home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 2 / RISC_DISC_2.iso / pd_share / program / language / oberon / potsrc / src / mod / cocj < prev    next >
Encoding:
Text File  |  1995-01-22  |  8.4 KB  |  270 lines
  1. MODULE COCJ; (* DT 22 10 1993 00:06 *)
  2.   IMPORT SYSTEM, Strings, Reals, COCT, COCQ, COCN;
  3.  
  4.   CONST
  5.    (*object and item modes*)
  6.     Var   =  1; Ind   =  3; Con   =  8; Reg = 11;   Fld   = 12; 
  7.     Typ   = 13; LProc = 14; XProc = 15; SProc = 16; CProc = 17; 
  8.     IProc = 18; Mod   = 19; Head  = 20;    
  9.  
  10.    (*structure forms*)    
  11.     Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;    
  12.     Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11;
  13.     Pointer = 13; ProcTyp = 14; Array = 15; DynArr = 16; Record = 17;    
  14.  
  15.         RLen = 9;
  16.     LRLen = 17;
  17.  
  18.   PROCEDURE DeRef*(VAR x: COCT.Item);
  19.     VAR np: INTEGER;
  20.   BEGIN COCQ.Prepend("(*", x.qoffs, np); COCQ.Append(")")
  21.   END DeRef;
  22.  
  23.   PROCEDURE NilPtr*(VAR x: COCT.Item);
  24.     VAR np: INTEGER;
  25.   BEGIN COCQ.Prepend("((", x.qoffs, np);
  26.     COCN.CTDenoter(x.typ, np, np); 
  27.     COCQ.Prepend(")pOt__nilchk(__FILE__,__LINE__,", np, np);
  28.     COCQ.Append("))")
  29.   END NilPtr;   
  30.  
  31.   PROCEDURE InRef*(VAR x: COCT.Item);
  32.     VAR np: INTEGER;
  33.   BEGIN COCQ.Prepend("(&", x.qoffs, np); COCQ.Append(")")
  34.   END InRef;
  35.  
  36.   PROCEDURE Cast*(VAR x: COCT.Item);
  37.     VAR np: INTEGER;
  38.   BEGIN
  39.     COCQ.Prepend("((", x.qoffs, np);
  40.     COCN.CTDenoter(x.typ, np, np);
  41.     IF x.mode = Ind THEN COCQ.Prepend("*)(", np, np) 
  42.     ELSE COCQ.Prepend(")(", np, np) 
  43.     END;
  44.     COCQ.Append("))")
  45.   END Cast;
  46.  
  47.    (* array indexes *)
  48.   PROCEDURE ArrInxPfx*(VAR x: COCT.Item; inxchk: BOOLEAN);
  49.     VAR len: LONGINT;
  50.       s: ARRAY 9 OF CHAR; 
  51.   BEGIN COCQ.Append(".arr[");
  52.     IF inxchk THEN 
  53.       COCQ.Append("pOt__inxchk(__FILE__,__LINE__,0x"); 
  54.       Strings.FromLInt(x.typ.n, 16, s); COCQ.Append(s); 
  55.       COCQ.Append(", ")
  56.     ELSE 
  57.       COCQ.Append("(")
  58.     END
  59.   END ArrInxPfx;
  60.  
  61.   PROCEDURE ArrInxSfx*;
  62.   BEGIN COCQ.Append(")]") 
  63.   END ArrInxSfx;
  64.  
  65.   PROCEDURE DynArrInxPfx*(VAR x: COCT.Item; inxchk: BOOLEAN);
  66.     VAR np: INTEGER; s: ARRAY 9 OF CHAR; btyp: COCT.Struct; y: COCT.Item;
  67.   BEGIN
  68.     COCQ.Prepend("(", x.qoffs, np);
  69.     IF x.intval = 0 THEN COCQ.Prepend("(char *)", np, np) END;
  70.     COCQ.Append("+sizeof(pOt__ArrTypDsc*)+");
  71.     btyp := x.typ.BaseTyp;
  72.     IF btyp.form = DynArr THEN
  73.       COCQ.Append("(*(");
  74.       COCN.CObjName(x, COCQ.cslen, np);
  75.       IF x.intval # 0 THEN
  76.         COCQ.Append("+0x");
  77.         Strings.FromLInt(x.intval, 16, s);
  78.         COCQ.Append("L");
  79.         COCQ.Append(s)
  80.       END;
  81.       COCQ.Append("))->elsize")
  82.     ELSE COCN.CTSize(btyp, COCQ.cslen, np)
  83.     END;
  84.     IF inxchk THEN 
  85.       COCQ.Append("*pOt__inxchk(__FILE__,__LINE__,(*(");
  86.       COCN.CObjName(x, COCQ.cslen, np);
  87.       IF x.intval # 0 THEN
  88.         COCQ.Append("+0x");
  89.         Strings.FromLInt(x.intval, 16, s);
  90.         COCQ.Append(s)
  91.       END;
  92.       COCQ.Append("))->nofel,")
  93.     ELSE COCQ.Append("*(")
  94.     END         
  95.   END DynArrInxPfx;   
  96.  
  97.   PROCEDURE DynArrInxSfx*;
  98.   BEGIN COCQ.Append("))") 
  99.   END DynArrInxSfx;
  100.  
  101.   PROCEDURE BytArrInxPfx*(VAR x: COCT.Item; inxchk: BOOLEAN);
  102.     VAR np: INTEGER;
  103.   BEGIN
  104.     IF inxchk THEN 
  105.       COCQ.Append(".data[pOt__inxchk(__FILE__,__LINE__,"); 
  106.       COCN.CObjName(x, COCQ.cslen, np); 
  107.       COCQ.Append(".len,")
  108.     ELSE COCQ.Append(".data[(")
  109.     END
  110.   END BytArrInxPfx;
  111.  
  112.   PROCEDURE BytArrInxSfx*;
  113.   BEGIN
  114.     COCQ.Append(")")
  115.   END BytArrInxSfx;
  116.  
  117.   PROCEDURE Field*(VAR x: COCT.Item; y: COCT.Object);
  118.     VAR np, ix: INTEGER; z: COCT.Item;
  119.   BEGIN
  120.     COCQ.Append(".");
  121.     ix := y.mnolev; WHILE ix # x.typ.n DO COCQ.Append("base."); INC(ix) END;
  122.     z.mode := Fld; z.obj := y; z.mnolev := y.mnolev;
  123.     COCN.CObjName(z, COCQ.cslen, np)
  124.   END Field;
  125.  
  126.   PROCEDURE TypGuard*(VAR x, y: COCT.Item; typchk: BOOLEAN);
  127.     VAR np: INTEGER; s: ARRAY 9 OF CHAR;
  128.   BEGIN
  129.     COCQ.Prepend("((", x.qoffs, np);
  130.     COCN.CObjName(y, np, np);
  131.     IF x.typ.form = Record THEN COCQ.Prepend("*)", np, np)
  132.     ELSE COCQ.Prepend(")", np, np)
  133.     END;
  134.     IF typchk THEN 
  135.       COCQ.Prepend("pOt__typchk(__FILE__,__LINE__,(pOt__RecTypDsc**)", np, np);
  136.       COCQ.Append(",(pOt__RecTypDsc*)&");
  137.       IF y.typ.form = Record THEN COCN.CTDName(y.typ, COCQ.cslen, np)
  138.       ELSE (*Pointer*) COCN.CTDName(y.typ.BaseTyp, COCQ.cslen, np)
  139.       END;
  140.       COCQ.Append(",0x");
  141.       IF y.typ.form = Record THEN Strings.FromLInt(y.typ.n, 16, s)
  142.       ELSE (*Pointer*)  Strings.FromLInt(y.typ.BaseTyp.n, 16, s)
  143.       END;
  144.       COCQ.Append(s); COCQ.Append("L")
  145.     ELSE COCQ.Prepend("(", np, np);
  146.     END;
  147.     COCQ.Append("))")
  148.   END TypGuard;
  149.  
  150.  (* Constants *)
  151.                                           
  152.   PROCEDURE CConstValue*(VAR x: COCT.Item; pos: INTEGER; VAR nextpos: INTEGER);
  153.  
  154.     CONST CConstMaxLen = 127; (* enough *)
  155.     VAR CConstBuf: ARRAY CConstMaxLen + 1 OF CHAR; 
  156.  
  157.     PROCEDURE WriteChar(c: CHAR);
  158.       VAR i: INTEGER;
  159.     BEGIN
  160.       CConstBuf[0] := "'";
  161.       IF (c = "\") OR (c = "'") OR (c = 22X) THEN
  162.         CConstBuf[1] := "\"; CConstBuf[2] := c; i := 3
  163.       ELSIF (0X <= c) & (c <= 1FX) OR (7FX <= c) & (c <= 0FFX) THEN
  164.         CConstBuf[1] := "\"; CConstBuf[2] := 0X;
  165.         COCQ.Prepend(CConstBuf, nextpos, nextpos);
  166.         Strings.FromLInt(ORD(c), 8, CConstBuf); 
  167.         i := 0; WHILE CConstBuf[i] # 0X DO INC(i) END
  168.       ELSE 
  169.         CConstBuf[1] := c; i := 2
  170.       END;
  171.       CConstBuf[i] := "'"; CConstBuf[i+1] := 0X;
  172.       COCQ.Prepend(CConstBuf, nextpos, nextpos)
  173.     END WriteChar;
  174.  
  175.     PROCEDURE WriteLInt(form: INTEGER; li: LONGINT);
  176.     BEGIN
  177.       IF form = Bool THEN COCQ.Prepend("(pOt_BOOLEAN)", nextpos, nextpos) 
  178.       ELSIF form IN {Pointer, ProcTyp} THEN COCQ.Prepend("(void*)", nextpos, nextpos)
  179.       END;
  180.       IF li # MIN(LONGINT) THEN 
  181.         Strings.FromLInt(li, 10, CConstBuf);
  182.         COCQ.Prepend(CConstBuf, nextpos, nextpos);
  183.         IF form = LInt THEN COCQ.Prepend("L", nextpos, nextpos) END
  184.       ELSE COCQ.Prepend("(pOt_LONGINT)", nextpos, nextpos);
  185.         Strings.FromLInt(li, 16, CConstBuf);
  186.         COCQ.Prepend("0x", nextpos, nextpos);
  187.         COCQ.Prepend(CConstBuf, nextpos, nextpos);
  188.         COCQ.Prepend("L", nextpos, nextpos)
  189.       END  
  190.     END WriteLInt;
  191.  
  192.     PROCEDURE WriteLReal(form: INTEGER; lr: LONGREAL);
  193.       VAR expo: INTEGER;
  194.         mant: LONGINT;
  195.         i,len: INTEGER;
  196.     BEGIN
  197.             CASE form OF Real: len := RLen; COCQ.Prepend("(pOt_REAL)", nextpos, nextpos)
  198.             | LReal: len := LRLen
  199.             END;
  200.       IF lr # 0 THEN
  201.         i := 0;
  202.         IF lr < 0.0 THEN CConstBuf[i] := "-"; INC(i); lr := -lr END;
  203.         expo := 0;
  204.         IF lr > 1.0 THEN WHILE lr >= 10.0 DO lr := lr/10.0; INC(expo) END
  205.         ELSE WHILE lr < 1.0 DO lr := lr*10.0; DEC(expo) END
  206.         END;
  207.         mant := ENTIER(lr);
  208.         CConstBuf[i] := CHR(mant + ORD("0")); INC(i);
  209.         CConstBuf[i] := "."; INC(i);
  210.         WHILE i # len DO
  211.           lr := (lr - mant)*10.0;
  212.           mant := ENTIER(lr);
  213.           CConstBuf[i] := CHR(mant + ORD("0"));
  214.           INC(i)
  215.         END;
  216.         CConstBuf[i] := 0X;
  217.         COCQ.Prepend(CConstBuf, nextpos, nextpos);
  218.         IF expo # 0 THEN
  219.           Strings.FromLInt(expo, 10, CConstBuf);
  220.           COCQ.Prepend("E", nextpos, nextpos);
  221.           COCQ.Prepend(CConstBuf, nextpos, nextpos)
  222.         END;  
  223.       ELSE COCQ.Prepend("0.0", nextpos, nextpos)
  224.       END
  225.     END WriteLReal;
  226.  
  227.     PROCEDURE WriteSet(s: LONGINT);
  228.     BEGIN
  229.       COCQ.Prepend("(pOt_SET)0x", nextpos, nextpos);
  230.       Strings.FromLInt(s, 16, CConstBuf);
  231.       Strings.Append(CConstBuf, "L");
  232.       COCQ.Prepend(CConstBuf, nextpos, nextpos)
  233.     END WriteSet;
  234.       
  235.     PROCEDURE WriteString(inx: LONGINT);
  236.     BEGIN
  237.       COCQ.Prepend("&pOt__strcon_buf[0x", nextpos, nextpos);
  238.       Strings.FromLInt(inx-1, 16, CConstBuf);
  239.       COCQ.Prepend(CConstBuf, nextpos, nextpos);
  240.       COCQ.Prepend("L]", nextpos, nextpos)
  241.     END WriteString;
  242.       
  243.   BEGIN (* x.mode = Const *)
  244.     nextpos := pos;
  245.     CASE x.typ.form OF 
  246.     | Char: WriteChar(CHR(x.intval MOD 100H))
  247.     | Bool, SInt .. LInt, Pointer, ProcTyp: WriteLInt(x.typ.form, x.intval)
  248.     | Real, LReal: WriteLReal(x.typ.form, x.fltval)
  249.     | Set: WriteSet(x.intval)
  250.     | String: IF (x.intval DIV 100H) = 0 THEN COCN.CObjName(x, nextpos, nextpos) 
  251.       ELSE WriteString(x.intval DIV 100H)
  252.       END
  253.     | NilTyp: COCQ.Prepend("pOt_NIL", nextpos, nextpos)
  254.     END
  255.   END CConstValue;
  256.  
  257.   PROCEDURE SetStrTD*(VAR x: COCT.Item; typ: COCT.Struct);
  258.     VAR np: INTEGER; s: ARRAY 5 OF CHAR;
  259.   BEGIN
  260.     COCQ.Prepend("pOt__set_str_td(", x.qoffs, np); COCQ.Append(",&");
  261.     IF (typ # NIL) & (typ.form = Array) THEN COCN.CTDName(typ, COCQ.cslen, np)
  262.     ELSE  COCQ.Append("pOt__str_td[0x"); 
  263.       Strings.FromLInt(x.intval MOD 100H, 16, s); COCQ.Append(s);
  264.       COCQ.Append("]")
  265.     END;
  266.     COCQ.Append(")")
  267.   END SetStrTD;
  268.  
  269. END COCJ.
  270.