Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/unix/volume27/calc-2.9.0/part05

Text File | 1993-12-07 | 59.7 KB | 2,990 lines

Newsgroups: comp.sources.unix
From: [e-mail] (David I. Bell)
Subject: v27i132: calc-2.9.0 - arbitrary precision C-like programmable calculator, Part05/19
References: <[e-mail]>
Sender: [e-mail]
Approved: [e-mail]

Submitted-By: [e-mail] (David I. Bell)
Posting-Number: Volume 27, Issue 132
Archive-Name: calc-2.9.0/part05

#!/bin/sh
# this is part 5 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file calc2.9.0/func.c continued
#
CurArch=5
if test ! -r s2_seq_.tmp
then echo "Please unpack part 1 first!"
     exit 1; fi
( read Scheck
  if test "$Scheck" != $CurArch
  then echo "Please unpack part $Scheck next!"
       exit 1;
  else exit 0; fi
) < s2_seq_.tmp || exit 1
echo "x - Continuing file calc2.9.0/func.c"
sed 's/^X//' << 'SHAR_EOF' >> calc2.9.0/func.c
X        math_error("Non-numeric positions for substr");
X    q1 = v2->v_num;
X    q2 = v3->v_num;
X    if (qisfrac(q1) || qisneg(q1) || qisfrac(q2) || qisneg(q2))
X        math_error("Illegal positions for substr");
X    i1 = qtoi(q1);
X    i2 = qtoi(q2);
X    cp = v1->v_str;
X    len = strlen(cp);
X    result.v_type = V_STR;
X    if (i1 > 0)
X        i1--;
X    if (i1 >= len) {    /* indexing off of end */
X        result.v_subtype = V_STRLITERAL;
X        result.v_str = "";
X        return result;
X    }
X    cp += i1;
X    len -= i1;
X    if ((i2 >= len) && (v1->v_subtype == V_STRLITERAL)) {
X        result.v_subtype = V_STRLITERAL;
X        result.v_str = cp;
X        return result;
X    }
X    if (len > i2)
X        len = i2;
X    if (len == 1) {
X        result.v_subtype = V_STRLITERAL;
X        result.v_str = charstr(*cp);
X        return result;
X    }
X    result.v_subtype = V_STRALLOC;
X    result.v_str = (char *)malloc(len + 1);
X    if (result.v_str == NULL)
X        math_error("No memory for substr");
X    strncpy(result.v_str, cp, len);
X    result.v_str[len] = '\0';
X    return result;
X}
X
X
Xstatic VALUE
Xf_char(vp)
X    VALUE *vp;
X{
X    long num;
X    NUMBER *q;
X    VALUE result;
X
X    if (vp->v_type != V_NUM)
X        math_error("Non-numeric argument for char");
X    q = vp->v_num;
X    num = qtoi(q);
X    if (qisneg(q) || qisfrac(q) || zisbig(q->num) || (num > 255))
X        math_error("Illegal number for char");
X    result.v_type = V_STR;
X    result.v_subtype = V_STRLITERAL;
X    result.v_str = charstr((int) num);
X    return result;
X}
X
X
Xstatic VALUE
Xf_ord(vp)
X    VALUE *vp;
X{
X    char *str;
X    VALUE result;
X
X    if (vp->v_type != V_STR)
X        math_error("Non-string argument for ord");
X    str = vp->v_str;
X    if (str[0] && str[1])
X        math_error("Multi-character string given for ord");
X    result.v_type = V_NUM;
X    result.v_num = itoq((long) (*str & 0xff));
X    return result;
X}
X
X
Xstatic VALUE
Xf_size(vp)
X    VALUE *vp;
X{
X    long count;
X    VALUE result;
X
X    switch (vp->v_type) {
X        case V_NULL:    count = 0; break;
X        case V_MAT:    count = vp->v_mat->m_size; break;
X        case V_LIST:    count = vp->v_list->l_count; break;
X        case V_ASSOC:    count = vp->v_assoc->a_count; break;
X        case V_OBJ:    count = vp->v_obj->o_actions->count; break;
X        default:    count = 1; break;
X    }
X    result.v_type = V_NUM;
X    result.v_num = itoq(count);
X    return result;
X}
X
X
Xstatic VALUE
Xf_search(count, vals)
X    VALUE **vals;
X{
X    VALUE *v1, *v2;
X    NUMBER *q;
X    long start;
X    long index;
X    VALUE result;
X
X    v1 = *vals++;
X    v2 = *vals++;
X    start = 0;
X    if (count == 3) {
X        if ((*vals)->v_type != V_NUM)
X            math_error("Non-numeric start index for search");
X        q = (*vals)->v_num;
X        if (qisfrac(q) || qisneg(q))
X            math_error("Bad start index for search");
X        start = qtoi(q);
X    }
X    switch (v1->v_type) {
X        case V_MAT:
X            index = matsearch(v1->v_mat, v2, start);
X            break;
X        case V_LIST:
X            index = listsearch(v1->v_list, v2, start);
X            break;
X        case V_ASSOC:
X            index = assocsearch(v1->v_assoc, v2, start);
X            break;
X        default:
X            math_error("Bad argument type for search");
X    }
X    result.v_type = V_NULL;
X    if (index >= 0) {
X        result.v_type = V_NUM;
X        result.v_num = itoq(index);
X    }
X    return result;
X}
X
X
Xstatic VALUE
Xf_rsearch(count, vals)
X    VALUE **vals;
X{
X    VALUE *v1, *v2;
X    NUMBER *q;
X    long start;
X    long index;
X    VALUE result;
X
X    v1 = *vals++;
X    v2 = *vals++;
X    start = MAXFULL;
X    if (count == 3) {
X        if ((*vals)->v_type != V_NUM)
X            math_error("Non-numeric start index for rsearch");
X        q = (*vals)->v_num;
X        if (qisfrac(q) || qisneg(q))
X            math_error("Bad start index for rsearch");
X        start = qtoi(q);
X    }
X    switch (v1->v_type) {
X        case V_MAT:
X            index = matrsearch(v1->v_mat, v2, start);
X            break;
X        case V_LIST:
X            index = listrsearch(v1->v_list, v2, start);
X            break;
X        case V_ASSOC:
X            index = assocrsearch(v1->v_assoc, v2, start);
X            break;
X        default:
X            math_error("Bad argument type for rsearch");
X    }
X    result.v_type = V_NULL;
X    if (index >= 0) {
X        result.v_type = V_NUM;
X        result.v_num = itoq(index);
X    }
X    return result;
X}
X
X
Xstatic VALUE
Xf_list(count, vals)
X    VALUE **vals;
X{
X    VALUE result;
X
X    result.v_type = V_LIST;
X    result.v_list = listalloc();
X    while (count-- > 0)
X        insertlistlast(result.v_list, *vals++);
X    return result;
X}
X
X
X/*ARGSUSED*/
Xstatic VALUE
Xf_assoc(count, vals)
X    VALUE **vals;
X{
X    VALUE result;
X
X    result.v_type = V_ASSOC;
X    result.v_assoc = assocalloc(0L);
X    return result;
X}
X
X
Xstatic VALUE
Xf_listinsert(v1, v2, v3)
X    VALUE *v1, *v2, *v3;
X{
X    VALUE result;
X
X    if ((v1->v_type != V_ADDR) || (v1->v_addr->v_type != V_LIST))
X        math_error("Inserting into non-list variable");
X    if (v2->v_type == V_ADDR)
X        v2 = v2->v_addr;
X    if ((v2->v_type != V_NUM) || qisfrac(v2->v_num))
X        math_error("Non-integral index for list insert");
X    if (v3->v_type == V_ADDR)
X        v3 = v3->v_addr;
X    insertlistmiddle(v1->v_addr->v_list, qtoi(v2->v_num), v3);
X    result.v_type = V_NULL;
X    return result;
X}
X
X
Xstatic VALUE
Xf_listpush(v1, v2)
X    VALUE *v1, *v2;
X{
X    VALUE result;
X
X    if ((v1->v_type != V_ADDR) || (v1->v_addr->v_type != V_LIST))
X        math_error("Pushing onto non-list variable");
X    if (v2->v_type == V_ADDR)
X        v2 = v2->v_addr;
X    insertlistfirst(v1->v_addr->v_list, v2);
X    result.v_type = V_NULL;
X    return result;
X}
X
X
Xstatic VALUE
Xf_listappend(v1, v2)
X    VALUE *v1, *v2;
X{
X    VALUE result;
X
X    if ((v1->v_type != V_ADDR) || (v1->v_addr->v_type != V_LIST))
X        math_error("Appending to non-list variable");
X    if (v2->v_type == V_ADDR)
X        v2 = v2->v_addr;
X    insertlistlast(v1->v_addr->v_list, v2);
X    result.v_type = V_NULL;
X    return result;
X}
X
X
Xstatic VALUE
Xf_listdelete(v1, v2)
X    VALUE *v1, *v2;
X{
X    VALUE result;
X
X    if ((v1->v_type != V_ADDR) || (v1->v_addr->v_type != V_LIST))
X        math_error("Deleting from non-list variable");
X    if (v2->v_type == V_ADDR)
X        v2 = v2->v_addr;
X    if ((v2->v_type != V_NUM) || qisfrac(v2->v_num))
X        math_error("Non-integral index for list delete");
X    removelistmiddle(v1->v_addr->v_list, qtoi(v2->v_num), &result);
X    return result;
X}
X
X
Xstatic VALUE
Xf_listpop(vp)
X    VALUE *vp;
X{
X    VALUE result;
X
X    if ((vp->v_type != V_ADDR) || (vp->v_addr->v_type != V_LIST))
X        math_error("Popping from non-list variable");
X    removelistfirst(vp->v_addr->v_list, &result);
X    return result;
X}
X
X
Xstatic VALUE
Xf_listremove(vp)
X    VALUE *vp;
X{
X    VALUE result;
X
X    if ((vp->v_type != V_ADDR) || (vp->v_addr->v_type != V_LIST))
X        math_error("Removing from non-list variable");
X    removelistlast(vp->v_addr->v_list, &result);
X    return result;
X}
X
X
X/*
X * Return the current runtime of calc in seconds.
X * This is the user mode time only.
X */
Xstatic NUMBER *
Xf_runtime()
X{
X    struct tms buf;
X
X    times(&buf);
X    return iitoq((long) buf.tms_utime, (long) CLK_TCK);
X}
X
X
Xstatic VALUE
Xf_fopen(v1, v2)
X    VALUE *v1, *v2;
X{
X    VALUE result;
X    FILEID id;
X
X    if (v1->v_type != V_STR)
X        math_error("Non-string filename for fopen");
X    if (v2->v_type != V_STR)
X        math_error("Non-string mode for fopen");
X    id = openid(v1->v_str, v2->v_str);
X    if (id == FILEID_NONE) {
X        result.v_type = V_NUM;
X        result.v_num = itoq((long) errno);
X    } else {
X        result.v_type = V_FILE;
X        result.v_file = id;
X    }
X    return result;
X}
X
X
Xstatic VALUE
Xf_fclose(vp)
X    VALUE *vp;
X{
X    VALUE result;
X
X    if (vp->v_type != V_FILE)
X        math_error("Non-file for fclose");
X    if (closeid(vp->v_file)) {
X        result.v_type = V_NUM;
X        result.v_num = itoq((long) errno);
X    } else
X        result.v_type = V_NULL;
X    return result;
X}
X
X
Xstatic VALUE
Xf_ferror(vp)
X    VALUE *vp;
X{
X    VALUE result;
X
X    if (vp->v_type != V_FILE)
X        math_error("Non-file for ferror");
X    result.v_type = V_NUM;
X    result.v_num = itoq((long) errorid(vp->v_file));
X    return result;
X}
X
X
Xstatic VALUE
Xf_feof(vp)
X    VALUE *vp;
X{
X    VALUE result;
X
X    if (vp->v_type != V_FILE)
X        math_error("Non-file for feof");
X    result.v_type = V_NUM;
X    result.v_num = itoq((long) eofid(vp->v_file));
X    return result;
X}
X
X
Xstatic VALUE
Xf_fflush(vp)
X    VALUE *vp;
X{
X    VALUE result;
X
X    if (vp->v_type != V_FILE)
X        math_error("Non-file for fflush");
X    flushid(vp->v_file);
X    result.v_type = V_NULL;
X    return result;
X}
X
X
Xstatic VALUE
Xf_fprintf(count, vals)
X    VALUE **vals;
X{
X    VALUE result;
X
X    if (vals[0]->v_type != V_FILE)
X        math_error("Non-file for fprintf");
X    if (vals[1]->v_type != V_STR)
X        math_error("Non-string format for fprintf");
X    idprintf(vals[0]->v_file, vals[1]->v_str, count - 2, vals + 2);
X    result.v_type = V_NULL;
X    return result;
X}
X
X
Xstatic VALUE
Xf_printf(count, vals)
X    VALUE **vals;
X{
X    VALUE result;
X
X    if (vals[0]->v_type != V_STR)
X        math_error("Non-string format for printf");
X    idprintf(FILEID_STDOUT, vals[0]->v_str, count - 1, vals + 1);
X    result.v_type = V_NULL;
X    return result;
X}
X
X
Xstatic VALUE
Xf_strprintf(count, vals)
X    VALUE **vals;
X{
X    VALUE result;
X
X    if (vals[0]->v_type != V_STR)
X        math_error("Non-string format for strprintf");
X    math_divertio();
X    idprintf(FILEID_STDOUT, vals[0]->v_str, count - 1, vals + 1);
X    result.v_str = math_getdivertedio();
X    result.v_type = V_STR;
X    result.v_subtype = V_STRALLOC;
X    return result;
X}
X
X
Xstatic VALUE
Xf_fgetc(vp)
X    VALUE *vp;
X{
X    VALUE result;
X    int ch;
X
X    if (vp->v_type != V_FILE)
X        math_error("Non-file for fgetc");
X    ch = getcharid(vp->v_file);
X    result.v_type = V_NULL;
X    if (ch != EOF) {
X        result.v_type = V_STR;
X        result.v_subtype = V_STRLITERAL;
X        result.v_str = charstr(ch);
X    }
X    return result;
X}
X
X
Xstatic VALUE
Xf_fgetline(vp)
X    VALUE *vp;
X{
X    VALUE result;
X    char *str;
X
X    if (vp->v_type != V_FILE)
X        math_error("Non-file for fgetline");
X    readid(vp->v_file, &str);
X    result.v_type = V_NULL;
X    if (str) {
X        result.v_type = V_STR;
X        result.v_subtype = V_STRALLOC;
X        result.v_str = str;
X    }
X    return result;
X}
X
X
Xstatic VALUE
Xf_files(count, vals)
X    VALUE **vals;
X{
X    VALUE result;
X
X    if (count == 0) {
X        result.v_type = V_NUM;
X        result.v_num = itoq((long) MAXFILES);
X        return result;
X    }
X    if ((vals[0]->v_type != V_NUM) || qisfrac(vals[0]->v_num))
X        math_error("Non-integer for files");
X    result.v_type = V_NULL;
X    result.v_file = indexid(qtoi(vals[0]->v_num));
X    if (result.v_file != FILEID_NONE)
X        result.v_type = V_FILE;
X    return result;
X}
X
X
X/*
X * Show the list of primitive built-in functions
X */
Xvoid
Xshowbuiltins()
X{
X    register struct builtin *bp;    /* current function */
X
X    printf("\nName\tArgs\tDescription\n\n");
X    for (bp = builtins; bp->b_name; bp++) {
X        printf("%-9s ", bp->b_name);
X        if (bp->b_maxargs == IN)
X            printf("%d+    ", bp->b_minargs);
X        else if (bp->b_minargs == bp->b_maxargs)
X            printf("%-6d", bp->b_minargs);
X        else
X            printf("%d-%-4d", bp->b_minargs, bp->b_maxargs);
X        printf(" %s\n", bp->b_desc);
X    }
X    printf("\n");
X}
X
X
X/*
X * Return the index of a built-in function given its name.
X * Returns minus one if the name is not known.
X */
Xgetbuiltinfunc(name)
X    char *name;
X{
X    register struct builtin *bp;
X
X    for (bp = builtins; bp->b_name; bp++) {
X        if ((*name == *bp->b_name) && (strcmp(name, bp->b_name) == 0))
X        return (bp - builtins);
X    }
X    return -1;
X}
X
X
X/*
X * Given the index of a built-in function, return its name.
X */
Xchar *
Xbuiltinname(index)
X    long index;
X{
X    if ((unsigned long)index >= (sizeof(builtins) / sizeof(builtins[0])) - 1)
X        return "";
X    return builtins[index].b_name;
X}
X
X
X/*
X * Given the index of a built-in function, and the number of arguments seen,
X * determine if the number of arguments are legal.  This routine is called
X * during parsing time.
X */
Xvoid
Xbuiltincheck(index, count)
X    long index;
X{
X    register struct builtin *bp;
X
X    if ((unsigned long)index >= (sizeof(builtins) / sizeof(builtins[0])) - 1)
X        math_error("Unknown built in index");
X    bp = &builtins[index];
X    if (count < bp->b_minargs)
X        scanerror(T_NULL, "Too few arguments for builtin function \"%s\"",
X    bp->b_name);
X    if (count > bp->b_maxargs)
X        scanerror(T_NULL, "Too many arguments for builtin function \"%s\"",
X            bp->b_name);
X}
X
X
X/*
X * Return the opcode for a built-in function that can be used to avoid
X * the function call at all.
X */
Xbuiltinopcode(index)
X    long index;
X{
X    if ((unsigned long)index >= (sizeof(builtins) / sizeof(builtins[0])) - 1)
X        return OP_NOP;
X    return builtins[index].b_opcode;
X}
X
X/* END CODE */
SHAR_EOF
echo "File calc2.9.0/func.c is complete"
chmod 0644 calc2.9.0/func.c || echo "restore of calc2.9.0/func.c fails"
set `wc -c calc2.9.0/func.c`;Sum=$1
if test "$Sum" != "48684"
then echo original size 48684, current size $Sum;fi
echo "x - extracting calc2.9.0/func.h (Text)"
sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/func.h &&
X/*
X * Copyright (c) 1993 David I. Bell
X * Permission is granted to use, distribute, or modify this source,
X * provided that this copyright notice remains intact.
X */
X
X
X#ifndef    FUNC_H
X#define    FUNC_H
X
X#include "calc.h"
X#include "label.h"
X
X
X/*
X * Structure of a function.
X * The f_opcodes array is actually of variable size.
X */
Xtypedef struct func FUNC;
Xstruct func {
X    FUNC *f_next;            /* next function in list */
X    unsigned long f_opcodecount;    /* size of opcode array */
X    unsigned int f_localcount;    /* number of local variables */
X    unsigned int f_paramcount;    /* max number of parameters */
X    char *f_name;            /* function name */
X    VALUE f_savedvalue;        /* saved value of last expression */
X    long f_opcodes[1];        /* array of opcodes (variable length) */
X};
X
X
X/*
X * Amount of space needed to allocate a function of n opcodes.
X */
X#define funcsize(n) (sizeof(FUNC) + (n) * sizeof(long))
X
X
X/*
X * Size of a character pointer rounded up to a number of opcodes.
X */
X#define PTR_SIZE ((sizeof(char *) + sizeof(long) - 1) / sizeof(long))
X
X
X/*
X * The current function being compiled.
X */
Xextern FUNC *curfunc;
X
X
X/*
X * Functions to handle functions.
X */
Xextern FUNC *findfunc MATH_PROTO((long index));
Xextern char *namefunc MATH_PROTO((long index));
Xextern BOOL evaluate MATH_PROTO((BOOL nestflag));
Xextern long adduserfunc MATH_PROTO((char *name));
Xextern void beginfunc MATH_PROTO((char *name, BOOL newflag));
Xextern int builtinopcode MATH_PROTO((long index));
Xextern char *builtinname MATH_PROTO((long index));
Xextern int dumpop MATH_PROTO((long *pc));
Xextern void addop MATH_PROTO((long op));
Xextern void endfunc MATH_PROTO((void));
Xextern void addopone MATH_PROTO((long op, long arg));
Xextern void addoptwo MATH_PROTO((long op, long arg1, long arg2));
Xextern void addoplabel MATH_PROTO((long op, LABEL *label));
Xextern void addopptr MATH_PROTO((long op, char *ptr));
Xextern void writeindexop MATH_PROTO((void));
Xextern void showbuiltins MATH_PROTO((void));
Xextern int getbuiltinfunc MATH_PROTO((char *name));
Xextern void builtincheck MATH_PROTO((long index, int count));
Xextern void addopfunction MATH_PROTO((long op, long index, int count));
Xextern void showfunctions MATH_PROTO((void));
Xextern void initfunctions MATH_PROTO((void));
Xextern void clearopt MATH_PROTO((void));
Xextern void updateoldvalue MATH_PROTO((FUNC *fp));
Xextern void calculate MATH_PROTO((FUNC *fp, int argcount));
Xextern VALUE builtinfunc MATH_PROTO((long index, int argcount, VALUE *stck));
X
X#endif
X
X/* END CODE */
SHAR_EOF
chmod 0644 calc2.9.0/func.h || echo "restore of calc2.9.0/func.h fails"
set `wc -c calc2.9.0/func.h`;Sum=$1
if test "$Sum" != "2475"
then echo original size 2475, current size $Sum;fi
echo "x - extracting calc2.9.0/hist.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/hist.c &&
X/*
X * Copyright (c) 1993 David I. Bell
X * Permission is granted to use, distribute, or modify this source,
X * provided that this copyright notice remains intact.
X *
X * Adapted from code written by Stephen Rothwell.
X *
X * Interactive readline module.  This is called to read lines of input,
X * while using emacs-like editing commands within a command stack.
X * The key bindings for the editing commands are (slightly) configurable.
X */
X
X#include <stdio.h>
X#include <ctype.h>
X#include <pwd.h>
X#include "hist.h"
X#include "terminal.h"
X
X
X#if defined(USE_TERMIOS)
X# include <termios.h>
X# define TTYSTRUCT    struct    termios
X#else /* USE_SGTTY */
X# if defined(USE_TERMIO)
X#  include <termio.h>
X#  define TTYSTRUCT    struct    termio
X# else /* USE_TERMIO */
X   /* assume USE_SGTTY */
X#  include <sys/ioctl.h>
X#  define TTYSTRUCT    struct    sgttyb
X# endif /* USE_TERMIO */
X#endif /* USE_SGTTY */
X
X
X#define    STDIN        0
X#define    SAVE_SIZE    256        /* size of save buffer */
X#define    MAX_KEYS    60        /* number of key bindings */
X
X
X#define CONTROL(x)        ((char)(((int)(x)) & 0x1f))
X
Xstatic    struct {
X    char    *prompt;
X    char    *buf;
X    char    *pos;
X    char    *end;
X    char    *mark;
X    int    bufsize;
X    int    linelen;
X    int    histcount;
X    int    curhist;
X} HS;
X
X
Xtypedef    void (*FUNCPTR)();
X
Xtypedef struct {
X    char    *name;
X    FUNCPTR    func;
X} FUNC;
X
X
Xstatic void    flush_input(), start_of_line(), end_of_line();
Xstatic void    forward_char(), backward_char(), forward_word();
Xstatic void    backward_word(), delete_char(), forward_kill_char();
Xstatic void    backward_kill_char(), forward_kill_word(), kill_line();
Xstatic void    new_line(), save_line(), forward_history();
Xstatic void    backward_history(), insert_char();
Xstatic void    goto_line(), list_history(), refresh_line(), swap_chars();
Xstatic void    set_mark(), yank(), save_region(), kill_region();
Xstatic void    reverse_search(), quote_char(), uppercase_word();
Xstatic void    lowercase_word(), ignore_char(), arrow_key();
X
X
Xstatic    FUNC    funcs[] =
X{
X    {"ignore-char",        ignore_char},
X    {"flush-input",        flush_input},
X    {"start-of-line",    start_of_line},
X    {"end-of-line",        end_of_line},
X    {"forward-char",    forward_char},
X    {"backward-char",    backward_char},
X    {"forward-word",    forward_word},
X    {"backward-word",    backward_word},
X    {"delete-char",        delete_char},
X    {"forward-kill-char",    forward_kill_char},
X    {"backward-kill-char",    backward_kill_char},
X    {"forward-kill-word",    forward_kill_word},
X    {"uppercase-word",    uppercase_word},
X    {"lowercase-word",    lowercase_word},
X    {"kill-line",        kill_line},
X    {"goto-line",        goto_line},
X    {"new-line",        new_line},
X    {"save-line",        save_line},
X    {"forward-history",    forward_history},
X    {"backward-history",    backward_history},
X    {"insert-char",        insert_char},
X    {"list-history",    list_history},
X    {"refresh-line",    refresh_line},
X    {"swap-chars",        swap_chars},
X    {"set-mark",        set_mark},
X    {"yank",        yank},
X    {"save-region",        save_region},
X    {"kill-region",        kill_region},
X    {"reverse-search",    reverse_search},
X    {"quote-char",        quote_char},
X    {"arrow-key",        arrow_key},
X    {NULL,             NULL}
X};
X
X
Xtypedef struct key_ent    KEY_ENT;
Xtypedef struct key_map    KEY_MAP;
X
Xstruct key_ent    {
X    FUNCPTR        func;
X    KEY_MAP        *next;
X};
X
X
Xstruct key_map {
X    char        *name;
X    KEY_ENT        default_ent;
X    KEY_ENT        *map[256];
X};
X
X
Xstatic char    base_map_name[] = "base-map";
Xstatic char    esc_map_name[] = "esc-map";
X
X
Xstatic KEY_MAP    maps[] = {
X    {base_map_name},
X    {esc_map_name}
X};
X
X
X#define    INTROUND    (sizeof(int) - 1)
X#define    HISTLEN(hp)    ((((hp)->len + INTROUND) & ~INTROUND) + sizeof(int))
X#define    HISTOFFSET(hp)    (((char *) (hp)) - histbuf)
X#define    FIRSTHIST    ((HIST *) histbuf)
X#define    NEXTHIST(hp)    ((HIST *) (((char *) (hp)) + HISTLEN(hp)))
X
X
Xtypedef struct {
X    int    len;        /* length of data */
X    char    data[1];    /* varying length data */
X} HIST;
X
X
Xstatic    int        inited;
Xstatic    int        canedit;
Xstatic    int        histused;
Xstatic    int        key_count;
Xstatic    int        save_len;
Xstatic    TTYSTRUCT    oldtty;
Xstatic    KEY_MAP        *cur_map;
Xstatic    KEY_MAP        *base_map;
Xstatic    KEY_ENT        key_table[MAX_KEYS];
Xstatic    char        histbuf[HIST_SIZE + 1];
Xstatic    char        save_buffer[SAVE_SIZE];
X
X
Xstatic    FUNCPTR    find_func();
Xstatic    HIST    *get_event();
Xstatic    HIST    *find_event();
Xstatic    void    read_key();
Xstatic    void    erasechar();
Xstatic    void    newline();
Xstatic    void    backspace();
Xstatic    void    beep();
Xstatic    void    echo_char();
Xstatic    void    echo_string();
Xstatic    void    savetext();
Xstatic    void    memrcpy();
Xstatic    int    read_bindings();
Xstatic    int    in_word();
X
X
X/*
X * Read a line into the specified buffer.  The line ends in a newline,
X * and is NULL terminated.  Returns the number of characters read, or
X * zero on an end of file or error.  The prompt is printed before reading
X * the line.
X */
Xint
Xhist_getline(prompt, buf, len)
X    char    *prompt;
X    char    *buf;
X    int    len;
X{
X    if (!inited)
X        (void) hist_init((char *) NULL);
X
X    HS.prompt = prompt;
X    HS.bufsize = len - 2;
X    HS.buf = buf;
X    HS.pos = buf;
X    HS.end = buf;
X    HS.mark = NULL;
X    HS.linelen = -1;
X
X    fputs(prompt, stdout);
X    fflush(stdout);
X
X    if (!canedit) {
X        if (fgets(buf, len, stdin) == NULL)
X            return 0;
X        return strlen(buf);
X    }
X
X    while (HS.linelen < 0)
X        read_key();
X
X    return HS.linelen;
X}
X
X
X/*
X * Initialize the module by reading in the key bindings from the specified
X * filename, and then setting the terminal modes for noecho and cbreak mode.
X * If the supplied filename is NULL, then a default filename will be used.
X * Returns zero if successful, or a nonzero error code if unsuccessful.
X * If this routine fails, hist_getline, hist_saveline, and hist_term can
X * still be called but all fancy editing is disabled.
X */
Xint
Xhist_init(filename)
X    char    *filename;
X{
X    TTYSTRUCT    newtty;
X
X    if (inited)
X        return HIST_INITED;
X
X    inited = 1;
X    canedit = 0;
X
X    if (filename == NULL)
X        filename = HIST_BINDING_FILE;
X
X    if (read_bindings(filename))
X        return HIST_NOFILE;
X
X#ifdef    USE_SGTTY
X    if (ioctl(STDIN, TIOCGETP, &oldtty) < 0)
X        return HIST_NOTTY;
X
X    newtty = oldtty;
X    newtty.sg_flags &= ~ECHO;
X    newtty.sg_flags |= CBREAK;
X
X    if (ioctl(STDIN, TIOCSETP, &newtty) < 0)
X        return HIST_NOTTY;
X#endif
X
X#ifdef    USE_TERMIO
X    if (ioctl(STDIN, TCGETA, &oldtty) < 0)
X        return HIST_NOTTY;
X
X    newtty = oldtty;
X    newtty.c_lflag &= ~(ECHO | ECHOE | ECHOK);
X    newtty.c_iflag |= ISTRIP;
X    newtty.c_lflag &= ~ICANON;
X    newtty.c_cc[VMIN] = 1;
X    newtty.c_cc[VTIME] = 0;
X
X    if (ioctl(STDIN, TCSETAW, &newtty) < 0)
X        return HIST_NOTTY;
X#endif
X
X#ifdef    USE_TERMIOS
X    if (tcgetattr(STDIN, &oldtty) < 0)
X        return HIST_NOTTY;
X
X    newtty = oldtty;
X    newtty.c_lflag &= ~(ECHO | ECHOE | ECHOK);
X    newtty.c_iflag |= ISTRIP;
X    newtty.c_lflag &= ~ICANON;
X    newtty.c_cc[VMIN] = 1;
X    newtty.c_cc[VTIME] = 0;
X
X    if (tcsetattr(STDIN, TCSANOW, &newtty) < 0)
X        return HIST_NOTTY;
X#endif
X
X    canedit = 1;
X
X    return HIST_SUCCESS;
X}
X
X
X/*
X * Reset the terminal modes just before exiting.
X */
Xvoid
Xhist_term()
X{
X    if (!inited || !canedit) {
X        inited = 0;
X        return;
X    }
X
X#ifdef    USE_SGTTY
X    (void) ioctl(STDIN, TIOCSETP, &oldtty);
X#endif
X
X#ifdef    USE_TERMIO
X    (void) ioctl(STDIN, TCSETAW, &oldtty);
X#endif
X
X#ifdef    USE_TERMIOS
X    (void) tcsetattr(STDIN, TCSANOW, &oldtty);
X#endif
X}
X
X
Xstatic KEY_MAP *
Xfind_map(map)
X    char    *map;
X{
X    int    i;
X
X    for (i = 0; i < sizeof(maps) / sizeof(maps[0]); i++) {
X        if (strcmp(map, maps[i].name) == 0)
X            return &maps[i];
X    }
X    return NULL;
X}
X
X
Xstatic void
Xunbind_key(map, key)
X    KEY_MAP        *map;
X{
X    map->map[key] = NULL;
X}
X
X
Xstatic void
Xraw_bind_key(map, key, func, next_map)
X    KEY_MAP        *map;
X    FUNCPTR        func;
X    KEY_MAP        *next_map;
X{
X    if (map->map[key] == NULL) {
X        if (key_count >= MAX_KEYS)
X            return;
X        map->map[key] = &key_table[key_count++];
X    }
X    map->map[key]->func = func;
X    map->map[key]->next = next_map;
X}
X
X
Xstatic KEY_MAP *
Xdo_map_line(line)
X    char    line[];
X{
X    char    *cp;
X    char    *map_name;
X
X    cp = line;
X    while (isspace(*cp))
X        cp++;
X    if (*cp == '\0')
X        return NULL;
X    map_name = cp;
X    while ((*cp != '\0') && !isspace(*cp))
X        cp++;
X    *cp = '\0';
X    return find_map(map_name);
X}
X
X
Xstatic void
Xdo_bind_line(map, line)
X    KEY_MAP        *map;
X    char        line[];
X{
X    char        *cp;
X    char        key;
X    char        *func_name;
X    char        *next_name;
X    KEY_MAP        *next;
X    FUNCPTR        func;
X
X    if (map == NULL)
X        return;
X    cp = line;
X    key = *cp++;
X    if (*cp == '\0') {
X        unbind_key(map, key);
X        return;
X    }
X    if (key == '^') {
X        if (*cp == '?') {
X            key = 0177;
X            cp++;
X        } else
X            key = CONTROL(*cp++);
X    }
X    else if (key == '\\')
X        key = *cp++;
X
X    while (isspace(*cp))
X        cp++;
X    if (*cp == '\0') {
X        unbind_key(map, key);
X        return;
X    }
X
X    func_name = cp;
X    while ((*cp != '\0') && !isspace(*cp))
X        cp++;
X    if (*cp) {
X        *cp++ = '\0';
X        while (isspace(*cp))
X            cp++;
X    }
X    func = find_func(func_name);
X    if (func == NULL) {
X        fprintf(stderr, "Unknown function \"%s\"\n", func_name);
X        return;
X    }
X
X    if (*cp == '\0') {
X        next = map->default_ent.next;
X        if (next == NULL)
X            next = base_map;
X    } else {
X        next_name = cp;
X        while ((*cp != '\0') && !isspace(*cp))
X            cp++;
X        if (*cp) {
X            *cp++ = '\0';
X            while (isspace(*cp))
X                cp++;
X        }
X        next = find_map(next_name);
X        if (next == NULL)
X            return;
X    }
X    raw_bind_key(map, key, func, next);
X}
X
X
Xstatic void
Xdo_default_line(map, line)
X    KEY_MAP        *map;
X    char        *line;
X{
X    char        *cp;
X    char        *func_name;
X    char        *next_name;
X    KEY_MAP        *next;
X    FUNCPTR        func;
X
X    if (map == NULL)
X        return;
X    cp = line;
X    while (isspace(*cp))
X        cp++;
X    if (*cp == '\0')
X        return;
X
X    func_name = cp;
X    while ((*cp != '\0') && !isspace(*cp))
X        cp++;
X    if (*cp != '\0')
X    {
X        *cp++ = '\0';
X        while (isspace(*cp))
X            cp++;
X    }
X    func = find_func(func_name);
X    if (func == NULL)
X        return;
X
X    if (*cp == '\0')
X        next = map;
X    else
X    {
X        next_name = cp;
X        while ((*cp != '\0') && !isspace(*cp))
X            cp++;
X        if (*cp != '\0')
X        {
X            *cp++ = '\0';
X            while (isspace(*cp))
X                cp++;
X        }
X        next = find_map(next_name);
X        if (next == NULL)
X            return;
X    }
X
X    map->default_ent.func = func;
X    map->default_ent.next = next;
X}
X
X
X/*
X * Read bindings from specified file.
X * Returns nonzero on error.
X */
Xstatic int
Xread_bindings(bindfile)
X    char    *bindfile;
X{
X    char    *cp;
X    KEY_MAP    *input_map;
X    FILE    *fp;
X    char    line[100];
X
X    base_map = find_map(base_map_name);
X    cur_map = base_map;
X    input_map = base_map;
X
X    fp = fopen(bindfile, "r");
X    if (fp == NULL)
X        return 1;
X
X    while (fgets(line, sizeof(line) - 1, fp)) {
X        cp = line;
X        while (isspace(*cp))
X            cp++;
X
X        if ((*cp == '\0') || (*cp == '#') || (*cp == '\n'))
X            continue;
X
X        if (cp[strlen(cp) - 1] == '\n')
X            cp[strlen(cp) - 1] = '\0';
X
X        if (memcmp(cp, "map", 3) == 0)
X            input_map = do_map_line(&cp[3]);
X        else if (memcmp(cp, "default", 7) == 0)
X            do_default_line(input_map, &cp[7]);
X        else
X            do_bind_line(input_map, cp);
X    }
X    fclose(fp);
X    return 0;
X}
X
X
Xstatic void
Xread_key()
X{
X    KEY_ENT        *ent;
X    int        key;
X
X    fflush(stdout);
X    key = fgetc(stdin);
X    if (key == EOF) {
X        HS.linelen = 0;
X        HS.buf[0] = '\0';
X        return;
X    }
X
X    ent = cur_map->map[key];
X    if (ent == NULL)
X        ent = &cur_map->default_ent;
X    if (ent->next)
X        cur_map = ent->next;
X    if (ent->func)
X        (*ent->func)(key);
X    else
X        insert_char(key);
X}
X
X
X/*
X * Return the Nth history event, indexed from zero.
X * Earlier history events are lower in number.
X */
Xstatic HIST *
Xget_event(n)
X{
X    register HIST *    hp;
X
X    if ((n < 0) || (n >= HS.histcount))
X        return NULL;
X    hp = FIRSTHIST;
X    while (n-- > 0)
X        hp = NEXTHIST(hp);
X    return hp;
X}
X
X
X/*
X * Search the history list for the specified pattern.
X * Returns the found history, or NULL.
X */
Xstatic HIST *
Xfind_event(pat, len)
X    char *    pat;
X{
X    register HIST *    hp;
X
X    for (hp = FIRSTHIST; hp->len; hp = NEXTHIST(hp)) {
X        if ((hp->len == len) && (memcmp(hp->data, pat, len) == 0))
X                return hp;
X    }
X    return NULL;
X}
X
X
X/*
X * Insert a line into the end of the history table.
X * If the line already appears in the table, then it is moved to the end.
X * If the table is full, then the earliest commands are deleted as necessary.
X * Warning: the incoming line cannot point into the history table.
X */
Xvoid
Xhist_saveline(line, len)
X    char *    line;
X{
X    HIST *    hp;
X    HIST *    hp2;
X    int    left;
X
X    if ((len > 0) && (line[len - 1] == '\n'))
X        len--;
X    if (len <= 0)
X        return;
X
X    /*
X     * See if the line is already present in the history table.
X     * If so, and it is already at the end, then we are all done.
X     * Otherwise delete it since we will reinsert it at the end.
X     */
X    hp = find_event(line, len);
X    if (hp) {
X        hp2 = NEXTHIST(hp);
X        left = histused - HISTOFFSET(hp2);
X        if (left <= 0)
X            return;
X        histused -= HISTLEN(hp);
X        memcpy(hp, hp2, left + 1);
X        HS.histcount--;
X    }
X
X    /*
X     * If there is not enough room left in the history buffer to add
X     * the new command, then repeatedly delete the earliest command
X     * as many times as necessary in order to make enough room.
X     */
X    while ((histused + len) >= HIST_SIZE) {
X        hp = (HIST *) histbuf;
X        hp2 = NEXTHIST(hp);
X        left = histused - HISTOFFSET(hp2);
X        histused -= HISTLEN(hp);
X        memcpy(hp, hp2, left + 1);
X        HS.histcount--;
X    }
X
X    /*
X     * Add the line to the end of the history table.
X     */
X    hp = (HIST *) &histbuf[histused];
X    hp->len = len;
X    memcpy(hp->data, line, len);
X    histused += HISTLEN(hp);
X    histbuf[histused] = 0;
X    HS.curhist = ++HS.histcount;
X}
X
X
X/*
X * Find the function for a specified name.
X */
Xstatic FUNCPTR
Xfind_func(name)
X    char    *name;
X{
X    FUNC    *fp;
X
X    for (fp = funcs; fp->name; fp++) {
X        if (strcmp(fp->name, name) == 0)
X            return fp->func;
X    }
X    return NULL;
X}
X
X
Xstatic void
Xarrow_key()
X{
X    switch (fgetc(stdin)) {
X        case 'A':
X            backward_history();
X            break;
X        case 'B':
X            forward_history();
X            break;
X        case 'C':
X            forward_char();
X            break;
X        case 'D':
X            backward_char();
X            break;
X    }
X}
X
X
Xstatic void
Xback_over_char(ch)
X    char    ch;
X{
X    backspace();
X    if (!isprint(ch))
X        backspace();
X}
X
X
Xstatic void
Xremove_char(ch)
X    char    ch;
X{
X    erasechar();
X    if (!isprint(ch))
X        erasechar();
X}
X
X
Xstatic void
Xecho_rest_of_line()
X{
X    echo_string(HS.pos, HS.end - HS.pos);
X}
X
X
Xstatic void
Xgoto_start_of_line()
X{
X    while (HS.pos > HS.buf)
X        back_over_char(*--HS.pos);
X}
X
X
Xstatic void
Xgoto_end_of_line()
X{
X    echo_rest_of_line();
X    HS.pos = HS.end;
X}
X
X
Xstatic void
Xdecrement_end(n)
X{
X    HS.end -= n;
X    if (HS.mark && (HS.mark > HS.end))
X        HS.mark = NULL;
X}
X
X
Xstatic void
Xignore_char()
X{
X}
X
X
Xstatic void
Xflush_input()
X{
X    echo_rest_of_line();
X    while (HS.end > HS.buf)
X        remove_char(*--HS.end);
X    HS.pos = HS.buf;
X    HS.mark = NULL;
X}
X
X
Xstatic void
Xstart_of_line()
X{
X    goto_start_of_line();
X}
X
X
Xstatic void
Xend_of_line()
X{
X    goto_end_of_line();
X}
X
X
Xstatic void
Xforward_char()
X{
X    if (HS.pos < HS.end)
X        echo_char(*HS.pos++);
X}
X
X
Xstatic void
Xbackward_char()
X{
X    if (HS.pos > HS.buf)
X        back_over_char(*--HS.pos);
X}
X
X
Xstatic void
Xuppercase_word()
X{
X    while ((HS.pos < HS.end) && !in_word(*HS.pos))
X        echo_char(*HS.pos++);
X    while ((HS.pos < HS.end) && in_word(*HS.pos)) {
X        if ((*HS.pos >= 'a') && (*HS.pos <= 'z'))
X            *HS.pos += 'A' - 'a';
X        echo_char(*HS.pos++);
X    }
X}
X
X
Xstatic void
Xlowercase_word()
X{
X    while ((HS.pos < HS.end) && !in_word(*HS.pos))
X        echo_char(*HS.pos++);
X    while ((HS.pos < HS.end) && in_word(*HS.pos)) {
X        if ((*HS.pos >= 'A') && (*HS.pos <= 'Z'))
X            *HS.pos += 'a' - 'A';
X        echo_char(*HS.pos++);
X    }
X}
X
X
Xstatic void
Xforward_word()
X{
X    while ((HS.pos < HS.end) && !in_word(*HS.pos))
X        echo_char(*HS.pos++);
X    while ((HS.pos < HS.end) && in_word(*HS.pos))
X        echo_char(*HS.pos++);
X}
X
X
Xstatic void
Xbackward_word()
X{
X    if ((HS.pos > HS.buf) && in_word(*HS.pos))
X        back_over_char(*--HS.pos);
X    while ((HS.pos > HS.buf) && !in_word(*HS.pos))
X        back_over_char(*--HS.pos);
X    while ((HS.pos > HS.buf) && in_word(*HS.pos))
X        back_over_char(*--HS.pos);
X    if ((HS.pos < HS.end) && !in_word(*HS.pos))
X        echo_char(*HS.pos++);
X}
X
X
Xstatic void
Xforward_kill_char()
X{
X    int    rest;
X    char    ch;
X
X    rest = HS.end - HS.pos;
X    if (rest-- <= 0)
X        return;
X    ch = *HS.pos;
X    if (rest > 0) {
X        memcpy(HS.pos, HS.pos + 1, rest);
X        *(HS.end - 1) = ch;
X    }
X    echo_rest_of_line();
X    remove_char(ch);
X    decrement_end(1);
X    while (rest > 0)
X        back_over_char(HS.pos[--rest]);
X}
X
X
Xstatic void
Xdelete_char()
X{
X    if (HS.end > HS.buf)
X        forward_kill_char();
X}
X
X
Xstatic void
Xbackward_kill_char()
X{
X    if (HS.pos > HS.buf) {
X        HS.pos--;
X        back_over_char(*HS.pos);
X        forward_kill_char();
X    }
X}
X
X
Xstatic void
Xforward_kill_word()
X{
X    char    *cp;
X
X    if (HS.pos >= HS.end)
X        return;
X    echo_rest_of_line();
X    for (cp = HS.end; cp > HS.pos;)
X        remove_char(*--cp);
X    cp = HS.pos;
X    while ((cp < HS.end) && !in_word(*cp))
X        cp++;
X    while ((cp < HS.end) && in_word(*cp))
X        cp++;
X    savetext(HS.pos, cp - HS.pos);
X    memcpy(HS.pos, cp, HS.end - cp);
X    decrement_end(cp - HS.pos);
X    echo_rest_of_line();
X    for (cp = HS.end; cp > HS.pos;)
X        back_over_char(*--cp);
X}
X
X
Xstatic void
Xkill_line()
X{
X    if (HS.end <= HS.pos)
X        return;
X    savetext(HS.pos, HS.end - HS.pos);
X    echo_rest_of_line();
X    while (HS.end > HS.pos)
X        remove_char(*--HS.end);
X    decrement_end(0);
X}
X
X
X/*
X * This is the function which completes a command line editing session.
X * The final line length is returned in the HS.linelen variable.
X * The line is NOT put into the edit history, so that the caller can
X * decide whether or not this should be done.
X */
Xstatic void
Xnew_line()
X{
X    int    len;
X
X    newline();
X    fflush(stdout);
X
X    HS.mark = NULL;
X    HS.end[0] = '\n';
X    HS.end[1] = '\0';
X    len = HS.end - HS.buf + 1;
X    if (len <= 1) {
X        HS.curhist = HS.histcount;
X        HS.linelen = 1;
X        return;
X    }
X    HS.curhist = HS.histcount;
X    HS.pos = HS.buf;
X    HS.end = HS.buf;
X    HS.linelen = len;
X}
X
X
Xstatic void
Xsave_line()
X{
X    int    len;
X
X    len = HS.end - HS.buf;
X    if (len > 0) {
X        hist_saveline(HS.buf, len);
X        flush_input();
X    }
X    HS.curhist = HS.histcount;
X}
X
X
Xstatic void
Xgoto_line()
X{
X    int    num;
X    char    *cp;
X    HIST    *hp;
X
X    num = 0;
X    cp = HS.buf;
X    while ((*cp >= '0') && (*cp <= '9') && (cp < HS.pos))
X        num = num * 10 + (*cp++ - '0');
X    if ((num <= 0) || (num > HS.histcount) || (cp != HS.pos)) {
X        beep();
X        return;
X    }
X    flush_input();
X    HS.curhist = HS.histcount - num;
X    hp = get_event(HS.curhist);
X    memcpy(HS.buf, hp->data, hp->len);
X    HS.end = &HS.buf[hp->len];
X    goto_end_of_line();
X}
X
X
Xstatic void
Xforward_history()
X{
X    HIST    *hp;
X
X    flush_input();
X    if (++HS.curhist >= HS.histcount)
X        HS.curhist = 0;
X    hp = get_event(HS.curhist);
X    if (hp) {
X        memcpy(HS.buf, hp->data, hp->len);
X        HS.end = &HS.buf[hp->len];
X    }
X    goto_end_of_line();
X}
X
X
Xstatic void
Xbackward_history()
X{
X    HIST    *hp;
X
X    flush_input();
X    if (--HS.curhist < 0)
X        HS.curhist = HS.histcount - 1;
X    hp = get_event(HS.curhist);
X    if (hp) {
X        memcpy(HS.buf, hp->data, hp->len);
X        HS.end = &HS.buf[hp->len];
X    }
X    goto_end_of_line();
X}
X
X
Xstatic void
Xinsert_char(key)
X{
X    int    len;
X    int    rest;
X
X    len = HS.end - HS.buf;
X    if (len >= HS.bufsize) {
X        beep();
X        return;
X    }
X    rest = HS.end - HS.pos;
X    if (rest > 0)
X        memrcpy(HS.pos + 1, HS.pos, rest);
X    HS.end++;
X    *HS.pos++ = key;
X    echo_char(key);
X    echo_rest_of_line();
X    while (rest > 0)
X        back_over_char(HS.pos[--rest]);
X}
X
X
Xstatic void
Xinsert_string(str, len)
X    char    *str;
X{
X    int    rest;
X    int    totallen;
X
X    if (len <= 0)
X        return;
X    totallen = (HS.end - HS.buf) + len;
X    if (totallen > HS.bufsize) {
X        beep();
X        return;
X    }
X    rest = HS.end - HS.pos;
X    if (rest > 0)
X        memrcpy(HS.pos + len, HS.pos, rest);
X    HS.end += len;
X    memcpy(HS.pos, str, len);
X    HS.pos += len;
X    echo_string(str, len);
X    echo_rest_of_line();
X    while (rest > 0)
X        back_over_char(HS.pos[--rest]);
X}
X
X
Xstatic void
Xlist_history()
X{
X    HIST    *hp;
X    int    num;
X
X    for (num = 0; num < HS.histcount; num++) {
X        hp = get_event(num);
X        printf("\n%3d: ", HS.histcount - num);
X        echo_string(hp->data, hp->len);
X    }
X    refresh_line();
X}
X
X
Xstatic void
Xrefresh_line()
X{
X    char    *cp;
X
X    newline();
X    fputs(HS.prompt, stdout);
X    if (HS.end > HS.buf) {
X        echo_string(HS.buf, HS.end - HS.buf);
X        cp = HS.end;
X        while (cp > HS.pos)
X            back_over_char(*--cp);
X    }
X}
X
X
Xstatic void
Xswap_chars()
X{
X    char    ch1;
X    char    ch2;
X
X    if ((HS.pos <= HS.buf) || (HS.pos >= HS.end))
X        return;
X    ch1 = *HS.pos--;
X    ch2 = *HS.pos;
X    *HS.pos++ = ch1;
X    *HS.pos = ch2;
X    back_over_char(ch2);
X    echo_char(ch1);
X    echo_char(ch2);
X    back_over_char(ch2);
X}
X
X
Xstatic void
Xset_mark()
X{
X    HS.mark = HS.pos;
X}
X
X
Xstatic void
Xsave_region()
X{
X    int    len;
X
X    if (HS.mark == NULL)
X        return;
X    len = HS.mark - HS.pos;
X    if (len > 0)
X        savetext(HS.pos, len);
X    if (len < 0)
X        savetext(HS.mark, -len);
X}
X
X
Xstatic void
Xkill_region()
X{
X    char    *cp;
X    char    *left;
X    char    *right;
X
X    if ((HS.mark == NULL) || (HS.mark == HS.pos))
X        return;
X
X    echo_rest_of_line();
X    if (HS.mark < HS.pos) {
X        left = HS.mark;
X        right = HS.pos;
X        HS.pos = HS.mark;
X    } else {
X        left = HS.pos;
X        right = HS.mark;
X        HS.mark = HS.pos;
X    }
X    savetext(left, right - left);
X    for (cp = HS.end; cp > left;)
X        remove_char(*--cp);
X    if (right < HS.end)
X        memcpy(left, right, HS.end - right);
X    decrement_end(right - left);
X    echo_rest_of_line();
X    for (cp = HS.end; cp > HS.pos;)
X        back_over_char(*--cp);
X}
X
X
Xstatic void
Xyank()
X{
X    insert_string(save_buffer, save_len);
X}
X
X
Xstatic void
Xreverse_search()
X{
X    int    len;
X    int    count;
X    int    testhist;
X    HIST    *hp;
X    char    *save_pos;
X
X    count = HS.histcount;
X    len = HS.pos - HS.buf;
X    if (len <= 0)
X        count = 0;
X    testhist = HS.curhist;
X    do {
X        if (--count < 0) {
X            beep();
X            return;
X        }
X        if (--testhist < 0)
X            testhist = HS.histcount - 1;
X        hp = get_event(testhist);
X    } while ((hp == NULL) || (hp->len < len) ||
X        memcmp(hp->data, HS.buf, len));
X
X    HS.curhist = testhist;
X    save_pos = HS.pos;
X    flush_input();
X    memcpy(HS.buf, hp->data, hp->len);
X    HS.end = &HS.buf[hp->len];
X    goto_end_of_line();
X    while (HS.pos > save_pos)
X        back_over_char(*--HS.pos);
X}
X
X
Xstatic void
Xquote_char()
X{
X    int    ch;
X
X    ch = fgetc(stdin);
X    if (ch != EOF)
X        insert_char(ch);
X}
X
X
X/*
X * Save data in the save buffer.
X */
Xstatic void
Xsavetext(str, len)
X    char    *str;
X{
X    save_len = 0;
X    if (len <= 0)
X        return;
X    if (len > SAVE_SIZE)
X        len = SAVE_SIZE;
X    memcpy(save_buffer, str, len);
X    save_len = len;
X}
X
X
X/*
X * Test whether a character is part of a word.
X */
Xstatic int
Xin_word(ch)
X    char    ch;
X{
X    return (isalnum(ch) || (ch == '_'));
X}
X
X
Xstatic void
Xerasechar()
X{
X    fputs("\b \b", stdout);
X}
X
X
Xstatic void
Xnewline()
X{
X    fputc('\n', stdout);
X}
X
X
Xstatic void
Xbackspace()
X{
X    fputc('\b', stdout);
X}
X
X
Xstatic void
Xbeep()
X{
X    fputc('\007', stdout);
X}
X
X
Xstatic void
Xecho_char(ch)
X{
X    if (isprint(ch))
X        putchar(ch);
X    else {
X        putchar('^');
X        putchar((ch + '@') & 0x7f);
X    }
X}
X
X
Xstatic void
Xecho_string(str, len)
X    char    *str;
X{
X    while (len-- > 0)
X        echo_char(*str++);
X}
X
X
Xstatic void
Xmemrcpy(dest, src, len)
X    char    *dest, *src;
X{
X    dest += len - 1;
X    src += len - 1;
X    while (len-- > 0)
X        *dest-- = *src--;
X}
X
X
X#ifdef    HIST_TEST
X
X/*
X * Main routine to test history.
X */
Xmain(argc, argv)
X    int    argc;
X    char    *argv[];
X{
X    char    *filename;
X    int    len;
X    char    buf[256];
X
X    filename = NULL;
X    if (argc > 1)
X        filename = argv[1];
X
X    switch (hist_init(filename)) {
X        case HIST_SUCCESS:
X            break;
X        case HIST_NOFILE:
X            fprintf(stderr, "Binding file was not found\n");
X            break;
X        case HIST_NOTTY:
X            fprintf(stderr, "Cannot set terminal parameters\n");
X            break;
X        case HIST_INITED:
X            fprintf(stderr, "Hist is already inited\n");
X            break;
X        default:
X            fprintf(stderr, "Unknown error from hist_init\n");
X            break;
X    }
X
X    do {
X        len = hist_getline("HIST> ", buf, sizeof(buf));
X        hist_saveline(buf, len);
X    } while (len && (buf[0] != 'q'));
X
X    hist_term();
X
X    return 0;
X}
X#endif
X
X/* END CODE */
SHAR_EOF
chmod 0644 calc2.9.0/hist.c || echo "restore of calc2.9.0/hist.c fails"
set `wc -c calc2.9.0/hist.c`;Sum=$1
if test "$Sum" != "22702"
then echo original size 22702, current size $Sum;fi
echo "x - extracting calc2.9.0/hist.h (Text)"
sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/hist.h &&
X/*
X * Copyright (c) 1993 David I. Bell
X * Permission is granted to use, distribute, or modify this source,
X * provided that this copyright notice remains intact.
X *
X * Definitions for command history module.
X */
X
X
X#ifdef    __STDC__
X#define    HIST_PROTO(a) a
X#else
X#define    HIST_PROTO(a) ()
X#endif
X
X
X/*
X * Default binding file and history size.
X */
X#ifndef    HIST_BINDING_FILE
X#define    HIST_BINDING_FILE    "/usr/lib/hist.bind"
X#endif
X
X#ifndef    HIST_SIZE
X#define    HIST_SIZE        (1024*10)
X#endif
X
X
X/*
X * path search defines
X */
X#define    HOMECHAR    '~'    /* char which indicates home directory */
X#define DOTCHAR        '.'    /* char which indicates current directory */
X#define    PATHCHAR    '/'    /* char which separates path components */
X#define    LISTCHAR    ':'    /* char which separates paths in a list */
X#define    PATHSIZE    1024    /* maximum length of path name */
X
X
X/*
X * Possible returns from hist_init.  Note that an error from hist_init does
X * not prevent calling the other routines, but fancy command line editing
X * is then disabled.
X */
X#define    HIST_SUCCESS    0    /* successfully inited */
X#define    HIST_INITED    1    /* initialization is already done */
X#define    HIST_NOFILE    2    /* bindings file could not be read */
X#define    HIST_NOTTY    3    /* terminal modes could not be set */
X
X
Xextern    int    hist_init HIST_PROTO((char *filename));
Xextern    void    hist_term HIST_PROTO((void));
Xextern    int    hist_getline HIST_PROTO((char *prompt, char *buf, int len));
Xextern    void    hist_saveline HIST_PROTO((char *line, int len));
X
X/* END CODE */
SHAR_EOF
chmod 0644 calc2.9.0/hist.h || echo "restore of calc2.9.0/hist.h fails"
set `wc -c calc2.9.0/hist.h`;Sum=$1
if test "$Sum" != "1475"
then echo original size 1475, current size $Sum;fi
echo "x - extracting calc2.9.0/input.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/input.c &&
X/*
X * Copyright (c) 1993 David I. Bell
X * Permission is granted to use, distribute, or modify this source,
X * provided that this copyright notice remains intact.
X *
X * Nested input source file reader.
X * For terminal input, this also provides a simple command stack.
X */
X
X#include <ctype.h>
X#include <pwd.h>
X#include "calc.h"
X#include "config.h"
X#include "hist.h"
X
X
X#define TTYSIZE        100    /* reallocation size for terminal buffers */
X#define DEPTH        10    /* maximum depth of input */
X#define IS_READ        1    /* reading normally */
X#define IS_REREAD    2    /* reread current character */
X#define chartoint(ch)    ((ch) & 0xff)    /* make sure char is not negative */
X
X
Xtypedef struct {
X    short i_state;        /* state (read, reread) */
X    short i_char;        /* currently read char */
X    long i_line;        /* line number */
X    char *i_str;        /* current string for input (if not NULL) */
X    char *i_origstr;    /* original string so it can be freed */
X    char *i_ttystr;        /* current character of tty line (or NULL) */
X    FILE *i_fp;        /* current file for input (if not NULL) */
X    char *i_name;        /* file name if known */
X} INPUT;
X
X
Xstatic int linesize;        /* current max size of input line */
Xstatic char *linebuf;        /* current input line buffer */
Xstatic char *prompt;        /* current prompt for terminal */
Xstatic BOOL noprompt;        /* TRUE if should not print prompt */
X
Xstatic int depth;        /* current input depth */
Xstatic INPUT *cip;        /* current input source */
Xstatic INPUT inputs[DEPTH];    /* input sources */
X
X
Xstatic int openfile MATH_PROTO((char *name));
Xstatic int ttychar MATH_PROTO((void));
X
X
X/*
X * Open an input file by possibly searching through a path list
X * and also possibly applying the specified extension.  For example:
X * opensearchfile("barf", ".:/tmp", ".c") searches in order for the
X * files "./barf", "./barf.c", "/tmp/barf", and "/tmp/barf.c".
X *
X * Returns -1 if all specified files cannot be opened.
X */
Xint
Xopensearchfile(name, pathlist, extension)
X    char *name;        /* file name to be read */
X    char *pathlist;        /* list of colon separated paths (or NULL) */
X    char *extension;    /* extra extension to try (or NULL) */
X{
X    int i;
X    char *cp;
X    char path[PATHSIZE+1];    /* name being searched for */
X
X    /*
X     * Don't try the extension if the filename already contains it.
X     */
X    if (extension) {
X        i = strlen(name) - strlen(extension);
X        if ((i >= 0) && (strcmp(&name[i], extension) == 0))
X            extension = NULL;
X    }
X    /*
X     * If the name is absolute, or if there is no path list, then
X     * make one which just searches for the name straight.  Then
X     * search through the path list for the file, without and with
X     * the specified extension.
X     */
X    if (name[0] == PATHCHAR ||
X        name[0] == HOMECHAR ||
X        (name[0] == DOTCHAR && name[1] == PATHCHAR) ||
X        pathlist == NULL) {
X        pathlist = "";
X    }
X    pathlist--;
X    do {
X        pathlist++;
X        cp = path;
X        while (*pathlist && (*pathlist != LISTCHAR))
X            *cp++ = *pathlist++;
X        if (cp != path)
X            *cp++ = PATHCHAR;
X        strcpy(cp, name);
X        i = openfile(path);
X        if ((i < 0) && extension) {
X            strcat(path, extension);
X            i = openfile(path);
X        }
X    } while ((i < 0) && *pathlist);
X    return i;
X}
X
X
X/*
X * Given a filename with a leading ~, expand it into a home directory for
X * that user.  This function will malloc the space for the expanded path.
X *
X * If the path is just ~, or begins with ~/, expand it to the home
X * directory of the current user.  If the environment variable $HOME
X * is known, it will be used, otherwise the password file will be
X * consulted.
X *
X * If the path is just ~username, or ~username/, expand it to the home
X * directory of that user by looking it up in the password file.
X *
X * If the password file must be consulted and the username is not found
X * a NULL pointer is returned.
X */
Xstatic char *
Xhomeexpand(name)
X    char *name;        /* a filename with a leading ~ */
X{
X    struct passwd *ent;    /* password entry */
X    char *home2;        /* fullpath of the home directory */
X    char *fullpath;        /* the malloced expanded path */
X    char *after;        /* after the ~user or ~ */
X    char username[PATHSIZE+1];    /* extratced username */
X
X    /* firewall */
X    if (name[0] != HOMECHAR)
X        return NULL;
X
X    /*
X     * obtain the home directory component
X     */
X    switch (name[1]) {
X    case PATHCHAR:        /* ~/... */
X    case '\0':        /* ~ */
X        home2 = home;
X        after = name+1;
X        break;
X    default:        /* ~username or ~username/... */
X
X        /* extract the username after the ~ */
X        after = (char *)strchr(name+2, PATHCHAR);
X        if (after == NULL) {
X            /* path is just ~username */
X            ent = getpwnam(name+1);
X            if (ent == NULL) {
X                /* unknown user */
X                return NULL;
X            }
X            /* just malloc the home directory and return it */
X            fullpath = (char *)malloc(strlen(ent->pw_dir)+1);
X            strcpy(fullpath, ent->pw_dir);
X            return fullpath;
X        }
X        if (after-name > PATHSIZE+1) {
X            /* username is too big */
X            return NULL;
X        }
X        strncpy(username, name+1, after-name-1);
X        username[after-name-1] = '\0';
X
X        /* get that user's home directory */
X        ent = getpwnam(username);
X        if (ent == NULL) {
X            /* unknown user */
X            return NULL;
X        }
X        home2 = ent->pw_dir;
X        break;
X    }
X
X    /*
X     * build the fullpath given the home directory
X     */
X    fullpath = (char *)malloc(strlen(home2)+strlen(after)+1);
X    sprintf(fullpath, "%s%s", home2, after);
X    return fullpath;
X}
X
X
X/*
X * f_open - ~-expand a filename and fopen() it
X */
XFILE *
Xf_open(name, mode)
X    char *name;        /* the filename to open */
X    char *mode;        /* the fopen mode to use */
X{
X    FILE *fp;        /* open file descriptor */
X    char *fullname;        /* file name with HOMECHAR expansion */
X
X    /*
X     * expand ~ if needed
X     */
X    if (name[0] == HOMECHAR) {
X        fullname = homeexpand(name);
X        if (fullname == NULL)
X            return NULL;
X        fp = fopen(fullname, mode);
X        free(fullname);
X    } else {
X        fp = fopen(name, mode);
X    }
X    return fp;
X}
X
X
X/*
X * Setup for reading from a input file.
X * Returns -1 if file could not be opened.
X */
Xstatic int
Xopenfile(name)
X    char *name;        /* file name to be read */
X{
X    FILE *fp;        /* open file descriptor */
X
X    if (depth >= DEPTH)
X         return -1;
X    fp = f_open(name, "r");
X    if (fp == NULL)
X         return -1;
X    cip++;
X    cip->i_state = IS_READ;
X    cip->i_char = '\0';
X    cip->i_str = NULL;
X    cip->i_origstr = NULL;
X    cip->i_ttystr = NULL;
X    cip->i_fp = fp;
X    cip->i_line = 1;
X    cip->i_name = (char *)malloc(strlen(name) + 1);
X    strcpy(cip->i_name, name);
X    depth++;
X    return 0;
X}
X
X
X/*
X * Open a string for scanning. String is ended by a null character.
X * String is copied into local memory so it can be trashed afterwards.
X * Returns -1 if cannot open string.
X */
Xint
Xopenstring(str)
X    char *str;        /* string to be opened */
X{
X    char *cp;        /* copied string */
X
X    if ((depth >= DEPTH) || (str == NULL))
X         return -1;
X    cp = (char *)malloc(strlen(str) + 1);
X    if (cp == NULL)
X         return -1;
X    strcpy(cp, str);
X    cip++;
X    cip->i_state = IS_READ;
X    cip->i_char = '\0';
X    cip->i_str = cp;
X    cip->i_origstr = cp;
X    cip->i_fp = NULL;
X    cip->i_name = NULL;
X    cip->i_ttystr = NULL;
X    cip->i_line = 1;
X    depth++;
X    return 0;
X}
X
X
X/*
X * Set to read input from the terminal.
X * Returns -1 if there is no more depth for input.
X */
Xint
Xopenterminal()
X{
X    if (depth >= DEPTH)
X         return -1;
X    cip++;
X    cip->i_state = IS_READ;
X    cip->i_char = '\0';
X    cip->i_str = NULL;
X    cip->i_origstr = NULL;
X    cip->i_ttystr = NULL;
X    cip->i_fp = NULL;
X    cip->i_name = NULL;
X    cip->i_line = 1;
X    depth++;
X    return 0;
X}
X
X
X/*
X * Close the current input source.
X */
Xstatic void
Xcloseinput()
X{
X    if (depth <= 0)
X        return;
X    if (cip->i_origstr)
X        free(cip->i_origstr);
X    if (cip->i_fp)
X        fclose(cip->i_fp);
X    if (cip->i_name)
X        free(cip->i_name);
X    cip--;
X    depth--;
X}
X
X
X/*
X * Reset the input sources back to the initial state.
X */
Xvoid
Xresetinput()
X{
X    while (depth > 0)
X        closeinput();
X    cip = inputs;
X    noprompt = FALSE;
X}
X
X
X/*
X * Set the prompt for terminal input.
X */
Xvoid
Xsetprompt(str)
X    char *str;
X{
X    prompt = str;
X    noprompt = FALSE;
X}
X
X
X/*
X * Read the next character from the current input source.
X * End of file closes current input source, and returns EOF character.
X */
Xint
Xnextchar()
X{
X    int ch;            /* current input character */
X
X    if (depth == 0)        /* input finished */
X         return EOF;
X    if (cip->i_state == IS_REREAD) {    /* rereading current char */
X         ch = cip->i_char;
X         cip->i_state = IS_READ;
X         if (ch == '\n')
X            cip->i_line++;
X         return ch;
X    }
X    if (cip->i_str) {        /* from string */
X        ch = chartoint(*cip->i_str++);
X        if (ch == '\0')
X            ch = EOF;
X    } else if (cip->i_fp) {        /* from file */
X        ch = fgetc(cip->i_fp);
X    } else {            /* from terminal */
X        ch = ttychar();
X    }
X    if (ch == EOF) {        /* fix up end of file */
X        closeinput();
X        ch = EOF;
X    }
X    if (depth > 0)
X        cip->i_char = (char)ch;    /* save for rereads */
X    if (ch == '\n')
X        cip->i_line++;
X    return ch;
X}
X
X
X/*
X * Read in the next line of input from the current input source.
X * The line is terminated with a null character, and does not contain
X * the final newline character.  The returned string is only valid
X * until the next such call, and so must be copied if necessary.
X * Returns NULL on end of file.
X */
Xchar *
Xnextline()
X{
X    char *cp;
X    int ch;
X    int len;
X
X    cp = linebuf;
X    if (linesize == 0) {
X        cp = (char *)malloc(TTYSIZE + 1);
X        if (cp == NULL)
X            math_error("Cannot allocate line buffer");
X        linebuf = cp;
X        linesize = TTYSIZE;
X    }
X    len = 0;
X    for (;;) {
X        noprompt = TRUE;
X        ch = nextchar();
X        noprompt = FALSE;
X        if (ch == EOF)
X            return NULL;
X        if (ch == '\0')
X            continue;
X        if (ch == '\n')
X            break;
X        if (len >= linesize) {
X            cp = (char *)realloc(cp, linesize + TTYSIZE + 1);
X            if (cp == NULL)
X                math_error("Cannot realloc line buffer");
X            linebuf = cp;
X            linesize += TTYSIZE;
X        }
X        cp[len++] = (char)ch;
X    }
X    cp[len] = '\0';
X    return linebuf;
X}
X
X
X/*
X * Read the next character from the terminal.
X * The routines in the history module are called so that the user
X * can use a command history and emacs-like editing of the line.
X */
Xstatic int
Xttychar()
X{
X    int ch;            /* current char */
X    int len;        /* length of current command */
X    static char charbuf[1000];
X
X    /*
X     * If we have more to read from the saved command line, then do that.
X     * When we see a newline character, then clear the pointer so we will
X     * read a new line on the next call.
X     */
X    if (cip->i_ttystr) {
X        ch = chartoint(*cip->i_ttystr++);
X        if (ch == '\n')
X            cip->i_ttystr = NULL;
X        return ch;
X    }
X
X    /*
X     * We need another complete line.
X     */
X    abortlevel = 0;
X    inputwait = TRUE;
X    len = hist_getline(noprompt ? "" : prompt, charbuf, sizeof(charbuf));
X    if (len == 0) {
X        inputwait = FALSE;
X        return EOF;
X    }
X    inputwait = FALSE;
X
X    /*
X     * Handle shell escape if present
X     */
X    if (charbuf[0] == '!') {        /* do a shell command */
X        char *cmd;
X
X        cmd = charbuf + 1;
X        if (*cmd == '\0' || *cmd == '\n')
X            cmd = shell;
X        system(cmd);
X        return '\n';
X    }
X    hist_saveline(charbuf, len);
X
X    /*
X     * Return the first character of the line, and set up to
X     * return the rest of it with later calls.
X     */
X    ch = chartoint(charbuf[0]);
X    if (ch != '\n')
X        cip->i_ttystr = charbuf + 1;
X    return ch;
X}
X
X
X/*
X * Return whether or not the input source is the terminal.
X */
XBOOL
Xinputisterminal()
X{
X    return ((depth <= 0) || ((cip->i_str == NULL) && (cip->i_fp == NULL)));
X}
X
X
X/*
X * Return the name of the current input file.
X * Returns NULL for terminal or strings.
X */
Xchar *
Xinputname()
X{
X    if (depth <= 0)
X        return NULL;
X    return cip->i_name;
X}
X
X
X/*
X * Return the current line number.
X */
Xlong
Xlinenumber()
X{
X    if (depth > 0)
X        return cip->i_line;
X    return 1;
X}
X
X
X/*
X * Restore the next character to be read again on the next nextchar call.
X */
Xvoid
Xreread()
X{
X    if ((depth <= 0) || (cip->i_state == IS_REREAD))
X        return;
X    cip->i_state = IS_REREAD;
X    if (cip->i_char == '\n')
X        cip->i_line--;
X}
X
X
X/*
X * Process all startup files found in the $CALCRC path.
X */
Xvoid
Xrunrcfiles()
X{
X    char path[PATHSIZE+1];    /* name being searched for */
X    char *cp;
X    char *newcp;
X    char *p;
X    int i;
X
X    /* execute each file in the list */
X    for (cp=calcrc, newcp=(char *)strchr(calcrc, LISTCHAR);
X         cp != NULL && *cp;
X         cp = newcp,
X         newcp=(newcp) ? (char *)strchr(newcp+1, LISTCHAR) : NULL) {
X
X        /* load file name into the path */
X        if (newcp == NULL) {
X            strcpy(path, cp);
X        } else {
X            strncpy(path, cp, newcp-cp);
X            path[newcp-cp] = '\0';
X        }
X
X        /* find the start of the path */
X        p = (path[0] == ':') ? path+1 : path;
X        if (p[0] == '\0') {
X            continue;
X        }
X
X        /* process the current file in the list */
X        i = openfile(p);
X        if (i < 0)
X            continue;
X        getcommands(FALSE);
X    }
X}
X
X/* END CODE */
SHAR_EOF
chmod 0644 calc2.9.0/input.c || echo "restore of calc2.9.0/input.c fails"
set `wc -c calc2.9.0/input.c`;Sum=$1
if test "$Sum" != "12268"
then echo original size 12268, current size $Sum;fi
echo "x - extracting calc2.9.0/label.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/label.c &&
X/*
X * Copyright (c) 1993 David I. Bell
X * Permission is granted to use, distribute, or modify this source,
X * provided that this copyright notice remains intact.
X *
X * Label handling routines.
X */
X
X#include "calc.h"
X#include "token.h"
X#include "label.h"
X#include "string.h"
X#include "opcodes.h"
X#include "func.h"
X
Xstatic long labelcount;            /* number of user labels defined */
Xstatic STRINGHEAD labelnames;        /* list of user label names */
Xstatic LABEL labels[MAXLABELS];        /* list of user labels */
X
X
X/*
X * Initialize the table of labels for a function.
X */
Xvoid
Xinitlabels()
X{
X    labelcount = 0;
X    initstr(&labelnames);
X}
X
X
X/*
X * Define a user named label to have the offset of the next opcode.
X */
Xvoid
Xdefinelabel(name)
X    char *name;            /* label name */
X{
X    register LABEL *lp;        /* current label */
X    long i;                /* current label index */
X
X    i = findstr(&labelnames, name);
X    if (i >= 0) {
X        lp = &labels[i];
X        if (lp->l_offset) {
X            scanerror(T_NULL, "Label \"%s\" is multiply defined",
X                name);
X            return;
X        }
X        setlabel(lp);
X        return;
X    }
X    if (labelcount >= MAXLABELS) {
X        scanerror(T_NULL, "Too many labels in use");
X        return;
X    }
X    lp = &labels[labelcount++];
X    lp->l_chain = 0;
X    lp->l_offset = curfunc->f_opcodecount;
X    lp->l_name = addstr(&labelnames, name);
X    clearopt();
X}
X
X
X/*
X * Add the offset corresponding to the specified user label name to the
X * opcode table for a function. If the label is not yet defined, then a
X * chain of undefined offsets is built using the offset value, and it
X * will be fixed up when the label is defined.
X */
Xvoid
Xaddlabel(name)
X    char *name;            /* user symbol name */
X{
X    register LABEL *lp;        /* current label */
X    long i;                /* counter */
X
X    for (i = labelcount, lp = labels; --i >= 0; lp++) {
X        if (strcmp(name, lp->l_name))
X            continue;
X        uselabel(lp);
X        return;
X    }
X    if (labelcount >= MAXLABELS) {
X        scanerror(T_NULL, "Too many labels in use");
X        return;
X    }
X    lp = &labels[labelcount++];
X    lp->l_offset = 0;
X    lp->l_chain = curfunc->f_opcodecount;
X    lp->l_name = addstr(&labelnames, name);
X    addop((long)0);
X}
X
X
X/*
X * Check to make sure that all labels are defined.
X */
Xvoid
Xchecklabels()
X{
X    register LABEL *lp;        /* label being checked */
X    long i;                /* counter */
X
X    for (i = labelcount, lp = labels; --i >= 0; lp++) {
X        if (lp->l_offset > 0)
X            continue;
X        scanerror(T_NULL, "Label \"%s\" was never defined",
X            lp->l_name);
X    }
X}
X
X
X/*
X * Clear an internal label for use.
X */
Xvoid
Xclearlabel(lp)
X    register LABEL *lp;    /* label being cleared */
X{
X    lp->l_offset = 0;
X    lp->l_chain = 0;
X    lp->l_name = NULL;
X}
X
X
X/*
X * Set any label to have the value of the next opcode in the current
X * function being defined.  If there were forward references to it,
X * all such references are patched up.
X */
Xvoid
Xsetlabel(lp)
X    register LABEL *lp;    /* label being set */
X{
X    register FUNC *fp;    /* current function */
X    long curfix;        /* offset of current location being fixed */
X    long nextfix;        /* offset of next location to fix up */
X    long offset;        /* offset of this label */
X
X    fp = curfunc;
X    offset = fp->f_opcodecount;
X    nextfix = lp->l_chain;
X    while (nextfix > 0) {
X        curfix = nextfix;
X        nextfix = fp->f_opcodes[curfix];
X        fp->f_opcodes[curfix] = offset;
X    }
X    lp->l_chain = 0;
X    lp->l_offset = offset;
X    clearopt();
X}
X
X
X/*
X * Use the specified label at the current location in the function
X * being compiled.  This adds one word to the current function being
X * compiled.  If the label is not yet defined, a patch chain is built
X * so the reference can be fixed when the label is defined.
X */
Xvoid
Xuselabel(lp)
X    register LABEL *lp;        /* label being used */
X{
X    long offset;            /* offset being added */
X
X    offset = curfunc->f_opcodecount;
X    if (lp->l_offset > 0) {
X        addop(lp->l_offset);
X        return;
X    }
X    addop(lp->l_chain);
X    lp->l_chain = offset;
X}
X
X/* END CODE */
SHAR_EOF
chmod 0644 calc2.9.0/label.c || echo "restore of calc2.9.0/label.c fails"
set `wc -c calc2.9.0/label.c`;Sum=$1
if test "$Sum" != "3757"
then echo original size 3757, current size $Sum;fi
echo "x - extracting calc2.9.0/label.h (Text)"
sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/label.h &&
X/*
X * Copyright (c) 1993 David I. Bell
X * Permission is granted to use, distribute, or modify this source,
X * provided that this copyright notice remains intact.
X */
X
X#ifndef    LABEL_H
X#define    LABEL_H
X
X
X#include "zmath.h"
X
X
X#define    NULL_LABEL    ((LABEL *) 0)
X
X
X/*
X * Label structures.
X */
Xtypedef struct {
X    long l_offset;          /* offset into code of label */
X    long l_chain;          /* offset into code of undefined chain */
X    char *l_name;          /* name of label if any */
X} LABEL;
X
X
Xextern void initlabels MATH_PROTO((void));
Xextern void definelabel MATH_PROTO((char *name));
Xextern void addlabel MATH_PROTO((char *name));
Xextern void clearlabel MATH_PROTO((LABEL *lp));
Xextern void setlabel MATH_PROTO((LABEL *lp));
Xextern void uselabel MATH_PROTO((LABEL *lp));
Xextern void checklabels MATH_PROTO((void));
X
X#endif
X
X/* END CODE */
SHAR_EOF
chmod 0644 calc2.9.0/label.h || echo "restore of calc2.9.0/label.h fails"
set `wc -c calc2.9.0/label.h`;Sum=$1
if test "$Sum" != "817"
then echo original size 817, current size $Sum;fi
echo "x - extracting calc2.9.0/lint.sed (Text)"
sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/lint.sed &&
X/: warning: conversion from long may lose accuracy$/d
SHAR_EOF
echo "End of part 5"
echo "File calc2.9.0/lint.sed is continued in part 6"
echo "6" > s2_seq_.tmp
exit 0