v23i052: Line oriented macro processor, Part02/09
Rich Salz
rsalz at bbn.com
Fri Nov 30 04:41:15 AEST 1990
Submitted-by: Darren New <new at ee.udel.edu>
Posting-number: Volume 23, Issue 52
Archive-name: lome/part02
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 2 (of 9)."
# Contents: LOME/Ifuncs1.c LOME/Ifuncs2.c LOME/Ifuncs3.c
# LOME/Ifuncs4.c LOME/LOME.c LOME/LOME2.c LOME/LOME7.c
# LOME/MacroIO.c LOME/MakeTail LOME/Rubin.out LOME/SCMTestD.inp
# PPL/FaultAmiga.c PPL/FaultUnix.c TFS/TFS.doc TFS/TestTFS.inp
# TFS/TestTFS2.out
# Wrapped by new at estelle.ee.udel.edu on Tue Aug 14 16:09:55 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'LOME/Ifuncs1.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'LOME/Ifuncs1.c'\"
else
echo shar: Extracting \"'LOME/Ifuncs1.c'\" \(3692 characters\)
sed "s/^X//" >'LOME/Ifuncs1.c' <<'END_OF_FILE'
X/*
X * Ifuncs1.c
X * SCM Interpreter Function set One
X * Copyright 1988 Darren New.
X * All rights reserved.
X */
X
X#include "PPL.h"
X#include "MacroIO.h"
X
X#include "Interp.h"
X
Xint Ebp(c) /* BEGIN PROGRAM */
X int c;
X{
X PLStatus(0, "YCGTFH Fbp");
X return -1;
X }
X
Xint Ibp(c)
X int c;
X{
X if (c != 0) PLStatus(0, "BEGIN PROGRAM must be first");
X return -1;
X }
X
Xint Eep(c) /* END PROGRAM */
X int c;
X{
X PLStatus(0, "YCGTFH Fep");
X return -1;
X }
X
Xint Iep(c)
X int c;
X{
X return -1;
X }
X
X#ifdef DEBUGF_DEFINED
Xstatic void calldebug(void);
Xstatic void calldebug() { Edebug(0); }
X#endif
X
Xint Ebmr(c) /* BEGIN MAIN ROUTINE */
X int c;
X{
X register short i;
X
X#ifdef DEBUGF_DEFINED
X void calldebug(void);
X DEBUG_FUNC[0] = calldebug;
X#endif
X
X /* the next is -1, +1 because Iparse uses the first name as a source */
X MStartIO(PLargcnt - 1, PLarglist + 1);
X
X for (i = '0'; i < '4'; i++)
X f[i] = PLToInt(i);
X for (i = '0'; i <= '9'; i++)
X v[i] = PLToInt(i);
X for (i = '0'; i < '6'; i++)
X p[i] = PLToInt(i);
X p['6'] = 10;
X p['8'] = 0; /* MINMEM */
X p['9'] = MAXMEM;
X
X /* DEBUGF(7, "line %3d: BEGIN MAIN ROUTINE" C c); */
X
X return c+1;
X }
X
Xint Ibmr(c)
X int c;
X{
X startLine = c;
X /* DEBUGF(9, "Execution will begin at line %d" C c); */
X return -1;
X }
X
Xint Eemr(c) /* END MAIN ROUTINE */
X int c;
X{
X /* DEBUGF(7, "line %3d: END MAIN ROUTINE" C c); */
X MStopIO();
X return -1;
X }
X
Xint Iemr(c)
X int c;
X{
X return -1;
X }
X
Xint Ebs(c) /* BEGIN SUBROUTINE $ */
X int c;
X{
X /* DEBUGF(7, "line %3d: BEGIN SUBROUTINE %c" C c C param[0]); */
X return c+1;
X }
X
Xint Ibs(c)
X int c;
X{
X if (subr[param[0]] != 0)
X PLStatus(0, "Subroutine begun twice");
X else
X subr[param[0]] = c;
X /* DEBUGF(9, "Subroutine %c starts at line %d" C param[0] C c); */
X return -1;
X }
X
Xint Ees(c) /* END SUBROUTINE $ */
X int c;
X{
X /* DEBUGF(7, "line %3d: END SUBROUTINE %c" C c C param[0]); */
X return (int) p[param[0]];
X }
X
Xint Ies(c)
X int c;
X{
X if (subr[param[0]] == 0)
X PLStatus(0, "Subroutine not yet begun");
X return -1;
X }
X
Xint El(c) /* LABEL $$ */
X int c;
X{
X /* DEBUGF(7, "line %3d: LABEL %c%c" C c C param[0] C param[1]); */
X return c+1;
X }
X
Xint Il(c)
X int c;
X{
X register short i = PLToInt(param[0]) * 10 + PLToInt(param[1]);
X if (i < 1 || i > 99) {
X PLStatus(0, "Bad label");
X return -1;
X }
X if (labl[i]) PLStatus(0, "Label defined twice");
X labl[i] = c;
X /* DEBUGF(9, "Label %d is at line %d" C i C c); */
X return -1;
X }
X
Xint Ecd(c) /* CHRDATA $$ $ $ $$ */
X int c;
X{
X short i = PLToInt(param[0]) * 10 + PLToInt(param[1]);
X unsigned p = PLToInt(param[4]) * 10 + PLToInt(param[5]);
X unsigned f = PLToInt(param[2]);
X unsigned v = param[3];
X
X if (i < 0 || i > 99 || p > 99) {
X PLStatus(0, "Bad CHRDATA number");
X return -1;
X }
X
X mem[i] = (v << 24) | ((f & 3) << 22) | (p & 0x3FFFFF);
X /* DEBUGF(8, "line %3d: CHRDATA" C c); */
X return c + 1;
X }
X
Xint Icd(c)
X int c;
X{
X return -1;
X }
X
Xint End(c) /* NUMDATA $$ $ $$ $$ */
X int c;
X{
X short i = PLToInt(param[0]) * 10 + PLToInt(param[1]);
X unsigned v = PLToInt(param[3]) * 10 + PLToInt(param[4]);
X unsigned p = PLToInt(param[5]) * 10 + PLToInt(param[6]);
X unsigned f = PLToInt(param[2]);
X
X if (i < 0 || i > 99 || p > 99 || v > 99) {
X PLStatus(0, "Bad NUMDATA number");
X return -1;
X }
X
X mem[i] = (v << 24) | ((f & 3) << 16) | (p & 0xFFFF);
X /* DEBUGF(8, "line %3d: NUMDATA" C c); */
X return c + 1;
X }
X
Xint Ind(c)
X int c;
X{
X return -1;
X }
X
X
X
END_OF_FILE
if test 3692 -ne `wc -c <'LOME/Ifuncs1.c'`; then
echo shar: \"'LOME/Ifuncs1.c'\" unpacked with wrong size!
fi
# end of 'LOME/Ifuncs1.c'
fi
if test -f 'LOME/Ifuncs2.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'LOME/Ifuncs2.c'\"
else
echo shar: Extracting \"'LOME/Ifuncs2.c'\" \(3965 characters\)
sed "s/^X//" >'LOME/Ifuncs2.c' <<'END_OF_FILE'
X/*
X * Ifuncs2.c
X * SCM Interpreter Function set Two
X * Copyright 1988 Darren New.
X * All rights reserved.
X */
X
X#include "PPL.h"
X#include "MacroIO.h"
X
X#include "Interp.h"
X
X#define ERROR(s) {PLStatus(0,s); MStopIO(); return -1;}
X
Xint Es(c) /* STOP $ */
X int c;
X{
X char s[50];
X strcpy(s, "STOP $ ENCOUNTERED!");
X s[5] = param[0];
X /* DEBUGF(0, s); */
X PLStatus(4, s);
X Edebug(c);
X MStopIO();
X return -1;
X }
X
Xint Ec(c) /* CALL $ */
X int c;
X{
X if (subr[param[0]] == 0)
X ERROR("Call of non-existant subroutine");
X /* DEBUGF(8, "line %3d: CALL %d" C c C param[0]); */
X p[param[0]] = c + 1;
X return (int) subr[param[0]];
X }
X
Xint Egm(c) /* GET MEM $ = $ */
X int c;
X{
X short frm = p[param[1]], to = param[0];
X if (frm < 0 || frm >= MAXMEM)
X ERROR("GET MEM out of bounds");
X v[to] = ((mem[frm] >> 24) & 0xFF);
X f[to] = ((mem[frm] >> 16) & 0x03);
X p[to] = (mem[frm] & 0xFFFF);
X /* DEBUGF(8, "line %3d: GET MEM %c = %c (src=%d, f=%d, v=%d, p=%d)" C c C
X param[0] C param[1] C frm C f[to] C v[to] C p[to]); */
X return c + 1;
X }
X
Xint Epm(c) /* PUT MEM $ = $ */
X int c;
X{
X short frm = param[1], to = p[param[0]];
X if (to < 0 || to >= MAXMEM)
X ERROR("PUT MEM out of bounds");
X mem[to] = (v[frm] << 24) | (f[frm] << 16) | (p[frm] & 0xFFFF);
X /* DEBUGF(8, "line %3d: GET MEM %c = %c (dst=%d, f=%d, v=%d, p=%d)" C c C
X param[0] C param[1] C to C f[frm] C v[frm] C p[frm]); */
X return c + 1;
X }
X
Xint Ef(c) /* FLG $ = $ */
X int c;
X{
X f[param[0]] = f[param[1]];
X /* DEBUGF(8, "line %3d: FLG %c = %c (%d)" C c C
X param[0] C param[1] C f[param[0]]); */
X return c + 1;
X }
X
Xint Epv(c) /* PTR $ = VAL $ */
X int c;
X{
X p[param[0]] = (v[param[1]] & 0xFF);
X /* DEBUGF(8, "line %3d: PTR %c = VAL %c (%d)" C c C
X param[0] C param[1] C p[param[0]]); */
X return c + 1;
X }
X
Xint Evp(c) /* VAL $ = PTR $ */
X int c;
X{
X v[param[0]] = (p[param[1]] & 0xFF);
X /* DEBUGF(8, "line %3d: VAL %c = PTR %c (%d)" C c C
X param[0] C param[1] C v[param[0]]); */
X return c + 1;
X }
X
Xint Eva(c) /* VAL $ = $ + $ */
X int c;
X{
X v[param[0]] = (0xFF & (v[param[1]] + v[param[2]]));
X /* DEBUGF(8, "line %3d: VAL %c = %c + %c (%d)" C c C
X param[0] C param[1] C param[2] C v[param[0]]); */
X return c + 1;
X }
X
Xint Evs(c) /* VAL $ = $ - $ */
X int c;
X{
X v[param[0]] = (0xFF & (v[param[1]] - v[param[2]]));
X /* DEBUGF(8, "line %3d: VAL %c = %c - %c (%d)" C c C
X param[0] C param[1] C param[2] C v[param[0]]); */
X return c + 1;
X }
X
Xint Epa(c) /* PTR $ = $ + $ */
X int c;
X{
X p[param[0]] = p[param[1]] + p[param[2]];
X /* DEBUGF(8, "line %3d: PTR %c = %c + %c (%d)" C c C
X param[0] C param[1] C param[2] C p[param[0]]); */
X return c + 1;
X }
X
Xint Eps(c) /* PTR $ = $ - $ */
X int c;
X{
X p[param[0]] = p[param[1]] - p[param[2]];
X /* DEBUGF(8, "line %3d: PTR %c = %c - %c (%d)" C c C
X param[0] C param[1] C param[2] C p[param[0]]); */
X return c + 1;
X }
X
Xint Ept(c) /* PTR $ = $ * $ */
X int c;
X{
X p[param[0]] = p[param[1]] * p[param[2]];
X /* DEBUGF(8, "line %3d: PTR %c = %c * %c (%d)" C c C
X param[0] C param[1] C param[2] C p[param[0]]); */
X return c + 1;
X }
X
Xint Epd(c) /* PTR $ = $ / $ */
X int c;
X{
X if (p[param[2]] == 0) ERROR("Attempted division by zero!");
X p[param[0]] = p[param[1]] / p[param[2]];
X /* DEBUGF(8, "line %3d: PTR %c = %c / %c (%d)" C c C
X param[0] C param[1] C param[2] C p[param[0]]); */
X return c + 1;
X }
X
Xint Empb(c) /* MOV PTR $ BY $ */
X int c;
X{
X p[param[0]] += p[param[1]];
X /* DEBUGF(8, "line %3d: MOV PTR %c BY %c (by %d, now %d)" C c C
X param[0] C param[1] C p[param[1]] C p[param[0]]); */
X return c + 1;
X }
X
X
END_OF_FILE
if test 3965 -ne `wc -c <'LOME/Ifuncs2.c'`; then
echo shar: \"'LOME/Ifuncs2.c'\" unpacked with wrong size!
fi
# end of 'LOME/Ifuncs2.c'
fi
if test -f 'LOME/Ifuncs3.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'LOME/Ifuncs3.c'\"
else
echo shar: Extracting \"'LOME/Ifuncs3.c'\" \(2594 characters\)
sed "s/^X//" >'LOME/Ifuncs3.c' <<'END_OF_FILE'
X/*
X * Ifuncs3.c
X * SCM Interpreter Function set Three
X * Copyright 1988 Darren New.
X * All rights reserved.
X */
X
X#include "PPL.h"
X#include "MacroIO.h"
X
X#include "Interp.h"
X
X#define ERROR(s) {PLStatus(0,s); MStopIO(); return -1;}
X
X
Xstatic int getnum(void);
Xstatic int getnum()
X{
X short i = PLToInt(param[0]) * 10 + PLToInt(param[1]);
X if (i < 1 || i > 99 || labl[i] == 0)
X ERROR("TO or TO IF with bad label");
X return (int) labl[i];
X }
X
Xint Et(c) /* TO $$ */
X int c;
X{
X /* DEBUGF(8, "line %3d: TO %c%c" C c C param[0] C param[1]); */
X return getnum();
X }
X
Xint Etife(c) /* TO $$ IF FLG $ EQ $ */
X int c;
X{
X /* DEBUGF(8, "line %3d: TO %c%c IF FLG %c EQ %c (%d eq %d)" C c C
X param[0] C param[1] C param[2] C param[3] C f[param[2]] C f[param[3]]); */
X if (f[param[2]] == f[param[3]])
X return getnum();
X return c + 1;
X }
X
Xint Etifn(c) /* TO $$ IF FLG $ NE $ */
X int c;
X{
X /* DEBUGF(8, "line %3d: TO %c%c IF FLG %c NE %c (%d ne %d)" C c C
X param[0] C param[1] C param[2] C param[3] C f[param[2]] C f[param[3]]); */
X if (f[param[2]] != f[param[3]])
X return getnum();
X return c + 1;
X }
X
Xint Etive(c) /* TO $$ IF VAL $ EQ $ */
X int c;
X{
X /* DEBUGF(8, "line %3d: TO %c%c IF VAL %c EQ %c (%d eq %d)" C c C
X param[0] C param[1] C param[2] C param[3] C v[param[2]] C v[param[3]]); */
X if (v[param[2]] == v[param[3]])
X return getnum();
X return c + 1;
X }
X
Xint Etivn(c) /* TO $$ IF VAL $ NE $ */
X int c;
X{
X /* DEBUGF(8, "line %3d: TO %c%c IF VAL %c NE %c (%d ne %d)" C c C
X param[0] C param[1] C param[2] C param[3] C v[param[2]] C v[param[3]]); */
X if (v[param[2]] != v[param[3]])
X return getnum();
X return c + 1;
X }
X
Xint Etipe(c) /* TO $$ IF PTR $ EQ $ */
X int c;
X{
X /* DEBUGF(8, "line %3d: TO %c%c IF PTR %c EQ %c (%d eq %d)" C c C
X param[0] C param[1] C param[2] C param[3] C p[param[2]] C p[param[3]]); */
X if (p[param[2]] == p[param[3]])
X return getnum();
X return c + 1;
X }
X
Xint Etipn(c) /* TO $$ IF PTR $ NE $ */
X int c;
X{
X /* DEBUGF(8, "line %3d: TO %c%c IF PTR %c NE %c (%d ne %d)" C c C
X param[0] C param[1] C param[2] C param[3] C p[param[2]] C p[param[3]]); */
X if (p[param[2]] != p[param[3]])
X return getnum();
X return c + 1;
X }
X
Xint Etipl(c) /* TO $$ IF PTR $ LT $ */
X int c;
X{
X /* DEBUGF(8, "line %3d: TO %c%c IF PTR %c LE %c (%d le %d)" C c C
X param[0] C param[1] C param[2] C param[3] C p[param[2]] C p[param[3]]); */
X if (p[param[2]] < p[param[3]])
X return getnum();
X return c + 1;
X }
X
X
END_OF_FILE
if test 2594 -ne `wc -c <'LOME/Ifuncs3.c'`; then
echo shar: \"'LOME/Ifuncs3.c'\" unpacked with wrong size!
fi
# end of 'LOME/Ifuncs3.c'
fi
if test -f 'LOME/Ifuncs4.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'LOME/Ifuncs4.c'\"
else
echo shar: Extracting \"'LOME/Ifuncs4.c'\" \(2846 characters\)
sed "s/^X//" >'LOME/Ifuncs4.c' <<'END_OF_FILE'
X/*
X * Ifuncs4.c
X * SCM Interpreter Function set Four
X * Copyright 1988 Darren New.
X * All rights reserved.
X */
X
X#include "PPL.h"
X#include "MacroIO.h"
X
X#include "Interp.h"
X
Xint Er(c) /* REWIND $ */
X int c;
X{
X f[param[0]] = (M_OK == MRewind(v[param[0]]));
X /* DEBUGF(8, "line %3d: REWIND %c (VAL %c=%d, FLG %c=%d)" C
X c C param[0] C param[0] C v[param[0]] C param[0] C f[param[0]]); */
X return c + 1;
X }
X
Xint Egb(c) /* GET BUFF $ */
X int c;
X{
X f[param[0]] = MGetBuff(v[param[0]]);
X /* DEBUGF(8, "line %3d: GET BUFF %c (VAL %c=%d, FLG %c=%d)" C
X c C param[0] C param[0] C v[param[0]] C param[0] C f[param[0]]); */
X return c + 1;
X }
X
Xint Epb(c) /* PUT BUFF $ */
X int c;
X{
X f[param[0]] = MPutBuff(v[param[0]]);
X /* DEBUGF(8, "line %3d: PUT BUFF %c (VAL %c=%d, FLG %c=%d)" C
X c C param[0] C param[0] C v[param[0]] C param[0] C f[param[0]]); */
X return c + 1;
X }
X
Xint Evi(c) /* VAL $ = INPUT */
X int c;
X{
X v[param[0]] = MGetChar();
X /* DEBUGF(8, "line %3d: VAL %c = INPUT (VAL %c=%d=`%c')" C
X c C param[0] C param[0] C v[param[0]] C v[param[0]]); */
X return c + 1;
X }
X
Xint Eov(c) /* OUTPUT = VAL $ */
X int c;
X{
X v[param[0]] = MPutChar(v[param[0]]);
X /* DEBUGF(8, "line %3d: OUTPUT = VAL %c (VAL %c=%d=`%c')" C
X c C param[0] C param[0] C v[param[0]] C v[param[0]]); */
X return c + 1;
X }
X
Xint Edebug(c) /* DEBUG */
X int c;
X{
X unsigned short i;
X unsigned short x, y, z;
X
X /* DEBUG_SETDEFS("RAW:0/190/640/200/Debug window", "T:DBugOut"); */
X /* DEBUG_ENTER("DEBUG DUMP", "LINE %d" C c); */
X for (i = '0'; i <= '9'; i++) {
X x = isprint(v[i]) ? v[i] : '?';
X /* DEBUGF(8, "Register %c: f=%d, v=%3d=%c, p=%d" C
X i C f[i] C v[i] C x C p[i]); */
X }
X for (i = 'A'; i <= 'Z'; i++) {
X x = isprint(v[i]) ? v[i] : '?';
X /* DEBUGF(8, "Register %c: f=%d, v=%3d=%c, p=%d" C
X i C f[i] C v[i] C x C p[i]); */
X }
X for (i = 0; i < MAXMEM; i++) {
X x = ((mem[i] >> 16) & 0x03);
X y = ((mem[i] >> 24) & 0xFF);
X z = (mem[i] & 0xFFFF);
X if (x || y || z) {
X /* DEBUGF(8, "M[%04d]=%d:%3d(%c):%4d" C
X i C x C y C isprint(y) ? y : '?' C z); */
X }
X }
X
X /* DEBUG_RETURN(NULL); */
X return c + 1;
X }
X
Xint Emt(c) /* MESSAGE $$$$ TO $ */
X int c;
X{
X int temp;
X MPutChar(0);
X for (temp = 0; temp < 20; temp++)
X MPutChar('*');
X MPutChar(' ');
X MPutChar(param[0]);
X MPutChar(param[1]);
X MPutChar(param[2]);
X MPutChar(param[3]);
X MPutChar(' ');
X MPutChar('E');
X MPutChar('R');
X MPutChar('R');
X MPutChar('O');
X MPutChar('R');
X MPutChar('!');
X MPutChar(0);
X f[param[4]] = MPutBuff(v[param[4]]);
X /* DEBUGF(8, "line %3d: MESSAGE %4s TO %c" C c C param C param[4]); */
X return c + 1;
X }
X
X
END_OF_FILE
if test 2846 -ne `wc -c <'LOME/Ifuncs4.c'`; then
echo shar: \"'LOME/Ifuncs4.c'\" unpacked with wrong size!
fi
# end of 'LOME/Ifuncs4.c'
fi
if test -f 'LOME/LOME.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'LOME/LOME.c'\"
else
echo shar: Extracting \"'LOME/LOME.c'\" \(2808 characters\)
sed "s/^X//" >'LOME/LOME.c' <<'END_OF_FILE'
X/*
X * LOME.c
X * Line Oriented Macro Expander data declaration file
X * Copyright 1989 Darren New
X *
X */
X
X#include "LOME.h"
X
Xchar params[O_last]; /* inputted parameter string */
X
Xunsigned char * macrochar; /* chars of macros (dyn alc) */
Xunsigned char * macroflag; /* flags of macros (dyn alc) */
Xmoffs macrosize; /* size of macros loaded */
X
Xstr varname[MAXvarnames]; /* names of variables */
Xstr varval[MAXvarnames]; /* values of variables */
X
Xstr ustack[MAXustack]; /* values of user stack */
Xshort ustacksize; /* # items on ustack */
X
Xstruct traceback_struct tstack[MAXnests]; /* traceback stack */
Xint tstacksize; /* traceback stack size */
X
Xshort sstack[MAXstreams]; /* input stream stack */
Xshort sstacksize; /* # items on sstack */
X
Xshort outstream; /* current output stream */
Xshort instream; /* current input stream */
X
Xchar consline[BIGLINE]; /* constructed line */
Xshort conslinesize; /* chars on cons line */
X
Xlong symgenval; /* symbol generator value */
X
Xlong skipping; /* skip value flag */
X
Xbool quitting; /* abnormally exitting */
X
X
X#if HIDPROTS
XHIDDEN void InitMemory ARGS((void));
X#endif
X
XHIDDEN void InitMemory()
X{
X /* output initially goes to stream 3 */
X outstream = 3;
X
X /* allocate memory for macro text */
X macrochar = (unsigned char *)
X PLAllocMem(MAXmacrochars, PLalloc_zero | PLalloc_die);
X macroflag = (unsigned char *)
X PLAllocMem(MAXmacrochars, PLalloc_zero | PLalloc_die);
X macrosize = 0;
X
X /* not abnormally quitting yet */
X quitting = FALSE;
X
X }
X
X#if HIDPROTS
XHIDDEN void CleanUp ARGS((void));
X#endif
X
XHIDDEN void CleanUp()
X{
X int j;
X
X if (macrochar) PLFreeMem(macrochar);
X if (macroflag) PLFreeMem(macroflag);
X
X for (j = 0; j < MAXvarnames; j++) {
X if (varname[j])
X PLFreeMem(varname[j]);
X if (varval[j])
X PLFreeMem(varval[j]);
X }
X
X for (j = 0; j < MAXustack; j++)
X if (ustack[j])
X PLFreeMem(ustack[j]);
X
X for (j = 0; j < MAXnests; j++) {
X if (Sinp) PLFreeMem(Sinp);
X if (Sp0) PLFreeMem(Sp0);
X if (Sp1) PLFreeMem(Sp1);
X if (Sp2) PLFreeMem(Sp2);
X if (Sp3) PLFreeMem(Sp3);
X if (Sp4) PLFreeMem(Sp4);
X if (Sp5) PLFreeMem(Sp5);
X if (Sp6) PLFreeMem(Sp6);
X if (Sp7) PLFreeMem(Sp7);
X if (Sp8) PLFreeMem(Sp8);
X if (Sp9) PLFreeMem(Sp9);
X }
X
X }
X
X
Xint AssertExit()
X{
X TraceBack();
X CleanUp();
X MStopIO();
X PLExit(PLsev_bomb);
X return 0;
X }
X
Xint BombExit()
X{
X return AssertExit();
X }
X
Xint FaultExit()
X{
X return AssertExit();
X }
X
Xshort DoIt()
X{
X bool loadok;
X
X MStartIO(PLargcnt, PLarglist);
X
X InitMemory();
X loadok = LoadMacros(1); /* macros are loaded from stream one */
X MRewind(1);
X
X if (loadok)
X ParseFiles(2); /* sources are loaded from stream two to start */
X
X CleanUp();
X
X MStopIO();
X return PLsev_normal;
X
X }
X
END_OF_FILE
if test 2808 -ne `wc -c <'LOME/LOME.c'`; then
echo shar: \"'LOME/LOME.c'\" unpacked with wrong size!
fi
# end of 'LOME/LOME.c'
fi
if test -f 'LOME/LOME2.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'LOME/LOME2.c'\"
else
echo shar: Extracting \"'LOME/LOME2.c'\" \(2881 characters\)
sed "s/^X//" >'LOME/LOME2.c' <<'END_OF_FILE'
X/*
X * LOME2.c
X * Line Oriented Macro Expander - ParseFiles()
X * Copyright 1989 Darren New
X *
X */
X
X#include "LOME.h"
X
X
X/* Some apologies are in order here: these functions are all void and
X all declare temporaries in the innermost place possible. They also
X all communicate through globals. HOWEVER, this was done intentionally
X to make reimplementing these algorithms in SCM easier. Sorry. */
X
X
X#ifdef HIDPROTS
XHIDDEN void OutputLine ARGS((void));
X#endif
X
XHIDDEN void OutputLine()
X{
X /* outputs the line that failed to match on TOS */
X
X int i;
X assert(0 < tstacksize);
X assert(Sinp != NULL);
X MPutChar(0); /* clear buffer */
X for (i = 0; Sinp[i]; i++)
X MPutChar(Sinp[i]);
X MPutChar(0);
X i = MPutBuff(outstream);
X }
X
X#ifdef HIDPROTS
XHIDDEN void ParseStack ARGS((void));
X#endif
X
XHIDDEN void ParseStack()
X{
X assert(0 <= tstacksize);
X
X while (tstacksize && ! quitting) {
X /* look for line only once, else returns cause starting over */
X if (Sretoffs < 0)
X FindMatch();
X if (Sretoffs < 0) { /* no match found */
X if ( (params[O_ZERO] + 2 == params[O_FMATCH]) ||
X (params[O_ZERO] + 1 == params[O_FMATCH] &&
X 1 == tstacksize) ) {
X Message("NONE");
X TraceBack();
X }
X else {
X OutputLine();
X PopTStack();
X }
X }
X else { /* match found - expand body lines */
X ExpandLine();
X }
X }
X
X }
X
X#ifdef HIDPROTS
XHIDDEN void StripHEOL ARGS((str s));
X#endif
X
XHIDDEN void StripHEOL ARGS1(str,s)
X{
X /* removes any trailing escape and chops off HEOL and on */
X int i;
X
X assert(s != NULL);
X i = 0;
X while (s[i]) {
X if (s[i] == params[O_ESC] && s[i+1])
X i += 2;
X else if (s[i] == params[O_ESC])
X s[i] = 0;
X else if (s[i] == params[O_HEOL])
X s[i] = 0;
X else
X i += 1;
X }
X }
X
X
Xvoid AddLineToStack ARGS1(str,line)
X{
X /* makes a copy of line and stacks it on traceback stack */
X tstacksize += 1;
X if (MAXnests <= tstacksize) {
X Message("NEST");
X tstacksize -= 1;
X TraceBack();
X }
X else {
X inx i;
X Sinp = PLStrDup(line);
X for (i = 0; i < 10; i++)
X Sp[i] = NULL;
X Sretoffs = -1;
X }
X }
X
X
Xvoid ParseFiles ARGS1(int,origstream)
X{
X char line[BIGLINE];
X
X assert(0 <= origstream && origstream <= 9);
X assert(macroflag != NULL);
X assert(macrochar != NULL);
X assert(0 < macrosize);
X
X sstack[0] = instream = origstream;
X sstacksize = 1;
X
X while (sstacksize && ! quitting) {
X int i = MGetBuff(instream);
X if (i == M_EOF || i == M_ILLEGAL) {
X if (i == M_ILLEGAL)
X Message("IOER");
X sstacksize -= 1;
X if (sstacksize)
X instream = sstack[sstacksize-1];
X else
X instream = 0;
X }
X else { /* read was OK */
X assert(0 <= skipping);
X if (skipping) {
X skipping -= 1;
X }
X else {
X int i = 0;
X do {
X line[i] = MGetChar();
X } while (line[i++]);
X StripHEOL(line);
X AddLineToStack(line);
X ParseStack();
X }
X }
X }
X
X }
X
X
X
END_OF_FILE
if test 2881 -ne `wc -c <'LOME/LOME2.c'`; then
echo shar: \"'LOME/LOME2.c'\" unpacked with wrong size!
fi
# end of 'LOME/LOME2.c'
fi
if test -f 'LOME/LOME7.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'LOME/LOME7.c'\"
else
echo shar: Extracting \"'LOME/LOME7.c'\" \(2597 characters\)
sed "s/^X//" >'LOME/LOME7.c' <<'END_OF_FILE'
X/*
X * LOME7.c
X * Line Oriented Macro Expander - DoSubsOp()
X * Copyright 1989 Darren New
X *
X */
X
X#include "LOME.h"
X
Xvoid DoSubsOp ARGS2(int,p /* the parameter number */,int,op /* the operation number */)
X{
X extern void DoMath ARGS((int p));
X
X assert(0 < tstacksize);
X assert(0 <= p && p <= 9);
X assert(0 <= op && op <= 9);
X
X switch (op) {
X
X case 0: {
X int i;
X if (Sp[p] != NULL && *Sp[p] != 0) {
X for (i = 0; Sp[p][i]; i++)
X ADDTOLINE(Sp[p][i]);
X ENDLINE();
X }
X break;
X }
X
X case 1: {
X char * l, * r;
X if (Sp[p] != NULL && *Sp[p] != 0) {
X for (l = Sp[p]; *l && *l == ' '; l += 1)
X /* look for first non-blank */;
X for (r = Sp[p] + strlen(Sp[p]) - 1;
X r >= l && *r == ' '; r -= 1)
X /* look for last non-blank */;
X if ( (*l == params[O_OP] && *r == params[O_CP]) ||
X (*l == params[O_OQ] && *r == params[O_CQ])) {
X l += 1; r -= 1;
X }
X while (l <= r)
X ADDTOLINE(*l++);
X ENDLINE();
X }
X break;
X }
X
X case 2: {
X DoMath(p);
X break;
X }
X
X case 3: {
X char * pnt;
X if (Sp[p] != NULL && *Sp[p] != 0) {
X pnt = VarLookup(Sp[p]);
X if (pnt != NULL && *pnt != 0) {
X while (*pnt)
X ADDTOLINE(*pnt++);
X ENDLINE();
X }
X }
X break;
X }
X
X case 4: {
X char * p1;
X char * p2;
X
X p1 = Sp[p];
X if (p1 && *p1 == 0) p1 = NULL;
X
X if (p1 != NULL) p2 = VarLookup(p1);
X else p2 = NULL;
X
X if (p2 != NULL && *p2 == 0) p2 = NULL;
X
X /* now, p2 != NULL iff var already has value set */
X
X if (p2 != NULL) {
X while (*p2)
X ADDTOLINE(*p2++);
X ENDLINE();
X }
X else {
X long value = symgenval++;
X short oldlen = conslinesize;
X
X InsNumber(value);
X
X if (p1 != NULL)
X VarSetVal(p1, &consline[oldlen]);
X }
X break;
X }
X
X case 5: {
X long val;
X
X if (Sp[p] != NULL)
X val = *Sp[p];
X else
X val = 0;
X
X InsNumber(val);
X
X break;
X }
X
X case 6: {
X long val;
X
X if (Sp[p] != NULL)
X val = strlen(Sp[p]);
X else
X val = 0;
X
X InsNumber(val);
X
X break;
X }
X
X case 7: {
X if (Sp[p] != NULL)
X PLFreeMem(Sp[p]);
X
X ENDLINE();
X Sp[p] = PLStrDup(consline);
X consline[conslinesize = 0] = 0;
X if (macroflag[Sretoffs] == 2) /* skip trailing BEOL if there */
X Sretoffs += 1;
X break;
X }
X
X case 8: {
X if (Sp[p] != NULL && *Sp[p] != 0)
X VarSetVal(Sp[p], consline);
X consline[conslinesize = 0] = 0;
X if (macroflag[Sretoffs] == 2) /* skip trailing BEOL if there */
X Sretoffs += 1;
X break;
X }
X
X case 9: {
X Message("NYET");
X TraceBack();
X break;
X }
X
X }
X
X }
X
X
END_OF_FILE
if test 2597 -ne `wc -c <'LOME/LOME7.c'`; then
echo shar: \"'LOME/LOME7.c'\" unpacked with wrong size!
fi
# end of 'LOME/LOME7.c'
fi
if test -f 'LOME/MacroIO.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'LOME/MacroIO.c'\"
else
echo shar: Extracting \"'LOME/MacroIO.c'\" \(3707 characters\)
sed "s/^X//" >'LOME/MacroIO.c' <<'END_OF_FILE'
X/*
X * MacroIO.c
X * Macro I/O Subsystem code file
X * Copyright 1988 Darren New.
X * All rights reserved.
X */
X
X#include "PPL.h"
X#include "TFS.h"
X
X#include "MacroIO.h"
X
Xshort MEchoFlag;
X
XHIDDEN char linebuff[BIGLINE];
XHIDDEN short ccp;
X
XHIDDEN int namecount;
XHIDDEN TFSfile stream[10];
XHIDDEN str name[10];
XHIDDEN char mode[10]; /* C = closed, R = reading, W = writing */
XHIDDEN char scratch[10]; /* 1 = discard on close */
X
XHIDDEN bool initted;
X
X
Xint MGetBuff ARGS1(int,which)
X{
X int i;
X
X PLErrClr();
X
X ccp = 0; linebuff[ccp] = 0;
X
X if (which == 0) return M_EOF;
X
X if (which < 0 || 9 < which) return M_ILLEGAL;
X
X if (mode[which] == 'C') { /* must open */
X stream[which] = TFSOpen(name[which], scratch[which] ? "RCD" : "RC");
X if (stream[which] != 0)
X mode[which] = 'R';
X else {
X return M_ILLEGAL;
X }
X }
X if (mode[which] == 'W')
X return M_ILLEGAL;
X i = TFSRead(stream[which], linebuff);
X if (i == -1) {
X if (PLerr == PLerr_eod) {
X PLErrClr();
X return M_EOF;
X }
X else {
X return M_ILLEGAL;
X }
X }
X
X if (MEchoFlag)
X PLStatus(6, linebuff);
X
X return M_OK;
X }
X
X
Xint MPutBuff ARGS1(int,which)
X{
X int i;
X
X PLErrClr();
X
X ccp = 0;
X
X if (which == 0) return M_OK;
X
X if (which < 0 || 9 < which) return M_ILLEGAL;
X
X if (mode[which] == 'C') { /* must open */
X stream[which] = TFSOpen(name[which], scratch[which] ? "WCTD" : "WCT");
X if (stream[which] != 0)
X mode[which] = 'W';
X else {
X return M_ILLEGAL;
X }
X }
X if (mode[which] == 'R') {
X return M_ILLEGAL;
X }
X i = TFSWrite(stream[which], linebuff);
X if (i == -1) {
X if (PLerr == PLerr_eod) {
X PLErrClr();
X return M_EOF;
X }
X else {
X return M_ILLEGAL;
X }
X }
X
X return M_OK;
X }
X
X
Xint MPutChar ARGS1(int,chr)
X{
X assert(0 <= ccp);
X
X if (ccp == BIGLINE - 1)
X return 0;
X
X chr = chr & 0xFF;
X linebuff[ccp++] = chr;
X
X if (chr == 0) ccp = 0;
X
X return chr;
X }
X
X
Xint MGetChar ARGS0()
X{
X char c;
X
X assert(0 <= ccp);
X assert(ccp < BIGLINE);
X
X c = 0xFF & linebuff[ccp++];
X if (c == 0) ccp = 0;
X return (int) c;
X }
X
X
Xint MRewind ARGS1(int,which)
X{
X
X PLErrClr();
X
X if (which == 0) return M_OK;
X
X if (which < 0 || 9 < which) return M_ILLEGAL;
X
X if (mode[which] != 'C') {
X TFSClose(stream[which]);
X stream[which] = 0;
X mode[which] = 'C';
X }
X return M_OK;
X }
X
X
Xint MRename ARGS2(int,which,str,newname)
X{
X TFSfile j;
X
X assert(newname != NULL);
X
X PLErrClr();
X
X if (which == 0) return M_ILLEGAL;
X
X if (which < 0 || 9 < which) return M_ILLEGAL;
X
X if (mode[which] != 'C') {
X if (scratch[which])
X TFSDestroy(stream[which]);
X else
X TFSClose(stream[which]);
X }
X else if (scratch[which]) {
X /* closed scratch file to be discarded */
X j = TFSOpen(name[which], "D");
X if (j) TFSDestroy(j);
X }
X
X mode[which] = 'C';
X scratch[which] = 0;
X
X PLFreeMem(name[which]);
X name[which] = PLStrDup(newname);
X
X return M_OK;
X }
X
X
Xint MStartIO ARGS2(int,argc,str*,argv)
X{
X inx i;
X
X PLErrClr();
X
X initted = ! TFSHasBeenInit();
X if (initted) TFSInit();
X
X
X name[0] = "::::"; /* should never get referenced */
X
X for (i = 0; i < argc; i++) {
X name[i+1] = PLStrDup(argv[i]);
X }
X
X namecount = ++i;
X
X while (i < 10) {
X name[i] = PLStrDup("t:TEMP?");
X name[i][6] = i + '0';
X scratch[i] = 1;
X i += 1;
X }
X for (i = 0; i < 10; i++)
X mode[i] = 'C';
X
X return 0;
X }
X
X
Xint MStopIO ARGS0()
X{
X inx i;
X
X PLErrClr();
X
X for (i = 1; i < 10; i++) {
X if (stream[i]) {
X if (scratch[i])
X TFSDestroy(stream[i]);
X else
X TFSClose(stream[i]);
X }
X PLFreeMem(name[i]);
X }
X
X if (initted) TFSTerm();
X initted = FALSE;
X
X return 0;
X }
X
X
END_OF_FILE
if test 3707 -ne `wc -c <'LOME/MacroIO.c'`; then
echo shar: \"'LOME/MacroIO.c'\" unpacked with wrong size!
fi
# end of 'LOME/MacroIO.c'
fi
if test -f 'LOME/MakeTail' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'LOME/MakeTail'\"
else
echo shar: Extracting \"'LOME/MakeTail'\" \(3867 characters\)
sed "s/^X//" >'LOME/MakeTail' <<'END_OF_FILE'
X# Makefile for PPL LOME -- Line Oriented Macro Expander
X
X.c.o :
X $(CC) $(CFLAGS) $*.c
X
X$(MACHINE) : LOME Comp1 Interp
X date >$(MACHINE)
X
XLOME : LOME.o LOME0.o LOME1.o LOME2.o LOME3.o LOME4.o LOME5.o LOME6.o LOME7.o LOME8.o MacroIO.o
X ld.$(MACHINE) LOME LOME.o LOME0.o LOME1.o LOME2.o LOME3.o LOME4.o LOME5.o LOME6.o LOME7.o LOME8.o MacroIO.o
X
XLOME.o : LOME.c LOME.h MacroIO.h $(INC)PPL.h
X
XLOME0.o : LOME0.c LOME.h MacroIO.h $(INC)PPL.h
X
XLOME1.o : LOME1.c LOME.h MacroIO.h $(INC)PPL.h
X
XLOME2.o : LOME2.c LOME.h MacroIO.h $(INC)PPL.h
X
XLOME3.o : LOME3.c LOME.h MacroIO.h $(INC)PPL.h
X
XLOME4.o : LOME4.c LOME.h MacroIO.h $(INC)PPL.h
X
XLOME5.o : LOME5.c LOME.h MacroIO.h $(INC)PPL.h
X
XLOME6.o : LOME6.c LOME.h MacroIO.h $(INC)PPL.h
X
XLOME7.o : LOME7.c LOME.h MacroIO.h $(INC)PPL.h
X
XLOME8.o : LOME8.c LOME.h MacroIO.h $(INC)PPL.h
X
XMacroIO.o : MacroIO.c MacroIO.h $(INC)PPL.h $(INC)TFS.h
X
XMIOtest : MIOtest.o MacroIO.o $(PPLLIB)
X ld.$(MACHINE) MIOtest MIOtest.o MacroIO.o
X
XComp1 : Comp1.o MacroIO.o $(PPLLIB)
X ld.$(MACHINE) Comp1 Comp1.o MacroIO.o
X
XComp1.o : Comp1.c $(INC)PPL.h MacroIO.h
X
XInterp : Interp.o Iparse.o Ifuncs1.o Ifuncs2.o Ifuncs3.o Ifuncs4.o MacroIO.o $(PPLLIB)
X ld.$(MACHINE) Interp Interp.o Iparse.o Ifuncs1.o Ifuncs2.o Ifuncs3.o Ifuncs4.o MacroIO.o
X
XInterp.o : Interp.c Interp.h
X
XIparse.o : Iparse.c $(INC)PPL.h $(INC)TFS.h MacroIO.h Interp.h
X
XIfuncs1.o : Ifuncs1.c $(INC)PPL.h MacroIO.h Interp.h
X
XIfuncs2.o : Ifuncs2.c $(INC)PPL.h MacroIO.h Interp.h
X
XIfuncs3.o : Ifuncs3.c $(INC)PPL.h MacroIO.h Interp.h
X
XIfuncs4.o : Ifuncs4.c $(INC)PPL.h MacroIO.h Interp.h
X
XLOME.cat : LOME.doc
X roff >LOME.cat -ub LOME.doc
X
X
Xtest : testMIO testLOME testCOMP1 testINTERP testRUBIN # do regression tests
X
X#testMIO tests the basic MacroIO implementation
X
XtestMIO : MIOtest MIOtest1.inp
X -$(DELETE) t:$(WILDCARD)
X MIOtest MIOtest1.inp t:MIOtest2.out t:MIOtest3.out
X $(DIFF) MIOtest2.out t:MIOtest2.out
X $(DIFF) MIOtest3.out t:MIOtest3.out
X $(DIFF) MIOtest8.out t:MIOTEST8.out
X
X#testLOME tests most aspects of LOME
X#This should print out one line on the console
X#t:LOME3.out and up should not exist
X
XtestLOME : LOME LOME.mac LOME.inp
X -$(DELETE) t:$(WILDCARD)
X LOME LOME.mac LOME.inp t:LOME1.out t:LOME2.out t:LOME3.out t:LOME4.out
X $(DIFF) LOME1.out t:LOME1.out
X $(DIFF) LOME2.out t:LOME2.out
X $(DIFF) LOME9.out t:LOME9.out
X
X#This tests both the SCM.mac file and the Comp1 compiler
XtestCOMP1 : Comp1 SCM.mac SCMTestP.scm SCMTestD.inp
X -$(DELETE) t:$(WILDCARD)
X Comp1 SCM.mac SCMTestP.scm SCMTestP.c $(TTY)
X $(DIFF) SCMTestC.out SCMTestP.c
X $(CC) $(CFLAGS) SCMTestP.c
X ld.$(MACHINE) SCMTestP SCMTestP.o MacroIO.o
X -$(DELETE) t:SCMTestD.out
X SCMTestP SCMTestD.inp t:SCMTestD.out $(TTY) $(TTY)
X $(DIFF) SCMTestD.out t:SCMTestD.out
X -$(DELETE) SCMTestP.c
X -$(DELETE) SCMTestP.o
X -$(DELETE) SCMTestP
X
X#This tests the interpreter
XtestINTERP : Interp SCMTestP.scm SCMTestD.inp
X -$(DELETE) t:$(WILDCARD)
X Interp SCMTestP.scm SCMTestD.inp t:SCMTestD.out
X $(DIFF) SCMTestD.out t:SCMTestD.out
X
X#This exercises LOME some more by running more examples
XtestRUBIN : LOME Rubin.mac Rubin.inp Rubin.out
X LOME Rubin.mac Rubin.inp t:Rubin.out $(TTY) $(TTY) $(TTY)
X $(DIFF) Rubin.out t:Rubin.out
X
X
Xtags : LOME.c LOME.h LOME0.c LOME1.c LOME2.c LOME3.c LOME4.c
Xtags : LOME5.c LOME6.c LOME7.c LOME8.c MacroIO.h MacroIO.c
X ctags LOME.c LOME.h LOME0.c LOME1.c LOME2.c LOME3.c LOME4.c
X ctags -a LOME5.c LOME6.c LOME7.c LOME8.c MacroIO.h MacroIO.c
X
X
Xzap : clean
X -$(DELETE) $(MACHINE)
X -$(DELETE) LOME
X -$(DELETE) Comp1
X -$(DELETE) Interp
X -$(DELETE) MIOtest
X -$(DELETE) tags
X
Xclean :
X -$(DELETE) $(WILDCARD).tmp
X -$(DELETE) $(WILDCARD).o
X -$(DELETE) $(WILDCARD).lnk
X -$(DELETE) t:$(WILDCARD)
X -$(DELETE) $(WILDCARD).err
X -$(DELETE) core #UNIX crash dump
X -$(DELETE) SnapShot.TB #Amiga LC crash dump
X -$(DELETE) SCMTestP.c
X -$(DELETE) SCMTestP.o
X -$(DELETE) SCMTestP
X
X#end of Makefile
X
X
END_OF_FILE
if test 3867 -ne `wc -c <'LOME/MakeTail'`; then
echo shar: \"'LOME/MakeTail'\" unpacked with wrong size!
fi
# end of 'LOME/MakeTail'
fi
if test -f 'LOME/Rubin.out' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'LOME/Rubin.out'\"
else
echo shar: Extracting \"'LOME/Rubin.out'\" \(2569 characters\)
sed "s/^X//" >'LOME/Rubin.out' <<'END_OF_FILE'
XFILE: Rubin&.inp
XThis is a test file for Rubin
XIt really doesn't do anything except test a few options
XThis is by no means an exhaustive test
X
XThis should come out unchanged
Xbecause it does not start with an asterisk
X
XTest simple cases:
XC gamma = alpha + beta
X CALLQ8 ADD(0,0,gamma,0,alpha,0,beta,0)
XC gamma = alpha - beta
X CALLQ8 SUB(0,0,gamma,0,alpha,0,beta,0)
XC gamma = alpha * beta
X CALLQ8 MULT(0,0,gamma,0,alpha,0,beta,0)
XC gamma = alpha / beta
X CALLQ8 DIV(0,0,gamma,0,alpha,0,beta,0)
X
XTest simple cases with modifiers:
XC gamma = alpha +x beta
X CALLQ8 ADDx(0,0,gamma,0,alpha,0,beta,0)
XC gamma = alpha -h beta
X CALLQ8 SUBh(0,0,gamma,0,alpha,0,beta,0)
XC gamma = alpha *f beta
X CALLQ8 MULTf(0,0,gamma,0,alpha,0,beta,0)
XC gamma = alpha /u beta
X CALLQ8 DIVu(0,0,gamma,0,alpha,0,beta,0)
X
XTest negations
XC gamma = -alpha + beta
X CALLQ8 ADD(2,0,gamma,0,alpha,0,beta,0)
X
XTest absolute values
XC gamma = |alpha - beta
X CALLQ8 SUB(4,0,gamma,0,alpha,0,beta,0)
XC gamma = |alpha - |beta
X CALLQ8 SUB(5,0,gamma,0,alpha,0,beta,0)
XC gamma = alpha - |beta
X CALLQ8 SUB(1,0,gamma,0,alpha,0,beta,0)
XC gamma = -|alpha - |beta
X CALLQ8 SUB(7,0,gamma,0,alpha,0,beta,0)
X
XTest a w field
XC gamma = alpha + beta /\omega
X CALLQ8 ADD(0,0,gamma,0,alpha,omega,beta,0)
XC gamma = alpha + beta /\~omega
X CALLQ8 ADD(64,0,gamma,0,alpha,omega,beta,0)
X
XTry the type casts
XC gamma =(half) alpha + beta
X CALLQ8 ADD(128,0,gamma,0,alpha,0,beta ,0)
XC gamma =(full) alpha + beta
X CALLQ8 ADD(0,0,gamma,0,alpha,0,beta ,0)
XC gamma = (scalar)alpha + beta
X CALLQ8 ADD(16,0,gamma,0,alpha,0,beta,0)
XC gamma = alpha + (scalar)beta
X CALLQ8 ADD(8,0,gamma,0,alpha,0,beta,0)
XC gamma = (scalar)alpha + (scalar)beta
X CALLQ8 ADD(24,0,gamma,0,alpha,0,beta,0)
XC gamma =(half) (scalar)alpha + (scalar)beta
X CALLQ8 ADD(152,0,gamma,0,alpha,0,beta ,0)
X
XTry x, y, and z
XC gamma'gift = alpha + beta
X CALLQ8 ADD(32,0,gamma,0,alpha,0,beta,gift)
XC gamma = alpha'apple + beta
X CALLQ8 ADD(0,apple,gamma,0,alpha,0,beta,0)
XC gamma = alpha + beta'book
X CALLQ8 ADD(0,0,gamma,book,alpha,0,beta,0)
XC gamma'gift = alpha'apple + beta'book
X CALLQ8 ADD(32,apple,gamma,book,alpha,0,beta,gift)
X
XTry a line with everything on it
XC gamma'gift =(half) -|(scalar)alpha'apple *big |(scalar)beta'book /\~omega
X CALLQ8 MULTbig(255,apple,gamma,book,alpha,omega,beta ,gift)
X
END_OF_FILE
if test 2569 -ne `wc -c <'LOME/Rubin.out'`; then
echo shar: \"'LOME/Rubin.out'\" unpacked with wrong size!
fi
# end of 'LOME/Rubin.out'
fi
if test -f 'LOME/SCMTestD.inp' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'LOME/SCMTestD.inp'\"
else
echo shar: Extracting \"'LOME/SCMTestD.inp'\" \(3137 characters\)
sed "s/^X//" >'LOME/SCMTestD.inp' <<'END_OF_FILE'
X1. IF SCM MACROS ARE CORRECT, OUTPUT CONTAINS NO LINES STARTING WITH X
X2. Lines starting with X indicate errors in macros or I/O.
X3. First three lines rely on VAL B = 1 + 0, VAL W = 2 + 0, GET BUFF B, PUT BUFF W.
X4. If this works, CALL F seems to work.
XX 001 TO $$ did not skip
XX 002 TO $$ IF FLG $ EQ $ fails on equal
XX 003 TO $$ IF FLG $ EQ $ skips on unequal
XX 004 TO $$ IF FLG $ NE $ skips on equal
XX 005 TO $$ IF FLG $ NE $ fails on unequal
XX 006 TO $$ IF VAL $ EQ $ fails on equal
XX 007 TO $$ IF VAL $ EQ $ skips on unequal
XX 008 TO $$ IF VAL $ NE $ skips on equal
XX 009 TO $$ IF VAL $ NE $ fails on unequal
XX 010 TO $$ IF PTR $ EQ $ fails on equal
XX 011 TO $$ IF PTR $ EQ $ skips on unequal
XX 012 TO $$ IF PTR $ NE $ skips on equal
XX 013 TO $$ IF PTR $ NE $ fails on unequal
XX 014 TO $$ IF PTR $ LT $ fails on less than
XX 015 TO $$ IF PTR $ LT $ skips on greater than
XX 016 TO $$ IF PTR $ LT $ skips on equal
XX 017 FLG $ = $ did not change destination
XX 018 VAL $ = PTR $ did not change destination
XX 019 PTR $ = VAL $ did not change destination
XX 020 PTR $ = VAL $ changes FLG field
XX 021 PTR $ = VAL $ changes VAL field
XX 022 VAL $ = PTR $ changes FLG field
XX 023 VAL $ = PTR $ changes PTR field
XX 024 FLG $ = $ changes VAL field
XX 025 VAL $ = $ changes PTR field
XX 026 VAL $ = $ + $ fails for (1 + 2)
XX 027 VAL $ = $ + $ changes PTR for (1 + 2)
XX 028 VAL $ = $ + $ changes FLG for (1 + 2)
X5. Next line contains "6. GOOD" - anything else is wrong
X6. DOG
XX 029 VAL $ = INPUT did not find end-of-line in right place
X7. Next line contains "8. 0 1 2 3 4 5 6 7 8 9" from VAL fields
X8. 0
XX 030 VAL $ = INPUT did not find end-of-line in right place
X9. Next line contains "10. 0 1 2 3" from PTR fields
X10. 0
XX 031 VAL $ = INPUT did not find end-of-line in right place
XX 032 PTR $ = $ + $ changes FLG field (1 + 2)
XX 033 PTR $ = $ + $ changes VAL field (1 + 2)
XX 034 PTR $ = $ + $ fails (for 1 + 2)
XX 035 PTR $ = $ - $ changes FLG field (1 - 3)
XX 036 PTR $ = $ - $ changes VAL field (1 - 3)
XX 037 PTR $ = $ - $ fails (1 - 3)
XX 038 VAL $ = $ - $ changes FLG field (1 - 3)
XX 039 VAL $ = $ - $ changes PTR field (1 - 3)
XX 040 VAL $ = $ - $ fails (1 - 3)
XX 041 PTR $ = $ * $ fails (1 * 3)
XX 042 PTR $ = $ * $ changes VAL field (3 * 3)
XX 043 PTR $ = $ * $ changes FLG field (3 * 3)
XX 044 PTR $ = $ / $ fails (6 / 2)
XX 045 PTR $ = $ / $ changes VAL field (6 / 2)
XX 046 PTR $ = $ / $ changes FLG field (6 / 2)
XX 047 PTR $ = $ / $ does not return 3 = 7 / 2
XX 048 PTR $ = $ / $ does not return (-3) = (-7) / 2
XX 049 PTR $ = $ / $ does not return (-3) = 7 / (-2)
XX 050 PTR $ = $ / $ does not return 3 = (-7) / (-2)
XX 051 PTR $ = $ * $ does not return (-4) = 2 * (-2)
XX 052 PTR $ = $ * $ does not return (-4) = (-2) * 2
XX 053 PTR $ = $ * $ does not return 4 = (-2) * (-2)
XX 054 TO $$ IF VAL $ EQ $ skips on (-6, +6)
XX 055 TO $$ IF VAL $ NE $ fails on (-6, +6)
XX 056 TO $$ IF PTR $ EQ $ skips on (-3, +3)
XX 057 TO $$ IF PTR $ NE $ fails on (-3, +3)
XX 058 TO $$ IF PTR $ LT $ fails on (-3, +3)
XX 059 TO $$ IF PTR $ LT $ skips on (+3, -3)
X99. This should be printed as the last line. - END OF TEST ONE
XX IF THIS PRINTS, DATA OR PROGRAM IS INCORRECT!
X
END_OF_FILE
if test 3137 -ne `wc -c <'LOME/SCMTestD.inp'`; then
echo shar: \"'LOME/SCMTestD.inp'\" unpacked with wrong size!
fi
# end of 'LOME/SCMTestD.inp'
fi
if test -f 'PPL/FaultAmiga.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'PPL/FaultAmiga.c'\"
else
echo shar: Extracting \"'PPL/FaultAmiga.c'\" \(2248 characters\)
sed "s/^X//" >'PPL/FaultAmiga.c' <<'END_OF_FILE'
X/*
X FaultAmiga.c
X This is the code for AssertBomb.
X*/
X
X#include "proto/exec.h"
X#include "proto/intuition.h"
X#include "proto/dos.h"
X
Xint AssertBomb(char *, char *, int, int, int (*)());
X
Xint AssertBomb(s, file, line, z, exitfunc)
Xchar * s; /* text of assertion */
Xchar * file; /* file that AssertBomb call appeared in */
Xint line; /* line at which alertbomb appeared */
Xint z; /* special string flag */
Xint (*exitfunc)(void); /* call this if assert fails */
X{
X#define c(x) *i++ = (x)
X register int result = 0;
X register char * j;
X char dispmess[500];
X register char * i;
X int flag = 0;
X
X i = dispmess;
X if (IntuitionBase == 0) {
X flag = 1;
X IntuitionBase = (struct IntuitionBase *)
X OpenLibrary("intuition.library", 0);
X }
X
X /* display s at upper left */
X c(0); c(15); c(15);
X if ((z & 7) == 1) {
X j = "Assert: ";
X while (*j) c(*j++);
X }
X else if ((z & 7) == 2) {
X j = "Fault: ";
X while (*j) c(*j++);
X }
X else if ((z & 7) == 3) {
X j = "Bomb: ";
X while (*j) c(*j++);
X }
X j = s;
X while (*j) c(*j++);
X c(0); c(1);
X
X /* file, then line on line two */
X c(0); c(15); c(30);
X j = file;
X while (*j) c(*j++);
X c(' '); c(' ');
X c('0' + (line / 10000 % 10));
X c('0' + (line / 1000 % 10));
X c('0' + (line / 100 % 10));
X c('0' + (line / 10 % 10));
X c('0' + (line / 1 % 10));
X c(0); c(1);
X
X /* left / right messages */
X if (0 == (z & 0x80)) {
X c(0); c(20); c(45);
X j = "Left mouse to retry after pause.";
X while (*j) c(*j++);
X c(0); c(1);
X }
X c(450 / 256); c(450 % 256); c(45);
X j = "Right mouse to abort.";
X while (*j) c(*j++);
X c(0); c(0);
X
X result = DisplayAlert(0, dispmess, 55);
X
X if (flag) {
X CloseLibrary((struct Library *) IntuitionBase);
X IntuitionBase = 0;
X }
X
X if (result == 0 && 0 != (z & 0x80)) {
X (*exitfunc)();
X }
X
X /* Here, if the user requests to retry, we delay for fifteen
X seconds to allow the user to close other apps, change disks,
X or whatever it takes to make this succeed. This is needed
X because DisplayAlert() disables the multitasking. */
X
X if (result && 0 == (z & 0x80))
X Delay((unsigned long) 50 * 15);
X else if (result)
X Delay((unsigned long) 50);
X
X return result;
X }
X
END_OF_FILE
if test 2248 -ne `wc -c <'PPL/FaultAmiga.c'`; then
echo shar: \"'PPL/FaultAmiga.c'\" unpacked with wrong size!
fi
# end of 'PPL/FaultAmiga.c'
fi
if test -f 'PPL/FaultUnix.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'PPL/FaultUnix.c'\"
else
echo shar: Extracting \"'PPL/FaultUnix.c'\" \(2149 characters\)
sed "s/^X//" >'PPL/FaultUnix.c' <<'END_OF_FILE'
X/*
X FaultUnix.c
X This is the code for AssertBomb.
X*/
X
X#include <stdio.h>
Xextern int open(char *, int);
Xextern int read(int, char *, int);
Xextern int write(int, char *, int);
Xextern int close(int);
Xextern void fflush(FILE *);
Xextern int strlen(char *);
Xextern int isatty(int);
X
Xint AssertBomb(char *, char *, int, int, int (*)(void));
X
Xint AssertBomb(s, file, line, z, exitfunc)
Xchar * s; /* text of assertion */
Xchar * file; /* file that AssertBomb call appeared in */
Xint line; /* line at which alertbomb appeared */
Xint z; /* special string flag */
Xint (*exitfunc)(void); /* call this if assert fails */
X{
X#define c(x) *i++ = (x)
X register int result = 1;
X register char * j;
X char dispmess[500];
X register char * i;
X char flag = 0;
X int fh;
X
X i = dispmess;
X fh = open("/dev/tty", 2); /* open console R/W */
X
X /* display s at upper left */
X c('\r'); c('\n');
X if ((z & 7) == 1) {
X j = "Assert: ";
X while (*j) c(*j++);
X }
X else if ((z & 7) == 2) {
X j = "Fault: ";
X while (*j) c(*j++);
X }
X else if ((z & 7) == 3) {
X j = "Bomb: ";
X while (*j) c(*j++);
X }
X j = s;
X while (*j) c(*j++);
X c('\r'); c('\n');
X
X /* file, then line on line two */
X j = file;
X while (*j) c(*j++);
X c(' '); c(' ');
X c('0' + (line / 10000 % 10));
X c('0' + (line / 1000 % 10));
X c('0' + (line / 100 % 10));
X c('0' + (line / 10 % 10));
X c('0' + (line / 1 % 10));
X c('\r'); c('\n');
X
X /* left / right messages */
X if (0 == (z & 0x80)) {
X j = "R to retry. ";
X while (*j) c(*j++);
X }
X j = "A to abort.";
X while (*j) c(*j++);
X c('\r'); c('\n'); c('\0');
X
X if (fh != -1 && isatty(fh)) {
X int i; /* don't try to read anymore on EOF or error */
X fflush(stdout); fflush(stderr); fflush(stdin);
X (void) write(fh, dispmess, strlen(dispmess));
X if (1 != (i = read(fh, &flag, 1)) || (flag != 'R' && flag != 'r'))
X result = 0;
X else
X result = 1;
X while (flag != '\n' && 1 == i && 1 == read(fh, &flag, 1))
X /* toss the rest of the line */ ;
X (void) close(fh);
X }
X
X if (result == 0 && 0 != (z & 0x80)) {
X (*exitfunc)();
X }
X
X return result;
X }
X
END_OF_FILE
if test 2149 -ne `wc -c <'PPL/FaultUnix.c'`; then
echo shar: \"'PPL/FaultUnix.c'\" unpacked with wrong size!
fi
# end of 'PPL/FaultUnix.c'
fi
if test -f 'TFS/TFS.doc' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'TFS/TFS.doc'\"
else
echo shar: Extracting \"'TFS/TFS.doc'\" \(2767 characters\)
sed "s/^X//" >'TFS/TFS.doc' <<'END_OF_FILE'
X.rm 75
X.rm 70
X.po 2
X.he 'TFS.Doc'Text File Subsystem'Darren New'
X.fo ' Page #' 'Printed % '
X.pl 63
X.nj
X.ce 4
XThis documentation and all accompanying files
XCopyright 1988 Darren New.
XAll Rights Reserved.
XSee README for distribution conditions.
X
XThis file documents the proposed "Text File Subsystem"
X(hereinafter referred to as "TFS"),
Xa subsystem of the "Portable Programmer's Library".
X
X
XThe TFS allows for the manipulation of line-oriented text files. It is not
Xpossible with the TFS to manipulate only parts of lines; only full lines
Xmay be written or read. In addition, it is not possible to update the
Xmiddle of a TFS file; a given file is opened either for read or write, not
Xboth. While reading, it may be possible to seek to other lines within the
Xfile; this depends on the host. Note that all of these routines are
Ximplemented for each host; there are no high-level routines here.
X
X.fi
X.ce
X***************************************************************
X
XThe TFS supports the following functions, as described more fully in the
XTFS.h header file.
X
XTFSInit() - Called to allow host to initialize anything it needs.
X
XTFSOpen() - Open a text file. Arguments include the open mode and the
Xhost-syntax file name to be opened. Return is a TFSfile "handle". This
Xhandle is in an internal format that the application cannot access. The
Xhandle returned is a LONG, but it may just be an index into a table or it
Xmay be cast from a pointer. In any case, a return of zero means an error
Xhas ocurred. If the file is opened for reading, other processes may be able
Xto read the file at the same time. If any process opens the file for
Xwriting, only that process may access that file until it is closed. A file
Xmust be opened before ANY other operation may be applied, including TFSInfo
Xand TFSDestroy.
X
XTFSClose() - Close a text file. This breaks a connection between a
Xhandle and a file, possibly after flushing buffers. After this, other
Xprocesses or programs may access the file.
X
XTFSInfo() - Determine file parameters. This may return various
Xparameters about the given file. The description of the information
Xreturned is given in the TFS.h file.
X
XTFSRead() - Read a line. Only entire lines are read. A '\0' is
Xappened to the buffer. Lines longer than BIGLINE get truncated with an
Xerror return.
X
XTFSWrite() - Write a line. The buffer must end in a '\0' and must be
Xshorter that BIGLINE.
X
XTFSNote() - Remember from where in the file the next line will be
Xread.
X
XTFSPoint() - Return file to where is was when TFSNote() was called.
X
XTFSDestroy() - Free space occupied by a text file. This may return an
Xerror if another process has the file open.
X
XTFSTerm() - Allows host to deinitialize anything it needs.
X
X
X
END_OF_FILE
if test 2767 -ne `wc -c <'TFS/TFS.doc'`; then
echo shar: \"'TFS/TFS.doc'\" unpacked with wrong size!
fi
# end of 'TFS/TFS.doc'
fi
if test -f 'TFS/TestTFS.inp' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'TFS/TestTFS.inp'\"
else
echo shar: Extracting \"'TFS/TestTFS.inp'\" \(2291 characters\)
sed "s/^X//" >'TFS/TestTFS.inp' <<'END_OF_FILE'
XTest Line One
XThis is Two
X
XThis, too, should appear.
X
XThis has trailing spaces
XThis has trailing tabs and spaces
X This has a leading tab.
X This has eight leading spaces
XThis has exactly one trailing tab
XThis has exactly one trailing space
X
X01234567890123456789012345678901234567890123456
X012345678901234567890123456789012345678901234567
X0123456789012345678901234567890123456789012345678
X01234567890123456789012345678901234567890123456789
X012345678901234567890123456789012345678901234567890
X
Xa123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456
Xb1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567
Xc12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
Xd123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789
Xe1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
Xf12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901
Xg123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012
X
XThis is the last line---
END_OF_FILE
if test 2291 -ne `wc -c <'TFS/TestTFS.inp'`; then
echo shar: \"'TFS/TestTFS.inp'\" unpacked with wrong size!
fi
# end of 'TFS/TestTFS.inp'
fi
if test -f 'TFS/TestTFS2.out' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'TFS/TestTFS2.out'\"
else
echo shar: Extracting \"'TFS/TestTFS2.out'\" \(2290 characters\)
sed "s/^X//" >'TFS/TestTFS2.out' <<'END_OF_FILE'
XTest Line One
XThis is Two
X
XThis, too, should appear.
X
XThis has trailing spaces
XThis has trailing tabs and spaces
X This has a leading tab.
X This has eight leading spaces
XThis has exactly one trailing tab
XThis has exactly one trailing space
X
X01234567890123456789012345678901234567890123456
X012345678901234567890123456789012345678901234567
X0123456789012345678901234567890123456789012345678
X01234567890123456789012345678901234567890123456789
X012345678901234567890123456789012345678901234567890
X
Xa123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456
Xb1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567
Xc12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
Xd12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
Xe12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
Xf12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
Xg12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
X
XThis is the last line---
X3 Trailing spaces:
END_OF_FILE
if test 2290 -ne `wc -c <'TFS/TestTFS2.out'`; then
echo shar: \"'TFS/TestTFS2.out'\" unpacked with wrong size!
fi
# end of 'TFS/TestTFS2.out'
fi
echo shar: End of archive 2 \(of 9\).
cp /dev/null ark2isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 9 archives.
rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0
--
--- Darren New --- Grad Student --- CIS --- Univ. of Delaware ---
exit 0 # Just in case...
--
Please send comp.sources.unix-related mail to rsalz at uunet.uu.net.
Use a domain-based address or give alternate paths, or you may lose out.
More information about the Comp.sources.unix
mailing list