brad@looking.ON.CA (Brad Templeton) (12/20/89)
Posting-number: Volume 9, Issue 76
Submitted-by: brad@looking.ON.CA (Brad Templeton)
Archive-name: newsclip/part07
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 7 (of 15)."
# Contents: comp/check.c comp/symtab.c has.c pipe.c
# Wrapped by allbery@uunet on Tue Dec 19 20:09:59 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'comp/check.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'comp/check.c'\"
else
echo shar: Extracting \"'comp/check.c'\" \(11942 characters\)
sed "s/^X//" >'comp/check.c' <<'END_OF_FILE'
X
X
X#include "nc.h"
X
X/*
X * Typechecking routines for parse trees
X */
X
X /*
X * Newsclip(TM) Compiler Source Code.
X * Copyright 1989 Looking Glass Software Limited. All Rights Reserved.
X * Unless otherwise licenced, the only authorized use of this source
X * code is compilation into a binary of the newsclip compiler for the
X * use of licenced Newsclip customers. Minor source code modifications
X * are allowed before compiling.
X * A short time evaluation of this product is also permitted. See the file
X * 'Licence' in the library source directory for details.
X */
X
X#define numtype(x) ((x)==T_INTEGER||(x)==T_DATE||(x)==T_NEWSGROUP)
X#define stringtype(x) ((x)==T_STRING||(x)==T_NEWSGROUP||(x)==T_USERNAME)
X
Xdtype
Xcheck( tp )
Xnodep tp; /* the tree pointer */
X{
X extern struct node_info node_table[];
X int nt; /* node type */
X int i;
X dtype rtype; /* our return type */
X dtype ktypes[MAX_KIDS];
X
X if( !tp )
X return 0;
X
X nt = tp->ntype;
X for( i = 0; i < node_table[nt].kids; i++ )
X ktypes[i] = check( tp->kids[i] );
X
X rtype = T_INTEGER;
X
X /* deal with the special cases */
X switch( nt ) {
X case N_LIST:
X {
X listp ol;
X /* check the parent for proc/func */
X /* we must return to avoid setting type */
X for( ol = (listp)tp; ol; ol = ol->next )
X check( ol->kid );
X return 0;
X }
X case N_FOREACH:
X
X if( insist_variable( kid0(tp) ) )
X break;
X
X if( ktypes[1] & T_ARRAY ) {
X if( (ktypes[1] & T_BASETYPE) != ktypes[0] ) {
X terror( tp, "Loop variable and range are not of matching type" );
X break;
X }
X }
X else if( ktypes[1] == T_DATABASE ) {
X if( ktypes[0] != T_STRING ) {
X terror( tp, "Database loop requires a string variable" );
X break;
X }
X }
X else {
X terror( tp, "for( xx in yy ) -- invalid 'yy' to search through" );
X }
X break;
X case N_INDEX:
X if( ktypes[0] == T_DATABASE ) {
X if( stringtype(ktypes[1]) )
X make_string( kid1(tp), ktypes[1] );
X else
X terror( tp, "Database index must be a single string" );
X rtype = T_INTEGER;
X }
X else {
X if( !( ktypes[0] & T_ARRAY ) )
X
X terror( tp, "Indexing requires an array or database" );
X else if( ktypes[1] != T_INTEGER )
X terror( tp, "Array index must be an integer");
X rtype = ktypes[0] & T_BASETYPE;
X }
X break;
X case N_STRING:
X rtype = T_STRING;
X break;
X case N_NGROUP:
X rtype = T_NEWSGROUP;
X break;
X case N_PAREN:
X rtype = ktypes[0];
X break;
X
X case N_EQ:
X case N_NE:
X if( ktypes[0] != ktypes[1] ) {
X if( numtype(ktypes[0]) && numtype(ktypes[1]) ) {
X rtype = T_INTEGER; /* no cast */
X break;
X }
X if( stringtype(ktypes[0]) && stringtype(ktypes[1]) ) {
X make_string(kid0(tp), ktypes[0]);
X make_string(kid1(tp), ktypes[1]);
X rtype = T_INTEGER;
X break;
X }
X if( (ktypes[0] == T_ARRAY || ktypes[1] ==
X T_ARRAY) && ktypes[0] &
X ktypes[1] & T_ARRAY ) {
X rtype = T_INTEGER;
X break;
X }
X /* check for comparison to NIL */
X terror( tp, "Comparison of incompatible types");
X }
X else if( ktypes[0] > T_STRING ) {
X /* if one is a predeclared symbol, that's ok */
X if( !predsym(kid0(tp)) && !predsym(kid1(tp)) )
X terror( tp, "Comparison on uncomparable types");
X }
X rtype = T_INTEGER;
X break;
X case N_IN:
X case N_NOT_IN:
X if( ktypes[1] == T_DATABASE ) {
X if( stringtype(ktypes[0]) )
X make_string( kid0(tp), ktypes[0] );
X else if( ktypes[0] != arrayof(T_STRING) )
X terror( tp, "Can only check for strings and strings arrays in databases" );
X }
X else if( !( ktypes[1] & T_ARRAY ) )
X terror( tp, "Can only check IN array or database" );
X else if((ktypes[0]&T_BASETYPE)!=(ktypes[1]&T_BASETYPE))
X terror( tp, "Types don't match on IN" );
X rtype = T_INTEGER;
X break;
X case N_HAS:
X case N_NOT_HAS:
X if( stringtype(ktypes[1]) ) {
X if( kid1(tp)->ntype == N_STRING ) {
X /* turn the hard string into a
X precompiled pat*/
X nodep skid;
X int patnum;
X skid = kid1(tp);
X patnum = pat_number((char *)kid0(skid));
X free( (char *)kid0(skid) );
X skid->kids[0] = (nodep) patnum;
X skid->ntype = N_PATTERN;
X }
X else
X make_string( kid1(tp), ktypes[1] );
X }
X else if( !( ktypes[1] & T_ARRAY && stringtype(ktypes[1]
X & T_BASETYPE) ) && ktypes[1] !=
X T_DATABASE )
X terror( tp, "HAS pattern must be string or database" );
X if( stringtype(ktypes[0]) )
X make_string( kid0(tp), ktypes[0] );
X else if( !stringtype(ktypes[0]&T_BASETYPE) &&
X ktypes[0] != T_DATABASE &&
X ktypes[0] != T_TEXT )
X terror( tp, "HAS search area must be string, database or text region" );
X rtype = T_INTEGER;
X break;
X
X case N_POSTINC:
X case N_POSTDEC:
X case N_PREINC:
X case N_PREDEC:
X insist_variable( kid0(tp) );
X if( ktypes[0] != T_INTEGER )
X terror(tp,"Increment and decrement allowed on numbers only" );
X rtype = T_INTEGER;
X break;
X case N_QUERY:
X if( ktypes[0] != T_INTEGER )
X terror(tp, "Query condition must be numeric" );
X else if( ktypes[1] != ktypes[2] )
X terror(tp, "Types of query clauses don't match" );
X rtype = ktypes[1];
X break;
X case N_ID:
X rtype = ((symptr)kid0(tp))->type;
X break;
X case N_CALL:
X {
X symptr prsym;
X if( kid0(tp) && (prsym = (symptr)kid0(kid0(tp)) ) ) {
X check_args( prsym, (listp)kid1(tp) );
X if( prsym->decl_type != ST_PROC )
X terror( tp, "'%s' is not a procedure",
X prsym->name );
X }
X break;
X }
X case N_FUNCALL:
X {
X symptr funsym;
X if( kid0(tp) && (funsym = (symptr)kid0(kid0(tp)) ) ) {
X check_args( funsym, (listp)kid1(tp) );
X rtype = funsym->type;
X if( funsym->decl_type != ST_FUNC )
X terror(tp, "'%s' is not a function",
X funsym->name );
X }
X break;
X }
X case N_ASSIGN:
X if( !insist_variable( kid0(tp) ) ) {
X if( assign_check( ktypes[0], kid1(tp),
X ktypes[1] ) )
X terror( tp, "Incompatible types on assignment" );
X }
X rtype = 0;
X break;
X case N_PARSE: /* assign array */
X make_string( kid1(tp), ktypes[1] );
X insist_variable( kid0(tp) );
X if( ktypes[0] & T_ARRAY ) {
X if( kid2(tp) )
X make_string( kid2(tp), ktypes[2] );
X else
X terror(tp,"Array parse requires delimiters" );
X }
X else {
X if( kid2(tp) )
X terror(tp,"Delimiters are only meaningful on an array parse");
X }
X break;
X case N_ARINIT: /* init empty array */
X insist_variable( kid0(tp) );
X if( ktypes[0] & T_ARRAY ) {
X if( ktypes[1] != T_INTEGER )
X terror(tp,"Array size must be integer");
X }
X else
X terror(tp,"Array assign requires array variable");
X break;
X case N_FOR:
X if( kid1(tp) != NIL && ktypes[1] != T_INTEGER )
X terror( tp, "For loop condition requires bool/int" );
X rtype = 0;
X break;
X case N_GOTO: {
X symptr sym;
X if( kid0(tp) && (sym = (symptr)kid0(kid0(tp))) &&
X sym->decl_type != ST_LABEL )
X terror( tp, "'%s' is not a label", sym->name );
X break;
X }
X case N_RETURN: {
X extern int in_routine;
X if( in_routine == ST_FUNC ) {
X extern dtype routine_type;
X if( kid0(tp) == NIL )
X terror( tp, "Function returns must return a value" );
X else if( assign_check( routine_type, kid0(tp),
X ktypes[0] ) )
X terror( tp, "Invalid type for function return value" );
X }
X else if( kid0(tp) != NIL )
X terror( tp, "Only functions may return values");
X
X break;
X }
X default: {
X byte nfl; /* flags for node type */
X extern int in_routine;
X
X nfl = node_table[nt].flags;
X if( nfl & TF_RET && in_routine == ST_FUNC ) {
X terror( tp, "Accept and Reject are not allowed inside functions" );
X break;
X }
X if( !(nfl & TF_RETINT) ) {
X if( nfl & TF_ONEINT )
X rtype = procint( tp, rtype, ktypes[0] );
X else if( nfl & TF_2INT ) {
X rtype = procint( tp, rtype, ktypes[0] );
X rtype = procint( tp, rtype, ktypes[1] );
X }
X }
X break;
X }
X
X }
X tp->ndtype = rtype;
X return rtype;
X
X}
X
X/* make sure a node returns a string */
X
Xmake_string( tp, tpt )
Xnodep tp; /* tree pointer */
Xdtype tpt; /* type of this tree */
X{
X switch(tpt) {
X case T_NEWSGROUP:
X tp->nflags |= CAST_NGNAME;
X tp->ndtype = T_STRING;
X break;
X case T_USERNAME:
X tp->nflags |= CAST_MAILNAME;
X tp->ndtype = T_STRING;
X break;
X case T_STRING:
X break;
X default:
X terror( tp, "String required" );
X break;
X }
X}
X
X/* Expect an integer or numeric argument */
X
Xdtype
Xprocint( tp, otype, newtype )
Xnodep tp; /* field */
Xdtype otype; /* old type */
Xdtype newtype; /* type of argument */
X{
X if( newtype == T_DATE || newtype == T_INTEGER )
X return newtype;
X else if( newtype == T_NEWSGROUP )
X return T_INTEGER;
X else
X terror( tp, "Number type required" );
X return T_INTEGER;
X}
X
X
X
X/* insist that the tree is a variable, return give error and return
X TRUE if it is not */
X
Xbool
Xinsist_variable( tr )
Xnodep tr; /* tree that must be a variable */
X{
X if( is_variable(tr) ) {
X tr->nflags |= NF_LVALUE;
X return FALSE;
X }
X else {
X terror( tr, "Assignment to non-variable" );
X return TRUE;
X }
X}
X
Xbool
Xis_variable( tr )
Xnodep tr; /* variable tree */
X{
X int ttype;
X
X ttype = tr->ntype;
X if( ttype == N_ID ) {
X symptr tid;
X tid = (symptr)kid0(tr);
X return tid->decl_type == ST_VAR && !(tid->sflags & OSF_CONST);
X }
X else if( ttype == N_INDEX && is_variable(kid0(tr)) )
X return TRUE;
X return FALSE;
X}
X
X/*
X * Test if two types are assignment compatible and set cast flags
X * returns true if there is an error.
X */
X
X
Xbool
Xassign_check( destype, src, srctype )
Xdtype destype; /* type of destination var */
Xnodep src; /* source tree */
Xdtype srctype; /* source type */
X{
X if( destype != srctype ) {
X if( destype & T_ARRAY && srctype == T_ARRAY )
X return FALSE;
X switch( destype ) {
X case T_DATE:
X if( srctype == T_INTEGER )
X src->nflags |= CAST_DATE;
X else {
X terror(src,"Integer or date required");
X return TRUE;
X }
X break;
X case T_INTEGER:
X if( srctype == T_DATE )
X src->nflags |= CAST_INT;
X else if( srctype != T_NEWSGROUP ) {
X terror(src,"Numeric value required");
X return TRUE;
X }
X break;
X case T_STRING:
X if( srctype == T_NEWSGROUP )
X src->nflags |= CAST_NGNAME;
X else if( srctype == T_USERNAME )
X src->nflags |= CAST_MAILNAME;
X else {
X terror(src,"String value required");
X return TRUE;
X }
X break;
X case T_GENARRAY:
X if( !(srctype & T_ARRAY) ) {
X terror( src,"Array value required" );
X return TRUE;
X }
X break;
X case T_GENPTR:
X if( !( srctype & T_ARRAY || srctype == T_STRING || srctype == T_DATABASE || srctype == T_USERNAME ) ){
X terror( src,"Structured data value required" );
X return TRUE;
X }
X break;
X default:
X return TRUE;
X }
X }
X return FALSE; /* types match */
X}
X
X/* Check the arguments on a call to a procedure or function */
X
Xcheck_args( funsym, funargs )
Xsymptr funsym; /* the symbol for the subroutine */
Xlistp funargs; /* the argument list */
X{
X struct typelist *dtlist; /* declared type list */
X listp curarg;
X int i;
X
X
X dtlist = funsym->argtypes;
X
X /* a null type list means an arbitrary argument list */
X if( !dtlist )
X return;
X
X curarg = funargs;
X for( i = 0; i < dtlist->argcount; i++ ) {
X if( curarg ) {
X if( assign_check( dtlist->args[i], curarg->kid,
X curarg->kid->ndtype ) )
X terror( curarg, "Type mismatch on argument %d of '%s'", i+1, funsym->name );
X }
X else {
X /* end of list */
X if( i >= dtlist->argmin ) {
X terror( funargs, "%s: Too few arguments",
X funsym->name );
X return;
X }
X break; /* loop done */
X }
X curarg = curarg->next;
X }
X /* if there were still arguments left, count them */
X while( curarg ) {
X if( ++i >= dtlist->argmax ) {
X terror( funargs, "%s: Too many arguments",funsym->name);
X return;
X }
X curarg = curarg->next;
X }
X
X}
X
X/* is this tree a reference to a predefined symbol? */
Xint
Xpredsym( tp )
Xnodep tp;
X{
X return tp->ntype == N_ID && ((symptr)kid0(tp))->sflags & OSF_PREDEF;
X}
END_OF_FILE
if test 11942 -ne `wc -c <'comp/check.c'`; then
echo shar: \"'comp/check.c'\" unpacked with wrong size!
fi
# end of 'comp/check.c'
fi
if test -f 'comp/symtab.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'comp/symtab.c'\"
else
echo shar: Extracting \"'comp/symtab.c'\" \(11785 characters\)
sed "s/^X//" >'comp/symtab.c' <<'END_OF_FILE'
X
X
X#include "nc.h"
X
X/*
X * Newsclip compiler symbol table routines.
X *
X * This code handles general symbol manipulation for the user program
X */
X
X /*
X * Newsclip(TM) Compiler Source Code.
X * Copyright 1989 Looking Glass Software Limited. All Rights Reserved.
X * Unless otherwise licenced, the only authorized use of this source
X * code is compilation into a binary of the newsclip compiler for the
X * use of licenced Newsclip customers. Minor source code modifications
X * are allowed before compiling.
X * A short time evaluation of this product is also permitted. See the file
X * 'Licence' in the library source directory for details.
X */
X /*
X * There are 3 levels of symbol table. There's the table of special
X * globals, the global symbol table and the local symbol table for
X * each routine. We do not support symbol tables inside compound
X * statments.
X */
X
X#define MAX_ST_INDEX 2
X
Xdbptr sym_stack[MAX_ST_INDEX+1]; /* stack of 3 symbol tables */
Xint cur_st_index = 0;
Xdbptr cur_symtab; /* current symbol table */
X
Xdbptr outer_symtab; /* the table of special symbols */
Xdbptr global_symtab; /* the gloal symtab for the user */
X
Xstruct sym_entry Unknown = {
X"Unknown", 0, 0, 0, 0, 0, 0 };
X
X
Xsymtab_init()
X{
X int i;
X symptr thesym;
X extern struct outsym predefs[];
X
X outer_symtab = init_db( 40, sizeof( struct sym_entry ) );
X
X for( i = 0; predefs[i].name; i++ ) {
X thesym = (symptr)add_rec( outer_symtab, predefs[i].name,
X AR_CREATE | AR_NOALLOC );
X thesym->decl_type = predefs[i].odecl_type;
X thesym->type = predefs[i].otype;
X /* do something with flags */
X thesym->sflags = predefs[i].flags;
X thesym->argtypes = predefs[i].atlist;
X }
X /* Link up the arg lists for predefined routines */
X
X global_symtab = init_db( 80, sizeof( struct sym_entry ) );
X cur_symtab = global_symtab;
X sym_stack[0] = outer_symtab;
X sym_stack[1] = global_symtab;
X cur_st_index = 1;
X}
X
Xnodep
Xextern_var( varname, type )
Xchar *varname; /* name of variable */
Xdtype type; /* type of variable */
X{
X symptr thesym;
X
X if( thesym = extern_decl(varname,ST_VAR,type,(listp)0) ) {
X if( thesym->sflags & OSF_CONST )
X return NIL;
X else
X return tree( N_EXTERN, declid(thesym) );
X }
X else
X return tree( N_EXTERN, NIL );
X
X}
X
X/* Do a general external declaration.
X * If the symbol exists at this level, complain about a
X * redeclaration.
X * If the symbol exists at a higher level, check that things
X * match, and if so, create the symbol at this level.
X */
X
Xsymptr
Xextern_decl( name, sytype, type, argtlist )
Xchar *name; /* name of external symbol */
Xint sytype; /* type of symbol */
Xdtype type; /* user type */
Xstruct typelist * argtlist; /* arglist if needed */
X{
X symptr thesym;
X extern bool no_externals; /* forbid undefined externals */
X
X thesym = (symptr)add_rec( cur_symtab, name, AR_NEWONLY );
X if( thesym ) {
X symptr globname;
X globname = (symptr)get_rec( outer_symtab, name );
X /* should be an option to disable true externals */
X if( globname ) {
X int flags;
X if( globname->decl_type != sytype ||
X globname->type != type ) {
X parerror( "External '%s' is of invalid type.",
X name );
X }
X else if( (sytype == ST_FUNC || sytype == ST_PROC) &&
X !arglists_match(argtlist, globname->argtypes )){
X parerror("Invalid argument list for '%s'",
X name );
X }
X else {
X handle_outer( globname, TRUE );
X thesym->sflags = globname->sflags;
X }
X }
X else {
X if( no_externals )
X parerror( "Undefined external references disallowed" );
X thesym->sflags = 0;
X }
X thesym->decl_type = sytype;
X thesym->type = type;
X thesym->argtypes = argtlist;
X return thesym;
X }
X else {
X parerror( "Symbol '%s' redeclared", name );
X return (symptr)0;
X }
X}
X
X
Xnodep
Xextern_func( funcname, type, arglist, is_external )
Xchar *funcname; /* name of proc or func */
Xdtype type; /* return type or 0 for procedure */
Xlistp arglist; /* list of arguments */
Xbool is_external; /* is this an external or a forward declaration */
X{
X symptr funcsym; /* the symbol created for the function */
X struct typelist *atlist;/* the argument type list */
X int fstype; /* the type of subroutine */
X
X fstype = type ? ST_FUNC : ST_PROC;
X
X atlist = buildargs( arglist );
X
X if( is_external ) {
X funcsym = extern_decl( funcname, fstype, type, atlist );
X if( !funcsym )
X return NIL;
X }
X else {
X if( cur_st_index != 1 ) {
X parerror( "Forward declaration of '%s' must be a global declaration", funcname );
X return NIL;
X }
X if( funcsym = declare_local( funcname, fstype, type ) ) {
X funcsym->sflags |= SF_FORWARD;
X funcsym->argtypes = atlist;
X }
X else
X return NIL;
X }
X if( funcsym->sflags & OSF_CONST )
X return NIL;
X else
X return tree( N_EXT_FUNC, declid(funcsym), arglist );
X}
X
Xsymptr
Xdeclare_local( name, sytype, type )
Xchar *name; /* symbol name */
Xint sytype;
Xdtype type;
X{
X symptr thesym;
X
X thesym = (symptr)add_rec( cur_symtab, name, AR_NEWONLY );
X if( thesym ) {
X thesym->decl_type = sytype;
X thesym->type = type;
X thesym->sflags |= SF_LOCAL;
X }
X else
X parerror( "Symbol '%s' redeclared", name );
X return thesym;
X}
X
Xnodep
Xdeclare_var( varname, type )
Xchar *varname; /* name of variable */
Xdtype type; /* type of variable */
X{
X symptr sym;
X
X if( sym = declare_local( varname, ST_VAR, type ) )
X return tree( N_DECL_VAR, declid(sym) );
X else
X return NIL;
X}
X
Xnodep
Xgen_declare( name )
Xchar *name; /* name of user routine */
X{
X symptr sym;
X sym = (symptr)add_rec( cur_symtab, name, AR_CREATE );
X /* is nil possible? */
X return sym ? declid(sym) : NIL;
X}
X
Xnodep
Xdeclare_arg( name, type )
Xchar *name; /* name of the argument */
Xdtype type; /* type for the argument */
X{
X /* for our purposes, these are just like variables */
X return declare_var( name, type );
X}
X
Xnodep
Xdeclare_lab( name )
Xchar *name; /* name of the label */
X{
X symptr sym;
X
X sym = (symptr)add_rec( cur_symtab, name, AR_CREATE );
X if( sym->decl_type != 0 && sym->decl_type != ST_LABREF ) {
X parerror( "Label '%s' redeclared", name );
X return declid( &Unknown );
X }
X else {
X sym->decl_type = ST_LABEL;
X return declid(sym);
X }
X
X
X}
X
X/* special globals to use while checking a routine */
X
Xint in_routine = 0;
Xint routine_type = 0;
X
X/* General procedure to check and output a subroutine */
X
Xroutine_decl( rid, rargs, rcode, type, symtype )
Xnodep rid; /* identifier for routine */
Xlistp rargs; /* the argument list */
Xnodep rcode; /* the code block for the routine */
Xdtype type; /* type to give the routine */
Xint symtype; /* type of symbol -- proc or function */
X{
X symptr thesym;
X struct typelist *atlist;/* the argument type list */
X extern int got_error; /* parsing error status */
X
X if( !rid )
X return;
X
X thesym = (symptr)kid0(rid);
X
X atlist = buildargs( rargs );
X
X /* set up the symbol */
X
X if( thesym->decl_type == 0 ) {
X thesym->type = type;
X thesym->sflags |= SF_LOCAL;
X thesym->decl_type = symtype;
X thesym->argtypes = atlist;
X }
X else {
X if( thesym->sflags & SF_FORWARD ) {
X if( thesym->decl_type != symtype ||
X thesym->type != type ||
X !arglists_match( thesym->argtypes,
X atlist ) )
X terror( rargs, "Subroutine declaration does not match forward declaration" );
X /* turn off forward for future */
X thesym->sflags &= ~SF_FORWARD;
X }
X else {
X parerror( "Symbol '%s' redeclared", thesym->name );
X return;
X }
X }
X
X /* set special externals */
X
X if( got_error < SYNTAX_ERROR ) {
X in_routine = symtype;
X routine_type = type;
X
X check( rcode );
X
X outsubr( thesym, rargs, rcode );
X
X /* clear special externals */
X
X in_routine = 0;
X routine_type = 0;
X }
X /* free up the code and arglist. Symbol and type list stay in
X the symbol table */
X treefree( rcode );
X treefree( rargs );
X}
X
X
X/*
X * Look up a label. Unusual in that it is possible the label has
X * not been declared yet. We will create it if so and wait for it
X * to get declared.
X */
X
Xnodep
Xgoto_lookup( name )
Xchar *name;
X{
X symptr sym;
X
X sym = (symptr)get_rec( cur_symtab, name );
X if( sym ) {
X if( sym->decl_type == ST_LABEL || sym->decl_type == ST_LABREF )
X return declid(sym);
X else {
X parerror( "Symbol '%s' is not a label", name );
X return declid( &Unknown );
X }
X }
X else {
X /* the symbol was not found. That's not an error yet */
X sym = (symptr)add_rec( cur_symtab, name, AR_CREATE );
X sym->decl_type = ST_LABREF;
X return declid(sym);
X }
X}
X
X/*
X * General symbol lookup.
X */
X
Xnodep
Xsymlookup( symname, t1, t2 )
Xchar *symname;
Xdtype t1,t2; /* possible types for symbol */
X{
X int i;
X symptr sym;
X
X for( i = cur_st_index; i >= 0; i-- ) {
X sym = (symptr)get_rec( sym_stack[i], symname );
X if( sym ) {
X if( i == 0 && !(sym->sflags & OSF_PREDEF) ) {
X parerror( "Symbol '%s' must be declared external before it can be referenced", symname );
X return declid( &Unknown );
X }
X if( sym->decl_type != t1 && sym->decl_type != t2 )
X parerror( "Incorrect kind of identifier: '%s'",
X symname );
X return declid(sym);
X }
X }
X
X /* never found it */
X parerror( "Undeclared symbol: '%s'", symname );
X return declid( &Unknown );
X}
X
Xnodep
Xdeclid(sym)
Xsymptr sym;
X{
X return tree( N_ID, (nodep)sym );
X}
X
Xpush_table()
X{
X if( cur_st_index < MAX_ST_INDEX ) {
X /* create a new table */
X cur_symtab = init_db( 20, sizeof( struct sym_entry ) );
X sym_stack[++cur_st_index] = cur_symtab;
X }
X}
X
Xpop_table()
X{
X /* free the old table */
X free_db( cur_symtab );
X cur_symtab = sym_stack[--cur_st_index];
X}
X
Xstruct typelist *
Xbuildargs( alist )
Xlistp alist; /* argument declaration list */
X{
X dtype tempdt[255]; /* build arglist here */
X struct typelist *ret; /* final return pointer */
X int anum;
X int i;
X
X for( anum = 0; alist; anum++,alist = alist->next ) {
X nodep decvar, decid;
X symptr arsym;
X
X if( decvar = alist->kid ) {
X if( decvar->ntype == N_INT )
X tempdt[anum] = (int)kid0(decvar);
X else {
X if( (decid = kid0(decvar)) &&
X (arsym = (symptr)kid0(decid)) )
X tempdt[anum] = arsym->type;
X else
X anum--; /* nil arg */
X }
X }
X else
X anum--; /* nil argument */
X }
X
X /* allocate room for a real arglist */
X
X ret = (struct typelist *) checkalloc( sizeof(struct typelist) );
X if( anum )
X ret->args = (dtype *) checkalloc( anum * sizeof(dtype) );
X else
X ret->args = (dtype *)0;
X
X ret->argmin = ret->argmax = ret->argcount = anum;
X /* copy over the found arguments */
X for( i = 0; i < anum; i++ )
X ret->args[i] = tempdt[i];
X
X return ret;
X}
X
X/* handle references to predefined symbols */
X
Xhandle_outer( globname, complain )
Xsymptr globname; /* global symbol */
Xint complain; /* complain about local header refs */
X{
X
X int flags;
X extern bool needs_stat;
X extern bool wants_dist;
X
X flags = globname->sflags;
X
X /* if we have already seen this symbol, ignore it */
X
X if( flags & OSF_REFERENCED )
X return;
X globname->sflags |= OSF_REFERENCED;
X
X switch( flags & OSF_SPECIAL_MASK ) {
X case SPC_HEADER:
X if( complain )
X insist_global(globname);
X hcreate( globname->name, globname->type );
X break;
X case SPC_STAT:
X needs_stat = TRUE;
X break;
X case SPC_FROM:
X if( complain )
X insist_global(globname);
X makeref( globname->name + 1 );
X makeref( "from" );
X break;
X case SPC_NEWSGROUPS:
X if( complain )
X insist_global(globname);
X makeref( globname->name + 1 );
X /* newsgroups already pre-referenced */
X break;
X case SPC_REF:
X makeref( "references" );
X break;
X case SPC_DIST:
X makeref( "distribution" );
X wants_dist = TRUE;
X break;
X }
X}
X
Xinsist_global(sym)
Xsymptr sym;
X{
X if( cur_st_index > 1 )
X parerror( "Header variable declaration for '%s' must be global, not local", sym->name );
X}
X
X/* Make as though an external reference has been made to a given name */
X
Xmakeref( name )
Xchar *name;
X{
X symptr globname;
X globname = (symptr)get_rec( outer_symtab, name );
X if( globname )
X handle_outer( globname, FALSE );
X}
END_OF_FILE
if test 11785 -ne `wc -c <'comp/symtab.c'`; then
echo shar: \"'comp/symtab.c'\" unpacked with wrong size!
fi
# end of 'comp/symtab.c'
fi
if test -f 'has.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'has.c'\"
else
echo shar: Extracting \"'has.c'\" \(11799 characters\)
sed "s/^X//" >'has.c' <<'END_OF_FILE'
X/*
X * has.c
X *
X * Library of article body searching routines.
X *
X */
X
X /*
X * Newsclip(TM) Library Source Code.
X * Copyright 1989 Looking Glass Software Limited. All Rights Reserved.
X * Unless otherwise licenced, the only authorized use of this source
X * code is compilation into a binary of the newsclip library for the
X * use of licenced Newsclip customers. Minor source code modifications
X * are allowed.
X * Use of this code for a short term evaluation of the product, as defined
X * in the associated file, 'Licence', is permitted.
X */
X
X#include "nl.h"
X#include "rei.h"
X#include "body.h"
X
Xextern char *arr_string AC(( array *, int, int ));
Xextern void parse_body AC(( unsigned int, unsigned int ));
Xextern void paragraphize AC(( area_type * ));
Xextern void init_stats AC(( int ));
X
X#define fetch_rxp( idx ) user_rxps[idx-1]
X
Xextern long time_now; /* Used to update dbase access times. */
X
Xextern int paragraph_scan; /* Indicates whether in paragraph mode */
X
Xextern area_type *Article; /* Ptr to the paragrahed article structures */
Xextern area_type *RawText; /* Ptr to the raw article structures */
X
Xextern char *include_prefix; /* User-defined prefix for included lines */
Xextern char *signature_start; /* User-defined start for signature */
Xextern int pattern_count; /* Number of expressions in user_patterns */
Xextern char *user_patterns[]; /* User's RE patterns, as typed. */
Xstatic rxp_type *user_rxps = (rxp_type *) NULL; /* Array of compiled user REs */
X
Xstatic int scan_text AC(( int, rxp_type ));
Xstatic int scan_array AC(( array *, rxp_type ));
Xstatic int scan_db AC(( dbptr, rxp_type ));
X
X/* str_has_str() - "string has string" pattern matching routine.
X * Returns TRUE if the first argument matches the RE pattern represented
X * by the second argument; otherwise, FALSE. */
X
Xint
Xstr_has_str( sptr, pptr )
Xchar *sptr; /* Pointer to the searched string */
Xchar *pptr; /* Pointer to the R.E. (non-compiled) */
X{
X return( REG_EXEC( REG_COMP_S( pptr ), sptr ) ? H_TRUE : H_FALSE );
X}
X
X/* str_has_pat() - "string has pattern" pattern matching routine.
X * Performs identically to str_has_str() above, but the pattern is
X * represented as an index into the pre-compiled user_pattern array. */
X
Xint
Xstr_has_pat( sptr, pidx )
Xchar *sptr; /* Pointer to the searched string */
Xint pidx; /* R.E. index (static, non-compiled R.E) */
X{
X return( REG_EXEC( fetch_rxp( pidx ), sptr ) ? H_TRUE : H_FALSE );
X}
X
X/* str_has_db() - "string has database" pattern matching routine.
X * Tests every key contained in the given database as a RE against the given
X * string argument, and returns TRUE if any key matches. */
X
Xint
Xstr_has_db( sptr, db )
Xchar *sptr;
Xdbptr db;
X{
X register userdb *rec;
X
X for( rec = (userdb *) first_rec( db ); rec;
X rec = (userdb *) next_rec( db, (dbrec *) rec ) )
X if( REG_EXEC( REG_COMP_S( rec->name ), sptr ) ) {
X rec->access_date = time_now;
X return( H_TRUE );
X }
X
X return( H_FALSE );
X}
X
X/* str_has_arr() - "string has array" pattern matching routine.
X * Tests every element in the given string array as a RE against the
X * given string argument, and returns TRUE if any matches occurs. */
X
Xint
Xstr_has_arr( sptr, aptr )
Xchar *sptr;
Xarray *aptr;
X{
X register rxp_type rxp;
X register int idx;
X int asize = aptr->arsize + AR_LOW_IDX;
X int atype = aptr->artype;
X
X for( idx = AR_LOW_IDX; idx < asize; idx++ ) {
X rxp = REG_COMP_S( arr_string( aptr, atype, idx ) );
X if( REG_EXEC( rxp, sptr ) )
X return( H_TRUE );
X }
X
X return( H_FALSE );
X}
X
X/* arr_has_str() - "array has string" pattern matching routine.
X * Tests the given string as a RE against every element in the array,
X * returning TRUE if a match occurs. */
X
Xint
Xarr_has_str( aptr, pptr )
Xarray *aptr; /* Array whose elements are to be searched */
Xchar *pptr; /* R.E. (noncompiled) being looked for */
X{
X return( scan_array( aptr, REG_COMP_S( pptr ) ) );
X}
X
X/* arr_has_pat() - "array has pattern" pattern matching routine.
X * Performs identically to arr_has_str() above, but the pattern is
X * represented as an index into the pre-compiled user_pattern array. */
X
Xint
Xarr_has_pat( aptr, pidx )
Xarray *aptr; /* Array whose elements are to be searched */
Xint pidx; /* Index into R.E. table (noncompiled) */
X{
X return( scan_array( aptr, fetch_rxp( pidx ) ) );
X}
X
X/* arr_has_db() - "array has database" pattern matching routine.
X * Treats each key in the database as a RE pattern to be searched for
X * in the given array. TRUE is returned if any match is detected. */
X
Xint
Xarr_has_db( aptr, db )
Xarray *aptr;
Xdbptr db;
X{
X register userdb *rec;
X
X for( rec = (userdb *) first_rec( db ); rec;
X rec = (userdb *) next_rec( db, (dbrec *) rec ) )
X if( H_TRUE == scan_array( aptr, REG_COMP_S( rec->name ) ) ) {
X rec->access_date = time_now;
X return( H_TRUE );
X }
X
X return( H_FALSE );
X}
X
X/* arr_has_arr() - "array has array" pattern matching routine.
X * Treats each element of the second array as a RE pattern to be searched
X * for in the first array. TRUE is returned if any match is detected. */
X
Xint
Xarr_has_arr( aptr, apptr )
Xarray *aptr; /* Array to be searched. */
Xarray *apptr; /* Array of patterns for which to search */
X{
X register rxp_type rxp;
X register int idx;
X int apsize = apptr->arsize + AR_LOW_IDX;
X int aptype = apptr->artype;
X
X for( idx = AR_LOW_IDX; idx < apsize; idx++ ) {
X rxp = REG_COMP_S( arr_string( apptr, aptype, idx ) );
X if( H_TRUE == scan_array( aptr, rxp ) )
X return( H_TRUE );
X }
X
X return( H_FALSE );
X}
X
X/* scan_array() is just common code used in the process of scanning
X * an array for the given [compiled] regular expression. */
X
Xstatic int
Xscan_array( aptr, a_rxp )
Xarray *aptr;
Xrxp_type a_rxp;
X{
X register rxp_type rxp = a_rxp;
X register int idx;
X int asize = aptr->arsize + AR_LOW_IDX;
X int atype = aptr->artype;
X
X if( rxp )
X for( idx = AR_LOW_IDX; idx < asize; idx++ )
X if( REG_EXEC( rxp, arr_string( aptr, atype, idx ) ) )
X return( H_TRUE );
X
X return( H_FALSE );
X}
X
X/* db_has_pat() - "database has pattern" pattern matching routine.
X * Takes the given index into the user_pattern array and searches for the
X * pattern in every key in the database, returning TRUE if a match is found. */
X
Xint
Xdb_has_pat( db, pidx )
Xdbptr db; /* Database in which to search for patterns */
Xint pidx; /* Index into R.E. table for which to search */
X{
X return( scan_db( db, fetch_rxp( pidx ) ) );
X}
X
X/* db_has_str() - "database has string" pattern matching routine.
X * Functions as db_has_pat() above, except that the second argument is
X * a user-constructed string rather than a constant pattern. */
X
Xint
Xdb_has_str( db, pptr )
Xdbptr db; /* Database in which to search for patterns */
Xchar *pptr; /* Pointer to R.E. for which to search */
X{
X return( scan_db( db, REG_COMP_S( pptr ) ) );
X}
X
X/* db_has_arr() - "database has array" pattern matching routine.
X * Searches the given database for each string contained in the array. */
X
Xint
Xdb_has_arr( db, apptr )
Xdbptr db;
Xarray *apptr;
X{
X register rxp_type rxp;
X register int idx;
X int apsize = apptr->arsize + AR_LOW_IDX;
X int aptype = apptr->artype;
X
X for( idx = AR_LOW_IDX; idx < apsize; idx++ ) {
X rxp = REG_COMP_S( arr_string( apptr, aptype, idx ) );
X if( H_TRUE == scan_db( db, rxp ) )
X return( H_TRUE );
X }
X
X return( H_FALSE );
X}
X
X/* scan_db() contains the common code called from database "has" routines. */
X
Xstatic int
Xscan_db( db, rxp )
Xdbptr db;
Xrxp_type rxp;
X{
X register dbrec *rec;
X
X if( rxp )
X for( rec = first_rec( db ); rec; rec = next_rec( db, rec ) )
X if( REG_EXEC( rxp, rec->key ) )
X return( H_TRUE );
X
X return( H_FALSE );
X}
X
X/* text_has_str() - "text has string" pattern matching routine.
X * Searches the specified portions of the article body for the given
X * regular expression, returning TRUE if found. */
X
Xint
Xtext_has_str( tid, pptr )
Xint tid; /* Type of the text to be searched */
Xchar *pptr; /* Pointer to the (non-compiled) R.E. string */
X{
X return( scan_text( tid, REG_COMP_S( pptr ) ) );
X}
X
X/* text_has_pat() - "text has pattern" pattern matching routine.
X * As text_has_str(), but uses index into user_patterns[] to obtain
X * the RE to search with. */
X
Xint
Xtext_has_pat( tid, pidx )
Xint tid; /* Type of the text to be searched */
Xint pidx; /* Index into array of user R.E.s */
X{
X return( scan_text( tid, fetch_rxp( pidx ) ) );
X}
X
X/* text_has_arr() - "text has array" pattern matching routine.
X * Searches articles for entire arrays of patterns. */
X
Xint
Xtext_has_arr( tid, apptr )
Xint tid; /* Area of text to be searched. */
Xarray *apptr; /* Array of patterns for which to search */
X{
X register rxp_type rxp;
X register int idx;
X int apsize = apptr->arsize + AR_LOW_IDX;
X int aptype = apptr->artype;
X
X for( idx = AR_LOW_IDX; idx < apsize; idx++ ) {
X rxp = REG_COMP_S( arr_string( apptr, aptype, idx ) );
X if( H_TRUE == scan_text( tid, rxp ) )
X return( H_TRUE );
X }
X
X return( H_FALSE );
X}
X
X/* text_has_db() - "text has database" pattern matching routine.
X * Searches articles for entire databases of patterns. */
X
Xint
Xtext_has_db( tid, db )
Xint tid; /* Area of text to be scanned */
Xdbptr db; /* Database containing patterns */
X{
X register userdb *rec;
X
X for( rec = (userdb *) first_rec( db ); rec;
X rec = (userdb *) next_rec( db, (dbrec *) rec ) )
X if( H_TRUE == scan_text( tid, REG_COMP_S( rec->name ) ) ) {
X rec->access_date = time_now;
X return( H_TRUE );
X }
X
X return( H_FALSE );
X}
X
X/* scan_text() is the common code used by the text "has" functions. */
X
Xstatic int
Xscan_text( tid, rxptr )
Xint tid;
Xrxp_type rxptr;
X{
X register u_list *ul;
X register int j;
X area_type *ap;
X
X if( !rxptr )
X return( H_FALSE );
X
X if( tid != LT_BODY || paragraph_scan ) {
X parse_body( 1, MAXINT );
X ap = Article;
X }
X else {
X read_body( 1, MAXINT );
X ap = RawText;
X }
X
X for( ; ap; ap = ap->next ) {
X if( ap->txt_typ & tid ) {
X if( paragraph_scan ) {
X if( !ap->para )
X paragraphize( ap );
X if( REG_EXEC( rxptr, ap->para ) )
X return( H_TRUE );
X }
X else for( ul = ap->list; ul; ul = ul->next ) {
X for( j = 0; j < ul->size; j++ )
X if( REG_EXEC( rxptr, ul->u_txt[j] ) )
X return( H_TRUE );
X }
X }
X }
X
X return( H_FALSE );
X}
X
X/* init_patterns() compiles the static user pattern array after
X * allocating the memory necessary to maintain the parallel array. */
X
Xvoid
Xinit_patterns()
X{
X register int i;
X
X if( pattern_count )
X user_rxps = (rxp_type *)
X perm_alloc( sizeof(rxp_type)*pattern_count );
X
X for( i = 0; i < pattern_count; i++ )
X user_rxps[i] = REG_COMP_P( user_patterns[i] );
X
X set_include_prefix( include_prefix );
X set_signature_start( signature_start );
X}
X
X/* line_count() returns the number of lines contained in the
X * specified section of the article body. */
X
Xint
Xline_count( statid )
Xint statid;
X{
X init_stats( statid );
X
X return( makeint( ArticleStats[ID_LINES][statid] ) );
X}
X
X/* byte_count() returns the number of bytes contained in the
X * specified section of the article body. */
X
Xint
Xbyte_count( statid )
Xint statid;
X{
X init_stats( statid );
X
X return( makeint( ArticleStats[ID_BYTES][statid] ) );
X}
X
X/* literal_pattern() scans the given string and returns a pointer to a
X * constructed copy of the string with all regular expression characters
X * escaped. */
X
Xstatic char *REMagic = ".*+|?[]()^$\\";
X
Xchar *
Xliteral_pattern( ptr )
Xchar *ptr; /* String to be literalized (escaped) */
X{
X int len = 0; /* Length of escaped string */
X char *retstr, *rptr = ptr;
X char esc = FALSE; /* Was last character an escape? */
X
X for( len = 1; *ptr; len++, ptr++ )
X if( !esc && strchr( REMagic, *ptr ) )
X len++;
X else
X esc = ('\\' == *ptr);
X
X ptr = rptr;
X rptr = retstr = perm_alloc( len*sizeof(char) );
X
X for( esc = FALSE; *ptr; ) {
X if( !esc && strchr( REMagic, *ptr ) )
X *retstr++ = '\\';
X else
X esc = ('\\' == *ptr);
X *retstr++ = *ptr++;
X }
X
X *retstr = '\0';
X
X return( rptr );
X}
END_OF_FILE
if test 11799 -ne `wc -c <'has.c'`; then
echo shar: \"'has.c'\" unpacked with wrong size!
fi
# end of 'has.c'
fi
if test -f 'pipe.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'pipe.c'\"
else
echo shar: Extracting \"'pipe.c'\" \(12339 characters\)
sed "s/^X//" >'pipe.c' <<'END_OF_FILE'
X
X/*
X * The "PIPE" mode interface to the newsclip program.
X *
X * This interface, defined in our news filter program specification, is for
X * use by newsreaders that wish to talk directly to a newsclip program.
X *
X * In essence, when they have an article they might wish to present to the
X * user, they can first pass it to the newsclip program, to see if the
X * user really wants to read it or not.
X *
X * This 'passing' can range from just providing the filename to engaging in
X * a dialogue to send the article down a pipe if it doesn't exist in a
X * conventional file.
X *
X * At all times we must take care that we never try to read more from a pipe
X * than is in it, or we will block.
X *
X * In pipe mode, the newsclip program is called with stdin (desc 0) as a
X * command pipe from the caller to the newsclip program, and stdout as an
X * answer pipe from the newclip program to the caller.
X */
X
X /*
X * Newsclip(TM) Library Source Code.
X * Copyright 1989 Looking Glass Software Limited. All Rights Reserved.
X * Unless otherwise licenced, the only authorized use of this source
X * code is compilation into a binary of the newsclip library for the
X * use of licenced Newsclip customers. Minor source code modifications
X * are allowed.
X * Use of this code for a short term evaluation of the product, as defined
X * in the associated file, 'Licence', is permitted.
X */
X
X
X#include "nl.h"
X#include "pipemode.h"
X#include <signal.h>
X
X/* function that reads a command from the pipe.
X * This function returns the argument count.
X * The arguments are stored in a static buffer. Pointers into that
X * buffer are stored into argv, which should be passed by the user.
X * The first argument, argv[0], will always be the command code. This
X * is normally the letter 'C' followed by a command letter.
X *
X * The actual arguments will follow in argv[1]..argv[argc-1]. The first
X * argument will normally be a sequence number which must be returned in
X * answers.
X *
X * If there is a problem reading from the pipe, the arg count will be 0
X * If there is a problem in the argus, the arg count will be -1
X */
X
Xstruct command command_buf; /* command input buffer */
Xchar argument_buf[MAX_ARGLEN]; /* buffer for arguments */
Xchar last_sequence[SEQ_SIZE+1] = "-1"; /* last sequence num */
Xchar cur_newsgroup[MAX_NGLEN]; /* last newsgroup */
X
XFILE *pipelog = 0;
Xint inpipe = -1; /* log of all input down pipe */
X
Xint
Xread_command( argv, avsize, storeseq )
Xchar **argv; /* pointer to array to store arg pointers in */
Xint avsize; /* number of elements in argv */
Xbool storeseq; /* store the sequence number? */
X{
X int argsize; /* size of argument buffer */
X int argc; /* argument count */
X int scanloc; /* where in the arg list we are */
X int howmanbytes;
X
X argc = 0;
X
X howmanbytes = read( F_COMPIPE, &command_buf, sizeof(struct command) );
X if( inpipe >= 0 )
X write( inpipe, &command_buf, howmanbytes );
X /* fprintf( stderr, "Filter: Read %d bytes\n", howmanbytes ); */
X if( pipelog )
X fprintf(pipelog,"F:Got: %s\n", &command_buf.comtype );
X if( howmanbytes == sizeof(struct command) ) {
X argv[argc++] = &command_buf.comtype;
X command_buf.space = 0;
X argsize = atoi( command_buf.arg_size );
X /* save away the sequence for replies */
X if( storeseq ) {
X strncpy(last_sequence, command_buf.seq_num, SEQ_SIZE);
X last_sequence[SEQ_SIZE] = 0;
X }
X if( argsize > 0 ) {
X if( argsize > MAX_ARGLEN ) {
X int i;
X char c;
X /* read away the too long arguments */
X for( i = 0; i < argsize; i++ ) {
X read( F_COMPIPE, &c, 1 );
X if( inpipe >= 0 )
X write( inpipe, &c, 1 );
X }
X return ERRCODE;
X }
X else {
X int size;
X size=read(F_COMPIPE,argument_buf,argsize);
X if( inpipe > 0 )
X write(inpipe,argument_buf,size);
X if( size != argsize ) {
X return 0;
X }
X /* if not null terminated, give an error */
X if( argument_buf[argsize-1] != 0 )
X return ERRCODE;
X }
X /* now scan the arguments into argv */
X for( scanloc = 0; scanloc < argsize;
X scanloc += strlen(argument_buf+scanloc)+1 )
X if( argc < avsize )
X argv[argc++] = argument_buf+scanloc;
X if( pipelog ) {
X int i;
X for( i = 1; i < argc; i++ )
X fprintf(pipelog, "F:Got Arg %d: %s\n",
X i, argv[i] );
X }
X }
X }
X else {
X warning( 2, "Error reading from command pipe\n" );
X return 0; /* end of file */
X }
X
X return argc;
X}
X
X
Xchar argcount[] = "Invalid argument count";
X
X/* The master loop for pipe mode. Read commands from the pipe and act
X upon them */
X
Xpipe_loop()
X{
X int argc; /* count of arguments to command */
X char *argv[MAX_ARGS]; /* argument pointer vector */
X bool running; /* control for main loop */
X extern int accept_all; /* accept all articles in this group */
X extern int reject_all; /* reject all articles in this group */
X char *debenv; /* debug environment variable */
X extern char *getenv();
X extern bool do_debug;
X
X
X /* debug log pipes */
X#ifdef DEBUG
X debenv = getenv("NCLIPDEBUG");
X debenv = "truepipe"; /* temp for now */
X if( do_debug || (debenv && lowerlet(debenv[0]) == 't') ) {
X char pipename[MAX_FNAME];
X extern char *dotdir;
X sprintf( pipename, "%s/pipelog", dotdir );
X pipelog = fopen( pipename, "w" );
X sprintf( pipename, "%s/inpipe", dotdir );
X inpipe = creat( pipename, 0666 );
X if( pipelog )
X setbuf( pipelog, NULL );
X }
X#endif
X
X /* First tell the newsreader that we're alive and kicking */
X reply_ok(); /* not really a 'reply' */
X
X /* do simple init. Perhaps we wish to read nglas file? */
X
X initngs(FALSE);
X
X Uinit();
X
X /* ignore possible keyboard signals */
X
X signal( SIGINT, SIG_IGN );
X signal( SIGQUIT, SIG_IGN );
X
X running = TRUE;
X cur_newsgroup[0] = 0;
X
X while( running ) {
X argc = read_command( argv, MAX_ARGS, TRUE );
X if( argc == 0 ) {
X fprintf( stderr, "End of File from command process\n" );
X if( pipelog )
X fprintf( pipelog, "End of file from command process\n" );
X break; /* terminate and close */
X }
X if( argc < 0 ) {
X /* send an error reply */
X reply_err( "Invalid Command" );
X continue;
X }
X reset_tempalloc();
X /* switch on the various commands */
X switch( argv[0][1] ) {
X case 'V': /* version number */
X if( argc != ABASE+1 ) {
X reply_err( argcount );
X break;
X }
X reply_arg( 'V', "V100", "ABHNPQV", "ABEHORV",
X "NULL", "100", NULL );
X break;
X case 'Q': /* quit */
X if( argc != ABASE ) {
X reply_err( argcount );
X /* terminate anyway */
X }
X reply_ok();
X running = FALSE;
X break;
X case 'P': /* program command */
X /* how many args? */
X if( argc < ABASE+1 ) {
X reply_err( argcount );
X break;
X }
X /* handle kill commands */
X handle_command( argv[ABASE] );
X break;
X case 'N':
X /* query a newsgroup */
X if( argc != ABASE+1 ) {
X reply_err( argcount );
X break;
X };
X try_newgroup( argv[ABASE] );
X /* check flags? */
X if( accept_all )
X reply_arg( 'A', "1000", NULL );
X else if( reject_all )
X reply_arg( 'R', "-1000", NULL );
X else
X reply_ok();
X break;
X case 'A': /* article dialogue */
X /* newsgroup artnum [filestyle filename] */
X do_art_dialogue( argc, argv );
X break;
X default:
X reply_err( "No such command" );
X break;
X }
X }
X /* terminate this newsgroup if there was one */
X if( cur_newsgroup[0] )
X finish_group();
X Uterminate();
X}
X
Xextern int reading_mode; /* style of reading articles */
X
X/* do an article dialogue. To understand this, you really have to read
X the spec, so a lot of comments here won't do a lot of good. */
X
Xdo_art_dialogue( argc, argv )
Xint argc;
Xchar **argv;
X{
X newsgroup n; /* newsgroup of dialogue */
X char artname[MAX_FNAME]; /* filename for article file */
X char scorebuf[10]; /* buffer to make ascii score string */
X extern int score;
X extern int article_number;
X int stat; /* status of article */
X FILE *artfile;
X
X
X if( argc != ABASE+2 && argc != ABASE+4 ) {
X reply_err( argcount );
X return;
X }
X /* fprintf( stderr, "Article group %s %s mode %s file %s\n",
X argv[ABASE], argv[ABASE+1], argv[ABASE+2], argv[ABASE+3] ); */
X try_newgroup( argv[ABASE] );
X article_number = atoi(argv[ABASE+1]);
X
X if( argc > ABASE+2 ) { /* there is a file name */
X
X strcpy( artname, argv[ABASE+3] );
X
X if( argv[ABASE+2][0] == 'R' )
X reading_mode = FILE_REQUEST;
X else
X reading_mode = FILE_FULL;
X
X }
X else {
X /* pipe read currently unimplemented */
X reading_mode = PIPE_READ;
X artname[0] = 0;
X }
X stat = accept_article( artname );
X
X if( stat == ERRCODE )
X reply_err( "Bad Article Dialogue" );
X
X sprintf( scorebuf, "%d", score );
X reply_arg( stat ? 'A' : 'R', scorebuf, NULL );
X}
X
X/* Send a reply with a given command code and various string args. The
X * list of string args (up to 4) is terminated by a null string
X */
X
Xreply_arg( code, a,b,c,d,e )
Xchar code;
Xchar *a,*b,*c,*d,*e;
X{
X g_reply_arg( 'R', code, a,b,c,d,e );
X}
X
X /* low level reply routine */
X
Xg_reply_arg( rtype, code, a,b,c,d,e )
Xchar rtype; /* reply type */
Xchar code; /* reply code */
Xchar *a,*b,*c,*d,*e; /* args */
X{
X struct command reply_buf;
X char repargs[MAX_ARGLEN];
X char *vector[6];
X int i, pos; /* loop counter and position in reparts */
X
X reply_buf.comtype = rtype;
X reply_buf.comcode = code;
X reply_buf.space = ' ';
X
X /* make a vector out of the various args, up to 5 of them */
X
X vector[0] = a;
X vector[1] = b;
X vector[2] = c;
X vector[3] = d;
X vector[4] = e;
X vector[5] = NULL;
X
X pos = 0;
X for( i = 0; i < 5 && vector[i]; i++ ) {
X strcpy( repargs+pos, vector[i] );
X /* check overflow? */
X pos += strlen(vector[i]) + 1;
X }
X sprintf( reply_buf.arg_size, "%03d", pos );
X reply_buf.zerob =0;
X /* copy back in the sequence number */
X sprintf( reply_buf.seq_num, "%5.5s", last_sequence );
X reply_buf.space2 = ' ';
X
X if( pipelog ) {
X int ic;
X fprintf( pipelog, "F:Send %s\n", &reply_buf.comtype );
X for( ic = 0; ic < 5 && vector[ic]; ic++ )
X fprintf( pipelog, ":%s:", vector[ic] );
X fprintf( pipelog, "\n" );
X }
X
X
X if( write(F_ANSPIPE, &reply_buf, sizeof(reply_buf))==sizeof(reply_buf)){
X if( pos > 0 && write( F_ANSPIPE, repargs, pos ) != pos )
X pipe_abort();
X }
X else
X pipe_abort();
X}
X
X/* A write failed to the pipe, we have to terminate */
X
Xpipe_abort()
X{
X if( pipelog )
X fprintf( pipelog, "Pipe Abort\n" );
X warning( 2, "Pipe mode abort\n" );
X if( cur_newsgroup[0] )
X finish_group();
X Uterminate();
X wrapup();
X exit(1);
X}
X
X/* check group name and if the group changed, call user routines if it did */
X/* The main group must stay around until it changes. To do this, we
X effectively reserve slot -1 for it using the ex_group_base variable. */
X
Xtry_newgroup( gname )
Xchar *gname;
X{
X extern newsgroup main_newsgroup;
X extern int extra_groups, ex_group_base; /* count of un-named groups */
X newsgroup new_newsgroup;
X
X if( strcmp( gname, cur_newsgroup ) != 0 ) {
X if( cur_newsgroup[0] ) {
X finish_group();
X }
X strcpy( cur_newsgroup, gname );
X /* allocate an extra group that stays until the next change */
X ex_group_base = extra_groups = 0;
X main_newsgroup = ng_number( cur_newsgroup );
X ex_group_base = extra_groups;
X Ustartgroup( 1 );
X }
X}
X
Xreply_ok()
X{
X reply_arg( 'O', NULL );
X}
X
Xreply_err( ermsg )
Xchar *ermsg;
X{
X reply_arg( 'E', ermsg, NULL );
X}
X
Xhandle_command(com)
Xchar *com;
X{
X extern int score;
X score = 0;
X Ucommand(com);
X if( score > 0 )
X reply_ok();
X else
X reply_err( "Invalid Kill Command" );
X}
X
X/*
X * Send a query, and await a response to that query
X * Returns 0 for OK, -1 for error
X */
X
Xquery( wquery, qarg )
Xchar wquery; /* what sort of query */
Xchar *qarg; /* argument, if any */
X{
X char *argv[MAX_ARGS]; /* argument pointer vector */
X int argc;
X g_reply_arg( 'Q', wquery, qarg, NULL );
X /* Read response, do not set sequence number */
X argc = read_command( argv, MAX_ARGS, FALSE );
X /* we don't care about the argument */
X if( argv[0][1] != wquery || argc > ABASE+2 )
X return ERRCODE;
X else
X return 0;
X}
X
X/* ask that the header be written to the file */
X/* This routine is not to be called in FILE_FULL mode */
X
Xint
Xask_for_header()
X{
X return query( 'H', NULL );
X}
X
X/* ask that the body be written to the article file */
X/* Not much we can do with error status at this point, as we are too
X deep in code, but we will return it regardless */
X/* This routine is not to be called in FILE_FULL mode */
X
Xint
Xask_for_body()
X{
X return query( 'B', NULL );
X}
END_OF_FILE
if test 12339 -ne `wc -c <'pipe.c'`; then
echo shar: \"'pipe.c'\" unpacked with wrong size!
fi
# end of 'pipe.c'
fi
echo shar: End of archive 7 \(of 15\).
cp /dev/null ark7isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 15 archives.
rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0