From keithp at keithp.com Fri Mar 21 12:31:22 2008 From: keithp at keithp.com (Keith Packard) Date: Fri, 21 Mar 2008 12:31:22 -0700 (PDT) Subject: [Nickle] nickle: Changes to 'refs/tags/2.67' Message-ID: <20080321193122.BBB2B130028@keithp.com> Tag '2.67' created by Keith Packard at 2008-03-21 20:30 -0700 Version 2.67 -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.6 (GNU/Linux) iD8DBQBH5Ay7Qp8BWwlsTdMRApRDAKCy5MHO3Jj8m+6soiZVQUcnmnACYQCdHkep qt1yjtokYNsALuwULjlp9W8= =t2dq -----END PGP SIGNATURE----- Changes since 2.65-34: --- 0 files changed --- From keithp at keithp.com Fri Mar 21 12:31:13 2008 From: keithp at keithp.com (Keith Packard) Date: Fri, 21 Mar 2008 12:31:13 -0700 (PDT) Subject: [Nickle] nickle: Branch 'master' - 16 commits Message-ID: <20080321193113.3923A130027@keithp.com> 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 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 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 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 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 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 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 +#include +#include +#include + +#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 -#include -#include -#include - -#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 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 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 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 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 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 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 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, ""); FilePuts (file, " ("); commit eefcdbb5330160a0197e425b45f174f34b1b5db7 Author: Keith Packard 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 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 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 #include #include +#include #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 -#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 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 ...); } } From keithp at keithp.com Wed Mar 26 23:24:02 2008 From: keithp at keithp.com (Keith Packard) Date: Wed, 26 Mar 2008 23:24:02 -0700 (PDT) Subject: [Nickle] nickle: Branch 'master' - 2 commits Message-ID: <20080327062402.C4F67130027@keithp.com> file.c | 26 +++++++++++++++++++++----- io.c | 49 ++++++++++++++++++++++++++----------------------- nickle.h | 2 ++ 3 files changed, 49 insertions(+), 28 deletions(-) New commits: commit d0604e797cf194eb025a1784766ebea8cf38ec87 Author: Keith Packard Date: Wed Mar 26 23:21:41 2008 -0700 Allow background nickle to not poll on tty ownership When stdin is connected to a terminal but nickle is not the foreground process on that terminal, the io code would poll to wait for ownership to flip back to nickle so that reads could be performed without generating a signal. Now, nickle waits until someone actually tries to read from the terminal before starting to poll. This means that simple background processing nickle programs will not poll every 100ms. diff --git a/file.c b/file.c index 2ba4b5b..11c344f 100644 --- a/file.c +++ b/file.c @@ -29,7 +29,7 @@ ReferencePtr fileBlockedReference; Value fileBlocked; -Bool anyFileWriteBlocked; +Bool stdinOwned, stdinPolling; #ifdef NO_PIPE_SIGIO Bool anyPipeReadBlocked; #endif @@ -952,8 +952,12 @@ FileIsReadable (int fd) int n; struct timeval tv; - if (fd < 3 && !ownTty[fd]) + if (fd == 0 && !stdinOwned) + { + if (!stdinPolling) + IoNoticeTtyUnowned (); return False; + } do { FD_ZERO (&bits); @@ -1892,7 +1896,7 @@ FileCheckBlocked (Bool block) continue; } prev = &blocked->file.next; - if (fd < 3 && !ownTty[fd]) + if (fd == 0 && !stdinOwned) continue; if (blocked->file.flags & FileInputBlocked) FD_SET (fd, &readable); diff --git a/io.c b/io.c index b7b1d99..d5c218a 100644 --- a/io.c +++ b/io.c @@ -15,9 +15,10 @@ #include "ref.h" volatile Bool signalIo; -Bool ownTty[3]; -Bool anyTtyUnowned; +Bool stdinOwned; +Bool stdinPolling; Bool ioTimeoutQueued; +Bool anyFileWriteBlocked; #ifdef HAVE_SIGACTION #define RESTART_SIGNAL(sig,func) @@ -41,14 +42,11 @@ IoInterrupt (void) void IoStop (void) { - int fd; - - for (fd = 0; fd < 3; fd++) + if (stdin_interactive) { - ownTty[fd] = False; - FileResetFd (fd); + FileResetFd (0); + stdinOwned = False; } - anyTtyUnowned = True; } #ifdef GETPGRP_VOID @@ -71,20 +69,15 @@ IoOwnTty (int fd) void IoStart (void) { - int fd; - - anyTtyUnowned = False; - for (fd = 0; fd < 3; fd++) + if (stdin_interactive) { - ownTty[fd] = IoOwnTty (fd); - if (!ownTty[fd]) - anyTtyUnowned = True; + stdinOwned = IoOwnTty (0); + if (stdinOwned) + { + stdinPolling = False; + FileSetFd (0); + } } - if (anyTtyUnowned) - IoNoticeTtyUnowned (); - else if (stdin_interactive) - for (fd = 0; fd < 3; fd++) - FileSetFd (fd); } void @@ -103,10 +96,10 @@ Value FileStdin, FileStdout, FileStderr; Bool IoTimeout (void *closure) { - if (anyTtyUnowned) + if (!stdinOwned) IoStart (); FileCheckBlocked (False); - if (anyFileWriteBlocked || anyTtyUnowned + if (anyFileWriteBlocked || (!stdinOwned && stdinPolling) #ifdef NO_PIPE_SIGIO || anyPipeReadBlocked #endif @@ -129,7 +122,11 @@ IoSetupTimeout (void) void IoNoticeTtyUnowned (void) { - IoSetupTimeout(); + if (!stdinOwned && !stdinPolling) + { + stdinPolling = True; + IoSetupTimeout(); + } } void commit fd8d02af5bf2884858108421fec40b8c7ca9863b Author: Keith Packard Date: Wed Mar 26 16:22:44 2008 -0700 Remove support for non-SIGIO pipes Older version of the kernel (before 2001) failed to generate SIGIO on pipes, so nickle had code to poll instead. I think we can safely remove that code now. diff --git a/file.c b/file.c index cd6d693..2ba4b5b 100644 --- a/file.c +++ b/file.c @@ -1,5 +1,3 @@ -/* $Header$ */ - /* * Copyright ?? 1988-2004 Keith Packard and Bart Massey. * All Rights Reserved. See the file COPYING in this directory @@ -32,7 +30,9 @@ ReferencePtr fileBlockedReference; Value fileBlocked; Bool anyFileWriteBlocked; +#ifdef NO_PIPE_SIGIO Bool anyPipeReadBlocked; +#endif extern Bool ownTty[3]; typedef struct _FileErrorMap { @@ -1876,7 +1876,9 @@ FileCheckBlocked (Bool block) Value blocked, *prev; Bool ready; Bool writeBlocked; +#ifdef NO_PIPE_SIGIO Bool readPipeBlocked; +#endif FD_ZERO (&readable); FD_ZERO (&writable); @@ -1915,12 +1917,16 @@ FileCheckBlocked (Bool block) else { anyFileWriteBlocked = False; +#ifdef NO_PIPE_SIGIO anyPipeReadBlocked = False; +#endif } if (n > 0) { writeBlocked = False; +#ifdef NO_PIPE_SIGIO readPipeBlocked = False; +#endif for (prev = &fileBlocked; (blocked = *prev); ) { fd = blocked->file.fd; @@ -1940,9 +1946,11 @@ FileCheckBlocked (Bool block) } if (blocked->file.flags & FileOutputBlocked) writeBlocked = True; +#ifdef NO_PIPE_SIGIO if (blocked->file.flags & FileInputBlocked && blocked->file.flags & FileIsPipe) readPipeBlocked = True; +#endif if (ready) ThreadsWakeup (blocked, WakeAll); if ((blocked->file.flags & (FileOutputBlocked|FileInputBlocked)) == 0) @@ -1951,7 +1959,9 @@ FileCheckBlocked (Bool block) prev = &blocked->file.next; } anyFileWriteBlocked = writeBlocked; +#ifdef NO_PIPE_SIGIO anyPipeReadBlocked = readPipeBlocked; +#endif } EXIT (); } @@ -1964,6 +1974,7 @@ FileSetBlocked (Value file, int flag) anyFileWriteBlocked = True; IoNoticeWriteBlocked (); } +#ifdef NO_PIPE_SIGIO if (flag == FileInputBlocked && (file->file.flags & FileIsPipe) && !anyPipeReadBlocked) @@ -1971,6 +1982,7 @@ FileSetBlocked (Value file, int flag) anyPipeReadBlocked = True; IoNoticeReadBlocked (); } +#endif if (file->file.flags & (FileOutputBlocked|FileInputBlocked)) { file->file.flags |= flag; diff --git a/io.c b/io.c index 2c16eed..b7b1d99 100644 --- a/io.c +++ b/io.c @@ -106,7 +106,11 @@ IoTimeout (void *closure) if (anyTtyUnowned) IoStart (); FileCheckBlocked (False); - if (anyFileWriteBlocked || anyPipeReadBlocked || anyTtyUnowned) + if (anyFileWriteBlocked || anyTtyUnowned +#ifdef NO_PIPE_SIGIO + || anyPipeReadBlocked +#endif + ) return True; ioTimeoutQueued = False; return False; @@ -134,11 +138,13 @@ IoNoticeWriteBlocked (void) IoSetupTimeout (); } +#ifdef NO_PIPE_SIGIO void IoNoticeReadBlocked (void) { IoSetupTimeout (); } +#endif void IoInit (void) diff --git a/nickle.h b/nickle.h index 09131c1..610019d 100644 --- a/nickle.h +++ b/nickle.h @@ -681,7 +681,9 @@ void IoStop (void); void IoFini (void); Bool IoTimeout (void *); void IoNoticeWriteBlocked (void); +#ifdef NO_PIPE_SIGIO void IoNoticeReadBlocked (void); +#endif void IoNoticeTtyUnowned (void); void IoInterrupt (void);