prohaska@coors.DEC (06/23/85)
Here is the C source for a compiler (preprocessor) that allows one to write
command procedures in VMS DCL using control structures like if-else,
while, for and do-while loops. Compound statements can be constructed
by enclosing statements within {}. The input is completely free-format.
Most of the syntax is patterned after C. I hope this program will provide relief
to all those DCL command procedures writers in VMS land who have to face
the miseries caused by GOTO's and COMEFROM's.
The compiler is written in standard C. I have successfully compiled it using
both the UNIX and VMS C compilers.
The source files and other related files were bundled such that they can
be unbundled using UNIX shell. VMS users will have to simply cut out the
files. Maybe the first structured DCL command procedure you may wish to
write is the one that can unbundle such bundles.
Sohail Aslam
...decvax!decwrl!dec-rhea!dec-pulsar!sprohaska
------------------------- CUT HERE ---------------------------------------
echo aaareadme.txt 1>&2
cat > aaareadme.txt <<'End of aaareadme.txt'
This directory contains the SDCL (Structured DCL) compiler files. These
include the source files and the documentation files. Here is what you
should have if the tape restore worked ok:
AAAREADME.TXT The file you are reading
BUN.VMS Example of structured DCL code
DEFS.H, LEX.C, OUTPUT.C, SDCL.C, STACK.C, STMT.C,
TCODES.H Files with C source of SDCL compiler
LASER.DCL,LASER.COM another example of SDCL input and generated ouput.
MAKEFILE.COM Command procedure that makes SDCL.EXE
SDCL.EXE The executable file created under VMS 4.1
SDCL.DOC A detailed documentation on the inner workings
of SDCL compiler. Formatted with UNIX nroff.
Can be printed on any printer.
SDCL.NR UNIX nroff source of SDCL.DOC
SDCL.MEM A brief guide to SDCL and and how to invoke the
compiler
SDCL.RNO DSR source for SDCL.MEM
To get SDCL up and running, you need the DEC C compiler. If you have it,
run the command procedure in MAKEFILE.COM and then install SDCL as a
foreign command:
$ @makefile
$! now in your login.com, add the line
$ sdcl :== $[directory-path]:sdcl
$! replace "directory-path" with the complete directory
$! path name to where the sdcl.exe resides.
If you donot have the C compiler, you can simply use the executable
SDCL.EXE included. It was created under VMS 4.1.
I have compiled the sources with the UNIX C compiler on the SUN workstation
and HP-UX. The program runs without any change. This implies that you donot
have the DEC C compiler, try using the DECUS C compiler. This may, hopefully
work.
I will welcome any comments, bug reports, fixes and any other suggestions.
If you make any enhancements, please let me.
Sohail Aslam
Computer Science Department
University of Colorado at Colorado Springs
P.O.Box 7150
Colorado Springs, CO 80933-7150
(303) 593-3332
End of aaareadme.txt
echo bun.vms 1>&2
cat > bun.vms <<'End of bun.vms'
/* Bun -- VMS DCL command procedure to bundle files into */
/* distribution package which can then be unbundled */
/* using UNIX shell. The output will be placed on the */
/* on the file given as the arg to this procedure */
if( p1 .eqs. "" ){
write sys$output\
"Usage: bundle outfile (outfile will receive bundle)"
exit /* DCL exit */
}
/* if the file exists, open it, otherwise create it */
open/write/err=out_err fout 'p1'
exist := "TRUE"
out_err:
if( exist .nes. "TRUE" ){
create 'p1'
open/write/err=give_up fout 'p1'
}
q := "'"
for( rc = 0; ; ){ /* no condition, no reinit */
inquire infile "File? "
if( infile .eqs. "" )
break /* time to wrapup */
open/read/err=infile_err inf 'infile'
write fout "echo ''infile' 1>&2"
write fout "cat >''infile' <<''q'END OF ''infile'''q'"
rc = rc + 2
done = 0
while( done .eq. 0 ){
read/end=eof inf line
write fout line
rc = rc + 1
}
eof: close inf
write fout "END OF ''infile'"
rc = rc + 1
next
/*
come here if trouble opening 'infile'
*/
infile_err: write sys$output \
"error opening ''infile'"
}
if( rc .gt. 0 ){
write sys$output "''rc' records written to ''p1'"
close fout
}
else
write sys$output "0 records written out"
exit
End of bun.vms
echo defs.h 1>&2
cat > defs.h <<'End of defs.h'
/*
* This file contains the character class and token code
* definitions that are used globally throuhout all files
* used in the sdcl program. Hence all C source files
* include this file.
*
*/
#define MAXTOKENLEN 133
#define MAXCONDLEN 255
#define TRUE 1
#define FALSE 0
/* First, defines to avoid using numbers for charclasses. */
#define LETTER 0 /* [A-Za-z_$] (notice _ and $ are
considered to be characters) */
#define DIGIT 1 /* [0-9] */
#define ONECHAR 2 /* (){}[]'.;:#%? */
#define SLASH 3 /* / */
#define STAR 4 /* * */
#define WHITESPACE 5 /* blank,tab,non-printing chars */
#define EOL 6 /* /n */
#define DQUOTE 7 /* " */
#define ENDFILE 8
#define ERR 9
/* Use defines to set up token codes. */
#define IF 0 /* keywords first, if */
#define ELSE 1
#define WHILE 2
#define FOR 3
#define BREAK 4
#define DO 50 /* this was added later */
#define NEXT 5
#define ID 6
/*
* If an identifier is not a keyword it might be one
* of the following special single characters...
*
*/
#define OPAREN 7
#define CPAREN 8
#define OBRACE 9
#define CBRACE 10
#define SEMICOLON 19
#define BANG 20
#define POUND 21
#define PERCENT 22
#define AND 23
#define QUOTE 24
#define PLUS 25
#define COMMA 26
#define MINUS 27
#define DOT 28
#define COLON 29
#define LT 30
#define EQUAL 31
#define GT 32
#define QUESTION 33
#define AT 34
#define OBRACKET 35
#define BACKSLASH 36
#define CBRACKET 37
#define CIRCUMFLEX 38
#define GRAVE 39
#define VERTICAL 40
#define TILDE 41
/* otherwise it is a single character. */
#define SCHAR 11
/* Blanks,tab,non-printing characters */
#define COMMENT 12
#define WSPACE 13
#define NEWLINE 14
#define FILEEND 15
#define STRING 16 /* "...." */
#define ERROR 17
#define INTEGER 18
End of defs.h
echo laser.com 1>&2
cat > laser.com <<'End of laser.com'
$ if (.not.(p1 .eqs. "?" )) then goto 23000
$ type sys$input
Usage:
laser file -nc -np -f s=n n=pcnt
where
file is the file created after TeXing or from a previous
laser command. Specify filename but no extension if
it is .DVI files, specify the extension if you want
to simply print a file.
-nc Donot run the file thru DVI to LN03 conversion step
-np Donot submit the file to the laser printer queue
-f cause print/feed command instead of print/nofeed which
is the default
s=n start processing .DVI file at this page
n=pcnt number of pages to process starting with the page
number specified with the "s=n" option
$ exit
$ 23000:
$ feed := "/NOFEED"
$ send := "YES"
$ conv := "YES"
$ ln03que := "ttf5:"
$ sp := ""
$ pcnt := ""
$ bugp = 2
$ count = 2
$ 23002: if (.not.(p'count' .nes. "")) then goto 23004
$ if (.not.(p'count' .eqs. "-D" )) then goto 23005
$ bugp = 1
$ goto 23003
$ 23005:
$ if (.not.(bugp )) then goto 23007
$ val = f$string( p'count')
$ write sys$output "DEBUG: parameter ''count': ''val'"
$ 23007:
$ if (.not.(p'count' .eqs. "-NP" )) then goto 23009
$ send := "NO"
$ goto 23010
$ 23009:
$ if (.not.(p'count' .eqs. "-NC" )) then goto 23011
$ conv := "NO"
$ goto 23012
$ 23011:
$ if (.not.(p'count' .eqs. "-F" )) then goto 23013
$ feed := ""
$ goto 23014
$ 23013:
$ val = f$string( p'count')
$ fc = f$extract( 0,1,val)
$ if (.not.(fc .eqs. "S" )) then goto 23015
$ sp := "/"'val'
$ if (.not.(bugp )) then goto 23017
$ write sys$output "DEBUG: startpage ''sp'"
$ 23017:
$ goto 23016
$ 23015:
$ if (.not.(fc .eqs. "N" )) then goto 23019
$ pcnt := "/"'val'
$ if (.not.(bugp )) then goto 23021
$ write sys$output "DEBUG: pagecount ''pcnt'"
$ 23021:
$ goto 23020
$ 23019:
$ write sys$output "Strange option ''val' ignored"
$ 23020:
$ 23016:
$ 23014:
$ 23012:
$ 23010:
$ 23003: count = count + 1
$ goto 23002
$ 23004:
$ if (.not.(p1 .nes. "" )) then goto 23023
$ if (.not.(conv .eqs. "YES" )) then goto 23025
$ dvi2lng 'p1' 'sp' 'pcnt'
$ ln03topp 'p1'
$ dele *.typ;*,*.lng;*,*.lnh;*
$ ln3 := 'p1'".ln3"
$ 23025:
$ if (.not.(send .eqs. "YES" )) then goto 23027
$ if (.not.(conv .eqs. "NO" )) then goto 23029
$ ln3 := 'p1'
$ 23029:
$ write sys$output "submitting ''ln3'"
$ if (.not.(feed .eqs. "/NOFEED" )) then goto 23031
$ print/nofeed/que='ln03que' 'ln3'
$ goto 23032
$ 23031:
$ print/que='ln03que' 'ln3'
$ 23032:
$ 23027:
$ goto 23024
$ 23023:
$ write sys$output "Usage: laser file -nc -np -f s=n n=pcnt"
$ write sys$output "Type ""laser ?"" for details"
$ 23024:
$ exit
End of laser.com
echo laser.dcl 1>&2
cat > laser.dcl <<'End of laser.dcl'
/* print TeX DVI file on the laser printer. The que is defined by the
symbol LN03QUE.
Usage:
laser file -nc -np -f s=n n=pcnt
where
file is the file created after TeXing or from a previous
laser command. Specify filename but no extension if
it is .DVI files, specify the extension if you want
to simply print a file.
-nc Donot run the file thru DVI to LN03 conversion step
-np Donot submit the file to the laser printer queue
-f cause print/feed command instead of print/nofeed which
is the default
s=n start processing .DVI file at this page
n=pcnt number of pages to process starting with the page
number specified with the "s=n" option
*/
if( p1 .eqs. "?" ){
type sys$input
# Usage:
# laser file -nc -np -f s=n n=pcnt
#
# where
# file is the file created after TeXing or from a previous
# laser command. Specify filename but no extension if
# it is .DVI files, specify the extension if you want
# to simply print a file.
#
# -nc Donot run the file thru DVI to LN03 conversion step
# -np Donot submit the file to the laser printer queue
# -f cause print/feed command instead of print/nofeed which
# is the default
# s=n start processing .DVI file at this page
# n=pcnt number of pages to process starting with the page
# number specified with the "s=n" option
exit
}
feed := "/NOFEED"
send := "YES"
conv := "YES"
ln03que := "ttf5:" /* change this for your system */
sp := ""
pcnt := ""
bugp = 2 /* even integer is false */
for( count = 2; p'count' .nes. ""; count = count + 1 ){
if( p'count' .eqs. "-D" ){
bugp = 1 /* odd integer is true */
next /* go to next parameter */
}
if( bugp ){
val = f$string( p'count')
write sys$output "DEBUG: parameter ''count': ''val'"
}
if( p'count' .eqs. "-NP" )
send := "NO" /* don't send to printer */
else if( p'count' .eqs. "-NC" )
conv := "NO" /* no dvi to ln3 */
else if( p'count' .eqs. "-F" )
feed := "" /* do a feed */
else {
val = f$string( p'count')
fc = f$extract( 0,1,val)
if( fc .eqs. "S" ){
sp := "/"'val'
if( bugp )
write sys$output "DEBUG: startpage ''sp'"
}
else if( fc .eqs. "N" ){
pcnt := "/"'val'
if( bugp )
write sys$output "DEBUG: pagecount ''pcnt'"
}
else
write sys$output "Strange option ''val' ignored"
}
}
if( p1 .nes. "" ){
if( conv .eqs. "YES" ){
dvi2lng 'p1' 'sp' 'pcnt'
ln03topp 'p1'
dele *.typ;*,*.lng;*,*.lnh;*
ln3 := 'p1'".ln3"
}
if( send .eqs. "YES" ){
if( conv .eqs. "NO" )
ln3 := 'p1'
write sys$output "submitting ''ln3'"
if( feed .eqs. "/NOFEED" )
print/nofeed/que='ln03que' 'ln3'
else
print/que='ln03que' 'ln3'
}
}
else {
write sys$output "Usage: laser file -nc -np -f s=n n=pcnt"
write sys$output "Type ""laser ?"" for details"
}
exit
End of laser.dcl
echo lex.c 1>&2
cat > lex.c <<'End of lex.c'
/*
* Function lex returns the token string and tokencode from standard input.
* The lex routine is table driven. The two tables "nextstate" and "output"
* were developed by hand. These tables are external to this file. They
* reside in "tcodes.h" are included in this file.
*
*/
#include <stdio.h>
#include "tcodes.h"
#include "defs.h"
/* Variables that need to retain their values across calls to lex. */
static int state = 0;
static int nextchar;
/*
*
* External FILE variable infile is initialized by the sdcl.c
* module. It points either to stdin or to a user-specified
* input file.
*/
extern FILE *infile;
int lex(token)
char *token;
{
/*
* The findclass array is used for quick lookups of
* character class of a character. The ordinal
* value of a character is used as an index into
* this array. The value found at the location
* indexed by this ordinal value will be the character
* class for this input index character. Since it
* will be used continously throughout program
* execution and it is only used by function lex()
* the array is static. The comments used in the
* initialization section for the array correspond
* to the decimal ascii values the rows represent.
*
*/
static int findclass[] =
{
/* 0 */ WHITESPACE,
/* 1 - 10 */ WHITESPACE, WHITESPACE, WHITESPACE, WHITESPACE, WHITESPACE,
WHITESPACE, WHITESPACE, WHITESPACE, WHITESPACE, EOL,
/* 11 - 20 */ WHITESPACE, WHITESPACE, WHITESPACE, WHITESPACE, WHITESPACE,
WHITESPACE, WHITESPACE, WHITESPACE, WHITESPACE, WHITESPACE,
/* 21 - 30 */ WHITESPACE, WHITESPACE, WHITESPACE, WHITESPACE, WHITESPACE,
WHITESPACE, WHITESPACE, WHITESPACE, WHITESPACE, WHITESPACE,
/* 31 - 40 */ WHITESPACE, WHITESPACE, ONECHAR, DQUOTE, ONECHAR,
LETTER, ONECHAR, ONECHAR, ONECHAR, ONECHAR,
/* 41 - 50 */ ONECHAR, STAR, ONECHAR, ONECHAR, ONECHAR,
ONECHAR, SLASH, DIGIT, DIGIT, DIGIT,
/* 51 - 60 */ DIGIT, DIGIT, DIGIT, DIGIT, DIGIT,
DIGIT, DIGIT, ONECHAR, ONECHAR, ONECHAR,
/* 61 - 70 */ ONECHAR, ONECHAR, ONECHAR, ONECHAR, LETTER,
LETTER, LETTER, LETTER, LETTER, LETTER,
/* 71 - 80 */ LETTER, LETTER, LETTER, LETTER, LETTER,
LETTER, LETTER, LETTER, LETTER, LETTER,
/* 81 - 90 */ LETTER, LETTER, LETTER, LETTER, LETTER,
LETTER, LETTER, LETTER, LETTER, LETTER,
/* 91 - 100 */ ONECHAR, ONECHAR, ONECHAR, ONECHAR, LETTER,
ONECHAR, LETTER, LETTER, LETTER, LETTER,
/* 101 - 110 */ LETTER, LETTER, LETTER, LETTER, LETTER,
LETTER, LETTER, LETTER, LETTER, LETTER,
/* 111 - 120 */ LETTER, LETTER, LETTER, LETTER, LETTER,
LETTER, LETTER, LETTER, LETTER, LETTER,
/* 121 - 127 */ LETTER, LETTER, ONECHAR, ONECHAR, ONECHAR,
ONECHAR
};
int i = 0, out = 0, class;
/*
* While the output state is non-zero, indicating a complete
* token has not been found...
*/
while (!out){
if (state)
/* and if the maximum token length has not been
* exceeded...
*/
if (i < MAXTOKENLEN)
token[i++] = nextchar;
nextchar = getc(infile);
/*
* Find out the character class of this next input
* character. Use this value to determine what
* the output and nextstate states should be for
* the DFA scanner.
*/
/* If the next character is EOF... */
class = (nextchar != EOF)? findclass[nextchar] : ENDFILE;
out = output[state][class];
state = nextstate[state][class];
}
token[i] = '\0';
/*
* Output contains the tokencode. If it is ID, check for keywords
* by searching table of keywords.
*/
if (out == ID)
out = iskeyword(token);
else if (out == SCHAR)
out = isspecialonechar(token[0]);
/* here's the token code */
return(out);
}
int iskeyword(token)
char *token;
/*
* This function compares the input parameter string with a struct array
* of keywords to determine if the input token is a keyword. The
* way the array is arranged function iskeyword returns either
* the token code of the keyword if it is one, or the generic
* token code ID if the inputted token is not a keyword.
*/
{
int i = 0;
static struct kwdtype
{
char *kw;
int tokevalue;
}
kwdtable [] =
{
"if", IF,
"else", ELSE,
"while", WHILE,
"for", FOR,
"break", BREAK,
"next", NEXT,
"do", DO,
"", ID
};
while (strcmp(kwdtable[i].kw, "") != 0){
if (strcmp(kwdtable[i].kw, token) == 0)
return(kwdtable[i].tokevalue);
i++;
}
return(kwdtable[i].tokevalue);
}
int isspecialonechar(token)
char token;
/*
* The inputted token is compared with each of the characters
* found in actual_char which is an array of structures. If
* a match is found then the corresponding value to return for
* this function is contained in the tvalue of that field of
* actual_char. If no match is found SCHAR is returned.
*/
{
static struct {
char specchar;
int tvalue;
} actual_char[] = {
'"', DQUOTE,
'#', POUND,
'(', OPAREN,
')', CPAREN,
';', SEMICOLON,
'\\', BACKSLASH,
'{', OBRACE,
'}', CBRACE,
'0', SCHAR
};
int i;
for (i = 0; actual_char[i].specchar != '0'; i++)
if (actual_char[i].specchar == token)
return(actual_char[i].tvalue);
return(actual_char[i].tvalue);
}
End of lex.c
echo makefile.com 1>&2
cat > makefile.com <<'End of makefile.com'
$! command procedure to create sdcl.
$ cc/nolist lex.c,-
output.c,-
sdcl.c,-
stack.c,-
stmt.c
$ link/exe=sdcl/notrace/nomap sdcl,-
output,-
stack,-
stmt,-
lex,-
sys$library:crtlib/lib
End of makefile.com
echo output.c 1>&2
cat > output.c <<'End of output.c'
/*
* All functions within this file are for formatting and performing
* the output of the DCL output code. Included here are the
* functions outdone(), outch(), emitstring(), emitlabel(),
* emitqstring(), emittarget(), itoa(), reverse(), and genlab().
*
* Also within this file is a function for outputting a
* string (usually indicating an error) passed to it. The
* name of the function is errmsg().
*
*/
#include <stdio.h>
#include "defs.h"
/*
* MAXCOL is the maximum number of columns in the
* output line. MAXBUF is one greater to allow for
* appending a NULL character to make a string.
*/
#define MAXCOL 80
#define MAXBUF MAXCOL + 1
/*
* outbuf[] and outp are the output buffer and index
* into same. These two variables are used in building and
* outputting the final output from the sdcl program.
*
* External variable outfile is initialized within sdcl.c.
* It points to either stdout or to a user-specified output
* file.
*/
static char outbuf[MAXBUF];
static outp = (-1);
extern FILE *outfile;
int outdone()
/*
* This function flushes the contents of outbuf to stdout and
* resets outp to -1. This is the only function within this
* file that makes a direct call to the fprintf() function and
* hence is the only function that produces any output. It is
* used by most of the other functions within this file.
*/
{
/* Append a newline and NULL characters, output, and set outp. */
outbuf[++outp] = '\n';
outbuf[++outp] = '\0';
fputs(outbuf, outfile );
outp = (-1);
}
int outch(c)
char c;
/*
* This function places its character input parameter into outbuf.
* Insertion of DCL continuation characters are also handled here.
* When a newline character is received by this function outbuf is
* flushed by a call to outdone().
*/
{
/* If c is a newline it is a signal to flush outbuf[]. */
if (c == '\n')
outdone();
/*
* Otherwise if there are now two less than the maximum
* characters currently in outbuf[] add a dcl continuation
* character and flush the buffer. Begin a new outbuf,
* without a prepended dollar sign. The first character
* of this new outbuf[] will be the inputted character c.
*/
else if (outp == MAXCOL - 2) {
outbuf[++outp] = '-';
outdone();
outbuf[++outp] = c;
}
/* Otherwise simply append c to outbuf[]. */
else
outbuf[++outp] = c;
}
int emitstring(string)
char *string;
/*
* The characters in string are placed in the output buffer
* one character at a time. Function outch() does the
* necessary bookeeping to prevent too many characters
* being placed in outbuf[].
*/
{
char c;
while (c = *string++)
outch(c);
}
int emitlabel(label)
int label;
/*
* This function converts integer intput label into a string of
* characters. To this string it appends a colon, and a blank
* character. This character label is then added to outbuf.
*/
{
/*
* Allow five characters for the number, one each for
* the colon, blank, and NULL characters for a total
* of eight characters in str.
*/
char str[8];
/* Convert label from integer to character, placing result into str.*/
itoa(label, str);
/* Add colon, blank, and NULL characters to str. */
str[5] = ':';
str[6] = ' ';
str[7] = '\0';
/* Send the character version label to outbuf[]. */
emitstring(str);
}
int emittarget(label)
int label;
/*
* This function converts integer intput label into a string of
* characters. To this string it appends a blank
* character. This character label is then added to outbuf.
* This function is almost exactly like emitlabel except that
* no colon is appended to the character string. This is
* used whenever a target must be specified after a goto is
* generated from within statements.c.
*/
{
/*
* Allow five characters for the number and one for
* the NULL character for a total of six characters in str.
*/
char str[6];
itoa(label, str);
str[5] = '\0';
emitstring(str);
}
int emitqstring(str)
char *str;
/*
* This procedure is called whenever a quoted string is to
* be output. It insures that the string is not broken by
* a newline character. It compares the length of the
* string to be output to the amount of room currently remaining
* in outbuf. If there isn't enough room in outbuf to contain
* the output string a dash is appended to outbuf to indicate
* line continuation. Then a newline is appended and the string
* is sent to outbuf.
*/
{
int c;
/*
* Check to see if outbuf has enough room left to hold
* the string that is to be output. If not append a
* dash and a newline character to outbuf and flush it
* by calling emitstring.
*/
if (strlen(str) > (MAXCOL - outp))
emitstring("- \n");
/* Output the rest of the input string. */
while (c = *str++)
outch(c);
}
int itoa(n, str)
int n;
char str[];
/*
* Converts the integer n into its string representation.
*/
{
int i = 0, sign;
/* Save the sign of n and make n positive if its negative. */
if ((sign = n) < 0)
n = -n;
/* Generate the digits in reverse order. */
do
{
str[i++] = n % 10 + '0';
} while ((n /= 10) > 0);
/* If n was negative add a minus sign , then append a NULL. */
if (sign < 0)
str[i++] = '-';
str[i] = '\0';
/* Reverse the string. */
reverse(str);
}
int reverse(str)
char str[];
/*
* Reverses the digits in an inputted string. The reversal
* is done in place.
*/
{
int c, i, j;
for (i = 0, j = strlen(str) - 1; i < j; i++, j--) {
c = str[i];
str[i] = str[j];
str[j] = c;
}
}
int genlab()
/*
* This function increments a static integer. This will
* generate a new value that can be used as a label
* during code generation.
*/
{
static int label = 23000;
return(label++);
}
int errmsg(string)
char *string;
{
fputs(string, stderr);
}
End of output.c
echo sdcl.c 1>&2
cat > sdcl.c <<'End of sdcl.c'
/*
* This file contains the main driver for sdcl preprocessor.
*
* This program accepts as input a file written in sdcl. This
* language is an enhanced version of DCL. It includes however
* the for, while, do while, if, if-else, next, and break. The syntax
* for these statements is almost exactly as in C. The ouput
* of this program is a file that is standard DCL. This language
* can be summarized in BNF as follows:
*
* program | statement
* | program statement
*
* statement | if ( condition ) statement
* | if ( condition ) statement else statement
* | while ( condition ) statement
* | for ( initialize; condition; reinitialize )
* statement
* | do statment while (condition)
* | break
* | next
* | { program }
* | other
*
*
* All the main driver function does is perform an initial call to
* the lexical scanner (to "prime the pump") and then repeatedly call
* function statement(). This function calls one of a series of semantic
* functions depending on what the first token on an input line is.
* The execution ends when the EOF token is encountered.
*
* The seven files that make up the sdcl processor are
*
* sdcl.c - main driver and non-terminal routines.
* statements.c - handles statements such as if, while, etc.
* scan_lex.c - does all scanning for input tokens.
* output.c - holds all code generation functions
* stack.c - provides stack and manipulation functions
* defs.h - token code and character class definitions.
* tcodes.h - nextstate and output tables for scanner.
*/
#include <stdio.h>
#include "defs.h"
#ifdef vax11c
#include descrip
#endif
extern int tokencode;
FILE *infile, *outfile;
main(argc, argv)
int argc;
char *argv[];
{
int extern_files = FALSE;
int xeq_flag = FALSE;
extern char *make_out_file();
extern FILE *efopen();
extern int statement();
#ifdef vax11c
char dcl_command[80];
$DESCRIPTOR ( cmd, dcl_command ); /* struct for lib$docomman */
#endif
/*
* If the user has specified input and output files (signified
* by argc equaling 3) open them for reading and writing. Also
* set a boolean indicating these files exist. This boolean will
* be used at program end to close these files.
*
*/
infile = stdin;
outfile = stdout;
if (argc == 4 ){
infile = efopen(argv[1], "r");
outfile = efopen(argv[2], "w");
argv[1] = argv[2];
extern_files = TRUE;
if (strcmp( argv[3], "-x" ) == 0 )
xeq_flag = TRUE;
}
else if (argc == 3 ){
infile = efopen(argv[1], "r");
if (strcmp( argv[2], "-x" ) == 0 ) {
xeq_flag = TRUE;
argv[1] = make_out_file( argv[1] );
outfile = efopen(argv[1], "w");
}
else{
outfile = efopen(argv[2], "w");
argv[1] = argv[2];
}
extern_files = TRUE;
}
else if (argc == 2){ /* infile only */
if (strcmp( argv[1], "-x" ) != 0 ) {
infile = efopen(argv[1], "r");
argv[1] = make_out_file( argv[1] );
outfile = efopen(argv[1], "w");
extern_files = TRUE;
}
else
fprintf(stderr,"Cannot execute from sys$output\n");
}
/*
* Keep going until EOF but first, get the
* first nonblank token via a call to scan().
*/
scan();
while( tokencode != FILEEND )
statement();
/* If the user specified input and output files close them. */
if (extern_files) {
fclose(infile);
fclose(outfile);
}
#ifdef vax11c
if ( xeq_flag ){
strcpy( dcl_command, "@" );
strcat( dcl_command, argv[1] );
exit ( lib$do_command ( &cmd ) );
}
#endif
}
FILE *efopen( name, mode )
char *name, *mode;
{
FILE *fp;
fp = fopen( name, mode );
if (fp == NULL ){
fprintf(stderr, "Trouble opening %s, abort\n", name );
exit( 1 );
}
return( fp );
}
char *make_out_file ( s )
char *s;
/*
make .com filename out of filename in s.
*/
{
int i;
char *new;
for (i = 0; s[i]; i++ )
if ( s[i] == '.' ){
s[i] = '\0';
break;
}
new = malloc( strlen(s) + 6 );
strcpy( new, s );
strcat( new, ".com" );
return ( new );
}
End of sdcl.c
echo sdcl.mem 1>&2
cat > sdcl.mem <<'End of sdcl.mem'
SDCL -- A Preprocessor for Structured DCL
Sohail Aslam
University of Colorado at Colorado Springs
Colorado Springs, CO 80933
The command language under the VAX/VMS operating system is called
Digital Command Language, or DCL. DCL provides a whole host of
capabilities that allow the user not only execute simple commands but
develop command procedures that can accomplish a complex task. DCL
provides variables, conditional operators, an IF-THEN-command
construct and a number of built-in functions. It is thus a small
programming language. Unfortunately, the only control structure
provided is the
IF condition THEN a command
By building a simple preprocessor, I have extended the control
structure to include C like control structures, e.g, if-else, while,
for, do-while etc. These structures can operate on a single command
or a group of commands.
I taught a class here at UCCS in the spring semester of 1985
titled "The UNIX Programming Environment"; I chose developing the
preprocessor for structured DCL as the semester project. For the
benefit of other teachers who may wish to assign such a project to
their class, I have included the UNIX nroff/troff source and formatted
version of the project handout. The handout provides a very detailed,
step by step description of the design and implementation of sdcl.
Thus it serves as a document for anyone who wants to understand the
workings of the preprocessor. The file "sdcl.nr" contains the
nroff/troff source and "sdcl.doc" is the formatted version of
"sdcl.nr" designed to be printed on ordinary line printers.
The real motivation for wanting to have structured DCL came from
the tradition set by RATFOR (RATional FORtran). For those of you not
familiar with RATFOR, RATFOR allows one to write code in FORTRAN in a
C like manner. DCL has similar deficiencies when it comes to writing
command procedures. I just wanted to illustrate that one does not
have to live with GOTO's and COMEFROM's in one's programming
practices. It is rather trivial to develop a layer of structured
environment on top of something that does not support it.
Page 2
The language recognized, and thus parsed, by sdcl is very simple.
Here it is BNF form:
program : statement
| program statement
if ( )
statement : if ( condition ) statement
if ( ) else
| if ( condition ) statement else statement
while ( )
| while ( condition ) statement
for ( ; ; )
| for ( intialize ; condition ; reinitialze )
statement
do while ( )
| do statement while ( condition )
break
| break
next
| next
{ }
| { program }
other
| other
Here is a summary of sdcl usage. Please refer to the file "sdcl.doc."
for a detailed description.
o The input file to sdcl is an ordinary text file containing
sdcl statements. Unlike DCL, statements must not begin with
a "$" sign.
o Statements can be enclosed within {} to form the so-called
compound statement.
o The preprocessor looks at the first token of each statement
to determine the type of statement so you should not preceed
keywords with DCL labels e.g. "usage: if( p1 .eqs. ..".
Statements that donot match one of the structured statements
are classified as "other" and simply emitted.
o Any sdcl source statement can be continued across more that
one line by placing a "\" (backslash) just before the end of
line.
o In structured constructs, the "\" need not be used however,
because sdcl can infer whether the constructs is complete or
not by simply going across line boundaries until satisfied.
So if the condition part is too long to fit on one line in an
"if" statement, it can simply be continued on the next line.
o Donot use the "-" (minus) as the continuation character in
sdcl statements.
o If a source line begins with a "#" sign, the pound sign is
removed and rest of the line is emitted AS IS. This can be
used to pass lines through sdcl untouched to DCL.
Page 3
The sdcl can be invoked as follows:
$ sdcl [infile.ext] [outfile.ext] [-x]
where
"infile.ext" is the input source file. If not specified, input
is taken from "sys$input".
"outfile.ext" is the output file that will receive the generated
DCL code. If outfile is not specified, then the ge-
code will be placed in "infile.COM". If no infile
was specified, output goes to "sys$output".
-x If -x is specifed, then the code in outfile is pas-
to DCL for execution via lib$do_command.
Make sure that the symbol "sdcl" is defined as a foreign command
either in your login.com or in the system wide login.com. For
example, if the image "sdcl.exe" resides in "sys$sysexe" then here is
how you may define "sdcl" as a foreign command in your login.com:
$ sdcl :== $sys$sysexe:sdcl
Note that parameters cannot be passed to the command procedure in
outfile when it is executed through the "-x" option.
Page 4
Here is a command procedure to give you a flavor of sdcl,
/* Bun -- VMS DCL command procedure to bundle files into */
/* distribution package which can then be unbundled */
/* using UNIX shell. The output will be placed on the */
/* on the file given as the arg to this procedure */
if( p1 .eqs. "" ){
write sys$output\
"Usage: bundle outfile (outfile will receive bundle)"
exit /* DCL exit */
}
/* if the file exists, open it, otherwise create it */
open/write/err=out_err fout 'p1'
exist := "TRUE"
out_err:
if( exist .nes. "TRUE" ){
create 'p1'
open/write/err=give_up fout 'p1'
}
q := "'"
for( rc = 0; ; ){ /* no condition, no reinit */
inquire infile "File? "
if( infile .eqs. "" )
break /* time to wrapup */
open/read/err=infile_err inf 'infile'
write fout "echo ''infile' 1>&2"
write fout "cat >''infile' <<''q'END OF ''infile'''q'"
rc = rc + 2
done = 0
while( done .eq. 0 ){
read/end=eof inf line
write fout line
rc = rc + 1
}
eof: close inf
write fout "END OF ''infile'"
rc = rc + 1
next
/*
come here if trouble opening 'infile'
*/
infile_err: write sys$output \
"error opening ''infile'"
}
if( rc .gt. 0 ){
write sys$output "''rc' records written to ''p1'"
close fout
}
else
write sys$output "0 records written out"
exit
Page 5
And here is the generated code.
$ if (.not.(p1 .eqs. "" )) then goto 23000
$ write sys$output "Usage: bundle outfile (outfile will receive bundle)"
$ exit
$ 23000:
$ open/write/err=out_err fout 'p1'
$ exist := "TRUE"
$ out_err:
$ if (.not.(exist .nes. "TRUE" )) then goto 23002
$ create 'p1'
$ open/write/err=give_up fout 'p1'
$ 23002:
$ q := "'"
$ rc = 0
$ 23004:
$ inquire infile "File? "
$ if (.not.(infile .eqs. "" )) then goto 23007
$ goto 23006
$ 23007:
$ open/read/err=infile_err inf 'infile'
$ write fout "echo ''infile' 1>&2"
$ write fout "cat >''infile' <<''q'END OF ''infile'''q'"
$ rc = rc + 2
$ done = 0
$ 23009: if (.not.(done .eq. 0 )) then goto 23010
$ read/end=eof inf line
$ write fout line
$ rc = rc + 1
$ goto 23009
$ 23010:
$ eof: close inf
$ write fout "END OF ''infile'"
$ rc = rc + 1
$ goto 23005
$ infile_err: write sys$output "error opening ''infile'"
$ 23005:
$ goto 23004
$ 23006:
$ if (.not.(rc .gt. 0 )) then goto 23011
$ write sys$output "''rc' records written to ''p1'"
$ close fout
$ goto 23012
$ 23011:
$ write sys$output "0 records written out"
$ 23012:
$ exit
End of sdcl.mem
echo sdcl.rno 1>&2
cat > sdcl.rno <<'End of sdcl.rno'
.flags bold
.ps 60,72
.lm 0
.sp 1
.b 2
.c 72
SDCL -- A Preprocessor for Structured DCL
.b 4
.c 72
Sohail Aslam
.b 2
.c 72
University of Colorado at Colorado Springs
.c 72
Colorado Springs, CO 80933
.b 2
.p 5,1,4
The command language under the VAX/VMS operating system is called
Digital Command Language, or DCL.
DCL provides a whole host of capabilities that allow the user not only
execute simple commands but develop command procedures that can accomplish
a complex task. DCL provides variables, conditional operators,
an IF-THEN-command construct and a number of built-in functions. It is
thus a small programming language. Unfortunately, the only control structure
provided is the
.b 1
#####IF_ condition_ THEN_ a_ command
.b 1
By building a simple preprocessor, I have extended the control structure to
include C like control structures, e.g, if-else, while, for, do-while etc.
These structures can operate on a single command or a group of commands.
.p 5,1,4
I taught a class here at UCCS in the spring semester of 1985 titled "The
UNIX Programming Environment"; I chose developing the preprocessor for
structured DCL as the semester project. For the benefit of other teachers
who may wish to assign such a project to their class, I have included the
UNIX nroff/troff source and formatted version of the project handout. The
handout provides a very detailed, step by step description of the design and
implementation of sdcl. Thus it serves as a document for anyone who wants
to understand the workings of the preprocessor. The file "sdcl.nr" contains
the nroff/troff source and "sdcl.doc" is the formatted version of "sdcl.nr"
designed to be printed on ordinary line printers.
.p 5,1,4
The real motivation for wanting to have structured DCL came from the tradition
set by RATFOR (RATional FORtran). For those of you not familiar with RATFOR,
RATFOR allows one to write code in FORTRAN in a C like manner. DCL has similar
deficiencies when it comes to writing command procedures. I just wanted to
illustrate that one does not have to live with GOTO's and COMEFROM's in one's
programming practices. It is rather trivial to develop a layer of structured
environment on top of something that does not support it.
.pg
.p 5,1,4
The language recognized, and thus parsed, by sdcl is very simple. Here it is
BNF form:
.lm +5
.nj
.nf
.b 1
program : statement
| program statement
statement : ^*if (\* condition ^*)\* statement
| ^*if (\* condition ^*)\* statement ^*else\* statement
| ^*while (\* condition ^*)\* statement
| ^*for (\* intialize ^*;\* condition ^*;\* reinitialze ^*)\*
statement
| ^*do\* statement ^*while ( \* condition ^*)\*
| ^*break\*
| ^*next\*
| ^*{\* program ^*}\*
| ^*other\*
.lm -5
.f
.ju
.b 1
Here is a summary of sdcl usage. Please refer to
the file "sdcl.doc." for a detailed description.
.list "o"
.le
The input file to sdcl is an ordinary text file containing sdcl statements.
Unlike DCL, statements must not begin with a "_$" sign.
.le
Statements can be enclosed within _{_} to form the so-called compound
statement.
.le
The preprocessor looks at the first token of each statement to determine
the type of statement so you should not preceed keywords with DCL labels
e.g. "usage: if( p1 .eqs. ..". Statements that donot match one of the
structured statements are classified as "other" and simply emitted.
.le
Any sdcl source statement can be continued across more that one line by
placing a "_\" (backslash) just before the end of line.
.le
In structured constructs, the "_\" need not be used however, because sdcl
can infer whether the constructs is complete or not by simply going
across line boundaries until satisfied. So if the condition part is too
long to fit on one line in an "if" statement, it can simply be continued on
the next line.
.le
Donot use the "-" (minus) as the continuation character in sdcl statements.
.le
If a source line begins with a "_#" sign, the pound sign is removed and
rest of the line is emitted AS IS. This can be used to pass lines through
sdcl untouched to DCL.
.end list
.pg
.b 2
The sdcl can be invoked as follows:
.b 1
.nj
.nf
####$ sdcl [infile.ext] [outfile.ext] [-x]
.b 1
where
.b 1
.lm +5
"infile.ext" is the input source file. If not specified, input
is taken from "sys_$input".
.b 1
"outfile.ext" is the output file that will receive the generated
DCL code. If outfile is not specified, then the ge-
code will be placed in "infile.COM". If no infile
was specified, output goes to "sys_$output".
.b 1
-x If -x is specifed, then the code in outfile is pas-
to DCL for execution via lib_$do__command.
.lm -5
.ju
.f
.b 1
Make sure that the symbol "sdcl" is defined as a foreign command either
in your login.com or in the system wide login.com. For example, if the
image "sdcl.exe" resides in "sys_$sysexe" then here is how you may
define "sdcl" as a foreign command in your login.com:
.b 1
#####$#sdcl#:==#_$sys_$sysexe:sdcl
.b 1
Note that parameters cannot be passed to the command procedure in
outfile when it is executed through the "-x" option.
.pg
Here is a command procedure to give you a flavor of sdcl,
.b 1
.literal
/* Bun -- VMS DCL command procedure to bundle files into */
/* distribution package which can then be unbundled */
/* using UNIX shell. The output will be placed on the */
/* on the file given as the arg to this procedure */
if( p1 .eqs. "" ){
write sys$output\
"Usage: bundle outfile (outfile will receive bundle)"
exit /* DCL exit */
}
/* if the file exists, open it, otherwise create it */
open/write/err=out_err fout 'p1'
exist := "TRUE"
out_err:
if( exist .nes. "TRUE" ){
create 'p1'
open/write/err=give_up fout 'p1'
}
q := "'"
for( rc = 0; ; ){ /* no condition, no reinit */
inquire infile "File? "
if( infile .eqs. "" )
break /* time to wrapup */
open/read/err=infile_err inf 'infile'
write fout "echo ''infile' 1>&2"
write fout "cat >''infile' <<''q'END OF ''infile'''q'"
rc = rc + 2
done = 0
while( done .eq. 0 ){
read/end=eof inf line
write fout line
rc = rc + 1
}
eof: close inf
write fout "END OF ''infile'"
rc = rc + 1
next
/*
come here if trouble opening 'infile'
*/
infile_err: write sys$output \
"error opening ''infile'"
}
if( rc .gt. 0 ){
write sys$output "''rc' records written to ''p1'"
close fout
}
else
write sys$output "0 records written out"
exit
.end literal
.pg
And here is the generated code.
.literal
$ if (.not.(p1 .eqs. "" )) then goto 23000
$ write sys$output "Usage: bundle outfile (outfile will receive bundle)"
$ exit
$ 23000:
$ open/write/err=out_err fout 'p1'
$ exist := "TRUE"
$ out_err:
$ if (.not.(exist .nes. "TRUE" )) then goto 23002
$ create 'p1'
$ open/write/err=give_up fout 'p1'
$ 23002:
$ q := "'"
$ rc = 0
$ 23004:
$ inquire infile "File? "
$ if (.not.(infile .eqs. "" )) then goto 23007
$ goto 23006
$ 23007:
$ open/read/err=infile_err inf 'infile'
$ write fout "echo ''infile' 1>&2"
$ write fout "cat >''infile' <<''q'END OF ''infile'''q'"
$ rc = rc + 2
$ done = 0
$ 23009: if (.not.(done .eq. 0 )) then goto 23010
$ read/end=eof inf line
$ write fout line
$ rc = rc + 1
$ goto 23009
$ 23010:
$ eof: close inf
$ write fout "END OF ''infile'"
$ rc = rc + 1
$ goto 23005
$ infile_err: write sys$output "error opening ''infile'"
$ 23005:
$ goto 23004
$ 23006:
$ if (.not.(rc .gt. 0 )) then goto 23011
$ write sys$output "''rc' records written to ''p1'"
$ close fout
$ goto 23012
$ 23011:
$ write sys$output "0 records written out"
$ 23012:
$ exit
.end literal
End of sdcl.rno
echo stack.c 1>&2
cat > stack.c <<'End of stack.c'
/*
* The functions within this file are used to maintain
* a stack structure. Include here all typedefs, pointers
* and stack maintenance functions. These functions include
* push(), pop(), and peek(). A hidden variable, top, is
* declared within this file and is used to indicate the
* top of this stack.
*
*/
#include <stdio.h>
#include "defs.h"
/*
* The following struct definition will be used to maintain
* the stack of information that will be used by the break
* and next code generating functions. The information
* contained in each node of the stack is the type of loop
* being parsed and the number of the last label that has
* been used in the code generation process.
*
* The variable declared after the typedef will always point
* to the top of the stack. By declaring it as a static
* variable it becomes hidden by all procedures that reside
* outside of this file. Initialize this pointer to NULL (0).
* This value indicates that the stack is empty.
*
*/
typedef struct nodetype NODETYPE;
struct nodetype
{
int looptype; /* While loop = 2, corresponding to WHILE = 2. */
int label; /* Last label used before this loop. */
struct nodetype *next; /* Makes this a self-referential struct. */
};
static NODETYPE *top = NULL;
/* Define a macro that will return the size of a stack node. */
#define NODESIZE sizeof(NODETYPE)
/* Define the push(), pop(), and peek() functions. */
extern int errmsg();
int push(ltype, labl)
int ltype;
int labl;
{
NODETYPE *ptr;
extern char *malloc();
/* First create a new node. Coerce it to point to a nodetype. */
ptr = (NODETYPE *) malloc(NODESIZE);
/*
* Check to see if there was enough stack memory left
* to allocate. If there wasn't, ptr will be NULL.
* Time for an error message.
*
*/
if (ptr == NULL){
errmsg("Fatal error -- loops nested to deep\n" );
exit(1);
}
ptr->looptype = ltype;
ptr->label = labl;
ptr->next = top;
top = ptr;
}
int pop(pltype, plabl)
int *pltype;
int *plabl;
{
NODETYPE *ptr;
extern char *free();
if (top){
*pltype = top->looptype;
*plabl = top->label;
ptr = top;
top = top->next;
free((char *) ptr);
return( 1 );
}
else {
errmsg("Internal Error -- Attempt to pop an empty stack--");
errmsg("continuing\n\n");
return(0);
}
}
peek(pltype, plab)
int *pltype;
int *plab;
/*
* Return the contents of the top of the stack without actually
* popping the stack. This function is the same as pop(), but
* only up to the point where top is changed.
*/
{
if (top) {
*pltype = top->looptype;
*plab = top->label;
return ( 1 );
}
else {
errmsg("Internal Error -- Attempt to pop an empty stack--");
errmsg("continuing\n\n");
return(0);
}
}
End of stack.c
echo stmt.c 1>&2
cat > stmt.c <<'End of stmt.c'
/*
* this file contains all the semantic analysis functions to be
* used in generating sdcl output. All of these functions are
* ultimately called by statement(), depending on what the
* current input token is. All of these functions then process
* a line of input by calling the lexical analysis function and,
* depending on what token is returned, generating correct DCL
* output lines.
*
*/
#include <stdio.h>
#include "tcodes.h"
#include "defs.h"
int tokencode;
char token[MAXTOKENLEN];
/*
* The following serve as forward declarations of internal and
* external to this file.
*
*/
extern int condition(), statement(), lex();
extern int push(), pop(), genlab(), errmsg();
extern int emitlabel(), emitqstring(), emittarget();
scan()
/*
* Repeatedly call lex until a token that is not a COMMENT,
* WSPACE, NEWLINE can be returned.
*/
{
do
{
tokencode = lex(token);
} while (tokencode == COMMENT || tokencode == WSPACE ||
tokencode == NEWLINE );
return(tokencode);
}
statement()
/*
* Based on current token, invoke the appropriate
* routine to process a statement beginning with that token.
*/
{
extern int ifstmt(), whilestmt(), forstmt(), dowhilestmt();
extern int breakstmt(), nextstmt(), compstmt();
extern int other();
switch (tokencode) {
case IF: ifstatement();
break;
case WHILE: whilestmt();
break;
case FOR: forstmt();
break;
case DO: dowhilestmt();
break;
case BREAK: breakstmt();
break;
case NEXT: nextstmt();
break;
case OBRACE: compstmt();
break;
default: other();
break;
}
}
int ifstatement()
/*
* Process an if stmt. In the process generate any code associated
* with the if/else control structure. When this function is called
* the current value of tokencode should be IF.
*
*/
{
int looptype, lab1, lab2;
scan();
if( tokencode == OPAREN )
/* skip over OPAREN so conditon() gets the next token. */
scan();
else
errmsg("Error--missing a '(' in if condition\n");
lab1 = genlab();
lab2 = genlab(); /* reserve this in case there is an else */
emitstring("$ ");
emitstring("if (.not.(");
/* Parse the condition from the input stream. */
condition();
if( tokencode == CPAREN)
scan();
else
errmsg("Error--missing a ')' in if condition\n");
/*
* Build the remainder of the if-()-then-goto line and
* output it. Function emittarget() is almost exactly like
* emitlabel() except that no colon is appended to the
* label.
*/
emitstring(")) then goto ");
emittarget(lab1);
emitstring("\n");
/*
* Process the action part if the if-statement with a
* recursive call to statement().
*/
statement();
/* Check for an else part. */
if (tokencode == ELSE ){
scan();
emitstring("$ goto ");
emittarget(lab2);
emitstring("\n");
emitstring("$ ");
emitlabel(lab1);
emitstring("\n");
statement();
/*
* Finally, build the target for the transfer from
* the if portion of the statement if the statement
* is an if-then-else.
*/
emitstring("$ ");
emitlabel(lab2);
emitstring("\n");
}
else{
/*
* Build the target for a transfer from the
* if condition when there is no else clause.
*/
emitstring("$ ");
emitlabel(lab1);
emitstring("\n");
}
}
int compstmt()
/*
* Called in response to encountering a OBRACE token,
* signalling a compound statement. What can
* legally follow is one or several statements. These
* statements can in turn be compound statements as well as any
* other statement type. All this function need do is call
* function statement recursively until a CBRACE is encountered
* (or the end of file).
*/
{
extern int statement();
scan();
while (tokencode != CBRACE && tokencode != FILEEND)
statement();
/* Get the next token following the CBRACE for statement() to use. */
scan();
}
int other()
/* This function is called when an input line doesn't begin with
* a keyword token or an OBRACE. Assume the line ends when a
* newline or EOF is encountered.
*
* If the current token begins with a POUND it is a special
* sdcl preprocessor directive to strip off the POUND and
* pass whatever follows it to the output.
*
* If there is no beginning POUND the output line has a
* DOLLAR prepended to it then the first, and all subsequent tokens are
* passed to the output stream.
*
* Certain tokens cause special actions to be taken. A BACKSLASH
* tokencode is an sdcl line-continuation signal. What it means is
* that the next input line is to be considered to be a continuation
* of the current line. When a backslash is encountered parse
* until the following newline character is encountered and
* discard the newline. Continue the parse appending the
* tokens from the next line until another newline, semicolon,
* of EOF token is found.
*
* A STRING token causes a call to emitqstring() instead of
* emitstring(). Emitqstring() merely checks to see if the
* STRING token will fit on the current output line. If it
* won't a dash (DCL continuation character) and a newline are
* appended to the current output line. This will then flush
* the current output line. Then the STRING token is output
* without a prepended dollar sign.
*/
{
/* If no directive to pass the input line directly... */
if (tokencode != POUND) {
/* ...output the current token. But first append a "$ ". */
emitstring("$ ");
emitstring(token);
}
tokencode = lex(token);
while (tokencode != NEWLINE && tokencode != FILEEND){
/*
* If a backslash include the next line of input
* with the current one.
*/
if (tokencode == BACKSLASH){
while (tokencode != NEWLINE)
tokencode = lex(token);
scan();
/* Add a space for readability. */
emitstring(" ");
}
/*
* Insure that the current STRING token will not
* be broken by a newline by outputting the
* string via calling emitqstring() instead of
* emitstring().
*/
else if (tokencode == STRING){
emitqstring(token);
tokencode = lex(token);
}
else if ( tokencode != COMMENT ) {
emitstring(token);
tokencode = lex(token);
}
else /* don't emit sdcl comment, just get next token */
tokencode = lex(token);
}
emitstring("\n"); /* cause a output line flush */
scan();
}
int whilestmt()
/*
* This function processes a while statement in a manner
* similar to how if statements are handled. This function
* will be invoked in response to finding the keyword "while"
* in the input stream.
*
* While the semantic parse is being performed the intermediate
* code for this statement is also being generated.
*/
{
int looptype, lab1, lab2;
/* Skip the keyword and get two labels. */
scan();
lab1 = genlab();
lab2 = genlab();
/*
* Begin building the output string. This will be
* the destination label for any next statements.
*/
emitstring ("$ ");
emitlabel(lab1);
emitstring("if (.not.(");
if (tokencode == OPAREN)
scan();
else
errmsg("Error--missing a '(' in while condition\n");
/*
* Call condition. When it returns the current token
* should be a CPAREN.
*/
condition();
if (tokencode == CPAREN)
scan();
else
errmsg("Error--missing a ')' in while condition\n");
emitstring(")) then goto ");
emittarget(lab2);
emitstring("\n");
/*
* Do the necessary stack operations to preserve the
* labels used with this while stmt. These will be used
* to target any next or break stmts.
*/
push(WHILE, lab1);
statement();
/*
* After the statement code has been generated the transfer
* statement to the beginning of the condition must be
* generated($ goto lab1). Then the destination for
* condition failure must be inserted. This value will
* be lab + 1 (lab2). Lab2 will * be the destination
* address for any break statements.
*/
emitstring("$ goto ");
emittarget(lab1);
emitstring("\n");
emitstring("$ ");
emitlabel(lab2);
emitstring("\n");
/*
* It is necessary to pop the stack although the values
* returned by the operation will not be used.
*/
pop(&looptype, &lab1);
}
int dowhilestmt()
/*
* Parse and generate the contruct
* do
* statement
* while ( condition )
*/
{
int lab1, lab2, lab3, looptype;
scan();
/*
* reserve all the labels needed for do-while and record loop
* on stack.
*/
lab1 = genlab();
lab2 = genlab();
lab3 = genlab();
push( DO, lab1 );
/*
* emit the label where the true exit from the condition
* will come to.
*/
emitstring( "$ " );
emitlabel( lab1 );
emitstring( "\n" );
statement();
if ( tokencode == WHILE )
scan();
else
errmsg("Error -- missing keyword 'while' in do-while\n" );
if ( tokencode == OPAREN )
scan();
else
errmsg("Error -- missing ( in do-while condition\n" );
/*
* emit code for condition test and branch
*/
emitstring( "$ " );
emitlabel( lab2 );
emitstring("if( " );
condition();
if ( tokencode == CPAREN )
scan();
else
errmsg("Error -- missing ) in do-while condition\n" );
/*
* branch to start of loop, and label for any break statements.
*/
emitstring(" ) then goto ");
emittarget( lab1 );
emitstring( "\n" );
emitstring( "$ ");
emitlabel( lab3 );
emitstring( "\n" );
/*
* pop stack now that we are done.
*/
pop( &looptype, &lab1 );
}
int breakstmt()
/*
* As its name implies this small function handles a break
* statement. It is called by function statement() whenever
* the token BREAK is encountered. All this function need
* do is call scan until a NEWLINE, or FILEEND
* is encountered. When it is found the appropriate goto
* string must be generated. Then one more call to scan will be
* performed to prepare for the next call to function statement().
*/
{
int looptype, label;
while (tokencode != NEWLINE && tokencode !=FILEEND )
tokencode = lex(token);
/*
* Examine the top of the stack to see what action should
* be taken. If currently within a for loop, generate
* a "$ goto (label + 2)." If in a while, generate a
* "$ goto (label + 1)."
*/
if( peek(&looptype, &label) ){
emitstring("$ goto ");
if (looptype == FOR || looptype == DO)
emittarget(label + 2);
else
emittarget(label + 1);
emitstring("\n");
}
else
errmsg("Error -- break statement is not within any loop\n");
scan();
}
int nextstmt()
/*
* Called by statement() whenever the NEXT keyword is found.
* This function repeatedly calls scan() until it finds a
* NEWLINE, or the end of the input file is encountered.
* After any of these tokens are found the appropriate goto
* string is generated to continue loop execution.
* Then one final call to scan is performed to prepare for
* any further calls to statement().
*/
{
int looptype, label;
while (tokencode != NEWLINE && tokencode != FILEEND )
tokencode = lex(token);
/*
* Examine the top of the stack to see what action should
* be taken. If currently within a for loop, generate
* a "$ goto (label + 1)." If in a while, generate a
* "$ goto label."
*/
if( peek(&looptype, &label) ) {
emitstring("$ goto ");
if (looptype == FOR || looptype == DO)
emittarget(label + 1);
else
emittarget(label);
emitstring("\n");
}
else
errmsg("Error -- next statement is not within any loop\n");
scan();
}
int condition()
/*
* This function will be called whenever a DCL condition needs
* to be evaluated. The current token should be an OPAREN, but
* it may not be. DCL conditions may have nested sets of
* parentheses and these must be handled by this function.
* Initialize a variable, paren_count, to one.
* Whenever another OPAREN is encountered increment paren_count.
* Decrement paren_count when a CPAREN is found. Repeat until
* paren_count goes to zero and a CPAREN has been found.
* Be sure to return with CPAREN as the current token.
*
* Since this condition can also appear in a for statement of
* sdcl condition can also be terminated by a SEMICOLON.
*
* For the code generation portion part of this function merely
* pass anything encountered to emistring(), except for the
* closing, CPAREN.
*
*/
{
short paren_count = 1;
/* Output the current token. */
emitstring(token);
/*
* Output all tokens returned by lex() except for
* the last CPAREN. Maintain level of parentheses
* nesting via increments and decrements to paren_count.
* The loop will terminate whenever either a SEMICOLON
* is found or a CPAREN is found when paren_count is
* zero.
*/
do{
tokencode = lex(token);
switch (tokencode)
{
case OPAREN : paren_count++;
emitstring(token);
break;
case CPAREN : paren_count--;
if (paren_count)
emitstring(token);
break;
case NEWLINE : /* eatup newlines */
case SEMICOLON : break; /* in a for loop */
default : emitstring(token);
break;
}
} while (paren_count && tokencode != SEMICOLON &&
tokencode != FILEEND );
/*
* At the end of this function the current token will be
* either a CPAREN or a SEMICOLON.
*/
}
int forstmt()
/*
* The code generation porion of this function is somewhat involved.
* The reinitialization portion of the code is saved in a temporary
* buffer called rstring[]. It is put into rsring by a call to
* reinitialize(). Then the statement portion of the input stream
* is read and processed. Then the reinitialization code is
* output after the proper transfer label is output.
*/
{
extern int initialize();
extern int reinitialize();
int lab1, lab2, lab3, looptype;
char rstring[MAXCONDLEN];
scan();
if (tokencode == OPAREN)
scan();
else
errmsg("Error--missing a '(' in for statement\n");
/*
* If the next token is not a SEMICOLON then an initialization
* statement exists for this for statement. Process it via
* a call to initialize().
*/
if (tokencode != SEMICOLON)
initialize();
/* Get the three labels necessary for a for-statement. */
lab1 = genlab();
lab2 = genlab();
lab3 = genlab();
emitstring("$ ");
emitlabel(lab1);
scan();
/*
* If the next token isn't a SEMICOLON assume that a
* condition statement exists. Begin building the
* string to test this condition. Call condition()
* to parse and output the relational expression, then
* finish building the statement by adding the "goto"
* clause with the appropriate transfer address for
* when the condition fails.
*/
if (tokencode != SEMICOLON){
emitstring("if (.not.(");
condition();
emitstring(")) then goto ");
emittarget(lab3);
}
emitstring("\n");
scan();
/*
* If the next token is not a CPAREN then we know that
* we don't have a null reinitialization statement.
* Call reinitialize() to parse and save this statement.
* The statement will be saved in rstring[] for later
* use after the statement portion of the for-loop
* has been processed.
*/
rstring[0] = '\0';
if (tokencode != CPAREN)
reinitialize(rstring);
if (tokencode == CPAREN)
scan();
else
errmsg("Error--missing a ')' in for statement\n");
/*
* Push lab1 onto the stack to enable processing of break
* and next statements. Process the action portion of
* this while-loop.
*/
push(FOR, lab1);
statement();
/*
* Build the label that preceedes the reinitialization stuff,
* and, if this stuff isn't NULL, output it after the label.
* Finish this line by then appending a newline character.
*
* This label will be the destination for any next statements.
*/
emitstring("$ ");
emitlabel(lab2);
if (rstring[0])
emitstring(rstring);
emitstring("\n");
/*
* Build the statement to transfer back to the beginning
* of the conditional test, output it, then insert the
* target label for when the condition fails. This last target
*
*/
emitstring("$ goto ");
emittarget(lab1);
emitstring("\n");
emitstring("$ ");
emitlabel(lab3);
emitstring("\n");
pop(&looptype, &lab1);
}
int initialize()
/*
* Parses the initialization section of a for statement. All
* that is necessary is to scan until a SEMICOLON is found.
*
* While parsing pass on any non-SEMICOLON tokens to the
* output stream. After a SEMICOLON has been found flush
* the output buffer by appending a newline character to
* the output stream.
*/
{
emitstring("$ ");
while (tokencode != SEMICOLON && tokencode != FILEEND ) {
emitstring(token);
tokencode = lex(token);
}
emitstring("\n");
}
int reinitialize(str)
char *str;
/*
* Parses the reinitialization section of a for statement. All
* that is necessary is to scan until the last CPAREN is found.
* For the code generation all tokens must be saved in the
* input character string, str. So for each token found, add
* it to str.
*/
{
short i = 0, j;
while (tokencode != CPAREN && tokencode != FILEEND){
j = 0;
/* Move all of token, except for the NULL, into str. */
while( token[j] )
str[i++] = token[j++];
tokencode = lex(token);
}
/* When done append a NULL to str. */
str[i] = '\0';
}
End of stmt.c
echo tcodes.h 1>&2
cat > tcodes.h <<'End of tcodes.h'
/*
* The nextstate and output tables for the DFA scanner are
* declared and initialized in this file. This file
* is used exclusively by scan_lex.c and hence is
* only included by that C source file. I have included
* descriptions of the state that each row of the 2-D array
* corresponds to. The columns correspond to the following
* character classes:
*
* L D O S S W E D E E
* E I N L T H O Q N R
* T G E A A I L U D R
* T I C S R T O F
* E T H H E T I
* R A S E L
* R P E
* A
* C
* E
*
*/
static char nextstate[][10] = {
/* state 0, START STATE */
{ 1, 2, 3, 4, 3, 8, 9, 11, 10, 13},
/* state 1, ID */
{ 1, 1, 3, 4, 3, 8, 9, 11, 10, 13},
/* state 2, INTEGER */
{ 1, 2, 3, 4, 3, 8, 9, 11, 10, 13},
/* state 3, SingleChar */
{ 1, 2, 3, 4, 3, 8, 9, 11, 10, 13},
/* state 4, Comment */
{ 1, 2, 3, 4, 5, 8, 9, 11, 10, 13},
/* state 5, Comment */
{ 5, 5, 5, 5, 6, 5, 5, 5, 13, 5},
/* state 6, Comment */
{ 5, 5, 5, 7, 6, 5, 5, 5, 13, 5},
/* state 7, Comment */
{ 1, 2, 3, 4, 3, 8, 9, 11, 10, 13},
/* state 8, WhiteSpace */
{ 1, 2, 3, 4, 3, 8, 9, 11, 10, 13},
/* state 9, Newline */
{ 1, 2, 3, 4, 3, 8, 9, 11, 10, 13},
/* state 10, EOF */
{10, 10, 10, 10, 10, 10, 10, 10, 10, 10},
/* state 11, String */
{11, 11, 11, 11, 11, 11, 13, 12, 13, 13},
/* state 12, String */
{ 1, 2, 3, 4, 3, 8, 9, 11, 10, 13},
/* state 13, ERROR */
{ 1, 2, 3, 4, 3, 8, 9, 11, 10, 13}
};
/*
*
* L D O S S W E D E E
* E I N L T H O Q N R
* T G E A A I L U D R
* T I C S R T O F
* E T H H E T I
* R A S E L
* R P E
* A
* C
* E
*
*/
static char output[][10] = {
/* state 0, START STATE */
{ 0, 0, 0, 0, 0, 0, 0, 0, 15, 0},
/* state 1, ID */
{ 0, 0, 6, 6, 6, 6, 6, 6, 6, 6},
/* state 2, INTEGER */
{18, 0, 18, 18, 18, 18, 18, 18, 18, 18},
/* state 3, SingleChar */
{11, 11, 11, 11, 11, 11, 11, 11, 11, 11},
/* state 4, Comment */
{11, 11, 11, 11, 0, 11, 11, 11, 0, 11},
/* state 5, Comment */
{ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
/* state 6, Comment */
{ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
/* state 7, Comment */
{12, 12, 12, 12, 12, 12, 12, 12, 12, 12},
/* state 8, WhiteSpace */
{13, 13, 13, 13, 13, 0, 13, 13, 13, 13},
/* state 9, Newline */
{14, 14, 14, 14, 14, 14, 14, 14, 14, 14},
/* state 10, EOF */
{15, 15, 15, 15, 15, 15, 15, 15, 15, 15},
/* state 11, String */
{ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
/* state 12, String */
{16, 16, 16, 16, 16, 16, 16, 16, 16, 16},
/* state 13, ERROR */
{17, 17, 17, 17, 17, 17, 17, 17, 17, 17}
};
End of tcodes.h