Newsgroups: comp.lang.apl
Path: watmath!watserv2.uwaterloo.ca!torn!utnut!cs.utexas.edu!wupost!csus.edu!sfsuvax1.sfsu.edu!vpcsc4
From: vpcsc4@sfsuvax1.sfsu.edu (Emmett McLean)
Subject: Keyed files as primitives 
Message-ID: <1993Jun4.084053.26022@csus.edu>
Sender: news@csus.edu
Organization: San Francisco State University
Date: Fri, 4 Jun 1993 08:40:53 GMT
Lines: 369

 Keyed files as primitives for J.

#!/bin/sh
# This is a shell archive (produced by shar 3.50)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 06/04/1993 08:32 UTC by emclean@sfsuvax1.sfsu.edu
# Source directory /usr/s3/emclean/src
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#    587 -rw------- readme
#   4178 -rw------- jk.c
#   2771 -rwx--x--x key.doc
#   1566 -rw------- key.js
#    121 -rw------- diff_x.c
#
# ============= readme ==============
if test -f 'readme' -a X"$1" != X"-c"; then
	echo 'x - skipping readme (File already exists)'
else
echo 'x - extracting readme (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'readme' &&
Attached are :
X
X 0. readme. 
X    This file.
X
X 1. jk.c. 
X    The C implementation of Mike Powell's keyed files programs.
X
X 2. key.doc  
X    Documentation 
X
X 3. key.js
X    Torture test script
X
X 4. diff_x.c
X    The UNIX diff output of x.c from the J source (version 6.3)
X    and the x.c file after it has been altered.
X
X Instructions:
X
X 1. Change the makefile so that OBJ includes jk.o
X
X 2. Add the lines from diff_x.c to x.c
X
X 3. Make j. Type make.
X
X 4. Run the script key.js
X
X As I receive comments and suggestions I will continue to make
X improvements. Your ideas are welcome.
X
X -Emmett
SHAR_EOF
chmod 0600 readme ||
echo 'restore of readme failed'
Wc_c="`wc -c < 'readme'`"
test 587 -eq "$Wc_c" ||
	echo 'readme: original size 587, current size' "$Wc_c"
fi
# ============= jk.c ==============
if test -f 'jk.c' -a X"$1" != X"-c"; then
	echo 'x - skipping jk.c (File already exists)'
