rsalz@bbn.com (Rich Salz) (11/30/90)
Submitted-by: Darren New <new@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@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@uunet.uu.net. Use a domain-based address or give alternate paths, or you may lose out.