earlw@pesnta.UUCP (Earl Wallace) (06/13/85)
#! /bin/sh
#
# This is an another posting of the Little Smalltalk source, the last posting
# of this source went out in 5 parts and they were too big (>200k) for most
# sites so I redid the whole mess to keep the files around the 50k range.
#
# The complete set is now 20 parts.
#
# P.S. - If you don't receive all 20 parts within 5 days, drop me a line.
# Also, I have the Rand sources of May 1984, if someone has a more
# updated copy, I'll be happy to post them (or YOU can post them :-))
#
# -earlw@pesnta
#
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# projects/object.h
# projects/pat.c
# projects/pat.h
# projects/primes.st
# This archive created: Thu Jun 13 11:32:38 1985
# By: Earl Wallace (Perkin-Elmer Data Systems Group / Customer Service)
export PATH; PATH=/bin:$PATH
if test -f 'projects/object.h'
then
echo shar: will not over-write existing file "'projects/object.h'"
else
cat << \SHAR_EOF > 'projects/object.h'
/*
Little Smalltalk object definitions
*/
# include "env.h"
/*
for objects the inst_var array is actually made as large as
necessary (as large as the size field). since C does not do
subscript bounds checking array indexing can be used
*/
struct obj_struct {
int ref_count;
int size;
struct class_struct *class;
struct obj_struct *super_obj;
struct obj_struct *inst_var[1];
};
/*
for classes
c_size = CLASSSIZE
class_name and super_class should be SYMBOLs
containing the names of the class and superclass,
respectively.
c_inst_vars should be an array of symbols, containing the
names of the instance variables
context size is the size of the context that should be
created each time a message is sent to objects of this
class.
message_names should be an array of symbols, corresponding
to the messages accepted by objects of this class.
methods should be an array of arrays, each element being a
two element array of bytecodes and literals.
*/
struct class_struct {
int c_ref_count;
int c_size;
struct obj_struct *class_name;
struct obj_struct *super_class;
struct obj_struct *file_name;
struct obj_struct *c_inst_vars;
int context_size;
struct obj_struct *message_names;
struct obj_struct *methods;
};
typedef struct class_struct class;
typedef struct obj_struct object;
/*
objects with non-object value (classes, integers, etc) have a
negative size field, the particular value being used to indicate
the type of object (the class field cannot be used for this purpose
can all classes, even those for built in objects, can be redefined)
check_bltin is a macro that tests the size field for a particular
value. it is used to define other macros, such as is_class, that
test each particular type of object.
The following classes are builtin
Block
ByteArray
Char
Class
Float
Integer
Interpreter
String
Symbol
*/
# define BLOCKSIZE -83
# define BYTEARRAYSIZE -567
# define CHARSIZE -33
# define CLASSSIZE -3
# define FILESIZE -5
# define FLOATSIZE -31415
# define INTEGERSIZE -17
# define INTERPSIZE -15
# define STRINGSIZE -258
# define SYMBOLSIZE -14
# define is_bltin(x) (((object *) x)->size < 0)
# define check_bltin(obj, type) (((object *) obj)->size == type)
# define is_block(x) check_bltin(x, BLOCKSIZE)
# define is_bytearray(x) check_bltin(x, BYTEARRAYSIZE)
# define is_character(x) check_bltin(x, CHARSIZE)
# define is_class(x) check_bltin(x, CLASSSIZE)
# define is_file(x) check_bltin(x, FILESIZE)
# define is_float(x) check_bltin(x, FLOATSIZE)
# define is_integer(x) check_bltin(x, INTEGERSIZE)
# define is_interpreter(x) check_bltin(x, INTERPSIZE)
# define is_string(x) check_bltin(x, STRINGSIZE)
# define is_symbol(x) check_bltin(x, SYMBOLSIZE)
/*
mstruct is used (via casts) to store linked lists of structures of
various types for memory saving and recovering
*/
struct mem_struct {
struct mem_struct *mlink;
};
typedef struct mem_struct mstruct;
/*
sassign assigns val to obj, which should not have a valid
value in it already.
assign decrements an existing val field first, then assigns.
note this will not work for assign(x,x) if x ref count is 1.
*/
# define sassign(obj, val) obj_inc((object *) (obj = val))
# define assign(obj, val) {obj_dec((object *) obj); sassign(obj, val);}
# define structalloc(type) (type *) o_alloc(sizeof(type))
/*
if INLINE is defined ( see env.h) , inline code will be generated
for object increments. inline code is generally faster, but
larger
*/
# ifdef INLINE
# define obj_inc(x) n_incs++, (x)->ref_count++
# endif
extern int n_incs, n_decs;
extern char *o_alloc();
extern object *new_inst(), *new_sinst();
extern object *new_obj();
extern object *new_array();
extern object *primitive();
extern object *o_nil;
extern object *o_true;
extern object *o_false;
extern int debug;
SHAR_EOF
if test 3941 -ne "`wc -c < 'projects/object.h'`"
then
echo shar: error transmitting "'projects/object.h'" '(should have been 3941 characters)'
fi
fi # end of overwriting check
if test -f 'projects/pat.c'
then
echo shar: will not over-write existing file "'projects/pat.c'"
else
cat << \SHAR_EOF > 'projects/pat.c'
#include <stdio.h>
#include <curses.h>
#include <ctype.h>
#include "pat.h"
#define DEBUG 0
#define MAXCHARS 128
#define ADDBUF(c) addbuf(c)
char spat[MAXCHARS]; /* holds pattern to be searched */
/* SUGGESTED CALLING SEQUENCE:
if (makepat(buf) != 0)
error("bad pattern");
...
if (match(s, spat))
then this is the line you want
*/
char *s; /* current focus of interest in input pattern */
static char *p = spat; /* not sure what this does */
#define DODASH(a,b) if (dodash( a, b ) == MYERR ) return MYERR
char *cur_line; /* points to beginning of pattern to match */
char *amatch();
/* makepat - make pattern, terminate at delim
returns MYERR if pattern is invalid, otherwise returns address of
character immediately following delimiter
*/
makepat(arg)
register char *arg;
{
register char *lastp, *lp;
#if DEBUG
fprintf(stderr, "makepat\n");
#endif
p = spat; /* overwrite old pattern */
lastp = p;
for ( s = arg ; *s != '\0'; ++s) {
lp = p;
if (*s == ANY)
{ ADDBUF(ANY);
}
else if (*s == BOL && s == arg)
{ ADDBUF(BOL);
}
else if (*s == EOL && *(s+1) == '\0')
{ ADDBUF(EOL);
}
else if (*s == NULINE)
{ ADDBUF('\n');
}
else if (*s == CCL)
{ if (getccl() == MYERR)
return MYERR;
}
else if (*s == CLOSURE && s != arg && *(s-1) != CLOSURE )
{ lp = lastp;
if (*lp == BOL || *lp == EOL || *lp == CLOSURE)
return(MYERR);
if (stclos(lastp) == MYERR)
return(MYERR);
}
else
{ ADDBUF(CHAR);
if ((*s == ESCAPE) && ( *(s+1) != '\0' ))
{ ADDBUF(*++s);
}
else
{ ADDBUF(*s);
}
}
lastp = lp;
}
if (*s != '\0') /* terminated early */
return(MYERR);
ADDBUF('\0');
return MYOK;
}
/* stclos - insert closure character before last pattern element */
stclos( lastp )
register char *lastp;
{
register char *q;
#if DEBUG
fprintf(stderr, "stclos\n");
#endif
ADDBUF('\0'); /* check for available space */
for ( q = p - 1; q > lastp; --q )
q[0] = q[-1];
*q = CLOSURE;
return MYOK;
}
/* getccl - create pattern node for CCL or NCCL */
static
getccl()
{
#if DEBUG
fprintf(stderr, "getccl\n");
#endif
if (*++s == NOT)
{ ADDBUF(NCCL);
++s;
}
else
{ ADDBUF(CCL);
}
ADDBUF('\0'); /* initialize character class counter */
return filset();
}
/* filset - expand set given at s into pattern at p */
filset()
{
register char *psave;
char *index();
static char digits[] = "0123456789";
static char lowalf[] = "abcdefghijklmnopqrstuvwxyz";
static char upalf[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
#if DEBUG
fprintf(stderr, "filset\n");
#endif
psave = p - 1; /* psave points to character count within CCL */
for ( ; *s != CCLEND && *s != '\0'; ++s)
{ if (*s == ESCAPE && *(s+1) != '\0')
{ addmaybe(*++s,psave);
}
else if (*s != '-')
{ addmaybe(*s,psave);
}
else if (p == psave || s[1] == CCLEND)
{ addmaybe('-',psave);
}
else if (index(digits,p[-1]) > 0)
{ DODASH(digits,psave);
}
else if (index(lowalf,p[-1]) > 0)
{ DODASH(lowalf,psave);
}
else if (index(upalf,p[-1]) > 0)
{ DODASH(upalf,psave);
}
else
{ addmaybe('-',psave);
}
}
if (*s != CCLEND)
return(MYERR);
return(MYOK);
}
/* dodash - expand s[-1]-s[1] into pat from valid */
dodash(valid, start)
register char *valid;
register char *start;
{
register char *k, *limit;
char *index();
#if DEBUG
fprintf(stderr, "dodash\n");
#endif
++s;
if ( *s == '\0' )
return MYERR;
limit = index(valid,*s);
k = index( valid, *( p-1 ));
if ( k > limit )
{ addmaybe('-',start);
addmaybe(*s,start);
return MYOK;
}
for( k++; k <= limit; ++k )
addmaybe(*k,start);
return MYOK;
}
/* addmaybe - add character c to character class if not already there */
addmaybe( c, start )
char c;
register char *start;
{
#if DEBUG
fprintf(stderr, "addmaybe\n");
#endif
if ( locate( &c, start-1 ))
return;
(*start)++;
ADDBUF(c);
}
/* match - find match anywhere on line */
match( s, pat )
register char *s, *pat;
{
#if DEBUG
fprintf(stderr, "match\n");
#endif
cur_line = s;
for( ; *s != '\0'; s++ )
{ if ( amatch( s, pat ))
return TRUE;
}
return FALSE;
}
/* amatch - look for a match starting at s */
/* returns a pointer to the next character of s to be parsed */
/* or 0 if not found */
char * amatch(s,p)
register char *s, *p;
{
register char *t, *cptr;
char *cmatch(), *amatch();
#if DEBUG
fprintf(stderr, "amatch\n");
#endif
for ( ; *p != '\0'; p += patsiz(p))
if (*p == CLOSURE)
{ ++p;
for (t = s; *t != '\0'; ++t)
if (cmatch(t,p) == NULL)
break;
/* t now points to character that made us fail */
/* try to match rest of pattern against rest of input */
/* shrink the closure by 1 after each failure */
for (p += patsiz(p) ; t >= s; --t)
if ( cptr = amatch(t,p))
return cptr;
return 0;
}
else
{ if ((s = cmatch(s,p)) == NULL)
return 0;
}
return s;
}
/* patsiz - returns size of pattern at p */
static
patsiz(p)
register char *p;
{
#if DEBUG
fprintf(stderr, "patsiz\n");
#endif
switch( *p )
{ case CHAR:
return 2;
case BOL:
case EOL:
case ANY:
return 1;
case CLOSURE:
return 1 + patsiz(p+1);
case CCL:
case NCCL:
return *(p+1) + 2;
default:
cant_happen(35);
}
}
/* cmatch - try to match a single element of the pattern */
static char *
cmatch(s,p)
register char *s, *p;
{
char *index();
register int bump;
#if DEBUG
fprintf(stderr, "cmatch\n");
#endif
bump = -1;
switch (*p)
{ case CHAR:
if (*s == p[1])
bump = 1;
break;
case BOL:
if (s == cur_line)
bump = 0;
break;
case ANY:
if (*s != '\0' && *s != '\n')
bump = 1;
break;
case EOL:
if (*s == '\0' || *s == '\n' )
bump = 0;
break;
case CCL:
if (locate(s,p) == 1)
bump = 1;
break;
case NCCL:
if (*s != '\0' && locate( s,p ) == 0)
bump = 1;
break;
default:
cant_happen(36);
}
return ( bump >= 0 )? s + bump: NULL;
}
/* locate - locate the character *s in the character class starting at p */
locate(s,p)
register char *s, *p;
{
register int count;
#if DEBUG
fprintf(stderr, "locate\n");
#endif
count = *++p;
while (count-- > 0)
if (*s == *++p)
return(1);
return 0;
}
addbuf(c)
register char c;
{
#if DEBUG
fprintf(stderr, "addbuf\n");
#endif
if ( p >= &spat[MAXCHARS])
cant_happen(37);
else
*p++ = c;
}
SHAR_EOF
if test 6346 -ne "`wc -c < 'projects/pat.c'`"
then
echo shar: error transmitting "'projects/pat.c'" '(should have been 6346 characters)'
fi
fi # end of overwriting check
if test -f 'projects/pat.h'
then
echo shar: will not over-write existing file "'projects/pat.h'"
else
cat << \SHAR_EOF > 'projects/pat.h'
#define CHAR 'a'
#define BOL '^'
#define EOL '$'
#define NULINE '@'
#define ANY '.'
#define CCL '['
#define CCLEND ']'
#define NCCL 'n'
#define NOT '^'
#define CLOSURE '*'
#define ESCAPE '\\'
#define MYOK 0
#define MYERR -1
SHAR_EOF
if test 253 -ne "`wc -c < 'projects/pat.h'`"
then
echo shar: error transmitting "'projects/pat.h'" '(should have been 253 characters)'
fi
fi # end of overwriting check
if test -f 'projects/primes.st'
then
echo shar: will not over-write existing file "'projects/primes.st'"
else
cat << \SHAR_EOF > 'projects/primes.st'
Class Primes :Generator
| primeGenerator lastPrime |
[
first
primeGenerator <- 2 to: 20.
^ lastPrime <- primeGenerator first
|
next
primeGenerator <- Factor new;
gen: primeGenerator
factor: lastPrime.
^ lastPrime <- primeGenerator next
]
Class Factor
| baseGenerator myFactor |
[
gen: aGen factor: aFactor
baseGenerator <- aGen.
myFactor <- aFactor
|
next | possible |
[ (possible <- baseGenerator next) notNil ]
whileTrue:
[ (possible \\ myFactor ~= 0)
ifTrue: [ ^ possible ] ].
^ nil
]
SHAR_EOF
if test 531 -ne "`wc -c < 'projects/primes.st'`"
then
echo shar: error transmitting "'projects/primes.st'" '(should have been 531 characters)'
fi
fi # end of overwriting check
# End of shell archive
exit 0