home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d1xx / d183 / pcq.lha / PCQ / Source / Expression.p < prev    next >
Text File  |  1989-02-26  |  20KB  |  727 lines
  1. external;
  2.  
  3. {
  4.     Expression.p (of PCQ Pascal)
  5.     Copyright (c) 1989 Patrick Quaid
  6.  
  7.     This module only has two parts.  The first is expression(),
  8. which handles all run-time expressions.  The other one is
  9. conexpr(), which handles all constant expressions.
  10. }
  11.  
  12. const
  13. {$I "pasconst.i"}
  14.  
  15. type
  16. {$I "pastype.i"}
  17.  
  18. var
  19. {$I "pasvar.i"}
  20.  
  21.     function typecheck(l, r : integer) : boolean;
  22.         forward;
  23.     procedure nextsymbol;
  24.         forward;
  25.     procedure gch;
  26.         forward;
  27.     procedure error(s : string);
  28.         forward;
  29.     procedure callfunc(f : integer);
  30.         forward;
  31.     procedure stdfunc(f : integer);
  32.         forward;
  33.     function match(s : integer): boolean;
  34.         forward;
  35.     function findid(s : string) : integer;
  36.         forward;
  37.     procedure printlabel(l : integer);
  38.         forward;
  39.     function getlabel() : integer;
  40.         forward;
  41.     function selector(f : integer) : integer;
  42.         forward;
  43.     procedure mismatch;
  44.         forward;
  45.     procedure noleftparent;
  46.         forward;
  47.     procedure norightparent;
  48.         forward;
  49.     procedure neednumber;
  50.         forward;
  51.     procedure needrightparent;
  52.         forward;
  53.     procedure needleftparent;
  54.         forward;
  55.     function suffix(s : integer) : char;
  56.         forward;
  57.     function numbertype(l : integer) : boolean;
  58.         forward;
  59.     function basetype(b : integer): integer;
  60.         forward;
  61.     procedure writehex(h : integer);
  62.         forward;
  63.     procedure promotetype(var f : integer; o, r : integer);
  64.         forward;
  65.  
  66. function expression() : integer;
  67.     forward;
  68.  
  69. function readlit(firstchar : char) : integer;
  70.  
  71. {
  72.     This routine reads a literal array of char into the literal
  73. array.  Read factor() to figure out why this is passed
  74. firstchar....
  75. }
  76.  
  77. var
  78.     length : integer;
  79. begin
  80.     length := 1;
  81.     litq[litptr] := firstchar;
  82.     litptr := litptr + 1;
  83.     while (currentchar <> chr(39)) and (currentchar <> chr(10)) do begin
  84.     litq[litptr] := currentchar;
  85.     gch;
  86.     if currentchar = chr(10) then
  87.        error("missing closing apostrophe");
  88.     length := length + 1;
  89.     litptr := litptr + 1;
  90.     end;
  91.     gch;
  92.     nextsymbol;
  93.     readlit := length;
  94. end;
  95.  
  96. function simpletype(testtype : integer) : boolean;
  97.  
  98. {
  99.     If a variable passes this test, it is held in a register
  100. during processing.  If not, the address of the variable is held in
  101. the register.  This is the main reason why type conversions don't
  102. work across all types of the same size.
  103. }
  104.  
  105. begin
  106.     simpletype := (idents[testtype].size <= 4) and
  107.           (idents[testtype].size <> 3) and
  108.           (idents[testtype].offset <> vrecord) and
  109.           (idents[testtype].offset <> varray);
  110. end;
  111.  
  112. function idfactor(factindex : integer) : integer;
  113.  
  114. {
  115.     idfactor() is another nightmare function.  It does whatever
  116. is necessary when the compiler runs across an identifer in an
  117. expression, which almost always means loading a value into d0.
  118. }
  119.  
  120. var
  121.     facttype    : integer;
  122.     selecttype    : integer;
  123.     originaltype : integer;
  124. begin
  125.     if factindex <> 0 then begin
  126.     facttype := idents[factindex].vtype;
  127.     if idents[factindex].object = func then begin
  128.         { call a user-defined function }
  129.         callfunc(factindex);
  130.         idfactor := facttype;
  131.     end else if idents[factindex].object = stanfunc then begin
  132.         { 'call' a standard function, which is actually handled
  133.         in-line. }
  134.         stdfunc(factindex);
  135.         idfactor := idents[factindex].vtype;
  136.     end else if idents[factindex].object = obtype then begin
  137.         { this implements the type conversion thing. }
  138.         needleftparent;
  139.         selecttype := expression();
  140.         needrightparent;
  141.         idfactor := factindex;
  142.     end else if idents[factindex].object = constant then begin
  143.         { load a constant or enumeration.  Expand this when
  144.         real numbers and string constants are included. }
  145.         writeln(output, "\tmove.l\t#", idents[factindex].offset, ',d0');
  146.         idfactor := idents[factindex].vtype;
  147.     end else begin
  148.         { it's probably a variable }
  149.         selecttype := selector(factindex);
  150.         if selecttype <> 0 then begin
  151.         { there was some sort of selection required }
  152.         facttype := selecttype;
  153.         originaltype := idents[factindex].vtype;
  154.         if idents[factindex].object = global then begin
  155.             if (idents[originaltype].offset = vpointer) or
  156.             (idents[originaltype].offset = vfile) then
  157.             writeln(output, "\tmove.l\td0,a0")
  158.             else begin
  159.             writeln(output, "\tmove.l\t#_",
  160.                     idents[factindex].name, ',a0');
  161.             writeln(output, "\tadd.l\td0,a0");
  162.             end
  163.         end else if idents[factindex].object = refarg then begin
  164.             if (idents[originaltype].offset = vpointer) or
  165.             (idents[originaltype].offset = vfile) then
  166.             writeln(output, "\tmove.l\td0,a0")
  167.             else begin
  168.             writeln(output, "\tmove.l\t", idents[factindex].offset,
  169.                     '(a5),a0');
  170.             writeln(output, "\tadd.l\td0,a0");
  171.             end
  172.         end else begin
  173.             if (idents[originaltype].offset = vpointer) or
  174.             (idents[originaltype].offset = vfile) then
  175.             writeln(output, "\tmove.l\td0,a0")
  176.             else begin
  177.             writeln(output, "\tlea\t", idents[factindex].offset,
  178.                     '(a5),a0');
  179.             writeln(output, "\tadd.l\td0,a0");
  180.             end
  181.         end;
  182.         if simpletype(facttype) then
  183.             writeln(output, "\tmove.", suffix(idents[facttype].size),
  184.             "\t(a0),d0");
  185.         else
  186.             writeln(output, "\tmove.l\ta0,d0");
  187.         end else begin
  188.         { this is a simple variable }
  189.         if idents[factindex].object = global then begin
  190.             if not simpletype(facttype) then begin
  191.             writeln(output, "\tmove.l\t#_",
  192.                     idents[factindex].name, ',d0');
  193.             end else begin
  194.             writeln(output,"\tmove.",suffix(idents[facttype].size),
  195.                 "\t_", idents[factindex].name, ',d0');
  196.             end
  197.         end else if (idents[factindex].object = local) or
  198.             (idents[factindex].object = valarg) then begin
  199.             if not simpletype(facttype) then begin
  200.             writeln(output, "\tlea\t", idents[factindex].offset, 
  201.                     '(a5),a0');
  202.             writeln(output, "\tmove.l\ta0,d0");
  203.             end else begin
  204.             writeln(output,"\tmove.",suffix(idents[facttype].size),
  205.                 chr(9), idents[factindex].offset, '(a5),d0');
  206.             end;
  207.         end else if idents[factindex].object = refarg then begin
  208.             if not simpletype(facttype) then begin
  209.             writeln(output, "\tmove.l\t", idents[factindex].offset,
  210.                     '(a5),d0');
  211.             end else begin
  212.             writeln(output, "\tmove.l\t", idents[factindex].offset,
  213.                     '(a5),a0');
  214.             writeln(output, "\tmove.",suffix(idents[facttype].size),
  215.                 "\t(a0),d0");
  216.             end;
  217.         end else begin
  218.             error("expecting a variable or function");
  219.             facttype := badtype;
  220.         end;
  221.         end;
  222.         idfactor := facttype;
  223.     end;
  224.     error("expecting an expression");
  225.     idfactor := badtype;
  226.     end else begin
  227.     error("Unknown identifier");
  228.     idfactor := badtype;
  229.     end;
  230. end;
  231.  
  232. function factor() : integer;
  233.  
  234. {
  235.     This is the lowest level of the expression parsing
  236. business.  It's pretty standard stuff.  All these expression
  237. routines return the index of the type they're working on.
  238. }
  239.  
  240. var
  241.     facttype    : integer;
  242.     factindex    : integer;
  243.     length    : integer;
  244.     firstchar    : char;
  245. begin
  246.     if currsym = ident1 then begin
  247.     factindex := findid(symtext);
  248.     nextsymbol;
  249.     facttype := idfactor(factindex);
  250.     end else if currsym = numeral1 then begin
  251.     if abs(symloc) > 32767 then begin
  252.         facttype := inttype;
  253.         write(output, "\tmove.l\t#");
  254.         writehex(symloc);
  255.         writeln(output, ',d0');
  256.     end else begin
  257.         { assumes short integers for literals...}
  258.         writeln(output, "\tmove.w\t#", symloc, ',d0');
  259.         facttype := shorttype;
  260.     end;
  261.     nextsymbol;
  262. {   end else if currsym = realnumeral1 then begin
  263.     write(output, "\tmove.l\t#");
  264.     writehex(integer(realnum));
  265.     writeln(output, ",d0");
  266.     facttype := realtype;
  267.     nextsymbol; }
  268.     end else if currsym = apostrophe1 then begin
  269.     firstchar := currentchar;
  270.     gch;
  271.     if currentchar <> chr(39) then begin
  272.         write(output, "\tmove.l\t#");
  273.         printlabel(litlab);
  274.         writeln(output, '+', litptr - 1, ',d0');
  275.         length := readlit(firstchar);
  276.         idents[literaltype].upper := length;
  277.         idents[literaltype].size := length;
  278.         facttype := literaltype;
  279.     end else begin
  280.         gch;
  281.         nextsymbol;
  282.         writeln(output, "\tmove.b\t#", ord(firstchar), ',d0');
  283.         facttype := chartype;
  284.     end;
  285.     end else if match(not1) then begin
  286.     facttype := factor();
  287.     if not typecheck(facttype, booltype) then begin
  288.         error("NOT applies only to Booleans");
  289.         facttype := badtype;
  290.     end else
  291.         writeln(output, "\tnot.b\td0");
  292.     end else if match(leftparent1) then begin
  293.     facttype := expression();
  294.     needrightparent;
  295.     end else if currsym = quote1 then begin
  296.     { Read a string.  This should go to a separate procedure }
  297.     write(output, "\tmove.l\t#");
  298.     printlabel(litlab);
  299.     writeln(output, '+', litptr - 1, ',d0');
  300.     while (currentchar <> '"') and (currentchar <> chr(10)) do begin
  301.         if currentchar = '\' then begin
  302.         gch;
  303.         if currentchar = 't' then
  304.             litq[litptr] := chr(9)
  305.         else if currentchar = 'n' then
  306.             litq[litptr] := chr(10)
  307.         else
  308.             litq[litptr] := currentchar;
  309.         end else
  310.         litq[litptr] := currentchar;
  311.         gch;
  312.         if currentchar = chr(10) then
  313.         error("missing close quote");
  314.         litptr := litptr + 1;
  315.     end;
  316.     gch;
  317.     nextsymbol;
  318.     litq[litptr] := chr(0);
  319.     litptr := litptr + 1;
  320.     facttype := stringtype;
  321.     end else begin
  322.     error("bizarre expression");
  323.     facttype := badtype;
  324.     end;
  325.     factor := facttype;
  326. end;
  327.     
  328. function operate(lefttype, righttype, operator : integer) : integer;
  329.  
  330. {
  331.     This routine handles the actual code generation for the
  332. various operations.  This handles all the math stuff, even though
  333. it's called by different routines.  In the next version this bit
  334. will properly handle the multiplication and division of 32 bit
  335. values.
  336. }
  337.  
  338. begin
  339.     if not typecheck(lefttype, righttype) then begin
  340.     mismatch;
  341.     lefttype := badtype;
  342.     end else begin
  343.     writeln(output, "\tmove.l\t(sp)+,d1");
  344.     if (operator = and1) or (operator = or1) then begin
  345.         if not typecheck(lefttype, booltype) then
  346.         error("Need Boolean expression for AND and OR");
  347.     end else begin
  348.         if numbertype(lefttype) then begin
  349.         promotetype(lefttype, righttype, 1);
  350.         promotetype(righttype, lefttype, 0);
  351.         end else
  352.         neednumber;
  353.     end;
  354.  
  355.     { The following arithmetic operations will undergo a major
  356.       change when two more things are added.  They are, not
  357.       surprisingly, real math and full 32 bit multiplication
  358.       and division.  Each of the following cases will have to
  359.       be fleshed out a bit to decide what kind of math routines
  360.       to use for a particular operation. }
  361.  
  362.     if operator = asterisk1 then begin
  363.         if lefttype = bytetype then begin
  364.         promotetype(lefttype, shorttype, 1);
  365.         promotetype(righttype, shorttype, 0);
  366.         end;
  367.         writeln(output, "\tmuls\td1,d0");
  368.         lefttype := inttype;
  369.     end else if operator = div1 then begin
  370.         if lefttype <> inttype then begin
  371.         promotetype(lefttype, inttype, 1);
  372.         promotetype(righttype, shorttype, 0);
  373.         end;
  374.         writeln(output, "\tdivs\td0,d1");
  375.         writeln(output, "\tmove.l\td1,d0");
  376.         lefttype := shorttype;
  377.     end else if operator = mod1 then begin
  378.         if lefttype <> inttype then begin
  379.         promotetype(lefttype, inttype, 1);
  380.         promotetype(righttype, shorttype, 0);
  381.         end;
  382.         writeln(output, "\tdivs\td0,d1");
  383.         writeln(output, "\tmove.l\td1,d0");
  384.         writeln(output, "\tswap\td0");
  385.         lefttype := shorttype;
  386.     end else if operator = and1 then begin
  387.         writeln(output, "\tand.b\td1,d0")
  388.     end else if operator = plus1 then begin
  389.         writeln(output, "\tadd.", suffix(idents[lefttype].size),
  390.                 "\td1,d0");
  391.     end else if operator = minus1 then begin
  392.         writeln(output, "\tsub.", suffix(idents[lefttype].size),
  393.             "\td1,d0");
  394.         writeln(output, "\tneg.", suffix(idents[lefttype].size),
  395.             "\td0");
  396.     end else if operator = or1 then
  397.         writeln(output, "\tor.b\td1,d0")
  398.     end;
  399.     operate := lefttype;
  400. end;
  401.  
  402. function term() : integer;
  403.  
  404. {
  405.     Again, pretty standard stuff.  This handles the level of
  406. precedence that includes *, div, mod, and and.
  407. }
  408.  
  409. var
  410.     lefttype    : integer;
  411.     righttype    : integer;
  412.     stay    : boolean;
  413. begin
  414.     lefttype := factor();
  415.     stay := true;
  416.     while stay do begin
  417.     if match(asterisk1) then begin
  418.         writeln(output, "\tmove.l\td0,-(sp)");
  419.         righttype := factor();
  420.         lefttype := operate(lefttype, righttype, asterisk1);
  421.     end else if match(div1) then begin
  422.         writeln(output, "\tmove.l\td0,-(sp)");
  423.         righttype := factor();
  424.         lefttype := operate(lefttype, righttype, div1);
  425.     end else if match(mod1) then begin
  426.         writeln(output, "\tmove.l\td0,-(sp)");
  427.         righttype := factor();
  428.         lefttype := operate(lefttype, righttype, mod1);
  429.     end else if match(and1) then begin
  430.         writeln(output, "\tmove.l\td0,-(sp)");
  431.         righttype := factor();
  432.         lefttype := operate(lefttype, righttype, and1);
  433.     end else
  434.         stay := false;
  435.     end;
  436.     term := lefttype;
  437. end;
  438.  
  439. function simple() : integer;
  440.  
  441. {
  442.     This is similar to term(), except it handles plus, minus,
  443. or, and unary minus.
  444. }
  445.  
  446. var
  447.     lefttype    : integer;
  448.     righttype    : integer;
  449.     stay    : boolean;
  450. begin
  451.     if match(minus1) then begin
  452.     lefttype := term();
  453.     if not typecheck(lefttype, inttype) then begin
  454.         error("need numeric type for unary minus");
  455.         lefttype := badtype;
  456.     end else
  457.         writeln(output, "\tneg.", suffix(idents[lefttype].size),"\td0");
  458.     end else
  459.     lefttype := term();
  460.  
  461.     stay := true;
  462.     while stay do begin
  463.     if match(plus1) then begin
  464.         writeln(output, "\tmove.l\td0,-(sp)");
  465.         righttype := term();
  466.         lefttype := operate(lefttype, righttype, plus1);
  467.     end else if match(minus1) then begin
  468.         writeln(output, "\tmove.l\td0,-(sp)");
  469.         righttype := term();
  470.         lefttype := operate(lefttype, righttype, minus1);
  471.     end else if match(or1) then begin
  472.         writeln(output, "\tmove.l\td0,-(sp)");
  473.         righttype := term();
  474.         lefttype := operate(lefttype, righttype, or1);
  475.     end else
  476.         stay := false;
  477.     end;
  478.     simple := lefttype;
  479. end;
  480.  
  481. function exprrelop(lefttype, operation : integer) : integer;
  482.  
  483. {
  484.     This handles the code for the various relative comparisons
  485. (like <, >, <=, etc.)
  486. }
  487.  
  488. var
  489.     righttype    : integer;
  490. begin
  491.     writeln(output, "\tmove.l\td0,-(sp)");
  492.     righttype := simple();
  493.     if not typecheck(lefttype, righttype) then begin
  494.     mismatch;
  495.     lefttype := badtype;
  496.     end else if idents[lefttype].offset <> vordinal then begin
  497.     error("only simple types allowed in inequalities");
  498.     lefttype := badtype;
  499.     end else begin
  500.     writeln(output, "\tmove.l\t(sp)+,d1");
  501.     if numbertype(lefttype) then begin
  502.         promotetype(lefttype, righttype, 1);
  503.         promotetype(righttype, lefttype, 0);
  504.     end;
  505.     writeln(output, "\tcmp.", suffix(idents[lefttype].size), "\td0,d1");
  506.     if operation = less1 then
  507.         writeln(output, "\tslt\td0")
  508.     else if operation = greater1 then
  509.         writeln(output, "\tsgt\td0")
  510.     else if operation = notless1 then
  511.         writeln(output, "\tsge\td0")
  512.     else if operation = notgreater1 then
  513.         writeln(output, "\tsle\td0");
  514.     lefttype := booltype;
  515.     end;
  516.     exprrelop := lefttype;
  517. end;
  518.  
  519. function expreqop(lefttype, operation : integer) : integer;
  520.  
  521. {
  522.     This generated code for comparisons of equality.  The main
  523. difference between this and the previous routine is that Pascal
  524. allows the comparison of complex types, so this routine has to
  525. handle that.
  526. }
  527.  
  528. var
  529.     righttype    : integer;
  530.     lab        : integer;
  531.     totalsize    : integer;
  532. begin
  533.     writeln(output, "\tmove.l\td0,-(sp)");
  534.     righttype := simple();
  535.     if not typecheck(lefttype, righttype) then begin
  536.     mismatch;
  537.     lefttype := badtype;
  538.     writeln(output, "\tmove.l\t(sp)+,d0");
  539.     end else begin
  540.     totalsize := idents[lefttype].size;
  541.     if not simpletype(lefttype) then begin
  542.  
  543.       { If we got here, this must be a complex type.  Therefore
  544.         compare the two objects byte by byte. }
  545.  
  546.         writeln(output, "\tmove.l\td0,a0");
  547.         writeln(output, "\tmove.l\t(sp)+,a1");
  548.         writeln(output, "\tmove.b\t#-1,d0");
  549.         writeln(output, "\tmove.l\t#", totalsize, ",d1");
  550.         lab := getlabel();
  551.         printlabel(lab);
  552.         writeln(output, "\tmove.b\t(a0)+,d2");
  553.         writeln(output, "\tcmp.b\t(a1)+,d2");
  554.         writeln(output, "\tseq\td2");
  555.         writeln(output, "\tand.b\td2,d0");
  556.         write(output, "\tdbra\td1,");
  557.         printlabel(lab);
  558.         writeln(output);
  559.         writeln(output, "\ttst.b\td0");
  560.         if operation = notequal1 then
  561.         writeln(output, "\tseq\td0");
  562.     end else begin
  563.         writeln(output, "\tmove.l\t(sp)+,d1");
  564.         if numbertype(lefttype) then begin
  565.         promotetype(lefttype, righttype, 1);
  566.         promotetype(righttype, lefttype, 0);
  567.         end;
  568.         writeln(output, "\tcmp.", suffix(idents[lefttype].size), "\td0,d1");
  569.         if operation = equal1 then
  570.         writeln(output, "\tseq\td0")
  571.         else if operation = notequal1 then
  572.         writeln(output, "\tsne\td0");
  573.     end;
  574.     lefttype := booltype;
  575.     end;
  576.     expreqop := lefttype;
  577. end;
  578.  
  579. function expression() : integer;
  580.  
  581. {
  582.     This is the main part of expression().  If there weren't
  583. any errors, the result of the expression will be in d0.
  584. }
  585.  
  586. var
  587.     lefttype : integer;
  588. begin
  589.     lefttype := simple();
  590.     if match(equal1) then
  591.     lefttype := expreqop(lefttype, equal1)
  592.     else if match(notequal1) then
  593.     lefttype := expreqop(lefttype, notequal1)
  594.     else if match(less1) then
  595.     lefttype := exprrelop(lefttype, less1)
  596.     else if match(greater1) then
  597.     lefttype := exprrelop(lefttype, greater1)
  598.     else if match(notless1) then
  599.     lefttype := exprrelop(lefttype, notless1)
  600.     else if match(notgreater1) then
  601.     lefttype := exprrelop(lefttype, notgreater1);
  602.     expression := lefttype;
  603. end;
  604.  
  605. function conexpr(var c : integer) : integer;
  606.     forward;
  607.  
  608. function conprimary(var contype : integer) : integer;
  609.  
  610. {
  611.     These routines are very similar to the other expression
  612. routines, but are much simpler.  They return the running value of
  613. the expression.  The type is returned in the reference parameter.
  614. This routine should handle type conversions and standard functions.
  615. }
  616.  
  617. var
  618.     result    : integer;
  619.     idindex    : integer;
  620. begin
  621.     if match(leftparent1) then begin
  622.     result := conexpr(contype);
  623.     needrightparent;
  624.     conprimary := result;
  625.     end else if currsym = numeral1 then begin
  626.     result := symloc;
  627.     nextsymbol;
  628.     contype := inttype;
  629.     conprimary := result;
  630.     end else if match(minus1) then begin
  631.     conprimary := -conprimary(contype);
  632.     end else if currsym = apostrophe1 then begin
  633.     contype := chartype;
  634.     result := ord(currentchar);
  635.     gch;
  636.     if currentchar <> chr(39) then begin
  637.         error("Only single character constants allowed.");
  638.         while (currentchar <> ';') and (currentchar <> chr(39)) and
  639.           (currentchar <> chr(10)) and (currentchar <> chr(0)) do
  640.         gch();
  641.     end;
  642.     gch;
  643.     nextsymbol;
  644.     conprimary := result;
  645.     end else if currsym = ident1 then begin
  646.     idindex := findid(symtext);
  647.     if idents[idindex].object = constant then begin
  648.         nextsymbol;
  649.         contype := idents[idindex].vtype;
  650.         conprimary := idents[idindex].offset;
  651.     end else begin
  652.         error("expecting a constant");
  653.         contype := inttype;
  654.         conprimary := 1;
  655.     end;
  656.     end else begin
  657.     error("unknown constant");
  658.     contype := inttype;
  659.     conprimary := 1;
  660.     end;
  661. end;
  662.  
  663. function confactor(var contype : integer) : integer;
  664.  
  665. {
  666.     This handles the second level of precedence for constant
  667. expressions.
  668. }
  669.  
  670. var
  671.     result, rightresult    : integer;
  672.     righttype    : integer;
  673. begin
  674.     result := conprimary(contype);
  675.     while (currsym = asterisk1) or (currsym = div1) do begin
  676.     if match(asterisk1) then begin
  677.         rightresult := conprimary(righttype);
  678.         if typecheck(contype, righttype) then
  679.         result := result * rightresult
  680.         else
  681.         mismatch;
  682.     end else if match(div1) then begin
  683.         rightresult := conprimary(righttype);
  684.         if typecheck(contype, righttype) then begin
  685.         if rightresult = 0 then begin
  686.             error("Division by zero");
  687.             rightresult := 1;
  688.         end;
  689.         result := result div rightresult;
  690.         end else
  691.         mismatch;
  692.     end;
  693.     end;
  694.     confactor := result;
  695. end;
  696.  
  697. function conexpr(var contype : integer) : integer;
  698.  
  699. {
  700.     This handles the other level of constant expressions, and
  701. is also the outermost level.
  702. }
  703.  
  704. var
  705.     result    : integer;
  706.     rightresult    : integer;
  707.     righttype    : integer;
  708. begin
  709.     result := confactor(contype);
  710.     while (currsym = minus1) or (currsym = plus1) do begin
  711.     if match(minus1) then begin
  712.         rightresult := confactor(righttype);
  713.         if typecheck(contype, righttype) then
  714.         result := result - rightresult
  715.         else
  716.         mismatch;
  717.     end else if match(plus1) then begin
  718.         rightresult := confactor(righttype);
  719.         if typecheck(contype, righttype) then
  720.         result := result + rightresult
  721.         else
  722.         mismatch;
  723.     end;
  724.     end;
  725.     conexpr := result;
  726. end;
  727.