else
echo 'x - extracting jk.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'jk.c' &&
/* ----------------------------------------------------------------------- */
/*                                                                         */
/* Mike Powell's keyed file programs                                       */
/* interfaced with J by emclean@vax1.sfsu.edu                              */
X
#include "j.h"
#define IAV(x) (I)*AV(x)
X
I kvs(w) A w;{A m,n;I t;
X RZ(w);if(!i0(tally(ope(w))))R 0;
X m=ope(w);if(!(BOX&AT(w)&&(AN(m)>=0)&&AT(m)&CHAR))R 0 ;
X n=eq(scc(' '),m);if(!i0(match(df1(n,bslash(slash(ds(COR)))),n)))R 0;
X R 1;
}
static F1(kcrt){PROLOG;A m,n,o;
X F1RANK(0,kcrt,0);RZ(w);ASSERT(kvs(w),EVDOMAIN);
X m=lrep(iota(sc(0)));n=lrep(reitem(v2(0,3),sc(0)));
X o=over(sc(1024),over(sc(1536),over(shape(n),sc(1024))));
X o=lrep(reitem(v2(2,3),over(sc(512),over(shape(m),o))));
X o=over(take(sc(512),o),over(take(sc(1024),m),take(sc(1024),n)));
X jfwrite(o,w);EPILOG(shape(o));
}
static F2(kget){PROLOG;A m,n,o;
X F2RANK(RMAXL,0,kget,0);RZ(a&&w);ASSERT(kvs(w),EVDOMAIN);
X m=exec1(jiread(over(w,box(v2(0,512)))));
X ASSERT(2==AR(m)&&6==AN(m),EVFACE);
X n=exec1(jiread(over(w,box(from(v2(0,1),from(sc(0),m))))));
X o=exec1(jiread(over(w,box(from(v2(0,1),from(sc(1),m))))));
X EPILOG(exec1(jiread(over(w,box(ravel(from(v2(0,1),from(indexof(n,box(a)),o))))))));
}
static F1(kmwrite){PROLOG;A m,n;RZ(w);
X m=from(sc(0),w);w=ope(from(sc(1),w));n=over(jfsize(m),shape(w));
X w=take(tymes(sc(512),ceil1(divide(shape(w),sc(400)))),w);
X m=(A)jfappend(w,m);EPILOG(over(n,shape(w)));
}
static F2(knwrite){PROLOG;A m,n;RZ(w);
X m=ge(from(sc(2),a),shape(ope(from(sc(1),w))));
X if(!IAV(m)) EPILOG(kmwrite(w));
X  else {
X  m=from(sc(0),w);w=ope(from(sc(1),w));
X  m=(A)jiwrite(w,over(m,box(over(from(sc(0),a),shape(w)))));
X  EPILOG(over(from(sc(0),a),over(shape(w),from(sc(2),a))));
X }
}
static F1(kdir){PROLOG;A b;
X F1RANK(0,kdir,0);ASSERT(kvs(w),EVDOMAIN); 
X b=exec1(jiread(over(w,box(v2(0,512)))));
X ASSERT(2==AR(b)&&6==AN(b),EVFACE);
X EPILOG(exec1(jiread(over(w,box(from(v2(0,1),from(sc(0),b)))))));
}
static F2(kput){PROLOG; A m,n,o,d,e,f,t;
X F2RANK(1,0,kget,0);RZ(a&&w);ASSERT(kvs(w),EVDOMAIN);
X ASSERT(0==i0(eps(head(a),kdir(w))),EVINDEX);
X n=exec1(jiread(over(w,box(v2(0,512)))));
X ASSERT(2==AR(n)&&6==AN(n),EVFACE);
X o=exec1(jiread(over(w,box(from(v2(0,1),from(sc(0),n))))));
X d=exec1(jiread(over(w,box(from(v2(0,1),from(sc(1),n))))));
X m=from(sc(0),a);a=lrep(ope(from(sc(1),a)));
X e=indexof(o,m);t=ge(e,tally(o));
X if (IAV(t)){
X  f=kmwrite(over(w,box(a)));o=over(o,m);
X  m=knwrite(ravel(from(sc(0),n)),over(w,box(lrep(o))));
X  d=over(d,f);n=knwrite(ravel(from(sc(1),n)),over(w,box(lrep(d))));
X  m=reitem(v2(2,3),over(m,n));m=take(sc(512),lrep(m));
X  EPILOG(left1(f,jiwrite(m,over(w,box(v2(0,512))))));
X }else{
X  f=knwrite(ravel(from(e,d)),over(w,box(a)));
X  m=over(take(e,d),over(f,drop(increm(e),d)));
X  m=knwrite(ravel(from(sc(1),n)),over(w,box(lrep(m))));
X  m=reitem(v2(2,3),over(from(sc(0),n),m));
X  EPILOG(left1(f,jiwrite(m,over(w,box(v2(0,512))))));
X }
} 
static F2(kcpy){PROLOG;A m,n;I i,t;
X F2RANK(0,0,kcpy,0);RZ(a&&w);ASSERT(kvs(w),EVDOMAIN);
X ASSERT(kvs(a),EVDOMAIN);
X m=kdir(a);n=sc(0);t=i0(tally(m));kcrt(w);
X DO(t,left1(increm(n),kput(over(from(n,m),box(kget(ope(from(n,m)),a))),w)););
X EPILOG(over(jfsize(a),jfsize(w)));
}
static F2(kdel){PROLOG;A m,n,o,d;
X F2RANK(RMAXL,0,kdel,0);RZ(a&&w);ASSERT(kvs(w),EVDOMAIN); 
X m=exec1(jiread(over(w,box(v2(0,512)))));
X ASSERT(2==AR(m)&&6==AN(m),EVFACE);
X n=exec1(jiread(over(w,box(from(v2(0,1),from(sc(0),m))))));
X o=exec1(jiread(over(w,box(from(v2(0,1),from(sc(1),m))))));
X d=not(eps(n,box(a)));n=repeat(d,n);
X n=knwrite(ravel(from(sc(0),m)),over(w,box(lrep(n))));
X o=repeat(d,o);o=knwrite(ravel(from(sc(1),m)),over(w,box(lrep(o))));
X m=reitem(v2(2,3),over(n,o));m=take(sc(512),lrep(m));
X EPILOG(left1(eps(sc(0),d),jiwrite(m,over(w,box(v2(0,512))))));
}
static F1(kmer){ASSERT(0,EVDOMAIN);}
static F2(kder){ASSERT(0,EVDOMAIN);}
C jkey(k,f1,f2)I k;AF*f1,*f2;
{ switch(k){
X  case 0: *f1=kcrt; *f2=kder; R 1;
X  case 1: *f1=kmer; *f2=kget; R 1;
X  case 2: *f1=kmer; *f2=kput; R 1;
X  case 3: *f1=kdir; *f2=kder; R 1;
X  case 4: *f1=kmer; *f2=kcpy; R 1;
X  case 5: *f1=kmer; *f2=kdel; R 1;
X  default: ASSERT(0,EVNONCE);       
X  }
}
SHAR_EOF
chmod 0600 jk.c ||
echo 'restore of jk.c failed'
Wc_c="`wc -c < 'jk.c'`"
test 4178 -eq "$Wc_c" ||
	echo 'jk.c: original size 4178, current size' "$Wc_c"
