[Nickle] nickle: Branch 'master' - 14 commits
Keith Packard
keithp at keithp.com
Wed Feb 22 03:59:53 PST 2012
Makefile.am | 2
alarm.c | 7 +
builtin-semaphore.c | 4
builtin-toplevel.c | 4
builtin.5c | 1
configure.ac | 2
examples/Makefile.am | 4
examples/skiplist.5c | 222 -------------------------------------------------
examples/sort.5c | 97 ---------------------
execute.c | 8 -
float.c | 18 ---
gamma.5c | 128 ++++++++++++++++++++++++++++
gcd.c | 2
lex.l | 42 +++++++--
list.5c | 78 +++++++++++++++++
main.c | 16 ++-
nickle.h | 6 +
rational.c | 2
scanf.5c | 96 ++++++++++++---------
skiplist.5c | 231 +++++++++++++++++++++++++++++++++++++++++++++++++++
sort.5c | 97 +++++++++++++++++++++
sync.c | 19 ++--
test/Makefile.am | 4
test/scanf.5c | 49 ++++++++++
24 files changed, 727 insertions(+), 412 deletions(-)
New commits:
commit 42aeaa3494c68fee1b1559dde8d99ee52677b361
Author: Keith Packard <keithp at keithp.com>
Date: Thu Feb 23 00:56:41 2012 +1300
Add list.5c
A useful data type
Signed-off-by: Keith Packard <keithp at keithp.com>
diff --git a/list.5c b/list.5c
new file mode 100644
index 0000000..a5df50e
--- /dev/null
+++ b/list.5c
@@ -0,0 +1,78 @@
+/*
+ * Copyright © 2012 Keith Packard <keithp at keithp.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; version 2 of the License.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
+ */
+
+namespace List {
+ public typedef list_t;
+
+ public typedef struct {
+ *list_t prev;
+ *list_t next;
+ } list_t;
+
+ public void init(*list_t l) {
+ l->next = l;
+ l->prev = l;
+ }
+
+ void add(*list_t entry, *list_t prev, *list_t next) {
+ next->prev = entry;
+ entry->next = next;
+ entry->prev = prev;
+ prev->next = entry;
+ }
+
+ void del(*list_t prev, *list_t next) {
+ next->prev = prev;
+ prev->next = next;
+ }
+
+ public bool is_empty(*list_t head) {
+ return head->next == head;
+ }
+
+ public *list_t first(*list_t head) {
+ assert(!is_empty(head), "empty list");
+ return head->next;
+ }
+
+ public *list_t last(*list_t head) {
+ assert(!is_empty(head), "empty list");
+ return head->prev;
+ }
+
+ public void insert(*list_t entry, *list_t head) {
+ add(entry, head, head->next);
+ }
+
+ public void append(*list_t entry, *list_t head) {
+ add(entry, head->prev, head);
+ }
+
+ public void remove(*list_t entry) {
+ del(entry->prev, entry->next);
+ init(entry);
+ }
+
+ public iterate(*list_t head, bool (*list_t) f) {
+ *list_t next;
+ for (*list_t pos = head->next; pos != head; pos = next) {
+ next = pos->next;
+ if (!f(pos))
+ break;
+ }
+ }
+}
commit ab2ed22e6ff90868fbbebaba1e1851f131044555
Author: Keith Packard <keithp at keithp.com>
Date: Thu Feb 23 00:15:02 2012 +1300
add 'millis' function to return a clock in milliseconds.
Useful when doing things with sleep
Signed-off-by: Keith Packard <keithp at keithp.com>
diff --git a/alarm.c b/alarm.c
index 7183535..bd9dcfd 100644
--- a/alarm.c
+++ b/alarm.c
@@ -144,6 +144,13 @@ do_sleep (Value ms)
RETURN (Void);
}
+Value
+do_millis (void)
+{
+ ENTER();
+ RETURN(NewInt(TimeInMs()));
+}
+
ReferencePtr SleepingReference;
static void
diff --git a/builtin-toplevel.c b/builtin-toplevel.c
index 88d2cea..73c6573 100644
--- a/builtin-toplevel.c
+++ b/builtin-toplevel.c
@@ -26,6 +26,10 @@ import_Toplevel_namespace()
" int time ()\n"
"\n"
" Return seconds since Jan 1, 1970 00:00 GMT\n" },
+ { do_millis, "millis", "i", "", "\n"
+ " int millis ()\n"
+ "\n"
+ " Return time in milliseconds\n" },
{ 0 }
};
diff --git a/nickle.h b/nickle.h
index e29fb86..cab7f37 100644
--- a/nickle.h
+++ b/nickle.h
@@ -885,6 +885,7 @@ Value do_Debug_done (void);
Value do_Debug_collect (void);
Value do_Debug_help (void);
Value do_File_mkpipe (void);
+Value do_millis (void);
/* one argument builtins */
Value do_sleep (Value);
commit 67801c2111e9f35afcd1667fb59a72efcfdb5df8
Author: Keith Packard <keithp at keithp.com>
Date: Tue Feb 21 23:50:18 2012 +1300
Add Semaphore::count
Useful for checking current semaphore value without
modifying it.
Signed-off-by: Keith Packard <keithp at keithp.com>
diff --git a/builtin-semaphore.c b/builtin-semaphore.c
index cd6c523..7d0045b 100644
--- a/builtin-semaphore.c
+++ b/builtin-semaphore.c
@@ -29,6 +29,10 @@ import_Semaphore_namespace()
"\n"
" Increment the count in 's' by one.\n"
" If the count is <= 0, wakeup one thread waiting on 's'.\n" },
+ { do_Semaphore_count, "count", "i", "S", "\n"
+ " int count (semaphore s)\n"
+ "\n"
+ " Return current semaphore count\n" },
{ do_Semaphore_test, "test", "b", "S", "\n"
" bool test (semaphore s)\n"
"\n"
diff --git a/nickle.h b/nickle.h
index 09a6056..e29fb86 100644
--- a/nickle.h
+++ b/nickle.h
@@ -925,6 +925,7 @@ Value do_Thread_get_priority (Value);
Value do_Thread_id_to_thread (Value);
Value do_Thread_join (Value);
Value do_Semaphore_signal (Value);
+Value do_Semaphore_count (Value);
Value do_Semaphore_wait (Value);
Value do_Semaphore_test (Value);
Value do_File_close (Value);
diff --git a/sync.c b/sync.c
index cc1d4fd..588c49a 100644
--- a/sync.c
+++ b/sync.c
@@ -39,6 +39,13 @@ do_Semaphore_test (Value s)
}
Value
+do_Semaphore_count (Value s)
+{
+ ENTER();
+ RETURN (NewInt(s->semaphore.count));
+}
+
+Value
do_Semaphore_signal (Value s)
{
ENTER ();
commit 0d6d153498b51bf02286eff06d327ab42914361e
Author: Keith Packard <keithp at keithp.com>
Date: Tue Feb 21 23:49:37 2012 +1300
Clean up do_Semaphore_wait
Make it clear that the semaphore count gets bumped down the first time
into this function.
Signed-off-by: Keith Packard <keithp at keithp.com>
diff --git a/sync.c b/sync.c
index 6bca5cd..cc1d4fd 100644
--- a/sync.c
+++ b/sync.c
@@ -17,14 +17,12 @@ do_Semaphore_wait (Value s)
if (aborting)
RETURN (Void);
if (!running->thread.partial)
- {
--s->semaphore.count;
- if (s->semaphore.count < 0)
- {
- running->thread.partial = 1;
- ThreadSleep (running, s, PrioritySync);
- RETURN (Void);
- }
+ if (s->semaphore.count < 0)
+ {
+ running->thread.partial = 1;
+ ThreadSleep (running, s, PrioritySync);
+ RETURN (Void);
}
complete = True;
RETURN (Void);
commit 6fd77649e822e026000ea5c857d2c30af8874030
Author: Keith Packard <keithp at keithp.com>
Date: Tue Feb 21 23:47:30 2012 +1300
Check for thread switch even if current thread is last
Threads can switch due to semaphores or other signals; that can leave
the current thread last in the run queue. Check for any case where
running changes instead of only when the current thread isn't last.
Signed-off-by: Keith Packard <keithp at keithp.com>
diff --git a/execute.c b/execute.c
index 64f2624..c127cb9 100644
--- a/execute.c
+++ b/execute.c
@@ -1448,13 +1448,9 @@ ThreadsRun (Value thread, Value lex)
inst = next;
thread->thread.continuation.pc = inst;
if (thread->thread.next)
- {
ThreadStepped (thread);
- if (running != thread)
- {
- break;
- }
- }
+ if (running != thread)
+ break;
}
EXIT ();
}
commit 61bd1359a1bc3766833071d04610176a5dfe6b6a
Author: Keith Packard <keithp at keithp.com>
Date: Tue Feb 21 17:42:29 2012 +1300
Make scanf not report valid conversion on blank input.
scanf was incorrectly accepting " " as a valid number, returning a
conversion of 0. Fix this by checking for empty strings in any numeric
conversion.
Signed-off-by: Keith Packard <keithp at keithp.com>
diff --git a/scanf.5c b/scanf.5c
index 83ef351..6fc44c2 100644
--- a/scanf.5c
+++ b/scanf.5c
@@ -7,6 +7,8 @@ extend namespace File {
* According to 'format', read from 'f' to 'args'
*/
{
+ exception bad_conversion();
+
/* Skip whitespace */
void whitespace ()
{
@@ -88,6 +90,8 @@ extend namespace File {
}
s = s + String::new(c);
}
+ if (String::length(s) == 0)
+ raise bad_conversion();
return string_to_integer (s, base);
}
@@ -105,6 +109,8 @@ extend namespace File {
}
s = s + String::new(c);
}
+ if (String::length(s) == 0)
+ raise bad_conversion();
return string_to_real (s);
}
@@ -120,6 +126,8 @@ extend namespace File {
}
s = s + String::new(c);
}
+ if (String::length(s) == 0)
+ raise bad_conversion();
return s;
}
@@ -129,36 +137,55 @@ extend namespace File {
while (i < String::length (format) && !end(f) && !error(f))
{
- switch (format[i]) {
- case ' ':
- case '\t':
- whitespace ();
- break;
- case '%':
- i++;
+ try {
switch (format[i]) {
- case 'b': case 'B':
- *args[argc++] = integer (isbinary, 2);
- break;
- case 'o': case 'O':
- *args[argc++] = integer (isoctal, 8);
- break;
- case 'd': case 'D':
- *args[argc++] = integer (isdecimal, 10);
- break;
- case 'x': case 'X':
- *args[argc++] = integer (ishex, 16);
- break;
- case 'e': case 'E':
- case 'f': case 'F':
- case 'g': case 'G':
- *args[argc++] = number(isfloat);
+ case ' ':
+ case '\t':
+ whitespace ();
break;
- case 'c':
- *args[argc++] = getc(f);
- break;
- case 's':
- *args[argc++] = word();
+ case '%':
+ i++;
+ switch (format[i]) {
+ case 'b': case 'B':
+ *args[argc] = integer (isbinary, 2);
+ argc++;
+ break;
+ case 'o': case 'O':
+ *args[argc] = integer (isoctal, 8);
+ argc++;
+ break;
+ case 'd': case 'D':
+ *args[argc] = integer (isdecimal, 10);
+ argc++;
+ break;
+ case 'x': case 'X':
+ *args[argc] = integer (ishex, 16);
+ argc++;
+ break;
+ case 'e': case 'E':
+ case 'f': case 'F':
+ case 'g': case 'G':
+ *args[argc] = number(isfloat);
+ argc++;
+ break;
+ case 'c':
+ *args[argc] = getc(f);
+ argc++;
+ break;
+ case 's':
+ *args[argc] = word();
+ argc++;
+ break;
+ default:
+ if (end (f))
+ return argc;
+ c = getc(f);
+ if (c != format[i]) {
+ ungetc (c, f);
+ return argc;
+ }
+ break;
+ }
break;
default:
if (end (f))
@@ -170,18 +197,9 @@ extend namespace File {
}
break;
}
- break;
- default:
- if (end (f))
- return argc;
- c = getc(f);
- if (c != format[i]) {
- ungetc (c, f);
- return argc;
- }
- break;
+ i++;
+ } catch bad_conversion() {
}
- i++;
}
return argc;
}
commit e6abc97a91f08a6ca6d06da5f88b627cf6b16a35
Author: Keith Packard <keithp at keithp.com>
Date: Tue Feb 21 17:41:13 2012 +1300
Add tests for scanf function
Scanf incorrectly accepts blank strings for numbers; here's a pile
of tests to validate various numeric input.
Signed-off-by: Keith Packard <keithp at keithp.com>
diff --git a/test/Makefile.am b/test/Makefile.am
index 7ab6cb7..d0ccb6d 100644
--- a/test/Makefile.am
+++ b/test/Makefile.am
@@ -1,4 +1,6 @@
-check_SCRIPTS=gcdtest.5c \
+check_SCRIPTS=\
+ scanf.5c \
+ gcdtest.5c \
inttest.5c \
optest.5c \
orderofoptest.5c \
diff --git a/test/scanf.5c b/test/scanf.5c
new file mode 100644
index 0000000..feb0bc7
--- /dev/null
+++ b/test/scanf.5c
@@ -0,0 +1,49 @@
+int errors = 0;
+
+void check(string input, string format, int count, poly value) {
+ poly got_value;
+ int got_count = File::fscanf(File::string_read(input), format, &got_value);
+ if (got_count != count) {
+ printf ("got %d wanted %d. input %s format %s\n",
+ got_count, count, input, format);
+ errors++;
+ return;
+ }
+ if (count != 0) {
+ if (got_value != value) {
+ printf ("read %v wanted %v. input %s format %s\n",
+ got_value, value, input, format);
+ errors++;
+ }
+ }
+}
+
+string[] int_formats={ "%b", "%o", "%d", "%x", "%e", "%f", "%g" };
+for (int i = 0; i < dim(int_formats); i++) {
+ check("0", int_formats[i], 1, 0);
+ check(" 0", int_formats[i], 1, 0);
+ check("1", "%x", 1, 1);
+ check(" 1", "%x", 1, 1);
+ check("", "%x", 0, 1);
+ check(" ", "%x", 0, 1);
+}
+
+string[] real_formats={ "%e", "%f", "%g" };
+
+typedef struct {
+ string input;
+ real value;
+} real_t;
+
+real_t[] real_tests = {
+ { .input = ".{3}", .value = 1/3 },
+ { .input = "1.0e-30", value = 1e-30 },
+ { .input = "1e30", .value = 1e30 },
+};
+
+for (int i = 0; i < dim(real_formats); i++) {
+ for (int t = 0; t < dim(real_tests); t++) {
+ check(real_tests[t].input, real_formats[i], 1, real_tests[t].value);
+ }
+}
+exit(errors);
commit 2d3f8dc35a068bac522115d6dfc6f573922040c5
Author: Keith Packard <keithp at keithp.com>
Date: Tue Feb 21 14:32:11 2012 +1300
Add sort and skiplist to standard nickle library
These are too useful to just be examples
Signed-off-by: Keith Packard <keithp at keithp.com>
diff --git a/Makefile.am b/Makefile.am
index 4837cf8..1c543cf 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -13,7 +13,7 @@ NICKLEFILES = builtin.5c math.5c scanf.5c mutex.5c \
arc4.5c prng.5c command.5c abort.5c \
printf.5c history.5c ctype.5c string.5c socket.5c \
file.5c parse-args.5c svg.5c process.5c \
- prime_sieve.5c factorial.5c gamma.5c
+ prime_sieve.5c factorial.5c gamma.5c sort.5c list.5c skiplist.5c
DEBIAN = debian/nickle.install debian/changelog debian/compat \
debian/control debian/copyright debian/rules debian/lintian.override
diff --git a/examples/Makefile.am b/examples/Makefile.am
index d67ebc6..29378e8 100644
--- a/examples/Makefile.am
+++ b/examples/Makefile.am
@@ -20,9 +20,7 @@ NICKLEFILES=\
roman.5c \
rsa-demo.5c \
rsa.5c \
- skiplist.5c \
- skiplisttest.5c \
- sort.5c
+ skiplisttest.5c
exampledir=$(pkgdatadir)/examples
diff --git a/examples/skiplist.5c b/examples/skiplist.5c
deleted file mode 100644
index f081d48..0000000
--- a/examples/skiplist.5c
+++ /dev/null
@@ -1,222 +0,0 @@
-/* $Header$ */
-
-/*
- * Copyright © 2004 Keith Packard and Bart Massey.
- * All Rights Reserved. See the file COPYING in this directory
- * for licensing information.
- */
-
-autoload PRNG;
-
-namespace Skiplist {
- public typedef *struct {
- } List;
-
- public typedef bool (poly a, poly b) Greater;
-
- public typedef void (poly a) Visit;
-
- public exception not_found (poly missing);
-
- /*
- * Private representation of an element
- */
- typedef Element;
-
- typedef union {
- *Element element;
- void nil;
- } ElementPtr;
-
- const MaxLevel = 16;
-
- typedef struct {
- poly value;
- ElementPtr[*] forward;
- } Element;
-
- typedef struct {
- int level;
- Greater greater;
- Element header;
- } SkipRec;
-
- typedef *SkipRec Skip;
-
- int random_level ()
- /*
- * This uses a fixed probability of 1/4 for each level
- */
- {
- int bits = PRNG::randbits(MaxLevel * 2);
- int level = 0;
-
- while (++level < MaxLevel)
- {
- if ((bits & 3) != 0)
- break;
- bits >>= 2;
- }
- return level;
- }
-
- public List new (Greater greater)
- /*
- * Allocate a new list with 'greater' as the ordering function
- */
- {
- return &(SkipRec) {
- .level = 0,
- .greater = greater,
- .header = {
- .forward = (ElementPtr[MaxLevel]) { [i] = ElementPtr.nil },
- .value = <>
- }
- };
- }
-
- public poly search (Skip list, poly value)
- /*
- * Search 'list' for 'value', returning a
- * matching value in the list else Raise 'not_found'.
- */
- {
- ElementPtr x = (ElementPtr.element) &list->header;
-
- for (int i = list->level; --i >= 0; )
- {
- while (x.element->forward[i] != ElementPtr.nil &&
- list->greater (value,
- x.element->forward[i].element->value))
- x = x.element->forward[i];
- }
- x = x.element->forward[0];
- if (x == ElementPtr.nil || list->greater (x.element->value, value))
- raise not_found (value);
- return x.element->value;
- }
-
- public void insert (Skip list, poly value)
- /*
- * Insert 'value' into 'list'
- */
- {
- ElementPtr[MaxLevel] update = {};
- ElementPtr x = (ElementPtr.element) &list->header;
-
- for (int i = list->level; --i >= 0;)
- {
- while (x.element->forward[i] != ElementPtr.nil &&
- list->greater (value,
- x.element->forward[i].element->value))
- x = x.element->forward[i];
- update[i] = x;
- }
- x = x.element->forward[0];
- int level = random_level ();
- if (level > list->level)
- {
- level = list->level + 1;
- list->level = level;
- update[level-1] = (ElementPtr.element) &list->header;
- }
-
- /*
- * Allocate new list entry
- */
- ElementPtr new = (ElementPtr.element) &(Element) {
- .value = value,
- .forward = (ElementPtr[level]) {}
- };
-
- for (int i = 0; i < level; i++)
- {
- new.element->forward[i] = update[i].element->forward[i];
- update[i].element->forward[i] = new;
- }
- }
-
- public void delete (Skip list, poly value)
- /*
- * delete entry matching 'value' from 'list', else
- * raise not_found.
- */
- {
- ElementPtr[MaxLevel] update = {};
- ElementPtr x = (ElementPtr.element) &list->header;
-
- for (int i = list->level; --i >= 0;)
- {
- while (x.element->forward[i] != ElementPtr.nil &&
- list->greater (value,
- x.element->forward[i].element->value))
- x = x.element->forward[i];
- update[i] = x;
- }
- x = x.element->forward[0];
- if (x == ElementPtr.nil || list->greater (x.element->value, value))
- raise not_found (value);
-
- for (int i = 0;
- i < list->level && update[i].element->forward[i] == x;
- i++)
- {
- update[i].element->forward[i] = x.element->forward[i];
- }
-
- while (list->level > 0 &&
- list->header.forward[list->level-1] == ElementPtr.nil)
- list->level--;
- }
-
- public void walk (Skip list, Visit visit)
- /*
- * Invoke 'visit' for each element of 'list'.
- * Operations on
- */
- {
- for (ElementPtr e = list->header.forward[0];
- e != ElementPtr.nil;
- e = (ElementPtr next))
- {
- next = e.element->forward[0];
- visit (e.element->value);
- }
- }
-
- public bool (&poly) iterate (Skip list)
- {
- ElementPtr e = list->header.forward[0];
-
- bool next (&poly value) {
- if (e == ElementPtr.nil)
- return false;
- value = e.element->value;
- e = e.element->forward[0];
- return true;
- }
-
- return next;
- }
-
- public int storage (Skip list, poly value)
- {
- ElementPtr x = (ElementPtr.element) &list->header;
-
- for (int i = list->level; --i >= 0;)
- {
- while (x.element->forward[i] != ElementPtr.nil &&
- list->greater (value,
- x.element->forward[i].element->value))
- x = x.element->forward[i];
- }
- x = x.element->forward[0];
- if (x == ElementPtr.nil || list->greater (x.element->value, value))
- raise not_found (value);
- return dim (x.element->forward);
- }
-}
-
-namespace Sortlist {
- public import Skiplist;
-}
diff --git a/examples/sort.5c b/examples/sort.5c
deleted file mode 100644
index dfc3e8d..0000000
--- a/examples/sort.5c
+++ /dev/null
@@ -1,97 +0,0 @@
-/* $Header$
- *
- * Copyright © 2002 Keith Packard and Bart Massey.
- * All Rights Reserved. See the file COPYING in this directory
- * for licensing information.
- */
-
-autoload PRNG;
-
-namespace Sort {
-
- /*
- * Quicksort with random pivot
- */
- public void qsort (&poly[*] a, bool(poly, poly) gt)
- {
- void quicksort (int p, int r) {
- if (p < r) {
- /* swap two array elements */
- 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 partition (int p, int r) {
- /* select a random element to pivot */
- int pivot = p + PRNG::randint(p-r);
- exchange (pivot, r);
-
- poly x = a[r];
- int i = p;
- for (int j = p; j < r; j++)
- {
- if (gt (x, a[j]))
- {
- exchange (i, j);
- i++;
- }
- }
- exchange (i, r);
- return i;
- }
-
- int q = partition (p, r);
- quicksort (p, q-1);
- quicksort (q+1, r);
- }
- }
-
- quicksort (0, dim(a)-1);
- }
-
- /*
- * Mergesort
- */
- public void mergesort (&poly[*] a, bool(poly, poly) gt)
- {
- void msort (int p, int r) {
- if (p < r)
- {
- /* merge two sorted lists together */
- void merge (int p, int q, int r)
- {
- /* temporary storage for left half of array */
- int n1 = q - p + 1;
- poly[n1] L;
- for (int i = 0; i < n1; i++)
- L[i] = a[p+i];
-
- /* temporary storage for right half of array */
- int n2 = r - q;
- poly[n2] R;
- for (int i = 0; i < n2; i++)
- R[i] = a[q+i+1];
-
- /* merge two halves back into main array */
- int i = 0, j = 0, k = p;
- while (i < n1 && j < n2)
- a[k++] = gt (L[i], R[j]) ? R[j++] : L[i++];
- while (i < n1)
- a[k++] = L[i++];
- while (j < n2)
- a[k++] = R[j++];
- }
-
- int q = (p + r) // 2;
- msort (p, q);
- msort (q+1, r);
- merge (p, q, r);
- }
- }
- msort (0, dim(a)-1);
- }
-
- protected int[*] randomints (int n, int max) =
- (int[n]) { [i] = PRNG::randint(max) };
-}
diff --git a/skiplist.5c b/skiplist.5c
new file mode 100644
index 0000000..92102f7
--- /dev/null
+++ b/skiplist.5c
@@ -0,0 +1,231 @@
+/* $Header$ */
+
+/*
+ * Copyright © 2004 Keith Packard and Bart Massey.
+ * All Rights Reserved. See the file COPYING in this directory
+ * for licensing information.
+ */
+
+autoload PRNG;
+
+namespace Skiplist {
+ public typedef bool (poly a, poly b) Greater;
+
+ public typedef void (poly a) Visit;
+
+ public exception not_found (poly missing);
+
+ /*
+ * Private representation of an element
+ */
+ typedef Element;
+
+ typedef union {
+ *Element element;
+ void nil;
+ } ElementPtr;
+
+ const MaxLevel = 16;
+
+ typedef struct {
+ poly value;
+ ElementPtr[*] forward;
+ } Element;
+
+ typedef struct {
+ int level;
+ Greater greater;
+ Element header;
+ } SkipRec;
+
+ public typedef *SkipRec Skip;
+
+ int random_level ()
+ /*
+ * This uses a fixed probability of 1/4 for each level
+ */
+ {
+ int bits = PRNG::randbits(MaxLevel * 2);
+ int level = 0;
+
+ while (++level < MaxLevel)
+ {
+ if ((bits & 3) != 0)
+ break;
+ bits >>= 2;
+ }
+ return level;
+ }
+
+ public Skip new (Greater greater)
+ /*
+ * Allocate a new list with 'greater' as the ordering function
+ */
+ {
+ return &(SkipRec) {
+ .level = 0,
+ .greater = greater,
+ .header = {
+ .forward = (ElementPtr[MaxLevel]) { [i] = ElementPtr.nil },
+ .value = <>
+ }
+ };
+ }
+
+ public poly search (Skip list, poly value)
+ /*
+ * Search 'list' for 'value', returning a
+ * matching value in the list else Raise 'not_found'.
+ */
+ {
+ ElementPtr x = (ElementPtr.element) &list->header;
+
+ for (int i = list->level; --i >= 0; )
+ {
+ while (x.element->forward[i] != ElementPtr.nil &&
+ list->greater (value,
+ x.element->forward[i].element->value))
+ x = x.element->forward[i];
+ }
+ x = x.element->forward[0];
+ if (x == ElementPtr.nil || list->greater (x.element->value, value))
+ raise not_found (value);
+ return x.element->value;
+ }
+
+ public void insert (Skip list, poly value)
+ /*
+ * Insert 'value' into 'list'
+ */
+ {
+ ElementPtr[MaxLevel] update = {};
+ ElementPtr x = (ElementPtr.element) &list->header;
+
+ for (int i = list->level; --i >= 0;)
+ {
+ while (x.element->forward[i] != ElementPtr.nil &&
+ list->greater (value,
+ x.element->forward[i].element->value))
+ x = x.element->forward[i];
+ update[i] = x;
+ }
+ x = x.element->forward[0];
+ int level = random_level ();
+ if (level > list->level)
+ {
+ level = list->level + 1;
+ list->level = level;
+ update[level-1] = (ElementPtr.element) &list->header;
+ }
+
+ /*
+ * Allocate new list entry
+ */
+ ElementPtr new = (ElementPtr.element) &(Element) {
+ .value = value,
+ .forward = (ElementPtr[level]) {}
+ };
+
+ for (int i = 0; i < level; i++)
+ {
+ new.element->forward[i] = update[i].element->forward[i];
+ update[i].element->forward[i] = new;
+ }
+ }
+
+ public void delete (Skip list, poly value)
+ /*
+ * delete entry matching 'value' from 'list', else
+ * raise not_found.
+ */
+ {
+ ElementPtr[MaxLevel] update = {};
+ ElementPtr x = (ElementPtr.element) &list->header;
+
+ for (int i = list->level; --i >= 0;)
+ {
+ while (x.element->forward[i] != ElementPtr.nil &&
+ list->greater (value,
+ x.element->forward[i].element->value))
+ x = x.element->forward[i];
+ update[i] = x;
+ }
+ x = x.element->forward[0];
+ if (x == ElementPtr.nil || list->greater (x.element->value, value))
+ raise not_found (value);
+
+ for (int i = 0;
+ i < list->level && update[i].element->forward[i] == x;
+ i++)
+ {
+ update[i].element->forward[i] = x.element->forward[i];
+ }
+
+ while (list->level > 0 &&
+ list->header.forward[list->level-1] == ElementPtr.nil)
+ list->level--;
+ }
+
+ public void walk (Skip list, Visit visit)
+ /*
+ * Invoke 'visit' for each element of 'list'.
+ * Operations on
+ */
+ {
+ for (ElementPtr e = list->header.forward[0];
+ e != ElementPtr.nil;
+ e = (ElementPtr next))
+ {
+ next = e.element->forward[0];
+ visit (e.element->value);
+ }
+ }
+
+ public bool (&poly) iterate (Skip list)
+ {
+ ElementPtr e = list->header.forward[0];
+
+ bool next (&poly value) {
+ if (e == ElementPtr.nil)
+ return false;
+ value = e.element->value;
+ e = e.element->forward[0];
+ return true;
+ }
+
+ return next;
+ }
+
+ public int length (Skip list)
+ {
+ int len = 0;
+ for (ElementPtr e = list->header.forward[0];
+ e != ElementPtr.nil;
+ e = e.element->forward[0])
+ {
+ len++;
+ }
+ return len;
+ }
+
+ public int storage (Skip list, poly value)
+ {
+ ElementPtr x = (ElementPtr.element) &list->header;
+
+ for (int i = list->level; --i >= 0;)
+ {
+ while (x.element->forward[i] != ElementPtr.nil &&
+ list->greater (value,
+ x.element->forward[i].element->value))
+ x = x.element->forward[i];
+ }
+ x = x.element->forward[0];
+ if (x == ElementPtr.nil || list->greater (x.element->value, value))
+ raise not_found (value);
+ return dim (x.element->forward);
+ }
+}
+
+namespace Sortlist {
+ public import Skiplist;
+}
diff --git a/sort.5c b/sort.5c
new file mode 100644
index 0000000..dfc3e8d
--- /dev/null
+++ b/sort.5c
@@ -0,0 +1,97 @@
+/* $Header$
+ *
+ * Copyright © 2002 Keith Packard and Bart Massey.
+ * All Rights Reserved. See the file COPYING in this directory
+ * for licensing information.
+ */
+
+autoload PRNG;
+
+namespace Sort {
+
+ /*
+ * Quicksort with random pivot
+ */
+ public void qsort (&poly[*] a, bool(poly, poly) gt)
+ {
+ void quicksort (int p, int r) {
+ if (p < r) {
+ /* swap two array elements */
+ 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 partition (int p, int r) {
+ /* select a random element to pivot */
+ int pivot = p + PRNG::randint(p-r);
+ exchange (pivot, r);
+
+ poly x = a[r];
+ int i = p;
+ for (int j = p; j < r; j++)
+ {
+ if (gt (x, a[j]))
+ {
+ exchange (i, j);
+ i++;
+ }
+ }
+ exchange (i, r);
+ return i;
+ }
+
+ int q = partition (p, r);
+ quicksort (p, q-1);
+ quicksort (q+1, r);
+ }
+ }
+
+ quicksort (0, dim(a)-1);
+ }
+
+ /*
+ * Mergesort
+ */
+ public void mergesort (&poly[*] a, bool(poly, poly) gt)
+ {
+ void msort (int p, int r) {
+ if (p < r)
+ {
+ /* merge two sorted lists together */
+ void merge (int p, int q, int r)
+ {
+ /* temporary storage for left half of array */
+ int n1 = q - p + 1;
+ poly[n1] L;
+ for (int i = 0; i < n1; i++)
+ L[i] = a[p+i];
+
+ /* temporary storage for right half of array */
+ int n2 = r - q;
+ poly[n2] R;
+ for (int i = 0; i < n2; i++)
+ R[i] = a[q+i+1];
+
+ /* merge two halves back into main array */
+ int i = 0, j = 0, k = p;
+ while (i < n1 && j < n2)
+ a[k++] = gt (L[i], R[j]) ? R[j++] : L[i++];
+ while (i < n1)
+ a[k++] = L[i++];
+ while (j < n2)
+ a[k++] = R[j++];
+ }
+
+ int q = (p + r) // 2;
+ msort (p, q);
+ msort (q+1, r);
+ merge (p, q, r);
+ }
+ }
+ msort (0, dim(a)-1);
+ }
+
+ protected int[*] randomints (int n, int max) =
+ (int[n]) { [i] = PRNG::randint(max) };
+}
commit d9d1cb686aac1709c55884f3c621185cfc94ecaf
Author: Keith Packard <keithp at keithp.com>
Date: Mon Jan 30 19:32:27 2012 -0800
Add gamma function
Signed-off-by: Keith Packard <keithp at keithp.com>
diff --git a/Makefile.am b/Makefile.am
index 9a93ba1..4837cf8 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -13,7 +13,7 @@ NICKLEFILES = builtin.5c math.5c scanf.5c mutex.5c \
arc4.5c prng.5c command.5c abort.5c \
printf.5c history.5c ctype.5c string.5c socket.5c \
file.5c parse-args.5c svg.5c process.5c \
- prime_sieve.5c factorial.5c
+ prime_sieve.5c factorial.5c gamma.5c
DEBIAN = debian/nickle.install debian/changelog debian/compat \
debian/control debian/copyright debian/rules debian/lintian.override
diff --git a/builtin.5c b/builtin.5c
index af07fce..318c2d8 100644
--- a/builtin.5c
+++ b/builtin.5c
@@ -119,6 +119,7 @@ library "command.5c";
library "math.5c";
library "prime_sieve.5c"
library "factorial.5c"
+library "gamma.5c"
import Math;
library "scanf.5c";
library "socket.5c";
diff --git a/gamma.5c b/gamma.5c
new file mode 100644
index 0000000..804d961
--- /dev/null
+++ b/gamma.5c
@@ -0,0 +1,128 @@
+
+extend namespace Math {
+
+ public real gamma(real n)
+ /*
+ * Stieljes continuing fraction method of computing
+ * gamma
+ */
+ {
+ real Stieltjes(real n, int ord, int bits) {
+
+ /*
+ * Compute the continuing fraction coefficients
+ */
+ real[*] StieltjesCF(int len, int bits) {
+
+ /* Compute a set of Bernouli numbers
+ * using the Akiyama-Tanigawa algorithm
+ */
+ real[*] AkiyamaTanigawa(int l, int bits) {
+ int n = 2 * l + 1;
+ real[n] t = { imprecise(1, bits) };
+ real[l] a;
+ int k = 1;
+ for (int m = 2; m <= n; m++) {
+ t[m-1] = 1/imprecise(m, bits);
+ for (int j = m-1; j >= 1; j--)
+ t[j-1] = j * (t[j-1] - t[j]);
+ if ((m & 1) != 0) {
+ real rk = imprecise(k, bits);
+ real v = t[0]/((2*rk-1)*(2*rk));
+ if ((k & 1) == 0)
+ a[k-1] = -v;
+ else
+ a[k-1] = v;
+ k++;
+ }
+ }
+ return a;
+ }
+ real[*] s = AkiyamaTanigawa(len, bits);
+ real[len,len] m;
+
+ for (int n = 0; n < len; n++)
+ m[n,0] = 0;
+ for (int n = 0; n < len-1; n++)
+ m[n,1] = s[n+1]/s[n];
+ for (int k = 3; k <= len; k++) {
+ for (int n = 1; n <= len - k + 1; n++) {
+ real a = m[n,k-3];
+ real b = m[n,k-2];
+ real c = m[n-1,k-2];
+ if ((k & 1) != 0)
+ m[n-1,k-1] = a + b - c;
+ else
+ m[n-1,k-1] = a * b / c;
+ }
+ }
+ m[0,0] = s[0];
+ return (real[len]) { [k] = m[0,k] };
+ }
+
+ real N = imprecise(n + 1, bits);
+ real q = N;
+ real[*] c = StieltjesCF(ord, bits);
+ real one = imprecise(1, bits);
+ for (int i = ord; i >= 2; i--)
+ q = N + c[i-1] / q;
+ return sqrt(2 * pi_value(bits)/N) * (N/exp(one)) ** N * exp(one/(12*q));
+ }
+
+ /*
+ * For positive integers, just use factorial
+ */
+ if (is_int(n)) {
+ if (n <= 0)
+ raise invalid_argument("gamma of non-positive integer", 0, n);
+ return (floor(n)-1)!;
+ }
+
+ /*
+ * Use Γ(z) = Γ(z+1)/z
+ * to solve for negative arguments
+ */
+ if (n < 0) {
+ int i = -floor(n) + 1;
+ real g = gamma(n + i);
+
+ while (i-- > 0) {
+ g = g / n;
+ n++;
+ }
+ return g;
+ }
+
+ n = imprecise(n);
+ int bits = precision(n);
+
+ /*
+ * Smaller numbers take a lot more coefficients to
+ * get the desired number of bits. Make the value
+ * larger, and increase the desired precision to match,
+ * to make the result converge faster.
+ */
+ if (n < 10000) {
+ int new_bits = bits + 14 - floor(log2(n));
+ real n_new = imprecise(n, new_bits) + 10000;
+ real g = gamma(n_new);
+ for (int i = 0; i < 10000; i++) {
+ n_new -= 1;
+ g = g / n_new;
+ }
+ return imprecise(g, bits);
+ }
+
+ /* This is a rough approximation of the
+ * number of coefficients in the fraction
+ * needed to produce the desired precision, it's
+ * good for any value larger than 10000. Larger numbers
+ * could use a smaller number of coefficients, but we
+ * don't know how much smaller
+ */
+ int ord = ceil(bits / 20);
+ return imprecise(Stieltjes(n-1, ord, bits + 20), bits);
+ }
+
+ public real(real n) Γ = gamma;
+}
commit 8a2d817b59aa16b0e15309d4372b69e4453cbc40
Author: Keith Packard <keithp at keithp.com>
Date: Mon Jan 30 12:10:56 2012 -0800
Printing rational 0 in 'e' format doesn't need an exponent
Computing a negative exponent requires a non-zero value, so just skip
that if the value is zero
Signed-off-by: Keith Packard <keithp at keithp.com>
diff --git a/rational.c b/rational.c
index e7a48b7..ae1083a 100644
--- a/rational.c
+++ b/rational.c
@@ -776,7 +776,7 @@ RationalDecimalPrint (Value f, Value rv, char format, int base, int width, int p
/*
* Check for small numbers for 'e' format
*/
- if (NaturalLess (r->num, r->den))
+ if (NaturalLess (r->num, r->den) && !NaturalZero(r->num))
{
Natural *quo, *rem;
Natural *mag;
commit 9bdf4cd13fa6e473f23ffa171566ffc296074194
Author: Keith Packard <keithp at keithp.com>
Date: Mon Jan 30 10:02:16 2012 -0800
NaturalGcd must return a Natural* when aborting
It was returning One (an Integer) instead of one_natural;
Signed-off-by: Keith Packard <keithp at keithp.com>
diff --git a/gcd.c b/gcd.c
index 2eaff30..71a4f1c 100644
--- a/gcd.c
+++ b/gcd.c
@@ -977,7 +977,7 @@ NaturalGcd (Natural *u0, Natural *v0)
while (v->length)
{
if (aborting)
- RETURN (One);
+ RETURN (one_natural);
#ifdef DEBUG_GCD
FilePrintf (FileStdout, "u = %n;\n", u);
FilePrintf (FileStdout, "v = %n;\n", v);
commit 478825cfa4a72b7f0de80d8b4e07df1ae2e77c9f
Author: Keith Packard <keithp at keithp.com>
Date: Sun Jan 29 23:26:02 2012 -0800
floor() and ceil() should work on imprecise floats
They should return an approximate integer value instead of raising an exception.
Signed-off-by: Keith Packard <keithp at keithp.com>
diff --git a/float.c b/float.c
index 3f2d2f4..b5b20f0 100644
--- a/float.c
+++ b/float.c
@@ -484,23 +484,7 @@ FloatInteger (Value av)
Natural *mag;
int dist;
- /*
- * Can only reduce floats that are integral
- *
- * Ensure that the precision of the number holds every bit
- * This requires that the precision of the representation
- * be no smaller than length of the numbers plus the
- * number of implied zeros.
- *
- * precision >= length (mant) + exponent
- * precision - length (mant) >= exponent
- * !(precision - length (mant) < exponent)
- *
- * The canonical representation ensures that length <= prec
- */
- if (a->exp->sign == Positive &&
- !NaturalLess (NewNatural (a->prec - FpartLength (a->mant)),
- a->exp->mag))
+ if (a->exp->sign == Positive)
{
mag = a->mant->mag;
dist = NaturalToInt (a->exp->mag);
commit 01b07df6e8929e2ef605327c3403271670eeccf1
Author: Keith Packard <keithp at keithp.com>
Date: Sun Jan 29 22:53:07 2012 -0800
Set version to 2.73 in prepartion for eventually release
Signed-off-by: Keith Packard <keithp at keithp.com>
diff --git a/configure.ac b/configure.ac
index 0482ada..0728551 100644
--- a/configure.ac
+++ b/configure.ac
@@ -6,7 +6,7 @@ dnl for licensing information.
AC_PREREQ([2.68])
-AC_INIT([nickle],[2.72],[http://nickle.org],[nickle])
+AC_INIT([nickle],[2.73],[http://nickle.org],[nickle])
AC_CONFIG_SRCDIR([nickle.h])
AC_CONFIG_HEADERS([config.h])
commit faab094af3dcf9a062ba9b6ec1b6b74ab8291c50
Author: Keith Packard <keithp at keithp.com>
Date: Sun Jan 29 22:50:46 2012 -0800
Only call readline tty cleanup on signal readline is active
If readline isn't active, the cleanup functions tend to make a mess of
the tty state, so don't call them. This really only matters when
handling SIGTSTP.
Signed-off-by: Keith Packard <keithp at keithp.com>
diff --git a/lex.l b/lex.l
index 8e9c76c..147ab45 100644
--- a/lex.l
+++ b/lex.l
@@ -89,6 +89,34 @@ NewLexInput (Value file, Atom name, Bool after, Bool interactive)
EXIT ();
}
+#ifdef HAVE_LIBREADLINE
+
+volatile int stdin_in_readline;
+
+static void
+my_prep_terminal(int meta_flag)
+{
+ stdin_in_readline = 1;
+ rl_prep_terminal(meta_flag);
+}
+
+static void
+my_deprep_terminal(void)
+{
+ rl_deprep_terminal();
+ stdin_in_readline = 0;
+}
+
+static int
+LexGetChar (void);
+
+static int
+ReadlineGetChar (FILE *f)
+{
+ return LexGetChar ();
+}
+#endif
+
ReferencePtr LexInputReference;
void
@@ -96,7 +124,10 @@ LexInit (void)
{
ENTER ();
-#if HAVE_RL_CATCH_SIGNALS
+#if HAVE_LIBREADLINE
+ rl_getc_function = ReadlineGetChar;
+ rl_prep_term_function = my_prep_terminal;
+ rl_deprep_term_function = my_deprep_terminal;
rl_catch_signals = 0;
#endif
LexInputReference = NewReference ((void **) &lexInput);
@@ -180,14 +211,6 @@ LexGetChar (void)
}
}
-#ifdef HAVE_LIBREADLINE
-static int
-ReadlineGetChar (FILE *f)
-{
- return LexGetChar ();
-}
-#endif
-
static Value
prompt (void)
{
@@ -227,7 +250,6 @@ LexGetInteractiveChar (void)
else
break;
}
- rl_getc_function = ReadlineGetChar;
rl_inhibit_completion = 1;
line_base = readline (p);
line = line_base;
diff --git a/main.c b/main.c
index 3baaf01..e20f1dd 100644
--- a/main.c
+++ b/main.c
@@ -166,7 +166,8 @@ intr (int sig)
int ret = write(2,"Double interrupt, exiting\n", 26);
(void) ret;
#if HAVE_RL_CLEANUP_AFTER_SIGNAL
- rl_cleanup_after_signal();
+ if (stdin_in_readline)
+ rl_cleanup_after_signal();
#endif
exit(1);
}
@@ -179,7 +180,9 @@ stop (int sig)
sigset_t set, oset;
#if HAVE_RL_CLEANUP_AFTER_SIGNAL
- rl_cleanup_after_signal();
+ printf ("stop %d\n", stdin_in_readline);
+ if (stdin_in_readline)
+ rl_cleanup_after_signal();
#endif
sigfillset (&set);
sigprocmask (SIG_SETMASK, &set, &oset);
@@ -193,7 +196,8 @@ stop (int sig)
IoStart ();
catchSignal (sig, stop);
#if HAVE_RL_RESET_AFTER_SIGNAL
- rl_reset_after_signal();
+ if (stdin_in_readline)
+ rl_reset_after_signal();
#endif
}
@@ -202,7 +206,8 @@ die (int sig)
{
IoStop ();
#if HAVE_RL_CLEANUP_AFTER_SIGNAL
- rl_cleanup_after_signal();
+ if (stdin_in_readline)
+ rl_cleanup_after_signal();
#endif
_exit (sig);
}
@@ -212,7 +217,8 @@ segv (int sig)
{
IoStop ();
#if HAVE_RL_CLEANUP_AFTER_SIGNAL
- rl_cleanup_after_signal();
+ if (stdin_in_readline)
+ rl_cleanup_after_signal();
#endif
releaseSignal (SIGSEGV);
/* return and reexecute the fatal instruction */
diff --git a/nickle.h b/nickle.h
index a9564ad..09a6056 100644
--- a/nickle.h
+++ b/nickle.h
@@ -746,7 +746,9 @@ Bool LexInteractive (void);
Bool LexResetInteractive (void);
void LexInit (void);
void NewLexInput (Value file, Atom name, Bool after, Bool interactive);
-
+#if HAVE_LIBREADLINE
+extern volatile int stdin_in_readline;
+#endif
int yywrap (void);
void yyerror (char *msg);
More information about the Nickle
mailing list