rsalz@bbn.com (Rich Salz) (11/30/90)
Submitted-by: Darren New <new@ee.udel.edu> Posting-number: Volume 23, Issue 53 Archive-name: lome/part03 #! /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 3 (of 9)." # Contents: LOME/Iparse.c LOME/LOME0.c LOME/LOME1.c LOME/LOME3.c # LOME/LOME6.c LOME/MIOtest.c LOME/MacroIO.doc LOME/MacroIO.h # LOME/SCM.mac # Wrapped by new@estelle.ee.udel.edu on Tue Aug 14 16:09:57 1990 PATH=/bin:/usr/bin:/usr/ucb ; export PATH if test -f 'LOME/Iparse.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'LOME/Iparse.c'\" else echo shar: Extracting \"'LOME/Iparse.c'\" \(5323 characters\) sed "s/^X//" >'LOME/Iparse.c' <<'END_OF_FILE' X/* X * Iparse.c X * SCM Interpreter code file X * Copyright 1988 Darren New. X * All rights reserved. X */ X X#include "PPL.h" X#include "TFS.h" X#include "MacroIO.h" X X#include "Interp.h" X Xshort zero = '0', X HeadParm = '$', X HeadEOL = '.'; X Xstruct macdef { X funcpnt execfunc; X str matchstr; X funcpnt initfunc; X }; X Xstatic struct macdef macro[] = { X Ebp, "BEGIN PROGRAM", Ibp, /* 0 */ X Eep, "END PROGRAM", Iep, /* 1 */ X Ebmr, "BEGIN MAIN ROUTINE", Ibmr, /* 2 */ X Eemr, "END MAIN ROUTINE", Iemr, /* 3 */ X Ebs, "BEGIN SUBROUTINE $", Ibs, /* 4 */ X Ees, "END SUBROUTINE $", Ies, /* 5 */ X El, "LABEL $$", Il, /* 6 */ X Ecd, "CHRDATA $$ $ $ $$", Icd, /* 7 */ X End, "NUMDATA $$ $ $$ $$", Ind, /* 8 */ X Es, "STOP $", 0, /* 9 */ X Ec, "CALL $", 0, /* 10 */ X Egm, "GET $ = MEM $", 0, /* 11 */ X Epm, "PUT MEM $ = $", 0, /* 12 */ X Ef, "FLG $ = $", 0, /* 13 */ X Epv, "PTR $ = VAL $", 0, /* 14 */ X Evp, "VAL $ = PTR $", 0, /* 15 */ X Eva, "VAL $ = $ + $", 0, /* 16 */ X Evs, "VAL $ = $ - $", 0, /* 17 */ X Epa, "PTR $ = $ + $", 0, /* 18 */ X Eps, "PTR $ = $ - $", 0, /* 19 */ X Ept, "PTR $ = $ * $", 0, /* 20 */ X Epd, "PTR $ = $ / $", 0, /* 21 */ X Empb, "MOV PTR $ BY $", 0, /* 22 */ X Et, "TO $$", 0, /* 23 */ X Etife, "TO $$ IF FLG $ EQ $", 0, /* 24 */ X Etifn, "TO $$ IF FLG $ NE $", 0, /* 25 */ X Etive, "TO $$ IF VAL $ EQ $", 0, /* 26 */ X Etivn, "TO $$ IF VAL $ NE $", 0, /* 27 */ X Etipe, "TO $$ IF PTR $ EQ $", 0, /* 28 */ X Etipn, "TO $$ IF PTR $ NE $", 0, /* 29 */ X Etipl, "TO $$ IF PTR $ LT $", 0, /* 30 */ X Er, "REWIND $", 0, /* 31 */ X Egb, "GET BUFF $", 0, /* 32 */ X Epb, "PUT BUFF $", 0, /* 33 */ X Evi, "VAL $ = INPUT", 0, /* 34 */ X Eov, "OUTPUT = VAL $", 0, /* 35 */ X Edebug, "DEBUG", 0, /* 36 */ X Emt, "MESSAGE $$$$ TO $", 0, /* 37 */ X 0, 0, 0 }; X X X Xstatic char * source[MAXSRC]; /* the source file */ X X Xstatic short findmacro(char *); Xstatic short findmacro(inpline) X char * inpline; X{ X short m; X register short c; X short p; X register char * s; X X m = 0; X while (s = macro[m].matchstr) { X c = 0; p = 0; X while (1) { X if (s[c] == HeadParm) { X if (inpline[c] != EOS) X param[p++] = inpline[c++]; X else { m += 1; break; } X } X else if (s[c] == inpline[c]) { X if (s[c] == EOS) { X param[p] = EOS; X return m; X } X else X c += 1; X } X else { m += 1; break; } X } X } X return -1; X } X X Xshort DoIt() X{ X char inpline[BIGLINE]; X char * sourcefile; X TFSfile sf; X short l, j; X int curline; X int realline; X X /* DEBUG_SETDEFS("RAW:0/190/640/200/Debug window", "T:DBugOut"); */ X /* DEBUG_ENTER("DoIt", NULL); */ X X PLStatus(6, "Reading source..."); X /* DEBUGF(0, "Reading source..."); */ X X sourcefile = PLarglist[0]; X X TFSInit(); X X sf = TFSOpen(sourcefile, "R"); X if (sf == 0) { X PLStatus(0, "Could not open source file"); X /* DEBUG_RETURN(NULL); */ X PLExit(PLsev_error); X } X X realline = 1; X while (-1 != (l = TFSRead(sf, inpline)) && 0 != l) X realline += 1; /* skip leading comments */ X X curline = 0; X while (-1 != (l = TFSRead(sf, inpline))) { X realline += 1; X /* DEBUGF(9, "Reading line %d (%d): %s" C curline C realline C inpline); */ X for (j = 0; j < l; j++) X if (inpline[j] == HeadEOL) X inpline[j] = '\0'; X else X if (islower(inpline[j])) X inpline[j] = toupper(inpline[j]); X if (inpline[0]) { X j = findmacro(inpline); X if (j == -1) { X PLStatus(0, "Unrecognised line:"); X PLStatus(0, inpline); X TFSClose(sf); X TFSTerm(); X /* DEBUG_RETURN(NULL); */ X PLExit(PLsev_error); X } X else { X for (l = 0; param[l]; l++) { X if (! isupper(param[l]) && !isdigit(param[l])) { X PLStatus(0, "Bad parameter"); X TFSClose(sf); X TFSTerm(); X /* DEBUG_RETURN(NULL); */ X PLExit(PLsev_error); X } X } X } X if (macro[j].initfunc) X (*macro[j].initfunc)(curline); X source[curline++] = PLStrDup(inpline); X if (curline >= MAXSRC) { X PLStatus(0, "Source too big"); X TFSClose(sf); X TFSTerm(); X /* DEBUG_RETURN(NULL); */ X PLExit(PLsev_oores); X } X } X } X if (PLerr != PLerr_eod) { X PLStatus(0, "Error reading source file"); X TFSClose(sf); X TFSTerm(); X /* DEBUG_RETURN(NULL); */ X PLExit(PLsev_error); X } X X TFSTerm(); X X PLErrClr(); X X /* DEBUGF(0, "Running..."); */ X PLStatus(6, "Running..."); X X curline = startLine; X while (curline != -1) { X j = findmacro(source[curline]); X curline = (*macro[j].execfunc)(curline); X } X X /* DEBUGF(0, "Execution complete!"); */ X PLStatus(6, "Execution complete!"); X X /* DEBUG_RETURN(NULL); */ X X return 0; X } X X X END_OF_FILE if test 5323 -ne `wc -c <'LOME/Iparse.c'`; then echo shar: \"'LOME/Iparse.c'\" unpacked with wrong size! fi # end of 'LOME/Iparse.c' fi if test -f 'LOME/LOME0.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'LOME/LOME0.c'\" else echo shar: Extracting \"'LOME/LOME0.c'\" \(4167 characters\) sed "s/^X//" >'LOME/LOME0.c' <<'END_OF_FILE' X/* X * LOME0.c X * Line Oriented Macro Expander - Routines called by tout le monde X * Copyright 1989 Darren New X * X */ X X#include "LOME.h" X X#define ADDTOLINE(c) (consline[conslinesize++] = (c)) X#define ENDLINE() (consline[conslinesize] = 0) X Xvoid Message ARGS1(str,s) X{ X char t[100]; X char * u; X strcpy(t, "********** Error: "); X strcat(t, s); X strcat(t, " "); X MPutChar(0); X for (u = t; *u; u++) X MPutChar(*u); X MPutChar(0); X MPutBuff(outstream); X } X Xvoid PopTStack() X{ X /* does everything needed to pop traceback stack */ X int i; /* scratch */ X assert(0 < tstacksize); X if (Sinp) PLFreeMem(Sinp); X Sinp = NULL; X for (i = 0; i < 10; i++) { X if (Sp[i]) PLFreeMem(Sp[i]); X Sp[i] = NULL; X } X Sretoffs = -1; X tstacksize -= 1; X } X X Xvoid TraceBack() X{ X char * t = "Constructed line, traceback follows:"; X X MPutChar(0); X while (*t) MPutChar(*t++); X MPutChar(0); X MPutBuff(outstream); X X consline[conslinesize] = 0; X t = consline; X while (*t) MPutChar(*t++); X MPutChar(0); X MPutBuff(outstream); X X while (0 < tstacksize) { X t = Sinp; X while (*t) MPutChar(*t++); X MPutChar(0); X MPutBuff(outstream); X PopTStack(); X } X X consline[conslinesize = 0] = 0; X X } X Xvoid IntToStr ARGS2(long,num,str,buf) X{ X /* convert a number to a string representation */ X long exponent; X int index = 0; X X assert(0 == num || num != - num); /* 0x80000000 fails */ X X if (num == 0) { X buf[index++] = params[O_ZERO]; X } X else { X if (num < 0) { X buf[index++] = params[O_MINUS]; X num = 0 - num; X } X X /* figure out first divisor */ X for (exponent = 1000; exponent < num; exponent *= 10) { X /* assertion fails if sizeof(long) too short */ X assert(100 < exponent); X } X while (num / exponent == 0) X exponent /= 10; X while (exponent != 0) { X /* not especially multiply-divide efficient */ X buf[index++] = (params[O_ZERO] + (num / exponent) % 10); X num -= (num / exponent) % 10 * exponent; X exponent /= 10; X } X } X buf[index] = 0; X X } X X Xlong StrToInt ARGS1(str,buf) X{ X /* converts buf to a long and returns it. Returns 0 if no good. */ X long res = 0; X long sign = 1L; X X if (buf == NULL || *buf == 0) { X return 0L; X } X if (*buf == params[O_MINUS]) { X sign = -1L; X buf += 1; X } X else if (*buf == params[O_PLUS]) { X sign = 1L; X buf += 1; X } X while (params[O_ZERO] <= *buf && *buf <= params[O_ZERO] + 9) { X res = res * 10 + *buf - params[O_ZERO]; X buf += 1; X } X X if (*buf) { X return 0L; X } X else { X return res * sign; X } X } X X Xlong StrToIntErr ARGS2(str,buf,str*,newbuf) X{ X /* converts buf to a long and returns it. returns pointer to char that X caused failure. */ X long res = 0; X long sign = 1L; X X if (buf == NULL || *buf == 0) { X if (newbuf) X *newbuf = buf; X return 0L; X } X if (*buf == params[O_MINUS]) { X sign = -1L; X buf += 1; X } X else if (*buf == params[O_PLUS]) { X sign = 1L; X buf += 1; X } X while (params[O_ZERO] <= *buf && *buf <= params[O_ZERO] + 9) { X res = res * 10 + *buf - params[O_ZERO]; X buf += 1; X } X X if (newbuf) X *newbuf = buf; X return res * sign; X } X X Xvoid InsNumber ARGS1(long,num) X{ X /* Insert the decimal equivalent of the given number into the line */ X char buf[BIGLINE]; X char * p; X X assert(0 == num || num != - num); /* 0x80000000 fails */ X X IntToStr(num, buf); X for (p = buf; *p; p++) X ADDTOLINE(*p); X ENDLINE(); X X } X X Xstr VarLookup ARGS1(str,vname) X{ X int i; X X if (vname == NULL || *vname == 0) { X return NULL; X } X for (i = 0; varname[i] && i < MAXvarnames; i++) { X if (strcmp(vname, varname[i]) == 0) { X return varval[i]; X } X } X return NULL; X } X Xvoid VarSetVal ARGS2(str,vname,str,vval) X{ X int i; X if (vname == NULL || *vname == 0) { X return; X } X i = 0; X while (varname[i] && i < MAXvarnames && strcmp(vname, varname[i])) X i += 1; /* look for name */ X X if (MAXvarnames <= i) { X Message("VFUL"); X TraceBack(); X quitting = TRUE; X return; X } X if (varname[i]) { X PLFreeMem(varval[i]); X varval[i] = NULL; X } X else { X varname[i] = PLStrDup(vname); X } X varval[i] = PLStrDup(vval); X } X X X X END_OF_FILE if test 4167 -ne `wc -c <'LOME/LOME0.c'`; then echo shar: \"'LOME/LOME0.c'\" unpacked with wrong size! fi # end of 'LOME/LOME0.c' fi if test -f 'LOME/LOME1.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'LOME/LOME1.c'\" else echo shar: Extracting \"'LOME/LOME1.c'\" \(4935 characters\) sed "s/^X//" >'LOME/LOME1.c' <<'END_OF_FILE' X/* X * LOME1.c X * Line Oriented Macro Expander - LoadMacros() X * Copyright 1989 Darren New X * X */ X X#include "LOME.h" X Xbool LoadMacros ARGS1(int,inpstream) X{ X int i, j; /* scratch */ X X do { X i = MGetBuff(inpstream); X if (i != M_OK) { X Message("UEOF"); X return FALSE; X } X i = MGetChar(); X } while (i != 0); X X /* read and parse parameter line */ X X i = MGetBuff(inpstream); X if (i != M_OK) { X Message("UEOF"); X return FALSE; X } X X for (j = 0; j < O_last; j++) { X params[j] = MGetChar(); X if (params[j] == 0) { X PLStatus(1, "Too few characters on parameter line"); X Message("FORM"); X return FALSE; X } X } X X if (0 != MGetChar()) { X PLStatus(1, "Too many characters on parameter line"); X Message("FORM"); X return FALSE; X } X X /* this operation should probably be elsewhere: */ X if (params[O_FSYMGEN] == params[O_ZERO] + 1) X symgenval = 100; X else if (params[O_FSYMGEN] == params[O_ZERO] + 2) X symgenval = 1000; X X X if (params[O_FECHO] == params[O_ZERO] + 1) X MEchoFlag = 1; X X /* Read and parse other lines */ X X while ((i = MGetBuff(inpstream)) == M_OK) { X int j = 0; /* no characters found yet */ X X /* load header */ X do { X i = MGetChar(); X X /* see if macro header is a blank line */ X while (j == 0 && i == 0) { X i = MGetBuff(inpstream); X /* late-change unstructured multi-level break. Sorry. */ X if (i != M_OK) goto found_end; X i = MGetChar(); X } X X /* skip leading spaces, maybe */ X while (j == 0 && i == params[O_SPACE] && X params[O_FSPACE] == params[O_ZERO]) X i = MGetChar(); X X j = 1; /* stop skipping leading spaces */ X X if (i == 0 || i == params[O_HEOL]) { X macroflag[macrosize] = 2; X macrochar[macrosize] = 0; X } X else if (i == params[O_ESC]) { X i = MGetChar(); X if (i == 0) { /* ignore final escape */ X macroflag[macrosize] = 2; X macrochar[macrosize] = 0; X } X else { X macroflag[macrosize] = 0; X macrochar[macrosize] = i; X } X } X else if (i == params[O_PHC]) { X if (macroflag[macrosize-1] == 1) { X /* can't have two placeholders in a row */ X PLStatus(1, "Two consecutive placeholders"); X Message("FORM"); X return FALSE; X } X macroflag[macrosize] = 1; X macrochar[macrosize] = i; X } X else { X macroflag[macrosize] = 0; X macrochar[macrosize] = i; X } X X if (MAXmacrochars <= macrosize + 1) { X Message("FULL"); X return FALSE; X } X X } while (macroflag[macrosize++] != 2); X X /* load body */ X do { X X j = 0; /* number of chars read so far */ X i = MGetBuff(inpstream); X if (i != M_OK) { X Message("UEOF"); X return FALSE; X } X X do { X i = MGetChar(); X if (i == params[O_BEOL] && j == 0) { X /* BEOL is first on line */ X i = MGetChar(); X if (i == params[O_BEOL]) { X macroflag[macrosize] = 3; X macrochar[macrosize] = 0; X macrosize += 1; X } X else if (params[O_ZERO] != params[O_FBLANK]) { X /* keep blank lines */ X macroflag[macrosize] = 2; X macrochar[macrosize] = 0; X macrosize += 1; X } X i = 0; /* discard rest of line */ X } X else if (i == 0 || i == params[O_BEOL]) { X /* found end of body line */ X if (j != 0 || params[O_ZERO] != params[O_FBLANK]) { X /* chars before or keep blanks */ X macroflag[macrosize] = 2; X macrochar[macrosize] = 0; X macrosize += 1; X } X /* skip optional trailing comment */ X i = 0; X } X else if (i == params[O_ESC]) { X i = MGetChar(); X if (i == 0) { /* ignore final escape */ X macroflag[macrosize] = 2; X macrochar[macrosize] = 0; X macrosize += 1; X i = 0; X } X else { X macroflag[macrosize] = 0; X macrochar[macrosize] = i; X macrosize += 1; X j += 1; X } X } X else if (i == params[O_SUBS]) { X i = MGetChar(); X if (i == params[O_CTRLOP] || i == params[O_FILEOP] || X (params[O_ZERO] <= i && X i <= params[O_ZERO] + 9)) { X macroflag[macrosize] = 1; X macrochar[macrosize] = i; X macrosize += 1; X i = MGetChar(); X if (params[O_ZERO] <= i && i <= params[O_ZERO] + 9) { X macroflag[macrosize] = 1; X macrochar[macrosize] = i; X macrosize += 1; X } X else { X PLStatus(1, "Operation not a digit"); X Message("FORM"); X return FALSE; X } X } X else { X PLStatus(1, "Operation not digit control or file"); X Message("FORM"); X return FALSE; X } X j += 1; X } X else { X macroflag[macrosize] = 0; X macrochar[macrosize] = i; X macrosize += 1; X j += 1; X } X X if (MAXmacrochars <= macrosize + 1) { X Message("FULL"); X return FALSE; X } X X /* end of body line loop */ X } while (i != 0); X X /* end of body loop */ X } while (macroflag[macrosize-1] != 3); X X /* end of macro file loop */ X found_end: ; /* go here if there is EOF or ERROR while attempting X to read macro header line */ X } X X if (i != M_EOF) { X Message("IOER"); X return FALSE; X } X X return TRUE; X X } X END_OF_FILE if test 4935 -ne `wc -c <'LOME/LOME1.c'`; then echo shar: \"'LOME/LOME1.c'\" unpacked with wrong size! fi # end of 'LOME/LOME1.c' fi if test -f 'LOME/LOME3.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'LOME/LOME3.c'\" else echo shar: Extracting \"'LOME/LOME3.c'\" \(5089 characters\) sed "s/^X//" >'LOME/LOME3.c' <<'END_OF_FILE' X/* X * LOME3.c X * Line Oriented Macro Expander - FindMatch() X * Copyright 1989 Darren New X * X */ X X#include "LOME.h" X X#ifdef HIDPROTS XHIDDEN bool ChInStr ARGS((char, str)); X#endif X XHIDDEN bool ChInStr ARGS2(char,ch,str,s) X{ X /* returns TRUE if ch can be found in s */ X for ( ; *s; s++) X if (ch == *s) X return TRUE; X return FALSE; X } X X X/* matches a balanced element starting at the front of inp. Stops on X seeing any char in mchars or at end of inp. If mchars is empty, X matches all of inp. X returns number of inp chars matched, X returns char which stopped scan (maybe 0) in *next */ X Xint BalMatch ARGS3(str,inp,str,mchars,char *,next) X{ X int s; /* offset into inp so far */ X char o, c; /* openning and closing nests */ X int depth; /* current nesting depth */ X bool esc; /* current Sinp[s] was escaped */ X char ch; /* Sinp[s] unless escape */ X X assert(mchars != NULL); X assert(inp != NULL); X assert(next != NULL); X X if (*mchars == 0) X return strlen(inp); X X depth = 0; /* nothing nested yet */ X o = c = 0; /* to shut up lint */ X s = 0; /* start at beginning */ X X do { X ch = inp[s]; X if (esc = (ch == params[O_ESC])) X ch = Sinp[++s]; X if (ch == 0) { X *next = 0; X return s; X } X else if (depth == 0 && ChInStr(ch, mchars)) { X *next = ch; X return s; X } X else if (depth != 0) { X s += 1; X if (ch == o && ! esc) depth += 1; X if (ch == c && ! esc) depth -= 1; X } X else { X /* depth == 0 and not matching character */ X s += 1; X if (ch == params[O_OQ] && ! esc) X o = ch, c = params[O_CQ], depth = 1; X if (ch == params[O_OP] && !esc) X o = ch, c = params[O_CP], depth = 1; X } X } while (1); X } X X X/* finds a match in the macrochar array for the Sinp. Sets Sp[], Rretoffs. X Sretoffs will be negative if no match was found, otherwise it will X be a pointer to the first character to be expanded. */ X X Xvoid FindMatch() X{ X int pf[10]; /* offsets of first chars of parameters */ X int pl[10]; /* offsets of first chars past parameters */ X int p; /* parameter being matched */ X int s; /* current char in Sinp */ X moffs m; /* current char in macro headers */ X bool found; /* stop looking */ X X assert(0 < tstacksize); X assert(Sinp != NULL); X X Sretoffs = -1; m = 0; found = FALSE; X s = 0; p = 0; X X while (m < macrosize && ! found) { X X if (macroflag[m] == 0) { X /* need to match this character */ X X char ch1, ch2; /* translated Sinp[s] and macrochar[m] */ X X /* maybe switch escaped? and fix cases? to allow esc=case */ X X ch1 = Sinp[s]; ch2 = macrochar[m]; X X if (ch1 == params[O_ESC]) /* escaped? */ X ch1 = Sinp[++s]; X X if (params[O_FCASE] == params[O_ZERO]) { /* fix cases? */ X if (params[O_UCA] <= ch1 && ch1 <= params[O_UCZ]) X ch1 = ch1 - params[O_UCA] + params[O_LCA]; X if (params[O_UCA] <= ch2 && ch2 <= params[O_UCZ]) X ch2 = ch2 - params[O_UCA] + params[O_LCA]; X } X X if (ch1 == 0 && ch2 == params[O_SPACE]) { X m += 1; /* allow trailing space in MH to match BEOL */ X } X else if (ch1 == ch2) { X s += 1; X m += 1; X } X else { X /* match failed. advance past header and body */ X while (macroflag[m] != 3) X m += 1; X m += 1; X s = 0; X p = 0; X } X } X else if (macroflag[m] == 1) { X /* here, match a balanced parameter */ X assert(p < 10); /* should be checked in LoadMacro */ X if (macroflag[m + 1] == 2) { X /* special case: PHC last character in header line */ X pf[p] = s; X while (Sinp[s]) X s += 1; X pl[p] = s; X p += 1; X found = TRUE; X m += 2; /* skip PHC and HEOL */ X } X else { X /* PHC not last on line */ X char mchars[2]; /* char to try to end scan */ X char next; /* char which stops scan */ X int mlen; /* match length */ X X assert(macroflag[m + 1] == 0); /* should be checked by LoadMacros */ X mchars[0] = macrochar[m + 1]; X mchars[1] = 0; X pf[p] = s; X X mlen = BalMatch(&Sinp[s], mchars, &next); X X if (next == 0) { X /* can't match because PHC not last on line */ X /* advance past header and body */ X while (macroflag[m] != 3) X m += 1; X m += 1; X s = 0; X p = 0; X } X else { X /* good match */ X assert(Sinp[s+mlen] == macrochar[m + 1]); X s += mlen; X pl[p] = s; X p += 1; X m += 1; /* skip placeholder character */ X } X } X } X else if (macroflag[m] == 2) { X /* here, match EOL */ X while (Sinp[s] == params[O_SPACE]) X s += 1; /* skip trailing unescaped spaces */ X if (Sinp[s] == 0) { X m += 1; X found = TRUE; X } X else { X /* match failed. advance past header and body */ X while (macroflag[m] != 3) X m += 1; X m += 1; X s = 0; X p = 0; X } X } X } X X if (found) { X /* set up parameter matches in stack */ X char * pnt; /* scratch */ X int i, j; /* scratch */ X X Sretoffs = m; X for (i = 0; i < p; i++) { X pnt = (char *) PLAllocMem(pl[i] + pf[i] + 1, X PLalloc_die | PLalloc_zero); X for (j = pf[i]; j < pl[i]; j++) X pnt[j - pf[i]] = Sinp[j]; X Sp[i] = pnt; X } X } X else { X Sretoffs = -1; X } X } X X END_OF_FILE if test 5089 -ne `wc -c <'LOME/LOME3.c'`; then echo shar: \"'LOME/LOME3.c'\" unpacked with wrong size! fi # end of 'LOME/LOME3.c' fi if test -f 'LOME/LOME6.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'LOME/LOME6.c'\" else echo shar: Extracting \"'LOME/LOME6.c'\" \(5725 characters\) sed "s/^X//" >'LOME/LOME6.c' <<'END_OF_FILE' X/* X * LOME6.c X * Line Oriented Macro Expander - DoFileOp() X * Copyright 1989 Darren New X * X */ X X#include "LOME.h" X X Xint GetF ARGS((int)); X Xint GetF ARGS1(int,offs) X{ X /* This gets the file number at the indicated offset in the consline. X It returns -1 for a FORM error. */ X X char ch = consline[offs]; X if (conslinesize <= offs) return -1; X if (ch == params[O_UCA]) return (int) instream; X if (ch == params[O_UCZ]) return (int) outstream; X if (ch < params[O_ZERO] || params[O_ZERO] + 9 < ch) X return -1; X return ch - params[O_ZERO]; X } X Xvoid Choke ARGS((str)); X Xvoid Choke ARGS1(str,s) X{ X Message(s); X TraceBack(); X quitting = TRUE; X } X X Xvoid DoFileOp ARGS1(int,op /* the operation number */) X{ X int i; X X assert(0 < tstacksize); X X switch (op) { X X case 0: { X int f = GetF(0); X if (f == -1) { X Choke("FORM"); X } X else { X int res = MRewind(f); X if (res != M_OK) { X Choke("IOER"); X } X if (consline[1] != 0) { X res = MRename(f, &consline[1]); X if (res != M_OK) { X Choke("IOER"); X } X } X } X break; X } X X case 1: { X int from = GetF(0); X int to = GetF(1); X if (from == -1 || to == -1) { X Choke("FORM"); X } X else { X char * match = &consline[2]; X int i, j; X if (*match == 0) { /* copy whole file */ X j = M_OK; X i = MGetBuff(from); X while (i == M_OK && j == M_OK) { X j = MPutBuff(to); X i = MGetBuff(from); X } X if (i != M_EOF || j != M_OK) { X Choke("IOER"); X } X } X else { /* copy to match */ X bool linefound = FALSE; X i = MGetBuff(from); X while (i == M_OK && ! linefound) { X match = &consline[2]; X linefound = TRUE; X while (*match && linefound) { X if (MGetChar() == *match) X match += 1; X else X linefound = FALSE; X } X if (! linefound) { X if (M_OK != MPutBuff(to)) X Choke("IOER"); X i = MGetBuff(from); X } X } X if (i == M_EOF) X Choke("UEOF"); X else if (i != M_OK) X Choke("IOER"); X } X } X break; X } X X case 2: { X int f = GetF(0); X if (f == -1) { X Choke("FORM"); X } X else { X outstream = f; X } X break; X } X X case 3: { X int f = GetF(0); X if (f == -1) { X Choke("FORM"); X } X else { X if (consline[1] != 0) { X sstack[sstacksize++] = f; X if (MAXstreams <= sstacksize) X Choke("SSTK"); X else X instream = f; X } X else { X instream = sstack[sstacksize-1] = f; X } X } X break; X } X X case 4: { X int f = GetF(0); X if (f == -1) { X Choke("FORM"); X } X else { X char * t = &consline[1]; X MPutChar(0); X while (*t) MPutChar(*t++); X MPutChar(0); X f = MPutBuff(f); X if (f != M_OK) X Choke("IOER"); X } X break; X } X X case 5: { X int f = GetF(0); X if (f == -1) { X Choke("FORM"); X } X else { X char ch = 0; X char * t = &consline[1]; X char * s = NULL; X MPutChar(0); X while (*t) { X if (params[O_ZERO] <= *t && *t <= params[O_ZERO] + 9) { X if (*t != ch) { X ch = *t; X s = Sp[*t - params[O_ZERO]]; X } X if (s && *s) X MPutChar(*s++); X else X MPutChar(params[O_SPACE]); X } X else { X MPutChar(*t); X ch = 0; X } X t += 1; X } X MPutChar(0); X if (M_OK != MPutBuff(f)) X Choke("IOER"); X } X break; X } X X case 6: { /* debugging dump */ X char * t; X int i; X X int f = GetF(0); X if (f == -1) { X Choke("FORM"); X } X else { X Message("DUMP"); X X t = "Variable names, values follow:"; X MPutChar(0); X while (*t) MPutChar(*t++); X MPutChar(0); X MPutBuff(outstream); X X for (i = 0; varname[i] && i < MAXvarnames; i++) { X MPutChar(0); X MPutChar(params[O_OQ]); X for (t = varname[i]; *t; t++) X MPutChar(*t); X MPutChar(params[O_CQ]); X MPutChar(params[O_SPACE]); X if (varval[i]) { X MPutChar(params[O_OQ]); X for (t = varval[i]; *t; t++) X MPutChar(*t); X MPutChar(params[O_CQ]); X } X MPutChar(0); X MPutBuff(outstream); X } X X t = "Parameters, values follow:"; X MPutChar(0); X while (*t) MPutChar(*t++); X MPutChar(0); X MPutBuff(outstream); X X for (i = 0; i < 10; i++) { X MPutChar(0); X MPutChar(params[O_ZERO] + i); X MPutChar(params[O_SPACE]); X if (Sp[i]) { X MPutChar(params[O_OQ]); X for (t = Sp[i]; *t; t++) X MPutChar(*t); X MPutChar(params[O_CQ]); X } X MPutChar(0); X MPutBuff(outstream); X } X X TraceBack(); X quitting = TRUE; X } X X break; X } X X case 7: { X#ifdef PPL_h X /* we are using PPL.h, so use PLStatus() */ X short pri = consline[0] - params[O_ZERO]; X if (pri < 0) pri = 0; X if (9 < pri) pri = 9; X if (0 < conslinesize) X PLStatus(pri, &consline[1]); X#endif /* PPL_h */ X break; X } X X case 8: { X int f; X int p; X f = GetF(0); X p = (0 < conslinesize) ? consline[1] - params[O_ZERO] : -1; X if (f == -1) { X Choke("FORM"); X } X else { X i = MGetBuff(f); X while (i == M_EOF && X consline[0] == params[O_UCA] && 0 < sstacksize) { X sstacksize -= 1; X if (sstacksize) X instream = sstack[sstacksize-1]; X else X instream = 0; X } X if (i == M_EOF) X Choke("UEOF"); X else if (i == M_ILLEGAL) X Choke("IOER"); X else if (0 <= p && p <= 9) { X /* use consline as temp storage */ X conslinesize = 0; X while (0 != (consline[conslinesize++] = MGetChar())) X /* read next char */ ; X if (Sp[p]) PLFreeMem(Sp[p]); X Sp[p] = PLStrDup(consline); X } X } X break; X } X X case 9: { X Message("NYET"); X TraceBack(); X break; X } X X } X X consline[conslinesize = 0] = 0; /* clear constructed line */ X if (macroflag[Sretoffs] == 2) /* skip trailing BEOL if there */ X Sretoffs += 1; X } X X END_OF_FILE if test 5725 -ne `wc -c <'LOME/LOME6.c'`; then echo shar: \"'LOME/LOME6.c'\" unpacked with wrong size! fi # end of 'LOME/LOME6.c' fi if test -f 'LOME/MIOtest.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'LOME/MIOtest.c'\" else echo shar: Extracting \"'LOME/MIOtest.c'\" \(4510 characters\) sed "s/^X//" >'LOME/MIOtest.c' <<'END_OF_FILE' X/* X * MIOTest.c X * Macro I/O Subsystem Test Program X * Copyright 1988,1990 Darren New. X * All rights reserved. X */ X X#include "PPL.h" X X#include "MacroIO.h" X X/******************* NOT COMPLETE ! *********************/ X X X X/* This program will test your implementation of MacroIO.c. X Put the following lines on stream one. Output will be to stream two. X Output will also be to stream three. X A scratch file is written then read on stream nine. X A newly named file is written to "t:MIOTEST8.out". X X X1) This should appear on stream 2. X2) This too should appear on stream 2. XX) This should not appear at all. X3) If this is not followed by a totally blank line, buffer not clearing. X4) Lines 4 - 6 should appear twice. X5) If not, rewind may not be working. X6) This is the last duplicated line. X7) Line 8 should be next and contain all ten digits. X9) Line 9 is followed by a maximum-length line of zeros. X10) The next line should contain only a single zero - test one item lines. X11) Last line on stream 2 for now. X12) This should go to stream 3. X13) This should go to stream 3 also. X */ X X X#define ERROUT {MStopIO(); PLExit(PLsev_error);} X Xshort DoIt() X{ X /* char lb[BIGLINE]; */ X /* short ccp; */ X X short ch1, ch2, ch3, ch4; X X MStartIO(PLargcnt, PLarglist); X X if (M_OK != MGetBuff(1)) ERROUT /* 1 */ X if (M_OK != MPutBuff(2)) ERROUT X if (M_OK != MGetBuff(1)) ERROUT /* 2 */ X if (M_OK != MPutBuff(2)) ERROUT X X if (M_OK != MGetBuff(1)) ERROUT /* X */ X X if (M_OK != MGetBuff(1)) ERROUT /* 3 */ X if (M_OK != MPutBuff(2)) ERROUT X MPutChar(0); X if (M_OK != MPutBuff(2)) ERROUT X X if (M_OK != MGetBuff(1)) ERROUT /* 4 */ X if (M_OK != MPutBuff(9)) ERROUT X if (M_OK != MGetBuff(1)) ERROUT /* 5 */ X if (M_OK != MPutBuff(9)) ERROUT X if (M_OK != MGetBuff(1)) ERROUT /* 6 */ X if (M_OK != MPutBuff(9)) ERROUT X X if (M_OK != MRewind(9)) ERROUT X if (M_OK != MGetBuff(9)) ERROUT /* 4 */ X if (M_OK != MPutBuff(2)) ERROUT X if (M_OK != MGetBuff(9)) ERROUT /* 5 */ X if (M_OK != MPutBuff(2)) ERROUT X if (M_OK != MGetBuff(9)) ERROUT /* 6 */ X if (M_OK != MPutBuff(2)) ERROUT X if (M_OK != MRewind(9)) ERROUT X if (M_OK != MGetBuff(9)) ERROUT /* 4 */ X if (M_OK != MPutBuff(2)) ERROUT X if (M_OK != MGetBuff(9)) ERROUT /* 5 */ X if (M_OK != MPutBuff(2)) ERROUT X if (M_OK != MGetBuff(9)) ERROUT /* 6 */ X if (M_OK != MPutBuff(2)) ERROUT X X if (M_OK != MGetBuff(1)) ERROUT /* 7 */ X if (M_OK != MPutBuff(2)) ERROUT X X ch1 = MGetChar(); X if (ch1 <= 0) ERROUT X ch1 -= 7; /* now ch1 == '0' */ X ch2 = MGetChar(); X if (ch2 <= 0) ERROUT X ch3 = MGetChar(); X if (ch3 <= 0) ERROUT X if (0 != MPutChar(0)) ERROUT X if (ch1+8 != MPutChar(ch1 + 8)) ERROUT X if (ch2 != MPutChar(ch2)) ERROUT X if (ch3 != MPutChar(ch3)) ERROUT X for (ch4 = 0; ch4 <= 9; ch4++) X if (ch4 + ch1 != MPutChar(ch4 + ch1)) X ERROUT X if (0 != MPutChar(0)) ERROUT X if (M_OK != MPutBuff(2)) ERROUT /* 8 */ X X if (M_OK != MGetBuff(1)) ERROUT /* 9 */ X if (M_OK != MPutBuff(2)) ERROUT X if (0 != MPutChar(0)) ERROUT X while (0 != MPutChar(ch1)) X ; X if (M_OK != MPutBuff(2)) ERROUT X X if (M_OK != MGetBuff(1)) ERROUT /* 10 */ X if (M_OK != MPutBuff(2)) ERROUT X X if (ch1 != MPutChar(ch1)) ERROUT X if (0 != MPutChar(0)) ERROUT X if (M_OK != MPutBuff(2)) ERROUT X X if (M_OK != MGetBuff(1)) ERROUT /* 11 */ X if (M_OK != MPutBuff(2)) ERROUT X X if (M_OK != MGetBuff(1)) ERROUT /* 12 */ X if (M_OK != MPutBuff(3)) ERROUT X X if (M_OK != MGetBuff(1)) ERROUT /* 13 */ X if (M_OK != MPutBuff(3)) ERROUT X X if (M_OK != MPutBuff(8)) ERROUT /* 13 again */ X if (M_OK != MRename(8, "t:MIOTEST8.out")) X ERROUT X if (M_OK != MPutBuff(8)) ERROUT /* 13 once again */ X X X if (M_EOF != MGetBuff(1)) ERROUT X X MStopIO(); X X return 0; X } X X END_OF_FILE if test 4510 -ne `wc -c <'LOME/MIOtest.c'`; then echo shar: \"'LOME/MIOtest.c'\" unpacked with wrong size! fi # end of 'LOME/MIOtest.c' fi if test -f 'LOME/MacroIO.doc' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'LOME/MacroIO.doc'\" else echo shar: Extracting \"'LOME/MacroIO.doc'\" \(5238 characters\) sed "s/^X//" >'LOME/MacroIO.doc' <<'END_OF_FILE' X XThe Macro I/O subsystem must maintain certain items of state between Xcalls. There must be at least ten streams available. Each stream must Xbe capable of either reading or writing or both. There must be a "line Xbuffer" (LB) capable of storing enough characters to hold the longest Xline on any stream. There must be a "current character pointer" (CCP) Xindicating the position of the next character to be read from or Xwritten to the line buffer. X XIt is assumed that the user of the program will assign names to the Xstreams in an unspecified way. Stream zero should always be associated Xwith a device which discards all output and always returns end-of-file Xduring reading. X XDefines in MacroIO.h include M_OK (=0), M_EOF (=1), and M_ILLEGAL (=2). X XMGetBuff : This must take a stream number (0 - 9) as a parameter and Xfill the LB with the next line from that stream. It must return the OK Xif the read was successful, or M_EOF if the end of file was detected, or XM_ILLEGAL if reading is illegal at this time on this stream. The CCP Xshould be set back to the beginning of the LB after this. A line Xconsisting of all spaces being read in must cause the next MGetChar to Xreturn zero upon the first call. A line containing leading spaces Xbefore non-space characters must preserve those leading spaces. XTrailing spaces after non-space characters may or may not be Xdiscarded. X XMPutBuff : This must take a stream number (0 - 9) as a parameter and Xcopy the contents of the LB to the given stream. It must return OK if Xthe write was successful, M_EOF or M_ILLEGAL if the end of medium was Xdetected, or ILLEGAL if writing is illegal at this time on this Xstream. The CCP should be set back to the beginnng of the line buffer Xafter this, but the buffer should not be cleared. Trailing spaces may Xbe discarded either during the write to the device, from the LB, or Xnot at all. Leading spaces before non-space characters must be Xpreserved. X XMPutChar : This must take a character and put it in the LB at the Xposition indicated by the CCP and then the CCP should be incremented. XIf the character passed to this is zero, the LB should be terminated; Xi.e., character zero marks the end of a line, and insertion of this Xcharacter into the LB should cause the CCP to be reset back to the Xbeginning. At this time, the buffer may be padded to a fixed size if Xneeded. If this character will not fit in the LB, a zero should be Xreturned. Otherwise, the character passed in should be returned. X XMGetChar : This must retrieve the character from the CCP of the LB and Xreturn it. It must then increment the CCP. If the last character has Xalready been retrieved, a zero should be returned, after which the Xcurrent character position should be reset to the beginning of the Xbuffer. See MGetBuff for information regarding spaces in the buffer. X XMRewind : This must take a stream number and reposition the stream to Xthe beginning of the data available. It must not alter the contents of Xthe LB nor of the stream addressed. If the Rewind was successful, this Xreturns OK, otherwise it returns M_ILLEGAL. This should allow changing Xfrom reading to writing or vica versa if possible. X XMRename : This must take a stream number and a string. It discards the Xfile associated with the stream if it is a scratch file. It then does Xwhat MRewind does, except that it behaves as if the user passed the Xstring as the name for the file initially. This may be called any Xnumber of times on each stream number. It cannot be used to modify Xstream zero. X XMStartIO : This must do whatever is needed to set up and initialize Xthe I/O subsystem. The parameters here will vary from implementation Xto implementation. This could, for example, prompt the user for the Xfile names to be associated with the streams. This will be called once Xbefore any other I/O routines are called. X XMStopIO : This must do whatever is needed to terminate I/O processing. XIt should close files and so on. It is expected that streams which Xwere written but not explicitly named by the user were scratch streams Xand may be discarded when MStopIO is called. X X XThe mapping from the internal representation (what MGetChar returns) Xand what the operating system handles must be done by these routines. XThe mapping must meet the following constraints: no character except Xthe end-of-line or end-of-file marker(s) may map to zero, as zero is Xreturned by MGetChar to indicate an end-of-line; the characters which Xrepresent the digits must translate to a contiguous set of internal Xcodes and the difference between any two digits must be the same as Xthe difference between the corresponding internal codes; the Xdifference between the internal code for an upper-case letter and the Xinternal code for the corresponding lower-case letter must be the same Xfor all letters; there may be no characters whose codes are between Xthe codes for 'A' and 'Z' which are not uppercase letters; there may Xbe no characters whose codes are between the codes for 'a' and 'z' Xwhich are not lowercase letters; all characters must map to numbers Xfrom 1 to 254 inclusive. Other than these six, no constraints are Xplaced on the mapping. In particular, there need not be exactly Xtwenty-six letters between 'A' and 'Z'; LOME handles this case Xproperly. X X END_OF_FILE if test 5238 -ne `wc -c <'LOME/MacroIO.doc'`; then echo shar: \"'LOME/MacroIO.doc'\" unpacked with wrong size! fi # end of 'LOME/MacroIO.doc' fi if test -f 'LOME/MacroIO.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'LOME/MacroIO.h'\" else echo shar: Extracting \"'LOME/MacroIO.h'\" \(4472 characters\) sed "s/^X//" >'LOME/MacroIO.h' <<'END_OF_FILE' X/* X * MacroIO.h X * Macro I/O Subsystem header file X * Copyright 1988 Darren New. X * All rights reserved. X */ X X X/* Return codes from ReadBuff, WriteBuff, and Rewind. X NOTE: SCM WILL BREAK IF YOU CHANGE THESE. */ X X#define M_OK 0 X#define M_EOF 1 X#define M_ILLEGAL 2 X X X/* XSet this to one if you want read lines to be echoed as PLStatus lines, Xotherwise leave this as zero. X*/ X Xextern short MEchoFlag; X X X/* XMGetBuff : This must take a stream number (0 - 9) as a parameter and Xfill the LB with the next line from that stream. It must return the Xnumber of characters read (non-negative) if the read was successful, Xor minus one if the end of file was detected, or minus two if reading Xis illegal at this time on this stream. The CCP should be set back to Xthe beginning of the line buffer after this. A line consisting of all Xspaces being read in must cause the next GetChar to return zero upon Xthe first call. A line containing leading spaces before non-space Xcharacters must preserve those leading spaces. Trailing spaces may be Xsaved or discarded. A ReadBuff as the first operation on the stream or Ximmediately after a Rewind will read the first line of the device or Xfile. X*/ X Xextern int MGetBuff ARGS((int)); X X X/* XMPutBuff : This must take a stream number (0 - 9) as a parameter and Xcopy the contents of the LB to the given stream. It must return a Xnon-negative number if the write was successful, minus one if the end Xof medium was detected, or minus two if writing is illegal at this Xtime on this stream. The CCP should be set back to the beginnng of the Xline buffer after this, but the buffer should not be cleared. Trailing Xspaces may be discarded either during the write to the device, from Xthe LB, or not at all. Leading spaces before non-space characters must Xbe preserved. The end-of-data mark is placed after the written line; Xi.e., calling WriteBuff as the first operation on the stream or Ximmediately after a Rewind will truncate the device (if possible) Xbefore writing the line. X*/ X Xextern int MPutBuff ARGS((int)); X X X/* XMPutChar : This must take a character and put it in the LB at the Xposition indicated by the CCP and then the CCP should be incremented. XIf the character passed to this is zero, the LB should be terminated; Xi.e., character zero marks the end of a line, and insertion of this Xcharacter into the LB should cause the CCP to be reset back to the Xbeginning. At this time, the buffer may be padded to a fixed size if Xneeded. If this character will not fit in the LB, a zero should be Xreturned. Otherwise, the character passed in should be returned. X*/ X Xextern int MPutChar ARGS((int)); X X X/* XMGetChar : This must retrieve the character from the CCP of the LB and Xreturn it. It must then increment the CCP. If the last character has Xalready been retrieved, a zero should be returned, after which the Xcurrent character position should be reset to the beginning of the Xbuffer. See MGetBuff for information regarding spaces in the buffer. X*/ X Xextern int MGetChar ARGS((void)); X X X/* XMRewind : This must take a stream number and reposition the stream to Xthe beginning of the data available. It must not alter the contents of Xthe LB nor of the stream addressed. If the Rewind was successful, this Xreturns zero, otherwise it returns minus one. X*/ X Xextern int MRewind ARGS((int)); X X X/* XMRename : This must take a stream number and a string. It discards the Xfile associated with the stream if it is a scratch file. It then does Xwhat MRewind does, except that it behaves as if the user passed the Xstring as the name for the file initially. This may be called any Xnumber of times on each stream number. It cannot be used to modify Xstream zero. X*/ X Xextern int MRename ARGS((int,str)); X X X/* XMStartIO : This must do whatever is needed to set up and initialize Xthe I/O subsystem. The parameters here will vary from implementation Xto implementation. This could, for example, prompt the user for the Xfile names to be associated with the streams. This will be called once Xbefore any other I/O routines are called. Right now, the parameters Xhere are the count and list of file names the user specified (a la Xmain(argc, argv)). X*/ X Xextern int MStartIO ARGS((int,str*)); X X X/* XMStopIO : This must do whatever is needed to terminate I/O processing. XIt should close files and so on. It is expected that streams which Xwere written but not explicitly named by the user were scratch streams Xand will be discarded when StopIO is called. X*/ X Xextern int MStopIO ARGS((void)); X X X END_OF_FILE if test 4472 -ne `wc -c <'LOME/MacroIO.h'`; then echo shar: \"'LOME/MacroIO.h'\" unpacked with wrong size! fi # end of 'LOME/MacroIO.h' fi if test -f 'LOME/SCM.mac' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'LOME/SCM.mac'\" else echo shar: Extracting \"'LOME/SCM.mac'\" \(4774 characters\) sed "s/^X//" >'LOME/SCM.mac' <<'END_OF_FILE' XFILE: SCM.mac XThis file contains the macro definitions for SCM, the Simple Character XManipulation language. This file must be changed from implementation to Ximplementation. This file can serve as the first argument to Comp1. XThis particular version is for generating C source code where longs Xare 32 bits, shorts are more than 8 bits, and the MacroIO package in C Xis available. X X0$.$> XBEGIN PROGRAM. X/* X * SCM Executable program. X * Generated by SCM Macros. X * X */ X#include "PPL.h" X#include "MacroIO.h" X /* */ X/* Declare the memory cells */ X#define MEMSIZ 6000 Xlong MEM[MEMSIZ]; X /* */ X/* Declare the registers */ Xshort FA, FB, FC, FD, FE, FF, FG, FH, FI, FJ, FK, FL, FM; Xshort FN, FO, FP, FQ, FR, FS, FT, FU, FV, FW, FX, FY, FZ; Xshort F0, F1, F2, F3; Xshort VA, VB, VC, VD, VE, VF, VG, VH, VI, VJ, VK, VL, VM; Xshort VN, VO, VP, VQ, VR, VS, VT, VU, VV, VW, VX, VY, VZ; Xshort V0, V1, V2, V3, V4, V5, V6, V7, V8, V9; Xlong PA, PB, PC, PD, PE, PF, PG, PH, PI, PJ, PK, PL, PM; Xlong PN, PO, PP, PQ, PR, PS, PT, PU, PV, PW, PX, PY, PZ; Xlong P0, P1, P2, P3, P4, P5, P6, P7, P8, P9; X /* */ Xvoid Stop ARGS((short, short, long)); Xvoid Oops ARGS((char *)); X /* */ Xvoid Stop ARGS3(short,flg,short,val,long,ptr) X{ X PLStatus(1, "Stop!"); X PLExit(PLsev_error); X } X /* */ Xvoid Oops ARGS1(char*,s) X{ X PLStatus(1, "Oops:"); X PLStatus(1, s); X PLExit(PLsev_error); X } X /* */ X/* BEGIN PROGRAM. */ X /* */ X> XEND PROGRAM. X/* END PROGRAM. */ X/* End of generated file */ X> XBEGIN MAIN ROUTINE. X/* BEGIN MAIN ROUTINE. */ Xshort DoIt() X{ X F0 = 0; F1 = 1; F2 = 2; F3 = 3; X V0 = 0; V1 = 1; V2 = 2; V3 = 3; V4 = 4; X V5 = 5; V6 = 6; V7 = 7; V8 = 8; V9 = 9; X P0 = 0; P1 = 1; P2 = 2; P3 = 3; P4 = 4; X P5 = 5; P6 = 10; X P8 = ((long) MEM); X P9 = ((long) MEM) + sizeof(long) * MEMSIZ; X MStartIO(PLargcnt, PLarglist); X> XEND MAIN ROUTINE. X/* END MAIN ROUTINE. */ X MStopIO(); X return 0; X } X> XBEGIN SUBROUTINE $. X/* BEGIN SUBROUTINE $10. */ Xvoid Sub$10(void); Xvoid Sub$10() X{ X> XEND SUBROUTINE $. X/* END SUBROUTINE $10. */ X return; X } X> XLABEL $$. X LABEL$10$20: X> XCHRDATA $$ $ $ $$. X {unsigned f = $30, v = '$40', p = $50*10+$60; X MEM[$10*10+$20] = (v << 24) | ((f & 3) << 22) | (p & 0x3FFFFF);} X> XNUMDATA $$ $ $$ $$. X {unsigned f = $30, v = $40*10+$50, p = $60*10+$70; X MEM[$10*10+$20] = (v << 24) | ((f & 3) << 22) | (p & 0x3FFFFF);} X> XSTOP $. X Stop(F$10, V$10, P$10); X> XCALL $. X Sub$10(); X> XGET $ = MEM $. X if (P$20 < MEM || MEM + MEMSIZ <= P$20 || 0 != (P$20 & 3)) X Oops("Get $00 out of range: P$20"); X {long temp; X temp = * (long *) P$20; X V$10 = (temp >> 24) & 0xFF; X F$10 = (temp >> 22) & 0x03; X P$10 = (temp << 10) >> 10; /* do sign extend */ X } X> XPUT MEM $ = $. X if (P$10 < MEM || MEM + MEMSIZ <= P$10 || 0 != (P$20 & 3)) X Oops("Put $00 out of range: P$10"); X {long temp; X temp = (V$20 << 24) | ((F$20 & 3) << 22) | (P$20 & 0x3FFFFF); X * (long *) P$10 = temp; X } X> XFLG $ = $. X F$10 = F$20; X> XPTR $ = VAL $. X P$10 = (V$20 & 0xFF); X> XVAL $ = PTR $. X V$10 = (P$20 & 0xFF); X> XVAL $ = $ + $. X V$10 = V$20 + V$30; X> XVAL $ = $ - $. X V$10 = V$20 - V$30; X> XPTR $ = $ + $. X P$10 = P$20 + P$30; X> XPTR $ = $ - $. X P$10 = P$20 - P$30; X> XPTR $ = $ * $. X P$10 = P$20 * P$30; X> XPTR $ = $ / $. X P$10 = P$20 / P$30; X> XMOV PTR $ BY $. X P$10 = P$10 + sizeof(long) * P$20; X> XTO $$. X goto LABEL$10$20; X> XTO $$ IF FLG $ EQ $. X if (F$30 == F$40) goto LABEL$10$20; X> XTO $$ IF FLG $ NE $. X if (F$30 != F$40) goto LABEL$10$20; X> XTO $$ IF VAL $ EQ $. X if (V$30 == V$40) goto LABEL$10$20; X> XTO $$ IF VAL $ NE $. X if (V$30 != V$40) goto LABEL$10$20; X> XTO $$ IF PTR $ EQ $. X if (P$30 == P$40) goto LABEL$10$20; X> XTO $$ IF PTR $ NE $. X if (P$30 != P$40) goto LABEL$10$20; X> XTO $$ IF PTR $ LT $. X if (P$30 < P$40) goto LABEL$10$20; X> XREWIND $. X {long temp; X temp = MRewind(V$10); X if (temp == OK) F$10 = 0; else F$10 = 1; X } X> XGET BUFF $. X F$10 = MGetBuff(V$10); X> XPUT BUFF $. X F$10 = MPutBuff(V$10); X> XVAL $ = INPUT. X V$10 = MGetChar(); X> XOUTPUT = VAL $. X V$10 = MPutChar(V$10); X> X. An empty line will match X> An empty line will generate nothing XDEBUG. X> The debug statement does nothing yet in compiled code XMESSAGE $$$$ TO $. X MPutChar(0); X {long temp; X for (temp = 0; temp < 20; temp++) X MPutChar('*'); X MPutChar($10); X MPutChar($20); X MPutChar($30); X MPutChar($40); X MPutChar(' '); X MPutChar('E'); X MPutChar('R'); X MPutChar('R'); X MPutChar('O'); X MPutChar('R'); X MPutChar('!'); X MPutChar(0); X temp = MPutBuff(V$50); X if (temp == OK) F$50 = 0; X else if (temp == EOF) F$50 = 1; X else if (temp == ILLEGAL) F$50 = 2; X } X> END_OF_FILE if test 4774 -ne `wc -c <'LOME/SCM.mac'`; then echo shar: \"'LOME/SCM.mac'\" unpacked with wrong size! fi # end of 'LOME/SCM.mac' fi echo shar: End of archive 3 \(of 9\). cp /dev/null ark3isdone 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.