fi
# ============= key.doc ==============
if test -f 'key.doc' -a X"$1" != X"-c"; then
	echo 'x - skipping key.doc (File already exists)'
else
echo 'x - extracting key.doc (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'key.doc' &&
X 
X NB. KEYED FILES.                  Mike Powell, Dec 1992.
X NB. J interface by Emmett McLean emclean@vax1.sfsu.edu June 3, 1993
X
X /* Special thanks to Mike Powell for writting these verbs */
X
X This package provides implements keyed file operations as primitive
X operators.
X
X Tested on NeXT/ULTRIX 4.3
X All values are stored in 5!:5 format. Values retrieved from the file
X are recreated with the Do verb, ". .
X
X Some checking is done. A domain error occurs if a filename is not
X composed of contigous spaces.  An index error occurs upon using a Put 
X instruction on a noun whose key already exists. No checking is done
X for nonexistent filenames.
X
X Create =. 50!:0
X Get    =. 50!:1
X Put    =. 50!:2
X Dir    =. 50!:3
X Copy   =. 50!:4
X Delete =. 50!:5
X
X 50!:0 <'filename' NB. Create
X   Creates a file and initializes its directory. Initially,
X   0-511     contain a two row integer matrix describing where to find
X             the list of keys and table of locations. Columns are
X             offset, size and slot capacity.
X   512-1535  The list of keys.
X             This is a list of boxed nouns. Initially empty.
X   1536-2559 The table of locations.
X             A two row integer matrix describing where to find the
X    objects associated with the elements of the list of keys.
X   Later, should either the list of keys or table of locations exceed
X   the slot capacity, they will be moved to a different part of the
X   file and given a greater capacity.
X   Returns the size of the file.
X
X NB. Get
X key 50!:1 <'filename' 
X   Returns the value associated with key. Produces an error if the key
X   does not exist.
X
X NB. Put
X (key;value) 50!:2 <'filename' 
X   Returns three integers - the offset,size and reserved capacity used
X   for this value.
X
X   If the key is a new one, its value is padded and appended to the end.
X   Padding is about 25%, rounded up to a 512B boundary.
X   If the key already exists and the value fits in the existing slot,
X   the new value replaces the old.
X   If the key already exists and the size of the new value exceeds the
X   space reserved, the value is padded and appended to the end.
X   Makes no attempt to reuse wasted space within the file.
X
X   A key is a noun. For example, the following are all usable as distinct
X   keys:
X     'abcd'
X  <'abcd'
X  1 4$'abcd'
X  i.4 10
X  6.7j8
X
X NB. Dir
X 50!:3<'filename'
X   Returns the list of keys.
X   For example, to test if a key is already present;
X   (<'abc')e. Dir<'filename'
X
X NB. Copy
X (<'sourcefile')50!:4 <'destination file'
X   Copies the contents of one file to another. Creates the destination
X   file. Eliminates wasted space.  Returns the before and after file sizes.
X
X NB. Delete
X key 50!:5<'filename'
X   Removes key from the list of keys.
X   Returns boolean (1=deleted, 0=not deleted).
X
SHAR_EOF
chmod 0711 key.doc ||
echo 'restore of key.doc failed'
Wc_c="`wc -c < 'key.doc'`"
test 2771 -eq "$Wc_c" ||
	echo 'key.doc: original size 2771, current size' "$Wc_c"
