v23i054: Line oriented macro processor, Part04/09
Rich Salz
rsalz at bbn.com
Fri Nov 30 04:42:34 AEST 1990
Submitted-by: Darren New <new at ee.udel.edu>
Posting-number: Volume 23, Issue 54
Archive-name: lome/part04
#! /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 4 (of 9)."
# Contents: LOME/LOME.h LOME/LOME.mac LOME/LOME1.out LOME/LOME5.c
# LOME/SCMdebug.mac PPL/PPLUnix.c TFS/TFS.h
# Wrapped by new at estelle.ee.udel.edu on Tue Aug 14 16:09:58 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'LOME/LOME.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'LOME/LOME.h'\"
else
echo shar: Extracting \"'LOME/LOME.h'\" \(6152 characters\)
sed "s/^X//" >'LOME/LOME.h' <<'END_OF_FILE'
X/*
X * LOME.h
X * Line Oriented Macro Expander Header file
X * Copyright 1989 Darren New
X *
X */
X
X#include "PPL.h"
X#include "MacroIO.h"
X
X/* ADJUSTABLE PARAMETERS: */
X
X#define MAXmacrochars 15000 /* max # of macro header or body characters */
X#define MAXvarnames 500 /* max # of variables allowed */
X#define MAXnests 200 /* max # of nested macro expansions */
X#define MAXustack 50 /* max # items on user stack */
X#define MAXstreams 20 /* max # items on input stream stack */
X
Xtypedef int moffs; /* type of in which will hold -1..MAXmacrochars */
X
X/* NON-ADJUSTABLE DECLARATIONS: */
X
X#define O_ESC 0 /* escape */
X#define O_PHC 1 /* placeholder character */
X#define O_HEOL 2 /* header end-of-line */
X#define O_SUBS 3 /* substitution */
X#define O_BEOL 4 /* body end-of-line */
X#define O_ZERO 5 /* digit zero */
X#define O_UCA 6 /* first upper-case letter */
X#define O_LCA 7 /* first lower-case letter */
X#define O_UCZ 8 /* last upper-case letter */
X#define O_FILEOP 9 /* file operation character */
X#define O_CTRLOP 10 /* control operation character */
X#define O_OQ 11 /* open quote */
X#define O_CQ 12 /* close quote */
X#define O_OP 13 /* open paren */
X#define O_CP 14 /* close paren */
X#define O_PLUS 15 /* plus sign */
X#define O_MINUS 16 /* minus sign */
X#define O_MULT 17 /* multiplication sign */
X#define O_DIV 18 /* division sign */
X#define O_FETCH 19 /* the fetch character */
X#define O_RADIX 20 /* the radix character */
X#define O_RESC1 21 /* reserved char 1 */
X#define O_RESC2 22 /* reserved char 2 */
X#define O_RESC3 23 /* reserved char 3 */
X#define O_RESC4 24 /* reserved char 4 */
X#define O_SPACE 25 /* space character */
X#define O_FCASE 26 /* case specific flag */
X#define O_FBLANK 27 /* blank output line flag */
X#define O_FSPACE 28 /* leading space flag */
X#define O_FMATCH 29 /* required match flag */
X#define O_FSYMGEN 30 /* symbol generator advance flag */
X#define O_FSTACKUNDER 31 /* user stack underflow flag */
X#define O_FSTACKSIZE 32 /* initial user stack size flag */
X#define O_FECHO 33 /* echo flag */
X#define O_RESF1 34 /* reserved flag 1 */
X#define O_RESF2 35 /* reserved flag 2 */
X#define O_RESF3 36 /* reserved flag 3 */
X#define O_RESF4 37 /* reserved flag 4 */
X#define O_last 38 /* size of parameter string */
X
Xextern char params[O_last]; /* inputted parameter string */
X
X /* Format of macros in macrochar and macroflag:
X * header: flag = 0, val=char to match
X * flag = 1, val='@' for placeholder
X * flag = 2, val=0 for HEOL
X * body lines:
X * flag = 0 to insert char in constructed line
X * flag = 1, val='0'-'9' or 'C' or 'F' followed by
X * flag = 1, val='0'-'9' for substitution
X * flag=2, val=0 for BEOL
X * flag=3, val=0 for end of body (after last BEOL)
X */
X
Xextern unsigned char * macrochar; /* chars of macros (dyn alc) */
Xextern unsigned char * macroflag; /* flags of macros (dyn alc) */
Xextern moffs macrosize; /* size of macros loaded */
X
Xextern str varname[MAXvarnames]; /* names of variables */
Xextern str varval[MAXvarnames]; /* values of variables */
X
Xextern str ustack[MAXustack]; /* values of user stack */
Xextern short ustacksize; /* # items on ustack */
X
Xstruct traceback_struct { /* one entry on traceback stack */
X moffs retoffs; /* macro offset to return to */
X str inp; /* matched line */
X str p[10]; /* parameter values */
X };
X
Xextern struct traceback_struct tstack[MAXnests]; /* traceback stack */
Xextern int tstacksize;
X
X#define Sretoffs (tstack[tstacksize-1].retoffs)
X#define Sinp (tstack[tstacksize-1].inp)
X#define Sp (tstack[tstacksize-1].p)
X#define Sp0 (tstack[tstacksize-1].p[0])
X#define Sp1 (tstack[tstacksize-1].p[1])
X#define Sp2 (tstack[tstacksize-1].p[2])
X#define Sp3 (tstack[tstacksize-1].p[3])
X#define Sp4 (tstack[tstacksize-1].p[4])
X#define Sp5 (tstack[tstacksize-1].p[5])
X#define Sp6 (tstack[tstacksize-1].p[6])
X#define Sp7 (tstack[tstacksize-1].p[7])
X#define Sp8 (tstack[tstacksize-1].p[8])
X#define Sp9 (tstack[tstacksize-1].p[9])
X
X#define ADDTOLINE(c) (consline[conslinesize++] = (c))
X#define ENDLINE() (consline[conslinesize] = 0)
X
Xextern short sstack[MAXstreams]; /* input stream stack */
Xextern short sstacksize; /* # items on sstack */
X
Xextern short outstream; /* current output stream */
Xextern short instream; /* current input stream */
X
Xextern char consline[BIGLINE]; /* constructed line */
Xextern short conslinesize; /* chars on cons line */
X
Xextern long symgenval; /* symbol generator value */
X
Xextern long skipping; /* skip value flag */
X
Xextern bool quitting; /* abnormally exitting */
X
X/* Functions: */
X
X /* the two main functions */
Xextern bool LoadMacros(int); /* load macros from stream */
Xextern void ParseFiles(int); /* parse source from stream */
X
X /* the support functions */
Xextern void AddLineToStack(str);/* push and parse new line */
Xextern int BalMatch(str,str,char*);
X /* match balanced string */
Xextern void FindMatch(void); /* match input line on top of traceback */
Xextern void ExpandLine(void); /* expand macro on top of traceback */
Xextern void DoCtrlOp(int); /* do control op given as arg */
Xextern void DoFileOp(int); /* do file op given as arg */
Xextern void DoSubsOp(int,int); /* do substitution=arg2 on param=arg1 */
X
X /* the general functions called from several places */
Xextern void Message(str); /* output a 4-char error message */
Xextern void TraceBack(void); /* display traceback */
Xextern void PopTStack(void); /* pop and discard top of traceback */
Xextern void IntToStr(long,str); /* convert integer to string */
Xextern long StrToInt(str); /* convert string to integer */
Xextern long StrToIntErr(str,str*); /* convert string to integer w/ errors */
Xextern void InsNumber(long); /* insert text of number into line */
Xextern str VarLookup(str); /* look up value of variable */
Xextern void VarSetVal(str,str); /* set value of variable */
X
X
END_OF_FILE
if test 6152 -ne `wc -c <'LOME/LOME.h'`; then
echo shar: \"'LOME/LOME.h'\" unpacked with wrong size!
fi
# end of 'LOME/LOME.h'
fi
if test -f 'LOME/LOME.mac' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'LOME/LOME.mac'\"
else
echo shar: Extracting \"'LOME/LOME.mac'\" \(7493 characters\)
sed "s/^X//" >'LOME/LOME.mac' <<'END_OF_FILE'
XFILE: LOME.mac
XThis is the input file for the regression testing of LOME.
X
X\@.@$0AaZFC`'()+-*/?!XXXX 011000000000
XTest1a @
XThis should say "`alpha '": "@00"
XThis should say "alpha ": "@01"
X$$
X
XTest1.
XTesting parameter substitution ops...$This should not appear
XThere should be exactly one blank line next
X$ Nothing but a blank line should appear here
XTest1a `alpha '$
XThis should have nothing between quotes: "@00"
XONEONE at 27$ Assign "ONEONE" to parameter 2
XThis should say "ONEONE": "@20"
XFOUR at 28$ set var ONEONE to FOUR
XThis should say "FOUR": "@23"
XThis should say "6": "@26"
XThis should be I/O code for "O": "@25"
XThis should say "0": "@55"
XThis should say "0" also: "@56"
XThree different numbers next: @54 @54 @54
XThis should say "FOUR" again: "@24"
XSIX at 37$ Assign "SIX" to parameter 3
XThis should say the same number three times: @34 @34 @34
XThese are the I/O codes of A Z a z 0 + - * / ( ) ` ' ? !:
XTest2Help A
XTest2Help Z
XTest2Help a
XTest2Help z
XTest2Help 0
XTest2Help +
XTest2Help -
XTest2Help *
XTest2Help /
XTest2Help (
XTest2Help )
XTest2Help `
XTest2Help '
XTest2Help ?
XTest2Help !
XTesting substitution ops (except math) complete!
X$$
X
XTest2Help @.
XThe I/O code for "@00" is "@05"
X$$
X
XTest3. test control ops
XTesting control ops...
XTest3a$ test skips single case
XTest3c$ test push and pop
X$$
XTest3a. test skips single case
XThis tests skips next. Following lines should be numbered and consecutive.
XIf a line starting with X appears, an error exists.
X01 - About to test skip eq
XSkip 1 if xyzzy eq xyzzy
XXA - If this appears, skip eq does not skip on eq
XSkip 1 if xyzzy eq pdq
X02 - If this does not appear, skip eq skips on ne
X03 - End test of skip eq. About to test skip ne.
XSkip 1 if lotus ne xyzzy
XXB - If this appears, skip ne does not skip on ne
XSkip 1 if lotus ne lotus
X04 - If this does not appear, skip ne skips on eq
X05 - end test of skip ne. about to test skip lt.
XSkip 1 if 100 lt 100
X06 - If this does not appear, 100 lt 100 skips
XSkip 1 if 100 lt 200
XXC - If this appears, 100 lt 200 did not skip
XSkip 1 if -100 lt 50
XXD - If this appears, -100 lt 200 did not skip
XSkip 1 if 50 lt -100
X07 - If this does not appear, 50 lt -100 skips
X08 - end test of skip lt. about to test skip begins.
XSkip 1 if xyzzy begins xyzzypdq
XXE - If this appears, xyzzy begins xyzzypdq does not skip
XSkip 1 if xyzzy begins xyzzy
XXF - If this appears, xyzzy begins xyzzy does not skip
XSkip 1 if xyzzy begins xyzz
X09 - If this does not appear, xyzzy begins xyzz skips
X10 - About to test multi-level skips
XTest3b1
X11 - End of numbered lines (for now)
X$$
XTest3b1.
XTest3b2
XXX - Multi level skip not skipping enough
X$$
XTest3b2.
XTest3b3
XXX - Multi level skip not skipping enough
X$$
XTest3b3.
XSkip -4 if 0 lt 1$ -4 because Skip @ if @ lt @ is also a macro
XXX - Multi level skip not skipping enough
X$$
XTest3c. test push and pop
XONE at C5TWO@C5THREE at C5
X2 at C6
X at C6
X3 at C6
XThis should say "THREE ONE": "@20 @30"
X$$
X
XTest4. Test skipping input directly
XAbout to test input skipping.
XSkip 3 if 1 lt 2
XXX - This should not appear.
X$$
XSkip @ if @ eq @. string equal comparison
X at C2$
X$$
XSkip @ if @ ne @. string notequal comparison.
X at C3$
X$$
XSkip @ if @ lt @. numeric lessthan comparison.
X at C1$
X$$
XSkip @ if @ begins @. initial string comparison.
X at C4$
X$$
X
XTest5. Decimal Loop constructs
XStart Decimal Loop Tests
XThis should print "test5a:(-3)" through "test5a:(19)" and then "stuff"
XDecimal loop -3 19 test5a:
XThe next line should say "test5b:(5)" and then "stuff"
XDecimal loop 5 5 test5b:
XThe next line should say "stuff" and then "no loop" w/o anything between
XDecimal loop 8 7 test5c:
Xno loop
XThis should say "test5d1:(1)" and "test5d1:(2)" and then NO "stuff"
XDecimal loop 1 5 test5d:
XEnd Decimal Loop Tests
X$$
XDecimal loop @ @ @
X at 21@C7stuff
X$$
Xtest5d:(@).
XSkip -3 if @00 eq 3
Xtest5d1:(@00)
X$$
X
XTest6. String Loop constructs
XStart String Loop Tests
XThis should say "t6:A" "t6:C" "t6:F" and then "stuff"
XString loop !ACF!!t6:!
XThis should print out the eval example from the docs
XString loop !AB+(B*CD)*E+-FG!+-*/!EVAL!
XThis should print out the XX example from the docs
XAB(CD`@07
X()`'@17
XXX at C8
XEnd String Loop Tests
X$$
XString loop !@!@!@!
X at 21@C8stuff
X$$
X
XTest7a. Test some file ops
X1VERY IMPORTANT TEST MESSAGE SHOULD GO TO CONSOLE at F7
X9note not so very imporant test message should be suppressed at F7
XX-X-X-X-X ONE
X4 at F2$ send output to stream 4
XFish Fish Fish
XThis line should go onto stream 4 and then be copied to output.
XThis should also go to stream 4 and be copied to output also.
XOnce more this goes to stream 4 and back.
XEND OF INPUT
X3 at F2$ reset output back to stream 3 again
XX-X-X-X-X TWO
X4 at F0$ rewind stream 4
X4ZEND OF INPUT at F1$ copy stream 4 to input until "END OF INPUT" found
XX-X-X-X-X THREE
X4 at F0$ rewind stream 4
X4X at F3$ read stream four and revert at EOF
X$$ force input stream 4 to read
XTest7b. more file operations
XX-X-X-X-X FOUR
X4 at F0$ rewind stream 4
X47 at F8$ read a line from 4 and put it in P7
XX-X-X-X-X FIVE
XThis should say "Fish Fish Fish": "@70"
XZThe next line should say "TestMath" only at F4
XZTestMath at F4
XThis should output the F5 example from LOME.doc:
XZERO at 0723@17
XZ 000000 11111 000 HELP22ME at F5
XX-X-X-X-X SIX
X49 at F1$ Copy stream 4 from current to EOF to scratch 9
X9 at F0$ rewind scratch 9
X9Z at F1$ Copy 9 to output until EOF
XX-X-X-X-X SEVEN
X9 at F0$ rewind nine again
X9ZOnce at F1$ copy it again, stopping at Once...
XX-X-X-X-X EIGHT
X9t:LOME9.out at F0$ rewind nine and rename it to t:LOME9.out
X9This should go only to t:LOME9.out at F4
XX-X-X-X-X NINE
X$$
X
XTestMath.
XTest mathematical substitutions:
XZIP at 07$ put "ZIP" into parameter zero
X7294 at 08$ put "7294" into variable ZIP
XNo operators: This should say "ZIP": "@02"
X3 9 + at 27
XAddition: This should say "12": "@22"
X3 9 *@27
XMultiplication: This should say "27": "@22"
X143 149 - at 27
XSubtraction: This should say "-6": "@22"
X3 9 /@27
XDivision w/ truncation: This should say "0": "@22"
X-34 5 /@27
XDivision w/o truncation: This should say "-6": "@22"
X -25 @27
XLeading minus: This should say "-25": "@22"
X 25 5 * 18 3 / + -1 * @27
XComplex formulas with leading minuses: This should say "-131": "@22"
XZIP ?@17$ put "ZIP ?" into parameter one
XFetch: This should say "7294": "@12"
X ZIP ? @17$ put " ZIP ? " into parameter one
XFetch with extra spaces: This should say "7294": "@12"
XZIP ? 18 /@17
XFetch then math: This should say "405": "@12"
X +3 +12 -2 / +3 * *@27
XComplex leading plusses and minuses: this should say "-54": "@22"
XRadix tests:
XThe following should give 0 to 9 and A to Z after TM1a: and then stuff
XDecimal loop 0 35 TM1:
XThe following should give -Z to -A and -9 to -1 and 0 after TM1a: and then stuff
XDecimal loop -35 0 TM1:
XThe following should give -2Z to -20 to -1Z to -10 to -Z to -1 to 0
XDecimal loop -107 0 TM1:
XThe following should give 0 to 35 after TM3a: and then stuff
XString loop !0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ!!TM3:!
XThe following should give 0 to 35 again after TM3a: and then stuff
XString loop !0123456789abcdefghijklmnopqrstuvwxyz!!TM3:!
XThe following should give 2 to 36 after TM3a: and then stuff
XString loop !123456789ABCDEFGHIJKLNNOPQRSTUVWXYZ!!TM3b:!
XThe following should count from 0 to 15 in binary after TM4a: and then stuff
XDecimal loop 0 15 TM4:
X +100 9 Z !@27
XRadix with leading plusses: This should say "2S": "@22"
XEnd of radix tests.
X$$
XTM4:(@).
X at 00 9 1 !@27TM4a:@22
X$$
XTM3b:@.
X10 @00 9 !@27TM3a:@22
X$$
XTM3:@.
X at 00 z 9 !@27TM3a:@22
X$$
XTM2:(@).
X at 00 Z 9 !@27TM2a:@22
X$$
XTM1:(@).
X at 00 9 Z !@27TM1a:@22
X$$
X
X
END_OF_FILE
if test 7493 -ne `wc -c <'LOME/LOME.mac'`; then
echo shar: \"'LOME/LOME.mac'\" unpacked with wrong size!
fi
# end of 'LOME/LOME.mac'
fi
if test -f 'LOME/LOME1.out' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'LOME/LOME1.out'\"
else
echo shar: Extracting \"'LOME/LOME1.out'\" \(7500 characters\)
sed "s/^X//" >'LOME/LOME1.out' <<'END_OF_FILE'
XThis line should come out unchanged
XTesting parameter substitution ops...
XThere should be exactly one blank line next
X
XThis should say "`alpha '": "`alpha '"
XThis should say "alpha ": "alpha "
XThis should have nothing between quotes: ""
XThis should say "ONEONE": "ONEONE"
XThis should say "FOUR": "FOUR"
XThis should say "6": "6"
XThis should be I/O code for "O": "79"
XThis should say "0": "0"
XThis should say "0" also: "0"
XThree different numbers next: 0 1 2
XThis should say "FOUR" again: "FOUR"
XThis should say the same number three times: 3 3 3
XThese are the I/O codes of A Z a z 0 + - * / ( ) ` ' ? !:
XThe I/O code for "A" is "65"
XThe I/O code for "Z" is "90"
XThe I/O code for "a" is "97"
XThe I/O code for "z" is "122"
XThe I/O code for "0" is "48"
XThe I/O code for "+" is "43"
XThe I/O code for "-" is "45"
XThe I/O code for "*" is "42"
XThe I/O code for "/" is "47"
XThe I/O code for "(" is "40"
XThe I/O code for ")" is "41"
XThe I/O code for "`" is "96"
XThe I/O code for "'" is "39"
XThe I/O code for "?" is "63"
XThe I/O code for "!" is "33"
XTesting substitution ops (except math) complete!
XTest2
XTesting control ops...
XThis tests skips next. Following lines should be numbered and consecutive.
XIf a line starting with X appears, an error exists.
X01 - About to test skip eq
X02 - If this does not appear, skip eq skips on ne
X03 - End test of skip eq. About to test skip ne.
X04 - If this does not appear, skip ne skips on eq
X05 - end test of skip ne. about to test skip lt.
X06 - If this does not appear, 100 lt 100 skips
X07 - If this does not appear, 50 lt -100 skips
X08 - end test of skip lt. about to test skip begins.
X09 - If this does not appear, xyzzy begins xyzz skips
X10 - About to test multi-level skips
X11 - End of numbered lines (for now)
XThis should say "THREE ONE": "THREE ONE"
XAbout to test input skipping.
XIf this does not appear, input skips skipping too much
XStart Decimal Loop Tests
XThis should print "test5a:(-3)" through "test5a:(19)" and then "stuff"
Xtest5a:(-3)
Xtest5a:(-2)
Xtest5a:(-1)
Xtest5a:(0)
Xtest5a:(1)
Xtest5a:(2)
Xtest5a:(3)
Xtest5a:(4)
Xtest5a:(5)
Xtest5a:(6)
Xtest5a:(7)
Xtest5a:(8)
Xtest5a:(9)
Xtest5a:(10)
Xtest5a:(11)
Xtest5a:(12)
Xtest5a:(13)
Xtest5a:(14)
Xtest5a:(15)
Xtest5a:(16)
Xtest5a:(17)
Xtest5a:(18)
Xtest5a:(19)
Xstuff
XThe next line should say "test5b:(5)" and then "stuff"
Xtest5b:(5)
Xstuff
XThe next line should say "stuff" and then "no loop" w/o anything between
Xstuff
Xno loop
XThis should say "test5d1:(1)" and "test5d1:(2)" and then NO "stuff"
Xtest5d1:(1)
Xtest5d1:(2)
XEnd Decimal Loop Tests
XStart String Loop Tests
XThis should say "t6:A" "t6:C" "t6:F" and then "stuff"
Xt6:A
Xt6:C
Xt6:F
Xstuff
XThis should print out the eval example from the docs
XEVAL(+)AB
XEVAL(*)(B*CD)
XEVAL(+)E
XEVAL(-)
XEVAL()FG
Xstuff
XThis should print out the XX example from the docs
XXX(\()AB
XXX(`)CD
XEnd String Loop Tests
XX-X-X-X-X ONE
XX-X-X-X-X TWO
XFish Fish Fish
XThis line should go onto stream 4 and then be copied to output.
XThis should also go to stream 4 and be copied to output also.
XOnce more this goes to stream 4 and back.
XX-X-X-X-X THREE
XFish Fish Fish
XThis line should go onto stream 4 and then be copied to output
XThis should also go to stream 4 and be copied to output also
XOnce more this goes to stream 4 and back
XEND OF INPUT
XX-X-X-X-X FOUR
XX-X-X-X-X FIVE
XThis should say "Fish Fish Fish": "Fish Fish Fish"
XThe next line should say "TestMath" only
XTestMath
XThis should output the F5 example from LOME.doc:
X ZERO 23 ZER HELP ME
XX-X-X-X-X SIX
XThis line should go onto stream 4 and then be copied to output.
XThis should also go to stream 4 and be copied to output also.
XOnce more this goes to stream 4 and back.
XEND OF INPUT
XX-X-X-X-X SEVEN
XThis line should go onto stream 4 and then be copied to output.
XThis should also go to stream 4 and be copied to output also.
XX-X-X-X-X EIGHT
XX-X-X-X-X NINE
XTest mathematical substitutions:
XNo operators: This should say "ZIP": "ZIP"
XAddition: This should say "12": "12"
XMultiplication: This should say "27": "27"
XSubtraction: This should say "-6": "-6"
XDivision w/ truncation: This should say "0": "0"
XDivision w/o truncation: This should say "-6": "-6"
XLeading minus: This should say "-25": "-25"
XComplex formulas with leading minuses: This should say "-131": "-131"
XFetch: This should say "7294": "7294"
XFetch with extra spaces: This should say "7294": "7294"
XFetch then math: This should say "405": "405"
XComplex leading plusses and minuses: this should say "-54": "-54"
XRadix tests:
XThe following should give 0 to 9 and A to Z after TM1a: and then stuff
XTM1a:0
XTM1a:1
XTM1a:2
XTM1a:3
XTM1a:4
XTM1a:5
XTM1a:6
XTM1a:7
XTM1a:8
XTM1a:9
XTM1a:A
XTM1a:B
XTM1a:C
XTM1a:D
XTM1a:E
XTM1a:F
XTM1a:G
XTM1a:H
XTM1a:I
XTM1a:J
XTM1a:K
XTM1a:L
XTM1a:M
XTM1a:N
XTM1a:O
XTM1a:P
XTM1a:Q
XTM1a:R
XTM1a:S
XTM1a:T
XTM1a:U
XTM1a:V
XTM1a:W
XTM1a:X
XTM1a:Y
XTM1a:Z
Xstuff
XThe following should give -Z to -A and -9 to -1 and 0 after TM1a: and then stuff
XTM1a:-Z
XTM1a:-Y
XTM1a:-X
XTM1a:-W
XTM1a:-V
XTM1a:-U
XTM1a:-T
XTM1a:-S
XTM1a:-R
XTM1a:-Q
XTM1a:-P
XTM1a:-O
XTM1a:-N
XTM1a:-M
XTM1a:-L
XTM1a:-K
XTM1a:-J
XTM1a:-I
XTM1a:-H
XTM1a:-G
XTM1a:-F
XTM1a:-E
XTM1a:-D
XTM1a:-C
XTM1a:-B
XTM1a:-A
XTM1a:-9
XTM1a:-8
XTM1a:-7
XTM1a:-6
XTM1a:-5
XTM1a:-4
XTM1a:-3
XTM1a:-2
XTM1a:-1
XTM1a:0
Xstuff
XThe following should give -2Z to -20 to -1Z to -10 to -Z to -1 to 0
XTM1a:-2Z
XTM1a:-2Y
XTM1a:-2X
XTM1a:-2W
XTM1a:-2V
XTM1a:-2U
XTM1a:-2T
XTM1a:-2S
XTM1a:-2R
XTM1a:-2Q
XTM1a:-2P
XTM1a:-2O
XTM1a:-2N
XTM1a:-2M
XTM1a:-2L
XTM1a:-2K
XTM1a:-2J
XTM1a:-2I
XTM1a:-2H
XTM1a:-2G
XTM1a:-2F
XTM1a:-2E
XTM1a:-2D
XTM1a:-2C
XTM1a:-2B
XTM1a:-2A
XTM1a:-29
XTM1a:-28
XTM1a:-27
XTM1a:-26
XTM1a:-25
XTM1a:-24
XTM1a:-23
XTM1a:-22
XTM1a:-21
XTM1a:-20
XTM1a:-1Z
XTM1a:-1Y
XTM1a:-1X
XTM1a:-1W
XTM1a:-1V
XTM1a:-1U
XTM1a:-1T
XTM1a:-1S
XTM1a:-1R
XTM1a:-1Q
XTM1a:-1P
XTM1a:-1O
XTM1a:-1N
XTM1a:-1M
XTM1a:-1L
XTM1a:-1K
XTM1a:-1J
XTM1a:-1I
XTM1a:-1H
XTM1a:-1G
XTM1a:-1F
XTM1a:-1E
XTM1a:-1D
XTM1a:-1C
XTM1a:-1B
XTM1a:-1A
XTM1a:-19
XTM1a:-18
XTM1a:-17
XTM1a:-16
XTM1a:-15
XTM1a:-14
XTM1a:-13
XTM1a:-12
XTM1a:-11
XTM1a:-10
XTM1a:-Z
XTM1a:-Y
XTM1a:-X
XTM1a:-W
XTM1a:-V
XTM1a:-U
XTM1a:-T
XTM1a:-S
XTM1a:-R
XTM1a:-Q
XTM1a:-P
XTM1a:-O
XTM1a:-N
XTM1a:-M
XTM1a:-L
XTM1a:-K
XTM1a:-J
XTM1a:-I
XTM1a:-H
XTM1a:-G
XTM1a:-F
XTM1a:-E
XTM1a:-D
XTM1a:-C
XTM1a:-B
XTM1a:-A
XTM1a:-9
XTM1a:-8
XTM1a:-7
XTM1a:-6
XTM1a:-5
XTM1a:-4
XTM1a:-3
XTM1a:-2
XTM1a:-1
XTM1a:0
Xstuff
XThe following should give 0 to 35 after TM3a: and then stuff
XTM3a:0
XTM3a:1
XTM3a:2
XTM3a:3
XTM3a:4
XTM3a:5
XTM3a:6
XTM3a:7
XTM3a:8
XTM3a:9
XTM3a:10
XTM3a:11
XTM3a:12
XTM3a:13
XTM3a:14
XTM3a:15
XTM3a:16
XTM3a:17
XTM3a:18
XTM3a:19
XTM3a:20
XTM3a:21
XTM3a:22
XTM3a:23
XTM3a:24
XTM3a:25
XTM3a:26
XTM3a:27
XTM3a:28
XTM3a:29
XTM3a:30
XTM3a:31
XTM3a:32
XTM3a:33
XTM3a:34
XTM3a:35
Xstuff
XThe following should give 0 to 35 again after TM3a: and then stuff
XTM3a:0
XTM3a:1
XTM3a:2
XTM3a:3
XTM3a:4
XTM3a:5
XTM3a:6
XTM3a:7
XTM3a:8
XTM3a:9
XTM3a:10
XTM3a:11
XTM3a:12
XTM3a:13
XTM3a:14
XTM3a:15
XTM3a:16
XTM3a:17
XTM3a:18
XTM3a:19
XTM3a:20
XTM3a:21
XTM3a:22
XTM3a:23
XTM3a:24
XTM3a:25
XTM3a:26
XTM3a:27
XTM3a:28
XTM3a:29
XTM3a:30
XTM3a:31
XTM3a:32
XTM3a:33
XTM3a:34
XTM3a:35
Xstuff
XThe following should give 2 to 36 after TM3a: and then stuff
XTM3a:2
XTM3a:3
XTM3a:4
XTM3a:5
XTM3a:6
XTM3a:7
XTM3a:8
XTM3a:9
XTM3a:10
XTM3a:11
XTM3a:12
XTM3a:13
XTM3a:14
XTM3a:15
XTM3a:16
XTM3a:17
XTM3a:18
XTM3a:19
XTM3a:20
XTM3a:21
XTM3a:22
XTM3a:24
XTM3a:24
XTM3a:25
XTM3a:26
XTM3a:27
XTM3a:28
XTM3a:29
XTM3a:30
XTM3a:31
XTM3a:32
XTM3a:33
XTM3a:34
XTM3a:35
XTM3a:36
Xstuff
XThe following should count from 0 to 15 in binary after TM4a: and then stuff
XTM4a:0
XTM4a:1
XTM4a:10
XTM4a:11
XTM4a:100
XTM4a:101
XTM4a:110
XTM4a:111
XTM4a:1000
XTM4a:1001
XTM4a:1010
XTM4a:1011
XTM4a:1100
XTM4a:1101
XTM4a:1110
XTM4a:1111
Xstuff
XRadix with leading plusses: This should say "2S": "2S"
XEnd of radix tests.
XEnd of Tests!
END_OF_FILE
if test 7500 -ne `wc -c <'LOME/LOME1.out'`; then
echo shar: \"'LOME/LOME1.out'\" unpacked with wrong size!
fi
# end of 'LOME/LOME1.out'
fi
if test -f 'LOME/LOME5.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'LOME/LOME5.c'\"
else
echo shar: Extracting \"'LOME/LOME5.c'\" \(6778 characters\)
sed "s/^X//" >'LOME/LOME5.c' <<'END_OF_FILE'
X/*
X * LOME5.c
X * Line Oriented Macro Expander - DoCtrlOp()
X * Copyright 1989 Darren New
X *
X */
X
X#include "LOME.h"
X
Xvoid DoCtrlOp ARGS1(int,op /* the operation number */)
X{
X int i;
X
X assert(0 < tstacksize);
X
X switch (op) {
X
X case 0: { /* stop */
X if (conslinesize != 0) {
X char * t = consline;
X MPutChar(0);
X while (*t) MPutChar(*t++);
X MPutChar(0);
X MPutBuff(outstream);
X TraceBack();
X }
X quitting = TRUE;
X break;
X }
X
X case 1: { /* skip p0 if val(p1) < val(p2) */
X if (StrToInt(Sp1) < StrToInt(Sp2)) {
X skipping = StrToInt(Sp0);
X while (macroflag[Sretoffs] != 2)
X Sretoffs += 1;
X }
X break;
X }
X
X case 2: { /* skip p0 if "p1" eq "p2" */
X
X bool m = TRUE; /* matched? */
X bool c = params[O_FCASE] == params[O_ZERO]; /* case indep? */
X char c1, c2; /* chars being compared */
X
X if (Sp1 == NULL) Sp1 = PLStrDup("");
X if (Sp2 == NULL) Sp2 = PLStrDup("");
X
X if (strlen(Sp1) != strlen(Sp2)) m = FALSE;
X
X for (i = 0; m && (c1 = Sp1[i]) && (c2 = Sp2[i]); i++) {
X m = c1 == c2;
X if (!m && c) {
X /* see if case independence will match */
X if (params[O_UCA] <= c1 && c1 <= params[O_UCZ])
X c1 = c1 - params[O_UCA] + params[O_LCA];
X if (params[O_UCA] <= c2 && c2 <= params[O_UCZ])
X c2 = c2 - params[O_UCA] + params[O_LCA];
X m = c1 == c2;
X }
X }
X
X if (m) {
X skipping = StrToInt(Sp0);
X while (macroflag[Sretoffs] != 2)
X Sretoffs += 1;
X }
X
X break;
X }
X
X case 3: { /* skip p0 if "p1" ne "p2" */
X
X bool m = TRUE; /* matched? */
X bool c = params[O_FCASE] == params[O_ZERO]; /* case indep? */
X char c1, c2; /* chars being compared */
X
X if (Sp1 == NULL) Sp1 = PLStrDup("");
X if (Sp2 == NULL) Sp2 = PLStrDup("");
X
X if (strlen(Sp1) != strlen(Sp2)) m = FALSE;
X
X for (i = 0; m && (c1 = Sp1[i]) && (c2 = Sp2[i]); i++) {
X m = c1 == c2;
X if (!m && c) {
X /* see if case independence will match */
X if (params[O_UCA] <= c1 && c1 <= params[O_UCZ])
X c1 = c1 - params[O_UCA] + params[O_LCA];
X if (params[O_UCA] <= c2 && c2 <= params[O_UCZ])
X c2 = c2 - params[O_UCA] + params[O_LCA];
X m = c1 == c2;
X }
X }
X
X if (!m) {
X skipping = StrToInt(Sp0);
X while (macroflag[Sretoffs] != 2)
X Sretoffs += 1;
X }
X
X break;
X }
X
X case 4: { /* skip p0 if "p1" starts "p2" */
X
X bool m = TRUE; /* matched? */
X bool c = params[O_FCASE] == params[O_ZERO]; /* case indep? */
X char c1, c2; /* chars being compared */
X
X if (Sp1 == NULL) Sp1 = PLStrDup("");
X if (Sp2 == NULL) Sp2 = PLStrDup("");
X
X for (i = 0; m && (c1 = Sp1[i]) && (c2 = Sp2[i]); i++) {
X m = c1 == c2;
X if (!m && c) {
X /* see if case independence will match */
X if (params[O_UCA] <= c1 && c1 <= params[O_UCZ])
X c1 = c1 - params[O_UCA] + params[O_LCA];
X if (params[O_UCA] <= c2 && c2 <= params[O_UCZ])
X c2 = c2 - params[O_UCA] + params[O_LCA];
X m = c1 == c2;
X }
X }
X
X if (Sp1[i] == 0) {
X skipping = StrToInt(Sp0);
X while (macroflag[Sretoffs] != 2)
X Sretoffs += 1;
X }
X
X break;
X }
X
X case 5: { /* push ustack */
X if (ustacksize == MAXustack) {
X Message("FSTK");
X TraceBack();
X quitting = TRUE;
X }
X else {
X ustack[ustacksize++] = PLStrDup(consline);
X }
X break;
X }
X
X case 6: { /* pop ustack */
X if (0 < ustacksize) {
X if (0 < conslinesize) {
X int p = consline[0] - params[O_ZERO];
X if (0 <= p && p <= 9) {
X if (Sp[p]) PLFreeMem(Sp[p]);
X Sp[p] = PLStrDup(ustack[ustacksize-1]);
X }
X else {
X Message("FORM");
X TraceBack();
X quitting = TRUE;
X }
X }
X ustacksize -= 1;
X PLFreeMem(ustack[ustacksize]);
X ustack[ustacksize] = NULL;
X }
X else {
X if (params[O_ZERO] == params[O_FSTACKUNDER]) {
X Message("ESTK");
X TraceBack();
X quitting = TRUE;
X }
X }
X break;
X }
X
X case 7: { /* decimal loop */
X char buf[BIGLINE];
X long p0 = StrToInt(Sp0);
X long p1 = StrToInt(Sp1);
X if (p0 <= p1) {
X /* build new macro line */
X ADDTOLINE(params[O_OP]);
X InsNumber(p0);
X ADDTOLINE(params[O_CP]);
X ENDLINE();
X /* update local parameters for next iteration */
X if (Sp0 != NULL) PLFreeMem(Sp0);
X IntToStr(p0 + 1, buf);
X Sp0 = PLStrDup(buf);
X /* patch return stack by looking for prev BEOL or HEOL */
X while (macroflag[Sretoffs -= 1] != 2)
X ;
X Sretoffs += 1;
X /* after patching my ret addr, add new stack frame */
X AddLineToStack(consline);
X }
X break;
X }
X
X case 8: { /* string loop */
X char buf[BIGLINE];
X if (Sp0 && *Sp0) {
X if (Sp1 == NULL || *Sp1 == 0) { /* individual characters */
X /* build constructed line */
X ADDTOLINE(*Sp0);
X ENDLINE();
X /* update local parameters for next iteration */
X strcpy(buf, Sp0 + 1);
X PLFreeMem(Sp0);
X Sp0 = PLStrDup(buf);
X }
X else { /* groups of characters */
X char next;
X int mlen;
X /* match string */
X mlen = BalMatch(Sp0, Sp1, &next);
X if (next) { /* not at end */
X ADDTOLINE(params[O_OP]);
X if (next == params[O_OP] || next == params[O_CP])
X ADDTOLINE(params[O_ESC]);
X ADDTOLINE(next);
X ADDTOLINE(params[O_CP]);
X for (i = 0; i < mlen; i++)
X ADDTOLINE(Sp0[i]);
X }
X else { /* at end */
X ADDTOLINE(params[O_OP]);
X ADDTOLINE(params[O_CP]);
X for (i = 0; i < mlen; i++)
X ADDTOLINE(Sp0[i]);
X }
X ENDLINE();
X if (Sp0[mlen]) { /* still some left */
X strcpy(buf, &Sp0[mlen + 1]); /* skip mchars too */
X PLFreeMem(Sp0);
X Sp0 = PLStrDup(buf);
X }
X else { /* all done */
X PLFreeMem(Sp0);
X Sp0 = NULL;
X }
X }
X /* patch return stack by looking for prev BEOL or HEOL */
X /* This is what actually causes the iteration */
X while (macroflag[Sretoffs -= 1] != 2)
X ;
X Sretoffs += 1;
X /* after patching my ret addr, add new stack frame */
X AddLineToStack(consline);
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 /* handle skips locally if possible */
X if (skipping < 0) {
X /* negative skips discard traceback stack entries */
X while (skipping < 0 && 0 < tstacksize) {
X PopTStack();
X skipping += 1;
X }
X skipping = 0;
X }
X else if (0 < skipping) {
X /* positive skips skip lines */
X while (0 < skipping && 0 < tstacksize) {
X while (2 != macroflag[Sretoffs] && 3 != macroflag[Sretoffs])
X Sretoffs += 1;
X if (3 == macroflag[Sretoffs]) {
X PopTStack(); /* reached end of macro body */
X }
X else {
X skipping -= 1; /* reached end of line */
X Sretoffs += 1; /* skip BEOL marker */
X }
X }
X /* here, if lines remain, ParseFile will skip them. */
X }
X
X }
X
X
END_OF_FILE
if test 6778 -ne `wc -c <'LOME/LOME5.c'`; then
echo shar: \"'LOME/LOME5.c'\" unpacked with wrong size!
fi
# end of 'LOME/LOME5.c'
fi
if test -f 'LOME/SCMdebug.mac' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'LOME/SCMdebug.mac'\"
else
echo shar: Extracting \"'LOME/SCMdebug.mac'\" \(7108 characters\)
sed "s/^X//" >'LOME/SCMdebug.mac' <<'END_OF_FILE'
XFILE: SCMdebug.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. This version generates inline DEBUGF statements.
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 DEBUGF(7, "flg=%d, val=%d, ptr=%d=%080x, MEM=%08x" C flg C val
X C ptr C ptr C MEM); /* DEBUGF continued */
X DEBUG_EXIT();
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 DEBUG_EXIT();
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 DEBUG_ENTER("MAIN ROUTINE", NULL);
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 DEBUGF(5, "P8=%08x, P9=%08x" C P8 C P9);
X MStartIO(PLargcnt, PLarglist);
X>
XEND MAIN ROUTINE.
X/* END MAIN ROUTINE. */
X DEBUG_RETURN(NULL);
X MStopIO();
X return 0;
X }
X>
XBEGIN SUBROUTINE $.
X/* BEGIN SUBROUTINE $10. */
Xvoid Sub$10(void);
Xvoid Sub$10()
X{
X DEBUG_ENTER("Sub$10", NULL);
X>
XEND SUBROUTINE $.
X/* END SUBROUTINE $10. */
X DEBUG_RETURN(NULL);
X return;
X }
X>
XLABEL $$.
X LABEL$10$20:
XDEBUGF(5, "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 $.
XDEBUGF(5, "STOP $10");
X Stop(F$10, V$10, P$10);
X>
XCALL $.
XDEBUGF(5, "CALL $10");
X Sub$10();
X>
XGET $ = MEM $.
XDEBUGF(7, "GET $10 = MEM $20");
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 */
XDEBUGF(8, " Now, F$10=%d, V$10=%d, P$10=%d" C F$10 C V$10 C P$10);
X }
X>
XPUT MEM $ = $.
XDEBUGF(7, "PUT MEM $10 = $20");
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;
XDEBUGF(8, " Put F$20=%d, V$20=%d, P$20=%d" C F$20 C V$20 C P$20);
X }
X>
XFLG $ = $.
XDEBUGF(7, "FLG $10 = $20");
X F$10 = F$20;
XDEBUGF(8, " Now, F$10=%d" C F$10);
X>
XPTR $ = VAL $.
XDEBUGF(7, "PTR $10 = VAL $20");
X P$10 = (V$20 & 0xFF);
XDEBUGF(8, " Now, P$10=%d" C P$10);
X>
XVAL $ = PTR $.
XDEBUGF(7, "VAL $10 = PTR $20");
X V$10 = (P$20 & 0xFF);
XDEBUGF(8, " Now, V$10=%d" C V$10);
X>
XVAL $ = $ + $.
XDEBUGF(7, "VAL $10 = $20 + $30");
X V$10 = V$20 + V$30;
XDEBUGF(8, " Now, V$10=%d" C V$10);
X>
XVAL $ = $ - $.
XDEBUGF(7, "VAL $10 = $20 - $30");
X V$10 = V$20 - V$30;
XDEBUGF(8, " Now, V$10=%d" C V$10);
X>
XPTR $ = $ + $.
XDEBUGF(7, "PTR $10 = $20 + $30");
X P$10 = P$20 + P$30;
XDEBUGF(8, " Now, P$10=%d" C P$10);
X>
XPTR $ = $ - $.
XDEBUGF(7, "PTR $10 = $20 - $30");
X P$10 = P$20 - P$30;
XDEBUGF(8, " Now, P$10=%d" C P$10);
X>
XPTR $ = $ * $.
XDEBUGF(7, "PTR $10 = $20 * $30");
X P$10 = P$20 * P$30;
XDEBUGF(8, " Now, P$10=%d" C P$10);
X>
XPTR $ = $ / $.
XDEBUGF(7, "PTR $10 = $20 / $30");
X P$10 = P$20 / P$30;
XDEBUGF(8, " Now, P$10=%d" C P$10);
X>
XMOV PTR $ BY $.
XDEBUGF(7, "MOV PTR $10 BY $20");
X P$10 = P$10 + sizeof(long) * P$20;
XDEBUGF(8, " Now, P$10=%d=%08x" C P$10 C P$10);
X>
XTO $$.
XDEBUGF(7, "TO $10$20");
X goto LABEL$10$20;
X>
XTO $$ IF FLG $ EQ $.
XDEBUGF(7, "TO $10$20 IF FLG $30 EQ $40 (F$30=%d, F$40=%d)" C F$30 C F$40);
X if (F$30 == F$40) goto LABEL$10$20;
X>
XTO $$ IF FLG $ NE $.
XDEBUGF(7, "TO $10$20 IF FLG $30 NE $40 (F$30=%d, F$40=%d)" C F$30 C F$40);
X if (F$30 != F$40) goto LABEL$10$20;
X>
XTO $$ IF VAL $ EQ $.
XDEBUGF(7, "TO $10$20 IF VAL $30 EQ $40 (V$30=%d, V$40=%d)" C V$30 C V$40);
X if (V$30 == V$40) goto LABEL$10$20;
X>
XTO $$ IF VAL $ NE $.
XDEBUGF(7, "TO $10$20 IF VAL $30 NE $40 (V$30=%d, V$40=%d)" C V$30 C V$40);
X if (V$30 != V$40) goto LABEL$10$20;
X>
XTO $$ IF PTR $ EQ $.
XDEBUGF(7, "TO $10$20 IF PTR $30 EQ $40 (P$30=%d, P$40=%d)" C P$30 C P$40);
X if (P$30 == P$40) goto LABEL$10$20;
X>
XTO $$ IF PTR $ NE $.
XDEBUGF(7, "TO $10$20 IF PTR $30 NE $40 (P$30=%d, P$40=%d)" C P$30 C P$40);
X if (P$30 != P$40) goto LABEL$10$20;
X>
XTO $$ IF PTR $ LT $.
XDEBUGF(7, "TO $10$20 IF PTR $30 LT $40 (P$30=%d, P$40=%d)" C P$30 C P$40);
X if (P$30 < P$40) goto LABEL$10$20;
X>
XREWIND $.
XDEBUGF(7, "REWIND $10 (V$10=%d)" C V$10);
X {long temp;
X temp = MRewind(V$10);
X if (temp == OK) F$10 = 0; else F$10 = 1;
XDEBUGF(8, " Now, F$10=%d" C F$10);
X }
X>
XGET BUFF $.
XDEBUGF(7, "GET BUFF $10 (V$10=%d)" C V$10);
X F$10 = MGetBuff(V$10);
XDEBUGF(8, " Now, F$10=%d" C F$10);
X>
XPUT BUFF $.
XDEBUGF(7, "PUT BUFF $10");
X F$10 = MPutBuff(V$10);
XDEBUGF(8, " Now, F$10=%d" C F$10);
X>
XVAL $ = INPUT.
XDEBUGF(7, "VAL $10 = INPUT");
X V$10 = MGetChar();
XDEBUGF(8, " Now, V$10=%d" C V$10);
X>
XOUTPUT = VAL $.
XDEBUGF(7, "OUTPUT = VAL $10");
X V$10 = MPutChar(V$10);
XDEBUGF(8, " Now, V$10=%d" C 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 $.
XDEBUGF(7, "MESSAGE $10$20$30$40 TO $50");
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 7108 -ne `wc -c <'LOME/SCMdebug.mac'`; then
echo shar: \"'LOME/SCMdebug.mac'\" unpacked with wrong size!
fi
# end of 'LOME/SCMdebug.mac'
fi
if test -f 'PPL/PPLUnix.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'PPL/PPLUnix.c'\"
else
echo shar: Extracting \"'PPL/PPLUnix.c'\" \(6076 characters\)
sed "s/^X//" >'PPL/PPLUnix.c' <<'END_OF_FILE'
X/*
X * PPLUnix.c
X * Portable Programmer's Library General Host Code
X * Unix version
X * Copyright 1988, 1990 Darren New. All Rights Reserved.
X *
X * Started 19-Feb-88 DHN
X * LastMod 07-jul-90 DHN
X *
X */
X
X#include "PPL.h"
X
X
X#define MAXARGC 20 /* max # args we are willing to remember */
X
X
XHIDDEN long memcount;
X
X
Xvoid PLExit(short severity)
X{
X exit((int) severity);
X }
X
Xptr PLAllocMem(size, flags)
X long size;
X int flags;
X{
X
X#ifdef CHECKALLOC
X
X /* Note that this has some debugging stuff in it */
X /**** OLD -- MUST BE CHECKED!! ****/
X ptr retval;
X inx i;
X assert(size < BIGMEM);
X retval = (ptr) malloc(size + sizeof(long) + sizeof(long) + (size & 1));
X if (retval == NULL) {
X if (flags & PLalloc_die) {
X bomb("Out of Memory");
X PLExit(PLsev_oores);
X }
X else
X return retval;
X }
X else {
X if (flags & PLalloc_zero)
X for (i = size + 2 * sizeof(long) + (size & 1) - 1; 0 <= i; i--)
X retval[i] = '\0';
X memcount += 1;
X (* (long *) retval) = 0xA5A55A5A;
X (* (long *) (retval + sizeof(long) + size + (size & 1))) = 0x5A5AA5A5;
X return retval + sizeof(long);
X }
X
X#else
X
X char * retval;
X inx i;
X assert(size < BIGMEM);
X assert(size < 65530L);
X assert(0 < size);
X retval = malloc((unsigned) size);
X if (retval == NULL) {
X if (flags & PLalloc_die) {
X bomb("Out of Memory");
X PLExit(PLsev_oores);
X return NULL; /* to shut up compiler */
X }
X else {
X return NULL;
X }
X }
X else {
X if (flags & PLalloc_zero) {
X for (i = 0; i < size; i++) {
X retval[i] = '\0';
X }
X }
X memcount += 1;
X return (ptr) retval;
X }
X
X#endif
X
X }
X
X
Xvoid PLFreeMem(where)
X ptr where;
X{
X
X#ifdef CHECKALLOC
X
X /* note that this has some debugging stuff in it */
X assert(where != NULL);
X where -= sizeof(long);
X if (* (long *) where == 0x19919119)
X bomb("Freed memory twice!");
X if (* (long *) where != 0xA5A55A5A)
X bomb("Freed non-malloced memory!");
X (* (long *) where) = 0x19919119;
X free(where);
X memcount -= 1;
X
X#else
X
X extern void free(void *);
X assert(where != NULL);
X free(where);
X memcount -= 1;
X
X#endif
X
X }
X
Xstr PLStrDup(s)
X str s;
X{
X str t;
X t = PLAllocMem(strlen(s)+1, PLalloc_die);
X strcpy((char *) t, (char *) s);
X return t;
X }
X
Xvoid PLCopyMem(to, from, siz)
X ptr to;
X ptr from;
X long siz;
X{
X /* be lazy and use lattice function here */
X extern void *memcpy(void *, void *, unsigned);
X assert(0 < siz);
X assert(siz < BIGMEM);
X assert(NULL != to);
X assert(NULL != from);
X (void) memcpy((char *) to, (char *) from, (unsigned) siz);
X }
X
Xvoid PLFillMem(ptr where, long siz, char chr)
X{
X char * whr = where;
X assert(whr != NULL);
X assert(0 < siz);
X assert(siz < 32760);
X assert(siz < BIGMEM);
X
X /* setmem((char *) where, (unsigned) siz, chr); */
X
X /* I don't trust Lattice at this point... */
X while (0 < siz--)
X *whr++ = chr;
X }
X
Xptr PLFindMem(ptr where, long siz, char chr)
X{
X extern void *memchr(void *, int, unsigned);
X assert(where != NULL);
X assert(0 < siz);
X assert(siz < BIGMEM);
X return (ptr) memchr((char *) where, chr, (unsigned) siz);
X }
X
X
X/* The error strings: */
XHIDDEN str PLerrstrs[] = {
X /* 0*/ "No Error",
X /* 1*/ "DOS error (retryable)",
X /* 2*/ "DOS error (wait/retry)",
X /* 3*/ "DOS error (please fix)",
X /* 4*/ "DOS error (failure)",
X /* 5*/ "Program fault",
X /* 6*/ "End of data during input",
X /* 7*/ "Out of resource during output",
X /* 8*/ "Multiple errors occured without being cleared",
X /* 9*/ "Item does not exist",
X /*10*/ "Item already exists",
X /*11*/ "You are not allowed to do that",
X /*12*/ "That opperation is not supported here",
X /*13*/ "Item is busy",
X /*14*/ "Item name missing or incorrectly formed",
X /*15*/ "Not Yet Implemented",
X /*16*/ "Cannot be Implemented",
X /*17*/ "Argument to internal function semantically invalid",
X /*18*/ "Overflow error",
X /*19*/ "Underflow error",
X /*20*/ "User break or interrupted system call",
X /*21*/ "Error number out of range",
X NULL
X };
X
XPLerr_enum PLerr;
X
Xint OSerr;
X
X/* The file and line of the last error (mainly for debugging) */
Xstr PLerr_file;
Xlong PLerr_line;
X
Xstr PLErrText()
X{
X if ( PLerr < 0 || PLerr_last < PLerr )
X PLerr = PLerr_last;
X return PLerrstrs[PLerr];
X }
X
Xstr PLOSErrText()
X{
X extern char * sys_errlist[];
X extern int sys_nerr;
X
X if (OSerr < 0 || sys_nerr <= OSerr)
X return "PSoserrtext bad OSerr number";
X else
X return sys_errlist[OSerr];
X }
X
Xshort PLstatuslevel = 6;
X
Xvoid PLStatus(short level, str message)
X{
X if (PLstatuslevel < level)
X return;
X if (PLcmdname && *PLcmdname) {
X fprintf(stderr, "%s: ", PLcmdname);
X }
X fprintf(stderr, "%s\n", message);
X fflush(stderr);
X }
X
Xvoid PLDelay(short secs)
X{
X assert(0 <= secs);
X if (secs != 0)
X (void) sleep((unsigned) secs);
X }
X
Xvoid PLBeep(short how)
X{
X fprintf(stderr, "\a");
X }
X
X
X/* This gives the name of the command, if available.
X */
Xstr PLcmdname;
X
X/* This gives the host-syntax filename for the executable file,
X * if available.
X */
Xstr PLcmdfile;
X
X/* This tells how many command-line arguments there were, excluding
X * the command name.
X */
Xshort PLargcnt;
X
X/* This is the array of command-line argument strings.
X */
Xstr PLarglist[MAXARGC];
X
X/* These are the flags describing the command-line parameters.
X */
Xlong PLargflags;
X
X/* Here is the main() that sets all this up, calls DoIt() and exits.
X */
X
X#if HIDPROTS
Xvoid main ARGS((int argc, char * argv[]));
X#endif
X
Xvoid main(int argc, char * argv[])
X{
X
X /* Eventually, we will want to init PLstatuslevel from an env var
X or something similar. */
X
X if (0 < argc) {
X char * cp;
X inx i;
X cp = argv[0] + strlen(argv[0]) - 1;
X while (argv[0] < cp && *cp != '/' && *cp != ':')
X cp -= 1;
X PLcmdname = cp;
X PLargcnt = argc - 1;
X for (i = 1; i < argc && i < MAXARGC; i++)
X PLarglist[i-1] = argv[i];
X }
X PLcmdname = argv[0];
X PLExit(DoIt());
X }
X
X
X/************* END OF FILE ***************/
X
END_OF_FILE
if test 6076 -ne `wc -c <'PPL/PPLUnix.c'`; then
echo shar: \"'PPL/PPLUnix.c'\" unpacked with wrong size!
fi
# end of 'PPL/PPLUnix.c'
fi
if test -f 'TFS/TFS.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'TFS/TFS.h'\"
else
echo shar: Extracting \"'TFS/TFS.h'\" \(6101 characters\)
sed "s/^X//" >'TFS/TFS.h' <<'END_OF_FILE'
X/*
X * TFS.h
X * Portable Programmer's Library Text File Subsystem Header File
X * Copyright 1988 Darren New. All Rights Reserved.
X *
X * Started: 26-Feb-88 DHN
X * LastMod: 05-jan-90 DHN
X *
X */
X
X#ifndef TFS_h
X#define TFS_h
X
Xtypedef long TFSfile; /* a handle to a file */
Xtypedef long TFSnote; /* file position information */
X
X
X/*
X * This initialized anything the TFS might need. Do not call this
X * twice in a row. If this detects an error, it will bomb().
X */
Xextern void TFSInit ARGS((void));
X
X/*
X * This returns TRUE if TFS has been initialized, FALSE if not.
X */
Xextern bool TFSHasBeenInit ARGS((void));
X
X/*
X * This allows a gracefull cleanup of anything TFSInit() may have
X * done. It is not guaranteed to close all TFS files, but it might.
X */
Xextern void TFSTerm ARGS((void));
X
X
X/* This opens a text file. It returns a zero on failure, with the
X * appropriate PLerr set. It returns non-zero on success, and expects
X * the returned value to be passed to all the other routines below.
X * The FNAME parameter is the textual representation of the file name
X * as the user selected it. Note that this is allowed to have strange
X * stuff in it, as long as these routines know what is going on.
X * The FNAME is expected to be a NUL-teminated string, as is the MODE.
X * The following characters are legal in the MODE string:
X * L - Locate (return TFSfile or error without actually opening)
X * C - Create (if file did not exist, create it; if it did, ignore this)
X * T - Truncate (if file did exist, truncate it; if not, ignore this)
X * A - Append (if file did exist, append to it; if not, ignore this)
X * R - Read (file is allowed to be read)
X * W - Write (file is allowed to be written)
X * P - Position (file is allowed to be positioned (TFSNote and TFSPoint))
X * D - Destroy (file is allowed to be destroyed instead of closed)
X *
X * L may be combined with any other command. The file will be checked
X * for the proper permissions, but will not be opened.
X * P is applicable only with R, and if absent may cause TFSInfo() to
X * return less information than if present. If P is present and the
X * file is on a non-"seekable" device (e.g., a terminal), an error may
X * be returned then or at the time of the position.
X * T and A are mutually exclusive, and if W is present one of T or A must
X * also be present; T and A are not allowed without W.
X * R and W are mutually exclusive.
X * Note that C and A are not exclusive; neither are C and D, or C and T,
X * or C and R (which makes an empty file open for reading if it is not
X * already existant).
X */
Xextern TFSfile TFSOpen ARGS((str fname, str mode));
X
X/* This closes a text file. It returns a FALSE on failure, with the
X * appropriate PLerr set; it returns TRUE on success.
X * It is a "bombable" error to pass an unopen file (or invalid handle)
X * to this routine.
X * It does not destroy the data in the file, even if "D" was
X * specified during TFSOpen(). It merely disconnects
X * the file and allows others to use it. It deallocates any buffers
X * obtained from TFSOpen() and so on.
X */
Xextern bool TFSClose ARGS((TFSfile handle));
X
X/* This destroys a text file. It returns a FALSE on failure, with the
X * appropriate PLerr set; it returns TRUE on success. The file
X * must have been previously opened by TFSOpen() with "D" in the mode.
X * It is a "bombable" error to pass an invalid or unopen handle to this.
X * No other permissions are required in the mode, but they may be
X * required by the host operating system.
X * The handle is invalid (closed) after a call to this routine, even if
X * the routine returned an error.
X */
Xextern bool TFSDestroy ARGS((TFSfile handle));
X
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*/
X
X/* Read a line. Only entire lines are read. A '\0' is appened to
X * the buffer. Lines longer than BIGLINE - 1 get truncated with an
X * error return. The return is the number of characters read excluding
X * the NUL appended by the read. The record separator is never returned.
X * End-of-file is indicated by a return of -1 with PLerr set to PLerr_eod.
X * All errors return with a zero-length string in buf.
X * It is a "bombable" error to pass an unopen or invalid handle to this.
X * All other errors are also indicated by a return of -1 with the error
X * code in PLerr. NOTE: Trailing whitespace (a la isspace()) is
X * eliminated from the buffer before returning. The line, INCLUDING
X * TRAILING WHITESPACE, must have a length of less than BIGLINE - 1.
X * The returned buffer is guaranteed to meet strlen(buf) < BIGLINE.
X */
Xextern short TFSRead ARGS((TFSfile handle, str buf));
X
X/* Write a line. Only entire lines are written. BUF must be NUL terminated.
X * The return is TRUE for a successful write or FALSE with PLerr set if
X * an error occured. The BUF must have strlen < BIGLINE - 1.
X * Trailing whitespace (a la isspace()) in the buffer will be discarded
X * on output without change to the buffer.
X * It is a "bombable" error to pass an unopen or invalid handle to this.
X */
Xextern bool TFSWrite ARGS((TFSfile handle, str buf));
X
X/* Remember where the file is positioned. This returns a long value that
X * can be passed to TFSPoint() to reposition the file in such a way that
X * the same line will be read after TFSNote() and TFSPoint(). Note that
X * this value is valid for this TFSOpen() only; i.e., this can NOT be
X * saved when the file is closed, and it can NOT be applied to a
X * different file.
X * It is a "bombable" error to pass an unopen or invalid handle to this.
X * The format of the TFSnote returned is a long, but the only values
X * usable by the application are zero and non-zero; a return of zero
X * indicates an error occured, and a return of non-zero indicates
X * success.
X */
Xextern long TFSNote ARGS((TFSfile handle));
X
X/* Reposition a file -- see TFSNote(). Returns TRUE for success, FALSE
X * for error.
X * It is a "bombable" error to pass an unopen or invalid handle to this.
X */
Xextern bool TFSPoint ARGS((TFSfile handle, TFSnote pos));
X
X
X#endif /* TFS_h */
X
END_OF_FILE
if test 6101 -ne `wc -c <'TFS/TFS.h'`; then
echo shar: \"'TFS/TFS.h'\" unpacked with wrong size!
fi
# end of 'TFS/TFS.h'
fi
echo shar: End of archive 4 \(of 9\).
cp /dev/null ark4isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 9 archives.
rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0
--
--- Darren New --- Grad Student --- CIS --- Univ. of Delaware ---
exit 0 # Just in case...
--
Please send comp.sources.unix-related mail to rsalz at uunet.uu.net.
Use a domain-based address or give alternate paths, or you may lose out.
More information about the Comp.sources.unix
mailing list