[Nickle] nickle: Branch 'master' - 16 commits
Keith Packard
keithp at keithp.com
Fri Mar 21 12:31:13 PDT 2008
Makefile.am | 20 ++-
box.c | 8 -
builtin-bsdrandom.c | 11 -
builtin-command.c | 19 +--
builtin-environ.c | 6 -
builtin-file.c | 81 +++++++------
builtin-foreign.c | 12 +-
builtin-math.c | 18 +--
builtin-namespaces.h | 2
builtin-pid.c | 242 ++++++++++++++++++++++++++++++++++++++++
builtin-process.c | 242 ----------------------------------------
builtin-sockets.c | 38 ++----
builtin-string.c | 12 +-
builtin-toplevel.c | 95 +++++++--------
builtin.c | 13 +-
compile.c | 4
configure.in | 2
debian/changelog | 11 +
debug.c | 5
examples/circle.5c | 2
examples/comb.5c | 6 -
examples/cribbage.5c | 6 -
examples/fourfours.5c | 2
examples/initializer.5c | 10 -
examples/kaiser.5c | 18 +--
examples/miller-rabin.5c | 8 -
examples/numbers.5c | 6 -
examples/prime.5c | 16 +-
examples/randtest.5c | 2
examples/restart.5c | 4
examples/rijndael.5c | 40 +++---
examples/roman.5c | 6 -
examples/rsa.5c | 8 -
examples/smlng/parse.5c | 3
examples/sort.5c | 23 +--
execute.c | 214 ++++++++++++++---------------------
file.5c | 12 +-
file.c | 38 +++---
float.c | 56 ++++++---
hash.c | 6 -
int.c | 15 +-
integer.c | 15 +-
lex.l | 2
nickle.h | 28 ++--
pretty.c | 280 +++++++++++++++++++++++------------------------
profile.c | 37 +++++-
rational.c | 10 -
ref.c | 20 +--
scanf.5c | 70 ++++++-----
sched.c | 62 +++++-----
scope.c | 15 +-
string.c | 5
sync.c | 8 -
test/optest.5c | 2
value.c | 69 ++++-------
value.h | 2
56 files changed, 983 insertions(+), 984 deletions(-)
New commits:
commit 5106300e425315c5f753dd4e1bf2c1ff6d19db64
Author: Keith Packard <keithp at keithp.com>
Date: Fri Mar 21 12:31:00 2008 -0700
Fix floating point printing to correctly round output
diff --git a/float.c b/float.c
index ee8c1e1..12af2ec 100644
--- a/float.c
+++ b/float.c
@@ -746,6 +746,7 @@ FloatPrint (Value f, Value fv, char format, int base, int width, int prec, int f
char *frac_buffer;
char *frac_string;
char *exp_string = 0;
+ Bool rounded = False;
if (base <= 0)
base = 10;
@@ -780,11 +781,6 @@ FloatPrint (Value f, Value fv, char format, int base, int width, int prec, int f
negative = a->mant->sign == Negative;
m = NewInteger (Positive, a->mant->mag);
- /*
- * Round the mantissa up by adding a bit at the extreme of the precision
- */
- m = Plus (m, NewFloat (one_fpart,
- NewIntFpart (length - a->prec), a->prec + 2));
m = Times (m, fratio);
if (True (Less (m, One)))
{
@@ -847,10 +843,11 @@ FloatPrint (Value f, Value fv, char format, int base, int width, int prec, int f
if (prec == INFINITE_OUTPUT_PRECISION)
prec = mant_prec;
}
-
+
int_part = Floor (m);
frac_part = Minus (m, int_part);
+try_again:
if (ValueIsInteger(int_part))
int_n = IntegerMag(int_part);
else
@@ -905,6 +902,31 @@ FloatPrint (Value f, Value fv, char format, int base, int width, int prec, int f
if (frac_width < 2)
frac_width = 0;
+ /*
+ * Round the fractional part up by 1/2 beyond the
+ * last digit to be printed.
+ */
+ if (!rounded)
+ {
+ int frac_digits = frac_width == 0 ? 0 : frac_width - 1;
+ Value round = Times (Divide (One, NewInt (2)),
+ Pow (NewInt (base),
+ NewInt (-frac_digits)));
+ frac_part = Plus (frac_part, round);
+
+ /*
+ * If the fractional overflowed, bump the integer part
+ * and try again
+ */
+ if (GreaterEqual (frac_part, One) == TrueVal)
+ {
+ frac_part = Minus (frac_part, One);
+ int_part = Plus (int_part, One);
+ rounded = True;
+ free (int_buffer);
+ goto try_again;
+ }
+ }
frac_buffer = 0;
frac_string = 0;
if (frac_width)
@@ -927,7 +949,7 @@ FloatPrint (Value f, Value fv, char format, int base, int width, int prec, int f
EXIT ();
return True;
}
-
+
while (frac_wrote < frac_width - 1)
{
*--frac_string = '0';
commit e7f78ce3e66259f0a08c0099de4b89ad739c03c8
Author: Keith Packard <keithp at keithp.com>
Date: Thu Mar 20 10:56:38 2008 -0700
Fix divide_by_zero exception type in fourfours.5c example
diff --git a/examples/fourfours.5c b/examples/fourfours.5c
index e6f0da9..fb00ea0 100644
--- a/examples/fourfours.5c
+++ b/examples/fourfours.5c
@@ -55,7 +55,7 @@ poly () binloop(poly() l, poly() r) {
}
return a[i++ % dim(a)](la, ra);
}
- catch divide_by_zero (string a, real x, real y) { continue; }
+ catch divide_by_zero (real x, real y) { continue; }
catch invalid_argument (string a, int i, poly p) { continue; }
catch invalid_binop_values (string a, poly l, poly r) { continue; }
};
commit e00e48546d26c6e0c22c70cb7eb14e81c897c61e
Author: Keith Packard <keithp at keithp.com>
Date: Thu Mar 20 10:20:52 2008 -0700
Make SRPM + RPM build work by serializing dependencies.
$(SRPM) $(RPM): ...
build
fails as it does 'build' twice.
diff --git a/Makefile.am b/Makefile.am
index 435c6ee..890057a 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -132,17 +132,21 @@ clean-local:
#
RPMDIR=$(HOME)/rpmbuild
-rpm: $(RPMFILE)
+rpm: $(RPMFILE) $(SRPMFILE)
-$(RPMFILE) $(SRPMFILE): $(TARFILE) nickle.spec
+$(RPMFILE): $(TARFILE) nickle.spec
mkdir -p $(RPMDIR)/$(PACKAGE)-$(VERSION)
cp $(TARFILE) $(RPMDIR)/$(PACKAGE)-$(VERSION)
rpmbuild -ba nickle.spec
-
+
+$(SRPMFILE): $(RPMFILE)
+
$(TARFILE): dist-gzip $(DISTFILES)
touch $(TARFILE)
echo $(TARFILE) ready
+release-files: $(RELEASE_FILES)
+
release: $(RELEASE_FILES)
scp $(RELEASE_FILES) nickle.org:/var/www/nickle/release
commit 48e852689a43de236f93aa13172d31c8eb536fc1
Author: Keith Packard <keithp at keithp.com>
Date: Wed Mar 19 23:24:45 2008 -0700
Makefile fixes: make main.o depend on Makefile, ensure debuild actually does
diff --git a/Makefile.am b/Makefile.am
index 6375043..435c6ee 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -87,7 +87,7 @@ $(USES_GRAM_H): gram.h
YACCCOMPILE = $(YACC) $(YFLAGS) $(AM_YFLAGS) gram.y && sed -i 's/^short yy/static const short yy/' y.tab.c && echo
-builtin.o: $(nickle_SOURCES)
+builtin.o main.o: Makefile
TARFILE=$(PACKAGE)-$(VERSION).tar.gz
DEBFILE=$(PACKAGE)_$(VERSION)-1_i386.deb
@@ -139,7 +139,9 @@ $(RPMFILE) $(SRPMFILE): $(TARFILE) nickle.spec
cp $(TARFILE) $(RPMDIR)/$(PACKAGE)-$(VERSION)
rpmbuild -ba nickle.spec
-$(TARFILE): dist-gzip
+$(TARFILE): dist-gzip $(DISTFILES)
+ touch $(TARFILE)
+ echo $(TARFILE) ready
release: $(RELEASE_FILES)
scp $(RELEASE_FILES) nickle.org:/var/www/nickle/release
commit 27ace3a23d90e8e5fe16b943743a8d9144cca7e6
Author: Keith Packard <keithp at keithp.com>
Date: Wed Mar 19 23:12:13 2008 -0700
Avoid having the 'pretty_print' builtin show two error messages.
NamespaceLocate takes a 'complain' boolean that will print out an error
message, but the pretty_print command also raises an exception when it fails
to find the name. Two errors is at least one too many here.
diff --git a/builtin-command.c b/builtin-command.c
index a098438..ea534cd 100644
--- a/builtin-command.c
+++ b/builtin-command.c
@@ -186,7 +186,7 @@ do_Command_pretty_print (int argc, Value *args)
for (i = 1; i < argc; i++)
{
names = args[i];
- if (NamespaceLocate (names, &namespace, &symbol, &publish, True))
+ if (NamespaceLocate (names, &namespace, &symbol, &publish, False))
PrettyPrint (f, publish, symbol);
else
RaiseStandardException (exception_invalid_argument, 3,
commit 31e633b55cece8a6e46d763b2e51c974b450a12f
Author: Keith Packard <keithp at keithp.com>
Date: Wed Mar 19 22:38:18 2008 -0700
Rename the builtin Process namespace to PID to not conflict with the Process library
diff --git a/Makefile.am b/Makefile.am
index 8692f08..6375043 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -49,7 +49,7 @@ nickle_SOURCES = \
builtin-command.c builtin-debug.c builtin-environ.c \
builtin-file.c builtin-math.c builtin-namespaces.h \
builtin-semaphore.c builtin-sockets.c builtin-string.c \
- builtin-thread.c builtin-toplevel.c builtin-process.c \
+ builtin-thread.c builtin-toplevel.c builtin-pid.c \
builtin.c builtin.h \
builtin-foreign.c gram.y lex.l
diff --git a/builtin-namespaces.h b/builtin-namespaces.h
index 3356343..df4fc89 100644
--- a/builtin-namespaces.h
+++ b/builtin-namespaces.h
@@ -23,4 +23,4 @@ extern void import_Gcd_namespace(void);
extern void import_Environ_namespace(void);
extern void import_Socket_namespace(void);
extern void import_Foreign_namespace(void);
-extern void import_Process_namespace(void);
+extern void import_PID_namespace(void);
diff --git a/builtin-pid.c b/builtin-pid.c
new file mode 100644
index 0000000..e0d4771
--- /dev/null
+++ b/builtin-pid.c
@@ -0,0 +1,242 @@
+/*
+ * Copyright © 1988-2008 Keith Packard and Bart Massey.
+ * All Rights Reserved. See the file COPYING in this directory
+ * for licensing information.
+ */
+
+/*
+ * builtin-process.c
+ *
+ * provide builtin functions for the PID namespace
+ */
+
+#include <unistd.h>
+#include <sys/types.h>
+#include <errno.h>
+#include <grp.h>
+
+#include "builtin.h"
+
+NamespacePtr PIDNamespace;
+
+static Value
+do_PID_getuid (void)
+{
+ ENTER ();
+ RETURN (NewInt (getuid()));
+}
+
+static Value
+do_PID_geteuid (void)
+{
+ ENTER ();
+ RETURN (NewInt (geteuid()));
+}
+
+static Value
+do_PID_getgid (void)
+{
+ ENTER ();
+ RETURN (NewInt (getgid()));
+}
+
+static Value
+do_PID_getegid (void)
+{
+ ENTER ();
+ RETURN (NewInt (getegid()));
+}
+
+static Value
+do_PID_getgroups (void)
+{
+ ENTER ();
+ int n;
+ gid_t *list;
+ Value ret;
+ int i;
+
+ n = getgroups (0, NULL);
+ list = AllocateTemp (n * sizeof (gid_t));
+ getgroups (n, list);
+ ret = NewArray (False, False, typePrim[rep_integer], 1, &n);
+ for (i = 0; i < n; i++)
+ ArrayValueSet(&ret->array, i, NewInt (list[i]));
+ RETURN (ret);
+}
+
+static Value
+do_PID_getpid (void)
+{
+ ENTER ();
+ RETURN (NewInt (getpid()));
+}
+
+static Value
+error (Value value)
+{
+ int err = errno;
+
+ RaiseStandardException (exception_system_error, 3,
+ FileGetErrorMessage (err),
+ NewInt (err), value);
+ return Void;
+}
+
+static Value
+do_PID_setuid (Value uid)
+{
+ ENTER ();
+ int u = IntPart (uid, "Invalid uid");
+ if (aborting)
+ RETURN(Void);
+
+ if (setuid (u) < 0)
+ RETURN (error (uid));
+
+ RETURN (Void);
+}
+
+static Value
+do_PID_seteuid (Value euid)
+{
+ ENTER ();
+ int u = IntPart (euid, "Invalid euid");
+ if (aborting)
+ RETURN(Void);
+
+ if (seteuid (u) < 0)
+ RETURN (error (euid));
+
+ RETURN (Void);
+}
+
+static Value
+do_PID_setgid (Value gid)
+{
+ ENTER ();
+ int u = IntPart (gid, "Invalid gid");
+ if (aborting)
+ RETURN(Void);
+
+ if (setgid (u) < 0)
+ RETURN (error (gid));
+
+ RETURN (Void);
+}
+
+static Value
+do_PID_setegid (Value egid)
+{
+ ENTER ();
+ int u = IntPart (egid, "Invalid egid");
+ if (aborting)
+ RETURN(Void);
+
+ if (setegid (u) < 0)
+ RETURN (error (egid));
+
+ RETURN (Void);
+}
+
+static Value
+do_PID_setgroups (Value groups)
+{
+ ENTER ();
+ int n;
+ int i;
+ gid_t *g;
+
+ n = ArrayLimits (&groups->array)[0];
+ g = AllocateTemp (n * sizeof (gid_t));
+ for (i = 0; i < n; i++) {
+ g[i] = IntPart (ArrayValueGet (&groups->array, i), "Invalid gid");
+ if (aborting)
+ RETURN(Void);
+ }
+
+ if (setgroups (n, g) < 0)
+ RETURN (error (groups));
+
+ RETURN (Void);
+}
+
+void
+import_PID_namespace (void)
+{
+ ENTER ();
+
+ static const struct fbuiltin_0 funcs_0[] = {
+ { do_PID_getuid, "getuid", "i", "", "\n"
+ " int getuid ()\n"
+ "\n"
+ " Return the current uid\n" },
+ { do_PID_geteuid, "geteuid", "i", "", "\n"
+ " int geteuid ()\n"
+ "\n"
+ " Return the current effective uid\n" },
+ { do_PID_getgid, "getgid", "i", "", "\n"
+ " int getgid ()\n"
+ "\n"
+ " Return the current gid\n" },
+ { do_PID_getegid, "getegid", "i", "", "\n"
+ " int getegid ()\n"
+ "\n"
+ " Return the current effective gid\n" },
+ { do_PID_getgroups, "getgroups", "Ai", "", "\n"
+ " int[*] getgroups ()\n"
+ "\n"
+ " Return the list of additional groups\n" },
+ { do_PID_getpid, "getpid", "i", "", "\n"
+ " int getpid ()\n"
+ "\n"
+ " Return the current process id." },
+ { 0 }
+ };
+ static const struct fbuiltin_1 funcs_1[] = {
+ { do_PID_setuid, "setuid", "v", "i", "\n"
+ " void setuid (int uid)\n"
+ "\n"
+ " Set the current uid." },
+ { do_PID_seteuid, "seteuid", "v", "i", "\n"
+ " void seteuid (int euid)\n"
+ "\n"
+ " Set the current euid." },
+ { do_PID_setgid, "setgid", "v", "i", "\n"
+ " void setgid (int gid)\n"
+ "\n"
+ " Set the current gid." },
+ { do_PID_setegid, "setegid", "v", "i", "\n"
+ " void setegid (int egid)\n"
+ "\n"
+ " Set the current egid." },
+ { do_PID_setgroups, "setgroups", "v", "Ai", "\n"
+ " void setgroups (int[*] groups)\n"
+ "\n"
+ " Set the list of additional groups." },
+ { 0 }
+ };
+
+ static const struct ebuiltin excepts[] = {
+ {"system_error", exception_system_error, "sEp", "\n"
+ " system_error (string message, error_type error, poly value)\n"
+ "\n"
+ " Raised when a system function fails.\n"
+ " 'message' is a printable error string.\n"
+ " 'error' is a symbolic error code.\n"
+ " 'value' is the value which failed.\n" },
+ { 0, 0 },
+ };
+ const struct ebuiltin *e;
+
+ PIDNamespace = BuiltinNamespace (/*parent*/ 0, "PID")->namespace.namespace;
+
+ for (e = excepts; e->name; e++)
+ BuiltinAddException (&PIDNamespace, e->exception, e->name, e->args, e->doc);
+
+ BuiltinFuncs0 (&PIDNamespace, funcs_0);
+ BuiltinFuncs1 (&PIDNamespace, funcs_1);
+ EXIT ();
+}
+
+
diff --git a/builtin-process.c b/builtin-process.c
deleted file mode 100644
index 830facf..0000000
--- a/builtin-process.c
+++ /dev/null
@@ -1,242 +0,0 @@
-/*
- * Copyright © 1988-2008 Keith Packard and Bart Massey.
- * All Rights Reserved. See the file COPYING in this directory
- * for licensing information.
- */
-
-/*
- * builtin-process.c
- *
- * provide builtin functions for the Process namespace
- */
-
-#include <unistd.h>
-#include <sys/types.h>
-#include <errno.h>
-#include <grp.h>
-
-#include "builtin.h"
-
-NamespacePtr ProcessNamespace;
-
-static Value
-do_Process_getuid (void)
-{
- ENTER ();
- RETURN (NewInt (getuid()));
-}
-
-static Value
-do_Process_geteuid (void)
-{
- ENTER ();
- RETURN (NewInt (geteuid()));
-}
-
-static Value
-do_Process_getgid (void)
-{
- ENTER ();
- RETURN (NewInt (getgid()));
-}
-
-static Value
-do_Process_getegid (void)
-{
- ENTER ();
- RETURN (NewInt (getegid()));
-}
-
-static Value
-do_Process_getgroups (void)
-{
- ENTER ();
- int n;
- gid_t *list;
- Value ret;
- int i;
-
- n = getgroups (0, NULL);
- list = AllocateTemp (n * sizeof (gid_t));
- getgroups (n, list);
- ret = NewArray (False, False, typePrim[rep_integer], 1, &n);
- for (i = 0; i < n; i++)
- ArrayValueSet(&ret->array, i, NewInt (list[i]));
- RETURN (ret);
-}
-
-static Value
-do_Process_getpid (void)
-{
- ENTER ();
- RETURN (NewInt (getpid()));
-}
-
-static Value
-error (Value value)
-{
- int err = errno;
-
- RaiseStandardException (exception_system_error, 3,
- FileGetErrorMessage (err),
- NewInt (err), value);
- return Void;
-}
-
-static Value
-do_Process_setuid (Value uid)
-{
- ENTER ();
- int u = IntPart (uid, "Invalid uid");
- if (aborting)
- RETURN(Void);
-
- if (setuid (u) < 0)
- RETURN (error (uid));
-
- RETURN (Void);
-}
-
-static Value
-do_Process_seteuid (Value euid)
-{
- ENTER ();
- int u = IntPart (euid, "Invalid euid");
- if (aborting)
- RETURN(Void);
-
- if (seteuid (u) < 0)
- RETURN (error (euid));
-
- RETURN (Void);
-}
-
-static Value
-do_Process_setgid (Value gid)
-{
- ENTER ();
- int u = IntPart (gid, "Invalid gid");
- if (aborting)
- RETURN(Void);
-
- if (setgid (u) < 0)
- RETURN (error (gid));
-
- RETURN (Void);
-}
-
-static Value
-do_Process_setegid (Value egid)
-{
- ENTER ();
- int u = IntPart (egid, "Invalid egid");
- if (aborting)
- RETURN(Void);
-
- if (setegid (u) < 0)
- RETURN (error (egid));
-
- RETURN (Void);
-}
-
-static Value
-do_Process_setgroups (Value groups)
-{
- ENTER ();
- int n;
- int i;
- gid_t *g;
-
- n = ArrayLimits (&groups->array)[0];
- g = AllocateTemp (n * sizeof (gid_t));
- for (i = 0; i < n; i++) {
- g[i] = IntPart (ArrayValueGet (&groups->array, i), "Invalid gid");
- if (aborting)
- RETURN(Void);
- }
-
- if (setgroups (n, g) < 0)
- RETURN (error (groups));
-
- RETURN (Void);
-}
-
-void
-import_Process_namespace (void)
-{
- ENTER ();
-
- static const struct fbuiltin_0 funcs_0[] = {
- { do_Process_getuid, "getuid", "i", "", "\n"
- " int getuid ()\n"
- "\n"
- " Return the current uid\n" },
- { do_Process_geteuid, "geteuid", "i", "", "\n"
- " int geteuid ()\n"
- "\n"
- " Return the current effective uid\n" },
- { do_Process_getgid, "getgid", "i", "", "\n"
- " int getgid ()\n"
- "\n"
- " Return the current gid\n" },
- { do_Process_getegid, "getegid", "i", "", "\n"
- " int getegid ()\n"
- "\n"
- " Return the current effective gid\n" },
- { do_Process_getgroups, "getgroups", "Ai", "", "\n"
- " int[*] getgroups ()\n"
- "\n"
- " Return the list of additional groups\n" },
- { do_Process_getpid, "getpid", "i", "", "\n"
- " int getpid ()\n"
- "\n"
- " Return the current process id." },
- { 0 }
- };
- static const struct fbuiltin_1 funcs_1[] = {
- { do_Process_setuid, "setuid", "v", "i", "\n"
- " void setuid (int uid)\n"
- "\n"
- " Set the current uid." },
- { do_Process_seteuid, "seteuid", "v", "i", "\n"
- " void seteuid (int euid)\n"
- "\n"
- " Set the current euid." },
- { do_Process_setgid, "setgid", "v", "i", "\n"
- " void setgid (int gid)\n"
- "\n"
- " Set the current gid." },
- { do_Process_setegid, "setegid", "v", "i", "\n"
- " void setegid (int egid)\n"
- "\n"
- " Set the current egid." },
- { do_Process_setgroups, "setgroups", "v", "Ai", "\n"
- " void setgroups (int[*] groups)\n"
- "\n"
- " Set the list of additional groups." },
- { 0 }
- };
-
- static const struct ebuiltin excepts[] = {
- {"system_error", exception_system_error, "sEp", "\n"
- " system_error (string message, error_type error, poly value)\n"
- "\n"
- " Raised when a system function fails.\n"
- " 'message' is a printable error string.\n"
- " 'error' is a symbolic error code.\n"
- " 'value' is the value which failed.\n" },
- { 0, 0 },
- };
- const struct ebuiltin *e;
-
- ProcessNamespace = BuiltinNamespace (/*parent*/ 0, "Process")->namespace.namespace;
-
- for (e = excepts; e->name; e++)
- BuiltinAddException (&ProcessNamespace, e->exception, e->name, e->args, e->doc);
-
- BuiltinFuncs0 (&ProcessNamespace, funcs_0);
- BuiltinFuncs1 (&ProcessNamespace, funcs_1);
- EXIT ();
-}
-
-
diff --git a/builtin.c b/builtin.c
index b1dc736..6f47c23 100644
--- a/builtin.c
+++ b/builtin.c
@@ -328,7 +328,7 @@ BuiltinInit (void)
import_Environ_namespace();
import_Socket_namespace();
import_Foreign_namespace ();
- import_Process_namespace ();
+ import_PID_namespace ();
/* Import builtin strings with predefined values */
BuiltinStrings (svars);
commit ffc553a721015347939cc07da4a81577d86093d0
Author: Keith Packard <keithp at keithp.com>
Date: Wed Mar 19 22:37:49 2008 -0700
FileGetErrorMessage returns a Value, not a char *
diff --git a/lex.l b/lex.l
index 36c0efa..8c350dd 100644
--- a/lex.l
+++ b/lex.l
@@ -148,7 +148,7 @@ LexFile (char *s, Bool complain, Bool after)
if (f == 0) {
if (complain)
(void) FilePrintf (FileStderr, "%s: %s\n",
- s, FileGetErrorMessage (err));
+ s, StringChars (&FileGetErrorMessage (err)->string));
return False;
}
(void) NewLexInput(f, AtomId (s), after, False);
commit 3382f746e5423aa6bdd18349e6b47a8a6a5b5259
Author: Keith Packard <keithp at keithp.com>
Date: Wed Mar 19 16:09:24 2008 -0700
bump to 2.67
diff --git a/configure.in b/configure.in
index 87853cf..c7c218a 100644
--- a/configure.in
+++ b/configure.in
@@ -7,7 +7,7 @@ dnl for licensing information.
AC_PREREQ(2.59)
AC_INIT([nickle],
- 2.66,
+ 2.67,
[http://nickle.org],
nickle)
diff --git a/debian/changelog b/debian/changelog
index 90392c0..006fc1b 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,14 @@
+nickle (2.67-1) unstable; urgency=low
+ * Don't require string to be first param on builtin exceptions
+ * Add io_eof exceptions when reading at EOF
+ * Add unix-domain socket support
+ * Make SIGINT raise signal exception
+ * Add pid/uid/gid builtins
+ * Add unlink/rename/mkdir/rmdir builtins
+ * Autoimport works better on nested namespaces
+
+ -- Keith Packard <keithp at keithp.com> Wed, 19 Mar 2008 16:09:04 -0700
+
nickle (2.66-1) unstable; urgency=low
* Support autoload/autoimport of nested namespaces.
* Allow 'print' to find unpublished names
commit 88f787164419f814d149e39eec89b94790b164e3
Author: Keith Packard <keithp at keithp.com>
Date: Wed Mar 19 17:19:26 2008 -0700
Fix a few broken calls to RaiseStandardException.
RaiseStandardException was changed to remove the need to pass a string
argument first, but a few calls were not converted, and C varargs cannot
catch these errors. I checked all calls and they appear OK now.
diff --git a/builtin-command.c b/builtin-command.c
index 1209e04..a098438 100644
--- a/builtin-command.c
+++ b/builtin-command.c
@@ -189,9 +189,8 @@ do_Command_pretty_print (int argc, Value *args)
if (NamespaceLocate (names, &namespace, &symbol, &publish, True))
PrettyPrint (f, publish, symbol);
else
- RaiseStandardException (exception_invalid_argument,
- "name not found",
- 2,
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("name not found"),
NewInt (i), names);
}
RETURN (Void);
diff --git a/builtin-sockets.c b/builtin-sockets.c
index e202a5b..213f0d4 100644
--- a/builtin-sockets.c
+++ b/builtin-sockets.c
@@ -164,9 +164,9 @@ do_Socket_create (int num, Value *args)
Value ret;
if (num == 0 || num > 2) {
- RaiseStandardException (exception_invalid_argument,
- "create must have one or two arguments",
- 2, NewInt (0), NewInt (num));
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("create must have one or two arguments"),
+ NewInt (0), NewInt (num));
RETURN (Void);
}
@@ -200,8 +200,8 @@ typedef union {
#define VerifyArgumentCount(arg, condition, error) \
if (! (condition)) { \
- RaiseStandardException (exception_invalid_argument, \
- (error), 2, NewInt (0), NewInt (arg)); \
+ RaiseStandardException (exception_invalid_argument, 3, \
+ NewStrString (error), NewInt (0), NewInt (arg)); \
}
/* Supports the following args from both bind and connect:
diff --git a/execute.c b/execute.c
index 480017d..64e4ce0 100644
--- a/execute.c
+++ b/execute.c
@@ -279,8 +279,8 @@ ThreadAssign (Value ref, Value v, Bool initialize)
else if (RefConstant(ref) && !initialize)
RaiseStandardException (exception_readonly_box, 1, v);
else if (ref->ref.element >= ref->ref.box->nvalues)
- RaiseStandardException (exception_invalid_array_bounds,
- 2, NewInt(ref->ref.element), v);
+ RaiseStandardException (exception_invalid_array_bounds, 2,
+ NewInt(ref->ref.element), v);
else if (!TypeCompatibleAssign (RefType (ref), v))
{
RaiseStandardException (exception_invalid_argument, 3,
@@ -787,7 +787,8 @@ ThreadOpArray (Value thread, Value value, int stack, Bool fetch, Bool typeCheck)
case rep_string:
if (!fetch)
{
- RaiseStandardException (exception_invalid_binop_values, 2, v, value);
+ RaiseStandardException (exception_invalid_binop_values, 2,
+ v, value);
break;
}
if (stack != 1)
commit 085584b85f75c5ea25a95be949d2286e7974df2d
Author: Keith Packard <keithp at keithp.com>
Date: Wed Mar 19 16:00:09 2008 -0700
Divide by zero declaration is (real, real), not (string, real, real)
The type declaration for the divide_by_zero exception was wrong.
diff --git a/builtin.c b/builtin.c
index 838485b..b1dc736 100644
--- a/builtin.c
+++ b/builtin.c
@@ -73,11 +73,10 @@ static const struct ebuiltin excepts[] = {
" Attempt to index outside of array or do pointer arithmetic\n"
" on a pointer not referencing an array.\n"
" 'message' indicates the error context.\n" },
- {"divide_by_zero", exception_divide_by_zero, "sRR", "\n"
- " divide_by_zero (string message, real num, real den)\n"
+ {"divide_by_zero", exception_divide_by_zero, "RR", "\n"
+ " divide_by_zero (real num, real den)\n"
"\n"
- " Division or modulus by zero.\n"
- " 'message' indicates the error context.\n" },
+ " Division or modulus by zero.\n" },
{"invalid_struct_member", exception_invalid_struct_member,"ps", "\n"
" invalid_struct_member (poly value, string member)\n"
"\n"
commit b3023c298db4e22eb86fd809ef76d7776d7e68df
Author: Keith Packard <keithp at keithp.com>
Date: Mon Feb 25 10:07:14 2008 -0800
Change yacc invocation to make yacc tables const.
byacc (and bison) leave the yacc tables in writable pages; this change edits
the C output code to move them to read-only pages.
diff --git a/Makefile.am b/Makefile.am
index cded6fa..8692f08 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -85,6 +85,8 @@ USES_GRAM_H = \
$(USES_GRAM_H): gram.h
+YACCCOMPILE = $(YACC) $(YFLAGS) $(AM_YFLAGS) gram.y && sed -i 's/^short yy/static const short yy/' y.tab.c && echo
+
builtin.o: $(nickle_SOURCES)
TARFILE=$(PACKAGE)-$(VERSION).tar.gz
commit fec8c2e743f1b2ab194652b5074f99a9e373cc22
Author: Keith Packard <keithp at keithp.com>
Date: Mon Feb 25 10:00:51 2008 -0800
Track profile ticks per function in addition to per statement.
Recursive functions make gathering useful profile data harder. This avoids
some recursion mis-counting by separately tracking function and statement
lifetimes.
diff --git a/compile.c b/compile.c
index d7ce654..82d7add 100644
--- a/compile.c
+++ b/compile.c
@@ -63,6 +63,8 @@ ObjMark (void *object)
break;
}
}
+ if (!profiling)
+ obj->ticks = obj->sub_ticks = 0;
for (i = 0; i < obj->used_stat; i++)
MemReference (ObjStat (obj, i)->stat);
}
@@ -85,6 +87,8 @@ NewObj (int size, int size_stat)
obj->used_stat = 0;
obj->error = False;
obj->nonLocal = 0;
+ obj->ticks = 0;
+ obj->sub_ticks = 0;
RETURN (obj);
}
diff --git a/file.c b/file.c
index aede4b1..cd6d693 100644
--- a/file.c
+++ b/file.c
@@ -1549,7 +1549,7 @@ FilePutDimensions (Value f, ExprPtr dims, Bool resizable)
while (dims)
{
if (dims->tree.left)
- PrettyExpr (f, dims->tree.left, -1, 0, False, 0);
+ PrettyExpr (f, dims->tree.left, -1, 0, False);
else if (resizable)
FilePuts (f, "...");
else
diff --git a/nickle.h b/nickle.h
index 7afb058..09131c1 100644
--- a/nickle.h
+++ b/nickle.h
@@ -573,6 +573,8 @@ typedef struct _obj {
int used;
int size_stat;
int used_stat;
+ double_digit ticks;
+ double_digit sub_ticks;
Bool error;
NonLocal *nonLocal;
} Obj;
@@ -697,7 +699,7 @@ void PrettyPrint (Value f, Publish publish, SymbolPtr name);
void PrettyCode (Value f, CodePtr code, Atom name, Class class,
Publish publish, int level, Bool nest);
void PrettyStat (Value F, Expr *e, Bool nest);
-void PrettyExpr (Value f, Expr *e, int parentPrec, int level, Bool nest, ProfileData *pd);
+void PrettyExpr (Value f, Expr *e, int parentPrec, int level, Bool nest);
void EditFunction (SymbolPtr name, Publish publish);
void EditFile (Value file_name);
diff --git a/pretty.c b/pretty.c
index 9e33ced..a7632a0 100644
--- a/pretty.c
+++ b/pretty.c
@@ -43,28 +43,23 @@ PrettyProfNum (Value f, unsigned long i, int pad_left)
FilePuts (f, " ");
}
-static void PrettyParameters (Value f, Expr *e, Bool nest, ProfileData *pd);
-static void PrettyArrayInit (Value f, Expr *e, int level, Bool nest, ProfileData *pd);
-static void PrettyStatement (Value f, Expr *e, int level, int blevel, Bool nest, ProfileData *pd);
-static void PrettyBody (Value f, CodePtr code, int level, Bool nest, ProfileData *pd);
-static void PrettyDoc (Value f, int level, Value doc, ProfileData *pd);
+static void PrettyParameters (Value f, Expr *e, Bool nest);
+static void PrettyArrayInit (Value f, Expr *e, int level, Bool nest);
+static void PrettyStatement (Value f, Expr *e, int level, int blevel, Bool nest);
+static void PrettyBody (Value f, CodePtr code, int level, Bool nest);
+static void PrettyDoc (Value f, int level, Value doc);
static void
-PrettyIndent (Value f, Expr *e, int level, ProfileData *pd)
+PrettyIndent (Value f, Expr *e, int level)
{
int i;
if (profiling)
{
if (e)
{
- PrettyProfNum (f, e->base.sub_ticks, 1);
+ PrettyProfNum (f, e->base.sub_ticks + e->base.ticks, 1);
FilePuts (f, " ");
PrettyProfNum (f, e->base.ticks, 1);
- if (pd)
- {
- pd->sub += e->base.sub_ticks;
- pd->self += e->base.ticks;
- }
}
else
FilePuts (f, " ");
@@ -77,10 +72,10 @@ PrettyIndent (Value f, Expr *e, int level, ProfileData *pd)
}
static void
-PrettyBlock (Value f, Expr *e, int level, Bool nest, ProfileData *pd)
+PrettyBlock (Value f, Expr *e, int level, Bool nest)
{
while (e->tree.left) {
- PrettyStatement (f, e->tree.left, level, level, nest, pd);
+ PrettyStatement (f, e->tree.left, level, level, nest);
e = e->tree.right;
}
}
@@ -145,18 +140,18 @@ tokenToPrecedence (int token)
}
static void
-PrettyParameters (Value f, Expr *e, Bool nest, ProfileData *pd)
+PrettyParameters (Value f, Expr *e, Bool nest)
{
while (e)
{
if (e->tree.left->base.tag == DOTDOTDOT)
{
- PrettyExpr (f, e->tree.left->tree.left, -1, 0, nest, pd);
+ PrettyExpr (f, e->tree.left->tree.left, -1, 0, nest);
FilePuts (f, "...");
}
else
{
- PrettyExpr (f, e->tree.left, -1, 0, nest, pd);
+ PrettyExpr (f, e->tree.left, -1, 0, nest);
}
e = e->tree.right;
if (e)
@@ -165,15 +160,15 @@ PrettyParameters (Value f, Expr *e, Bool nest, ProfileData *pd)
}
static void
-PrettyArrayInit (Value f, Expr *e, int level, Bool nest, ProfileData *pd);
+PrettyArrayInit (Value f, Expr *e, int level, Bool nest);
static void
-PrettyArrayInits (Value f, Expr *e, int level, Bool nest, ProfileData *pd)
+PrettyArrayInits (Value f, Expr *e, int level, Bool nest)
{
while (e)
{
if (e->tree.left)
- PrettyArrayInit (f, e->tree.left, 0, nest, pd);
+ PrettyArrayInit (f, e->tree.left, 0, nest);
e = e->tree.right;
if (e)
{
@@ -186,31 +181,31 @@ PrettyArrayInits (Value f, Expr *e, int level, Bool nest, ProfileData *pd)
}
static void
-PrettyArrayInit (Value f, Expr *e, int level, Bool nest, ProfileData *pd)
+PrettyArrayInit (Value f, Expr *e, int level, Bool nest)
{
switch (e->base.tag) {
case OC:
FilePuts (f, "{ ");
- PrettyArrayInits (f, e->tree.left, level, nest, pd);
+ PrettyArrayInits (f, e->tree.left, level, nest);
FilePuts (f, " }");
break;
case DOTDOTDOT:
FilePuts (f, "...");
break;
default:
- PrettyExpr (f, e, -1, level, nest, pd);
+ PrettyExpr (f, e, -1, level, nest);
break;
}
}
static void
-PrettyHashInit (Value f, Expr *e, int level, Bool nest, ProfileData *pd)
+PrettyHashInit (Value f, Expr *e, int level, Bool nest)
{
while (e)
{
- PrettyExpr (f, e->tree.left->tree.left, -1, level, nest, pd);
+ PrettyExpr (f, e->tree.left->tree.left, -1, level, nest);
FilePuts (f, " => ");
- PrettyExpr (f, e->tree.left->tree.right, -1, level, nest, pd);
+ PrettyExpr (f, e->tree.left->tree.right, -1, level, nest);
e = e->tree.right;
if (e)
FilePuts (f, ", ");
@@ -218,13 +213,13 @@ PrettyHashInit (Value f, Expr *e, int level, Bool nest, ProfileData *pd)
}
static void
-PrettyStructInit (Value f, Expr *e, int level, Bool nest, ProfileData *pd)
+PrettyStructInit (Value f, Expr *e, int level, Bool nest)
{
while (e)
{
FilePuts (f, AtomName (e->tree.left->tree.left->atom.atom));
FilePuts (f, " = ");
- PrettyExpr (f, e->tree.left->tree.right, -1, level, nest, pd);
+ PrettyExpr (f, e->tree.left->tree.right, -1, level, nest);
e = e->tree.right;
if (e)
FilePuts (f, ", ");
@@ -265,7 +260,7 @@ PrettyChar (Value f, int c)
}
static void
-PrettyDecl (Value f, Expr *e, int level, Bool nest, ProfileData *pd)
+PrettyDecl (Value f, Expr *e, int level, Bool nest)
{
DeclListPtr decl;
@@ -311,7 +306,7 @@ PrettyDecl (Value f, Expr *e, int level, Bool nest, ProfileData *pd)
if (decl->init)
{
FilePuts (f, " = ");
- PrettyExpr (f, decl->init, -1, level, nest, pd);
+ PrettyExpr (f, decl->init, -1, level, nest);
}
if (decl->next)
FilePuts (f, ",");
@@ -323,7 +318,7 @@ PrettyDecl (Value f, Expr *e, int level, Bool nest, ProfileData *pd)
}
void
-PrettyExpr (Value f, Expr *e, int parentPrec, int level, Bool nest, ProfileData *pd)
+PrettyExpr (Value f, Expr *e, int parentPrec, int level, Bool nest)
{
int selfPrec;
@@ -337,19 +332,19 @@ PrettyExpr (Value f, Expr *e, int parentPrec, int level, Bool nest, ProfileData
FilePuts (f, AtomName (e->atom.atom));
break;
case VAR:
- PrettyDecl (f, e, level, nest, pd);
+ PrettyDecl (f, e, level, nest);
break;
case OP:
- PrettyExpr (f, e->tree.left, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.left, selfPrec, level, nest);
FilePuts (f, " (");
if (e->tree.right)
- PrettyParameters (f, e->tree.right, nest, pd);
+ PrettyParameters (f, e->tree.right, nest);
FilePuts (f, ")");
break;
case OS:
- PrettyExpr (f, e->tree.left, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.left, selfPrec, level, nest);
FilePuts (f, "[");
- PrettyParameters (f, e->tree.right, nest, pd);
+ PrettyParameters (f, e->tree.right, nest);
FilePuts (f, "]");
break;
case NEW:
@@ -357,31 +352,31 @@ PrettyExpr (Value f, Expr *e, int parentPrec, int level, Bool nest, ProfileData
if (e->tree.left)
{
FilePuts (f, " ");
- PrettyExpr (f, e->tree.left, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.left, selfPrec, level, nest);
}
break;
case ARRAY:
FilePuts (f, "{ ");
- PrettyArrayInits (f, e->tree.left, level, nest, pd);
+ PrettyArrayInits (f, e->tree.left, level, nest);
FilePuts (f, " }");
break;
case COMP:
FilePuts (f, "{ ");
FilePuts (f, "[");
- PrettyExpr (f, e->tree.left->tree.left, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.left->tree.left, selfPrec, level, nest);
FilePuts (f, "] ");
if (e->tree.right->base.tag == OC)
- PrettyStatement (f, e->tree.right, level + 1, level, nest, pd);
+ PrettyStatement (f, e->tree.right, level + 1, level, nest);
else
{
FilePuts (f, "= ");
- PrettyExpr (f, e->tree.right, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.right, selfPrec, level, nest);
}
FilePuts (f, " }");
break;
case HASH:
FilePuts (f, "{ ");
- PrettyHashInit (f, e->tree.left, level, nest, pd);
+ PrettyHashInit (f, e->tree.left, level, nest);
FilePuts (f, " }");
break;
case ANONINIT:
@@ -389,14 +384,14 @@ PrettyExpr (Value f, Expr *e, int parentPrec, int level, Bool nest, ProfileData
break;
case STRUCT:
FilePuts (f, "{ ");
- PrettyStructInit (f, e->tree.left, level, nest, pd);
+ PrettyStructInit (f, e->tree.left, level, nest);
FilePuts (f, " }");
break;
case UNION:
if (e->tree.right)
{
FilePrintf (f, "(%T.%A) ", e->base.type, e->tree.left->atom.atom);
- PrettyExpr (f, e->tree.right, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.right, selfPrec, level, nest);
}
else
{
@@ -472,7 +467,7 @@ PrettyExpr (Value f, Expr *e, int parentPrec, int level, Bool nest, ProfileData
case ASSIGNAND:
case ASSIGNOR:
case COMMA:
- PrettyExpr (f, e->tree.left, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.left, selfPrec, level, nest);
switch (e->base.tag) {
case PLUS: FilePuts (f, " + "); break;
case MINUS: FilePuts (f, " - "); break;
@@ -511,10 +506,10 @@ PrettyExpr (Value f, Expr *e, int parentPrec, int level, Bool nest, ProfileData
case ASSIGNOR: FilePuts (f, " ||= "); break;
case COMMA: FilePuts (f, ", "); break;
}
- PrettyExpr (f, e->tree.right, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.right, selfPrec, level, nest);
break;
case FACT:
- PrettyExpr (f, e->tree.left, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.left, selfPrec, level, nest);
FilePuts (f, "!");
break;
case LNOT:
@@ -523,7 +518,7 @@ PrettyExpr (Value f, Expr *e, int parentPrec, int level, Bool nest, ProfileData
case INC:
case DEC:
if (e->tree.right)
- PrettyExpr (f, e->tree.right, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.right, selfPrec, level, nest);
switch (e->base.tag) {
case LNOT: FilePuts (f, "~"); break;
case UMINUS: FilePuts (f, "-"); break;
@@ -532,49 +527,49 @@ PrettyExpr (Value f, Expr *e, int parentPrec, int level, Bool nest, ProfileData
case DEC: FilePuts (f, "--"); break;
}
if (e->tree.left)
- PrettyExpr (f, e->tree.left, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.left, selfPrec, level, nest);
break;
case STAR:
FilePuts (f, "*");
- PrettyExpr (f, e->tree.left, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.left, selfPrec, level, nest);
break;
case AMPER:
FilePuts (f, "&");
- PrettyExpr (f, e->tree.left, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.left, selfPrec, level, nest);
break;
case COLONCOLON:
- PrettyExpr (f, e->tree.left, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.left, selfPrec, level, nest);
FilePuts (f, "::");
FilePuts (f, AtomName (e->tree.right->atom.atom));
break;
case DOT:
- PrettyExpr (f, e->tree.left, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.left, selfPrec, level, nest);
FileOutput (f, '.');
FilePuts (f, AtomName (e->tree.right->atom.atom));
break;
case ARROW:
- PrettyExpr (f, e->tree.left, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.left, selfPrec, level, nest);
FilePuts (f, "->");
FilePuts (f, AtomName (e->tree.right->atom.atom));
break;
case QUEST:
- PrettyExpr (f, e->tree.left, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.left, selfPrec, level, nest);
FilePuts (f, " ? ");
- PrettyExpr (f, e->tree.right->tree.left, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.right->tree.left, selfPrec, level, nest);
FilePuts (f, " : ");
- PrettyExpr (f, e->tree.right->tree.right, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.right->tree.right, selfPrec, level, nest);
break;
case DOLLAR:
if (e->tree.left)
{
FilePuts (f, "$");
- PrettyExpr (f, e->tree.left, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.left, selfPrec, level, nest);
}
else
FilePuts (f, ".");
break;
case EXPR:
- PrettyExpr (f, e->tree.left, selfPrec, level, nest, pd);
+ PrettyExpr (f, e->tree.left, selfPrec, level, nest);
break;
}
if (selfPrec < parentPrec)
@@ -582,16 +577,16 @@ PrettyExpr (Value f, Expr *e, int parentPrec, int level, Bool nest, ProfileData
}
static void
-_PrettyCatch (Value f, Expr *e, int level, Bool nest, ProfileData *pd)
+_PrettyCatch (Value f, Expr *e, int level, Bool nest)
{
CodePtr catch;
Atom name;
if (!e)
return;
- _PrettyCatch (f, e->tree.left, level, nest, pd);
+ _PrettyCatch (f, e->tree.left, level, nest);
if (nest)
- PrettyIndent (f, 0, level, pd);
+ PrettyIndent (f, 0, level);
e = e->tree.right;
catch = e->code.code;
if (catch->base.name->base.tag == COLONCOLON)
@@ -599,9 +594,9 @@ _PrettyCatch (Value f, Expr *e, int level, Bool nest, ProfileData *pd)
else
name = catch->base.name->atom.atom;
FilePuts (f, "catch ");
- PrettyExpr (f, catch->base.name, 0, level, nest, pd);
+ PrettyExpr (f, catch->base.name, 0, level, nest);
FilePuts (f, " ");
- PrettyBody (f, catch, level, nest, pd);
+ PrettyBody (f, catch, level, nest);
FilePuts (f, "\n");
}
@@ -609,91 +604,91 @@ static void
PrintArgs (Value f, ArgType *args);
void
-PrettyStatement (Value f, Expr *e, int level, int blevel, Bool nest, ProfileData *pd)
+PrettyStatement (Value f, Expr *e, int level, int blevel, Bool nest)
{
switch (e->base.tag) {
case EXPR:
- PrettyIndent (f, e, level, pd);
- PrettyExpr (f, e->tree.left, -1, level, nest, pd);
+ PrettyIndent (f, e, level);
+ PrettyExpr (f, e->tree.left, -1, level, nest);
FilePuts (f, ";\n");
break;
case IF:
- PrettyIndent (f, e, level, pd);
+ PrettyIndent (f, e, level);
FilePuts (f, "if (");
- PrettyExpr (f, e->tree.left, -1, level, nest, pd);
+ PrettyExpr (f, e->tree.left, -1, level, nest);
FilePuts (f, ")\n");
if (nest)
- PrettyStatement (f, e->tree.right, level+1, level, nest, pd);
+ PrettyStatement (f, e->tree.right, level+1, level, nest);
break;
case ELSE:
- PrettyIndent (f, e, level, pd);
+ PrettyIndent (f, e, level);
FilePuts (f, "if (");
- PrettyExpr (f, e->tree.left, -1, level, nest, pd);
+ PrettyExpr (f, e->tree.left, -1, level, nest);
FilePuts (f, ")\n");
if (nest)
{
- PrettyStatement (f, e->tree.right->tree.left, level+1, level, nest, pd);
- PrettyIndent (f, 0, level, pd);
+ PrettyStatement (f, e->tree.right->tree.left, level+1, level, nest);
+ PrettyIndent (f, 0, level);
FilePuts (f, "else\n");
- PrettyStatement (f, e->tree.right->tree.right, level+1, level, nest, pd);
+ PrettyStatement (f, e->tree.right->tree.right, level+1, level, nest);
}
break;
case WHILE:
- PrettyIndent (f, e, level, pd);
+ PrettyIndent (f, e, level);
FilePuts (f, "while (");
- PrettyExpr (f, e->tree.left, -1, level, nest, pd);
+ PrettyExpr (f, e->tree.left, -1, level, nest);
FilePuts (f, ")\n");
if (nest)
- PrettyStatement (f, e->tree.right, level+1, level, nest, pd);
+ PrettyStatement (f, e->tree.right, level+1, level, nest);
break;
case OC:
- PrettyIndent (f, 0, blevel, pd);
+ PrettyIndent (f, 0, blevel);
FilePuts (f, "{\n");
- PrettyBlock (f, e, blevel + 1, nest, pd);
- PrettyIndent (f, 0, blevel, pd);
+ PrettyBlock (f, e, blevel + 1, nest);
+ PrettyIndent (f, 0, blevel);
FilePuts (f, "}\n");
break;
case DO:
- PrettyIndent (f, 0, level, pd);
+ PrettyIndent (f, 0, level);
FilePuts (f, "do\n");
if (nest)
- PrettyStatement (f, e->tree.left, level+1, level, nest, pd);
- PrettyIndent (f, e, level, pd);
+ PrettyStatement (f, e->tree.left, level+1, level, nest);
+ PrettyIndent (f, e, level);
FilePuts (f, "while (");
- PrettyExpr (f, e->tree.right, -1, level, nest, pd);
+ PrettyExpr (f, e->tree.right, -1, level, nest);
FilePuts (f, ");\n");
break;
case FOR:
- PrettyIndent (f, e, level, pd);
+ PrettyIndent (f, e, level);
FilePuts (f, "for (");
if (e->tree.left->tree.left)
- PrettyExpr (f, e->tree.left->tree.left, -1, level, nest, pd);
+ PrettyExpr (f, e->tree.left->tree.left, -1, level, nest);
if (e->tree.left->base.tag == SEMI)
FilePuts (f, ";");
if (e->tree.left->tree.right->tree.left)
{
if (e->tree.left->base.tag == SEMI)
FilePuts (f, " ");
- PrettyExpr (f, e->tree.left->tree.right->tree.left, -1, level, nest, pd);
+ PrettyExpr (f, e->tree.left->tree.right->tree.left, -1, level, nest);
}
FilePuts (f, ";");
if (e->tree.left->tree.right->tree.right->tree.left)
{
FilePuts (f, " ");
- PrettyExpr (f, e->tree.left->tree.right->tree.right->tree.left, -1, level, nest, pd);
+ PrettyExpr (f, e->tree.left->tree.right->tree.right->tree.left, -1, level, nest);
}
FilePuts (f, ")\n");
if (nest)
- PrettyStatement (f, e->tree.right, level+1, level, nest, pd);
+ PrettyStatement (f, e->tree.right, level+1, level, nest);
break;
case SWITCH:
case UNION:
- PrettyIndent (f, e, level, pd);
+ PrettyIndent (f, e, level);
if (e->base.tag == SWITCH)
FilePuts (f, "switch (");
else
FilePuts (f, "union switch (");
- PrettyExpr (f, e->tree.left, -1, level, nest, pd);
+ PrettyExpr (f, e->tree.left, -1, level, nest);
FilePuts (f, ")");
if (nest)
{
@@ -702,43 +697,43 @@ PrettyStatement (Value f, Expr *e, int level, int blevel, Bool nest, ProfileData
FilePuts (f, " {\n");
while (block)
{
- PrettyIndent (f, 0, level, pd);
+ PrettyIndent (f, 0, level);
if (block->tree.left->tree.left)
{
FilePuts (f, "case ");
- PrettyExpr (f, block->tree.left->tree.left, -1, level, nest, pd);
+ PrettyExpr (f, block->tree.left->tree.left, -1, level, nest);
}
else
FilePuts (f, "default");
FilePuts (f, ":\n");
- PrettyBlock (f, block->tree.left->tree.right, level+1, nest, pd);
+ PrettyBlock (f, block->tree.left->tree.right, level+1, nest);
block = block->tree.right;
}
- PrettyIndent (f, 0, level, pd);
+ PrettyIndent (f, 0, level);
FilePuts (f, "}");
}
FilePuts (f, "\n");
break;
case SEMI:
- PrettyIndent (f, e, level, pd);
+ PrettyIndent (f, e, level);
FilePuts (f, ";\n");
break;
case BREAK:
- PrettyIndent (f, e, level, pd);
+ PrettyIndent (f, e, level);
FilePuts (f, "break;\n");
break;
case CONTINUE:
- PrettyIndent (f, e, level, pd);
+ PrettyIndent (f, e, level);
FilePuts (f, "continue;\n");
break;
case RETURNTOK:
- PrettyIndent (f, e, level, pd);
+ PrettyIndent (f, e, level);
FilePuts (f, "return ");
- PrettyExpr (f, e->tree.right, -1, level, nest, pd);
+ PrettyExpr (f, e->tree.right, -1, level, nest);
FilePuts (f, ";\n");
break;
case FUNC:
- PrettyIndent (f, e, level, pd);
+ PrettyIndent (f, e, level);
{
DeclListPtr decl = e->decl.decl;
ExprPtr init = decl->init;
@@ -766,55 +761,55 @@ PrettyStatement (Value f, Expr *e, int level, int blevel, Bool nest, ProfileData
e = e->tree.left;
/* fall through */
case VAR:
- PrettyIndent (f, e, level, pd);
- PrettyDecl (f, e, level, nest, pd);
+ PrettyIndent (f, e, level);
+ PrettyDecl (f, e, level, nest);
FilePuts (f, ";\n");
break;
case NAMESPACE:
- PrettyIndent (f, e, level, pd);
+ PrettyIndent (f, e, level);
FilePuts (f, "namespace ");
- PrettyExpr (f, e->tree.left, -1, level, nest, pd);
+ PrettyExpr (f, e->tree.left, -1, level, nest);
FilePuts (f, "\n");
- PrettyStatement (f, e->tree.right, level + 1, level, nest, pd);
+ PrettyStatement (f, e->tree.right, level + 1, level, nest);
break;
case IMPORT:
- PrettyIndent (f, e, level, pd);
+ PrettyIndent (f, e, level);
FilePrintf (f, "%pimport ", e->tree.right->decl.publish);
- PrettyExpr (f, e->tree.left, -1, level, nest, pd);
+ PrettyExpr (f, e->tree.left, -1, level, nest);
FilePuts (f, ";\n");
break;
case TWIXT:
- PrettyIndent (f, e, level, pd);
+ PrettyIndent (f, e, level);
FilePuts (f, "twixt (");
- PrettyExpr (f, e->tree.left->tree.left, -1, level, nest, pd);
+ PrettyExpr (f, e->tree.left->tree.left, -1, level, nest);
FilePuts (f, "; ");
- PrettyExpr (f, e->tree.left->tree.right, -1, level, nest, pd);
+ PrettyExpr (f, e->tree.left->tree.right, -1, level, nest);
FilePuts (f, ")\n");
if (nest)
- PrettyStatement (f, e->tree.right->tree.left, level+1, level, nest, pd);
+ PrettyStatement (f, e->tree.right->tree.left, level+1, level, nest);
break;
case CATCH:
- PrettyIndent (f, e, level, pd);
+ PrettyIndent (f, e, level);
FilePuts (f, "try");
if (nest)
{
FilePuts (f, "\n");
- PrettyStatement (f, e->tree.right, level+1, level, nest, pd);
+ PrettyStatement (f, e->tree.right, level+1, level, nest);
}
else
FilePuts (f, " ");
- _PrettyCatch (f, e->tree.left, level, nest, pd);
+ _PrettyCatch (f, e->tree.left, level, nest);
break;
case RAISE:
- PrettyIndent (f, e, level, pd);
+ PrettyIndent (f, e, level);
FilePrintf (f, "raise %A (", e->tree.left->atom.atom);
if (e->tree.right)
- PrettyParameters (f, e->tree.right, nest, pd);
+ PrettyParameters (f, e->tree.right, nest);
FilePuts (f, ");\n");
break;
case DOLLAR:
- PrettyIndent (f, e, level, pd);
- PrettyExpr (f, e->tree.left, -1, level, nest, pd);
+ PrettyIndent (f, e, level);
+ PrettyExpr (f, e->tree.left, -1, level, nest);
FilePuts (f, "\n");
break;
}
@@ -838,20 +833,20 @@ PrintArgs (Value f, ArgType *args)
}
static void
-PrettyDoc (Value f, int level, Value doc, ProfileData *pd)
+PrettyDoc (Value f, int level, Value doc)
{
char *s = StringChars (&doc->string);
long len = doc->string.length;
unsigned c;
Bool newline = False;
- PrettyIndent (f, 0, level, pd);
+ PrettyIndent (f, 0, level);
FilePuts (f, "/""*");
while ((s = StringNextChar (s, &c, &len)))
{
if (newline)
{
- PrettyIndent (f, 0, level, pd);
+ PrettyIndent (f, 0, level);
FilePuts (f, " *");
newline = False;
}
@@ -861,20 +856,20 @@ PrettyDoc (Value f, int level, Value doc, ProfileData *pd)
}
if (newline)
{
- PrettyIndent (f, 0, level, pd);
+ PrettyIndent (f, 0, level);
FileOutput (f, ' ');
}
FilePuts (f, "*""/");
}
static void
-PrettyBody (Value f, CodePtr code, int level, Bool nest, ProfileData *pd)
+PrettyBody (Value f, CodePtr code, int level, Bool nest)
{
PrintArgs (f, code->base.args);
if (code->base.doc != Void)
{
FilePuts (f, "\n");
- PrettyDoc (f, level + 1, code->base.doc, pd);
+ PrettyDoc (f, level + 1, code->base.doc);
}
if (nest)
{
@@ -885,10 +880,10 @@ PrettyBody (Value f, CodePtr code, int level, Bool nest, ProfileData *pd)
else
{
FilePuts (f, "\n");
- PrettyIndent (f, 0, level, pd);
+ PrettyIndent (f, 0, level);
FilePuts (f, "{\n");
- PrettyBlock (f, code->func.code, level + 1, nest, pd);
- PrettyIndent (f, 0, level, pd);
+ PrettyBlock (f, code->func.code, level + 1, nest);
+ PrettyIndent (f, 0, level);
FilePuts (f, "}");
}
}
@@ -900,19 +895,26 @@ void
PrettyCode (Value f, CodePtr code, Atom name, Class class, Publish publish,
int level, Bool nest)
{
- ProfileData pd;
- pd.sub = pd.self = 0;
if (name)
FilePrintf (f, "%p%k%T %A ", publish, class, code->base.type, name);
else
FilePrintf (f, "%tfunc", code->base.type);
- PrettyBody (f, code, level, nest, &pd);
+ PrettyBody (f, code, level, nest);
if (!code->base.builtin && nest && profiling)
{
+ double_digit sub = 0, self = 0;
+ if (code->func.body.obj) {
+ sub += code->func.body.obj->sub_ticks;
+ self += code->func.body.obj->ticks;
+ }
+ if (code->func.staticInit.obj) {
+ sub += code->func.staticInit.obj->sub_ticks;
+ self += code->func.staticInit.obj->ticks;
+ }
FilePuts (f, "\n---------------------\n");
- PrettyProfNum (f, pd.sub, 1);
+ PrettyProfNum (f, sub + self, 1);
FilePuts (f, " ");
- PrettyProfNum (f, pd.self, 1);
+ PrettyProfNum (f, self, 1);
if (name)
FilePrintf (f, ": %A\n", name);
else
@@ -923,7 +925,7 @@ PrettyCode (Value f, CodePtr code, Atom name, Class class, Publish publish,
void
PrettyStat (Value f, Expr *e, Bool nest)
{
- PrettyStatement (f, e, 1, 1, nest, 0);
+ PrettyStatement (f, e, 1, 1, nest);
}
void
@@ -953,8 +955,8 @@ doPrettyPrint (Value f, Publish publish, SymbolPtr symbol, int level, Bool nest)
if (!symbol)
return;
if (profiling)
- FilePuts (f, " called(ms) self(ms)\n");
- PrettyIndent (f, 0, level, 0);
+ FilePuts (f, " total(ms) self(ms)\n");
+ PrettyIndent (f, 0, level);
switch (symbol->symbol.class) {
case class_const:
case class_global:
@@ -981,7 +983,7 @@ doPrettyPrint (Value f, Publish publish, SymbolPtr symbol, int level, Bool nest)
{
FilePuts (f, " {\n");
PrintNamespace (f, symbol->namespace.namespace, level + 1);
- PrettyIndent (f, 0, level, 0);
+ PrettyIndent (f, 0, level);
FilePuts (f, "}\n");
}
else
@@ -994,7 +996,7 @@ doPrettyPrint (Value f, Publish publish, SymbolPtr symbol, int level, Bool nest)
if (symbol->exception.doc != Void)
{
FilePuts (f, "\n");
- PrettyDoc (f, level + 1, symbol->exception.doc, 0);
+ PrettyDoc (f, level + 1, symbol->exception.doc);
}
FilePuts (f, ";\n");
break;
diff --git a/profile.c b/profile.c
index f5797d9..b66255d 100644
--- a/profile.c
+++ b/profile.c
@@ -42,18 +42,47 @@ ProfileInterrupt (Value thread)
pc = thread->thread.continuation.pc;
if (pc)
{
- stat = ObjStatement (thread->thread.continuation.obj,pc);
+ ObjPtr obj = thread->thread.continuation.obj;
+ stat = ObjStatement (obj, pc);
if (stat)
{
stat->base.ticks += ticks;
+ stat->base.line = -stat->base.line - 1;
}
+ obj->ticks += ticks;
+ obj->error += 100;
}
for (frame = thread->thread.continuation.frame; frame; frame = frame->previous)
{
- pc = frame->savePc;
- stat = ObjStatement (frame->saveObj, frame->savePc);
- if (stat)
+ ObjPtr obj = frame->saveObj;
+ stat = ObjStatement (obj, frame->savePc);
+ if (stat && stat->base.line >= 0) {
stat->base.sub_ticks += ticks;
+ stat->base.line = -stat->base.line - 1;
+ }
+ if (obj->error < 100) {
+ obj->sub_ticks += ticks;
+ obj->error += 100;
+ }
+ }
+ for (frame = thread->thread.continuation.frame; frame; frame = frame->previous)
+ {
+ ObjPtr obj = frame->saveObj;
+ stat = ObjStatement (obj, frame->savePc);
+ if (stat)
+ stat->base.line = -stat->base.line + 1;
+ if (obj->error >= 100)
+ obj->error -= 100;
+ }
+ pc = thread->thread.continuation.pc;
+ if (pc)
+ {
+ ObjPtr obj = thread->thread.continuation.obj;
+ stat = ObjStatement (obj, pc);
+ if (stat)
+ stat->base.line = -stat->base.line + 1;
+ if (obj->error >= 100)
+ obj->error -= 100;
}
}
diff --git a/sched.c b/sched.c
index 894e2bf..994d1c1 100644
--- a/sched.c
+++ b/sched.c
@@ -302,7 +302,7 @@ TraceFunction (Value file, FramePtr frame, CodePtr code, ExprPtr name)
FilePuts (file, " ");
if (name)
- PrettyExpr (file, name, -1, 0, False, 0);
+ PrettyExpr (file, name, -1, 0, False);
else
FilePuts (file, "<anonymous>");
FilePuts (file, " (");
commit eefcdbb5330160a0197e425b45f174f34b1b5db7
Author: Keith Packard <keithp at keithp.com>
Date: Mon Feb 25 08:40:42 2008 -0800
Remove old "function" keyword from examples
diff --git a/examples/circle.5c b/examples/circle.5c
index ae8cd50..33aa0ed 100644
--- a/examples/circle.5c
+++ b/examples/circle.5c
@@ -17,7 +17,7 @@ typedef struct {
real dist, bearing;
} course;
-course function great_circle (loc start, loc end) {
+course great_circle (loc start, loc end) {
real rad = pi / 180;
/* real earth_radius = 6371.2 km ; */
real earth_radius = 3958.9; /* miles */
diff --git a/examples/comb.5c b/examples/comb.5c
index c9169ef..50cd8c2 100644
--- a/examples/comb.5c
+++ b/examples/comb.5c
@@ -7,15 +7,15 @@
namespace Comb {
- public int function perm(n, r) {
+ public int perm(n, r) {
return n! // r!;
}
- public int function choose(n, r) {
+ public int choose(n, r) {
return n! // (r! * (n - r)!);
}
- public int function binom(n, k) {
+ public int binom(n, k) {
int sum, i;
sum = 1;
diff --git a/examples/cribbage.5c b/examples/cribbage.5c
index 82821d6..9ccb6e1 100644
--- a/examples/cribbage.5c
+++ b/examples/cribbage.5c
@@ -9,7 +9,7 @@
namespace Cribbage {
- int function countsum(int c, int[*] v, int n) {
+ int countsum(int c, int[*] v, int n) {
if (c < 0)
return 0;
int t = 0;
@@ -22,7 +22,7 @@ namespace Cribbage {
return countsum(c, v, n - 1) + countsum(c - v[n - 1], v, n - 1);
}
- int function countpairs(int[*] v, int n) {
+ int countpairs(int[*] v, int n) {
if (n < 2)
return 0;
int c = 0;
@@ -37,7 +37,7 @@ namespace Cribbage {
return c * (c + 1) // 2 + countpairs(w, n - c - 1);
}
- public int function score(int[*] v) {
+ public int score(int[*] v) {
int n = dim(v);
return 2 * countsum(15, v, n) + 2 * countpairs(v, n);
}
diff --git a/examples/initializer.5c b/examples/initializer.5c
index 3e7792f..05f5a0a 100644
--- a/examples/initializer.5c
+++ b/examples/initializer.5c
@@ -11,10 +11,10 @@ continuation c;
/*
* Static initializer example
*/
-function stat ()
+int stat ()
{
int x = 1;
- function bar ()
+ int bar ()
{
static int qq = 37;
/*
@@ -51,14 +51,14 @@ longjmp (c, 1) /* 110 */
*/
int glob_x = 2;
-function glob ()
+int glob ()
{
int x = 2;
- function bar ()
+ int bar ()
{
int z = 3;
global q = 7;
- function bletch ()
+ int bletch ()
{
/*
* This initializer is run in glob's static initializer context
diff --git a/examples/kaiser.5c b/examples/kaiser.5c
index e4ec2c0..4b26e2a 100644
--- a/examples/kaiser.5c
+++ b/examples/kaiser.5c
@@ -6,7 +6,7 @@
* for licensing information.
*/
-real function i0(real x)
+real i0(real x)
{
real ds, d, s;
@@ -25,7 +25,7 @@ real function i0(real x)
return s;
}
-real function highpass (real n, real m, real wc)
+real highpass (real n, real m, real wc)
{
real alpha = m/2;
real dist;
@@ -36,7 +36,7 @@ real function highpass (real n, real m, real wc)
return -sin(dist * (pi/2-wc)) / (pi * dist);
}
-real function lowpass (real n, real m, real wc)
+real lowpass (real n, real m, real wc)
{
real alpha = m/2;
real dist;
@@ -46,13 +46,13 @@ real function lowpass (real n, real m, real wc)
return sin (wc * dist) / (pi * dist);
}
-real function kaiser (real n, real m, real beta)
+real kaiser (real n, real m, real beta)
{
real alpha = m / 2;
return i0 (beta * sqrt (1 - ((n - alpha) / alpha)**2)) / i0(beta);
}
-function write_high (string filename,
+void write_high (string filename,
real m,
real wc,
real beta,
@@ -67,7 +67,7 @@ function write_high (string filename,
File::close (f);
}
-function write_low (string filename,
+void write_low (string filename,
real m,
real wc,
real beta,
@@ -82,7 +82,7 @@ function write_low (string filename,
File::close (f);
}
-real function Beta (real A)
+real Beta (real A)
{
if (A > 50)
return 0.1102 * (A - 8.7);
@@ -92,12 +92,12 @@ real function Beta (real A)
return 0.0;
}
-int function M (real A, real deltaw)
+int M (real A, real deltaw)
{
return ceil ((A - 8) / (2.285 * deltaw));
}
-real function filter (real wpass, real wstop, real error, *int mp)
+real filter (real wpass, real wstop, real error, *int mp)
{
real deltaw = wstop - wpass;
real A = -20 * log10 (error);
diff --git a/examples/miller-rabin.5c b/examples/miller-rabin.5c
index 01477a3..01c5778 100644
--- a/examples/miller-rabin.5c
+++ b/examples/miller-rabin.5c
@@ -31,7 +31,7 @@ namespace MillerRabin {
* Computes core of Miller-Rabin test
* as suggested by Cormen/Leiserson/Rivest.
*/
- witness_result function witnessexp(int b, int e, int m) {
+ witness_result witnessexp(int b, int e, int m) {
switch (e) {
case 0:
return (witness_result){ .pow = 0, .wit = 1};
@@ -55,7 +55,7 @@ namespace MillerRabin {
}
/* Rest of Miller-Rabin test */
- bool function witness(int a, int n) {
+ bool witness(int a, int n) {
witness_result we = witnessexp(a, n - 1, n);
if (we.wit != 0)
return true;
@@ -65,7 +65,7 @@ namespace MillerRabin {
}
/* Try small primes, then Miller-Rabin */
- public bool function composite(int n, int d) {
+ public bool composite(int n, int d) {
int i, j;
for (i = 0; i < nprimes && primes[i] < n; i++)
if (n % primes[i] == 0)
@@ -79,7 +79,7 @@ namespace MillerRabin {
}
/* generate an n-bit prime (with probability 1-(2**-d)) number */
- public int function primebits(int n, int d) {
+ public int primebits(int n, int d) {
while (true) {
int q = PRNG::randbits(n - 1) + 2**(n - 1);
bool why = composite(q, d);
diff --git a/examples/numbers.5c b/examples/numbers.5c
index 42cfe6f..e98fcb4 100644
--- a/examples/numbers.5c
+++ b/examples/numbers.5c
@@ -15,7 +15,7 @@
namespace Numbers {
- public int function bigpowmod(int b, int e, int m) {
+ public int bigpowmod(int b, int e, int m) {
if (e == 0)
return 1;
if (e == 1)
@@ -30,7 +30,7 @@ namespace Numbers {
public typedef struct { int d, x, y; } coeff;
/* Extended Euclid's Algorithm */
- public coeff function extgcd(int a, int b) {
+ public coeff extgcd(int a, int b) {
if (b == 0)
return (coeff) { .d = a, .x = 1, .y = 0};
coeff t = extgcd(b, a % b);
@@ -41,7 +41,7 @@ namespace Numbers {
}
/* multiplicative inverse of a mod n */
- public int function zminv(int a, int n) {
+ public int zminv(int a, int n) {
coeff e = extgcd(a, n);
if (e.x < 0)
return n + e.x;
diff --git a/examples/prime.5c b/examples/prime.5c
index b4ca209..a162235 100644
--- a/examples/prime.5c
+++ b/examples/prime.5c
@@ -11,7 +11,7 @@
namespace Factor {
- public bool function is_prime (int i)
+ public bool is_prime (int i)
{
if (i == 1) return false;
if (i == 2) return true;
@@ -40,9 +40,9 @@ namespace Factor {
int v;
} int_list_struct;
- public int_list function primes (int i)
+ public int_list primes (int i)
{
- bool function prime_wrt (int_list l, int i)
+ bool prime_wrt (int_list l, int i)
{
if (l == int_list.end) return true;
if (i % l.ref->v == 0) return false;
@@ -59,9 +59,9 @@ namespace Factor {
return l;
}
- int[*] function list_to_array (int_list l)
+ int[*] list_to_array (int_list l)
{
- int function list_length (int_list l)
+ int list_length (int_list l)
{
return l != int_list.end ? 1+list_length(l.ref->next) : 0;
}
@@ -82,9 +82,9 @@ namespace Factor {
void none;
} array_or_none;
- public array_or_none function factor (int i)
+ public array_or_none factor (int i)
{
- array_or_none function array_append (array_or_none a, int v)
+ array_or_none array_append (array_or_none a, int v)
{
union switch (a) {
case array:
@@ -105,7 +105,7 @@ namespace Factor {
array_or_none result = array_or_none.none;
- int function one_factor (int i)
+ int one_factor (int i)
{
if (i == 1) return 1;
if ((i & 1) == 0) return 2;
diff --git a/examples/randtest.5c b/examples/randtest.5c
index 5b68c9f..cdb8213 100644
--- a/examples/randtest.5c
+++ b/examples/randtest.5c
@@ -10,7 +10,7 @@
autoimport PRNG;
-int[*] function t(int n) {
+int[*] t(int n) {
int[2] s = {0, 0};
int i;
for (i = 0; i < n; i++)
diff --git a/examples/restart.5c b/examples/restart.5c
index ddaca16..f793df0 100644
--- a/examples/restart.5c
+++ b/examples/restart.5c
@@ -12,7 +12,7 @@
exception div0_attempt(continuation c);
-rational function f(int x) {
+rational f(int x) {
continuation c;
int y;
if ((y = setjmp(&c, 0)) != 0) {
@@ -28,7 +28,7 @@ rational function f(int x) {
return 1 / x;
}
-rational function protected_f(int x) {
+rational protected_f(int x) {
try {
return f(x);
} catch div0_attempt(c) {
diff --git a/examples/rijndael.5c b/examples/rijndael.5c
index 09526d9..ed57e18 100644
--- a/examples/rijndael.5c
+++ b/examples/rijndael.5c
@@ -172,7 +172,7 @@ public namespace Rijndael {
namespace algorithm {
- int function SC (int BC)
+ int SC (int BC)
{
return ((BC - 4) >> 1);
};
@@ -183,7 +183,7 @@ public namespace Rijndael {
{ { 0, 0 }, { 1, 7 }, { 3, 5 }, { 4, 4 } }
};
- int function mul(int a, int b)
+ int mul(int a, int b)
{
/* multiply two elements of GF(2^m)
* needed for MixColumn and InvMixColumn
@@ -194,7 +194,7 @@ public namespace Rijndael {
return 0;
}
- void function KeyAddition(*int[*,*] a,
+ void KeyAddition(*int[*,*] a,
*int[*,*,*] rk,
int r,
int BC)
@@ -208,7 +208,7 @@ public namespace Rijndael {
a*[i,j] ^= rk*[r,i,j];
}
- void function ShiftRow(*int[*,*] a,
+ void ShiftRow(*int[*,*] a,
int d,
int BC)
{
@@ -227,7 +227,7 @@ public namespace Rijndael {
}
}
- void function Substitution(*int[*,*] a,
+ void Substitution(*int[*,*] a,
*int[*] box,
int BC)
{
@@ -241,7 +241,7 @@ public namespace Rijndael {
a*[i,j] = box*[a*[i,j]];
}
- void function MixColumn(*int[*,*] a,
+ void MixColumn(*int[*,*] a,
int BC)
{
/* Mix the four bytes of every column in a linear way
@@ -260,7 +260,7 @@ public namespace Rijndael {
a*[i,j] = b[i,j];
}
- void function InvMixColumn(*int[*,*] a,
+ void InvMixColumn(*int[*,*] a,
int BC)
{
/* Mix the four bytes of every column in a linear way
@@ -280,7 +280,7 @@ public namespace Rijndael {
a*[i,j] = b[i,j];
}
- public int function rijndaelKeySched (int[*,*] k,
+ public int rijndaelKeySched (int[*,*] k,
int keyBits,
int blockBits,
*int[*,*,*] W)
@@ -354,7 +354,7 @@ public namespace Rijndael {
return 0;
}
- public void function rijndaelEncrypt (*int[*,*] a,
+ public void rijndaelEncrypt (*int[*,*] a,
int keyBits,
int blockBits,
*int[*,*,*] rk)
@@ -399,7 +399,7 @@ public namespace Rijndael {
}
- public void function rijndaelEncryptRound (*int[*,*] a,
+ public void rijndaelEncryptRound (*int[*,*] a,
int keyBits,
int blockBits,
*int[*,*,*] rk,
@@ -449,7 +449,7 @@ public namespace Rijndael {
}
}
- public void function rijndaelDecrypt (*int[*,*] a,
+ public void rijndaelDecrypt (*int[*,*] a,
int keyBits,
int blockBits,
*int[*,*,*] rk)
@@ -508,7 +508,7 @@ public namespace Rijndael {
* of decryption correspond with the intermediate values
* of encryption.
*/
- public void function rijndaelDecryptRound (*int[*,*] a,
+ public void rijndaelDecryptRound (*int[*,*] a,
int keyBits,
int blockBits,
*int[*,*,*] rk,
@@ -563,7 +563,7 @@ public namespace Rijndael {
import algorithm;
- public int function makeKey (*keyInstance key,
+ public int makeKey (*keyInstance key,
int direction,
int keyLen,
string keyMaterial)
@@ -613,7 +613,7 @@ public namespace Rijndael {
public exception bad_cipher_mode (int mode);
public exception bad_cipher_instance (string t);
- public int function cipherInit (*cipherInstance cipher,
+ public int cipherInit (*cipherInstance cipher,
int mode,
string IV)
{
@@ -659,7 +659,7 @@ public namespace Rijndael {
public exception bad_cipher_state (*cipherInstance cipher);
- public int function blockEncrypt (*cipherInstance cipher,
+ public int blockEncrypt (*cipherInstance cipher,
*keyInstance key,
*int[*] input,
int inputLen,
@@ -735,7 +735,7 @@ public namespace Rijndael {
return numBlocks*cipher->blockLen;
}
- public int function blockDecrypt (*cipherInstance cipher,
+ public int blockDecrypt (*cipherInstance cipher,
*keyInstance key,
*int[*] input,
int inputLen,
@@ -843,7 +843,7 @@ public namespace Rijndael {
* BAD_CIPHER_STATE - cipher in bad state (e.g., not initialized)
*/
- public int function cipherUpdateRounds (*cipherInstance cipher,
+ public int cipherUpdateRounds (*cipherInstance cipher,
*keyInstance key,
*int[*] input,
int inputLen,
@@ -888,7 +888,7 @@ public namespace Rijndael {
return TRUE;
}
- public int[*] function string_to_array (string s, *cipherInstance cipher)
+ public int[*] string_to_array (string s, *cipherInstance cipher)
{
int blockLen = cipher->blockLen // 8;
int len = (ceil (String::length (s) / blockLen) * blockLen);
@@ -903,7 +903,7 @@ public namespace Rijndael {
return a;
}
- public string function array_to_string (int[*] a)
+ public string array_to_string (int[*] a)
{
string s = "";
int i;
@@ -916,7 +916,7 @@ public namespace Rijndael {
import Rijndael;
-void function main ()
+void main ()
{
string secret = "000102030405060708090a0b0c0d0e0f";
string original = "Hello, world.";
diff --git a/examples/roman.5c b/examples/roman.5c
index 5a15197..8d4adbd 100644
--- a/examples/roman.5c
+++ b/examples/roman.5c
@@ -10,7 +10,7 @@
* capabilities of the language.
*/
-string function roman (int i)
+string roman (int i)
{
if (i < 0)
return "-" + roman (-i);
@@ -26,9 +26,9 @@ string function roman (int i)
(digit) { .ones = "I", .five = "V", .tens = "X", .base = 1 }
};
- string function place (int i, digit dig)
+ string place (int i, digit dig)
{
- string function lots (int i, string s)
+ string lots (int i, string s)
{
if (i != 0)
return s + lots (i-1,s);
diff --git a/examples/rsa.5c b/examples/rsa.5c
index 8522f57..7520b18 100644
--- a/examples/rsa.5c
+++ b/examples/rsa.5c
@@ -35,11 +35,11 @@ namespace RSA {
global int n; /* public key */
global int d = 0; /* decryption exponent (0 for encrypt-only) */
- public int function encrypt(int m) {
+ public int encrypt(int m) {
return bigpowmod(m, e, n);
}
- public int function decrypt(int c) {
+ public int decrypt(int c) {
exception decrypt_public_key();
if (d == 0)
@@ -47,7 +47,7 @@ namespace RSA {
return bigpowmod(c, d, n);
}
- public void function set_private_key(int p, int q, int e0) {
+ public void set_private_key(int p, int q, int e0) {
int phi = (p - 1) * (q - 1);
n = p * q;
@@ -59,7 +59,7 @@ namespace RSA {
d = zminv(e, phi);
}
- public void function set_public_key(int n0, int e0) {
+ public void set_public_key(int n0, int e0) {
n = n0;
e = e0;
d = 0;
diff --git a/examples/sort.5c b/examples/sort.5c
index c8e9c52..dfc3e8d 100644
--- a/examples/sort.5c
+++ b/examples/sort.5c
@@ -12,21 +12,17 @@ namespace Sort {
/*
* Quicksort with random pivot
*/
- public void function qsort (&poly[*] a, bool(poly, poly) gt)
+ public void qsort (&poly[*] a, bool(poly, poly) gt)
{
- void function quicksort (int p, int r)
- {
- if (p < r)
- {
+ void quicksort (int p, int r) {
+ if (p < r) {
/* swap two array elements */
- void function exchange (int i, int j)
- {
+ void exchange (int i, int j) {
poly t = a[i]; a[i] = a[j]; a[j] = t;
}
/* partition the array into two pieces and return the pivot */
- int function partition (int p, int r)
- {
+ int partition (int p, int r) {
/* select a random element to pivot */
int pivot = p + PRNG::randint(p-r);
exchange (pivot, r);
@@ -57,14 +53,13 @@ namespace Sort {
/*
* Mergesort
*/
- public void function mergesort (&poly[*] a, bool(poly, poly) gt)
+ public void mergesort (&poly[*] a, bool(poly, poly) gt)
{
- void function msort (int p, int r)
- {
+ void msort (int p, int r) {
if (p < r)
{
/* merge two sorted lists together */
- void function merge (int p, int q, int r)
+ void merge (int p, int q, int r)
{
/* temporary storage for left half of array */
int n1 = q - p + 1;
@@ -97,6 +92,6 @@ namespace Sort {
msort (0, dim(a)-1);
}
- protected int[*] function randomints (int n, int max) =
+ protected int[*] randomints (int n, int max) =
(int[n]) { [i] = PRNG::randint(max) };
}
commit 3e6fed4d93df52b6593af4b93d320a7bac683c51
Author: Keith Packard <keithp at keithp.com>
Date: Mon Feb 11 08:29:26 2008 -0800
Raise io_eof exception when reading past EOF.
Instead of returning -1, raise an exception so that applications don't end
up spinning at EOF. Applications should check for File::end before reading
or catch the exception.
diff --git a/builtin-file.c b/builtin-file.c
index 5e83928..20edd6c 100644
--- a/builtin-file.c
+++ b/builtin-file.c
@@ -515,6 +515,9 @@ do_File_getc (Value f)
FileGetErrorMessage (f->file.input_errno),
FileGetError (f->file.input_errno), f);
RETURN (Void);
+ case FileEOF:
+ RaiseStandardException (exception_io_eof, 1, f);
+ RETURN (Void);
default:
complete = True;
RETURN (NewInt (c));
commit 2d56ac7537216e699a24fa7127e6c3fa18e80ea7
Author: Keith Packard <keithp at keithp.com>
Date: Mon Feb 11 08:28:13 2008 -0800
Remove first string arg from RaiseStandardException.
Every standard exception was required to have a string for the first
argument, which isn't always desired. Eliminating this forced first argument
allows each exception to have the desired arguments.
diff --git a/box.c b/box.c
index 768a23d..3d7d909 100644
--- a/box.c
+++ b/box.c
@@ -70,8 +70,7 @@ BoxValue (BoxPtr box, int e)
{
if (!BoxElements(box)[e].value)
{
- RaiseStandardException (exception_uninitialized_value,
- "Uninitialized value", 0);
+ RaiseStandardException (exception_uninitialized_value, 0);
return (Void);
}
return (BoxElements(box)[e].value);
@@ -126,9 +125,8 @@ BoxRewrite (BoxPtr box, int *ep)
*/
if (e >= box->nvalues)
{
- RaiseStandardException (exception_invalid_array_bounds,
- "Rewriting reference beyond box bounds",
- 1, NewInt (e));
+ RaiseStandardException (exception_invalid_array_bounds, 2,
+ Void, NewInt (e));
e = 0;
box = NewBox (True, False, 1, typePrim[rep_void]);
BoxValueSet (box, 0, 0);
diff --git a/builtin-bsdrandom.c b/builtin-bsdrandom.c
index fbb2ac1..957c08c 100644
--- a/builtin-bsdrandom.c
+++ b/builtin-bsdrandom.c
@@ -45,14 +45,13 @@ do_BSD_random (Value bits)
Value ret = Zero;
if (n > 31)
- RaiseStandardException (exception_invalid_argument,
- "random: modulus exceeds 2^31",
- 2,
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("random: modulus exceeds 2^31"),
NewInt (0), bits);
else if (n <= 0)
- RaiseStandardException (exception_invalid_argument,
- "random: bad modulus",
- 1, NewInt (0), bits);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("random: bad modulus"),
+ NewInt (0), bits);
else
ret = NewInt (random () & ((1 << n) - 1));
RETURN (ret);
diff --git a/builtin-command.c b/builtin-command.c
index 985cde2..1209e04 100644
--- a/builtin-command.c
+++ b/builtin-command.c
@@ -111,9 +111,9 @@ command_name (Value name)
if (isdigit ((int)c) || c == '_')
continue;
}
- RaiseStandardException (exception_invalid_argument,
- "argument must be valid name",
- 2, NewInt (0), name);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("argument must be valid name"),
+ NewInt (0), name);
return 0;
}
return cmd_base;
@@ -129,9 +129,9 @@ do_Command_new_common (Value name, Value func, Bool names)
RETURN (Void);
if (!ValueIsFunc(func))
{
- RaiseStandardException (exception_invalid_argument,
- "argument must be func",
- 2, NewInt (1), func);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("argument must be func"),
+ NewInt (1), func);
RETURN (Void);
}
CurrentCommands = NewCommand (CurrentCommands, AtomId (cmd),
diff --git a/builtin-environ.c b/builtin-environ.c
index e8b3593..a00d1f9 100644
--- a/builtin-environ.c
+++ b/builtin-environ.c
@@ -68,9 +68,9 @@ do_Environ_get (Value av)
RETURN (Void);
c = getenv (name);
if (!c) {
- RaiseStandardException (exception_invalid_argument,
- "name not available",
- 2, NewInt(0), av);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("name not available"),
+ NewInt(0), av);
RETURN (Void);
}
RETURN (NewStrString (c));
diff --git a/builtin-file.c b/builtin-file.c
index f5751f1..5e83928 100644
--- a/builtin-file.c
+++ b/builtin-file.c
@@ -207,6 +207,11 @@ import_File_namespace()
" 'message' is a printable error string.\n"
" 'error' is a symbolic error code.\n"
" 'name' is the filename which failed.\n" },
+ {"io_eof", exception_io_eof, "f", "\n"
+ " io_eof (file f)\n"
+ "\n"
+ " Raised when reading at end-of-file.\n"
+ " 'file' is the file at eof.\n" },
{0, 0 },
};
@@ -244,8 +249,9 @@ do_File_print (Value file, Value value, Value format,
return Void;
if (ibase < 0 || ibase == 1)
{
- RaiseStandardException (exception_invalid_argument,
- "Illegal base", 2, NewInt (0), base);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("Illegal base"),
+ NewInt (0), base);
return Void;
}
iwidth = IntPart (width, "Illegal width");
@@ -267,9 +273,10 @@ do_File_print (Value file, Value value, Value format,
fill->string.length, 0));
if (file->file.flags & FileOutputError)
{
- RaiseStandardException (exception_io_error,
+ RaiseStandardException (exception_io_error, 3,
FileGetErrorMessage (file->file.output_errno),
- 2, FileGetError (file->file.output_errno), file);
+ FileGetError (file->file.output_errno),
+ file);
}
}
return Void;
@@ -294,9 +301,10 @@ do_File_open (Value name, Value mode)
ret = FileFopen (n, m, &err);
if (!ret)
{
- RaiseStandardException (exception_open_error,
+ RaiseStandardException (exception_open_error, 3,
FileGetErrorMessage (err),
- 2, FileGetError (err), name);
+ FileGetError (err),
+ name);
RETURN (Void);
}
complete = True;
@@ -311,9 +319,9 @@ do_File_flush (Value f)
ThreadSleep (running, f, PriorityIo);
break;
case FileError:
- RaiseStandardException (exception_io_error,
+ RaiseStandardException (exception_io_error, 3,
FileGetErrorMessage (f->file.output_errno),
- 2, FileGetError (f->file.output_errno), f);
+ FileGetError (f->file.output_errno), f);
break;
}
return Void;
@@ -329,16 +337,16 @@ do_File_close (Value f)
ThreadSleep (running, f, PriorityIo);
break;
case FileError:
- RaiseStandardException (exception_io_error,
+ RaiseStandardException (exception_io_error, 3,
FileGetErrorMessage (f->file.output_errno),
- 2, FileGetError (f->file.output_errno), f);
+ FileGetError (f->file.output_errno), f);
break;
default:
if (FileClose (f) == FileError)
{
- RaiseStandardException (exception_io_error,
+ RaiseStandardException (exception_io_error, 3,
FileGetErrorMessage (f->file.output_errno),
- 2, FileGetError (f->file.output_errno), f);
+ FileGetError (f->file.output_errno), f);
}
else
complete = True;
@@ -377,9 +385,9 @@ do_File_filter (Value path, Value argv, Value filev)
ret = FileFilter (p, args, filev, &err);
if (!ret)
{
- RaiseStandardException (exception_open_error,
+ RaiseStandardException (exception_open_error, 3,
FileGetErrorMessage (err),
- 2, FileGetError (err), path);
+ FileGetError (err), path);
ret = Void;
}
complete = True;
@@ -396,9 +404,9 @@ Value do_File_mkpipe (void) {
ret = FileMakePipe (&err);
if (!ret)
{
- RaiseStandardException (exception_open_error,
+ RaiseStandardException (exception_open_error, 3,
FileGetErrorMessage (err),
- 2, FileGetError (err), Void);
+ FileGetError (err), Void);
RETURN (Void);
}
RETURN (ret);
@@ -423,9 +431,9 @@ do_File_reopen (Value name, Value mode, Value file)
ret = FileReopen (n, m, file, &err);
if (!ret)
{
- RaiseStandardException (exception_open_error,
+ RaiseStandardException (exception_open_error, 3,
FileGetErrorMessage (err),
- 2, FileGetError (err), name);
+ FileGetError (err), name);
RETURN (Void);
}
complete = True;
@@ -477,9 +485,9 @@ do_File_getb (Value f)
ThreadSleep (running, f, PriorityIo);
RETURN (Void);
case FileError:
- RaiseStandardException (exception_io_error,
+ RaiseStandardException (exception_io_error, 3,
FileGetErrorMessage (f->file.input_errno),
- 2, FileGetError (f->file.input_errno), f);
+ FileGetError (f->file.input_errno), f);
RETURN (Void);
default:
complete = True;
@@ -503,9 +511,9 @@ do_File_getc (Value f)
ThreadSleep (running, f, PriorityIo);
RETURN (Void);
case FileError:
- RaiseStandardException (exception_io_error,
+ RaiseStandardException (exception_io_error, 3,
FileGetErrorMessage (f->file.input_errno),
- 2, FileGetError (f->file.input_errno), f);
+ FileGetError (f->file.input_errno), f);
RETURN (Void);
default:
complete = True;
@@ -567,9 +575,10 @@ do_File_putb (Value v, Value f)
{
if (FileOutput (f, IntPart (v, "putb non integer")) == FileError)
{
- RaiseStandardException (exception_io_error,
+ RaiseStandardException (exception_io_error, 3,
FileGetErrorMessage (f->file.output_errno),
- 2, FileGetError (f->file.output_errno), f);
+ FileGetError (f->file.output_errno),
+ f);
}
else
complete = True;
@@ -591,9 +600,10 @@ do_File_putc (Value v, Value f)
{
if (FileOutchar (f, IntPart (v, "putc non integer")) == FileError)
{
- RaiseStandardException (exception_io_error,
+ RaiseStandardException (exception_io_error, 3,
FileGetErrorMessage (f->file.output_errno),
- 2, FileGetError (f->file.output_errno), f);
+ FileGetError (f->file.output_errno),
+ f);
}
else
complete = True;
@@ -658,9 +668,9 @@ do_File_unlink (Value name)
ret = unlink (n);
if (ret < 0) {
int err = errno;
- RaiseStandardException (exception_name_error,
+ RaiseStandardException (exception_name_error, 3,
FileGetErrorMessage (err),
- 2, FileGetError (err), name);
+ FileGetError (err), name);
RETURN (Void);
}
RETURN (Void);
@@ -682,9 +692,9 @@ do_File_rename (Value old, Value new)
ret = rename (o, n);
if (ret < 0) {
int err = errno;
- RaiseStandardException (exception_name_error,
+ RaiseStandardException (exception_name_error, 3,
FileGetErrorMessage (err),
- 2, FileGetError (err), new);
+ FileGetError (err), new);
RETURN (Void);
}
RETURN (Void);
@@ -707,9 +717,9 @@ do_File_mkdir (Value name, Value mode)
ret = mkdir (n, m);
if (ret < 0) {
int err = errno;
- RaiseStandardException (exception_name_error,
+ RaiseStandardException (exception_name_error, 3,
FileGetErrorMessage (err),
- 2, FileGetError (err), name);
+ FileGetError (err), name);
RETURN (Void);
}
RETURN (Void);
@@ -728,9 +738,9 @@ do_File_rmdir (Value name)
ret = rmdir (n);
if (ret < 0) {
int err = errno;
- RaiseStandardException (exception_name_error,
+ RaiseStandardException (exception_name_error, 3,
FileGetErrorMessage (err),
- 2, FileGetError (err), name);
+ FileGetError (err), name);
RETURN (Void);
}
RETURN (Void);
diff --git a/builtin-foreign.c b/builtin-foreign.c
index ede65d4..8570104 100644
--- a/builtin-foreign.c
+++ b/builtin-foreign.c
@@ -9,6 +9,7 @@
#include <ctype.h>
#include <strings.h>
#include <time.h>
+#include <errno.h>
#include "builtin.h"
NamespacePtr ForeignNamespace;
@@ -35,13 +36,16 @@ do_Foreign_load (Value av)
if (!lib)
{
char *err = 0;
+ int e = errno;
#if HAVE_DLERROR
err = dlerror ();
#endif
if (!err)
err = "cannot open";
- RaiseStandardException (exception_invalid_argument,
- err, 2, NewInt(0), av);
+ RaiseStandardException (exception_open_error, 3,
+ NewStrString (err),
+ NewInt(e),
+ av);
RETURN (Void);
}
@@ -54,8 +58,8 @@ do_Foreign_load (Value av)
#endif
if (!err)
err = "missing nickle_init";
- RaiseStandardException (exception_invalid_argument,
- err, 2, NewInt (0), av);
+ RaiseStandardException (exception_open_error, 3,
+ NewStrString (err), NewInt (0), av);
#if HAVE_DLCLOSE
dlclose (lib);
#endif
diff --git a/builtin-math.c b/builtin-math.c
index 3d0b559..5066474 100644
--- a/builtin-math.c
+++ b/builtin-math.c
@@ -94,16 +94,16 @@ Popcount (Value av)
if (!Integralp (ValueTag(av)))
{
- RaiseStandardException (exception_invalid_argument,
- "Math::popcount: not an integer",
- 2, av, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("Math::popcount: not an integer"),
+ av, Void);
RETURN (Void);
}
if (Negativep (av))
{
- RaiseStandardException (exception_invalid_argument,
- "Math::popcount: negative argument",
- 2, av, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("Math::popcount: negative argument"),
+ av, Void);
RETURN (Void);
}
switch (ValueTag(av)) {
@@ -133,9 +133,9 @@ Popcount (Value av)
ret = Plus (ret, NewInt (part));
break;
default:
- RaiseStandardException (exception_invalid_argument,
- "Math::popcount: not an integer",
- 2, av, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("Math::popcount: not an integer"),
+ av, Void);
RETURN (Void);
}
RETURN (ret);
diff --git a/builtin-process.c b/builtin-process.c
index 0a935ab..830facf 100644
--- a/builtin-process.c
+++ b/builtin-process.c
@@ -77,9 +77,9 @@ error (Value value)
{
int err = errno;
- RaiseStandardException (exception_system_error,
+ RaiseStandardException (exception_system_error, 3,
FileGetErrorMessage (err),
- 2, NewInt (err), value);
+ NewInt (err), value);
return Void;
}
diff --git a/builtin-sockets.c b/builtin-sockets.c
index 934d03a..e202a5b 100644
--- a/builtin-sockets.c
+++ b/builtin-sockets.c
@@ -24,13 +24,6 @@
#include "builtin.h"
#include <errno.h>
-#define perror(s) FilePrintf(FileStderr, s ": %s\n", FileGetErrorMessage(errno))
-#ifdef HAVE_HSTRERROR
-#define herror(s) FilePrintf(FileStderr, s ": %s\n", hstrerror(h_errno))
-#else
-#define herror(s) FilePrintf(FileStderr, s ": network error %d\n", h_errno);
-#endif
-
NamespacePtr SocketNamespace;
Type *typeSockaddr;
@@ -294,7 +287,6 @@ static Bool address_lookup_af_inet (int num, Value *args,
hostent = gethostbyname (hostchars);
if (hostent == 0)
{
- herror ("address_lookup");
return False; /* FIXME: more here? */
}
@@ -371,9 +363,9 @@ do_Socket_connect (int num, Value *args)
}
else
{
- RaiseStandardException (exception_io_error,
+ RaiseStandardException (exception_io_error, 3,
FileGetErrorMessage (err),
- 2, FileGetError (err),
+ FileGetError (err),
s);
RETURN (Void);
}
@@ -412,9 +404,9 @@ do_Socket_bind (int num, Value *args)
#endif
if (bind (s->file.fd, &addr.addr, len) == -1)
{
- RaiseStandardException (exception_io_error,
+ RaiseStandardException (exception_io_error, 3,
FileGetErrorMessage (errno),
- 2, FileGetError (errno),
+ FileGetError (errno),
s);
RETURN (Void);
}
@@ -463,9 +455,9 @@ do_Socket_accept (Value s)
}
else
{
- RaiseStandardException (exception_io_error,
+ RaiseStandardException (exception_io_error, 3,
FileGetErrorMessage (err),
- 2, FileGetError (err),
+ FileGetError (err),
s);
RETURN (Void);
}
@@ -510,9 +502,9 @@ do_Socket_gethostname (void)
if (gethostname (hostname, sizeof (hostname)) == -1)
{
- RaiseStandardException (exception_io_error,
+ RaiseStandardException (exception_io_error, 3,
FileGetErrorMessage (errno),
- 2, FileGetError (errno),
+ FileGetError (errno),
Void);
RETURN (Void);
}
@@ -532,9 +524,9 @@ do_Socket_getsockname (Value s)
if (getsockname (s->file.fd, (struct sockaddr *) &addr, &len) == -1)
{
- RaiseStandardException (exception_io_error,
+ RaiseStandardException (exception_io_error, 3,
FileGetErrorMessage (errno),
- 2, FileGetError (errno),
+ FileGetError (errno),
s);
RETURN (Void);
}
diff --git a/builtin-string.c b/builtin-string.c
index b2af623..e9bc54b 100644
--- a/builtin-string.c
+++ b/builtin-string.c
@@ -153,16 +153,16 @@ do_String_substr (Value av, Value bv, Value cv)
}
if (b < 0 || b > al)
{
- RaiseStandardException (exception_invalid_argument,
- "substr: index out of range",
- 2, NewInt (1), bv);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("substr: index out of range"),
+ NewInt (1), bv);
RETURN (av);
}
if (b + c > al)
{
- RaiseStandardException (exception_invalid_argument,
- "substr: count out of range",
- 2, NewInt (2), cv);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("substr: count out of range"),
+ NewInt (2), cv);
RETURN (av);
}
/*
diff --git a/builtin-toplevel.c b/builtin-toplevel.c
index 6ef745b..7a2236d 100644
--- a/builtin-toplevel.c
+++ b/builtin-toplevel.c
@@ -278,9 +278,8 @@ do_string_to_integer (int n, Value *p)
base = p[1];
break;
default:
- RaiseStandardException (exception_invalid_argument,
- "string_to_integer: wrong number of arguments",
- 2,
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("string_to_integer: wrong number of arguments"),
NewInt (2),
NewInt (n));
RETURN(Void);
@@ -361,9 +360,9 @@ do_imprecise (int n, Value *p)
prec = IntPart (p[1], "imprecise: invalid precision");
if (prec <= 0)
{
- RaiseStandardException (exception_invalid_argument,
- "imprecise: precision must be positive",
- 2, NewInt(0), p[1]);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("imprecise: precision must be positive"),
+ NewInt(0), p[1]);
RETURN(v);
}
}
@@ -398,9 +397,9 @@ do_func_args (Value a)
ENTER ();
if (!ValueIsFunc (a))
{
- RaiseStandardException (exception_invalid_argument,
- "func_args: argument must be function",
- 2, NewInt (0), a);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("func_args: argument must be function"),
+ NewInt (0), a);
RETURN (Void);
}
RETURN (NewInt (a->func.code->base.argc));
@@ -434,9 +433,9 @@ do_dim(Value av)
Value ret;
if (av->array.ndim != 1)
{
- RaiseStandardException (exception_invalid_argument,
- "dim: argument must be one-dimensional array",
- 2, NewInt (0), av);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("dim: argument must be one-dimensional array"),
+ NewInt (0), av);
RETURN (Void);
}
ret = NewInt(ArrayLimits(&av->array)[0]);
@@ -472,16 +471,16 @@ do_setdims (Value av, Value dv)
if (a->ndim != ArrayNvalues(d))
{
- RaiseStandardException (exception_invalid_argument,
- "setdims: size of dimensions must match dimensionality of array",
- 2, NewInt (a->ndim), dv);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("setdims: size of dimensions must match dimensionality of array"),
+ NewInt (a->ndim), dv);
RETURN (Void);
}
if (!av->array.resizable)
{
- RaiseStandardException (exception_invalid_argument,
- "setdims: array must be resizable",
- 1, av, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("setdims: array must be resizable"),
+ av, Void);
RETURN (Void);
}
for (i = 0; i < a->ndim; i++)
@@ -492,9 +491,9 @@ do_setdims (Value av, Value dv)
RETURN (Void);
if (dims[j] < 0)
{
- RaiseStandardException (exception_invalid_argument,
- "setdims: dimensions must be non-negative",
- 2, NewInt (i), NewInt (dims[j]));
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("setdims: dimensions must be non-negative"),
+ NewInt (i), NewInt (dims[j]));
RETURN (Void);
}
}
@@ -511,16 +510,16 @@ do_setdim (Value av, Value dv)
RETURN (Void);
if (d < 0)
{
- RaiseStandardException (exception_invalid_argument,
- "setdim: dimension must be non-negative",
- 2, dv, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("setdim: dimension must be non-negative"),
+ dv, Void);
RETURN (Void);
}
if (!av->array.resizable)
{
- RaiseStandardException (exception_invalid_argument,
- "setdim: array must be resizable",
- 1, av, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("setdim: array must be resizable"),
+ av, Void);
RETURN (Void);
}
ArrayResize (av, 0, d);
@@ -573,9 +572,9 @@ do_exponent (Value av)
if (!ValueIsFloat(av))
{
- RaiseStandardException (exception_invalid_argument,
- "exponent: argument must be imprecise",
- 2, NewInt (0), av);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("exponent: argument must be imprecise"),
+ NewInt (0), av);
RETURN (Void);
}
ret = NewInteger (av->floats.exp->sign, av->floats.exp->mag);
@@ -591,9 +590,9 @@ do_mantissa (Value av)
if (!ValueIsFloat(av))
{
- RaiseStandardException (exception_invalid_argument,
- "mantissa: argument must be imprecise",
- 2, NewInt (0), av);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("mantissa: argument must be imprecise"),
+ NewInt (0), av);
RETURN (Void);
}
ret = NewInteger (av->floats.mant->sign, av->floats.mant->mag);
@@ -614,9 +613,9 @@ do_numerator (Value av)
av = NewInteger (av->rational.sign, av->rational.num);
break;
default:
- RaiseStandardException (exception_invalid_argument,
- "numerator: argument must be precise",
- 2, NewInt (0), av);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("numerator: argument must be precise"),
+ NewInt (0), av);
av = Void;
break;
}
@@ -636,9 +635,9 @@ do_denominator (Value av)
av = NewInteger (Positive, av->rational.den);
break;
default:
- RaiseStandardException (exception_invalid_argument,
- "denominator: argument must be precise",
- 2, NewInt (0), av);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("denominator: argument must be precise"),
+ NewInt (0), av);
av = Void;
break;
}
@@ -657,9 +656,9 @@ do_bit_width (Value av)
av = NewInt (NaturalWidth (IntegerMag(av)));
break;
default:
- RaiseStandardException (exception_invalid_argument,
- "bit_width: argument must be integer",
- 2, NewInt (0), av);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("bit_width: argument must be integer"),
+ NewInt (0), av);
av = Void;
break;
}
@@ -827,9 +826,9 @@ do_is_uninit (Value av)
{
ENTER ();
if (!av) {
- RaiseStandardException (exception_invalid_argument,
- "do_is_uninit: invalid reference",
- 2, NewInt (0), av);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("do_is_uninit: invalid reference"),
+ NewInt (0), av);
av = Void;
} else if (RefValueGet(av)) {
av = FalseVal;
@@ -844,9 +843,9 @@ do_make_uninit (Value av)
{
ENTER ();
if (!av) {
- RaiseStandardException (exception_invalid_argument,
- "do_make_uninit: invalid reference",
- 2, NewInt (0), av);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("do_make_uninit: invalid reference"),
+ NewInt (0), av);
} else {
RefValueSet(av, 0);
}
diff --git a/builtin.c b/builtin.c
index 40bc238..838485b 100644
--- a/builtin.c
+++ b/builtin.c
@@ -78,8 +78,8 @@ static const struct ebuiltin excepts[] = {
"\n"
" Division or modulus by zero.\n"
" 'message' indicates the error context.\n" },
- {"invalid_struct_member", exception_invalid_struct_member,"sps", "\n"
- " invalid_struct_member (string message, poly struct, string member)\n"
+ {"invalid_struct_member", exception_invalid_struct_member,"ps", "\n"
+ " invalid_struct_member (poly value, string member)\n"
"\n"
" 'member' is not in 'value'.\n" },
{"invalid_binop_values", exception_invalid_binop_values, "spp",
diff --git a/debug.c b/debug.c
index ebd8b48..966ed4d 100644
--- a/debug.c
+++ b/debug.c
@@ -186,9 +186,8 @@ do_Debug_dump (Value f)
if (!ValueIsFunc (f))
{
- RaiseStandardException (exception_invalid_argument,
- "dump: not a function",
- 1,
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("dump: not a function"),
NewInt (0), f);
RETURN (Void);
}
diff --git a/examples/smlng/parse.5c b/examples/smlng/parse.5c
index 584e981..c8422e9 100644
--- a/examples/smlng/parse.5c
+++ b/examples/smlng/parse.5c
@@ -27,6 +27,9 @@ public namespace Lexc {
{
char ch;
+ if (File::end (in))
+ return (char) { c = 0, id = Eof };
+
ch.c = File::getc (in);
printf ("got %d\n", ch.c);
if (ch.c == '<')
diff --git a/execute.c b/execute.c
index fde8ef0..480017d 100644
--- a/execute.c
+++ b/execute.c
@@ -100,9 +100,9 @@ ThreadCall (Value thread, Bool tail, InstPtr *next, int *stack)
if (!ValueIsInt (numvar))
{
- RaiseStandardException (exception_invalid_argument,
- "Incompatible argument",
- 2, NewInt(-1), Arg(0));
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("Incompatible argument"),
+ NewInt(-1), Arg(0));
RETURN (Void);
}
argc = -argc - 1 + ValueInt(numvar);
@@ -115,9 +115,7 @@ ThreadCall (Value thread, Bool tail, InstPtr *next, int *stack)
if (!ValueIsFunc(func))
{
ThreadStackDump (thread);
- RaiseStandardException (exception_invalid_unop_value,
- "Not a function",
- 1, func);
+ RaiseStandardException (exception_invalid_unop_value, 1, func);
RETURN (Void);
}
code = func->func.code;
@@ -126,23 +124,23 @@ ThreadCall (Value thread, Bool tail, InstPtr *next, int *stack)
{
if (!argt)
{
- RaiseStandardException (exception_invalid_argument,
- "Too many parameters",
- 2, NewInt (argc), NewInt(code->base.argc));
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("Too many arguments"),
+ NewInt (argc), NewInt(code->base.argc));
RETURN (Void);
}
if (fe == argc)
{
- RaiseStandardException (exception_invalid_argument,
- "Too few arguments",
- 2, NewInt (argc), NewInt(code->base.argc));
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("Too few arguments"),
+ NewInt (argc), NewInt(code->base.argc));
RETURN (Void);
}
if (!TypeCompatibleAssign (argt->type, Arg(fe)))
{
- RaiseStandardException (exception_invalid_argument,
- "Incompatible argument",
- 2, NewInt (fe), Arg(fe));
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("Incompatible argument"),
+ NewInt (fe), Arg(fe));
RETURN (Void);
}
fe++;
@@ -277,28 +275,17 @@ ThreadAssign (Value ref, Value v, Bool initialize)
{
ENTER ();
if (!ValueIsRef (ref))
- {
- RaiseStandardException (exception_invalid_binop_values,
- "Attempted store through non reference",
- 2, ref, v);
- }
+ RaiseStandardException (exception_invalid_binop_values, 2, ref, v);
else if (RefConstant(ref) && !initialize)
- {
- RaiseStandardException (exception_readonly_box,
- "Attempted assignment to constant box",
- 1, v);
- }
+ RaiseStandardException (exception_readonly_box, 1, v);
else if (ref->ref.element >= ref->ref.box->nvalues)
- {
RaiseStandardException (exception_invalid_array_bounds,
- "Attempted assignment beyond box bounds",
2, NewInt(ref->ref.element), v);
- }
else if (!TypeCompatibleAssign (RefType (ref), v))
{
- RaiseStandardException (exception_invalid_argument,
- "Incompatible types in assignment",
- 2, NewInt(ref->ref.element), v);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("Incompatible types in assignment"),
+ NewInt(ref->ref.element), v);
}
else
{
@@ -327,9 +314,9 @@ ThreadArray (Value thread, Bool resizable, int ndim, Type *type)
Value d = Stack(i);
dims[i] = IntPart (d, "Invalid array dimension");
if (dims[i] < 0)
- RaiseStandardException (exception_invalid_argument,
- "Negative array dimension",
- 2, NewInt (0), d);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("Negative array dimension"),
+ NewInt (0), d);
if (aborting)
RETURN (0);
}
@@ -351,9 +338,9 @@ ThreadArrayInd (Value thread, Bool resizable, Value dim, Type *type)
Value d = ArrayValue (a, i);
dims[i] = IntPart (d, "Invalid array dimension");
if (dims[i] < 0)
- RaiseStandardException (exception_invalid_argument,
- "Negative array dimension",
- 2, NewInt (0), d);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("Negative array dimension"),
+ NewInt (0), d);
if (aborting)
RETURN (0);
}
@@ -380,9 +367,9 @@ ThreadArrayIndex (Value array, Value thread, int ndim,
d = Stack(dim + off - 1);
if (!ValueIsInt(d) || (part = ValueInt(d)) < 0)
{
- RaiseStandardException (exception_invalid_argument,
- "Array index not non-negative integer",
- 2, array, d);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("Array index not non-negative integer"),
+ array, d);
return 0;
}
if (limits[dim] <= part)
@@ -396,9 +383,8 @@ ThreadArrayIndex (Value array, Value thread, int ndim,
}
else if (except)
{
- RaiseStandardException (exception_invalid_array_bounds,
- "Array index out of bounds",
- 2, array, d);
+ RaiseStandardException (exception_invalid_array_bounds, 2,
+ array, d);
return 0;
}
}
@@ -497,9 +483,9 @@ ThreadArrayInit (Value thread, Value value, AInitMode mode,
{
if (!TypeCompatibleAssign (ArrayType(&array->array), value))
{
- RaiseStandardException (exception_invalid_argument,
- "Incompatible types in array initialization",
- 2, array, value);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("Incompatible types in array initialization"),
+ array, value);
break;
}
i = ThreadArrayIndex (array, thread, ndim, Stack(1), 2, True, False);
@@ -670,9 +656,9 @@ ThreadExceptionCall (Value thread, InstPtr *next, int *stack)
args = Stack(0);
if (!ValueIsArray (args))
{
- RaiseStandardException (exception_invalid_argument,
- "exception call argument must be array",
- 1, args);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("exception call argument must be array"),
+ NewInt (0), args);
*stack = 1;
RETURN (Void);
}
@@ -801,16 +787,13 @@ ThreadOpArray (Value thread, Value value, int stack, Bool fetch, Bool typeCheck)
case rep_string:
if (!fetch)
{
- RaiseStandardException (exception_invalid_unop_value,
- "Strings aren't addressable",
- 1, value);
+ RaiseStandardException (exception_invalid_binop_values, 2, v, value);
break;
}
if (stack != 1)
{
- RaiseStandardException (exception_invalid_binop_values,
- "Strings have only 1 dimension",
- 2, NewInt (stack), v);
+ RaiseStandardException (exception_invalid_binop_values, 2,
+ NewInt (stack), v);
break;
}
i = IntPart (value, "Invalid string index");
@@ -819,9 +802,8 @@ ThreadOpArray (Value thread, Value value, int stack, Bool fetch, Bool typeCheck)
s = StringChars (&v->string);
if (i < 0 || StringLength (s, v->string.length) <= i)
{
- RaiseStandardException (exception_invalid_binop_values,
- "String index out of bounds",
- 2, value, v);
+ RaiseStandardException (exception_invalid_binop_values, 2,
+ v, value);
break;
}
value = NewInt (StringGet (s, v->string.length, i));
@@ -829,9 +811,8 @@ ThreadOpArray (Value thread, Value value, int stack, Bool fetch, Bool typeCheck)
case rep_array:
if (stack != v->array.ndim)
{
- RaiseStandardException (exception_invalid_binop_values,
- "Mismatching dimensionality",
- 2, NewInt (stack), v);
+ RaiseStandardException (exception_invalid_binop_values, 2,
+ NewInt (stack), v);
break;
}
i = ThreadArrayIndex (v, thread, stack, value, 0, True, !fetch);
@@ -850,9 +831,8 @@ ThreadOpArray (Value thread, Value value, int stack, Bool fetch, Bool typeCheck)
case rep_hash:
if (stack != 1)
{
- RaiseStandardException (exception_invalid_binop_values,
- "Hashes have only one dimension",
- 2, NewInt (stack), v);
+ RaiseStandardException (exception_invalid_binop_values, 2,
+ NewInt (stack), v);
break;
}
if (fetch)
@@ -861,9 +841,7 @@ ThreadOpArray (Value thread, Value value, int stack, Bool fetch, Bool typeCheck)
value = HashRef (v, value);
break;
default:
- RaiseStandardException (exception_invalid_unop_value,
- "Not an array",
- 1, value);
+ RaiseStandardException (exception_invalid_unop_value, 1, v);
break;
}
return value;
@@ -876,9 +854,7 @@ ThreadOpDot (Value thread, Value value, Atom atom, Bool fetch)
switch (ValueTag(value)) {
default:
- RaiseStandardException (exception_invalid_unop_value,
- "Not a struct/union",
- 1, value);
+ RaiseStandardException (exception_invalid_unop_value, 1, value);
break;
case rep_struct:
if (fetch)
@@ -887,10 +863,8 @@ ThreadOpDot (Value thread, Value value, Atom atom, Bool fetch)
v = StructMemRef (value, atom);
if (!v)
{
- RaiseStandardException (exception_invalid_struct_member,
- "no such struct member",
- 2, value,
- NewStrString (AtomName (atom)));
+ RaiseStandardException (exception_invalid_struct_member, 2,
+ value, NewStrString (AtomName (atom)));
break;
}
value = v;
@@ -903,15 +877,11 @@ ThreadOpDot (Value thread, Value value, Atom atom, Bool fetch)
if (!v)
{
if (StructMemType (value->unions.type, atom))
- RaiseStandardException (exception_invalid_struct_member,
- "requested union tag not current",
- 2, value,
- NewStrString (AtomName (atom)));
+ RaiseStandardException (exception_invalid_struct_member, 2,
+ value, NewStrString (AtomName (atom)));
else
- RaiseStandardException (exception_invalid_struct_member,
- "no such union tag",
- 2, value,
- NewStrString (AtomName (atom)));
+ RaiseStandardException (exception_invalid_struct_member, 2,
+ value, NewStrString (AtomName (atom)));
break;
}
value = v;
@@ -1028,9 +998,9 @@ ThreadsRun (Value thread, Value lex)
case OpBranchFalse:
if (!ValueIsBool(value))
{
- RaiseStandardException (exception_invalid_argument,
- "conditional expression not bool",
- 2, value, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("conditional expression not bool"),
+ value, Void);
break;
}
if (!True (value))
@@ -1039,9 +1009,9 @@ ThreadsRun (Value thread, Value lex)
case OpBranchTrue:
if (!ValueIsBool(value))
{
- RaiseStandardException (exception_invalid_argument,
- "conditional expression not bool",
- 2, value, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("conditional expression not bool"),
+ value, Void);
break;
}
if (True (value))
@@ -1062,9 +1032,9 @@ ThreadsRun (Value thread, Value lex)
case OpTagCase:
if (!ValueIsUnion(value))
{
- RaiseStandardException (exception_invalid_argument,
- "union switch expression not union",
- 2, value, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("union switch expression not union"),
+ value, Void);
break;
}
if (value->unions.tag == inst->tagcase.tag)
@@ -1074,15 +1044,11 @@ ThreadsRun (Value thread, Value lex)
if (!v)
{
if (StructMemType (value->unions.type, inst->atom.atom))
- RaiseStandardException (exception_invalid_struct_member,
- "requested union tag not current",
- 2, value,
- NewStrString (AtomName (inst->atom.atom)));
+ RaiseStandardException (exception_invalid_struct_member, 2,
+ value, NewStrString (AtomName (inst->atom.atom)));
else
- RaiseStandardException (exception_invalid_struct_member,
- "no such union tag",
- 2, value,
- NewStrString (AtomName (inst->atom.atom)));
+ RaiseStandardException (exception_invalid_struct_member, 2,
+ value, NewStrString (AtomName (inst->atom.atom)));
break;
}
value = v;
@@ -1103,17 +1069,17 @@ ThreadsRun (Value thread, Value lex)
case OpReturn:
if (!thread->thread.continuation.frame)
{
- RaiseStandardException (exception_invalid_argument,
- "return outside of function",
- 2, Void, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("return outside of function"),
+ Void, Void);
break;
}
if (!TypeCompatibleAssign (thread->thread.continuation.frame->function->func.code->base.type,
value))
{
- RaiseStandardException (exception_invalid_argument,
- "Incompatible type in return",
- 2, value, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("Incompatible type in return"),
+ value, Void);
break;
}
if (aborting)
@@ -1206,10 +1172,8 @@ ThreadsRun (Value thread, Value lex)
v = StructMemRef (w, inst->atom.atom);
if (!v)
{
- RaiseStandardException (exception_invalid_struct_member,
- "Invalid struct member",
- 2, v,
- NewStrString (AtomName (inst->atom.atom)));
+ RaiseStandardException (exception_invalid_struct_member, 2,
+ v, NewStrString (AtomName (inst->atom.atom)));
break;
}
ThreadAssign (v, value, True);
@@ -1222,10 +1186,8 @@ ThreadsRun (Value thread, Value lex)
v = UnionRef (value, inst->atom.atom);
if (!v)
{
- RaiseStandardException (exception_invalid_struct_member,
- "Invalid union member",
- 2, value,
- NewStrString (AtomName (inst->atom.atom)));
+ RaiseStandardException (exception_invalid_struct_member, 2,
+ value, NewStrString (AtomName (inst->atom.atom)));
break;
}
w = CStack(0); stack = 1;
@@ -1242,16 +1204,14 @@ ThreadsRun (Value thread, Value lex)
case OpVarActual:
if (!ValueIsArray(value))
{
- RaiseStandardException (exception_invalid_unop_value,
- "Not an array",
- 1, value);
+ RaiseStandardException (exception_invalid_unop_value, 1,
+ value);
break;
}
if (value->array.ndim != 1)
{
- RaiseStandardException (exception_invalid_unop_value,
- "Array not one dimension",
- 1, value);
+ RaiseStandardException (exception_invalid_unop_value, 1,
+ value);
break;
}
for (i = 0; i < ArrayLimits(&value->array)[0]; i++)
@@ -1279,9 +1239,8 @@ ThreadsRun (Value thread, Value lex)
case OpArrowRefStore:
if (!ValueIsRef(value))
{
- RaiseStandardException (exception_invalid_unop_value,
- "Not a reference",
- 1, value);
+ RaiseStandardException (exception_invalid_unop_value, 1,
+ value);
break;
}
value = RefValue (value);
@@ -1302,9 +1261,9 @@ ThreadsRun (Value thread, Value lex)
case OpStaticDone:
if (!thread->thread.continuation.frame)
{
- RaiseStandardException (exception_invalid_argument,
- "StaticInitDone outside of function",
- 2, Void, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("StaticInitDone outside of function"),
+ Void, Void);
break;
}
if (aborting)
diff --git a/file.c b/file.c
index 64b7c41..aede4b1 100644
--- a/file.c
+++ b/file.c
@@ -528,14 +528,14 @@ FileGetError (int err)
RETURN (ret);
}
-char *
+Value
FileGetErrorMessage (int err)
{
int i;
for (i = 0; i < NUM_FILE_ERRORS; i++)
if (fileErrorMap[i].value == err)
- return fileErrorMap[i].message;
- return "Unknown error";
+ return NewStrString (fileErrorMap[i].message);
+ return NewStrString ("Unknown error");
}
static void
@@ -718,9 +718,9 @@ FileReopen (char *name, char *mode, Value file, int *errp)
if (file->file.flags & FileString)
{
- RaiseStandardException (exception_invalid_argument,
- "Reopen: string file",
- 2, file, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("Reopen: string file"),
+ NewInt (0), file);
RETURN (Void);
}
@@ -789,21 +789,21 @@ FileFilter (char *program, char *args[], Value filev, int *errp)
for (i = 0; i < 3; i++) {
Value f = ArrayValue (&filev->array, i);
if (i == 0 && !(f->file.flags & FileReadable)) {
- RaiseStandardException (exception_invalid_argument,
- "File::filter: process input not readable",
- 2, f, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("File::filter: process input not readable"),
+ NewInt (i), f);
RETURN (Void);
}
if (i == 1 && !(f->file.flags & FileWritable)) {
- RaiseStandardException (exception_invalid_argument,
- "File::filter: process output not writable",
- 2, f, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("File::filter: process output not writable"),
+ NewInt (i), f);
RETURN (Void);
}
if (i == 2 && !(f->file.flags & FileWritable)) {
- RaiseStandardException (exception_invalid_argument,
- "File::filter: process error not writable",
- 2, f, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("File::filter: process error not writable"),
+ NewInt (i), f);
RETURN (Void);
}
fds[i] = f->file.fd;
@@ -924,9 +924,9 @@ FileStringString (Value file)
if (!(file->file.flags & FileString))
{
- RaiseStandardException (exception_invalid_argument,
- "string_string: not string file",
- 2, file, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("string_string: not string file"),
+ NewInt (0), file);
RETURN (Void);
}
len = 0;
diff --git a/float.c b/float.c
index 2b65ab8..ee8c1e1 100644
--- a/float.c
+++ b/float.c
@@ -379,9 +379,8 @@ FloatDivide (Value av, Value bv, int expandOk)
if (FpartZero (b->mant))
{
- RaiseStandardException (exception_divide_by_zero,
- "real divide by zero",
- 2, av, bv);
+ RaiseStandardException (exception_divide_by_zero, 2,
+ av, bv);
RETURN (Void);
}
DebugF ("Dividend ", a);
@@ -511,10 +510,7 @@ FloatInteger (Value av)
}
else
{
- RaiseStandardException (exception_invalid_unop_value,
- "ambiguous conversion to int",
- 1,
- av);
+ RaiseStandardException (exception_invalid_unop_value, 1, av);
}
RETURN (av);
}
@@ -1162,8 +1158,9 @@ DoublePart (Value av, char *error)
av = NewValueFloat (av, 64);
if (!ValueIsFloat (av))
{
- RaiseStandardException (exception_invalid_argument, error,
- 2, NewInt (0), av);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString (error),
+ NewInt (0), av);
return 0.0;
}
if (NaturalLess (av->floats.exp->mag, max_int_natural))
@@ -1175,8 +1172,9 @@ DoublePart (Value av, char *error)
if (av->floats.exp->sign == Negative)
return 0.0;
- RaiseStandardException (exception_invalid_argument, error,
- 2, NewInt (0), av);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString (error),
+ NewInt (0), av);
return 0.0;
}
if (av->floats.exp->sign == Negative)
diff --git a/hash.c b/hash.c
index 8a8dd3d..6f06c10 100644
--- a/hash.c
+++ b/hash.c
@@ -348,8 +348,7 @@ HashGet (Value hv, Value key)
{
if (!ht->def)
{
- RaiseStandardException (exception_uninitialized_value,
- "uninitialized hash element", 0);
+ RaiseStandardException (exception_uninitialized_value, 0);
return (Void);
}
if (ht->count >= ht->hashSet->entries &&
@@ -365,8 +364,7 @@ HashGet (Value hv, Value key)
value = HashEltValue (he);
if (!value)
{
- RaiseStandardException (exception_uninitialized_value,
- "uninitialized hash element", 0);
+ RaiseStandardException (exception_uninitialized_value, 0);
return (Void);
}
return value;
diff --git a/int.c b/int.c
index e1e1f19..5be10ab 100644
--- a/int.c
+++ b/int.c
@@ -75,9 +75,8 @@ IntDivide (Value av, Value bv, int expandOk)
if (b == 0)
{
- RaiseStandardException (exception_divide_by_zero,
- "int divide by zero",
- 2, av, bv);
+ RaiseStandardException (exception_divide_by_zero, 2,
+ av, bv);
RETURN (Void);
}
if (expandOk && a % b != 0)
@@ -97,9 +96,8 @@ IntDiv (Value av, Value bv, int expandOk)
if (b == 0)
{
- RaiseStandardException (exception_divide_by_zero,
- "int div by zero",
- 2, av, bv);
+ RaiseStandardException (exception_divide_by_zero, 2,
+ av, bv);
RETURN (Void);
}
switch (catagorize_signs (IntSign(a), IntSign(b))) {
@@ -141,9 +139,8 @@ IntMod (Value av, Value bv, int expandOk)
if (b == 0)
{
- RaiseStandardException (exception_divide_by_zero,
- "int modulus by zero",
- 2, av, bv);
+ RaiseStandardException (exception_divide_by_zero, 2,
+ av, bv);
RETURN (Void);
}
switch (catagorize_signs (IntSign(a), IntSign(b))) {
diff --git a/integer.c b/integer.c
index 266611e..5bd6ba3 100644
--- a/integer.c
+++ b/integer.c
@@ -113,9 +113,8 @@ IntegerDivide (Value av, Value bv, int expandOk)
if (NaturalZero (IMag(b)))
{
- RaiseStandardException (exception_divide_by_zero,
- "integer divide by zero",
- 2, av, bv);
+ RaiseStandardException (exception_divide_by_zero, 2,
+ av, bv);
RETURN (Void);
}
sign = Positive;
@@ -137,9 +136,8 @@ IntegerDiv (Value av, Value bv, int expandOk)
if (NaturalZero (IMag(b)))
{
- RaiseStandardException (exception_divide_by_zero,
- "integer div by zero",
- 2, av, bv);
+ RaiseStandardException (exception_divide_by_zero, 2,
+ av, bv);
RETURN (Void);
}
quo = NaturalDivide (IMag(a), IMag(b), &rem);
@@ -160,9 +158,8 @@ IntegerMod (Value av, Value bv, int expandOk)
if (NaturalZero (IMag(b)))
{
- RaiseStandardException (exception_divide_by_zero,
- "integer modulus by zero",
- 2, av, bv);
+ RaiseStandardException (exception_divide_by_zero, 2,
+ av, bv);
RETURN (Void);
}
quo = NaturalDivide (IMag(a), IMag(b), &rem);
diff --git a/nickle.h b/nickle.h
index 294cf46..7afb058 100644
--- a/nickle.h
+++ b/nickle.h
@@ -749,19 +749,20 @@ extern Value yyinput;
/* Standard exceptions */
typedef enum _standardException {
exception_none,
- exception_uninitialized_value, /* string */
+ exception_uninitialized_value, /* */
exception_invalid_argument, /* string integer poly */
- exception_readonly_box, /* string poly */
- exception_invalid_array_bounds, /* string poly poly */
- exception_divide_by_zero, /* string number number */
- exception_invalid_struct_member,/* string poly string */
- exception_invalid_binop_values, /* string poly poly */
- exception_invalid_unop_value, /* string poly */
+ exception_readonly_box, /* poly */
+ exception_invalid_array_bounds, /* poly poly */
+ exception_divide_by_zero, /* number number */
+ exception_invalid_struct_member,/* poly string */
+ exception_invalid_binop_values, /* poly poly */
+ exception_invalid_unop_value, /* poly */
exception_open_error, /* string integer string */
exception_io_error, /* string integer file */
exception_name_error, /* string integer string */
exception_signal, /* integer */
exception_system_error, /* string integer poly */
+ exception_io_eof, /* file */
_num_standard_exceptions
} StandardException;
@@ -774,7 +775,6 @@ RegisterStandardException (StandardException se,
void
RaiseStandardException (StandardException se,
- char *string,
int argc,
...);
@@ -810,8 +810,7 @@ BoxValue (BoxPtr box, int e)
Value v = BoxElements(box)[e];
if (!v)
{
- RaiseStandardException (exception_uninitialized_value,
- "Uninitialized value", 0);
+ RaiseStandardException (exception_uninitialized_value, 0);
return (Void);
}
return v;
@@ -822,9 +821,8 @@ Dereference (Value v)
{
if (!ValueIsRef(v))
{
- RaiseStandardException (exception_invalid_unop_value,
- "Not a reference",
- 1, v);
+ RaiseStandardException (exception_invalid_unop_value, 1,
+ v);
return Void;
}
return REFERENCE (RefValue (v));
diff --git a/rational.c b/rational.c
index a6c71d5..ef06bf5 100644
--- a/rational.c
+++ b/rational.c
@@ -132,9 +132,8 @@ RationalDivide (Value av, Value bv, int expandOk)
if (NaturalZero (b->num))
{
- RaiseStandardException (exception_divide_by_zero,
- "rational divide by zero",
- 2, av, bv);
+ RaiseStandardException (exception_divide_by_zero, 2,
+ av, bv);
RETURN (Void);
}
sign = Positive;
@@ -177,9 +176,8 @@ RationalMod (Value av, Value bv, int expandOk)
if (NaturalZero (b->num))
{
- RaiseStandardException (exception_divide_by_zero,
- "rational modulus by zero",
- 2, av, bv);
+ RaiseStandardException (exception_divide_by_zero, 2,
+ av, bv);
RETURN (Void);
}
div = NaturalTimes (b->num, a->den);
diff --git a/ref.c b/ref.c
index 4518fd5..284f1cd 100644
--- a/ref.c
+++ b/ref.c
@@ -35,9 +35,8 @@ RefPlus (Value av, Value bv, int expandOk)
if (i < 0 || i >= ref->box->nvalues ||
(!ref->box->homogeneous && i != ref->element))
{
- RaiseStandardException (exception_invalid_array_bounds,
- "Element out of range in reference addition",
- 2, av, bv);
+ RaiseStandardException (exception_invalid_array_bounds, 2,
+ av, bv);
RETURN (Void);
}
RETURN (NewRef (ref->box, i));
@@ -73,9 +72,8 @@ RefMinus (Value av, Value bv, int expandOk)
bref = &bv->ref;
if (ref->box != bref->box)
{
- RaiseStandardException (exception_invalid_binop_values,
- "References to different objects are unordered",
- 2, av, bv);
+ RaiseStandardException (exception_invalid_binop_values, 2,
+ av, bv);
RETURN (Void);
}
RETURN (NewInt (ref->element - bref->element));
@@ -83,9 +81,8 @@ RefMinus (Value av, Value bv, int expandOk)
i = i + element;
if (i < 0 || i >= ref->box->nvalues || (!ref->box->homogeneous && i != ref->element))
{
- RaiseStandardException (exception_invalid_array_bounds,
- "Element out of range in reference subtraction",
- 2, av, bv);
+ RaiseStandardException (exception_invalid_array_bounds, 2,
+ av, bv);
RETURN (Void);
}
RETURN (NewRef (ref->box, i));
@@ -99,9 +96,8 @@ RefLess (Value av, Value bv, int expandOk)
if (aref->box != bref->box ||
(!aref->box->homogeneous && aref->element != bref->element))
{
- RaiseStandardException (exception_invalid_binop_values,
- "References to different objects are unordered",
- 2, av, bv);
+ RaiseStandardException (exception_invalid_binop_values, 2,
+ av, bv);
return FalseVal;
}
if (aref->element < bref->element)
diff --git a/sched.c b/sched.c
index 458ce80..894e2bf 100644
--- a/sched.c
+++ b/sched.c
@@ -129,9 +129,9 @@ do_Thread_join (Value target)
ENTER ();
if (!ValueIsThread(target))
{
- RaiseStandardException (exception_invalid_argument,
- "Thread::join needs thread argument",
- 2, target, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("join needs thread argument"),
+ target, Void);
RETURN (Void);
}
if (target->thread.state != ThreadFinished)
@@ -219,9 +219,9 @@ do_Thread_set_priority (Value thread, Value priority)
int i;
if (!ValueIsThread(thread))
{
- RaiseStandardException (exception_invalid_argument,
- "Thread::set_priority: not a thread",
- 2, thread, priority);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("set_priority: not a thread"),
+ thread, priority);
RETURN (Void);
}
i = IntPart (priority, "Invalid thread priority");
@@ -242,9 +242,9 @@ do_Thread_get_priority (Value thread)
ENTER ();
if (!ValueIsThread(thread))
{
- RaiseStandardException (exception_invalid_argument,
- "Thread::get_priority: not a thread",
- 2, thread, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("get_priority: not a thread"),
+ thread, Void);
RETURN (Void);
}
RETURN (NewInt (thread->thread.priority));
@@ -257,9 +257,9 @@ KillThread (Value thread)
if (!ValueIsThread(thread))
{
- RaiseStandardException (exception_invalid_argument,
- "Thread::kill: not a thread",
- 2, thread, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("kill: not a thread"),
+ thread, Void);
return 0;
}
if (thread->thread.state == ThreadFinished)
@@ -281,9 +281,9 @@ do_Thread_kill (int n, Value *p)
{
thread = lookupVar (0, "thread");
if (!ValueIsThread(thread))
- RaiseStandardException (exception_invalid_argument,
- "Thread::kill: no default thread",
- 2, thread, Void);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("kill: no default thread"),
+ thread, Void);
else
ret = KillThread (thread);
}
@@ -378,13 +378,13 @@ do_Thread_trace (int n, Value *p)
break;
default:
if (n == 0)
- RaiseStandardException (exception_invalid_argument,
- "Thread::trace: no default continuation",
- 1, Zero);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("trace: no default continuation"),
+ NewInt (0), Void);
else
- RaiseStandardException (exception_invalid_argument,
- "Thread::trace: neither continuation nor thread",
- 1, v);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("Thread::trace: neither continuation nor thread"),
+ NewInt (0), v);
RETURN (Void);
}
TraceFrame (FileStdout, frame, obj, pc, depth);
@@ -983,9 +983,9 @@ do_setjmp (Value continuation_ref, Value ret)
if (!ValueIsRef(continuation_ref))
{
- RaiseStandardException (exception_invalid_argument,
- "setjump: not a reference",
- 1, continuation_ref);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("setjump: not a reference"),
+ NewInt (0), continuation_ref);
RETURN (Void);
}
continuation = NewContinuation (&running->thread.continuation,
@@ -1010,9 +1010,9 @@ do_longjmp (InstPtr *next, Value continuation, Value ret)
RETURN (Void);
if (!ValueIsContinuation(continuation))
{
- RaiseStandardException (exception_invalid_argument,
- "longjmp: non-continuation argument",
- 1, continuation);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("longjmp: non-continuation argument"),
+ NewInt (0), continuation);
RETURN (Void);
}
RETURN (ContinuationJump (running, &continuation->continuation, ret, next));
@@ -1171,7 +1171,6 @@ CheckStandardException (void)
void
RaiseStandardException (StandardException se,
- char *string,
int argc,
...)
{
@@ -1181,11 +1180,10 @@ RaiseStandardException (StandardException se,
va_list va;
va_start (va, argc);
- i = argc + 1;
+ i = argc;
args = NewArray (False, False, typePoly, 1, &i);
- ArrayValueSet (&args->array, 0, NewStrString (string));
for (i = 0; i < argc; i++)
- ArrayValueSet (&args->array, i + 1, va_arg (va, Value));
+ ArrayValueSet (&args->array, i, va_arg (va, Value));
standardException = se;
standardExceptionArgs = args;
SetSignalException ();
diff --git a/scope.c b/scope.c
index 97bc192..98c146d 100644
--- a/scope.c
+++ b/scope.c
@@ -235,9 +235,8 @@ NamespaceLocate (Value names,
if (!ValueIsArray(names) || names->array.ndim != 1 ||
ArrayLimits(&names->array)[0] == 0)
{
- RaiseStandardException (exception_invalid_argument,
- "not non-empty array of strings",
- 2,
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("not non-empty array of strings"),
NewInt (0), names);
return False;
}
@@ -249,9 +248,8 @@ NamespaceLocate (Value names,
return False;
if (!ValueIsString(string))
{
- RaiseStandardException (exception_invalid_argument,
- "not string",
- 2,
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("not string"),
NewInt (0), string);
return False;
}
@@ -271,9 +269,8 @@ NamespaceLocate (Value names,
{
if (symbol->symbol.class != class_namespace)
{
- RaiseStandardException (exception_invalid_argument,
- "not namespace",
- 2,
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("not namespace"),
NewInt(i), string);
return False;
}
diff --git a/string.c b/string.c
index 1e6429a..ae3e381 100644
--- a/string.c
+++ b/string.c
@@ -187,8 +187,9 @@ StrzPart (Value v, char *error)
{
if (!ValueIsString (v) || strlen (StringChars(&v->string)) != v->string.length)
{
- RaiseStandardException (exception_invalid_argument, error,
- 2, NewInt (0), v);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString (error),
+ NewInt (0), v);
return 0;
}
return StringChars (&v->string);
diff --git a/sync.c b/sync.c
index 3c9fa8d..6bca5cd 100644
--- a/sync.c
+++ b/sync.c
@@ -102,11 +102,9 @@ do_Semaphore_new (int n, Value *value)
count = IntPart (value[0], "Illegal initial semaphore count");
break;
default:
- RaiseStandardException (exception_invalid_argument,
- "new: wrong number of arguments",
- 2,
- NewInt (1),
- NewInt (n));
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString ("new: wrong number of arguments"),
+ NewInt (1), NewInt (n));
RETURN(Void);
}
ret = ALLOCATE (&SemaphoreRep.data, sizeof (Semaphore));
diff --git a/test/optest.5c b/test/optest.5c
index 1b88d7e..14af7df 100644
--- a/test/optest.5c
+++ b/test/optest.5c
@@ -55,7 +55,7 @@ check (test, (union {string b;}) { .b = "hello" });
check (bool func () { try {
test.a;
return false;
-} catch invalid_struct_member (string msg, poly test, string name) {
+} catch invalid_struct_member (poly test, string name) {
return true;
} return false; } (), true);
diff --git a/value.c b/value.c
index 78024cf..dc7c50b 100644
--- a/value.c
+++ b/value.c
@@ -100,8 +100,9 @@ IntPart (Value av, char *error)
{
if (!ValueIsInt(av))
{
- RaiseStandardException (exception_invalid_argument, error,
- 2, NewInt (0), av);
+ RaiseStandardException (exception_invalid_argument, 3,
+ NewStrString (error),
+ NewInt (0), av);
return 0;
}
return ValueInt(av);
@@ -139,9 +140,8 @@ BinaryOperate (Value av, Value bv, BinaryOp operator)
if (b == 0)
{
- RaiseStandardException (exception_divide_by_zero,
- "int divide by zero",
- 2, av, bv);
+ RaiseStandardException (exception_divide_by_zero, 2,
+ av, bv);
return Void;
}
if (a % b != 0)
@@ -152,9 +152,8 @@ BinaryOperate (Value av, Value bv, BinaryOp operator)
if (b == 0)
{
- RaiseStandardException (exception_divide_by_zero,
- "int div by zero",
- 2, av, bv);
+ RaiseStandardException (exception_divide_by_zero, 2,
+ av, bv);
return Void;
}
switch (catagorize_signs (IntSign(a), IntSign(b))) {
@@ -182,9 +181,8 @@ BinaryOperate (Value av, Value bv, BinaryOp operator)
if (b == 0)
{
- RaiseStandardException (exception_divide_by_zero,
- "int modulus by zero",
- 2, av, bv);
+ RaiseStandardException (exception_divide_by_zero, 2,
+ av, bv);
return Void;
}
switch (catagorize_signs (IntSign(a), IntSign(b))) {
@@ -249,9 +247,7 @@ BinaryOperate (Value av, Value bv, BinaryOp operator)
{
if (operator == EqualOp)
RETURN (FalseVal);
- RaiseStandardException (exception_invalid_binop_values,
- "invalid operands",
- 2,
+ RaiseStandardException (exception_invalid_binop_values, 2,
av, bv);
RETURN (Void);
}
@@ -274,9 +270,8 @@ UnaryOperate (Value v, UnaryOp operator)
if (!rep->unary[operator])
{
- RaiseStandardException (exception_invalid_unop_value,
- "invalid operand",
- 1, v);
+ RaiseStandardException (exception_invalid_unop_value, 1,
+ v);
RETURN (Void);
}
if (aborting)
@@ -404,10 +399,7 @@ Factorial (Value av)
if (!Integralp (ValueTag(av)) || Negativep (av))
{
- RaiseStandardException (exception_invalid_unop_value,
- "invalid operand",
- 1,
- av);
+ RaiseStandardException (exception_invalid_unop_value, 1, av);
RETURN (Void);
}
/*
@@ -465,9 +457,7 @@ Pow (Value av, Value bv)
if (!Numericp (ValueTag(av)) || !Numericp (ValueTag(bv)))
{
- RaiseStandardException (exception_invalid_binop_values,
- "invalid operands",
- 2,
+ RaiseStandardException (exception_invalid_binop_values, 2,
av, bv);
RETURN (Void);
}
@@ -527,9 +517,8 @@ Pow (Value av, Value bv)
}
break;
default:
- RaiseStandardException (exception_invalid_binop_values,
- "non-integer pow right operand",
- 2, av, bv);
+ RaiseStandardException (exception_invalid_binop_values, 2,
+ av, bv);
result = Void;
break;
}
@@ -542,9 +531,8 @@ ShiftL (Value av, Value bv)
ENTER ();
if (!Integralp (ValueTag(av)) || !Integralp (ValueTag(bv)))
{
- RaiseStandardException (exception_invalid_binop_values,
- "non-integer << operands",
- 2, av, bv);
+ RaiseStandardException (exception_invalid_binop_values, 2,
+ av, bv);
RETURN (Void);
}
if (Negativep (bv))
@@ -587,9 +575,8 @@ ShiftR (Value av, Value bv)
ENTER ();
if (!Integralp (ValueTag(av)) || !Integralp (ValueTag(bv)))
{
- RaiseStandardException (exception_invalid_binop_values,
- "non-integer >> operands",
- 2, av, bv);
+ RaiseStandardException (exception_invalid_binop_values, 2,
+ av, bv);
RETURN (Void);
}
if (Negativep (bv))
@@ -631,9 +618,7 @@ Gcd (Value av, Value bv)
if (!Integralp (ValueTag(av)) || !Integralp (ValueTag(bv)))
{
- RaiseStandardException (exception_invalid_binop_values,
- "invalid gcd argument values",
- 2,
+ RaiseStandardException (exception_invalid_binop_values, 2,
av, bv);
RETURN (Void);
}
@@ -650,9 +635,7 @@ Bdivmod (Value av, Value bv)
if (!Integralp (ValueTag(av)) || !Integralp (ValueTag(bv)))
{
- RaiseStandardException (exception_invalid_binop_values,
- "invalid gcd argument values",
- 2,
+ RaiseStandardException (exception_invalid_binop_values, 2,
av, bv);
RETURN (Void);
}
@@ -668,9 +651,7 @@ KaryReduction (Value av, Value bv)
if (!Integralp (ValueTag(av)) || !Integralp (ValueTag(bv)))
{
- RaiseStandardException (exception_invalid_binop_values,
- "invalid kary_reduction argument values",
- 2,
+ RaiseStandardException (exception_invalid_binop_values, 2,
av, bv);
RETURN (Void);
}
@@ -817,9 +798,7 @@ Dereference (Value v)
{
if (!ValueIsRef(v))
{
- RaiseStandardException (exception_invalid_unop_value,
- "Not a reference",
- 1, v);
+ RaiseStandardException (exception_invalid_unop_value, 1, v);
return Void;
}
return REFERENCE (RefValue (v));
diff --git a/value.h b/value.h
index b53d6fc..98c5845 100644
--- a/value.h
+++ b/value.h
@@ -1047,7 +1047,7 @@ extern Value Blank, Elementless, Void, TrueVal, FalseVal;
# define False(v) ((v) != TrueVal)
Value FileGetError (int err);
-char *FileGetErrorMessage (int err);
+Value FileGetErrorMessage (int err);
int FileInput (Value);
int FileOutput (Value, char);
void FileUnput (Value, unsigned char);
commit 9cd6fc05beac5155f9039781d79c11a112fea731
Author: Keith Packard <keithp at keithp.com>
Date: Thu Feb 7 17:52:05 2008 -0800
Avoid using getc at EOF
diff --git a/file.5c b/file.5c
index c8ff0cd..27ff88c 100644
--- a/file.5c
+++ b/file.5c
@@ -42,13 +42,13 @@ extend namespace File {
public int getchar ()
/* return getc (stdin); */
{
- return File::getc (stdin);
+ return getc (stdin);
}
public void ungetchar (int ch)
/* ungetc (ch, stdin); */
{
- File::ungetc (ch, stdin);
+ ungetc (ch, stdin);
}
public void putchar (int c)
@@ -60,13 +60,13 @@ extend namespace File {
public int getbyte ()
/* return getb (stdin) */
{
- return File::getb (stdin);
+ return getb (stdin);
}
public void putbyte (int b)
/* putb (b, stdout) */
{
- File::putb (b, stdout);
+ putb (b, stdout);
}
public string fgets (file f)
@@ -79,17 +79,17 @@ extend namespace File {
int c;
s = "";
- for (;;)
+ while (!end(f))
{
c = getc (f);
switch (c) {
case '\n':
- case -1:
return s;
default:
s = s + String::new (c);
}
}
+ return s;
}
public string gets ()
diff --git a/scanf.5c b/scanf.5c
index c3fcec7..83ef351 100644
--- a/scanf.5c
+++ b/scanf.5c
@@ -12,9 +12,11 @@ extend namespace File {
{
int c;
- while (Ctype::isspace (c = File::getc (f)))
- ;
- File::ungetc (c, f);
+ while (!end (f))
+ if (!Ctype::isspace (c = getc (f))) {
+ ungetc (c, f);
+ break;
+ }
}
bool isbinary (int c)
@@ -76,13 +78,16 @@ extend namespace File {
int integer (bool(int c) test, int base)
{
int c;
- string s;
+ string s = "";
whitespace();
- s = "";
- while (test (c = File::getc (f)))
+ while (!end (f)) {
+ if (!test (c = getc (f))) {
+ ungetc (c, f);
+ break;
+ }
s = s + String::new(c);
- File::ungetc (c, f);
+ }
return string_to_integer (s, base);
}
@@ -90,29 +95,27 @@ extend namespace File {
real number (bool(int c) test)
{
int c;
- string s;
+ string s = "";
whitespace();
- s = "";
- while (test (c = File::getc (f)))
+ while (!end (f)) {
+ if (!test (c = getc (f))) {
+ ungetc (c, f);
+ break;
+ }
s = s + String::new(c);
- File::ungetc (c, f);
+ }
return string_to_real (s);
}
string word ()
{
- int c;
- string s;
-
whitespace();
- s = "";
- while (!File::end (f))
- {
- c = File::getc(f);
- if (!Ctype::isgraph (c))
- {
- File::ungetc (c, f);
+ string s = "";
+ while (!end (f)) {
+ int c = getc(f);
+ if (!Ctype::isgraph (c)) {
+ ungetc (c, f);
break;
}
s = s + String::new(c);
@@ -124,7 +127,7 @@ extend namespace File {
int argc = 0;
int c;
- while (i < String::length (format) && !File::end(f) && !File::error(f))
+ while (i < String::length (format) && !end(f) && !error(f))
{
switch (format[i]) {
case ' ':
@@ -152,25 +155,28 @@ extend namespace File {
*args[argc++] = number(isfloat);
break;
case 'c':
- *args[argc++] = File::getc(f);
+ *args[argc++] = getc(f);
break;
case 's':
*args[argc++] = word();
break;
default:
- c = File::getc(f);
- if (c != format[i])
- {
- File::ungetc (c, f);
+ if (end (f))
+ return argc;
+ c = getc(f);
+ if (c != format[i]) {
+ ungetc (c, f);
return argc;
}
+ break;
}
break;
default:
- c = File::getc(f);
- if (c != format[i])
- {
- File::ungetc (c, f);
+ if (end (f))
+ return argc;
+ c = getc(f);
+ if (c != format[i]) {
+ ungetc (c, f);
return argc;
}
break;
@@ -198,7 +204,7 @@ extend namespace File {
* According to 'format', read from stdin to 'args'
*/
{
- return File::fscanf (stdin, format, args ...);
+ return fscanf (stdin, format, args ...);
}
}
More information about the Nickle
mailing list