fi
# ============= key.js ==============
if test -f 'key.js' -a X"$1" != X"-c"; then
	echo 'x - skipping key.js (File already exists)'
else
echo 'x - extracting key.js (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'key.js' &&
X    create =. 50!:0
X    get    =. 50!:1
X    put    =. 50!:2
X    dir    =. 50!:3
X    copy   =. 50!:4
X    delete =. 50!:5
X    
X    50!:0 <'testfile'
X    NB. demo
X    (('abc');(i.10)) put <'testfile'
X    (('def');(i.5 5)) put <'testfile'
X    (('mno');(2*i.5 5)) put <'testfile'
X    (('xyz');('junkstuff')) put <'testfile'
X    dir <'testfile'
X    ('abc') get <'testfile'
X    ('xyz') get <'testfile'
X    create <'newtestfile'
X    (<'testfile') copy <'newtestfile'
X    dir <'newtestfile'
X    ('abc') delete <'newtestfile'
X    dir <'newtestfile'
X    ('def') delete <'newtestfile'
X    ('mno') delete <'newtestfile'
X    ('xyz') delete <'newtestfile'
X    (('yyz');('junkstuff')) put <'testfile'
X   
X    a =. i. 0 0
X    a =. a,'y. =. 4 >. y.'
X    a =. a,'b=. ? (y. , 5 5) $ 1000'
X    a =. a,'i=.0 '
X    a =. a,'create <''testfile'' '
X    a =. a,'loop0)'
X    a =. a,'1!:2&2 i'
X    a =. a,'d=. (i;(i{b))put <''testfile'' '
X    a =. a,'$.=.>(y.=(i=.>:i)) { loop0 ; end0 '
X    a =. a,'end0) 1!:2&2 dir <''testfile'' '
X    a =. a,'(<''testfile'') copy <''ntestfile'' '
X    a =. a,'dir<''ntestfile'' '
X    a =. a,'1!:2&2 ,&'' '' ": (3{b)'
X    a =. a,'1!:2&2 (? y.) get <''testfile'' '
X    a =. a,'i=. 0'
X    a =. a,'loop1)'
X    a =. a,'d=. i delete <''testfile'' '
X    a =. a,'$.=.>(y.=(i=.>:i)) { loop1 ; end1 '
X    a =. a,'end1)'
X    a =. a,'y. =. dir <''testfile'' '
X    a =. a : '' 
X   
X    NB. incorrect usage : 
X    create <'testfile typeo'  
X
X    NB. duplicate key 
X    create<'testfile' 
X    (3;4)put<'testfile'
X    (3;5)put<'testfile'
X
X    NB. null filename
X    dir<''
X    
SHAR_EOF
chmod 0600 key.js ||
echo 'restore of key.js failed'
Wc_c="`wc -c < 'key.js'`"
test 1566 -eq "$Wc_c" ||
	echo 'key.js: original size 1566, current size' "$Wc_c"
fi
# ============= diff_x.c ==============
if test -f 'diff_x.c' -a X"$1" != X"-c"; then
	echo 'x - skipping diff_x.c (File already exists)'
else
echo 'x - extracting diff_x.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'diff_x.c' &&
98,100d97
<  if(20==p){AF*f1,*f2;
<   ASSERT(jcob(q,&f1,&f2),EVDOMAIN);
<   R CDERIV(CIBEAM, f1,f2, RMAXL,RMAXL,RMAXL);}
SHAR_EOF
chmod 0600 diff_x.c ||
echo 'restore of diff_x.c failed'
Wc_c="`wc -c < 'diff_x.c'`"
test 121 -eq "$Wc_c" ||
	echo 'diff_x.c: original size 121, current size' "$Wc_c"
fi
exit 0
