diff options
Diffstat (limited to 'libslang/examples')
| -rw-r--r-- | libslang/examples/assoc.sl | 46 | ||||
| -rw-r--r-- | libslang/examples/life.sl | 131 | ||||
| -rw-r--r-- | libslang/examples/prime.sl | 46 | ||||
| -rw-r--r-- | libslang/examples/saveobj.sl | 630 | ||||
| -rw-r--r-- | libslang/examples/sort.sl | 62 | ||||
| -rw-r--r-- | libslang/examples/utmp.sl | 67 |
6 files changed, 982 insertions, 0 deletions
diff --git a/libslang/examples/assoc.sl b/libslang/examples/assoc.sl new file mode 100644 index 0000000..c4b2b37 --- /dev/null +++ b/libslang/examples/assoc.sl @@ -0,0 +1,46 @@ +% This example illustrates the use of associative arrays. +% The function 'analyse_file' counts the number of occurrences of each word +% in a specified file. Once the file has been read in, it writes out +% the list of words and number of occurrences to the file counts.log + +define analyse_file (file) +{ + variable fp; + variable line; + variable i, a, n, word; + variable keys, values; + + fp = fopen (file, "r"); + if (fp == NULL) + verror ("Unable to open %s", file); + + % Create an Integer_Type assoc array with default value of 0. + a = Assoc_Type[Integer_Type, 0]; + + while (-1 != fgets (&line, fp)) + { + foreach (strtok (strlow(line), "^a-zA-Z\d128-\d255")) + { + word = (); + a[word] = a[word] + 1; % default value of 0 assumed!! + } + } + + () = fclose (fp); + keys = assoc_get_keys (a); + values = assoc_get_values (a); + + i = array_sort (values); + keys = keys[i]; + values = values[i]; + + fp = fopen ("count.log", "w"); + % The default array_sort for Int_Type is an ascending sort. We want the + % opposite. + for (i = n-1; i >= 0; i--) + { + () = fputs (sprintf ("%s:\t%d\n", keys[i], values[i]), fp); + } + () = fclose (fp); +} + diff --git a/libslang/examples/life.sl b/libslang/examples/life.sl new file mode 100644 index 0000000..4d750c0 --- /dev/null +++ b/libslang/examples/life.sl @@ -0,0 +1,131 @@ +% This example provides an implementation of Conway's famous game of life. +% It uses the SMG module from the modules directory. Make sure you +% build it first. + +import ("smg"); + +% This is a simple random number generator +static variable _urand_seed = _time() / (getpid () + 1); +static define _urand (unused) +{ + _urand_seed = _urand_seed * 69069UL + 1013904243UL; + return _urand_seed / 4294967296.0; +} + +static define urand (m, n) +{ + variable a = array_map (Double_Type, &_urand, [1:m*n]); + reshape (a, [m, n]); + return a; +} + +% The algorithm for the game begins here. +static define make_left (n) +{ + variable a; + + a = Int_Type [n]; + a[0] = n-1; + a[[1:]] = [0:n-2]; + + return a; +} + +static define make_right(n) +{ + variable a; + + a = Int_Type [n]; + a[[0:n-2]] = [1:n-1]; + a[-1] = 0; + + return a; +} + + +static define life_init (nr, nc) +{ + variable a; + variable up, down, left, right; + variable i; + variable num_neighbors; + + a = typecast (5.0 * urand (nr, nc), Char_Type); + a[where (a != 1)] = 0; + + up = make_left (nr); + down = make_right (nr); + left = make_left (nc); + right = make_right (nc); + + return (a,up,down,left,right); +} + +static define life_new_generation (a, up, down, left, right) +{ + variable b; + variable middle = [:]; + variable i; + + % Make sure array contains only 0 and 1 + a[where(a)] = 1; + + b = (a[up,left] + a[up, middle] + a[up, right] + + a[middle,left] + a[middle, right] + + a[down, left] + a[down, middle] + a[down, right]); + b = typecast (b, Char_Type); + + i = where ((b < 2) or (b > 3) or ((b == 2) and (a == 0))); + b[i] = 0; + return b; +} + +define life_print (a, old_a) +{ + variable dims, i, j; + (dims,,) = array_info (a); + + a = @a; + a[where (a)] = 1; + a[where (a and (old_a == 0))] = 2; + + smg_set_color (0); + smg_cls (); + + _for (0, dims[0]-1, 1) + { + i = (); + foreach (where (a[i,*])) + { + j = (); + smg_gotorc(i,j); + smg_set_color (a[i,j]); + smg_write_string ("O"); + } + } + smg_set_color (0); + smg_refresh (); + sleep (1); +} + +define life (nr, nc) +{ + variable a, left, right, up, down, new_a; + + (new_a, up, down, left, right) = life_init (nr, nc); + + a = new_a; + do + { + life_print (new_a, a); + a = new_a; + new_a = life_new_generation (a, up, down, left, right); + } + while (length (where (new_a))); +} + +smg_init_smg (); + +life (Smg_Screen_Rows, Smg_Screen_Cols); + + diff --git a/libslang/examples/prime.sl b/libslang/examples/prime.sl new file mode 100644 index 0000000..154f2ee --- /dev/null +++ b/libslang/examples/prime.sl @@ -0,0 +1,46 @@ +#! /usr/bin/env slsh +% This demo counts the number of primes between 2 and some integer + +static define usage () +{ + () = fprintf (stderr, "Usage: %S <integer greater than 2>\n", __argv[0]); + exit (1); +} + +define count_primes (num) +{ + variable size = (num - 1)/2; + variable nonprimes = Char_Type[size + 1]; % last one is sentinel + variable count = 1; + variable prime = 3; + variable i = 0; + + do + { + count++; + %()=printf ("%S\n", prime); + + nonprimes [[i:size-1:prime]] = 1; + variable i_save = i; + while (i++, nonprimes[i]) + ; + prime += 2 * (i - i_save); + } + while (i < size); + + return count; +} + + +static variable Num; + +if (__argc != 2) + usage (); +Num = integer (__argv[1]); +if (Num < 3) + usage (); + +tic (); +()=printf ("\n\n%d primes between 2 and %d in %f seconds.\n", + count_primes (Num), Num, toc ()); +exit(0); diff --git a/libslang/examples/saveobj.sl b/libslang/examples/saveobj.sl new file mode 100644 index 0000000..c7a39a1 --- /dev/null +++ b/libslang/examples/saveobj.sl @@ -0,0 +1,630 @@ +% This example shows how one can save the values of slang variables to a file +% and then load those values back in another instance of the program. +% +% The following code defines two public functions: +% +% save_object (FILE, obj, ...); +% (obj,...) = load_object (FILE); +% +% For example, +% a = [1:20]; +% b = 2.4; +% c = struct { d, e }; c.d = 2.7; c.e = "foobar"; +% save_object ("foo.save", a, b, c); +% +% saves the values of the variables a, b, c to a file called "foo.save". +% These values may be retrieved later, e.g., by another program instance +% via: +% (a,b,c) = load_object ("foo.save"); +% +% Caveats: +% +% 1. Not all object types are supported. The ones supported include: +% +% All integer types (Int_Type, Char_Type, Long_Type, ...) +% Float_Type, Double_Type +% String_Type, BString_Type +% Null_Type +% +% as well as the container classes of the above objects: +% Struct_Type, Array_Type +% +% 2. The algorithm for saving Struct_Type is recursive. This allows one to +% save a linked-list of Struct_Type objects. However, due to the recursive +% nature of the algorithm and the interpreter's finite stack size, such +% linked-lists cannot be arbitrarily long. +% +% 3. Objects are saved in the native representation. As such, the files are +% not portable across machine architectures. +% +% File Format: +% +% Each slang object is written to the file with the following format +% Data_Type (integer) +% Length of Data Bytes (unsigned integer) +% Data Bytes +% +% Here, Data Bytes may specify other objects if the parent is a container +% object. + +%_debug_info = 1; + +static variable Type_Map = Assoc_Type[Integer_Type, -1]; +static variable Write_Object_Funs = Assoc_Type[Ref_Type]; +static variable Read_Object_Funs = Assoc_Type[Ref_Type]; + +!if (is_defined ("_Save_Object_Cache_Type")) +typedef struct +{ + index +} +_Save_Object_Cache_Type; + +static variable Object_Cache; +static variable Num_Cached; + +static define delete_cache () +{ + Object_Cache = NULL; + Num_Cached = 0; +} + +static define create_cache () +{ + delete_cache (); +} + + +% If the object does not need cached, return the object. +% If the object needs cached but does not exist in the cache, cache it and +% return it. +% Otherwise, the object is in the cache, to return a _Save_Object_Cache_Type +% representing the object. +static define cache_object (obj) +{ + variable t = typeof (obj); + + if ((t != Array_Type) + and (0 == is_struct_type (obj))) + return obj; + + variable n = Num_Cached; + variable c = Object_Cache; + while (n) + { + if (__eqs (c.obj, obj)) + { + obj = @_Save_Object_Cache_Type; + obj.index = n; + return obj; + } + + c = c.next; + n--; + } + + c = struct {obj, next}; + c.obj = obj; + c.next = Object_Cache; + Object_Cache = c; + Num_Cached++; + %vmessage ("%S added to cache", c.obj); + + return obj; +} + +static define get_object_from_cache (index) +{ + variable depth = Num_Cached - index; + variable c = Object_Cache; + while (depth) + { + c = c.next; + depth--; + } + return c.obj; +} + +static define get_type_id (type) +{ + variable id; + id = Type_Map[string (type)]; + if (id == -1) + verror ("Object %S is not supported", type); + return id; +} + + + +static define write_not_implemented (fp, object) +{ + () = fprintf (stderr, "write for object %S not implemented\n", typeof (object)); + return 0; +} + +static define do_fwrite (a, fp) +{ + %vmessage ("Writing %S", a); + variable n = fwrite (a, fp); + if (n == -1) + verror ("fwrite failed: %s", errno_string (errno)); + return n; +} + +static define do_fread (t, n, fp) +{ + variable b; + if (n != fread (&b, t, n, fp)) + verror ("fread failed: %s", errno_string (errno)); + %vmessage ("Read %S", b); + return b; +} + +static define do_ftell (fp) +{ + variable pos = ftell (fp); + if (-1 == pos) + verror ("ftell failed: %s", errno_string (errno)); + return pos; +} + +static define do_fseek (fp, ofs, whence) +{ + if (-1 == fseek (fp, ofs, whence)) + verror ("fseek failed: %s", errno_string (errno)); +} + +static define sizeof (t) +{ + variable size; + + switch (t) + { case Char_Type or case UChar_Type: size = 1; } + { case Int16_Type or case UInt16_Type: size = 2; } + { case Int32_Type or case UInt32_Type: size = 4; } + { case Float_Type: size = 4; } + { case Double_Type: size = 8; } + { + verror ("sizeof (%S) not implemented", t); + } + + return size; +} + + +static define write_numbers (fp, a) +{ + variable size = sizeof (_typeof (a)); + variable num = do_fwrite (a, fp); + return num * size; +} + +static define read_numbers (fp, t, nbytes) +{ + variable size = sizeof (t); + nbytes /= size; + return do_fread (t, nbytes, fp); +} + +static define write_string (fp, a) +{ + return do_fwrite (a, fp); +} + +static define read_string (fp, t, nbytes) +{ + t = do_fread (Char_Type, nbytes, fp); + if (nbytes == 1) + t = char (t); + + return t; +} + +static define start_header (fp, id) +{ + variable len = write_numbers (fp, id); + variable pos = do_ftell (fp); + len += write_numbers (fp, 0); % temporary + + variable h = struct + { + pos, len + }; + h.pos = pos; + h.len = len; + + return h; +} + +static define end_header (fp, h, num) +{ + do_fseek (fp, h.pos, SEEK_SET); + () = do_fwrite (num, fp); + do_fseek (fp, 0, SEEK_END); + return h.len + num; +} + +static define id_to_datatype (id) +{ + variable keys, values; + + keys = assoc_get_keys (Type_Map); + values = assoc_get_values (Type_Map); + variable i = where (values == id); + !if (length (i)) + verror ("Corrupt file? Unknown type-id (%d)", id); + return eval (keys[i][0]); +} + +static define write_scalars (fp, a) +{ + variable id = get_type_id (typeof (a)); + variable h = start_header (fp, id); + variable len = write_numbers (fp, a); + return end_header (fp, h, len); +} + +static define read_null (fp, t, nbytes) +{ + return NULL; +} + +static define write_null (fp, a) +{ + return 0; +} + +static define write_object (); +static define read_object (); + +% Array DataBytes: int num_dims, int dims[num_dims], type, Data... +static define write_array (fp, a) +{ + variable dims, num_dims, data_type; + (dims, num_dims, data_type) = array_info (a); + variable len; + variable id = get_type_id (data_type); + + len = write_numbers (fp, num_dims) + write_numbers (fp, dims) + + write_numbers (fp, id); + + % For now allow numbers or strings + if (_typeof(a) == String_Type) + { + foreach (a) + { + variable elem = (); + len += write_object (fp, elem); + } + + return len; + } + + len += write_numbers (fp, a); + + return len; +} + +static define read_array (fp, type, nbytes) +{ + variable num_dims = do_fread (Int_Type, 1, fp); + variable dims = do_fread (Int_Type, num_dims, fp); + type = do_fread (Int_Type, 1, fp); + variable len; + len = 1; + foreach (dims) + len *= (); + + type = id_to_datatype (type); + + variable v; + + if (type == String_Type) + { + v = String_Type [len]; + _for (0,len-1,1) + { + variable i = (); + v[i] = read_object (fp, NULL); + } + } + else v = do_fread (type, len, fp); + + reshape (v, dims); + return v; +} + +% Data Bytes: int num_fields. String-Object [num_fields], Values[num_fields] +static define write_struct (fp, a) +{ + variable fields = get_struct_field_names (a); + variable len = write_numbers (fp, typecast (length (fields), Int_Type)); + foreach (fields) + { + variable f = (); + len += write_object (fp, f); + } + + foreach (fields) + { + f = (); + len += write_object (fp, get_struct_field (a, f)); + } + + return len; +} + +static define read_struct (fp, type, nbytes) +{ + variable num_fields = do_fread (Int_Type, 1, fp); + variable fields = String_Type[num_fields]; + variable i; + _for (0, num_fields-1, 1) + { + i = (); + fields[i] = read_object (fp, NULL); + } + + variable s = @Struct_Type (fields); + + % make sure it is in the cache in case the fields refer to it. + if (type != _Save_Object_Cache_Type) + () = cache_object (s); + + _for (0, num_fields-1, 1) + { + i = (); + set_struct_field (s, fields[i], read_object (fp, NULL)); + } + + return s; +} + +% Data Bytes: int index +static define write_cached_object (fp, a) +{ + return write_numbers (fp, a.index); +} + + +static define read_cached_object (fp, type, nbytes) +{ + variable index = read_numbers (fp, Int_Type, nbytes); + return get_object_from_cache (index); +} + + +static define add_type (t, w, r, id) +{ + t = string (t); + Type_Map[t] = id; + Write_Object_Funs[t] = w; + Read_Object_Funs [t] = r; +} + +add_type (Char_Type, &write_numbers, &read_numbers, 1); +add_type (UChar_Type, &write_numbers, &read_numbers, 2); +add_type (Short_Type, &write_numbers, &read_numbers, 3); +add_type (UShort_Type, &write_numbers, &read_numbers, 4); +add_type (Integer_Type, &write_numbers, &read_numbers, 5); +add_type (UInteger_Type,&write_numbers, &read_numbers, 6); +add_type (Long_Type, &write_numbers, &read_numbers, 7); +add_type (ULong_Type, &write_numbers, &read_numbers, 8); +add_type (Float_Type, &write_numbers, &read_numbers, 9); +add_type (Double_Type, &write_numbers, &read_numbers, 10); +add_type (String_Type, &write_string, &read_string, 11); +add_type (BString_Type, &write_string, &read_string, 12); +add_type (Struct_Type, &write_struct, &read_struct, 13); +add_type (Array_Type, &write_array, &read_array, 14); +add_type (Null_Type, &write_null, &read_null, 15); + +add_type (_Save_Object_Cache_Type, &write_cached_object, &read_cached_object, 1000); + +static define get_write_function (type) +{ + variable key = string (type); + if (assoc_key_exists (Write_Object_Funs, key)) + return Write_Object_Funs[key]; + verror ("No write method defined for %S", key); +} + +static define get_read_function (type) +{ + variable key = string (type); + if (assoc_key_exists (Read_Object_Funs, key)) + return Read_Object_Funs[key]; + verror ("No read method defined for %S", key); +} + +static define write_object (fp, a) +{ + a = cache_object (a); + variable id = get_type_id (typeof (a)); + + variable h = start_header (fp, id); + variable f = get_write_function (typeof (a)); + variable num = (@f)(fp, a); + %vmessage ("Done Writing %S", a); + return end_header (fp, h, num); +} + +static define read_object (fp, statusp) +{ + variable type, nbytes; + variable status = fread (&type, Integer_Type, 1, fp); + if (status == -1) + { + if (statusp == NULL) + verror ("No more objects in file"); + + @statusp = 0; + return 0; + } + + nbytes = do_fread (Integer_Type, 1, fp); + type = id_to_datatype (type); + + variable f = get_read_function (type); + variable v = (@f)(fp, type, nbytes); + + % Necessary because String_Type may get written as BString_Type + if (type != _Save_Object_Cache_Type) + v = typecast (v, type); + + %vmessage ("Read %S", v); + if (statusp != NULL) + @statusp = 1; + + return v; +} + + +public define save_object () +{ + if (_NARGS < 2) + usage ("save_object (file, obj1, ...)"); + + variable objs = __pop_args (_NARGS - 1); + variable file = (); + + variable fp = fopen (file, "w+"); + if (fp == NULL) + verror ("Unable to open %s: %s", file, errno_string (errno)); + + create_cache (); + + foreach (objs) + { + variable obj = ().value; + () = write_object (fp, obj); + } + + delete_cache (); +} + +public define load_object (file) +{ + variable fp = fopen (file, "r"); + if (fp == NULL) + verror ("Unable to open %s: %s", file, errno_string (errno)); + + create_cache (); + forever + { + variable status; + variable obj = read_object (fp, &status); + if (status == 0) + break; + obj; + } + delete_cache (); +} + +#iffalse +% Regression test +static define failed (s, a, b) +{ + vmessage ("Failed: %s: wrote: '%S', read '%S'\n", s, a, b); +} + +static define test_eqs (); +static define test_eqs (a, b) +{ + if ((typeof (a) != typeof (b)) + or (_typeof (a) != _typeof (b))) + { + failed ("typeof", typeof(a), typeof(b)); + return 0; + } + + if (typeof (a) != Struct_Type) + { + if (length (a) != length (b)) + { + failed ("test_eqs length", a, b); + return 0; + } + + if (length (where (a != b))) + { + failed ("test_eqs", a, b); + return 0; + } + return 1; + } + + variable fa, fb; + fa = get_struct_field_names (a); + fb = get_struct_field_names (b); + + !if (test_eqs (fa, fb)) + { + failed ("test_eqs: fa, fb"); + return 0; + } + + if (length (fa) != length (fb)) + return 0; + + foreach (fa) + { + variable name = (); + variable va, vb; + va = get_struct_field (a, name); + vb = get_struct_field (b, name); + if ((typeof (va) == Struct_Type) + and (typeof (vb) == Struct_Type)) + { + % void loop + continue; + } + !if (test_eqs (va, vb)) + return 0; + } + + return 1; +} + +static define test_save_object () +{ + variable x0 = 1278; + variable x1 = 2.3; + variable x2 = "foo"; + variable x3 = struct + { + a, b, c, d + }; + variable x4 = [1:10]; + variable x5 = ["a","b","c","d"]; + + x3.a = "foo"; + x3.b = PI; + x3.c = [1:20]; + x3.d = x3; + + save_object ("foo.sv", x0,x1,x2,x3,x4,x5); + + variable y0,y1,y2,y3,y4,y5; + + (y0,y1,y2,y3,y4,y5) = load_object ("foo.sv"); + + !if (test_eqs (x0, y0)) + failed ("x0", x0, y0); + !if (test_eqs (x1, y1)) + failed ("x1", x1, y1); + !if (test_eqs (x2, y2)) + failed ("x2", x2, y2); + + !if (test_eqs (x3, y3)) + failed ("x3", x3, y3); + + !if (test_eqs (x4, y4)) + failed ("x4", x4, y4); + !if (test_eqs (x5, y5)) + failed ("x5", x5, y5); + + vmessage ("Regression Test Done"); +} + +test_save_object (); +#endif diff --git a/libslang/examples/sort.sl b/libslang/examples/sort.sl new file mode 100644 index 0000000..c2eb7ad --- /dev/null +++ b/libslang/examples/sort.sl @@ -0,0 +1,62 @@ +#! /usr/bin/env slsh + +% This program presents the solution to a problem posed by +% Tom Christiansen <tchrist@mox.perl.com>. The problem reads: +% +% Sort an input file that consists of lines like this +% +% var1=23 other=14 ditto=23 fred=2 +% +% such that each output line is sorted WRT to the number. Order +% of output lines does not change. Resolve collisions using the +% variable name. e.g. +% +% fred=2 other=14 ditto=23 var1=23 +% +% Lines may be up to several kilobytes in length and contain +% zillions of variables. +%--------------------------------------------------------------------------- +% +% The solution presented below works by breaking up the line into an +% array of alternating keywords and values with the keywords as the even +% elements and the values as the odd. It is about 30% faster than the +% python solution. + +static variable Keys, Values; +static define sort_fun (i, j) +{ + variable s, a, b; + + s = Values[i] - Values[j]; + !if (s) + return strcmp (Keys[i], Keys[j]); + return s; +} + + +define main () +{ + variable line, len, i, vals; + foreach (stdin) + { + line = (); + line = strtok (line, " \t\n="); + len = length(line)/2; + if (len == 0) + continue; + + % Even elements are keys, odd are values + Keys = line[[0::2]]; + vals = line[[1::2]]; + + Values = array_map(Int_Type, &integer, vals); + + i = array_sort ([0:len-1], &sort_fun); + + % There are different ways of writing the result. Here is a + % fast way that avoids a loop. + () = printf ("%s\n", strjoin (Keys[i] + "=" + vals[i], " ")); + } +} + +main (); diff --git a/libslang/examples/utmp.sl b/libslang/examples/utmp.sl new file mode 100644 index 0000000..b7a69af --- /dev/null +++ b/libslang/examples/utmp.sl @@ -0,0 +1,67 @@ +% This file illustrates how to read a binary file into a structure. In this +% case, the file is the Unix utmp file. +% +% Note that the format of the utmp file will vary with the OS. The format +% encoded here is for glibc Linux, but even that may be version-dependent. + +variable format, size, fp, buf; + +variable is_glibc = 1; + +#ifeval is_glibc +typedef struct +{ + ut_type, ut_pid, ut_line, ut_id, + ut_user, ut_host, ut_exit, ut_session, ut_tv, ut_addr +} UTMP_Type; +% The ut_tv is a timeval structure which has the format: l2 +% Also the ut_exit field is a struct of h2 +format = pad_pack_format ("h i S32 S4 S32 S256 h2 l l2 k4 x20"); +#else +typedef struct +{ + ut_type, ut_pid, ut_line, ut_id, + ut_time, ut_user, ut_host, ut_addr +} UTMP_Type; +format = pad_pack_format ("h i S12 S2 l S8 S16 l"); +#endif + +size = sizeof_pack (format); +vmessage ("Sizeof of utmp line: %d bytes", size); + +define print_utmp (u) +{ + () = fprintf (stdout, "%-16s %-12s %-16s %s\n", + u.ut_user, u.ut_line, u.ut_host, +#ifeval is_glibc + ctime (u.ut_tv[0]) +#else + ctime (u.ut_time) +#endif + ); +} + +variable Utmp_File; +foreach (["/var/run/utmp", "/var/log/utmp"]) +{ + Utmp_File = (); + fp = fopen (Utmp_File, "rb"); + if (fp != NULL) + break; +} + +if (fp == NULL) error ("Unable to open utmp file"); + +() = fprintf (stdout, "%-16s %-12s %-16s %s\n", + "USER", "TTY", "FROM", "LOGIN@"); + +variable U = @UTMP_Type; + +while (size == fread (&buf, Char_Type, size, fp)) +{ + set_struct_fields (U, unpack (format, buf)); + print_utmp (U); +} + +() = fclose (fp); + |