diff options
Diffstat (limited to 'unix/boot/xyacc/debug/dc.y')
| -rw-r--r-- | unix/boot/xyacc/debug/dc.y | 306 |
1 files changed, 306 insertions, 0 deletions
diff --git a/unix/boot/xyacc/debug/dc.y b/unix/boot/xyacc/debug/dc.y new file mode 100644 index 00000000..0d6fe655 --- /dev/null +++ b/unix/boot/xyacc/debug/dc.y @@ -0,0 +1,306 @@ +# SPP/Yacc specification for a simple desk calculator. Input consists +# of simple arithmetic expressions; output is the value of the expression. +# Operands are restricted to integer and real numeric constants. + +%{ +include <ctype.h> +include <lexnum.h> + +define YYMAXDEPTH 150 # length of parser stack + +task dc = t_dc + +# Operand Structure (parser stack) +define YYOPLEN 2 # size of operand structure +define OPTYPE Memi[$1] # operand datatype +define OPVALI Memi[$1+1] # integer value of operand +define OPVALR Memr[$1+1] # real value of operand + +%} + +%token CONST LETTER YYEOF + +%left '+' '-' +%left '*' '/' +%left UMINUS + +%% + +prog : # Empty + | prog stmt eost { + return (OK) + } + | YYEOF { + return (EOF) + } + | prog error '\n' { + yyerrok + } + ; + +stmt : expr { + # Print the value of an expression. + if (OPTYPE($1) == TY_INT) { + call printf ("%d\n") + call pargi (OPVALI($1)) + } else { + call printf ("%g\n") + call pargr (OPVALR($1)) + } + } + | LETTER '=' expr { + # Set the value of a register (from a-z). + call putreg (OPVALI($1), $3) + } + ; + +expr : '(' expr ')' { + YYMOVE ($2, $$) + } + | expr '+' opnl expr { + call binop ($1, $4, $$, '+') + } + | expr '-' opnl expr { + call binop ($1, $4, $$, '-') + } + | expr '*' opnl expr { + call binop ($1, $4, $$, '*') + } + | expr '/' opnl expr { + call binop ($1, $4, $$, '/') + } + | '-' expr %prec UMINUS { + call unop ($2, $$, '-') + } + | LETTER { + call getreg (OPVALI($1), $$) + } + | CONST + ; + +eost : ';' + | '\n' + ; + +opnl : # Empty + | opnl '\n' + ; + +%% + + +# DC -- Main routine for the desk calculator. + +procedure t_dc() + +bool debug +int status +bool clgetb() +int yyparse() +extern yylex() + +begin + debug = clgetb ("debug") + + repeat { + status = yyparse (STDIN, debug, yylex) + if (status == ERR) + call eprintf ("syntax error") + } until (status == EOF) +end + + +# BINOP -- Perform an arithmetic binary operation on two operands (passed +# by pointer), returning the result in a third. + +procedure binop (a, b, c, operation) + +pointer a, b, c # c = a op b +int operation # i.e., '+', '-', etc. +int i, j, k +real x, y, z + +begin + if (OPTYPE(a) == TY_INT && OPTYPE(b) == TY_INT) { + # Both operands are of type int, so return an integer result. + + i = OPVALI(a) + j = OPVALI(b) + + switch (operation) { + case '+': + k = i + j + case '-': + k = i - j + case '*': + k = i * j + case '/': + k = i / j + default: + call error (1, "unknown binary operator") + } + OPVALI(c) = k + OPTYPE(c) = TY_INT + + } else { + # At least one of the two operands is a real. Perform the + # calculation in type real, producing a real result. + + if (OPTYPE(a) == TY_INT) + x = OPVALI(a) + else + x = OPVALR(a) + if (OPTYPE(b) == TY_INT) + y = OPVALI(b) + else + y = OPVALR(b) + + switch (operation) { + case '+': + z = x + y + case '-': + z = x - y + case '*': + z = x * y + case '/': + z = x / y + default: + call error (1, "unknown binary operator") + } + + OPVALR(c) = z + OPTYPE(c) = TY_REAL + } +end + + +# UNOP -- Perform a unary operation. Since there is only one operand, the +# datatype does not change. + +procedure unop (a, b, operation) + +pointer a, b +int operation + +begin + OPTYPE(b) = OPTYPE(a) + + switch (operation) { + case '-': + switch (OPTYPE(a)) { + case TY_INT: + OPVALI(b) = -OPVALI(a) + case TY_REAL: + OPVALR(b) = -OPVALR(a) + } + default: + call error (2, "unknown unary operator") + } +end + + +# GETREG, PUTREG -- Fetch or store the contents of a register variable. +# Registers are referred to by letter, A-Z or a-z. + +define MAXREG ('z'-'a'+1) + + +procedure getreg (regchar, op) + +int regchar +pointer op + +bool store +int regbuf[MAXREG*YYOPLEN] +int reg, offset + +begin + store = false + goto 10 + +entry putreg (regchar, op) + store = true + + # Compute offset into storage. Structures are stored in buffer + # by a binary copy, knowing only the length of the structure. +10 if (IS_UPPER(regchar)) + reg = regchar - 'A' + 1 + else + reg = regchar - 'a' + 1 + reg = max(1, min(MAXREG, reg)) + offset = (reg-1) * YYOPLEN + 1 + + # Copy the operand structure either in or out. + if (store) + call amovi (Memi[op], regbuf[offset], YYOPLEN) + else + call amovi (regbuf[offset], Memi[op], YYOPLEN) +end + + +# YYLEX -- Lexical input routine. Return next token from the input +# stream. Recognized tokens are CONST (numeric constants), LETTER, +# and the operator characters. + +int procedure yylex (fd, yylval) + +int fd +pointer yylval +char ch, lbuf[SZ_LINE] +int ip, nchars, token, junk +double dval +int lexnum(), getline(), gctod() +data ip /0/ + +begin + # Fetch a nonempty input line, or advance to start of next token + # if within a line. Newline is a token. + repeat { + if (ip <= 0 || lbuf[ip] == EOS) { + if (getline (fd, lbuf) == EOF) { + ip = 0 + return (YYEOF) + } else + ip = 1 + } + while (IS_WHITE (lbuf[ip])) + ip = ip + 1 + } until (lbuf[ip] != EOS) + + # Determine type of token. If numeric constant, convert to binary + # and return value in op structure (yylval). If letter (register + # variable) return value and advance input one char. If any other + # character, return char itself as the token, and advance input one + # character. + + if (IS_DIGIT (lbuf[ip])) + token = lexnum (lbuf, ip, nchars) + else + token = LEX_NONNUM + + switch (token) { + case LEX_OCTAL, LEX_DECIMAL, LEX_HEX: + junk = gctod (lbuf, ip, dval) + OPTYPE(yylval) = TY_INT + OPVALI(yylval) = int (dval) + return (CONST) + + case LEX_REAL: + junk = gctod (lbuf, ip, dval) + OPTYPE(yylval) = TY_REAL + OPVALR(yylval) = dval + return (CONST) + + default: + ch = lbuf[ip] + ip = ip + 1 + if (IS_ALPHA (ch)) { + OPTYPE(yylval) = LETTER + OPVALI(yylval) = ch + return (LETTER) + } else { + OPTYPE(yylval) = ch + return (OPTYPE(yylval)) + } + } +end |