allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc) (06/22/89)
Posting-number: Volume 7, Issue 47
Submitted-by: fox@marlow.UUCP (Paul Fox)
Archive-name: crisp1.9/part27
#!/bin/sh
# this is part 6 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file ./language.c continued
#
CurArch=6
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 ./language.c"
sed 's/^X//' << 'SHAR_EOF' >> ./language.c
X/* | 8 | 9 | : | ; | < | = | > | ? | */
X 0x0b,0x0b,0x08,0x08,0x0a,0x0a,0x0a,0x08,
X/* | @ | A | B | C | D | E | F | G | */
X 0x08,0x0b,0x0b,0x0b,0x0b,0x0b,0x0b,0x0a,
X/* | H | I | J | K | L | M | N | O | */
X 0x0a,0x0a,0x0a,0x0a,0x0a,0x0a,0x0a,0x0a,
X/* | P | Q | R | S | T | U | V | W | */
X 0x0a,0x0a,0x0a,0x0a,0x0a,0x0a,0x0a,0x0a,
X/* | X | Y | Z | [ | \ | ] | ^ | _ | */
X 0x0b,0x0a,0x0a,0x08,0x08,0x08,0x0a,0x0a,
X/* | ` | a | b | c | d | e | f | g | */
X 0x08,0x0b,0x0b,0x0b,0x0b,0x0b,0x0b,0x0a,
X/* | h | i | j | k | l | m | n | o | */
X 0x0a,0x0a,0x0a,0x0a,0x0a,0x0a,0x0a,0x0a,
X/* | p | q | r | s | t | u | v | w | */
X 0x0a,0x0a,0x0a,0x0a,0x0a,0x0a,0x0a,0x0a,
X/* | x | y | z | { | | | } | ~ | del| */
X 0x0b,0x0a,0x0a,0x08,0x0a,0x08,0x0a,0x08,
X 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0x80-0x87 */
X 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0x88-0x8f */
X 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0x90-0x97 */
X 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0x98-0x9f */
X 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0xa0-0xa7 */
X 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0xa8-0xaf */
X 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0xb0-0xb7 */
X 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0xb8-0xbf */
X 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0xc0-0xc7 */
X 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0xc8-0xcf */
X 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0xd0-0xd7 */
X 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0xd8-0xdf */
X 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0xe0-0xe7 */
X 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0xe8-0xef */
X 0x08,0x08,0x08,0x08,0x08,0x08,0x08,0x08, /* 0xf0-0xf7 */
X 0x08,0x08,0x08,0x00,0x00,0x00,0x00,0x00, /* 0xf8-0xff */
X };
Xstatic char *line_ptr;
Xstatic char *line_buf;
X
X# define newline() {fp_ptr->line_no++; line_ptr = line_buf;}
X# define get_char() (*line_ptr++ = yytchar = (yytchar = *fp_ptr->bufp++) ?\
X yytchar : get_char1() )
X
Xinit_fp(f, filename)
Xchar *filename;
X{ extern char *chk_alloc();
X register int yytchar;
X static int first_time = TRUE;
X struct stat stat_buf;
X static char space[] = {' ', NULL};
X
X if (first_time) {
X int i;
X first_time = FALSE;
X for (i = 0; i < MAX_FILES; i++)
X fps[i].fd = -1;
X hd_syms = ll_init();
X }
X if (stat(filename, &stat_buf) < 0 ||
X (stat_buf.st_mode & S_IFMT) != S_IFREG)
X return -1;
X fp_ptr++;
X if (fp_ptr - fps >= MAX_FILES-1) {
X errorf("Include files nested too deeply");
X fp_ptr--;
X return 0;
X }
X if (fp_ptr->fd >= 0)
X close(fp_ptr->fd);
X if ((fp_ptr->fd = open(filename, O_RDONLY)) < 0) {
X fp_ptr--;
X return -1;
X }
X strcpy(fp_ptr->name, filename);
X fp_ptr->size = stat_buf.st_size;
X fp_ptr->line_no = 1;
X fp_ptr->flags = f;
X fp_ptr->bufp = fp_ptr->buf = chk_alloc(FBUFSIZ+3)+2;
X *fp_ptr->bufp = NULL;
X
X line_ptr = space;
X if (stat_buf.st_size)
X get_char();
X else
X fp_ptr->bufp[-1] = NULL;
X line_ptr = line_buf;
X fp_ptr->bufp--;
X return 0;
X}
Xvoid
Xinit_fp1(buf)
Xchar *buf;
X{
X fp_ptr++;
X if (fp_ptr - fps >= MAX_FILES-1) {
X errorf("File is too complex to parse.\n");
X fp_ptr--;
X return;
X }
X strcpy(fp_ptr->name, fp_ptr[-1].name);
X fp_ptr->line_no = fp_ptr[-1].line_no;
X fp_ptr->fd = -1;
X fp_ptr->flags = 0;
X fp_ptr->bufp = fp_ptr->buf = buf;
X fp_ptr->bufend = &buf[strlen(buf)+1];
X}
Xget_char1()
X{
X register int ch;
X register int n;
X
X fp_ptr->bufp--;
Xagain:
X if (*fp_ptr->bufp == NULL)
X if (fp_ptr->fd >= 0 &&
X (n = sys_read(fp_ptr->fd, fp_ptr->bufp = fp_ptr->buf, FBUFSIZ)) > 0) {
X fp_ptr->bufend = &fp_ptr->buf[n];
X *fp_ptr->bufend = NULL;
X }
X else {
X if (fp_ptr->fd >= 0) {
X close(fp_ptr->fd);
X chk_free(fp_ptr->buf-2);
X }
X fp_ptr->fd = -1;
X if (fp_ptr->flags == TERMINAL) {
X fp_ptr--;
X return 0;
X }
X fp_ptr--;
X goto again;
X }
X ch = *fp_ptr->bufp++;
X return ch;
X}
Xchar yytext[YYMAX];
Xlong yyint;
Xint llevel = 0;
Xint cm_running = FALSE;
XDEFINE *def_head,
X *def_ptr;
X
Xint token;
Xint malloc_size = NATOMS;
Xint parse_error;
X
Xyyparse()
X{
X char error_line[BUFSIZ];
X CM *cm = (CM *) fp_ptr->bufp;
X int atom;
X int i;
X
X if (cm->cm_magic == CM_MAGIC) {
X i = read_cm();
X close(fp_ptr->fd);
X fp_ptr->fd = -1;
X fp_ptr--;
X return i;
X }
X
X parse_error = 0;
X line_ptr = line_buf = error_line;
X
X def_head = def_ptr = NULL;
X npending = 0;
X if ((first_atom = (LIST *) chk_alloc(malloc_size)) == NULL) {
X yyerror("Cannot allocate room for macro\n", (char *) NULL);
X return -1;
X }
X
X atom = 0;
X
X while (1) {
X pending_macros[npending] = atom;
X token = yylex();
X if (token == TOKEN_EOF)
X break;
X if (token != OPEN_PAREN) {
X yyerror("Macro does not start with a '('", (char *) NULL);
X break;
X }
X atom = yyparse1(atom);
X if (token < 0)
X break;
X if (token != CLOSE_PAREN) {
X yyerror("Macro does not end with a ')'", (char *) NULL);
X break;
X }
X first_atom[atom++] = F_END;
X npending++;
X }
X free_defines(def_head);
X ll_clear(hd_syms);
X
X if (parse_error) {
X if (first_atom)
X chk_free((char *) first_atom);
X }
X else if (atom) {
X first_atom = (LIST *) chk_realloc((char *) first_atom, atom+1);
X for (i = 0; i < npending; i++) {
X sizeof_macro = pending_macros[i+1] - pending_macros[i];
X execute_macro(first_atom + pending_macros[i]);
X }
X }
X return parse_error;
X}
Xfree_defines(ptr)
Xregister DEFINE *ptr;
X{
X if (ptr == NULL)
X return;
X free_defines(ptr->next);
X chk_free(ptr->name);
X chk_free(ptr->value - 1);
X chk_free(ptr);
X}
Xyyparse1(base_atom)
Xregister int base_atom;
X{ register int atom = base_atom;
X register int new_atom;
X register LIST *ap;
X int first_token = TRUE;
X int decl = 0;
X
X while (1) {
X if (atom > malloc_size - 10) {
X malloc_size += NATOMS;
X if ((first_atom = (LIST *) chk_realloc((char *) first_atom,
X malloc_size)) == NULL) {
X yyerror("Cannot allocate room for macro\n", (char *) NULL);
X return -1;
X }
X }
X token = yylex();
X if (token == OPEN_PAREN) {
X if (decl) {
X yyerror("Cannot nest declarations.", (char *) NULL);
X return NULL;
X }
X first_atom[atom] = F_LIST;
X if ((new_atom = yyparse1(atom + sizeof_atoms[F_LIST])) == NULL)
X return NULL;
X if (token == TOKEN_EOF) {
X yyerror("Missing close parenthesis.", (char *) NULL);
X return NULL;
X }
X if (yylook() == CLOSE_PAREN)
X LPUT16(&first_atom[atom], 0);
X else
X LPUT16(&first_atom[atom], new_atom - atom);
X atom = new_atom;
X continue;
X }
X ap = &first_atom[atom];
X if (token == CLOSE_PAREN) {
X *ap = F_HALT;
X return ++atom;
X }
X if (decl || token == ID) {
X BUILTIN *bp;
X extern BUILTIN builtin[];
X if (bp = lookup_builtin(yytext)) {
X if (first_token) {
X if (strcmp(yytext, "int") == 0)
X decl = F_INT;
X else if (strcmp(yytext, "string") == 0)
X decl = F_STR;
X else if (strcmp(yytext, "list") == 0)
X decl = F_LIST;
X else if (strcmp(yytext, "global") == 0)
X decl = -1;
X first_token = FALSE;
X }
X *ap = F_ID;
X LPUT16(ap, bp - builtin);
X atom += sizeof_atoms[F_ID];
X continue;
X }
X if (decl == -1) {
X OPCODE type;
X OPCODE decl_gettype();
X type = decl_gettype(yytext);
X if ((int) type == 0) {
X yyerror("Undefined symbol %s", yytext);
X return NULL;
X }
X if (type == F_ERROR) {
X yyerror(
X"Trying to globalise symbol declared with different types: %s", yytext);
X return NULL;
X }
X *ap = F_INT;
X LPUT32(ap, (long) type);
X atom += sizeof_atoms[F_INT];
X ap = &first_atom[atom];
X }
X else if (decl)
X decl_enter(yytext, decl);
X if (yytext[0] != '"') {
X *ap = F_STR;
X LPUT32(ap, (long) strdup(yytext));
X }
X else {
X *ap = F_LIT;
X LPUT32(ap, (long) strdup(yytext+1));
X }
X atom += sizeof_atoms[*ap];
X first_token = FALSE;
X continue;
X }
X first_token = FALSE;
X if (token == INT) {
X *ap = F_INT;
X LPUT32(ap, yyint);
X atom += sizeof_atoms[F_INT];
X continue;
X }
X if (token == TOKEN_EOF)
X return atom;
X token = -1;
X yyerror("Invalid token", (char *) NULL);
X return NULL;
X }
X}
XList_p
Xdecl_lookup(sym)
Xchar *sym;
X{ List_p lp;
X SYMBOL *sp;
X
X for (lp = ll_first(hd_syms); lp; lp = ll_next(lp)) {
X sp = (SYMBOL *) ll_elem(lp);
X if (strcmp(sp->s_name, sym) == 0)
X return lp;
X }
X return NULL;
X}
Xdecl_enter(sym, type)
Xchar *sym;
XOPCODE type;
X{ List_p lp = decl_lookup(sym);
X SYMBOL *sp;
X if (lp) {
X sp = (SYMBOL *) ll_elem(lp);
X if (sp->s_type != type)
X sp->s_type = F_ERROR;
X }
X else {
X sp = (SYMBOL *) chk_alloc(sizeof (SYMBOL));
X strcpy(sp->s_name, yytext);
X sp->s_type = type;
X ll_append(hd_syms, (char *) sp);
X }
X}
XOPCODE
Xdecl_gettype(sym)
Xchar *sym;
X{ List_p lp = decl_lookup(sym);
X SYMBOL *sp;
X if (lp == NULL)
X return (OPCODE) 0;
X sp = (SYMBOL *) ll_elem(lp);
X return sp->s_type;
X}
Xint looking = FALSE;
Xint saved_token;
Xyylook()
X{
X if (looking == TRUE)
X return token;
X saved_token = token = yylex();
X looking = TRUE;
X return token;
X}
Xyylex()
X{
X register int yytchar;
X register int ch;
X register int i;
X if (looking) {
X looking = FALSE;
X return token = saved_token;
X }
Xagain:
X while (_chars_[get_char()] & _XWS)
X ;
X
X switch (yytchar) {
X case 0x04: /* CTRL-D */
X case 0x1a: /* CTRL-Z */
X case 0:
X return TOKEN_EOF;
X case '\r':
X goto again;
X case '(':
X return OPEN_PAREN;
X case ')':
X return CLOSE_PAREN;
X case '-':
X ch = yytchar;
X i = _chars_[get_char()] & _XDIGIT;
X *--fp_ptr->bufp = (char) yytchar;
X yytchar = ch;
X if (i == 0)
X goto alpha;
X case '0': case '1': case '2': case '3': case '4':
X case '5': case '6': case '7': case '8': case '9':
X return do_number(yytchar);
X case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': case 'G':
X case 'H': case 'I': case 'J': case 'K': case 'L': case 'M': case 'N':
X case 'O': case 'P': case 'Q': case 'R': case 'S': case 'T': case 'U':
X case 'V': case 'W': case 'X': case 'Y': case 'Z':
X case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': case 'g':
X case 'h': case 'i': case 'j': case 'k': case 'l': case 'm': case 'n':
X case 'o': case 'p': case 'q': case 'r': case 's': case 't': case 'u':
X case 'v': case 'w': case 'x': case 'y': case 'z':
X case '_': case '$':
X i = do_symbol(yytchar);
X if (i == TRUE)
X goto again;
X return token = ID;
X case '/':
X yytext[0] = (char) yytchar;
X if (*fp_ptr->bufp == '*') {
X if (do_comment(TRUE) == 0)
X return TOKEN_EOF;
X goto again;
X }
X if (*fp_ptr->bufp == NULL) {
X if (getchar() == '*') {
X if (do_comment(TRUE) == 0)
X return TOKEN_EOF;
X goto again;
X }
X --fp_ptr->bufp;
X }
X get_until(yytext+1, _XSYMBOL);
X if (yytext[1] != '/' || yytext[2] != NULL)
X return ID;
X /* Fall into... (allows // as a comment). */
X case ';':
X if (do_comment(FALSE) == 0)
X return TOKEN_EOF;
X goto again;
X case '+': case '*': case '%': case '<': case '>': case '^':
X case '=': case '!': case '|': case '&': case '.': case '~':
Xalpha:
X yytext[0] = (char) yytchar;
X get_until(yytext+1, _XSYMBOL);
X return ID;
X case '\'':
X if (get_quoted_string('\'') == FALSE) {
X yyerror("Character constant too long or unterminated.", (char *) NULL);
X return -1;
X }
X yyint = yytext[0];
X return token = INT;
X case '"':
X if (get_quoted_string('"') == FALSE) {
X yyerror("String literal not terminated.", (char *) NULL);
X return -1;
X }
X return token;
X case '#':
X cpp();
X goto again;
X case '\n':
X newline();
X goto again;
X default:
X sprintf(yytext, "illegal character: 0x%02x (%c)",
X yytchar & 0xff, yytchar);
X yyerror(yytext, (char *) NULL);
X return -1;
X }
X}
Xstatic
Xget_escaped_character(str)
Xchar *str;
X{ int byte;
X char *charp = str++;
X char ch = *str++;
X
X switch (ch) {
X case 't': byte = '\t'; break;
X case 'n': byte = '\n'; break;
X case 'f': byte = '\f'; break;
X case 'r': byte = '\r'; break;
X case 'x':
X byte = *str++;
X if (isdigit(byte))
X byte -= '0';
X else if (byte >= 'A' && byte <= 'F')
X byte = byte - 'A' + 10;
X else if (byte >= 'a' && byte <= 'f')
X byte = byte - 'a' + 10;
X else {
X str--;
X break;
X }
X /*--------------------------
X * Second digit.
X *--------------------------*/
X ch = *str++;
X if (isdigit(ch))
X byte = (byte << 4) + ch - '0';
X else if (ch >= 'A' && ch <= 'F')
X byte = (byte << 4) + ch - 'A' + 10;
X else if (ch >= 'a' && ch <= 'f')
X byte = (byte << 4) + ch - 'a' + 10;
X else
X str--;
X break;
X default:
X byte = ch;
X break;
X }
X *charp++ = byte;
X strcpy(charp, str);
X}
Xdo_comment(C_comment)
X{ register int yytchar;
X int end_ch = C_comment ? '*' : '\n';
X int lineno = fp_ptr->line_no;
X
X while (1) {
X if (get_char() == 0) {
X yyerror("Unterminated comment at line %d", lineno);
X return 0;
X }
Xsecond_char:
X if (yytchar == '\n')
X newline();
X if (yytchar == end_ch) {
X if (!C_comment)
X return 1;
X if (get_char() == 0)
X return 0;
X if (yytchar == '/')
X return 1;
X goto second_char;
X }
X }
X}
Xget_quoted_string(quote)
X{ register unsigned char *cp = (unsigned char *) yytext;
X register int yytchar;
X
X if (quote == '"')
X *cp++ = '"';
X while (1) {
X if (get_char() == 0) {
X *cp = NULL;
X return FALSE;
X }
X if (yytchar == quote) {
X *cp = NULL;
X break;
X }
X if (yytchar == '\n') {
X *cp = NULL;
X return FALSE;
X }
X if (yytchar != '\\') {
X *cp++ = (char) yytchar;
X continue;
X }
X *cp++ = '\\';
X *cp++ = get_char();
X }
X
X for (cp = (unsigned char *) yytext; *cp; cp++) {
X if (*cp != '\\')
X continue;
X get_escaped_character(cp);
X }
X
X token = ID;
X return TRUE;
X}
Xvoid
Xget_until(str, mask)
Xregister char *str;
Xregister int mask;
X{
X register int yytchar;
X
X while (1) {
X if (get_char() == 0) {
X *str = NULL;
X return;
X }
X if ((_chars_[yytchar] & mask) == 0) {
X --fp_ptr->bufp;
X *str = NULL;
X return;
X }
X *str++ = (char) yytchar;
X }
X}
X
X
Xvoid
Xyyerror(str, str1)
Xchar *str, *str1;
X{ char buf[256];
X char *cp, *cp1;
X register int yytchar;
X
X parse_error = -1;
X if (verbose_errors && token != TOKEN_EOF) {
X memcpy(buf, line_buf, line_ptr - line_buf);
X cp = &buf[line_ptr - line_buf];
X while ((*cp++ = get_char()) != '\n')
X ;
X *--cp = NULL;
X ewprintf("%s", buf);
X for (cp = buf, cp1 = line_buf; cp1 < line_ptr; )
X *cp++ = *cp1++ == '\t' ? '\t' : ' ';
X *cp = NULL;
X ewprintf("%s^", buf);
X }
X if (fp_ptr >= fps)
X sprintf(buf, "%s(%d): %s", fp_ptr->name, fp_ptr->line_no, str);
X else
X strcpy(buf, str);
X ewprintf(buf, str1);
X llevel = 0;
X token = -1;
X}
Xvoid
Xcpp()
X{ register char *cp;
X register int yytchar;
X
X yytext[0] = '#';
X for (cp = yytext+1; ; *cp++ = (char) yytchar)
X if (get_char() == 0 || yytchar == '\n' || yytchar == ';') {
X if (yytchar)
X --fp_ptr->bufp;
X *cp = NULL;
X break;
X }
X
X for (cp = yytext+1; *cp == ' ' || *cp == '\t'; )
X cp++;
X if (strncmp(cp, "define", 6) == 0) {
X do_define();
X return;
X }
X if (strncmp(cp, "include", 7) == 0) {
X do_include();
X return;
X }
X yyerror("pre-processor command not recognized");
X}
Xvoid
Xdo_include()
X{ extern char *bpath;
X char inc_file[128];
X char buf[128];
X register char *cp, *bp;
X int delim;
X extern char *strrchr();
X
X for (cp = yytext+8; *cp && *cp != '<' && *cp != '"'; )
X cp++;
X if (*cp)
X delim = *cp++;
X for (bp = inc_file; *cp && *cp != '>' && *cp != '"'; )
X *bp++ = *cp++;
X *bp = NULL;
X
X if (delim == '"' && init_fp(0, inc_file) >= 0)
X return;
X if (cp = strrchr(fp_ptr->name, '/')) {
X strcpy(buf, fp_ptr->name);
X strcpy(&buf[cp - fp_ptr->name + 1], inc_file);
X if (init_fp(0, buf) >= 0)
X return;
X }
X
X for (cp = bpath; *cp && inc_file[0] != '/' ; ) {
X bp = buf;
X while (*cp && *cp != ';')
X *bp++ = *cp++;
X if (*cp == ';')
X cp++;
X *bp++ = '/';
X strcpy(bp, inc_file);
X if (init_fp(0, buf) >= 0)
X return;
X }
X ewprintf("Cannot read %s", inc_file);
X}
Xvoid
Xdo_define()
X{ char *symbol;
X char *value;
X register DEFINE *dp = def_head;
X extern char *chk_alloc();
X extern char *strtok();
X register int l;
X register char *cp = yytext;
X
X while (strncmp(cp, "define", 6) != 0)
X cp++;
X cp += 6;
X while (isspace(*cp))
X cp++;
X symbol = strtok(cp, " \t");
X cp = strtok((char *) NULL, "\n");
X while (*cp && isspace(*cp))
X cp++;
X if (*cp == '"') {
X value = cp++;
X for (; *cp && *cp != '"'; cp++)
X if (*cp == '\\')
X cp++;
X if (*cp == '"')
X *++cp = NULL;
X }
X else
X value = strtok(cp, " \t\n");
X
X l = strlen(value);
X
X for (; dp; dp=dp->next)
X if (strcmp(dp->name, symbol) == 0)
X break;
X if (dp == NULL) {
X if (def_ptr == NULL)
X def_head = def_ptr = (DEFINE *) chk_alloc(sizeof (DEFINE));
X else {
X def_ptr->next = (DEFINE *) chk_alloc(sizeof (DEFINE));
X def_ptr = def_ptr->next;
X }
X def_ptr->name = strdup(symbol);
X def_ptr->value = chk_alloc(l + 4) + 1;
X def_ptr->next = NULL;
X dp = def_ptr;
X }
X else if (strlen(dp->value + 1) > l) {
X chk_free(dp->value - 1);
X dp->value = chk_alloc(l + 4) + 1;
X }
X
X memcpy(dp->value + 1, value, l + 1);
X}
Xdo_number(ch)
X{ extern long atol();
X
X yytext[0] = (char) ch;
X get_until(yytext+1, _XDIGIT);
X if (yytext[1] == 'x' || yytext[1] == 'X')
X sscanf(yytext+2, "%lx", &yyint);
X else if (yytext[0] == '0')
X sscanf(yytext, "%lo", &yyint);
X else
X yyint = atol(yytext);
X return token = INT;
X}
Xdo_symbol(ch)
X{ register DEFINE *dp = def_head;
X char *save_line_ptr = line_ptr - 1;
X
X yytext[0] = (char) ch;
X get_until(yytext+1, _XSYMBOL);
X
X for (; dp; dp = dp->next)
X if (dp->name[0] == yytext[0] && strcmp(dp->name, yytext) == 0) {
X init_fp1(dp->value + 1);
X line_ptr = save_line_ptr;
X return TRUE;
X }
X return FALSE;
X}
X
Xread_cm()
X{
X register LIST *lp;
X register LIST *lpend;
X CM *cm = (CM *) fp_ptr->bufp;
X u_int32 *m_offsets;
X u_int32 num_strings;
X u_int32 *globals;
X int i;
X LIST *base_list;
X char *string_table;
X u_int32 *soffsets;
X extern int cm_version;
X
X
X if (cm_running)
X exit(0);
X
X if (fp_ptr->size > MAX_CM_SIZE ||
X (cm = (CM *) chk_alloc((unsigned) fp_ptr->size)) == NULL) {
X yyerror("Macro file too big to read");
X return -1;
X }
X lseek(fp_ptr->fd, 0l, 0);
X if (sys_read(fp_ptr->fd, (char *) cm, (int) fp_ptr->size) !=
X (int) fp_ptr->size) {
X yyerror("Read() error on .cm file");
X return -1;
X }
X swap_cm_header(cm);
X if (cm->cm_version != cm_version) {
X errorf(".cm version %d not supported", cm->cm_version);
X return -1;
X }
X
X m_offsets = (u_int32 *) (cm + 1);
X globals = (u_int32 *) ( ((char *) cm) + cm->cm_globals );
X if (cm->cm_globals & 1) {
X errorf("Global decls not on even boundary.");
X return -1;
X }
X base_list = (LIST *) (m_offsets + cm->cm_num_macros + 2);
X num_strings = WGET32(m_offsets[cm->cm_num_macros + 1]);
X soffsets = (u_int32 *) (((char *) base_list) +
X WGET32(m_offsets[cm->cm_num_macros]));
X string_table = (char *) (soffsets + num_strings);
X
X lpend = base_list + cm->cm_num_atoms;
X
X swap_words(soffsets, cm->cm_num_strings);
X for (lp = base_list; lp < lpend; lp += sizeof_atoms[*lp]) {
X if (*lp == F_STR || *lp == F_LIT) {
X int offset = (int) LGET32(lp);
X LPUT32(lp, (long) (string_table + soffsets[offset]));
X }
X }
X
X swap_words(globals, cm->cm_num_globals);
X for (i = 0; i < cm->cm_num_globals; i++) {
X lp = (LIST *) (base_list + *globals++);
X trace_list(lp);
X exec1(lp, lp + sizeof_atoms[*lp]);
X }
X swap_words(m_offsets, cm->cm_num_macros);
X for (i = 0; i < cm->cm_num_macros; i++)
X execute_macro(base_list + m_offsets[i]);
X return 0;
X}
Xswap_cm_header(cm)
XCM *cm;
X{
X cm->cm_magic = WGET16(cm->cm_magic);
X cm->cm_version = WGET16(cm->cm_version);
X cm->cm_num_macros = WGET16(cm->cm_num_macros);
X cm->cm_num_atoms = WGET16(cm->cm_num_atoms);
X cm->cm_globals = WGET32(cm->cm_globals);
X cm->cm_num_globals = WGET16(cm->cm_num_globals);
X cm->cm_num_strings = WGET16(cm->cm_num_strings);
X}
Xmalloc_hack()
X{
X}
SHAR_EOF
echo "File ./language.c is complete"
chmod 0444 ./language.c || echo "restore of ./language.c fails"
mkdir . >/dev/null 2>&1
echo "x - extracting ./line.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ./line.c &&
X/**************************************************************
X *
X * CRISP - Custom Reduced Instruction Set Programmers Editor
X *
X * (C) Paul Fox, 1989
X * 43, Jerome Close Tel: +44 6284 4222
X * Marlow
X * Bucks.
X * England SL7 1TX
X *
X *
X * Please See COPYRIGHT notice.
X *
X **************************************************************/
X
X#include "list.h"
X
XSCCSID("@(#) line.c 1.16, (C) 1989, P. Fox");
X
X#define NBLOCK 16 /* Line block chunk size */
X#define NBLOCK1 256 /* Line block chunk size for large */
X /* allocations. */
X#ifndef KBLOCK
X#define KBLOCK 256 /* Kill buffer block size. */
X#endif
Xvoid lfree();
Xextern int pty;
Xextern int strip_cr_flag;
X# define LBLK(x) ((int) (NBLOCK - 1 + (x)) & ~(NBLOCK-1))
X# define LBLK1(x) ((int) (NBLOCK1 - 1 + (x)) & ~(NBLOCK1-1))
X
Xstatic LINE *hd_line = NULL;
Xfree_line(lp)
Xregister LINE *lp;
X{
X vm_free(lp, &hd_line);
X}
X# define alloc_line() ((LINE *) vm_alloc(sizeof (LINE), &hd_line))
X# define free_line(lp) vm_free(lp, &hd_line)
XLINE *
Xlalloc(used)
Xregister RSIZE used;
X{
X register LINE *lp;
X register u_int16 size;
X static char *msg = "Can't get %d bytes";
X
X size = (u_int16) LBLK(used);
X
X if ((lp = alloc_line()) == NULL) {
X ewprintf(msg, sizeof(LINE));
X return NULL;
X }
X if (size == 0)
X lp->l_text = NULL;
X else if ((lp->l_text = (u_char *) chk_alloc(size)) == NULL) {
X free_line(lp);
X ewprintf(msg, size);
X return NULL;
X }
X lp->l_size = size;
X lp->l_lineno = 0;
X /*NOSTRICT*/
X lp->l_used = (u_int16) used;
X return lp;
X}
X
Xvoid
Xlfree(buf, line)
Xregister int line;
XBUFFER *buf;
X{
X register WINDOW *wp;
X register LINE *lp;
X BUFFER *saved_bp = curbp;
X LINE *next_line;
X
X curbp = buf;
X lp = linep(line);
X curbp = saved_bp;
X next_line = lp->l_fp;
X
X for (wp = wheadp; wp; wp = wp->w_wndp) {
X if (wp->w_bufp != buf)
X continue;
X if (wp->w_top_line > line)
X wp->w_top_line--;
X if (wp->w_line > line) {
X wp->w_line--;
X wp->w_col = 1;
X }
X }
X if (buf->b_line > line) {
X buf->b_line--;
X buf->b_col = 1;
X }
X buf->b_numlines--;
X lp->l_bp->l_fp = next_line;
X next_line->l_bp = lp->l_bp;
X if (lp->l_text && (lp->l_flags & L_FILE) == 0)
X chk_free(lp->l_text);
X free_line(lp);
X flush_cache(buf);
X}
X
Xvoid
Xlchange(flag)
Xregister int flag;
X{ register WINDOW *wp;
X
X curbp->b_flag |= BFCHG;
X
X for (wp = wheadp; wp; wp = wp->w_wndp)
X if (wp->w_bufp == curbp)
X wwin_modify(wp, wp == curwp ? flag :
X flag == WFDELL ? WFHARD : flag);
X}
X
Xl_insert(ch)
X{ char buf[2];
X
X if (ch == '\n')
X lnewline('\n');
X else {
X buf[0] = (char) ch;
X buf[1] = NULL;
X if (rdonly())
X return FALSE;
X lchange(WFEDIT);
X llinsert(buf, 1, FALSE);
X lchange(WFEDIT);
X }
X return TRUE;
X}
Xlinsert(str, n)
Xchar *str;
X{ register char *cp;
X register u_int16 len;
X int nline = 0;
X
X if (rdonly())
X return -1;
X lchange(WFEDIT);
X
X while (n > 0) {
X int nl = FALSE;
X char *cpend = str + n;
X for (cp = str; cp < cpend; cp++) {
X if (*cp == '\n') {
X nl = TRUE;
X break;
X }
X }
X len = cp - str;
X n -= len + 1;
X if (len && strip_cr_flag && str[len-1] == '\r')
X len--;
X if (llinsert(str, len, nl) == FALSE)
X return -1;
X str = cp + 1;
X nline += nl;
X }
X lchange(WFEDIT);
X return nline;
X}
X
Xllinsert(cp, len, nl)
Xchar *cp;
Xu_int16 len;
X{ extern LINE *global_lp;
X register LINE *lp1;
X register LINE *lp2;
X register u_int16 tdoto;
X int line;
X
X line = *cur_line;
X if (len && *cur_line == curbp->b_numlines) {
X if ((lp2=lalloc(len)) == NULL) {
Xfalse_exit:
X vm_unlock(*cur_line);
X return FALSE;
X }
X u_delete((RSIZE) 1);/*NEW*/
X lp1 = vm_lock_line(line);
X curbp->b_numlines++;
X curbp->b_cline++;
X lp2->l_fp = lp1;
X lp2->l_bp = lp1->l_bp;
X lp1->l_bp->l_fp = lp2;
X lp1->l_bp = lp2;
X
X lp1 = lp2;
X lp1->l_used = 0;
X vm_unlock(*cur_line + 1);
X }
X
X tdoto = current_offset(*cur_col, TRUE);
X lp1 = global_lp;
X if (len) {
X u_delete((RSIZE) len);
X if (lrealloc(lp1, tdoto, len) == FALSE)
X goto false_exit;
X memcpy(&lp1->l_text[tdoto], cp, len);
X vm_unlock(line);
X }
X
X if (nl)
X lnewline1(lp1, tdoto+len, '\n');
X else
X *cur_col = current_col(tdoto + len);
X return TRUE;
X}
Xlrealloc(lp, dot, len)
Xregister LINE *lp;
X{
X register char *cp1;
X register char *cp2;
X register char *cp3;
X char *chk_realloc();
X
X if (lp->l_flags & L_FILE)
X lnormal(lp, len);
X if (lp->l_used+len > lp->l_size) {
X int newlen = lp->l_used + len;
X u_int16 size = (u_int16) (lp->l_used > NBLOCK1 ?
X LBLK1(newlen) : LBLK(newlen));
X if (lp->l_text)
X lp->l_text = (u_char *) chk_realloc(lp->l_text, size);
X else
X lp->l_text = (u_char *) chk_alloc(size);
X lp->l_size = size;
X }
X cp1 = (char *) &lp->l_text[lp->l_used];
X cp2 = cp1 + len;
X cp3 = (char *) &lp->l_text[dot];
X while (cp1 != cp3)
X *--cp2 = *--cp1;
X lp->l_used += len;
X return TRUE;
X}
Xlnormal(lp, len)
Xregister LINE *lp;
X{ register char *cp1;
X if (lp->l_flags & L_FILE) {
X lp->l_size = LBLK(lp->l_used) + len;
X cp1 = chk_alloc(lp->l_size);
X memcpy(cp1, lp->l_text, lp->l_used);
X lp->l_text = (u_char *) cp1;
X lp->l_flags &= ~L_FILE;
X }
X}
Xlnewline(nl)
X{
X
X if (rdonly())
X return;
X
X lnewline1(vm_lock_line(*cur_line), current_offset(*cur_col, FALSE), nl);
X}
Xlnewline1(lp1, tdoto, nl)
Xregister LINE *lp1;
Xregister u_int16 tdoto;
X{ register LINE *lp2;
X
X lchange(WFHARD);
X u_delete((RSIZE) 1);
X if ((lp2=lalloc((RSIZE) (lp1->l_used - tdoto))) == NULL) {
X vm_unlock(*cur_line);
X return FALSE;
X }
X if (*cur_line == curbp->b_numlines)
X curbp->b_linep = lp2;
X curbp->b_numlines++;
X
X if (tdoto < lp1->l_used) {
X memcpy(lp2->l_text, lp1->l_text + tdoto, lp1->l_used - tdoto);
X lp2->l_used = lp1->l_used - tdoto;
X lp1->l_used = tdoto;
X }
X
X lp2->l_bp = lp1;
X lp2->l_fp = lp1->l_fp;
X lp1->l_fp->l_bp = lp2;
X lp1->l_fp = lp2;
X
X vm_unlock(*cur_line);
X vm_unlock(*cur_line + 1);
X (*cur_line)++;
X *cur_col = 1;
X ladjust();
X return TRUE;
X}
Xladjust()
X{ register WINDOW *wp;
X
X for (wp = wheadp; wp; wp = wp->w_wndp) {
X if (wp->w_bufp != curbp || wp == curwp)
X continue;
X if (wp->w_line >= *cur_line)
X wp->w_line++;
X if (wp->w_top_line >= *cur_line)
X wp->w_top_line++;
X if (wp->w_mined >= *cur_line)
X wp->w_mined++;
X if (wp->w_maxed >= *cur_line)
X wp->w_maxed++;
X }
X
X /*----------------------------------------
X /* If current buffer has a marked area,
X /* then update the the end of region pointer
X /* if it ends after the cursor.
X /*----------------------------------------*/
X if (curbp->b_anchor) {
X extern int end_line;
X get_marked_areas(curwp);
X if (end_line > *cur_line)
X curbp->b_anchor->a_line++;
X }
X}
X# define CHUNK_SIZE (25 * 1024) /* This ought to be less than */
X /* 32K to avoid problems on */
X /* small systems. */
Xlreadin_file(fd, size, fname)
Xlong size;
Xchar *fname;
X{
X register char *bp, *bp1, *bpend;
X long filesize = size;
X char *buf;
X char **chunk_list = NULL;
X long pos = 0;
X LINE *lp, *clp;
X int nline = curbp->b_numlines;
X int current_line = *cur_line;
X RSIZE nbytes = 0;
X int binary = FALSE;
X int line_overflow = 0;
X int long_line = FALSE;
X
X clp = linep(*cur_line);
X u_dot();
X while (size > 0) {
X int len = size > CHUNK_SIZE ? CHUNK_SIZE : size;
X size -= len;
X buf = chk_alloc(sizeof (char *) + len);
X if (chunk_list)
X *chunk_list = buf;
X chunk_list = (char **) buf;
X buf += sizeof (char *);
X len = sys_read(fd, buf, len);
X if (pos == 0) {
X if (buf[0] == 0x00 || (buf[0] & 0x80) ||
X buf[1] == 0x00 || (buf[1] & 0x80))
X binary = TRUE;
X }
X pos += len;
X bp = buf;
X bpend = buf + len;
X while (bp < bpend) {
X /*----------------------------------------
X /* If file is binary then make lines into
X /* 32 character chunks.
X /*----------------------------------------*/
X if (binary) {
X bp1 = bp + 32;
X if (bp1 >= bpend)
X bp1 = bpend;
X }
X else {
X for (bp1 = bp; bp1 < bpend; bp1++)
X if (*bp1 == '\n')
X break;
X if (long_line) {
X flush_cache(curbp);
X *cur_line = current_line + curbp->b_numlines - nline - 1;
X *cur_col = current_col(clp->l_bp->l_used);
X llinsert(bp, bp1 - bp, FALSE);
X long_line = bp1 >= bpend;
X lp = clp;
X goto continue_loop;
X }
X if (bp1 >= bpend) {
X long diff = bpend - bp;
X if (size) {
X if (bp != buf) {
X size += diff;
X pos -= diff;
X lseek(fd, pos, 0);
X long_line = FALSE;
X break;
X }
X else {
X long_line = TRUE;
X line_overflow++;
X }
X }
X }
X }
X lp = lalloc(0);
X lp->l_flags |= L_FILE;
X lp->l_text = (u_char *) bp;
X lp->l_size = lp->l_used = bp1 - bp;
X nbytes += lp->l_size + 1;
X
X lp->l_fp = clp;
X lp->l_bp = clp->l_bp;
X
X clp->l_bp = lp;
X lp->l_bp->l_fp = lp;
X
X curbp->b_numlines++;
Xcontinue_loop:
X if (binary) {
X bp = bp1;
X }
X else {
X if (strip_cr_flag && bp[lp->l_used-1] == '\r')
X lp->l_used--;
X bp = bp1+1;
X }
X }
X if (curbp->b_system != 0)
X percentage(pos, filesize, "Reading", fname);
X }
X flush_cache(curbp);
X curbp->b_chunk = chunk_list;
X if (binary)
X curbp->b_flag |= BFBINARY;
X nline = curbp->b_numlines - nline;
X u_delete((RSIZE) nbytes);
X *cur_line = current_line + nline;
X return nline;
X}
Xvoid
Xldelete(n)
XRSIZE n;
X{ register LINE *this_line = vm_lock_line(*cur_line);
X register LINE *next_line;
X register LINE *last_line = curbp->b_linep;
X int dot = current_offset(*cur_col, FALSE);
X
X if (rdonly() || *cur_line == curbp->b_numlines)
X return;
X u_insert(n);
X if (n <= this_line->l_used - dot) {
X memcpy(&this_line->l_text[dot],
X &this_line->l_text[dot+n],
X this_line->l_used - dot - n);
X this_line->l_used -= n;
X lchange(WFEDIT);
X return;
X }
X
X n -= this_line->l_used - dot;
X this_line->l_used = dot;
X if (dot == 0 && n == this_line->l_used + 1)
X lchange(WFDELL);
X else
X lchange(WFHARD);
X while (n > 0 && (next_line = this_line->l_fp) != last_line) {
X if (--n <= next_line->l_used) {
X if (n)
X memcpy(next_line->l_text,
X &next_line->l_text[n],
X next_line->l_used - n);
X next_line->l_used -= n;
X lrealloc(this_line, this_line->l_used, next_line->l_used);
X memcpy(&this_line->l_text[dot], next_line->l_text,
X next_line->l_used);
X lfree(curbp, *cur_line + 1);
X break;
X }
X n -= next_line->l_used;
X lfree(curbp, *cur_line + 1);
X }
X if (n && dot == 0 && next_line == last_line)
X lfree(curbp, *cur_line);
X}
X
Xspace_fill(lp, num, start, col)
XLINE *lp;
X{ register u_char *cp1;
X register u_char *cp2;
X register int num_to_copy;
X int num_tabs = 0;
X extern int tab_char;
X int size;
X int saved_col = *cur_col;
X
X if (tab_char && col) {
X int tcol = col - 1;
X while (num > 2) {
X int tab_width = next_tab_stop(tcol + 1) - tcol;
X if (tab_width > num)
X break;
X num_tabs++;
X tcol += tab_width;
X num -= tab_width;
X }
X num += num_tabs;
X }
X u_dot();
X *cur_col = col;
X u_delete((RSIZE) num);
X *cur_col = saved_col;
X lnormal(lp, 0);
X if (lp->l_size - lp->l_used < num) {
X if (lp->l_size)
X lp->l_text = (u_char *) chk_realloc(lp->l_text, LBLK(lp->l_used + num));
X else
X lp->l_text = (u_char *) chk_alloc(num);
X }
X
X num_to_copy = lp->l_used - start;
X cp1 = &lp->l_text[lp->l_used];
X cp2 = cp1 + num;
X while (num_to_copy-- > 0)
X *--cp2 = *--cp1;
X
X lp->l_used += num;
X cp1 = &lp->l_text[start];
X size = num;
X num -= num_tabs;
X while (num_tabs-- > 0)
X *cp1++ = '\t';
X while (num-- > 0)
X *cp1++ = ' ';
X return start + size;
X}
Xrenumber_lines(bp)
Xregister BUFFER *bp;
X{
X register LINE *lp;
X register u_int16 line_no = 1;
X for (lp = lforw(bp->b_linep); lp != bp->b_linep; lp = lforw(lp)) {
X lp->l_lineno = line_no++;
X }
X}
SHAR_EOF
chmod 0444 ./line.c || echo "restore of ./line.c fails"
mkdir . >/dev/null 2>&1
echo "x - extracting ./lisp.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ./lisp.c &&
X/**************************************************************
X *
X * CRISP - Custom Reduced Instruction Set Programmers Editor
X *
X * (C) Paul Fox, 1989
X * 43, Jerome Close Tel: +44 6284 4222
X * Marlow
X * Bucks.
X * England SL7 1TX
X *
X *
X * Please See COPYRIGHT notice.
X *
X **************************************************************/
X# include "list.h"
X
XSCCSID("@(#) lisp.c 1.8, (C) 1989, P. Fox");
X
Xint temporary_list = FALSE; /* Set to TRUE if a new list has been */
X /* stored in the list accumulator, and */
X /* we need to free its memory. */
XLIST *next_atom();
Xstatic void first_atom();
X
Xquote()
X{
X str_acc_assign(argv[1].l_list, length_of_list(argv[1].l_list));
X acc_type = F_LIST;
X return 0;
X}
Xis_type(type)
X{ SYMBOL *sp = argv[1].l_sym;
X
X if (type == F_NULL && argv[1].l_flags == F_LIST) {
X LIST *lp = sp->s_list;
X if (lp == NULL || lp[0] == F_HALT)
X accumulator = 1;
X else
X accumulator = 0;
X return;
X }
X accumulator = (int) argv[1].l_flags == type;
X}
Xcar()
X{
X first_atom(argv[1].l_list);
X}
X
Xstatic void
Xfirst_atom(lp)
Xregister LIST *lp;
X{ int len;
X
X if (null_list(lp))
X return;
X switch (*lp) {
X case F_INT:
X accumulator = LGET32(lp);
X return;
X case F_STR:
X case F_LIT: {
X char *cp = (char *) LGET32(lp);
X strl_acc_assign(cp);
X return;
X }
X case F_ID:
X strl_acc_assign(builtin[LGET16(lp)].name);
X return;
X case F_RSTR: {
X r_str *rp = (r_str *) LGET32(lp);
X str_acc_assign(rp->r_str, rp->r_used);
X/* acc_type = F_RSTR;*/
X return;
X }
X default:
X if (*lp != F_LIST) {
X errorf("car: empty list.");
X return;
X }
X }
X len = LGET16(lp);
X if (len == 0)
X len = length_of_list(lp);
X else
X len++;
X len -= sizeof_atoms[F_LIST];
X lp += sizeof_atoms[F_LIST];
X str_acc_assign(lp, len);
X saccumulator[len - 1] = F_HALT;
X acc_type = F_LIST;
X}
Xcdr()
X{ register LIST *lp = argv[1].l_list;
X int len;
X
X if (null_list(lp))
X return;
X lp = next_atom(lp);
X list_acc(lp, length_of_list(lp));
X}
Xnull_list(lp)
Xregister LIST *lp;
X{
X if (lp && *lp != F_HALT)
X return FALSE;
X list_acc((LIST *) NULL, 0);
X return TRUE;
X}
Xlist_length()
X{
X accumulator = list_lengthp(argv[1].l_list);
X return 0;
X}
Xlist_lengthp(lp)
Xregister LIST *lp;
X{ int len = 0;
X
X if (lp == NULL)
X return 0;
X while (*lp != F_HALT) {
X len++;
X if (*lp == F_LIST) {
X u_int16 i = LGET16(lp);
X if (i == 0)
X return len;
X lp += i;
X continue;
X }
X lp += sizeof_atoms[*lp];
X }
X return len;
X}
Xput_nth()
X{ int n = argv[1].l_int;
X SYMBOL *sp = argv[2].l_sym;
X LIST *lp = sp->s_list;
X LIST *newlp;
X LIST *lp1;
X int before, after;
X int bytes_to_insert, bytes_to_delete = 0;
X char buf[5];
X char *bufp;
X int length = length_of_list(sp->s_list);
X
X switch (argv[3].l_flags) {
X case F_LIST:
X bytes_to_insert = length_of_list(argv[3].l_list) + sizeof_atoms[F_LIST];
X bufp = (char *) argv[3].l_list;
X break;
X case F_STR:
X case F_LIT:
X argv[3].l_flags = F_RSTR;
X argv[3].l_rstr = r_init(argv[3].l_str);
X goto Default;
X case F_RSTR:
X r_inc(argv[3].l_rstr);
XDefault:
X default:
X bytes_to_insert = sizeof_atoms[(int) argv[3].l_flags];
X buf[0] = (int) argv[3].l_flags;
X bufp = buf;
X LPUT32(buf, argv[3].l_int);
X break;
X }
X if (lp == NULL) {
X sp->s_list = (LIST *) chk_alloc(bytes_to_insert + sizeof_atoms[F_HALT]);
X sp->s_list[bytes_to_insert] = F_HALT;
X if (argv[3].l_flags == F_LIST && after) {
X sp->s_list[0] = F_LIST;
X LPUT16(sp->s_list, bytes_to_insert);
X memcpy(sp->s_list + sizeof_atoms[F_LIST], bufp,
X bytes_to_insert - sizeof_atoms[F_LIST]);
X }
X else
X memcpy(sp->s_list, bufp, bytes_to_insert);
X return;
X }
X while (n-- > 0 && *lp != F_HALT) {
X if (*lp == F_LIST) {
X int i = LGET16(lp);
X if (i == 0)
X break;
X lp += i;
X }
X else
X lp += sizeof_atoms[*lp];
X }
X
X bytes_to_delete = sizeof_atoms[*lp];
X switch (*lp) {
X case F_HALT:
X case F_LIT:
X case F_STR:
X case F_ID:
X case F_INT:
X break;
X case F_RSTR:
X r_dec(LGET32(lp));
X break;
X case F_LIST:
X bytes_to_delete = LGET16(lp);
X for (lp1 = lp; lp1 < lp + bytes_to_delete; lp1 += sizeof_atoms[*lp1])
X if (*lp1 == F_RSTR)
X r_dec(LGET32(lp1));
X break;
X default:
X panic("put_nth");
X }
X
X before = lp - sp->s_list;
X after = length - before - bytes_to_delete;
X lp += bytes_to_delete;
X newlp = (LIST *) chk_alloc(before + bytes_to_insert + after + 1);
X if (before)
X memcpy(newlp, sp->s_list, before);
X if (argv[3].l_flags == F_LIST && after) {
X newlp[before] = F_LIST;
X LPUT16(newlp + before, bytes_to_insert);
X memcpy(newlp + before + sizeof_atoms[F_LIST], bufp,
X bytes_to_insert - sizeof_atoms[F_LIST]);
X }
X else {
X memcpy(newlp + before, bufp, bytes_to_insert);
X }
X if (after)
X memcpy(newlp + before + bytes_to_insert, lp, after);
X newlp[before + bytes_to_insert + after] = F_HALT;
X chk_free(sp->s_list);
X sp->s_list = newlp;
X}
Xappend()
X{ register LIST *lp1 = argv[1].l_sym->s_list;
X register LIST *lp2 = argv[2].l_list;
X LIST *new_list;
X int length1 = length_of_list(lp1);
X int length2 = length_of_list(lp2);
X int length = length1 + length2;
X
X if (length1 == 0) {
X str_acc_assign(lp2, length2);
X acc_type = F_LIST;
X return;
X }
X new_list = (LIST *) chk_alloc(length + 3);
X memcpy(new_list, lp1, length1);
X memcpy(new_list + length1 - 1, lp2, length2);
X temporary_list = TRUE;
X str_acc_assign(new_list, length + 3);
X chk_free(new_list);
X acc_type = F_LIST;
X}
Xtypeof()
X{
X if (argv[1].l_flags == F_NULL ||
X (argv[1].l_flags == F_STR && strcmp(argv[1].l_str, "NULL") == 0))
X strl_acc_assign("NULL");
X else if (argv[1].l_flags == F_INT)
X strl_acc_assign("integer");
X else if (argv[1].l_flags == F_STR)
X strl_acc_assign("string");
X else
X strl_acc_assign("list");
X}
Xstatic char **global_cp;
Xstatic void
Xmac_list2(sp, arg)
Xregister SPBLK *sp;
Xvoid *arg;
X{ MACRO *mp = (MACRO *) sp->data;
X *global_cp++ = mp->m_name;
X}
Xchar **
Xget_macro_list()
X{ extern int macro_cnt;
X extern SPTREE *macro_tbl;
X char **mac_list;
X
X if ((mac_list = (char **) chk_alloc(macro_cnt * sizeof (char *))) == NULL)
X return NULL;
X global_cp = mac_list;
X spapply(macro_tbl, mac_list2, global_cp);
X return mac_list;
X}
Xmacro_list()
X{ LIST *l_macs;
X int l_len;
X char **mac_list;
X extern int macro_cnt;
X register int i;
X register LIST *lp;
X
X if ((mac_list = get_macro_list()) == NULL) {
X accumulator = -1;
X return;
X }
X l_len = macro_cnt * sizeof_atoms[F_STR] + 2;
X if ((l_macs = (LIST *) chk_alloc(l_len)) == NULL) {
X accumulator = -1;
X chk_free(mac_list);
X return;
X }
X lp = l_macs;
X for (i = 0; i < macro_cnt; i++) {
X *lp = F_STR;
X LPUT32(lp, (long) mac_list[i]);
X lp += sizeof_atoms[F_STR];
X }
X *lp = F_HALT;
X str_acc_assign(l_macs, l_len);
X chk_free(l_macs);
X chk_free(mac_list);
X acc_type = F_LIST;
X}
Xcommand_list()
X{ static LIST *l_cmds = NULL;
X static int l_len;
X register LIST *lp;
X register BUILTIN *bp;
X extern int sizeof_builtin;
X extern int macro_cnt;
X int c_index, m_index;
X int len;
X char **mac_list;
X char **get_macro_list();
X char **cpp;
X
X l_len = (sizeof_builtin + macro_cnt) * sizeof_atoms[F_STR] + 2;
X if ((l_cmds = (LIST *) chk_alloc(l_len)) == NULL) {
X accumulator = -1;
X return;
X }
X if ((mac_list = get_macro_list()) == NULL) {
X accumulator = -1;
X chk_free(l_cmds);
X return;
X }
X lp = l_cmds;
X bp = builtin;
X cpp = mac_list;
X len = 0;
X c_index = m_index = 0;
X while (c_index < sizeof_builtin && m_index < macro_cnt) {
X int diff = strcmp(bp->name, *cpp);
X *lp = F_STR;
X if (diff < 0) {
X LPUT32(lp, (long) bp->name);
X bp++, c_index++;
X }
X else if (diff == 0) {
X LPUT32(lp, (long) bp->name);
X cpp++, m_index++, bp++, c_index++;
X }
X else {
X LPUT32(lp, (long) *cpp);
X cpp++, m_index++;
X }
X lp += sizeof_atoms[F_STR];
X len++;
X }
X while (c_index < sizeof_builtin) {
X *lp = F_STR;
X LPUT32(lp, (long) bp->name);
X lp += sizeof_atoms[F_STR];
X bp++, len++, c_index++;
X }
X while (m_index < macro_cnt) {
X *lp = F_STR;
X LPUT32(lp, (long) *cpp);
X lp += sizeof_atoms[F_STR];
X cpp++, len++, m_index++;
X }
X *lp = F_HALT;
X str_acc_assign(l_cmds, len * sizeof_atoms[F_STR] + 2);
X chk_free(l_cmds);
X chk_free(mac_list);
X acc_type = F_LIST;
X
X}
Xnth()
X{ LIST *lp = argv[2].l_list;
X int n = argv[1].l_int;
X
X while (n-- > 0 && lp)
X lp = next_atom(lp);
X first_atom(lp);
X}
XLIST *
Xnext_atom(lp)
Xregister LIST *lp;
X{
X if (*lp == F_HALT)
X return NULL;
X if (*lp == F_LIST) {
X int i = LGET16(lp);
X if (i == 0)
X return NULL;
X return lp + i;
X }
X return lp + sizeof_atoms[*lp];
X}
X
SHAR_EOF
chmod 0444 ./lisp.c || echo "restore of ./lisp.c fails"
mkdir . >/dev/null 2>&1
echo "x - extracting ./list.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ./list.c &&
X/**************************************************************
X *
X * CRISP - Custom Reduced Instruction Set Programmers Editor
X *
X * (C) Paul Fox, 1989
X * 43, Jerome Close Tel: +44 6284 4222
X * Marlow
X * Bucks.
X * England SL7 1TX
X *
X *
X * Please See COPYRIGHT notice.
X *
X **************************************************************/
X# include "list.h"
X
XSCCSID("@(#) list.c 1.8, (C) 1989 P. Fox");
X
XSPTREE *macro_tbl = NULL;
XHead_p macrof;
Xint macro_cnt = 0;
X
Xstruct f fps[MAX_FILES];
Xstruct f *fp_ptr;
Xint init_defined;
Xextern char yytext[];
X
Xinit_macros()
X{
X macro_tbl = spinit();
X}
Xmac_compare(m1, mac2)
Xregister char *m1;
XMACRO **mac2;
X{ register char *t = (*mac2)->m_name;
X for ( ; *m1 == *t; m1++, t++)
X if (*m1 == 0)
X return 0;
X return *m1 - *t;
X}
XMACRO *
Xlookup_macro(name)
Xchar *name;
X{
X SPBLK *sp = splookup(name, macro_tbl);
X if (sp)
X return (MACRO *) sp->data;
X return NULL;
X}
Xenter_macro()
X{ extern BUILTIN builtin[];
X return ins_macro(get_str(1), argv[2].l_list, 0);
X}
Xins_macro(name, list, flags)
Xchar *name;
XLIST *list;
X{ register MACRO *mptr;
X MACRO *mp_new;
X extern BUILTIN *lookup_builtin();
X extern int autoloading;
X BUILTIN *bp = lookup_builtin(name);
X
X if (mptr = lookup_macro(name)) {
X int f = mptr->m_flags & M_AUTOLOAD;
X if (f == 0) {
X if (bp == NULL)
X delete_macro(mptr->m_list);
X else {
X mp_new = (MACRO *) chk_alloc(sizeof (MACRO));
X mp_new->m_next = mptr;
X mptr = mp_new;
X mptr->m_flags = 0;
X bp->first_macro = mptr;
X bp->macro = mptr;
X bp->flags |= B_REDEFINE;
X }
X }
X }
X else {
X# if 0
X register MACRO **mp_end = ¯o_tbl[macro_cnt];
X MACRO **mp;
X register int i;
X if (macro_cnt >= MAX_MACROS-1)
X return -1;
X for (i = 0, mp = macro_tbl; mp < mp_end; mp++, i++) {
X int eq = strcmp(name, (*mp)->m_name);
X if (eq > 0)
X continue;
X while (i < macro_cnt) {
X mp_end[0] = mp_end[-1];
X i++;
X mp_end--;
X }
X break;
X }
X macro_cnt++;
X# endif
X SPBLK *sp = (SPBLK *) chk_alloc ( sizeof (MACRO) +
X sizeof (SPBLK));
X mptr = (MACRO *) (sp + 1);
X mptr->m_name = strdup(name);
X sp->key = mptr->m_name;
X sp->data = (char *) mptr;
X mptr->m_next = NULL;
X mptr->m_flags = 0;
X if (bp) {
X bp->first_macro = mptr;
X bp->macro = mptr;
X bp->flags |= B_REDEFINE;
X }
X spenq(sp, macro_tbl);
X macro_cnt++;
X }
X mptr->m_ftime = TRUE;
X mptr->m_list = list;
X mptr->m_flags = (u_int16) flags;
X init_defined |= strcmp(name, "_init") == 0;
X return 0;
X}
Xdelete_macro(list)
Xregister LIST *list;
X{
X return 0;
X}
X
Xvoid
Xstartupfile()
X{ char *ggetenv();
X char *bpath = ggetenv("BPATH");
X extern int autoloading;
X
X autoloading = TRUE;
X
X /*----------------------------------
X * Initialise head of macro file list.
X *----------------------------------*/
X macrof = ll_init();
X
X fp_ptr = &fps[0]-1;
X
X if (bpath == NULL || strcmp(bpath, "/") == 0)
X bpath = NULL;
X
X str_exec("crisp");
X str_exec("startup");
X
X autoloading = FALSE;
X}
Xread_macro(file_name)
Xchar *file_name;
X{ int len = strlen(file_name);
X int ret;
X char buf[128];
X char *cp = file_name;
X int noext = strcmp(file_name + len - 3, ".cm") != 0 &&
X strcmp(file_name + len - 2, ".m") != 0;
X
X if (noext) {
X sprintf(buf, "%s.cm", file_name);
X cp = buf;
X }
X
X if ((ret = read_macro1(cp)) >= 0)
X return ret;
X if (!noext)
X return -1;
X sprintf(buf, "%s.m", file_name);
X return read_macro1(buf);
X}
Xread_macro1(filename)
Xchar *filename;
X{ int ret;
X
X if (init_fp(TERMINAL, filename) >= 0) {
X init_defined = FALSE;
X ret = yyparse();
X if (init_defined)
X str_exec("_init");
X return ret ? 1 : 0;
X }
X return -1;
X}
SHAR_EOF
chmod 0444 ./list.c || echo "restore of ./list.c fails"
mkdir . >/dev/null 2>&1
echo "x - extracting ./m_buf.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ./m_buf.c &&
X/**************************************************************
X *
X * CRISP - Custom Reduced Instruction Set Programmers Editor
X *
X * (C) Paul Fox, 1989
X * 43, Jerome Close Tel: +44 6284 4222
X * Marlow
X * Bucks.
X * England SL7 1TX
X *
X *
X * Please See COPYRIGHT notice.
X *
X **************************************************************/
X# include "list.h"
X
XSCCSID("@(#) m_buf.c 1.17, (C) P. Fox");
X
X# define RIGHT 1
X# define DOWN 2
X# define LEFT 3
X# define UP 4
X
XWINDOW *get_window();
XWINDOW *get_edge();
Xextern char *bname();
XHead_p hd_position; /* save/restore position */
X
Xextern BUFFER *numberb();
Xstruct pos {
X int buffer;
X short line;
X short col;
X int top_line;
X };
Xcreate_buffer()
X{
X register BUFFER *bp;
X extern char *filename();
X char *name = filename(get_str(1));
X int new_buffer = bfind(name, FALSE) == NULL;
X
X accumulator = -1;
X
X bp = bfind(name, TRUE);
X bp->b_system =
X (argv[3].l_flags == F_NULL ? (short) 0 : (short) argv[3].l_int);
X accumulator = bp->b_bufnum;
X
X bp->b_title = strdup(get_str(1));
X bclear(bp);
X if (argv[2].l_flags != F_NULL /*&& new_buffer*/) {
X readin(bp, get_str(2));
X strcpy(bp->b_fname, get_str(2));
X bp->b_line = bp->b_col = 1;
X }
X bp->b_flag |= BFREAD;
X return 0;
X}
Xdel_buffer()
X{
X killbuffer((u_int16) argv[1].l_int);
X/* curbp = curwp->w_bufp;*/
X}
Xinq_buffer()
X{
X accumulator = curbp->b_bufnum;
X}
Xset_buffer_flags()
X{ int bchg = curbp->b_flag & BFCHG;
X
X if (argv[1].l_flags == F_INT) {
X curbp->b_flag &= argv[1].l_int;
X if (bchg && (curbp->b_flag & BFCHG) == 0)
X curbp->b_nummod = 0;
X }
X if (argv[2].l_flags == F_INT)
X curbp->b_flag |= argv[2].l_int;
X}
Xinq_modified()
X{
X
X if (argv[1].l_flags == F_NULL)
X accumulator = curbp->b_nummod;
X else
X accumulator = numberb((u_int16) argv[1].l_int)->b_nummod;
X return 0;
X}
Xnext_buffer()
X{ BUFFER *bp;
X extern BUFFER *scrap_bp;
X int sysbufs = argv[1].l_flags == F_NULL ? 0 : argv[1].l_int;
X
X for (bp = curbp->b_bufp;; bp = bp->b_bufp) {
X if (bp == NULL)
X bp = bheadp;
X if (bp == scrap_bp && !sysbufs)
X continue;
X if (bp == curbp || bp->b_system == 0 || sysbufs)
X break;
X }
X accumulator = bp->b_bufnum;
X return 0;
X}
Xset_buffer()
X{ BUFFER *bp;
X
X if ((bp = numberb((u_int16) argv[1].l_int)) == NULL) {
X ewprintf("set_buffer: no such buffer");
X accumulator = -1;
X return;
X }
X
X if (curbp)
X accumulator = curbp->b_bufnum;
X else
X accumulator = 0;
X if (curwp->w_bufp == curbp && curbp) {
X curbp->b_line = curwp->w_line;
X curbp->b_col = curwp->w_col;
X curbp->b_top = curwp->w_top_line;
X }
X curbp = bp;
X set_hooked();
X}
Xdetach_buffer(wp)
XWINDOW *wp;
X{ BUFFER *bp = wp->w_bufp;
X
X if (bp) {
X bp->b_nwnd--;
X wp->w_bufp = NULL;
X bp->b_line = wp->w_line;
X bp->b_col = wp->w_col;
X bp->b_top = wp->w_top_line;
X }
X}
Xget_dir(str)
Xchar *str;
X{ unsigned char buf[32];
X
X int i = (int) argv[1].l_int;
X
X if (argv[1].l_flags == F_INT)
X return (i >= 1 && i <= 4) ? i : 0;
X
X while (1) {
X if (ereply("%s%s", buf, 1, str, " (use cursor keys)") == ABORT)
X return 0;
X
X switch (buf[0]) {
X case KEY_UP: return UP;
X case KEY_DOWN: return DOWN;
X case KEY_LEFT: return LEFT;
X case KEY_RIGHT: return RIGHT;
X }
X }
X}
Xcre_edge()
X{
X register int i = get_dir("Select side for new window");
X WINDOW *vsplitwind();
X WINDOW *splitwind();
X WINDOW *wp;
X
X accumulator = 0;
X
X if (i == 0)
X return -1;
X if (i == LEFT || i == RIGHT)
X wp = vsplitwind();
X else
X wp = splitwind();
X
X if (wp && (i == RIGHT || i == DOWN))
X curwp = wp;
X accumulator = 1;
X return 0;
X}
Xdel_edge()
X{ register int i = get_dir("Select window edge to delete");
X WINDOW *adj_wp;
X WINDOW *nwp;
X
X accumulator = 1;
X
X if ((adj_wp = get_edge(i)) == NULL)
X return 0;
X
X if (i == UP) {
X curwp->w_y = adj_wp->w_y;
X curwp->w_h += adj_wp->w_h + 1;
X }
X else if (i == DOWN) {
X curwp->w_h += adj_wp->w_h + 1;
SHAR_EOF
echo "End of part 6"
echo "File ./m_buf.c is continued in part 7"
echo "7" > s2_seq_.tmp
exit 0
--
===================== Reuters Ltd PLC,
Tel: +44 628 891313 x. 212 Westthorpe House,
UUCP: fox%marlow.uucp@idec.stc.co.uk Little Marlow,
Bucks, England SL7 3RQ