allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc) (07/23/89)
Posting-number: Volume 7, Issue 44
Submitted-by: fox@marlow.UUCP (Paul Fox)
Archive-name: crisp1.9/part24
#!/bin/sh
# this is part 3 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file ./anchor.c continued
#
CurArch=3
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 ./anchor.c"
sed 's/^X//' << 'SHAR_EOF' >> ./anchor.c
X
Xint start_line, start_col;
Xint end_line, end_col;
Xint mark_type;
X
Xdrop_anchor()
X{
X ANCHOR *ap = (ANCHOR *) chk_alloc(sizeof (ANCHOR));
X int previous_anchor = curbp->b_alist != NULL;
X
X u_raise();
X ap->a_line = *cur_line;
X ap->a_offset = *cur_col;
X ap->a_type = argv[1].l_flags == F_NULL ?
X (u_int16) MK_NORMAL :
X (u_int16) (argv[1].l_int & 0xffff);
X ll_push(curbp->b_alist, (char *) ap);
X curbp->b_anchor = ap;
X win_modify(previous_anchor ? WFHARD : WFMOVE);
X return 0;
X}
Xraise_anchor()
X{
X accumulator = 0;
X if (curbp->b_anchor == NULL)
X return 0;
X u_drop();
X accumulator = 1;
X if (ll_pop(curbp->b_alist))
X curbp->b_anchor = (ANCHOR *) ll_elem(ll_first(curbp->b_alist));
X else
X curbp->b_anchor = NULL;
X win_modify(WFHARD);
X return 0;
X}
Xmark()
X{
X if (curbp->b_anchor)
X raise_anchor();
X else
X drop_anchor();
X return 0;
X}
Xwrite_block()
X{ char *cp;
X FILE *fp;
X char buf[BUFSIZ];
X char *open_mode = argv[2].l_flags == F_NULL ? "w" :
X argv[2].l_int == 0 ? "w" : "a";
X accumulator = 0;
X if (check_mark())
X return;
X
X cp = get_arg1("Write marked area as: ", buf, sizeof buf);
X if (cp == NULL)
X return;
X if ((fp = fopen(cp, open_mode)) == NULL) {
X ewprintf("Write failed.");
X accumulator = -1;
X return;
X }
X copyregion(fp);
X fclose(fp);
X raise_anchor();
X accumulator = 1;
X
X}
Xinq_marked()
X{
X accumulator = 0;
X if (get_marked_areas((WINDOW *) NULL)) {
X accumulator = mark_type;
X if (argv[1].l_flags != F_NULL)
X int_assign(argv[1].l_sym, (long) start_line);
X if (argv[2].l_flags != F_NULL)
X int_assign(argv[2].l_sym, (long) start_col);
X if (argv[3].l_flags != F_NULL)
X int_assign(argv[3].l_sym, (long) end_line);
X if (argv[4].l_flags != F_NULL) {
X if (mark_type == MK_LINE)
X end_col = get_longest_line();
X int_assign(argv[4].l_sym, (long) end_col);
X }
X }
X return 0;
X}
Xget_longest_line()
X{
X int ln = start_line;
X int max_ecol = 0;
X int old_cur_line = *cur_line;
X int col;
X
X while (ln <= end_line) {
X LINE *lp = linep(ln);
X *cur_line = ln++;
X col = current_col(llength(lp));
X if (col > max_ecol)
X max_ecol = col;
X }
X *cur_line = old_cur_line;
X return max_ecol;
X}
Xswap_anchor()
X{
X int col = *cur_col;
X
X if (curbp->b_anchor) {
X *cur_line = curbp->b_anchor->a_line;
X curbp->b_anchor->a_line = *cur_line;
X *cur_col = curbp->b_anchor->a_offset;
X curbp->b_anchor->a_offset = col;
X }
X return 0;
X}
Xget_marked_areas(wp)
XWINDOW *wp;
X{ ANCHOR *ap;
X int tmpl;
X
X if (wp == NULL)
X ap = curbp->b_anchor;
X else
X ap = wp->w_bufp->b_anchor;
X if (ap == NULL) {
X start_line = *cur_line;
X end_line = curbp->b_numlines;
X return FALSE;
X }
X mark_type = ap->a_type;
X start_line = ap->a_line;
X start_col = ap->a_offset;
X end_line = wp ? wp->w_line : *cur_line;
X end_col = wp ? wp->w_col : *cur_col;
X
X if (mark_type == MK_COLUMN) {
X if (start_line > end_line)
X SWAP(start_line, end_line, tmpl);
X if (start_col > end_col)
X SWAP(start_col, end_col, tmpl);
X return TRUE;
X }
X if (start_line > end_line) {
X SWAP(start_line, end_line, tmpl);
X SWAP(start_col, end_col, tmpl);
X }
X if (start_line == end_line && start_col > end_col)
X SWAP(start_col, end_col, tmpl);
X if (mark_type == MK_LINE) {
X end_col = 32767;
X start_col = 1;
X }
X else if (mark_type == MK_NONINC)
X end_col--;
X return TRUE;
X}
SHAR_EOF
echo "File ./anchor.c is complete"
chmod 0444 ./anchor.c || echo "restore of ./anchor.c fails"
mkdir . >/dev/null 2>&1
echo "x - extracting ./basic.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ./basic.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("@(#) basic.c 1.5, (C) P. Fox");
X/*
X * Go to beginning of line.
X */
X/*ARGSUSED*/
Xbeginning_of_line()
X{
X u_dot();
X *cur_col = 1;
X win_modify(WFMOVE);
X return 0;
X}
X
X/*
X * Go to end of line.
X */
Xend_of_line()
X{ register LINE *lp = linep(*cur_line);
X u_dot();
X
X *cur_col = current_col(llength(lp));
X win_modify(WFMOVE);
X return 0;
X}
Xnext_char()
X{ int n = argv[1].l_flags == F_INT ? argv[1].l_int : 1;
X
X if (n < 0) {
X argv[1].l_int = -n;
X prev_char();
X return;
X }
X u_dot();
X win_modify(WFMOVE);
X while (n > 0 && *cur_line != curbp->b_numlines) {
X LINE *lp = linep(*cur_line);
X int offset = current_offset(*cur_col, FALSE);
X
X if (n + offset <= llength(lp)) {
X *cur_col = current_col(offset + n);
X break;
X }
X n -= llength(lp) - offset + 1;
X *cur_col = 1;
X (*cur_line)++;
X }
X win_modify(WFMOVE);
X accumulator = 1;
X return;
X}
Xprev_char()
X{ int offset;
X LINE *lp;
X int n = argv[1].l_flags == F_INT ? argv[1].l_int : 1;
X
X if (n < 0) {
X argv[1].l_int = -n;
X next_char();
X return;
X }
X if (*cur_col == 1 && *cur_line == 1) {
X accumulator = 0;
X return;
X }
X
X offset = current_offset(*cur_col, FALSE);
X u_dot();
X win_modify(WFMOVE);
X while (n > 0) {
X if (offset > n) {
X offset -= n;
X n = 0;
X }
X else if (offset) {
X n -= offset;
X offset = 0;
X }
X else {
X if (*cur_line == 1)
X break;
X (*cur_line)--;
X lp = linep(*cur_line);
X offset = lp->l_used;
X n--;
X }
X }
X accumulator = 1;
X win_modify(WFMOVE);
X *cur_col = current_col(offset);
X return;
X}
X/*
X * Move cursor forwards. Do the
X * right thing if the count is less than
X * 0.
X */
Xforwchar(n)
X{ int col = *cur_col;
X
X u_dot();
X *cur_col += n;
X if (*cur_col < 1)
X *cur_col = 1;
X if (col != *cur_col) {
X accumulator = 1;
X win_modify(WFMOVE);
X }
X else
X accumulator = 0;
X return 0;
X}
X/*
X * Move cursor backwards. Do the
X * right thing if the count is less than
X * 0. Error if you try to move back from
X * the beginning of the buffer.
X */
Xbackchar(n)
X{
X u_dot();
X win_modify(WFMOVE);
X if (*cur_col == 1 && *cur_line > 1) {
X (*cur_line)--;
X return end_of_line();
X }
X return forwchar(-n);
X}
X
X
X/*
X * Go to the beginning of the
X * buffer.
X */
Xgotobob()
X{
X u_dot();
X win_modify(WFMOVE);
X *cur_col = *cur_line = 1;
X win_modify(WFMOVE);
X return 0;
X}
X
X/*
X * Go to the end of the buffer.
X */
Xgotoeob()
X{ int n;
X
X u_dot();
X win_modify(WFMOVE);
X *cur_line = curbp->b_numlines;
X if (*cur_line > 1)
X (*cur_line)--;
X n = end_of_line();
X if (hooked)
X set_buffer_bottom(curwp);
X return n;
X}
X
X/*
X * Move forward by full lines.
X * If the number of lines to move is less
X * than zero, call the backward line function to
X * actually do it. The last command controls how
X * the goal column is set.
X */
Xforwline(n)
X{
X int old_line = *cur_line;
X
X u_dot();
X win_modify(WFMOVE);
X if (n < 0 && *cur_line + n < 1)
X *cur_line = 1;
X else if (*cur_line + n > numlines())
X *cur_line = numlines();
X else
X *cur_line += n;
X accumulator = *cur_line != old_line;
X win_modify(WFMOVE);
X return 0;
X}
X
Xbackline(n)
X{
X return forwline(-n);
X}
Xnumlines()
X{
X return curbp->b_numlines;
X}
Xpage_down()
X{
X forwline(curwp->w_h);
X return 0;
X}
X
Xpage_up()
X{
X backline(curwp->w_h);
X return 0;
X}
Xgotoline(n)
X{
X
X u_dot();
X win_modify(WFMOVE);
X
X *cur_col = 1;
X *cur_line = 1;
X return forwline(n - 1);
X}
Xdist_to_tab()
X{
X accumulator = next_tab_stop(*cur_col) - *cur_col + 1;
X/* assert(accumulator >= 0);*/
X return 0;
X}
SHAR_EOF
chmod 0444 ./basic.c || echo "restore of ./basic.c fails"
mkdir . >/dev/null 2>&1
echo "x - extracting ./bookmark.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ./bookmark.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("@(#) bookmark.c 1.2, (C) P. Fox");
X# define MAX_BOOKMARKS 10
X
Xstruct bookmark {
X u_int16 b_buffer;
X int b_line;
X int b_col;
X int b_ref;
X } bookmarks[MAX_BOOKMARKS];
X
Xdrop_bookmark()
X{ struct bookmark *bk;
X
X if (argv[1].l_int == 0)
X argv[1].l_int = 10;
X if (argv[1].l_int < 1 || argv[1].l_int > MAX_BOOKMARKS) {
X ewprintf("drop_bookmark: invalid bookmark.");
X return 0;
X }
X
X bk = &bookmarks[argv[1].l_int - 1];
X if (argv[3].l_flags == F_INT && argv[4].l_flags == F_INT &&
X argv[5].l_flags == F_INT) {
X bk->b_buffer = argv[3].l_int;
X bk->b_line = argv[4].l_int;
X bk->b_col = argv[5].l_int;
X }
X else {
X bk->b_buffer = curbp->b_bufnum;
X bk->b_line = *cur_line;
X bk->b_col = *cur_col;
X }
X bk->b_ref = TRUE;
X infof("Bookmark dropped.");
X return 0;
X}
Xgoto_bookmark()
X{
X struct bookmark *bk;
X int move = TRUE;
X long book_no;
X
X accumulator = 0;
X if (get_iarg1("Go to bookmark [1-10]: ", &book_no))
X return 0;
X
X if (book_no == 0)
X book_no = 10;
X if (book_no < 1 || book_no > MAX_BOOKMARKS) {
X ewprintf("goto_bookmark: invalid bookmark.");
X return 0;
X }
X
X bk = &bookmarks[book_no - 1];
X if (bk->b_ref == FALSE)
X return 0;
X if (argv[2].l_flags != F_NULL) {
X move = FALSE;
X int_assign(argv[2].l_sym, (long) bk->b_buffer);
X }
X if (argv[3].l_flags != F_NULL) {
X move = FALSE;
X int_assign(argv[3].l_sym, (long) bk->b_line);
X }
X if (argv[4].l_flags != F_NULL) {
X move = FALSE;
X int_assign(argv[4].l_sym, (long) bk->b_col);
X }
X
X if (move) {
X WINDOW *wp;
X for (wp = wheadp; wp; wp->w_wndp)
X if (wp->w_bufp->b_bufnum == bk->b_buffer)
X break;
X if (wp == NULL) {
X BUFFER *bp = numberb(bk->b_buffer);
X if (bp == NULL) {
X ewprintf("goto_bookmark: no such buffer.");
X return 0;
X }
X showbuffer(bp, curwp);
X curbp = bp;
X }
X else {
X curwp = wp;
X curbp = curwp->w_bufp;
X }
X argv[1].l_int = bk->b_line;
X argv[2].l_int = bk->b_col;
X move_abs();
X }
X accumulator = 1;
X return 0;
X}
SHAR_EOF
chmod 0444 ./bookmark.c || echo "restore of ./bookmark.c fails"
mkdir . >/dev/null 2>&1
echo "x - extracting ./buffer.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ./buffer.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("@(#) buffer.c 1.14, (C) P. Fox");
X
XBUFFER *
Xnumberb(n)
Xu_int16 n;
X{
X register BUFFER *bp;
X
X for (bp = bheadp; bp; bp = bp->b_bufp)
X if (bp->b_bufnum == n)
X return bp;
X return (BUFFER *) NULL;
X}
X/*
X * Dispose of a buffer, by name.
X */
Xkillbuffer(n)
Xu_int16 n;
X{
X register BUFFER *bp;
X register BUFFER *bp1;
X register WINDOW *wp;
X extern BUFFER *numberb();
X
X if ((bp = numberb(n)) == NULL)
X return FALSE;
X
X if (bclear(bp) != TRUE)
X return TRUE;
X p_cleanup(bp);
X if (bp->b_nwnd != 0) {
X for (wp = wheadp; wp && bp->b_nwnd; wp = wp->w_wndp) {
X if (wp->w_bufp == bp) {
X --bp->b_nwnd;
X wp->w_bufp = NULL;
X }
X }
X }
X if (bp->b_title)
X chk_free(bp->b_title);
X ll_clear(bp->b_register);
X ll_free(bp->b_register);
X ll_free(bp->b_alist);
X delete_buffer_symbols(bp);
X free_line(bp->b_linep);
X if (bheadp == bp)
X bheadp = bp->b_bufp;
X else {
X for (bp1 = bheadp; bp1 && bp1->b_bufp != bp; )
X bp1 = bp1->b_bufp;
X if (bp1)
X bp1->b_bufp = bp->b_bufp;
X }
X
X chk_free((char *) bp);
X if (curbp == bp)
X curbp = NULL;
X return (TRUE);
X}
X
X
X
X/*
X * Look through the list of buffers, giving the user
X * a chance to save them. Return TRUE if there are
X * any changed buffers afterwards. Buffers that don't
X * have an associated file don't count. Return FALSE
X * if there are no changed buffers.
X */
Xanycb()
X{
X register BUFFER *bp;
X int nbuf = 0;
X char buf[80];
X char reply[4];
X extern BUFFER *scrap_bp;
X
X for (bp = bheadp; bp != NULL; bp = bp->b_bufp)
X if (*bp->b_fname && bp->b_nummod && bp->b_system == 0 && bp != scrap_bp)
X nbuf++;
X
X if (nbuf == 0)
X return FALSE;
X (void) sprintf(buf, "%d buffer%s not been saved. Exit [ynw]? ",
X nbuf, nbuf == 1 ? " has" : "s have");
X
X reply[0] = NULL;
X ereply(buf, reply, 1);
X if (reply[0] == 'Y' || reply[0] == 'y')
X return FALSE;
X if (reply[0] != 'W' && reply[0] != 'w')
X return TRUE;
X
X for (bp = bheadp; bp != NULL; bp = bp->b_bufp)
X if (*bp->b_fname && bp->b_nummod && bp->b_system == 0 && bp != scrap_bp)
X writeout(bp, bp->b_fname, TRUE, FALSE);
X return FALSE;
X}
Xchar *
Xfilename(fn)
Xchar *fn;
X{ static char buf[NFILEN];
X register char *cp;
X extern char *get_cwd();
X extern char *sys_delim();
X
X for (cp = fn; *cp; )
X if (*cp == '/' && cp[1] == '/')
X strcpy(cp, cp+1);
X else
X cp++;
X# if defined(VMS)
X {char buf1[256];
X if (strchr(fn, '/') != NULL)
X fn = sys_fname_unix_to_vms(fn, buf1, sizeof buf1);
X if (strchr(fn, ':') != NULL)
X return fn;
X }
X# endif
X if (fn[0] == '/')
X return fn;
X cp = get_cwd();
X if (cp[0] == '/' && cp[1] == NULL)
X sprintf(buf, "/%s", fn);
X else
X sprintf(buf, "%s%s%s", cp, sys_delim(), fn);
X# if defined(VMS)
X {char *vms_filename_canon();
X return vms_filename_canon(buf);
X }
X# else
X /*-----------------------------------------
X * Map dir/./file to dir/file, and
X * dir1/dir2/../file to dir1/file.
X *-----------------------------------------*/
Xagain:
X for (cp = buf; *cp; cp++) {
X if (*cp == '/' && cp[1] == '.' && cp[2] == '/') {
X strcpy(cp, cp+2);
X goto again;
X }
X if (*cp == '/' && cp[1] == '.' && cp[2] == '.' && cp[3] == '/') {
X char *cp1;
X if (cp == buf) {
X strcpy(buf, cp+3);
X goto again;
X }
X for (cp1 = cp - 1; cp1 >= buf; cp1--)
X if (*cp1 == '/')
X break;
X strcpy(cp1, cp+3);
X goto again;
X }
X }
X return buf;
X# endif
X}
Xinq_file_buffer()
X{ BUFFER *bp = bfind(get_str(1), FALSE);
X
X if (bp == NULL)
X accumulator = 0;
X else
X accumulator = bp->b_bufnum;
X}
X/*
X * Search for a buffer, by name.
X * If not found, and the "cflag" is TRUE,
X * create a buffer and put it in the list of
X * all buffers. Return pointer to the BUFFER
X * block for the buffer.
X */
XBUFFER *
Xbfind(buffer_name, cflag)
Xregister char *buffer_name;
X{
X register BUFFER *bp;
X register LINE *lp;
X register BUFFER *bp1;
X u_int16 i;
X static u_int16 buffer_number = 0;
X static BUFFER null_buffer = {0};
X
X for (bp = bheadp; bp; bp = bp->b_bufp)
X if (strcmp(buffer_name, bp->b_fname) == 0)
X return bp;
X
X if (!cflag)
X return NULL;
X /*NOSTRICT*/
X if ((bp= (BUFFER *) chk_alloc(sizeof(BUFFER))) == NULL) {
X ewprintf("Can't get %d bytes", sizeof(BUFFER));
X return NULL;
X }
X if ((lp=lalloc((RSIZE) 0)) == NULL) {
X chk_free((char *) bp);
X return NULL;
X }
X *bp = null_buffer;
X strcpy(bp->b_fname, filename(buffer_name));
X bp->b_alist = ll_init();
X bp->b_syms = spinit();
X bp->b_register = ll_init();
X# ifdef S_IRUSR
X bp->b_mode = S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH;
X# else
X bp->b_mode = 0644;
X# endif
X bp->b_bufnum = ++buffer_number;
X bp->b_linep = lp;
X bp->b_numlines = bp->b_line = bp->b_col = 1;
X for (i = 0; i < NTABS; i++)
X bp->b_tabs[i] = i*8;
X lp->l_fp = lp;
X lp->l_bp = lp;
X
X if (bheadp == NULL)
X bheadp = bp;
X else {
X for (bp1 = bheadp; bp1->b_bufp; )
X bp1 = bp1->b_bufp;
X bp1->b_bufp = bp;
X }
X
X return (bp);
X}
X
Xbclear(bp)
Xregister BUFFER *bp;
X{
X bp->b_flag &= ~(BFCHG|BFRO);
X while (bp->b_numlines > 1)
X lfree(bp, 1);
X
X bp->b_line = bp->b_col = 1;
X
X while (ll_pop(bp->b_alist))
X ;
X return TRUE;
X}
X
X/*
X * Display the given buffer in the given window.
X */
Xshowbuffer(bp, wp)
Xregister BUFFER *bp;
Xregister WINDOW *wp;
X{
X register WINDOW *owp;
X
X if (wp->w_bufp == bp) { /* Easy case! */
X wp->w_flag |= WFHARD;
X return;
X }
X
X detach_buffer(wp);
X wp->w_bufp = bp;
X wp->w_old_line = 1;
X
X w_title(wp, bname(bp->b_fname), "");
X
X if (bp->b_nwnd++ == 0) { /* First use. */
X set_window_parms(wp, bp);
X return;
X }
X
X wp->w_flag |= WFHARD;
X /* already on screen, steal values from other window */
X for (owp = wheadp; owp; owp = owp->w_wndp)
X if (owp->w_bufp == bp && owp != wp) {
X wp->w_top_line = owp->w_top_line; /* PDF */
X wp->w_line = owp->w_line;
X wp->w_col = owp->w_col;
X wp->w_old_line = owp->w_old_line;
X break;
X }
X}
Xset_window_parms(wp, bp)
Xregister WINDOW *wp;
Xregister BUFFER *bp;
X{
X wp->w_flag |= WFHARD;
X wp->w_top_line = bp->b_top;
X wp->w_line = bp->b_line;
X wp->w_col = bp->b_col;
X if (wp->w_line - wp->w_top_line >= wp->w_h)
X wp->w_top_line = wp->w_line;
X}
Xset_buffer_parms(wp, bp)
Xregister WINDOW *wp;
Xregister BUFFER *bp;
X{
X bp->b_line = wp->w_line;
X bp->b_col = wp->w_col;
X bp->b_top = wp->w_top_line;
X}
Xinq_buffer_flags()
X{
X BUFFER *bp = argv[1].l_flags == F_INT ?
X numberb(argv[1].l_int) : curbp;
X
X if (bp == NULL)
X accumulator = -1;
X else {
X accumulator = bp->b_flag & 0xff;
X if (bp->b_display)
X accumulator |= BFPROC;
X accumulator &= ~BFCHG;
X if (curbp->b_nummod)
X accumulator |= BFCHG;
X }
X}
SHAR_EOF
chmod 0444 ./buffer.c || echo "restore of ./buffer.c fails"
mkdir . >/dev/null 2>&1
echo "x - extracting ./builtin.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ./builtin.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"
XSCCSID("@(#) builtin.c 1.8, (C) P. Fox");
X
X# define ERROR -1
X# define EXECUTE -2
Xint action;
X
Xstatic LIST f_halt = F_HALT;
XLISTV *argv;
Xint argc;
Xint hooked;
Xint *cur_line;
Xint *cur_col;
Xextern int break_flag;
Xchar *command_name; /* Name of macro primitive currently being */
X /* executed. */
Xint autoloading = FALSE; /* TRUE if autoloading a macro - avoids the */
X /* 'macro successfully loaded' message */
X /* being printed. */
Xint doing_return = FALSE; /* Set to TRUE when a 'return' is executed.*/
X
Xvoid set_hooked();
Xextern int ctrl_c;
X
Xvoid
Xeval_expr(lp)
XLISTV *lp;
X{
X if (lp->l_flags == F_INT)
X accumulator = lp->l_int;
X else if (lp->l_flags == F_LIST)
X (void) execute_macro(lp->l_list);
X else
X ewprintf("Internal evaluation error");
X}
Xstr_exec(str)
Xchar *str;
X{
X register char *cp = str;
X char buf[256];
X char *dp = buf;
X extern char *strtok();
X int i;
X# define LIST_BUF_SIZE 128
X LIST lp[LIST_BUF_SIZE];
X LIST *lp1;
X
X while (isspace(*cp))
X cp++;
X lp[0] = F_STR;
X LPUT32(lp, (long) dp);
X lp1 = lp + 5;
X while (*cp && !isspace(*cp))
X *dp++ = *cp++;
X *dp++ = NULL;
X while (*cp) {
X while (isspace(*cp))
X cp++;
X if (*cp == NULL)
X break;
X if (lp1 >= &lp[LIST_BUF_SIZE-10]) {
X ewprintf("Out of space in str_exec");
X return 0;
X }
X if (*cp == '-' || (*cp >= '0' && *cp <= '9')) {
X *lp1 = F_INT;
X LPUT32(lp1, (long) atoi(cp));
X while (*cp && *cp != ' ' && *cp != '\t')
X cp++;
X }
X else {
X register char *cp1;
X char ch_term = ' ';
X
X if (*cp == '"')
X ch_term = '"', cp++;
X cp1 = cp;
X
X while (*cp) {
X if (*cp == '\\')
X cp++;
X else if (*cp == ch_term)
X break;
X cp++;
X }
X
X *lp1 = F_LIT;
X LPUT32(lp1, (long) dp);
X for (cp = cp1; *cp && *cp != ch_term; ) {
X/* if (*cp == '\\')
X ++cp;*/
X *dp++ = *cp++;
X }
X
X *dp++ = NULL;
X if (*cp)
X cp++;
X }
X lp1 += 5;
X }
X *lp1 = F_HALT;
X i = nexecute_macro(lp);
X return i;
X}
Xnexecute_macro(lp)
XLIST *lp;
X{
X if (++nest_level >= MAX_NESTING)
X panic("Macro nesting overflow.");
X execute_macro(lp);
X delete_local_symbols();
X}
Xexecute_macro(lp)
Xregister LIST *lp;
X{ static int handling_ctrlc = FALSE;
X u_int16 i;
X
X while (*lp == F_LIST) {
X if (ctrl_c && !handling_ctrlc) {
X handling_ctrlc = TRUE;
X trigger(REG_CTRLC);
X ctrl_c = FALSE;
X handling_ctrlc = FALSE;
X }
X execute_macro(lp + sizeof_atoms[*lp]);
X if (break_flag || doing_return)
X return;
X if ((i = LGET16(lp)) == 0)
X return;
X lp += i;
X }
X if (*lp == F_HALT)
X return;
X trace_list(lp);
X exec1(lp, lp + sizeof_atoms[*lp]);
X}
Xexec1(lp_0, lp_argv)
Xregister LIST *lp_0;
XLIST *lp_argv;
X{
X register BUILTIN *bp;
X char *macro_name;
X register MACRO *mptr;
X int saved_msg_level;
X int loop_count;
X MACRO *saved_macro;
X int opc = *lp_0;
X
X if (opc == F_ID)
X bp = &builtin[LGET16(lp_0)];
X else if (opc == F_INT) {
X acc_type = F_INT;
X accumulator = LGET32(lp_0);
X return;
X }
X else if (opc == F_LIT) {
X strl_acc_assign((char *) LGET32(lp_0));
X return;
X }
X else {
X char *str = opc == F_RSTR ? ((r_str *) LGET32(lp_0))->r_str
X : (char *) LGET32(lp_0);
X bp = lookup_builtin(str);
X }
X
X
X if (bp) {
X if (bp->flags & B_REDEFINE) {
X if (bp->macro == NULL) {
X bp->macro = bp->first_macro;
X goto hell;
X }
X if (bp->macro == bp->first_macro)
X bp->argv = lp_argv;
X mptr = saved_macro = bp->macro;
X bp->macro = bp->macro->m_next;
X macro_name = bp->name;
X goto exec_macro;
X }
X else {
Xhell: if (bp->func == NULL) {
X trace_log("*** Not yet implemented - %s ***\n",
X bp->name);
X return;
X }
X eval_args(bp, lp_argv);
X bp->argv = &f_halt;
X return;
X }
X }
X /*-------------------------------------------------*/
X /* Lookup-defined macros. */
X /*-------------------------------------------------*/
X macro_name = opc == F_ID ? builtin[LGET16(lp_0)].name :
X (char *) LGET32(lp_0);
X for (loop_count = 0; loop_count < 2; loop_count++) {
X if (bp)
X mptr = saved_macro;
X else
X mptr = lookup_macro(macro_name);
X if (mptr)
X break;
X if (ld_macro(macro_name)) {
X extern int m_flag;
Xundefined_macro:
X if (m_flag == FALSE)
X errorf("%s undefined.", macro_name);
X return;
X }
X }
X if (mptr == NULL)
X goto undefined_macro;
X /*-------------------------------------------------*/
X /* Check to see whether we need to autoload the */
X /* macro. */
X /*-------------------------------------------------*/
Xexec_macro:
X if (mptr->m_flags & M_AUTOLOAD) {
X int saved_auto = autoloading;
X autoloading = TRUE;
X if (ld_macro((char *) mptr->m_list)) {
X autoloading = saved_auto;
X return;
X }
X autoloading = saved_auto;
X mptr = lookup_macro(macro_name);
X if (mptr->m_flags & M_AUTOLOAD)
X return;
X }
X lp_0 = mptr->m_list;
X if (*lp_0 == F_HALT)
X return;
X mac_stack[ms_cnt].name = macro_name;
X mac_stack[ms_cnt].argv = lp_argv;
X if (ms_cnt++ == 0) {
X saved_msg_level = msg_level;
X msg_level = 1;
X }
X trace_log("Execute macro: %s\n", macro_name);
X nexecute_macro(lp_0);
X if (bp)
X bp->macro = saved_macro;
X mptr->m_ftime = FALSE;
X if (--ms_cnt == 0)
X msg_level = saved_msg_level;
X}
X
Xstruct saved {
X OPCODE save_type;
X char *save_str;
X };
Xeval_args(bp, lp)
Xregister BUILTIN *bp;
Xregister LIST *lp;
X{
X extern LIST *copy_list();
X LISTV local_argv[MAX_ARGC];
X register LISTV *lap = &local_argv[1];
X register char *as = bp->args;
X int optional;
X LIST *bpargv = bp->argv;
X LIST *optarg = &f_halt;
X LIST *argp;
X register int largc = 1;
X struct saved saved_str[MAX_ARGC];
X int ss_cnt = 0;
X register int i;
X r_str *rp;
X
X
X if (*lp == F_HALT) {
X lp = bpargv;
X bpargv = &f_halt;
X }
X# define RS(x) ((r_str *) (x))
X while (*as && lp && *lp != F_HALT) {
X int type;
X char *str;
X
X str = *lp == F_STR ? (char *) LGET32(lp) : "";
X rp = RS(str);
X if (optional = *as == '*')
X as++;
X if (*bpargv != F_HALT) {
X optarg = bpargv;
X if (*bpargv == F_LIST)
X bpargv += LGET16(lp);
X else
X bpargv += sizeof_atoms[*bpargv];
X }
X argp = lp;
X ++largc;
X if (*as != 'R' && str[0] == 'N' && strcmp(str, "NULL") == 0) {
X if (optarg[0] != F_HALT) {
X argp = optarg;
X rp = RS(LGET32(lp));
X str = *argp == F_STR ? rp->r_str : "";
X type = eval_expr2(*as, argp, lap, str);
X }
X else {
X if (!optional)
X return arg_error(bp, TRUE, saved_str, ss_cnt, lap - local_argv);
X lap->l_int = 0;
X lap->l_flags = F_NULL;
X type = F_HALT;
X }
X }
X else
X type = eval_expr2(*as, argp, lap, str);
X as++;
X switch (type) {
X case F_INT:
X lap->l_flags = F_INT;
X lap->l_int = accumulator;
X break;
X case EXECUTE:
X goto execute;
X case F_HALT:
X break;
X case F_LIT:
X break;
X case F_STR:
X saved_str[ss_cnt].save_str = lap->l_str = strdup(lap->l_str);
X saved_str[ss_cnt++].save_type = F_STR;
X break;
X case F_RSTR:
X saved_str[ss_cnt].save_str = (char *)
X (lap->l_rstr = r_inc(lap->l_rstr));
X saved_str[ss_cnt++].save_type = F_RSTR;
X lap->l_flags = F_RSTR;
X break;
X case F_LIST:
X i = length_of_list(lap->l_list);
X if (i) {
X saved_str[ss_cnt].save_str = chk_alloc(i);
X memcpy(saved_str[ss_cnt].save_str, lap->l_list, i);
X lap->l_list = (LIST *) saved_str[ss_cnt].save_str;
X saved_str[ss_cnt++].save_type = F_LIST;
X }
X break;
X case ERROR:
X return arg_error(bp, TRUE, saved_str, ss_cnt, lap - local_argv);
X default:
X ewprintf("%s: default case", bp->name);
X panic("default case");
X }
X lap++;
X if ((i = *lp) == F_LIST) {
X u_int16 i = LGET16(lp);
X if (i == 0)
X goto check_rest_of_arguments;
X lp += i;
X }
X else if (i == F_HALT)
X lp = bpargv;
X else
X lp += sizeof_atoms[i];
X }
X
X if (lp && *lp != F_HALT) {
X ewprintf("%s: Too many arguments", bp->name);
X return arg_error(bp, FALSE, saved_str, ss_cnt);
X }
Xcheck_rest_of_arguments:
X while (*as) {
X if (*as != '*')
X return arg_error(bp, TRUE, saved_str, ss_cnt, lap - local_argv);
X as += 2;
X lap->l_flags = F_NULL;
X lap->l_int = 0;
X lap++;
X }
X
Xexecute:
X acc_type = F_INT;
X argv = local_argv;
X argc = largc;
X command_name = bp->name;
X set_hooked();
X (*bp->func)(bp->arg);
X# ifndef PRODUCTION
X if ((bp->flags & B_NOVALUE) == 0)
X trace_acc();
X bp->reference++;
X# endif
X return free_saved(saved_str, ss_cnt);
X}
Xfree_saved(saved_str, ss_cnt)
Xregister struct saved *saved_str;
Xregister int ss_cnt;
X{
X while (ss_cnt > 0) {
X switch (saved_str[--ss_cnt].save_type) {
X case F_LIST:
X case F_STR:
X chk_free(saved_str[ss_cnt].save_str);
X break;
X case F_RSTR:
X r_dec((r_str *) saved_str[ss_cnt].save_str);
X break;
X }
X }
X}
Xchar state_tbl[][9] = {
X/* F_INT, F_STR, F_LIST, NULL, F_ID, F_END, POLY, F_LIT, F_RSTR */
X/*a*/ { -1, F_STR, F_LIST, -1, F_ID, -1, -1, F_LIT, F_RSTR},
X/*b*/ {F_INT, F_STR, -1, -1, F_ID, -1, -1, F_LIT, F_RSTR},
X/*c*/ { -1, -1, -1, -1, -1, -1, -1, -1, -1},
X/*d*/ { -1, -1, -1, -1, -1, -1, -1, -1, -1},
X/*e*/ { -1, -1, -1, -1, -1, -1, -1, -1, -1},
X/*f*/ { -1, -1, -1, -1, -1, -1, -1, -1, -1},
X/*g*/ { -1, -1, -1, -1, -1, -1, -1, -1, -1},
X/*h*/ { -1, -1, -1, -1, -1, -1, -1, -1, -1},
X/*i*/ {F_INT, -1, -1, -1, -1, -1, -1, -1, -1},
X/*j*/ { -1, -1, -1, -1, -1, -1, -1, -1, -1},
X/*k*/ { -1, -1, -1, -1, -1, -1, -1, -1, -1},
X/*l*/ { -1, -1, F_LIST, -1, -1, -1, -1, -1, -1},
X/*m*/ { -1, -1, -1, -1, -1, -1, -1, -1, -1},
X/*n*/ { -1, -1, -1, -1, -1, -1, -1, -1, -1},
X/*o*/ { -1, -1, -1, -1, -1, -1, -1, -1, -1},
X/*p*/ { -1, -1, -1, -1, -1, -1, -1, -1, -1},
X/*q*/ { -1, -1, -1, -1, -1, -1, -1, -1, -1},
X/*r*/ { -1, -1, -1, -1, -1, -1, -1, -1, -1},
X/*s*/ { -1, F_STR, -1, -1, F_ID, -1, -1, F_LIT, F_RSTR},
X/*t*/ {F_INT, F_STR, F_LIST, -1, F_ID, -1, -1, F_LIT, F_RSTR},
X };
Xeval_expr2(ch, argp, lap, str)
XLIST *argp;
Xregister LISTV *lap;
Xchar *str;
X{ SYMBOL *sp;
X int type;
X
X if (isupper(ch)) {
X if (ch == 'R') {
X lap->l_list = argp;
X lap->l_flags = F_LIST;
X return EXECUTE;
X }
X if (ch == 'C') {
X lap->l_list = argp;
X lap->l_flags = F_LIST;
X return F_HALT;
X }
X if (!(*argp == F_STR || *argp == F_ID) ||
X (sp = lookup(str)) == NULL)
X return -1;
X lap->l_sym = sp;
X switch (ch) {
X case 'S':
X if (sp->s_type == F_STR) {
X lap->l_flags = F_STR;
X return F_HALT;
X }
X return ERROR;
X case 'I':
X if (sp->s_type == F_INT) {
X lap->l_flags = F_INT;
X return F_HALT;
X }
X return ERROR;
X case 'L':
X if (sp->s_type == F_LIST) {
X lap->l_flags = F_LIST;
X return F_HALT;
X }
X return ERROR;
X case 'T':
X if (sp->s_type == F_LIST) {
X lap->l_flags = F_LIST;
X return F_HALT;
X }
X case 'B':
X if (sp->s_type == F_INT || sp->s_type == F_STR) {
X lap->l_flags = sp->s_type;
X return F_HALT;
X }
X return ERROR;
X }
X }
X if (ch == 'm') {
X if (*argp == F_STR) {
X lap->l_flags = F_STR;
X lap->l_str = str;
X return F_LIT;
X }
X if (*argp == F_ID) {
X eval(argp, lap);
X return F_STR;
X }
X return ERROR;
X }
X type = eval(argp, lap);
X ch -= 'a';
X if (ch < 0 || ch >= sizeof state_tbl / sizeof state_tbl[0]) {
X ewprintf("Unknown case string for '%c'", ch + 'a');
X panic("");
X }
X return state_tbl[ch][type - F_INT];
X}
Xarg_error(bp, msg, saved_str, cnt, arg)
Xchar *saved_str[MAX_ARGC];
XBUILTIN *bp;
X{
X if (msg)
X errorf("%s: parameter %d invalid", bp->name, arg);
X free_saved(saved_str, cnt);
X acc_type = F_INT;
X return -1;
X}
Xvoid
Xset_hooked()
X{
X
X if (hooked = curwp->w_bufp == curbp) {
X cur_line = &curwp->w_line;
X cur_col = &curwp->w_col;
X }
X else {
X cur_line = &curbp->b_line;
X cur_col = &curbp->b_col;
X }
X}
Xget_iarg1(str, l)
Xchar *str;
Xlong *l;
X{
X char buf[80];
X
X if (argv[1].l_flags == F_INT) {
X *l = argv[1].l_int;
X return 0;
X }
X if (ereply(str, buf, sizeof buf - 1) != TRUE)
X return -1;
X (void) sscanf(buf, "%ld", l);
X return 0;
X}
Xchar *
Xget_arg1(str, buf, bufsiz)
Xchar *str;
Xchar *buf;
X{ register char *cp;
X
X if (argv[1].l_flags == F_STR)
X return argv[1].l_str;
X if (argv[1].l_flags == F_RSTR)
X return argv[1].l_rstr->r_str;
X
X if (ereply(str, buf, bufsiz - 1) != TRUE || buf[0] == NULL)
X return (char *) NULL;
X for (cp = buf; *cp; cp++)
X if (*cp != ' ')
X break;
X return *cp == NULL ? (char *) NULL : buf;
X}
SHAR_EOF
chmod 0444 ./builtin.c || echo "restore of ./builtin.c fails"
mkdir . >/dev/null 2>&1
echo "x - extracting ./clock.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ./clock.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# include "clk.h"
X# include <signal.h>
XSCCSID("@(#) clock.c 1.7, (C) 1989, P. Fox");
X
X# define MAX_TIMEOUTS 10
X
Xstruct callout {
X int (*func)();
X int arg;
X long id;
X long timeout;
X };
X
X/*# define ALARM(x) (trace_log("alarm(%d)\n", x), alarm(x))*/
X# define ALARM(x) alarm(x)
Xstruct callout callo[MAX_TIMEOUTS];
Xint ntmo = 0;
Xstatic long clk_id = 0;
Xint clock_ticked = FALSE;
Xint clock_handler();
X
Xclk_timeout(func, arg, timeout)
Xint (*func)();
Xlong timeout;
X{ register struct callout *cp = callo;
X register int i, j;
X
X clk_remove(func);
X if (ntmo && clock_ticked == FALSE) {
X int secs = ALARM(0);
X callo[0].timeout = secs;
X }
X
X timeout /= 1 SECOND;
X if (ntmo == 0)
X goto end_of_function;
X
X if (ntmo >= MAX_TIMEOUTS-1)
X return 0;
X for (i = 0; i < ntmo; i++, cp++) {
X if (cp->timeout > timeout) {
X for (j = ntmo; j > i; j--)
X callo[j] = callo[j-1];
X cp[1].timeout -= timeout;
X goto end_of_function;
X }
X timeout -= cp->timeout;
X }
Xend_of_function:
X cp->func = func;
X cp->arg = arg;
X cp->id = ++clk_id;
X cp->timeout = timeout;
X ntmo++;
X if (clock_ticked == FALSE) {
X if (callo[0].timeout == 0)
X clock_handler();
X else {
X signal(SIGALRM, clock_handler);
X ALARM(callo[0].timeout);
X }
X }
X return clk_id;
X}
Xclk_remove(func)
Xint (*func)();
X{ register struct callout *cp;
X register struct callout *cend = &callo[ntmo];
X
X for (cp = callo; cp < cend; cp++)
X if (cp->func == func) {
X cp[1].timeout += cp->timeout;
X for (; cp < cend; cp++)
X *cp = cp[1];
X ntmo--;
X break;
X }
X}
Xclock_check()
X{ int i;
X int (*func)();
X int arg;
X int clock_handler();
X
X if (clock_ticked == FALSE)
X return 1;
X callo[0].timeout = 0;
X while (ntmo && callo[0].timeout == 0) {
X func = callo[0].func;
X arg = callo[0].arg;
X for (i = 0; i < MAX_TIMEOUTS; i++)
X callo[i] = callo[i+1];
X ntmo--;
X if (func)
X (*func)(arg);
X }
X signal(SIGALRM, clock_handler);
X clock_ticked = FALSE;
X if (ntmo)
X ALARM(callo[0].timeout);
X return 1;
X}
Xclock_handler()
X{
X signal(SIGALRM, SIG_IGN);
X# if defined(VMS)
X sys_cancel_io();
X# endif
X clock_ticked = TRUE;
X}
Xdump_callo()
X{
X int i;
X trace_log("CALLOUTS = %d\n", ntmo);
X for (i = 0; i < ntmo; i++) {
X trace_log("%d: func=", i);
X trace_log("%08lx ", callo[i].func);
X trace_log("tmo=%ld.\n", callo[i].timeout);
X }
X}
SHAR_EOF
chmod 0444 ./clock.c || echo "restore of ./clock.c fails"
mkdir . >/dev/null 2>&1
echo "x - extracting ./cm.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ./cm.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# define _DECLS
X# include "list.h"
X# include "cm.h"
XSCCSID("@(#) cm.c 1.12, (C) 1989 P. Fox");
X
X# define MAX_ATOMS 32000 /* Max. number of atoms in a macro */
X /* definition. */
X# define MAX_STRINGS 2048 /* Max. strings in macro file. */
X# define MAX_GLOBALS 256 /* Max. no. of global statements */
X /* in program. */
X#ifndef TRUE
X# define TRUE 1
X# define FALSE 0
X# endif
X
X/* Resolves dummy references *************/
Xchar *K[1];
XOPCODE acc_type;
Xlong accumulator;
Xchar *saccumulator;
Xexec1() {}
X/**************/
Xvoid patom();
Xextern char *strdup();
Xextern char *chk_alloc();
Xextern char *get_string();
X
X/*-------------------*/
XBUFFER *bheadp;
XBUFFER *curbp;
XWINDOW *wheadp;
XWINDOW *curwp;
Xint hooked;
Xint *cur_line;
Xint *cur_col;
Xint nest_level;
XLISTV *argv;
Xint pflag = 0;
Xint flush_flag = TRUE;
X/*-------------------*/
XMACRO macro_tbl[MAX_MACROS];
Xu_int32 m_offsets[MAX_MACROS];
Xint macro_cnt;
Xchar *bpath;
Xextern int cm_running;
Xstruct f fps[MAX_FILES];
Xstruct f *fp_ptr;
Xint a_flag = FALSE;
Xint l_flag = 0;
Xint L_flag = 0; /* TRUE if we want more disassembly info. */
Xint s_flag = FALSE; /* TRUE if size info. only. */
Xint nglobals; /* Number of global statements found so far. */
Xu_int32 globals[MAX_GLOBALS]; /* Table of indexes to global statements. */
Xlong nlist; /* Number of list atoms. */
Xlong nint; /* Number of int atoms. */
Xlong nstr; /* Number of F_STR atoms. */
Xlong nid; /* Number of F_ID atoms. */
Xlong nnull; /* Number of flags==0 atoms. */
Xlong ndontknow; /* Number of Don't knows. */
Xlong nhalt; /* Number of HALT opcodes. */
X
Xextern DEFINE *def_head,
X *def_ptr;
Xextern int cm_version;
Xextern u_int32 WGET32();
Xextern u_int16 WGET16();
X
XFILE *fp; /* File pointer for output file. */
X
Xchar buf[BUFSIZ]; /* Temporary working buffer. */
Xchar *output_file; /* Name of output file. */
XCM cm_header = {CM_MAGIC}; /* Header for output file. */
Xint string_count; /* Count of literals in list. */
Xchar **string_table;
Xchar *str_table; /* Pointer to string table for disassembly.*/
XLIST *atom_start; /* Pointer to base of compiled macro. */
Xint atom_count; /* Count of atoms in buffer. */
X
Xextern BUILTIN builtin[];
Xextern int sizeof_builtin;
Xextern BUILTIN *lookup_builtin();
X
Xint do_switches();
Xvoid usage();
X/*---------------------------------------
X * Prototype definitions.
X *---------------------------------------*/
Xextern char *bsearch();
Xvoid disassemble();
Xvoid write_output_file();
Xint init_fp();
Xint yyparse();
Xvoid list_macro();
Xvoid delete_macro();
Xvoid yyerror();
Xvoid execute_macro();
X
Xmain(argc, argv)
Xchar **argv;
X{ int arg_index = do_switches(argc, argv);
X int len;
X extern int dflag;
X extern char *crisp_log;
X MACRO *mp;
X static char argv_buf[1024];
X int exit_status = 0;
X int print_msg;
X
X/* dflag = 1;
X crisp_log = "/dev/tty";*/
X
X cm_running = TRUE;
X if ((bpath = getenv("BPATH")) == NULL)
X bpath = "/usr/local/crisp/macros";
X
X
X fp_ptr = &fps[0]-1;
X if (arg_index >= argc)
X usage();
X malloc_hack();
X print_msg = arg_index < argc - 1;
X for ( ; arg_index < argc; arg_index++) {
X char *file = argv[arg_index];
X int len = strlen(file);
X atom_count = 0;
X if (strlen(file) > 3 && strcmp(file + len -3, ".cm") == 0) {
X disassemble(file);
X continue;
X }
X if (print_msg)
X printf("Compiling %s...\n", file);
X if (init_fp(TERMINAL, file) < 0) {
X perror(file);
X continue;
X }
X
X macro_cnt = 0;
X nglobals = 0;
X if (yyparse() != 0) {
X printf("Compilation of %s unsuccessful.\n", file);
X exit_status = -1;
X continue;
X }
X
X /*----------------------------------------------
X * Open output file.
X *----------------------------------------------*/
X if (output_file == NULL) {
X if (len <= 2 || strcmp(file + len -2, ".m") != 0)
X sprintf(buf, "%s.cm", file);
X else
X sprintf(buf, "%.*s.cm", len - 2, file);
X output_file = buf;
X }
X
X write_output_file();
X if (a_flag)
X print_perc();
X /*----------------------------------------------
X * Dump internal form of macro if asked for.
X *----------------------------------------------*/
X for (mp = macro_tbl; mp < ¯o_tbl[macro_cnt]; mp++) {
X if (l_flag) {
X list_macro(0, mp->m_list);
X printf("\n");
X }
X /*chk_free(mp->m_name);*/
X /*chk_free(mp->m_list);*/
X }
X
X def_head = NULL;
X def_ptr = NULL;
X output_file = NULL;
X# ifdef MALLOC
X{ int i;
X static int loop_count = 0;
X if (++loop_count < 10)
X continue;
X strcpy(argv_buf, "cm ");
X if (arg_index + 1 >= argc)
X continue;
X for (i = arg_index+1; i < argc; i++) {
X strcat(argv_buf, " ");
X strcat(argv_buf, argv[i]);
X }
X argv[0] = "/bin/sh", argv[1] = "-c", argv[2] = argv_buf;
X execv(argv[0], argv);
X perror("execv");
X}
X# endif
X }
X return exit(exit_status);
X}
Xvoid
Xwrite_output_file()
X{
X int i;
X u_int32 base;
X long ftell();
X u_int32 offset;
X LIST *lp;
X
X if ((fp = fopen(output_file, "w")) == NULL) {
X perror(output_file);
X exit(1);
X }
X
X if ((atom_start = (LIST *) chk_alloc(MAX_ATOMS)) == NULL) {
X fprintf(stderr, "Not enough room to compile macros\n");
X exit(1);
X }
X if ((string_table = (char **) chk_alloc(sizeof (char *) * MAX_STRINGS)) == NULL) {
X fprintf(stderr, "Not enough room to allocate string table\n");
X exit(1);
X }
X
X cm_header.cm_num_macros = macro_cnt;
X cm_header.cm_version = cm_version;
X if (fwrite((char *) &cm_header, sizeof (CM), 1, fp) != 1) {
Xoutput_error:
X perror(output_file);
X exit(1);
X }
X
X if (fwrite((char *) m_offsets, sizeof (u_int32), macro_cnt+2, fp) !=
X macro_cnt+2)
X goto output_error;
X
X base = ftell(fp);
X string_count = 0;
X for (i = 0; i < macro_cnt; i++) {
X int n = macro_tbl[i].m_size;
X LIST *lpend;
X if (L_flag)
X printf("\n*** Macro %d:\n", i);
X lp = macro_tbl[i].m_list;
X lpend = lp + n;
X m_offsets[i] = (ftell(fp) - (long) base) / sizeof (LIST);
X while (lp < lpend) {
X char *str = "";
X if (*lp == F_STR || *lp == F_LIT)
X str = get_string(lp);
X else if (*lp == F_ID) {
X int id = LGET16(lp);
X if (strcmp(builtin[id].name, "global") == 0) {
X globals[nglobals++] = m_offsets[i] +
X (lp - macro_tbl[i].m_list);
X }
X }
X if (L_flag)
X patom(macro_tbl[i].m_list, lp, str);
X lp += sizeof_atoms[*lp];
X }
X if (fwrite((char *) macro_tbl[i].m_list, sizeof (LIST), n, fp) != n)
X goto output_error;
X }
X if (ftell(fp) & 3)
X fwrite("PAD", (int) (4 - (ftell(fp) & 3)), 1, fp);
X m_offsets[macro_cnt] = ftell(fp) - (long) base;
X m_offsets[macro_cnt+1] = string_count;
X /*------------------------------------------
X * Now write out table of string offsets from here.
X *------------------------------------------*/
X for (offset = 0, i = 0; i < string_count; i++) {
X u_int32 o = WGET32(offset);
X if (fwrite((char *) &o, sizeof o, 1, fp) != 1)
X goto output_error;
X offset += strlen(string_table[i]) + 1;
X }
X /*------------------------------------------
X * Now write out string table.
X *------------------------------------------*/
X for (i = 0; i < string_count; i++) {
X int len = strlen(string_table[i]);
X if (fwrite(string_table[i], len+1, 1, fp) != 1)
X goto output_error;
X }
X if (ftell(fp) & 3)
X fwrite("PAD", (int) (4 - (ftell(fp) & 3)), 1, fp);
X cm_header.cm_globals = ftell(fp);
X swap_words(globals, nglobals);
X if (nglobals && fwrite((char *) globals, sizeof globals[0] * nglobals, 1, fp) != 1)
X goto output_error;
X rewind(fp);
X cm_header.cm_num_atoms = atom_count;
X cm_header.cm_num_globals = nglobals;
X cm_header.cm_num_strings = string_count;
X swap_cm_header(&cm_header);
X if (fwrite((char *) &cm_header, sizeof (CM), 1, fp) != 1)
X goto output_error;
X swap_words(m_offsets, macro_cnt+2);
X if (fwrite((char *) m_offsets, sizeof (u_int32), macro_cnt+2, fp) !=
X macro_cnt+2)
X goto output_error;
X fclose(fp);
X
X chk_free((char *) string_table);
X chk_free((char *) atom_start);
X}
Xchar *
Xget_string(lp)
Xregister LIST *lp;
X{
X register char **cpp;
X register char **cpend = &string_table[string_count];
X char *str = (char *) LGET32(lp);
X static char buf[128];
X
X for (cpp = string_table; cpp < cpend; cpp++)
X if (**cpp == *str && strcmp(*cpp, str) == 0) {
X strcpy(buf, str);
X LPUT32(lp, (long) (cpp - string_table));
X chk_free(str);
X return buf;
X }
X *cpp = str;
X LPUT32(lp, (long) string_count++);
X return str;
X}
Xvoid
Xusage()
X{
X fprintf(stderr, "Usage: cm [-aLl] [-o output_file] file-name ...\n\n");
X fprintf(stderr, " -a Print atom percentages.\n");
X fprintf(stderr, " -l List macro expansions.\n");
X fprintf(stderr, " -L Print detailed disassembly info.\n");
X fprintf(stderr, " -q Quiet error messages.\n");
X fprintf(stderr, " -s Print size of .cm file only.\n");
X fprintf(stderr, " (Use with .cm file only).\n");
X fprintf(stderr, " -o file Name of compiled output file.\n");
X exit(1);
X}
X
Xdo_switches(ac, av)
Xchar **av;
X
X{
X int c;
X extern char *optarg;
X int errflag = 0;
X extern int optind;
X
X while ((c = getopt(ac, av, "acLqldo:s")) != EOF)
X switch (c) {
X case 'a': a_flag = TRUE; break;
X case 'l': l_flag = 1; break;
X case 'q': {
X extern int verbose_errors;
X verbose_errors = FALSE;
X break;
X }
X case 'L': L_flag = 1; break;
X case 'o':
X output_file = optarg;
X break;
X case 's': s_flag = TRUE; break;
X default:
X errflag++;
X }
X
X if (errflag)
X usage();
X return optind;
X}
Xmac_compare(mac1, mac2)
Xchar *mac1;
XMACRO *mac2;
X{
X return strcmp(mac1, mac2->m_name);
X}
Xenter_macro(list)
XLIST *list;
X{ register MACRO *mptr;
X char name[64];
X
X if (*list != F_STR) {
X printf("Macro name must be an id\n");
X return -1;
X }
X strncpy(name, (char *) LGET32(list), 64);
X list += sizeof_atoms[F_STR];
X if (macro_cnt && (mptr = (MACRO *) bsearch(name, macro_tbl, macro_cnt,
X sizeof macro_tbl[0], mac_compare)))
X delete_macro(mptr->m_list);
X else {
X MACRO *mp_end = ¯o_tbl[macro_cnt];
X if (macro_cnt >= MAX_MACROS-1) {
X printf("Macro table full\n");
X return -1;
X }
X for (mptr = macro_tbl; mptr < mp_end; mptr++)
X if (strcmp(name, mptr->m_name) < 0) {
X for ( ; mp_end >= mptr; mp_end--)
X mp_end[1] = mp_end[0];
X break;
X }
X macro_cnt++;
X mptr->m_name = strdup(name);
X }
X mptr->m_list = list;
X return 0;
X}
Xvoid
Xdelete_macro(list)
Xregister LIST *list;
X{
X
X}
Xvoid
Xdisassemble(file)
Xchar *file;
X{
X FILE *fp = fopen(file, "r");
X int i;
X CM *cm;
X struct stat stat_buf;
X u_int32 *vm_offsets;
X u_int32 num_strings;
X u_int32 *soffsets;
X int nm;
X LIST *lp;
X LIST *base_list;
X
X printf("\n*** File: %s\n\n", file);
X nhalt = nlist = nint = nstr = nid = nnull = ndontknow = 0;
X
X if (fp == NULL || stat(file, &stat_buf) < 0) {
X perror(file);
X exit(1);
X }
X cm = (CM *) chk_alloc((unsigned) stat_buf.st_size);
X if (read(fileno(fp), (char *) cm, (int) stat_buf.st_size) !=
X (int) stat_buf.st_size) {
X fprintf(stderr, "Read() error on .cm file");
X exit(1);
X }
X if (cm->cm_version != cm_version) {
X fprintf(stderr, ".cm file has wrong version number - %d\n",
X cm->cm_version);
X fprintf(stderr, "Current version is %d\n", cm_version);
X exit(1);
X }
X
X vm_offsets = (u_int32 *) (cm + 1);
X base_list = (LIST *) (vm_offsets + cm->cm_num_macros + 2);
X num_strings = vm_offsets[cm->cm_num_macros + 1];
X soffsets = (u_int32 *) (((char *) base_list) +
X vm_offsets[cm->cm_num_macros]);
X str_table = (char *) (soffsets + num_strings);
X
X if (cm->cm_magic != CM_MAGIC) {
X fprintf(stderr, "%s: invalid magic number\n", file);
X exit(1);
X }
X printf("Version of .cm : %d\n", cm->cm_version);
X printf("Number of macros: %d\n", cm->cm_num_macros);
X printf("Number of globals: %d\n", cm->cm_num_globals);
X printf("Size : %5ld Header\n", (u_int32) (sizeof *cm));
X printf(" %5ld Atoms\n",
X (long) (sizeof (LIST) * cm->cm_num_atoms));
X printf(" + %5d Strings\n", cm->cm_num_strings);
X printf(" -------\n");
X printf(" %5ld\n", (u_int32) stat_buf.st_size);
X if (s_flag)
X goto end_of_function;
X
X for (i = 0; i < cm->cm_num_macros; i++)
X printf("Macro %d, offset = atom #%ld\n", i, vm_offsets[i]);
X printf("String table starts at %08lx. No. of strings =%ld\n",
X vm_offsets[cm->cm_num_macros], num_strings);
X
X for (nm = 0, lp = base_list; lp < base_list + cm->cm_num_atoms; ) {
X char *str = (*lp == F_STR || *lp == F_LIT)
X ? str_table + soffsets[LGET32(lp)] : "";
X if (strcmp(str, "macro") == 0 && l_flag)
X printf("\n*** Macro %d:\n", nm++);
X patom(base_list, lp, str);
X lp += sizeof_atoms[*lp];
X }
X
X if (l_flag == 0)
X goto end_of_function;
X printf("String Table:\n");
X for (i = 0; i < num_strings; i++)
X printf("\tString %2d: Offset=%04lx '%s'\n", i,
X soffsets[i], str_table + soffsets[i]);
X printf("\n");
Xend_of_function:
X if (a_flag)
X print_perc();
X chk_free((char *) cm);
X}
X# define PC(x) ((x) * 100) / natoms
Xprint_perc()
X{ long natoms = nlist + nint + nstr + nid + nnull + ndontknow + nhalt;
X if (natoms == 0)
X natoms = 1;
X printf("\n");
X printf("Number of F_HALT atoms : %5ld (%2ld%%)\n",
X nhalt, PC(nhalt));
X printf("Number of F_LIST atoms : %5ld (%2ld%%)\n",
X nlist, PC(nlist));
X printf("Number of F_INT atoms : %5ld (%2ld%%)\n",
X nint, PC(nint));
X printf(
X"Number of F_STR atoms : %5ld (%2ld%%) INT+STR=%ld (%2ld%%)\n",
X nstr, PC(nstr), nstr + nint, PC(nstr + nint));
X printf("Number of F_ID atoms : %5ld (%2ld%%)\n",
X nid, PC(nid));
X printf("Number of F_NULL atoms : %5ld (%2ld%%)\n",
X nnull, PC(nnull));
X printf("Number of <DONT KNOW> atoms : + %5ld (%2ld%%)\n",
X nnull, PC(nnull));
X printf(" -------\n", natoms);
X printf("TOTAL: %5ld\n", natoms);
X}
Xvoid
Xexecute_macro(lp)
XLIST *lp;
X{ char name[64];
X char *macro_keywd;
X extern char *strdup();
X LIST *lpn;
X extern int sizeof_macro;
X
X if (macro_cnt >= MAX_MACROS-1) {
X printf("Macro table full\n");
X return;
X }
X lpn = lp + sizeof_atoms[*lp];
X if (*lpn != F_STR && *lpn != F_ID) {
X yyerror("Macro must start with a name\n");
X exit(1);
X }
X strcpy(name, *lpn == F_ID ?
X builtin[LGET16(lpn)].name : (char *) LGET32(lpn));
X macro_keywd = *lp == F_ID ?
X builtin[LGET16(lp)].name : (char *) LGET32(lp);
X if (strcmp(macro_keywd, "macro") != 0 &&
X strcmp(macro_keywd, "replacement") != 0)
X return;
X if (strcmp(macro_keywd, "macro") == 0 && *lpn == F_ID)
X printf("Warning: '%s' redefines a builtin.\n", name);
X macro_tbl[macro_cnt].m_name = strdup(name);
X macro_tbl[macro_cnt].m_size = sizeof_macro;
X atom_count += sizeof_macro;
SHAR_EOF
echo "End of part 3"
echo "File ./cm.c is continued in part 4"
echo "4" > 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