home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 2 / RISC_DISC_2.iso / pd_share / program / language / oberon / potsrc / src / mod / cocx < prev    next >
Encoding:
Text File  |  1995-01-27  |  12.3 KB  |  365 lines
  1. MODULE COCX; (* DVD 04 09 1993 01:55 *)
  2.  (* C eXpressions *)
  3.   IMPORT Strings, COCT, COCQ, COCN, COCJ;
  4.  
  5.   CONST
  6.    (*structure forms*)    
  7.     Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;    
  8.     Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;    
  9.     Pointer = 13; ProcTyp = 14; Array = 15; DynArr = 16; Record = 17;    
  10.  
  11.     intSet = {SInt .. LInt}; realSet = {Real .. LReal};
  12.     numSet = intSet + realSet;
  13.  
  14.  (* Expressions *)
  15.  
  16.   PROCEDURE SubExprPrefix*;
  17.   BEGIN COCQ.Append("(")
  18.   END SubExprPrefix;
  19.  
  20.   PROCEDURE SubExprSuffix*;
  21.   BEGIN COCQ.Append(")")
  22.   END SubExprSuffix;
  23.  
  24.   PROCEDURE Set00*(VAR x: COCT.Item; rngchk: BOOLEAN);
  25.     VAR np: INTEGER;
  26.   BEGIN COCQ.Prepend("((unsigned long)1<<", x.qoffs, np); 
  27.     IF rngchk THEN COCQ.Prepend("pOt__rngchk_se(__FILE__,__LINE__,", np, np)
  28.     ELSE COCQ.Prepend("(", np, np)
  29.     END;
  30.     COCQ.Append("))")
  31.   END Set00;
  32.  
  33.   PROCEDURE Set10*(VAR x: COCT.Item; rngchk: BOOLEAN); 
  34.    (*the name is spelled one-zero, not ten*)
  35.     VAR np: INTEGER; 
  36.   BEGIN COCQ.Prepend("((~(unsigned long)0<<", x.qoffs, np);
  37.     IF rngchk THEN COCQ.Prepend("pOt__rngchk_se(__FILE__,__LINE__,", np, np)
  38.     ELSE COCQ.Prepend("(", np, np)
  39.     END;
  40.     COCQ.Append("))&(~(~(unsigned long)1<<");
  41.     IF rngchk THEN COCQ.Append("pOt__rngchk_se(__FILE__,__LINE__,")
  42.     ELSE COCQ.Append("(")
  43.     END;
  44.   END Set10; 
  45.  
  46.   PROCEDURE Set11*(VAR x: COCT.Item; rngchk: BOOLEAN);
  47.   BEGIN COCQ.Append("))))")
  48.   END Set11;
  49.  
  50.   PROCEDURE InPfx*(VAR x: COCT.Item; rngchk: BOOLEAN);
  51.     VAR np: INTEGER;
  52.   BEGIN COCQ.Prepend("((unsigned long)0!=((unsigned long)1<<", x.qoffs, np); 
  53.     IF rngchk THEN COCQ.Prepend("pOt__rngchk_se(__FILE__,__LINE__,", np, np)
  54.     ELSE COCQ.Prepend("(", np, np)
  55.     END;                   
  56.     COCQ.Append(")&") (* set operations in Oberon and C have different priority, so they are always surrounded by parentheses *)
  57.   END InPfx;
  58.  
  59.   PROCEDURE InSfx*;
  60.   BEGIN COCQ.Append("))")
  61.   END InSfx;
  62.  
  63.   PROCEDURE TypTest*(VAR x,y: COCT.Item);
  64.     VAR np: INTEGER; s: ARRAY 9 OF CHAR;
  65.   BEGIN COCQ.Prepend("pOt__typtest((pOt__RecTypDsc**)", x.qoffs, np);
  66.     COCQ.Append(",(pOt__RecTypDsc*)&");
  67.     IF y.typ.form = Record THEN COCN.CTDName(y.typ, COCQ.cslen, np)
  68.     ELSE (*Pointer*) COCN.CTDName(y.typ.BaseTyp, COCQ.cslen, np)
  69.     END;
  70.     COCQ.Append(",0x");
  71.     IF y.typ.form = Record THEN Strings.FromLInt(y.typ.n, 16, s)
  72.     ELSE (*Pointer*)  Strings.FromLInt(y.typ.BaseTyp.n, 16, s)
  73.     END;
  74.     COCQ.Append(s); COCQ.Append("L)")
  75.   END TypTest;
  76.  
  77.   PROCEDURE MOp*(op: INTEGER; VAR x: COCT.Item; rngchk: BOOLEAN);
  78.     VAR np: INTEGER; f: INTEGER;
  79.   BEGIN f := x.typ.form;
  80.     CASE op OF
  81.       6  (*+*): 
  82.     | 7  (*-*): 
  83.       IF f IN numSet THEN COCQ.Prepend("-", x.qoffs, np)
  84.       ELSIF f = Set THEN COCQ.Prepend("~", x.qoffs, np) 
  85.       END
  86.     | 32 (*~*): COCQ.Prepend("!", x.qoffs, np)
  87.     END
  88.   END MOp;
  89.  
  90.   PROCEDURE NumOp*(op:INTEGER; convert:SET; VAR x,y:COCT.Item; rngchk:BOOLEAN);
  91.     VAR np: INTEGER; s: ARRAY 4 OF CHAR;
  92.     
  93.     PROCEDURE CastX;
  94.     BEGIN 
  95.       COCQ.Prepend("))", y.qoffs, np); 
  96.       COCQ.Prepend("((", x.qoffs, np); 
  97.       COCN.CTDenoter(x.typ, np, np); 
  98.       COCQ.Prepend(")(", np, np)
  99.     END CastX;
  100.   
  101.   BEGIN
  102.     IF rngchk & (x.typ.form IN intSet) & (op # 2) THEN
  103.       Strings.FromLInt(x.typ.form,10,s);
  104.       COCQ.Append("),"); COCQ.Append(s); COCQ.Append(")");
  105.       COCQ.Prepend("),(pOt_LONGINT)(", y.qoffs, np);
  106.       COCQ.Prepend("chk(__FILE__,__LINE__,(pOt_LONGINT)(", x.qoffs, np);
  107.       CASE op OF 1 (***): COCQ.Prepend("mul", x.qoffs, np)
  108.       | 3 (*DIV*): COCQ.Prepend("div", x.qoffs, np)
  109.       | 4 (*MOD*): COCQ.Prepend("mod", x.qoffs, np)
  110.       | 6 (*+*): COCQ.Prepend("add", x.qoffs, np)
  111.       | 7 (*-*): COCQ.Prepend("sub", x.qoffs, np)
  112.       END;
  113.       COCQ.Prepend("(", x.qoffs, np);
  114.       COCN.CTDenoter(x.typ, np, np); 
  115.       COCQ.Prepend(")pOt__", np, np)
  116.     ELSE
  117.       IF 1 IN convert THEN COCJ.Cast(y) END;
  118.       CASE op OF 1 (***): 
  119.         COCQ.Prepend("*", y.qoffs, np);
  120.         IF 0 IN convert THEN CastX END
  121.       | 2 (*/*):
  122.         COCQ.Prepend("/", y.qoffs, np);
  123.         IF 0 IN convert THEN CastX END
  124.       | 3 (*DIV*):
  125.         COCQ.Prepend(",", y.qoffs, np); COCQ.Append(")");
  126.         IF 0 IN convert THEN CastX END;
  127.         COCQ.Prepend("(", x.qoffs, np);
  128.         COCN.CTDenoter(x.typ, np, np); 
  129.         COCQ.Prepend(")pOt__div(", np, np)
  130.       | 4 (*MOD*):
  131.         COCQ.Prepend(",", y.qoffs, np); COCQ.Append(")");
  132.         IF 0 IN convert THEN CastX END;
  133.         COCQ.Prepend("(", x.qoffs, np);
  134.         COCN.CTDenoter(x.typ, np, np); 
  135.         COCQ.Prepend(")pOt__mod(", np, np)
  136.       | 6 (*+*):
  137.         COCQ.Prepend("+", y.qoffs, np);
  138.         IF 0 IN convert THEN CastX END
  139.       | 7 (*-*):
  140.         COCQ.Prepend("-", y.qoffs, np);
  141.         IF 0 IN convert THEN CastX END
  142.       END
  143.     END
  144.   END NumOp;
  145.  
  146.   PROCEDURE SetOp*(op: INTEGER; VAR x, y: COCT.Item);
  147.     VAR np: INTEGER;
  148.   BEGIN
  149.     CASE op OF 
  150.       1 (***): COCQ.Prepend("&", y.qoffs, np) 
  151.     | 2 (*/*): COCQ.Prepend("^", y.qoffs, np) 
  152.     | 6 (*+*): COCQ.Prepend("|", y.qoffs, np) 
  153.     | 7 (*-*): COCQ.Prepend("&~", y.qoffs, np) 
  154.     END;
  155.     COCQ.Prepend("(", x.qoffs, np); COCQ.Append(")")
  156.   END SetOp;
  157.  
  158.   PROCEDURE BoolOp*(op: INTEGER; VAR x, y: COCT.Item);
  159.     VAR np: INTEGER;
  160.   BEGIN
  161.     CASE op OF
  162.       5 (*&*): COCQ.Prepend("&&", y.qoffs, np)
  163.     | 8 (*OR*): COCQ.Prepend("||", y.qoffs, np)
  164.     END;
  165.     COCQ.Prepend("(", x.qoffs, np); COCQ.Append(")")
  166.   END BoolOp;
  167.  
  168.   PROCEDURE NumRel*(op: INTEGER; convert: SET; VAR x, y: COCT.Item);
  169.     VAR np: INTEGER;
  170.  
  171.     PROCEDURE CastX;
  172.     BEGIN 
  173.       COCQ.Prepend("))", y.qoffs, np); 
  174.       COCQ.Prepend("((", x.qoffs, np); 
  175.       COCN.CTDenoter(x.typ, np, np); 
  176.       COCQ.Prepend(")(", np, np)
  177.     END CastX;
  178.   
  179.   BEGIN
  180.     IF 1 IN convert THEN COCJ.Cast(y) END;
  181.     CASE op OF
  182.       9 (*=*): COCQ.Prepend("==", y.qoffs, np)
  183.     | 10 (*#*): COCQ.Prepend("!=", y.qoffs, np)
  184.     | 11 (*<*): COCQ.Prepend("<", y.qoffs, np)
  185.     | 12 (*<=*): COCQ.Prepend("<=", y.qoffs, np)
  186.     | 13 (*>*): COCQ.Prepend(">", y.qoffs, np)
  187.     | 14 (*>=*): COCQ.Prepend(">=", y.qoffs, np)
  188.     END;
  189.     IF 0 IN convert THEN CastX END;
  190.     COCQ.Prepend("(", x.qoffs, np); COCQ.Append(")")
  191.   END NumRel;
  192.   
  193.   PROCEDURE StrRel*(op: INTEGER; VAR x, y: COCT.Item);
  194.     VAR np: INTEGER; s: ARRAY 9 OF CHAR;
  195.   BEGIN
  196.     s[0] := "s"; s[1] := "s"; s[2] := 0X;
  197.     COCQ.Prepend(",", y.qoffs, np);
  198.     IF y.typ.form = Char THEN s[1] := "c"
  199.     ELSE
  200.       IF y.typ.form # String THEN COCQ.Prepend("(pOt_CHAR*)&", np, np) END;
  201.       IF x.typ.form = Char THEN s[0] := "c"
  202.       ELSIF x.typ.form # String THEN COCQ.Prepend("(pOt_CHAR*)&", x.qoffs, np) 
  203.       END
  204.     END;
  205.     COCQ.Prepend("pOt__cmp", x.qoffs, np);
  206.     COCQ.Prepend(s, np, np); COCQ.Prepend("(", np, np);
  207.     COCQ.Append(",0x"); Strings.FromLInt(LONG(op), 16, s);
  208.     COCQ.Append(s); COCQ.Append(")")
  209.   END StrRel;
  210.  
  211.   PROCEDURE CharRel*(op: INTEGER; VAR x, y: COCT.Item);
  212.     VAR np: INTEGER;
  213.   BEGIN
  214.     COCQ.Prepend("(unsigned char)", y.qoffs, np);
  215.     CASE op OF
  216.       9 (*=*): COCQ.Prepend("==", y.qoffs, np)
  217.     | 10 (*#*): COCQ.Prepend("!=", y.qoffs, np)
  218.     | 11 (*<*): COCQ.Prepend("<", y.qoffs, np)
  219.     | 12 (*<=*): COCQ.Prepend("<=", y.qoffs, np)
  220.     | 13 (*>*): COCQ.Prepend(">", y.qoffs, np)
  221.     | 14 (*>=*): COCQ.Prepend(">=", y.qoffs, np)
  222.     END;
  223.     COCQ.Prepend("((unsigned char)", x.qoffs, np); COCQ.Append(")")
  224.   END CharRel;
  225.  
  226.   PROCEDURE StProcPfx*(fctno: INTEGER; rngchk: BOOLEAN);
  227.   BEGIN
  228.     CASE fctno OF 0 (*HALT*): COCQ.Append("pOt__halt(__FILE__,__LINE__,")
  229.     | 1  (*NEW*): COCQ.Append("pOt__new(__FILE__,__LINE__,(pOt__TypDsc***)&")
  230.     | 2  (*CC*): COCQ.Append("(") (* not imp. *)
  231.     | 3  (*ABS*):
  232.     | 4  (*CAP*): COCQ.Append("pOt__cap((unsigned char)")
  233.     | 5  (*ORD*): COCQ.Append("(pOt_INTEGER)((unsigned char)")
  234.     | 6  (*ENTIER*): 
  235.       IF rngchk THEN COCQ.Append("pOt__rngchk_li(__FILE__,__LINE__,") 
  236.       ELSE COCQ.Append("pOt__entier(") 
  237.       END
  238.     | 7  (*SIZE*): COCQ.Append("(pOt_LONGINT)(sizeof(")
  239.     | 8  (*ODD*): COCQ.Append("(pOt_BOOLEAN)(0x1&(")
  240.     | 9  (*ADR*): COCQ.Append("((pOt_LONGINT)&")
  241.     | 10,11 (*MIN,MAX*): 
  242.     | 12 (*CHR*): COCQ.Append("(pOt_CHAR)");
  243.       IF rngchk THEN COCQ.Append("pOt__rngchk_cn(__FILE__,__LINE__,") END;
  244.       COCQ.Append("(unsigned char)(")         
  245.     | 13,14 (*SHORT LONG*): 
  246.     | 15 (*OVFL*): COCQ.Append("(")
  247.     | 16, 17, 18, 19 (*INC DEC INCL EXCL*):
  248.     | 20 (*LEN*): COCQ.Append("(*((pOt__ArrTypDsc**)&")
  249.     | 21 (*ASH*): COCQ.Append("pOt__ash(")
  250.     | 22 (*LSH*): COCQ.Append("pOt__lsh(")
  251.     | 23 (*ROT*): COCQ.Append("pOt__rot(")
  252.     | 24 (*GET*): COCQ.Append("pOt__get((pOt_BYTE_SYSTEM*)")
  253.     | 25 (*PUT*): COCQ.Append("pOt__put((pOt_BYTE_SYSTEM*)")
  254.     | 26 (*BIT*): COCQ.Append("(*(pOt_BYTE_SYSTEM *)(")
  255.     | 27 (*VAL*): 
  256.     | 28 (*SYSTEM.NEW*):
  257.     | 29 (*COPY*):
  258.       IF rngchk THEN COCQ.Append("pOt__copychk(__FILE__,__LINE__,(pOt_CHAR*)&")
  259.       ELSE COCQ.Append("pOt__copy((pOt_CHAR*)&")
  260.       END
  261.     | 30 (*MOVE*): COCQ.Append("pOt__move((pOt_BYTE_SYSTEM*)")
  262.     END
  263.   END StProcPfx;
  264.  
  265.   PROCEDURE StPar1Sfx*(VAR x:COCT.Item; fctno: INTEGER; rngchk: BOOLEAN);
  266.     VAR np: INTEGER;
  267.   BEGIN
  268.     CASE fctno OF 0 (*HALT*):
  269.     | 1  (*NEW*): COCQ.Append(",(pOt__TypDsc*)&"); COCN.CTDName(x.typ,COCQ.cslen,np)
  270.     | 2  (*CC*): 
  271.     | 3  (*ABS*): 
  272.       COCQ.Prepend("(", x.qoffs, np);
  273.       COCN.CTDenoter(x.typ, np, np);
  274.       IF x.typ.form IN intSet THEN COCQ.Prepend(")pOt__abs(", np, np)
  275.       ELSIF x.typ.form IN realSet THEN COCQ.Prepend(")pOt__fabs(", np, np)
  276.       END
  277.     | 4 .. 6 (*CAP ORD ENTIER*): 
  278.     | 7 (*SIZE*): 
  279.       IF x.typ.form IN {Array, DynArr, Record} THEN
  280.         COCQ.Append(")-sizeof(pOt__TypDsc*)")
  281.       ELSE COCQ.Append(")")
  282.       END
  283.     | 8  (*ODD*): COCQ.Append(")")
  284.     | 9  (*ADR*): 
  285.       IF x.typ.form IN {Array, DynArr, Record} THEN 
  286.         COCQ.Append("+sizeof(pOt__TypDsc*)") 
  287.       END
  288.     | 10,11 (*MIN,MAX*): 
  289.     | 12 (*CHR*): IF rngchk THEN COCQ.Append(")") END
  290.     | 13 (*SHORT*): 
  291.       COCQ.Prepend("(",x.qoffs,np); 
  292.       COCN.CTDenoter(x.typ,np,np); 
  293.       COCQ.Prepend(")",np,np);
  294.       IF rngchk THEN COCQ.Prepend("pOt__rngchk_",np,np);
  295.         CASE x.typ.form OF Int: COCQ.Prepend("si",np,np)
  296.         | LInt: COCQ.Prepend("i",np,np)
  297.         | LReal: COCQ.Prepend("r",np,np)
  298.         END;
  299.         COCQ.Prepend("(__FILE__,__LINE__,",np,np)
  300.       ELSE COCQ.Prepend("(",np,np)
  301.       END
  302.     | 14 (*LONG*): 
  303.       COCQ.Prepend("(",x.qoffs,np); 
  304.       COCN.CTDenoter(x.typ,np,np); 
  305.       COCQ.Prepend(")(",np,np);
  306.     | 15 (*OVFL*):
  307.     | 16 (*INC*): COCQ.Append("+=(");
  308.     | 17 (*DEC*): COCQ.Append("-=(");
  309.     | 18 (*INCL*): COCQ.Append("|=((unsigned long)1<<(");
  310.     | 19 (*EXCL*): COCQ.Append("&=~((unsigned long)1<<(")
  311.     | 20 (*LEN*): COCQ.Append("+")
  312.     | 21, 22 (*ASH,LSH*): COCQ.Append(",")
  313.     | 23 (*ROT*): COCQ.Append(","); COCN.CTSize(x.typ,COCQ.cslen,np); COCQ.Append("*8,");
  314.     | 24,25 (*GET PUT*): COCQ.Append(",(pOt_BYTE_SYSTEM*)&")
  315.     | 26 (*BIT*): COCQ.Append(")&");
  316.       IF rngchk THEN COCQ.Append("pOt__rngchk_cn(__FILE__,__LINE__,1<<(")
  317.       ELSE COCQ.Append("(1<<(")
  318.       END
  319.     | 27 (*VAL*): COCQ.Prepend("((",x.qoffs,np); COCN.CTDenoter(x.typ,np,np);
  320.       COCQ.Prepend(")(",np,np); COCQ.Append(")")
  321.     | 28 (*SYSTEM.NEW*): COCQ.Append("=("); COCN.CTDenoter(x.typ,COCQ.cslen,np);
  322.       COCQ.Append(")pOt__alloc(__FILE__,__LINE__,");
  323.     | 29 (*COPY*): COCQ.Append(",(pOt_CHAR*)&")
  324.     | 30 (*MOVE*): COCQ.Append(",(pOt_BYTE_SYSTEM*)")
  325.     END
  326.   END StPar1Sfx;
  327.  
  328.   PROCEDURE StPar2Sfx*(VAR x:COCT.Item; fctno: INTEGER; rngchk: BOOLEAN);
  329.     VAR np: INTEGER;
  330.   BEGIN
  331.     CASE fctno OF 16, 17 (*INC DEC*):
  332.     | 18, 19 (*INCL EXCL*): COCQ.Append(")")
  333.     | 20 .. 23 (*LEN ASH LSH ROT*):
  334.     | 24, 25 (*GET PUT*): COCQ.Append(","); COCN.CTSize(x.typ,COCQ.cslen,np)
  335.     | 26 (*BIT*): COCQ.Append("))")
  336.     | 27, 28, 29 (*VAL SYSTEM.NEW COPY*):
  337.     | 30 (*MOVE*): COCQ.Append(",")
  338.     END
  339.   END StPar2Sfx;
  340.  
  341.   PROCEDURE StPar3Sfx*(VAR x: COCT.Item; fctno: INTEGER; rngchk: BOOLEAN);
  342.     VAR np: INTEGER;
  343.   BEGIN 
  344.     CASE fctno OF 30:
  345.     END
  346.   END StPar3Sfx;
  347.  
  348.   PROCEDURE StFakeSfx*(fctno: INTEGER; rngchk: BOOLEAN);
  349.   BEGIN 
  350.     CASE fctno OF 16,17 (*INC DEC*): COCQ.Append("1")
  351.     | 20 (*LEN*): COCQ.Append("0")
  352.     END
  353.   END StFakeSfx;
  354.  
  355.   PROCEDURE StFctSfx*(fctno:INTEGER; rngchk:BOOLEAN);
  356.   BEGIN 
  357.     IF (fctno = 10) OR (fctno = 11) THEN (*nothing*)
  358.     ELSIF fctno = 20 THEN COCQ.Append("))->nofel")
  359.     ELSE COCQ.Append(")")
  360.     END
  361.   END StFctSfx;
  362.  
  363. END COCX.
  364.  
  365.