home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 2 / RISC_DISC_2.iso / pd_share / program / language / oberon / potsrc / src / mod / cocy < prev    next >
Encoding:
Text File  |  1995-01-22  |  12.8 KB  |  402 lines
  1. MODULE COCY; (*DT 09 01 1993*)
  2.  (* Objects' declarations *)
  3.   IMPORT Strings, COCT, COCQ, COCN, COCJ, COCO;
  4.   
  5.   CONST
  6.    (*object modes*)
  7.     Var = 1; Ind = 3; Con = 8; Fld = 12; Typ = 13;
  8.     LProc = 14; XProc = 15; SProc = 16; CProc = 17; IProc = 18;
  9.  
  10.    (*structure forms*)
  11.     Undef = 0; Set = 9; String = 10; NoTyp = 12;
  12.     Pointer = 13; ProcTyp = 14; Array = 15; DynArr = 16; Record = 17;
  13.     
  14.    (*variable modes*)
  15.     Defi = 0; Refe = 1; Twin = 2; Decl = 3;
  16.  
  17.    (*modifiers*)
  18.     Extern = 0; Static = 1; Interrupt = 2; Typedef = 3;
  19.     
  20.   VAR
  21.     prevtyp: COCT.Struct;
  22.     prevmarked: BOOLEAN;
  23.  
  24.   PROCEDURE ContDecl;
  25.   BEGIN COCO.PutSeq(","); COCO.Separate
  26.   END ContDecl;
  27.  
  28.   PROCEDURE TermDecl;
  29.   BEGIN COCO.PutSeq(";"); COCO.Wrap
  30.   END TermDecl;
  31.   
  32.   PROCEDURE Modifier(m: INTEGER);
  33.   BEGIN 
  34.     CASE m OF Extern: COCO.PutSeq("extern")
  35.     | Static: COCO.PutSeq("static")
  36.     | Interrupt: COCO.PutSeq("pOt__interrupt")
  37.     | Typedef: COCO.PutSeq("typedef")
  38.     END;
  39.     COCO.Separate
  40.   END Modifier;
  41.   
  42.   PROCEDURE ^Type*(str: COCT.Struct; def: BOOLEAN);
  43.   PROCEDURE ^ParList(par: COCT.Object; fwd: BOOLEAN);
  44.  
  45.   PROCEDURE Obj(VAR x: COCT.Item);
  46.     VAR np: INTEGER; typ: COCT.Struct;
  47.   BEGIN typ := x.typ;
  48.     IF (typ.form = ProcTyp) & 
  49.       ((typ.strobj = x.obj) OR (typ.strobj = NIL)) THEN
  50.       COCQ.Prepend("(*", x.qoffs, np); COCQ.Append(")");
  51.       typ := typ.BaseTyp
  52.     END;
  53.     IF (typ.form = Pointer) &
  54.       ((typ.strobj = x.obj) OR (typ.strobj = NIL)) THEN 
  55.       COCQ.Prepend("*", x.qoffs, np); typ := typ.BaseTyp
  56.     END;
  57.     IF x.mode <= Ind THEN
  58.       IF typ = prevtyp THEN 
  59.         IF (x.mnolev = 0) & (x.obj.marked # prevmarked) THEN
  60.           TermDecl;
  61.           IF ~x.obj.marked THEN Modifier(Static) END;
  62.           Type(typ, FALSE);
  63.           prevmarked := x.obj.marked
  64.         ELSE ContDecl
  65.         END; 
  66.         COCQ.Release(x)
  67.       ELSE 
  68.         IF prevtyp # NIL THEN TermDecl END;
  69.         CASE x.intval OF 
  70.           Defi: 
  71.           IF (~COCT.IsParam(x.obj)) & (x.mnolev = 0) & (~x.obj.marked) THEN 
  72.             Modifier(Static) 
  73.           END
  74.         | Refe: Modifier(Static)
  75.         | Twin:
  76.         | Decl: Modifier(Extern)
  77.         END;
  78.         Type(typ, FALSE);
  79.         COCQ.Release(x); prevtyp := typ; prevmarked := x.obj.marked
  80.       END
  81.     ELSIF x.mode = Fld THEN
  82.       IF typ = prevtyp THEN ContDecl; COCQ.Release(x)
  83.       ELSE IF prevtyp # NIL THEN TermDecl END;
  84.         Type(typ, FALSE);
  85.         COCQ.Release(x); prevtyp := typ
  86.       END  
  87.     ELSE Type(typ, FALSE); COCQ.Release(x)
  88.     END;
  89.     IF (x.typ.form = ProcTyp) &
  90.       ((x.typ.strobj = x.obj) OR (x.typ.strobj = NIL))  THEN
  91.       ParList(x.typ.link, TRUE) 
  92.     END
  93.   END Obj;
  94.  
  95.   PROCEDURE ObjToItem*(obj: COCT.Object; VAR x: COCT.Item);
  96.   BEGIN x.mnolev := COCT.topScope.mnolev;
  97.     x.mode := obj.mode; x.obj := obj; x.typ := obj.typ;
  98.     x.intval := obj.intval; x.fltval := obj.fltval;
  99.     IF x.mode <= Ind THEN COCT.VarMode(x) END
  100.   END ObjToItem;
  101.  
  102.   PROCEDURE ConstObj*(c: COCT.Object; cmode: INTEGER);
  103.     VAR np: INTEGER; x: COCT.Item;
  104.   BEGIN ObjToItem(c, x); COCQ.Mark(x); COCN.CObjName(x, x.qoffs, np);
  105.     IF (x.typ = COCT.stringtyp) & (x.mnolev = 0) & x.obj.marked THEN
  106.       IF cmode = Decl THEN Modifier(Extern) END;
  107.       COCO.PutSeq("pOt__String"); COCO.Separate; COCQ.Release(x);
  108.       IF cmode = Defi THEN COCQ.Mark(x); COCJ.CConstValue(x, x.qoffs, np);
  109.         COCO.PutSeq("="); COCQ.Release(x)
  110.       END;
  111.       TermDecl
  112.     ELSE COCQ.Drop(x)  
  113.     END  
  114.   END ConstObj;
  115.         
  116.   PROCEDURE TypeObj*(t: COCT.Object);
  117.     VAR np: INTEGER; x: COCT.Item;
  118.   BEGIN ObjToItem(t, x);
  119.     COCQ.Mark(x); COCN.CObjName(x, x.qoffs, np);
  120.     Modifier(Typedef); Obj(x);
  121.     TermDecl
  122.   END TypeObj;
  123.  
  124.   PROCEDURE Struct*(typ: COCT.Struct);
  125.   BEGIN Type(typ, TRUE); TermDecl
  126.   END Struct;
  127.  
  128.   PROCEDURE StartVOList*;
  129.   BEGIN prevtyp := NIL; prevmarked := FALSE
  130.   END StartVOList;
  131.  
  132.   PROCEDURE VarObj*(v: COCT.Object; vmode: INTEGER);
  133.     VAR np: INTEGER; x: COCT.Item; 
  134.   BEGIN ObjToItem(v, x); x.intval := vmode;
  135.     COCQ.Mark(x); 
  136.     IF x.intval = Refe THEN 
  137.       INC(COCT.level); COCN.CObjName(x, x.qoffs, np); DEC(COCT.level)
  138.     ELSIF x.intval = Twin THEN 
  139.       DEC(COCT.level); COCN.CObjName(x, x.qoffs, np); INC(COCT.level)
  140.     ELSE COCN.CObjName(x, x.qoffs, np)
  141.     END;
  142.     IF x.mode = Ind THEN COCQ.Prepend("*", x.qoffs, np) END;
  143.     Obj(x)
  144.   END VarObj;
  145.  
  146.   PROCEDURE StopVOList*;
  147.   BEGIN IF prevtyp # NIL THEN TermDecl END; prevtyp := NIL
  148.   END StopVOList;
  149.   
  150.   PROCEDURE ProcObj*(p: COCT.Object; pmode: INTEGER);
  151.     VAR np: INTEGER; x: COCT.Item;
  152.   BEGIN ObjToItem(p, x); x.intval := pmode;
  153.     IF x.intval # Decl THEN DEC(x.mnolev) END;
  154.     COCQ.Mark(x);
  155.     COCN.CObjName(x, x.qoffs, np);
  156.     CASE x.mode OF 
  157.       LProc: Modifier(Static)
  158.     | XProc: Modifier(Extern)
  159.     | CProc:
  160.     | IProc: Modifier(Interrupt)
  161.     END;
  162.     Type(x.typ, FALSE); COCQ.Release(x);
  163.     ParList(x.obj.dsc, x.intval # Defi);
  164.     IF x.intval # Defi THEN TermDecl END
  165.   END ProcObj;
  166.  
  167.   PROCEDURE RetObj*(proc: COCT.Object);
  168.     VAR np: INTEGER; x: COCT.Item;
  169.   BEGIN COCQ.Mark(x); COCN.CRetName(x.qoffs, np);
  170.     Type(proc.typ, FALSE); COCQ.Release(x); TermDecl
  171.   END RetObj;
  172.  
  173.   PROCEDURE BodyObj*(obj: COCT.Object; pmode: INTEGER);
  174.     VAR np: INTEGER; x: COCT.Item;
  175.   BEGIN IF pmode = Decl THEN COCO.PutSeq("extern ") END;
  176.     COCO.PutSeq("void "); 
  177.     COCQ.Mark(x); COCN.CBodyName(obj, x.qoffs, np); COCQ.Release(x);
  178.     IF pmode = Defi THEN COCO.PutSeq("()"); COCO.Wrap
  179.     ELSE COCO.Separate; COCO.PutSeq("pOt__ARGS((void))"); TermDecl
  180.     END
  181.   END BodyObj;
  182.  
  183.   PROCEDURE StrTypeDef(str: COCT.Struct);
  184.     VAR s: ARRAY 9 OF CHAR; 
  185.       np: INTEGER; x: COCT.Item; fld: COCT.Object;
  186.   BEGIN 
  187.     COCO.PutSeq("{"); COCO.Wrap; COCO.Indent; 
  188.     CASE str.form OF 
  189.       Array:
  190.       CASE str.BaseTyp.form OF 
  191.         Undef .. Set: COCO.PutSeq("pOt__ArrTypDsc")
  192.       | Pointer, ProcTyp: COCO.PutSeq("pOt__PtrArrTypDsc")
  193.       | String .. NoTyp:
  194.       | Array, Record: COCO.PutSeq("pOt__StrArrTypDsc")
  195.       | DynArr:
  196.       END;
  197.       COCO.Separate; COCO.PutSeq("*td"); TermDecl;
  198.       x.mode := Fld; x.typ := str.BaseTyp;
  199.       COCQ.Mark(x); COCQ.Append("arr[0x");
  200.       Strings.FromLInt(str.n, 16, s); COCQ.Append(s); COCQ.Append("L]");
  201.       StartVOList; Obj(x); StopVOList
  202.     | Record:
  203.       IF str.BaseTyp = NIL THEN COCO.PutSeq("pOt__RecTypDsc *td")
  204.       ELSE Type(str.BaseTyp, FALSE); COCO.PutSeq("base")
  205.       END; TermDecl;
  206.       fld := str.link; 
  207.       IF fld # NIL THEN
  208.         StartVOList;
  209.         WHILE fld # NIL DO 
  210.           IF fld.name # "" THEN
  211.             VarObj(fld, Defi); fld := fld.next 
  212.           END
  213.         END;
  214.         StopVOList
  215.       END
  216.     END;
  217.     COCO.Undent; COCO.PutSeq("}") 
  218.   END StrTypeDef;
  219.  
  220.   PROCEDURE Type*(str: COCT.Struct; def: BOOLEAN);
  221.     VAR np: INTEGER; x: COCT.Item; 
  222.   BEGIN 
  223.     x.mnolev := -str.mno; 
  224.     x.mode := Typ; x.typ := str; x.obj := str.strobj;
  225.     COCQ.Mark(x);
  226.     IF str.form = NoTyp THEN
  227.       COCQ.Append("void"); COCQ.Release(x)
  228.     ELSIF str.form = DynArr THEN
  229.       IF str.BaseTyp = COCT.bytetyp THEN COCQ.Append("pOt__BytArr")
  230.       ELSE COCQ.Append("pOt__DynArr")
  231.       END;
  232.       COCQ.Release(x)
  233.     ELSIF str.form IN {Array, Record} THEN 
  234.       COCN.CTagName(str, x.qoffs, np); COCQ.Release(x);
  235.       IF def THEN COCO.Separate; StrTypeDef(str) END
  236.     ELSE
  237.       IF x.mnolev = 0 THEN COCT.FindObj(x.obj, x.mnolev) END;
  238.       IF str.form # Undef THEN COCN.CObjName(x, x.qoffs, np) END;
  239.       COCQ.Release(x)
  240.     END; 
  241.     COCO.Separate
  242.   END Type;
  243.       
  244.   PROCEDURE ParList(par: COCT.Object; fwd: BOOLEAN);
  245.     VAR np: INTEGER; x: COCT.Item; parorg, parend: COCT.Object;
  246.   BEGIN 
  247.     IF (par # NIL) & (par.mode <= Ind) & (par.intval = 1) THEN
  248.       IF fwd THEN COCO.Separate; COCO.PutSeq("pOt__ARGS((");
  249.         LOOP
  250.           ObjToItem(par, x); x.intval := Defi;
  251.           COCQ.Mark(x); IF x.mode = Ind THEN COCQ.Prepend("*", x.qoffs, np) END;
  252.           prevtyp := NIL; Obj(x); 
  253.           par := par.next;
  254.           IF (par = NIL) OR (par.mode > Ind) OR (par.intval = 0) THEN EXIT END;
  255.           ContDecl
  256.         END;
  257.         COCO.PutSeq("))")
  258.       ELSE parorg := par; 
  259.         COCO.Indent; COCO.PutPP("if pOt__ANSI_C");
  260.         COCO.PutSeq("(");
  261.         LOOP
  262.           ObjToItem(par, x); x.intval := Defi;
  263.           COCQ.Mark(x); COCN.CObjName(x, x.qoffs, np);
  264.           IF x.mode = Ind THEN COCQ.Prepend("*", x.qoffs, np) END;
  265.           prevtyp := NIL; Obj(x); 
  266.           par := par.next;
  267.           IF (par = NIL) OR (par.mode > Ind) OR (par.intval = 0) THEN 
  268.             parend := par; 
  269.             EXIT 
  270.           END;
  271.           ContDecl
  272.         END;
  273.         COCO.PutSeq(")");
  274.         COCO.PutPP("else");
  275.         COCO.PutSeq("(");
  276.         par := parorg;
  277.         LOOP
  278.           ObjToItem(par, x); COCQ.Mark(x); COCN.CObjName(x, x.qoffs, np); COCQ.Release(x);
  279.           par := par.next;
  280.           IF par = parend THEN EXIT END;
  281.           ContDecl
  282.         END; COCO.PutSeq(")"); 
  283.         COCO.Wrap; 
  284.         par := parorg; StartVOList;
  285.         REPEAT VarObj(par, Defi); par := par.next UNTIL par = parend;
  286.         StopVOList;
  287.         COCO.PutPP("endif"); COCO.Undent;
  288.       END
  289.     ELSE 
  290.       IF fwd THEN COCO.Separate; COCO.PutSeq("pOt__ARGS((void))")
  291.       ELSE COCO.PutSeq("()"); COCO.Wrap
  292.       END
  293.     END
  294.   END ParList;
  295.   
  296.   PROCEDURE GCNode*(nptr, nstr: INTEGER; firstvar: COCT.Object);
  297.     VAR obj: COCT.Object; s: ARRAY 9 OF CHAR;
  298.       x: COCT.Item; np: INTEGER;
  299.       dummyGC: BOOLEAN;
  300.     PROCEDURE Ptr(iptr: INTEGER);
  301.     BEGIN COCO.PutSeq("pOt__gc_ptrs.vars[0x");
  302.       Strings.FromLInt(iptr, 16, s); COCO.PutSeq(s);
  303.       COCO.PutSeq("]=")
  304.     END Ptr;
  305.  
  306.     PROCEDURE Str(istr: INTEGER);
  307.     BEGIN COCO.PutSeq("pOt__gc_strs.vars[0x");
  308.       Strings.FromLInt(istr, 16, s); COCO.PutSeq(s);
  309.       COCO.PutSeq("]=")
  310.     END Str;
  311.     
  312.   BEGIN
  313.     IF COCT.level = 0 THEN Modifier(Static);
  314.       COCO.PutSeq("struct {void *next, *vars[0x");
  315.       Strings.FromLInt(nptr+1, 16, s); COCO.PutSeq(s);
  316.       COCO.PutSeq("];} pOt__gc_ptrs = {pOt_NIL,{"); COCO.Wrap; 
  317.       COCO.Indent;
  318.       obj := firstvar;
  319.       WHILE (obj # NIL) & (obj.mode <= Typ) DO
  320.         IF (obj.mode = Var) & (obj.typ.form = Pointer) THEN
  321.           ObjToItem(obj, x);
  322.           IF x.mode = Var THEN COCO.PutSeq("&") END;
  323.           COCQ.Mark(x); COCN.CObjName(x, x.qoffs, np); COCQ.Release(x);
  324.           COCO.PutSeq(","); COCO.Wrap
  325.         END;
  326.         obj := obj.next
  327.       END;
  328.       COCO.PutSeq("pOt_NIL"); COCO.Wrap; 
  329.       COCO.Undent; 
  330.       COCO.PutSeq("}}"); TermDecl;
  331.   
  332.       Modifier(Static);
  333.       COCO.PutSeq("struct {void *next, *vars[0x");
  334.       Strings.FromLInt(nstr+1, 16, s); COCO.PutSeq(s);
  335.       COCO.PutSeq("];} pOt__gc_strs = {&pOt__gc_ptrs,{"); COCO.Wrap; 
  336.       COCO.Indent;
  337.       obj := firstvar;
  338.       WHILE (obj # NIL) & (obj.mode <= Typ) DO
  339.         IF (obj.mode = Var) & 
  340.           (obj.typ.form IN {Array .. Record}) &
  341.           COCT.HasPtr(obj.typ) THEN
  342.           ObjToItem(obj, x);
  343.           IF x.mode = Var THEN COCO.PutSeq("&") END;
  344.           COCQ.Mark(x); COCN.CObjName(x, x.qoffs, np); COCQ.Release(x);
  345.           COCO.PutSeq(","); COCO.Wrap
  346.         END;
  347.         obj := obj.next
  348.       END;
  349.       COCO.PutSeq("pOt_NIL"); COCO.Wrap; 
  350.       COCO.Undent; 
  351.       COCO.PutSeq("}}"); TermDecl
  352.     ELSE dummyGC := (nstr = 0) & (nptr = 0);
  353.       IF dummyGC THEN 
  354.         COCO.PutSeq("struct {void*next;} pOt__gc_ptrs"); TermDecl
  355.       ELSE  
  356.         COCO.PutSeq("struct {void *next, *vars[0x");
  357.         Strings.FromLInt(nptr+1, 16, s); COCO.PutSeq(s);
  358.         COCO.PutSeq("];} pOt__gc_ptrs"); TermDecl; 
  359.  
  360.         COCO.PutSeq("struct {void *next, *vars[0x");
  361.         Strings.FromLInt(nstr+1, 16, s); COCO.PutSeq(s);
  362.         COCO.PutSeq("];} pOt__gc_strs"); TermDecl
  363.       END;
  364.    
  365.       COCO.PutSeq("pOt__gc_ptrs.next = pOt__gc_root"); TermDecl;
  366.  
  367.       IF ~dummyGC THEN
  368.         COCO.PutSeq("pOt__gc_strs.next = &pOt__gc_ptrs"); TermDecl;
  369.    
  370.         Ptr(nptr); COCO.PutSeq("pOt_NIL"); TermDecl;
  371.         Str(nstr); COCO.PutSeq("pOt_NIL"); TermDecl;
  372.         
  373.         obj := firstvar;
  374.         WHILE (obj # NIL) & (obj.mode <= Typ) DO
  375.           IF obj.mode = Var THEN
  376.             ObjToItem(obj, x);
  377.             IF obj.typ.form = Pointer THEN DEC(nptr); 
  378.               Ptr(nptr); IF x.mode = Var THEN COCO.PutSeq("&") END;
  379.               COCQ.Mark(x); COCN.CObjName(x, x.qoffs, np); COCQ.Release(x);
  380.               TermDecl
  381.             ELSIF (obj.typ.form IN {Array .. Record}) & COCT.HasPtr(obj.typ) THEN DEC(nstr);
  382.               Str(nstr); IF x.mode = Var THEN COCO.PutSeq("&") END;
  383.               COCQ.Mark(x); COCN.CObjName(x, x.qoffs, np); COCQ.Release(x);
  384.               TermDecl
  385.             END
  386.           END;
  387.           obj := obj.next
  388.         END;
  389.         COCO.PutSeq("pOt__gc_root=(struct pOt__tag_gc_node*)&pOt__gc_strs"); 
  390.         TermDecl
  391.       END
  392.     END  
  393.   END GCNode;
  394.  
  395.   PROCEDURE GCLock*;
  396.   BEGIN COCO.PutSeq("int pOt__gc_enabled_prev"); TermDecl;
  397.     COCO.PutSeq("pOt__gc_enabled_prev=pOt__gc_enabled"); TermDecl;
  398.     COCO.PutSeq("pOt__gc_enabled=0"); TermDecl
  399.   END GCLock;
  400.     
  401. END COCY.
  402.