From: Eric S. Raymond Date: Wed, 19 Apr 1995 22:54:15 +0000 (+0000) Subject: CORC support appears to work. X-Git-Tag: 1-2~9 X-Git-Url: http://thyrsus.com/gitweb/?a=commitdiff_plain;h=9e24e980ea90601a4c9a241fa16dfff5967c1db3;p=cupl.git CORC support appears to work. --- diff --git a/Makefile b/Makefile index 8e95bcf..107600d 100644 --- a/Makefile +++ b/Makefile @@ -1,9 +1,9 @@ # -# Makefile for the CUPL project +# Makefile for the CUPL/CORC project # -CDEBUG = -O # change to -g for debugging -YFLAGS = -l # add -vt for debugging -CFLAGS = $(CDEBUG) -D_POSIX_SOURCE -DPARSEDEBUG # -DYYDEBUG=1 +CDEBUG = -g # use -O for production, -g for debugging +YFLAGS = -vt # use -l for production, -vt for debugging +CFLAGS = $(CDEBUG) -D_POSIX_SOURCE -DPARSEDEBUG -DYYDEBUG=1 SOURCES = cupl.[ylh] tokdump.c main.c interpret.c execute.c monitor.c @@ -12,12 +12,12 @@ cupl: $(MODULES) $(CC) $(MODULES) -lm -o cupl # You can use either lex or flex -#LEX = lex -LEX = flex +LEX = lex +#LEX = flex # You can use either bison or yacc -#YACC = yacc -YACC = bison -y +YACC = yacc +#YACC = bison -y lexer.c: cupl.l $(LEX) $(LFLAGS) cupl.l diff --git a/READ.ME b/READ.ME index 6d251fa..1e17edd 100644 --- a/READ.ME +++ b/READ.ME @@ -1,8 +1,9 @@ - CUPL for UNIX + CUPL and CORC for UNIX by Eric S. Raymond This directory contains sources for cupl, a UNIX implementation of CUPL, the -Cornell University Programming Language. +Cornell University Programming Language. It also interprets CORC, the +Cornell Computing Language, the immediate ancestor of CUPL. CUPL was an early (1966) teaching language implemented as a batch compiler on the IBM/360 at Cornell University. It was descended from an earlier (1962) @@ -13,6 +14,9 @@ CUPL has only one scalar type, a long floating-point real corresponding to C double. It supports vector and matrix aggregates, and has operations specialized for matrix calculations. +CORC is a near-subset of CUPL. There are some minor differences in keywords. +In CORC, the statement GO TO is equivalent to CUPL's GO TO END. + The cupl implementation is a Retrocomputing Museum project. The Retrocomputing Museum revives long-dead languages for the benefit of students and historians of programming-language design. @@ -25,6 +29,7 @@ Files: READ.ME -- this file cupl.doc -- transcription of the original CUPL documentation +corc.doc -- transcription of the original CORC documentation cupl.mm -- description and discussion of the language tour.doc -- a tour of the compiler internals @@ -55,7 +60,16 @@ test/simplequad.cupl -- simplest version of quadratic equation solver test/squares.cupl -- print a table of squares test/sum.cupl -- compute sum of presented data -For each test file, there is a corresponding test file used for + CORC samples +(These are all the complete program examples from the CORC manual) + +test/factorial.corc -- compute the factorial function +test/powercorc.corc -- compute the sum of a power series +test/quadcorc.corc -- solve multiple quadratic equations +test/sumsquares.corc -- compute sums of first n integers and squares +test/title.corc -- illustate use of NOTE, TITLE, and WRITE + +For each .cupl or .corc file, there is a corresponding test file used for regression-testing of the interpreter. The interpreter should pass all these tests. @@ -78,6 +92,14 @@ REGRESS -- perform regression test on the front end * GOTO blabel END always goes to the end of the current PERFORM block, even if the label is that of an enclosing block. +* Because the cupl interpreter also interprets CORC, the CORC keywords + BEGIN, DEC, DECREASE, EQL, GEQ, GTR, INC, INCREASE, INT, LSS, NEQ, NOTE, + REPEAT, TITLE, UNTIL, and $ are also reserved words in CUPL. + Send comments, bug reports, and fixes to esr@snark.thyrsus.com. Also see -my home page at //www.thyrsus.com/~esr/home.html for updates and other +my home page at http://www.thyrsus.com/~esr/home.html for updates and other related resources. +--------------------------------------------------------------------------- +Version 1.1: + * Added CORC support. + * Fixed a core-dump bug in the prettyprinter. diff --git a/cupl.h b/cupl.h index 1d02d7b..9dafbeb 100644 --- a/cupl.h +++ b/cupl.h @@ -99,6 +99,8 @@ typedef struct lvar_t lvar; extern lvar *idlist; +bool corc; /* are we parsing CUPL or CORC? */ + #define for_symbols(s) for (s = idlist; s; s = s->next) /* subscripting operations */ diff --git a/cupl.l b/cupl.l index 031d5cd..65622ac 100644 --- a/cupl.l +++ b/cupl.l @@ -12,6 +12,7 @@ extern char *strdup(const char *s); lvar *idlist; +bool corc; static node *intern_number(char *); static node *intern_identifier(char *); @@ -27,52 +28,68 @@ N [0-9.]+ %% COMMENT.*\n ; +NOTE.*\n {corc = TRUE;} ABS {return(ABS);} ALL {return(ALL);} ALLOCATE {return(ALLOCATE);} AND {return(AND);} ATAN {return(ATAN);} +BEGIN {corc = TRUE; return(BLOCK);} BLOCK {return(BLOCK);} BY {return(BY);} COMMENT {return(COMMENT);} COS {return(COS);} +DEC {corc = TRUE; return(DEC);} +DECREASE {corc = TRUE; return(DEC);} DET {return(DET);} DOT {return(DOT);} ELSE {return(ELSE);} END {return(END);} +EQL {corc = TRUE; return('=');} EXP {return(EXP);} FLOOR {return(FLOOR);} FOR {return(FOR);} GE {return(GE);} +GEQ {corc = TRUE; return(GE);} GO {return(GO);} GT {return(GT);} +GTR {corc = TRUE; return(GT);} IDN {return(IDN);} IF {return(IF);} +INC {corc = TRUE; return(INC);} +INCREASE {corc = TRUE; return(INC);} +INT {corc = TRUE; return(FLOOR);} INV {return(INV);} LE {return(LE);} +LEQ {corc = TRUE; return(LE);} LET {return(LET);} LN {return(LN);} LOG {return(LOG);} +LSS {corc = TRUE; return(LE);} LT {return(LT);} MAX {return(MAX);} MIN {return(MIN);} NE {return(NE);} +NEQ {corc = TRUE; return(NE);} OR {return(OR);} PERFORM {return(PERFORM);} POSMAX {return(POSMAX);} POSMIN {return(POSMIN);} RAND {return(RAND);} READ {return(READ);} +REPEAT {corc = TRUE; return(PERFORM);} SGM {return(SGM);} SIN {return(SIN);} SQRT {return(SQRT);} STOP {return(STOP);} THEN {return(THEN);} TIMES {return(TIMES);} +TITLE.*\n {corc = TRUE; yylval.node = intern_string(yytext + 6); return(TITLE);} TO {return(TO);} TRC {return(TRC);} TRN {return(TRN);} +UNTIL {corc = TRUE; return(UNTIL);} WATCH {return(WATCH);} WHILE {return(WHILE);} WRITE {return(WRITE);} @@ -85,6 +102,7 @@ WRITE {return(WRITE);} '[^']*' {yylval.node = intern_string(yytext); return(STRING);} "**" {return(POWER);} +"$" {corc = TRUE; return(POWER);} [+*/().,=-] {return(yytext[0]);} [ \t] ; @@ -196,6 +214,7 @@ int yywrap() #ifdef MAIN YYSTYPE yylval; +int verbose; main() { @@ -204,13 +223,13 @@ main() while ((t = yylex()) > 0) { if (t == NUMBER) - (void) printf("NUMBER: %f\n", yylval.numval); - else if (t == NEWLINE) + (void) printf("NUMBER: %f\n", yylval.node->u.numval); + else if (t == '\n') (void) printf("NEWLINE\n"); else if (t == STRING) - (void) printf("STRING: %s\n", yylval.string); + (void) printf("STRING: %s\n", yylval.node->u.string); else if (t == IDENTIFIER) - (void) printf("IDENTIFIER: %s\n", yylval.string); + (void) printf("IDENTIFIER: %s\n", yylval.node->u.string); else (void) printf("keyword %3d: %s\n", t, tokdump(t)); } diff --git a/cupl.xml b/cupl.xml index 448faae..d8224ce 100644 --- a/cupl.xml +++ b/cupl.xml @@ -1,5 +1,5 @@ .SA 1 -.TL "CUPL: the UNIX implementation" +.TL "CUPL/CORC: the UNIX implementation" .AF "Thyrsus Enterprises" .AU "Eric S. Raymond" ESR "\&\&22 South Warren Ave, Malvern PA 19355" .MT 4 @@ -10,51 +10,63 @@ CUPL was an early (1966) teaching language implemented as a batch compiler on the IBM/360 at Cornell University. It was descended from an earlier (1962) experimental language called CORC (CORnell Compiler), which was in turn derived -from PL/1. +from PL/1. Statements made without qualification about CUPL below +also apply to CORC. .P CUPL is documented in "CUPL: The Cornell University Programming Language", by R.J. Walker, a manual first printed in November 1966. This implementation, and the discussion in this paper, are based on the July 1967 second printing. .P -The purpose of this implementation, and this paper, is to preserve a CUPL -implementation for the edification of historians and students of -programming-language design. CUPL was representative of a significant class of -teaching languages in its period, and study of the design casts a clear light -on the preoccupations of its time. +CORC is documented in "An Instruction Manual For CORC", by R.W. Conway, +W.L. Maxwell, R.J. Walker. This implementation tracks the 2nd edition +of September 1963. .P -.H 1 "The CUPL Language" +The purpose of this implementation, and this paper, is to preserve a +CUPL/CORC implementation for the edification of historians and +students of programming-language design. CUPL and CORC were +representative of a significant class of teaching languages in its +period, and study of the design casts a clear light on the +preoccupations of its time. +.P +.H 1 "The CUPL and CORC Languages" .P This distribution includes, in the file cupl.doc, a transcription of all the relevant parts of the CUPL manual (the bulk of the text is a -general tutorial on scientific programming). +general tutorial on scientific programming). Another file, +corc.doc, similarly excerpts the CORC manual. .P CUPL has only one scalar type, a long floating-point real corresponding to C double (round-off rules coerce scalars to integer in contexts like subscripting). It supports vector and matrix aggregates, and has operations specialized for linear-algebra calculations. There is no function abstraction -and all variables are global; program chunking is achieved through PERFORM -blocks which resemble parameterless subroutines. +and all variables are global; program chunking is achieved through BLOCK +or BEGIN blocks which resemble parameterless subroutines. .P CUPL rather resembles early BASICs, minus BASIC's string facility. It is oriented towards scientific calculation and linear algebra, and would be nearly impossible (or, at any rate, extremely painful) to use for anything else. .P -The programming-support features resembled those of the better-known WATFOR -and WATFIV compilers, incorporating elaborate error-correction and trace -output features using a runtime monitor. +The programming-support features of CUPL resembled those of the +better-known WATFOR and WATFIV compilers, incorporating elaborate +error-correction and trace output features using a runtime monitor. +CORC does not appear to have supported these features. .P .H 1 "Differences from the original CUPL" .P -The most obvious differences are also the most trivial. CUPL, first -implemented on an IBM/360 Model 30, used a small capital-letters-only subset of -EBCDIC similar to SIXBIT, and followed the archaic IBM practice of using a -slashed-O for alphabetic O and plain 0 for zero. Original CUPL listings thus +The most obvious differences are also the most trivial. CUPL was +first implemented on an IBM/360 Model 30; CORC on Burroughs 1604 and +220 machines. Both used a small capital-letters-only character set +SIXBIT, and followed the archaic IBM practice of using a slashed-O for +alphabetic O and plain 0 for zero. Original CUPL/CORC listings thus look rather odd to the modern eye. .P -The original CUPL was a batch system with a fixed-field card format; labels in -columns 1-8, statements in 10-72, statement continuations beginning in column -15. Data for the program was supplied following a special *DATA label in the -same deck as the program. +The original CUPL was a batch system with a fixed-field card format; +labels in columns 1-8, statements in 10-72, statement continuations +beginning in column 15 (CORC's format differed only in detail from +this). In CUPL, data for the program was supplied following a special +*DATA label in the same deck as the program; CORC did not require this +marker (it is not clear from the CORC documentation how end-of-program +was recognized). .P On modern output devices, slashed-0 tends to be used, if at all, for zero. We have not tried to preserve IBM's reversal. Nor have we tried to enforce the @@ -67,31 +79,36 @@ initializations. More significant differences arise from differences between the word size and floating-point format in CUPL's original host and those of typical modern C implementation. The 360 had a 36-bit word; original CUPL scalars ranged from -1e76 to 1e-78 with nine decimal digits of precision. On today's typical 32-bit -microprocessor such as an Intel 486, C floats are 32 bits and have roughly -1e+38 to 1e-38 range and 9 digits precision; doubles are 64 bits, with range -roughly 1e308 to 1e-304 and 19 digits of precision. This implementation use -doubles to emulate CUPL scalars. +1e76 to 1e-78 with nine decimal digits of precision. The Burroughs +1604 was documented as having a much wider range, 1e308 to 1e-308 with +11 digits of precision; the Burroughs 220 supported 1e-49 to 1e50 with +8 digits of precision. +.PP +On today's typical 32-bit microprocessor such as an Intel 486, C +floats are 32 bits and have roughly 1e+38 to 1e-38 range and 9 digits +precision; doubles are 64 bits, with range roughly 1e308 to 1e-304 and +19 digits of precision. This implementation use doubles to emulate +CUPL/CORC scalars. .P We know from the documentation that the original CUPL compiler ran in 64K of core. The present implementation is easily twice that size. However, given the cycle speeds of the 1960s, it certainly runs a good deal faster that original CUPL, even with interpretation overhead. .P -We don't implement original CUPL's error-correction facilities. Though clever, -they would make the parser forbiddingly complex, and much less important in an -interactive environment. +We don't implement original CUPL's error-correction facilities. +Though clever, they would make the parser forbiddingly complex, and +are anyway much less important in an interactive environment. .P -There are many limits in original CUPL that we do not enforce. There is +There are many limits in original CUPL/CORC that we do not enforce. There is no limit on the length of variable names short of the lexer's very long token buffer length. There is no hard limit on the number of statements in a program. There is no hard limit on the size of arrays. .P -While the format of number output does not exactly conform to original CUPL -rules, it is sufficiently ugly to please any but the pickiest. We -implement all of 5.2 except the fixing of the decimal point at -position 7 in each field. Instead we simply use printf(3)'s %f and %e -at field-width precision. +While the format of number output does not exactly conform to the original +CUPL/CORC rules, it is sufficiently ugly to please any but the +pickiest. We implement all of 5.2 except the fixing of the decimal +point at position 7 in each field. Instead we simply use printf(3)'s +%f and %e at field-width precision. .P Also, by default, we wrap after three 20-char fields rather than 6, so as to fit on an 80-column line. Command-line options to change the diff --git a/cupl.y b/cupl.y index fa599e9..99dd0d1 100644 --- a/cupl.y +++ b/cupl.y @@ -43,15 +43,16 @@ int yydebug; } /* keywords */ -%token ABS ALL ALLOCATE AND ATAN BLOCK BY COMMENT COS DET DOT ELSE END EXP -%token FLOOR FOR GE GO GT IDN IF INV LE LET LN LOG LT MAX MIN NE OR PERFORM -%token POSMAX POSMIN RAND READ SGM SIN SQRT STOP THEN TIMES TO TRC TRN -%token WATCH WHILE WRITE DATA +%token ABS ALL ALLOCATE AND ATAN BLOCK BY COMMENT COS DEC DET DOT ELSE END EXP +%token FLOOR FOR GE GO GT IDN IF INC INV LE LET LN LOG LT MAX MIN NE OR PERFORM +%token POSMAX POSMIN RAND READ SGM SIN SQRT STOP THEN TIMES TITLE TO TRC TRN +%token UNTIL WATCH WHILE WRITE DATA %token POWER %token STRING %token NUMBER %token IDENTIFIER +%token TITLE %token LPAREN ')' %token RPAREN '(' @@ -118,6 +119,7 @@ command : simple {$$ = $1;} | BLOCK {$$ = cons(BLOCK, NULLNODE, NULLNODE);} | END {$$ = cons(END, NULLNODE, NULLNODE);} | DATA datal {$$ = $2;} + | TITLE {$$ = cons(WRITE, $1, NULLNODE);;} ; cond : IF guard THEN simple @@ -143,6 +145,7 @@ gosub : PERFORM IDENTIFIER {$$ = cons(PERFORM, $2, NULLNODE);} perform : gosub {$$ = $1;} | gosub expr TIMES {$$ = cons(TIMES, $2, $1);} | gosub WHILE guard {$$ = cons(WHILE, $3, $1);} + | gosub UNTIL guard {$$ = cons(UNTIL, $3, $1);} | gosub FOR IDENTIFIER '=' expl {$$ = cons(FOR, cons('=', $3, $5), $1);} @@ -181,6 +184,8 @@ rel : expr '=' expr {$$ = cons('=', $1, $3);} /* simple statement types */ simple : LET IDENTIFIER '=' expr {$$ = cons(LET, $2, $4);} + | INC IDENTIFIER BY expr {$$ = cons(LET, $2, cons(PLUS, $2, $4));} /* CORC */ + | DEC IDENTIFIER BY expr {$$ = cons(LET, $2, cons(MINUS, $2, $4));} /* CORC */ | GO TO IDENTIFIER {$$ = cons(GO, $3, NULLNODE);} | GO TO IDENTIFIER END {$$ = cons(OG, $3, NULLNODE);} | READ readl {$$ = $2;} diff --git a/execute.c b/execute.c index fdb54c6..daacb8a 100644 --- a/execute.c +++ b/execute.c @@ -500,6 +500,16 @@ static value cupl_eval(node *tree) result.rank = FAIL; return(result); + case UNTIL: + do { + cupl_eval(tree->cdr); + + cond = cupl_eval(tree->car); + } while + (!cond.rank); + result.rank = FAIL; + return(result); + case FOR: iterator = tree->car; if (iterator->type == '=') diff --git a/interpret.c b/interpret.c index c278ddc..9327dc3 100644 --- a/interpret.c +++ b/interpret.c @@ -94,7 +94,7 @@ static void prettyprint(node *tree, int indent) prettyprint(tree->car, indent + INDENT); prettyprint(tree->cdr, - indent + INDENT * (tree->type != tree->cdr->type)); + indent + INDENT * (tree->cdr && (tree->type != tree->cdr->type))); } } #endif /* PARSEDEBUG */ @@ -188,6 +188,18 @@ static bool r_mark_labels(node *tp) return(TRUE); } +static bool mung_corc_labels(node *tp) +{ + if (tp->type == GO && tp->car->syminf->blabeldef > 0) + { + tp->type = OG; + tp->car->syminf->slabelref--; + tp->car->syminf->blabelref++; + } + + return(TRUE); +} + static bool check_errors(node *tree) /* look for inconsistencies in a program parse tree */ { @@ -206,6 +218,10 @@ static bool check_errors(node *tree) /* mark labels */ recursive_apply(tree, r_mark_labels); + /* map CORC's GO TO to CUPL's GO TO END */ + if (corc) + recursive_apply(tree, mung_corc_labels); + /* describe all labels and variables */ if (verbose >= DEBUG_CHECKDUMP) { @@ -290,16 +306,16 @@ static bool r_label_rewrite(node *tp) if (left && left->type == IDENTIFIER && left->syminf->blabelref) { -#ifdef ODEBUG +#ifdef PDEBUG (void) printf("patching block label left reference to %s\n", left->u.string); -#endif /* ODEBUG */ +#endif /* PDEBUG */ tp->car = left->syminf->target; } if (right && right->type == IDENTIFIER && right->syminf->blabelref) { -#ifdef ODEBUG +#ifdef PDEBUG (void) printf("patching block label right reference to %s\n", right->u.string); -#endif /* ODEBUG */ +#endif /* PDEBUG */ tp->cdr = right->syminf->target; } } @@ -311,16 +327,16 @@ static bool r_label_rewrite(node *tp) if (left && left->type == IDENTIFIER && left->syminf->slabelref) { -#ifdef ODEBUG +#ifdef PDEBUG (void) printf("patching statement label left reference to %s\n", left->u.string); -#endif /* ODEBUG */ +#endif /* PDEBUG */ tp->car = left->syminf->target; } if (right && right->type == IDENTIFIER && right->syminf->slabelref) { -#ifdef ODEBUG +#ifdef PDEBUG (void) printf("patching statement label right reference to %s\n", right->u.string); -#endif /* ODEBUG */ +#endif /* PDEBUG */ tp->cdr = right->syminf->target; } } diff --git a/main.c b/main.c index 74b04af..b06283f 100644 --- a/main.c +++ b/main.c @@ -7,7 +7,7 @@ SYNOPSIS cupl [-vn[y]] [-w nn] [-f nn] [file...] DESCRIPTION - The main sequence of the Cornell University Programming Language compiler. + Main sequence of the Cornell University Programming Language interpreter. All the real work is done by yyparse. May set globals verbose and yydebug. *****************************************************************************/