1(* 	$Id: ConvertDecl.Mod,v 1.70 2005/12/26 10:56:55 mva Exp $	 *)
2MODULE OOC:C:ConvertDecl;
3(*  Translate Oberon-2 declarations to their C counterparts.
4    Copyright (C) 2001-2005  Michael van Acken
5
6    This file is part of OOC.
7
8    OOC is free software; you can redistribute it and/or modify it
9    under the terms of the GNU General Public License as published by
10    the Free Software Foundation; either version 2 of the License, or
11    (at your option) any later version.
12
13    OOC is distributed in the hope that it will be useful, but WITHOUT
14    ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
15    or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
16    License for more details.
17
18    You should have received a copy of the GNU General Public License
19    along with OOC. If not, write to the Free Software Foundation, 59
20    Temple Place - Suite 330, Boston, MA 02111-1307, USA.
21*)
22
23IMPORT
24  Object, Object:BigInt,
25  OOC:Repository, Sym := OOC:SymbolTable, OOC:SymbolTable:Predef,
26  TR := OOC:SymbolTable:TypeRules, OOC:C:Naming, OOC:C:DeclWriter;
27
28
29CONST
30  modeWriteExported = 0;
31  modeWritePrivate = 1;
32  modeWriteFctDef = 2;
33  modeFormalParameter = 3;
34
35
36PROCEDURE ^ ConvertDecl (w: DeclWriter.Writer;
37                         item: Sym.Declaration;
38                         mode: SHORTINT): DeclWriter.Declaration;
39
40PROCEDURE ConvertType* (w: DeclWriter.Writer;
41                        resolvedType, type: Sym.Type): DeclWriter.Type;
42(**Produces a C type declaration from an Oberon-2 type constructor.
43   @oparam{resolvedType} refers to the concrete type that is to be translated,
44   that is, the bare bones constructor that remains after all naming and
45   aliasing issues have been resolved.  @oparam{type} is the type reference
46   that appeared in the source code to identify the @oparam{resolvedType}.  It
47   is either equal to @oparam{resolvedType}, or a type name that is resolved to
48   @oparam{resolvedType}.
49
50   The object @oparam{w} is used to construct the type expression.  Result
51   is the C type expression corresponding to @oparam{type}.  *)
52  VAR
53    ptr: Sym.Item;
54    fct: DeclWriter.Function;
55    struct: DeclWriter.Struct;
56    trefClass: DeclWriter.TypeRefClass;
57    name: STRING;
58    baseType, srcCodeBaseType: Sym.Type;
59    dummy: LONGINT;
60
61  PROCEDURE ConvertParam (fct: DeclWriter.Function; param: Sym.VarDecl);
62    VAR
63      decl: DeclWriter.Declaration;
64
65    PROCEDURE AddArrayLength (type: Sym.Type; dim: LONGINT);
66    (* If `type' is an open array, add length arguments to the parameter list,
67       one for each open dimension.  *)
68      VAR
69        length: DeclWriter.Declaration;
70      BEGIN
71        type := type.Deparam();
72        IF (type IS Sym.Array) & type(Sym.Array). isOpenArray THEN
73          length := w. NewDeclaration (Naming.NameOfLengthParam (param, dim),
74                                       DeclWriter.tqNone,
75                                       DeclWriter.scAuto,
76                                       w. basicType[DeclWriter.lengthType]);
77          fct. AddParameter (length);
78
79          AddArrayLength (type(Sym.Array). elementType, dim+1)
80        END;
81      END AddArrayLength;
82
83    PROCEDURE AddTypeTag (param: Sym.VarDecl);
84      VAR
85        tag: DeclWriter.Declaration;
86      BEGIN
87        type := type.Deparam();
88        IF param. isVarParam & (param. type IS Sym.Record) THEN
89          tag := w. NewDeclaration (Naming.NameOfTypeTagParam (param),
90                                    DeclWriter.tqNone,
91                                    DeclWriter.scAuto,
92                                    w. basicType[DeclWriter.typeTagType]);
93          fct. AddParameter (tag);
94        END;
95      END AddTypeTag;
96
97    BEGIN
98      decl := ConvertDecl (w, param, modeFormalParameter);
99      fct. AddParameter (decl);
100      IF param. supplementArgs THEN
101        AddArrayLength (param. type, 0);
102        AddTypeTag (param);
103      END;
104    END ConvertParam;
105
106  PROCEDURE AddFields (struct: DeclWriter.Struct; type: Sym.Type): LONGINT;
107    VAR
108      offset, i: LONGINT;
109    BEGIN
110      IF (type = NIL) THEN
111        RETURN 0;
112      ELSE
113        type := type.Deparam();
114        offset := AddFields (struct, type(Sym.Record). baseType);
115        ptr := type(Sym.Record). nestedItems;
116        WHILE (ptr # NIL) DO
117          WITH ptr: Sym.FieldDecl DO
118            TR.AllocateType(ptr.type);
119            FOR i := offset TO ptr. offset-1 DO
120              struct. AddPadding (w, i);
121            END;
122            struct. AddMember (ConvertDecl (w, ptr, modeFormalParameter));
123            offset := ptr. offset+ptr. type. size;
124          ELSE                     (* ignore non-declarations *)
125          END;
126          ptr := ptr. nextNested;
127        END;
128
129        (* NOTE: this padding currently interferes with the initialization
130           of type descriptors for the .d files, and is therefore disabled
131        (* pad to end of record *)
132        FOR i := offset TO type. size-1 DO
133          struct. AddPadding (w, i);
134        END;
135        RETURN type. size;*)
136
137        RETURN offset;
138      END;
139    END AddFields;
140
141  BEGIN
142    IF (type = NIL) THEN
143      RETURN w. basicType[DeclWriter.void]
144    ELSE
145      WITH type: Sym.PredefType DO
146        CASE type. id OF
147        | Predef.boolean:
148          RETURN w. basicType[DeclWriter.char8]
149        | Predef.char:
150          RETURN w. basicType[DeclWriter.char8]
151        | Predef.longchar:
152          RETURN w. basicType[DeclWriter.char16]
153        | Predef.ucs4char:
154          RETURN w. basicType[DeclWriter.char32]
155        | Predef.shortint:
156          RETURN w. basicType[DeclWriter.int8]
157        | Predef.integer:
158          RETURN w. basicType[DeclWriter.int16]
159        | Predef.longint:
160          RETURN w. basicType[DeclWriter.int32]
161        | Predef.hugeint:
162          RETURN w. basicType[DeclWriter.int64]
163        | Predef.real:
164          RETURN w. basicType[DeclWriter.real32]
165        | Predef.longreal:
166          RETURN w. basicType[DeclWriter.real64]
167        | Predef.set:
168          RETURN w. basicType[DeclWriter.uint32]
169
170        | Predef.byte:
171          RETURN w. basicType[DeclWriter.char8]
172        | Predef.ptr:
173          RETURN w. basicType[DeclWriter.ptr]
174        END
175
176      | type: Sym.TypeName DO
177        IF (resolvedType IS Sym.QualType) THEN
178          (* avoid running into the default part below if the type name is
179             a parametric record type, or we may refer to the struct name
180             too early *)
181          resolvedType := resolvedType(Sym.QualType).baseType;
182        END;
183
184        WITH resolvedType: Sym.PredefType DO
185          RETURN ConvertType (w, resolvedType, resolvedType);
186        | resolvedType: Sym.Record DO
187          IF resolvedType.isUnion THEN
188            trefClass := DeclWriter.refUnion;
189          ELSE
190            trefClass := DeclWriter.refStruct;
191          END;
192          RETURN w. NewTypeRef (trefClass, Naming.NameOfType (resolvedType));
193        ELSE
194          RETURN w. NewTypeRef (DeclWriter.refTypedef,
195                                Naming.NameOfType (resolvedType));
196        END;
197
198      | type: Sym.Pointer DO
199        baseType := type. baseType;
200        srcCodeBaseType := type. srcCodeBaseType;
201        WHILE (baseType IS Sym.Array) DO
202          srcCodeBaseType := baseType(Sym.Array). srcCodeElementType;
203          baseType := baseType(Sym.Array). elementType;
204        END;
205        RETURN w. NewPointer (DeclWriter.tqNone,
206                              ConvertType (w, baseType, srcCodeBaseType));
207
208      | type: Sym.FormalPars DO
209        fct := w. NewFunction
210            (ConvertType (w, type. resultType, type. srcCodeResultType),
211             type. anyRestParameters);
212        fct.SetNoReturn(type.noReturn);
213        fct.SetCallConv(type.callConv);
214        ptr := type. nestedItems;
215        WHILE (ptr # NIL) DO
216          WITH ptr: Sym.VarDecl DO   (* this pics up receiver and params *)
217            ConvertParam (fct, ptr)
218          ELSE                     (* ignore non-declarations *)
219          END;
220          ptr := ptr. nextNested
221        END;
222
223        (* declarations differ for function declarations and the definition
224           of function types: the latter is a pointer type, the former is
225           not; for simplicity, always add the pointer on top of the function
226           definition, and remove it later where appropriate *)
227        RETURN w. NewPointer (DeclWriter.tqNone, fct);
228
229      | type: Sym.Array DO
230        IF type. isOpenArray THEN
231          RETURN w. NewArray (ConvertType (w, type. elementType, type. srcCodeElementType), -1)
232        ELSE
233          RETURN w. NewArray (ConvertType (w, type. elementType, type. srcCodeElementType), type. length)
234        END;
235
236      | type: Sym.Record DO
237        IF (type. namingDecl = NIL) THEN
238          name := NIL;
239        ELSE
240          name := Naming.NameOfDeclaration (type. namingDecl);
241        END;
242        struct := w. NewStruct (type. isUnion, name);
243        dummy := AddFields (struct, type);
244        RETURN struct;
245
246      | type: Sym.TypeVar DO
247        RETURN ConvertType(w, type.bound, type);
248
249      | type: Sym.QualType DO
250        RETURN ConvertType(w, type.baseType, type.srcCodeBaseType);
251      END
252    END
253  END ConvertType;
254
255PROCEDURE ConvertDecl (w: DeclWriter.Writer;
256                       item: Sym.Declaration;
257                       mode: SHORTINT): DeclWriter.Declaration;
258  VAR
259    sc: DeclWriter.StorageClass;
260    tq: DeclWriter.TypeQualifier;
261    name: STRING;
262    ctype: DeclWriter.Type;
263    fpars: DeclWriter.Type;
264  BEGIN
265    WITH item: Sym.ProcDecl DO
266      CASE mode OF
267      | modeWriteExported:
268        sc := DeclWriter.scExtern
269      | modeWritePrivate:
270        IF (item. parent IS Sym.ProcDecl) THEN
271          sc := DeclWriter.scForceAuto; (* prototype for nested function *)
272        ELSE
273          sc := DeclWriter.scStatic;
274        END;
275      | modeWriteFctDef:
276        IF (item. parent IS Sym.ProcDecl) THEN
277          sc := DeclWriter.scAuto; (* definition of nested function *)
278        ELSIF (item.exportMark=Sym.nameNotExported) & ~item.IsTypeBound() THEN
279          sc := DeclWriter.scStatic
280        ELSE
281          sc := DeclWriter.scAuto
282        END
283      END;
284      fpars := ConvertType (w, item. formalPars, item. formalPars);
285      fpars := fpars(DeclWriter.Pointer). base;
286
287      IF item.hasTryStatm THEN
288        fpars(DeclWriter.Function).MakeParametersVolatile;
289      END;
290      IF (mode # modeWriteExported) THEN
291        (* write NORETURN only in header file *)
292        fpars(DeclWriter.Function).SetNoReturn(FALSE);
293      END;
294
295      RETURN w. NewDeclaration
296        (Naming.NameOfDeclaration (item), DeclWriter.tqNone, sc, fpars);
297
298    | item: Sym.ConstDecl DO
299      RETURN w. NewDefine (Naming.NameOfDeclaration (item),
300                           item. value, item. type);
301
302    | item: Sym.VarDecl DO
303      tq := DeclWriter.tqNone;
304      IF item. isParameter THEN
305        sc := DeclWriter.scAuto;
306
307        IF ~item. isVarParam & item. isPassPerReference THEN
308          (* value parameter is converted into a reference: signal that
309             the dereferenced object is not modified by the procedure *)
310          tq := DeclWriter.tqConst;
311        END;
312      ELSE
313        IF (mode = modeWriteExported) THEN
314          sc := DeclWriter.scExtern
315        ELSIF (item. exportMark = Sym.nameNotExported) &
316              (item. parent IS Sym.Module) THEN
317          sc := DeclWriter.scStatic
318        ELSE
319          sc := DeclWriter.scAuto
320        END
321      END;
322
323      name := Naming.NameOfDeclaration (item);
324      ctype := ConvertType (w, item. type, item. srcCodeType);
325      IF (mode = modeFormalParameter) & item. isParameter THEN
326        IF ~item.isVarParam & item.isPassPerReference & item.hasLocalCopy THEN
327          (* for non-scalar values that are passed to a value parameter, the
328             name of the address passed from the caller is extended; this way,
329             it can be distinguished from the name of the local copy of the
330             value parameter *)
331          name := name. Concat (Object.NewLatin1(Naming.suffixPassPerRef))
332        END;
333
334        IF item. isPassPerReference & ~(item. type IS Sym.Array) THEN
335          (* for pass-by-reference arguments, turn the argument type into
336             a pointer; C arrays are already pointers, so we skip this for
337             array type *)
338          ctype := w. NewPointer (DeclWriter.tqNone, ctype);
339        END;
340      ELSIF (mode # modeWriteExported) &
341            (item.exportMark # Sym.nameNotExported) &
342            (item.type.namingDecl = NIL) THEN
343        (* for an exported record variable, we don't want to repeat the
344           struct definition in the .oh and the .d file; instead we use
345           typeof() to recycle the header's type in the variable definition *)
346        ctype := w.NewTypeOf(name);
347      END;
348
349      RETURN w. NewDeclaration (name, tq, sc, ctype)
350
351    | item: Sym.FieldDecl DO
352      RETURN w. NewDeclaration
353          (Naming.NameOfDeclaration (item),
354           DeclWriter.tqNone,
355           DeclWriter.scMember,
356           ConvertType (w, item. type, item. srcCodeType));
357
358    | item: Sym.TypeDecl DO
359      RETURN w. NewDeclaration (Naming.NameOfDeclaration (item),
360                                DeclWriter.tqNone,
361                                DeclWriter.scTypedef,
362                                ConvertType (w, item. type, item. srcCodeType))
363    END
364  END ConvertDecl;
365
366PROCEDURE ConvertSymTab* (w: DeclWriter.Writer; m: Repository.Module;
367                          symTab: Sym.Module; exports: Sym.Exports;
368                          writeExported: BOOLEAN);
369(**Translates all declarations of the module to C.  The C declarations are
370   emitted to the writer object @oparam{w}.  The parameter @oparam{m}
371   identifies the repository entry of the current module.
372
373   The procedure supports two different modes of operations: writing the public
374   interface of a module, and writing the complement to the public interface.
375   The set of emitted declarations is selected by @oparam{writeExported}.  With
376   @samp{@oparam{writeExported}=@code{TRUE}}, all items in @oparam{exports} are
377   written.  Otherwise, all items @emph{not} in @oparam{exports} are emitted.  *)
378  VAR
379    mode: SHORTINT;
380    fctType: DeclWriter.Function;
381
382  PROCEDURE ConvertTopLevel (root: Sym.Item; m: Repository.Module;
383                             mode: SHORTINT);
384    VAR
385      ptr: Sym.Item;
386      decl: DeclWriter.Declaration;
387
388    PROCEDURE ExportedVarDecl (ptr: Sym.Item): BOOLEAN;
389      BEGIN
390        WITH ptr: Sym.VarDecl DO
391          (* an exported variable appears both in the header file (as an
392             extern declaration) and in the data file (as a normal variable
393             declaration of storage class auto) *)
394          RETURN (ptr. exportMark # Sym.nameNotExported);
395        ELSE
396          RETURN FALSE;
397        END;
398      END ExportedVarDecl;
399
400    PROCEDURE AddTypeBoundHelpers (w: DeclWriter.Writer; proc: Sym.ProcDecl);
401      VAR
402        d: DeclWriter.Declaration;
403      BEGIN
404        d := w. NewDefine (Naming.NameOfTypeBoundIndex (proc),
405                           BigInt.NewInt(proc. tbProcIndex), NIL);
406        w. AddDeclaration (d);
407
408        d := w. NewDeclaration (Naming.NameOfTypeBoundSignature (proc),
409                                DeclWriter.tqNone,
410                                DeclWriter.scTypedef,
411                                ConvertType (w, proc. formalPars,
412                                             proc. formalPars));
413        w. AddDeclaration (d);
414      END AddTypeBoundHelpers;
415
416    BEGIN
417      ptr := root. nestedItems;
418      WHILE (ptr # NIL) DO
419        WITH ptr: Sym.Declaration DO
420          IF (exports. HasKey (ptr) = (mode = modeWriteExported)) OR
421             ExportedVarDecl (ptr) THEN
422            WITH ptr: Sym.Import DO
423              IF ~ptr. IsInternalImport() THEN
424                w. AddDeclaration(w.NewIncludeModule
425                                  (m.GetImportedModule(ptr.moduleName.str^)));
426              END;
427            ELSE
428              IF (ptr IS Sym.ProcDecl) & ptr(Sym.ProcDecl). isForwardDecl THEN
429                (* ignore forward declaration, or we get duplicates *)
430              ELSE
431                decl := ConvertDecl (w, ptr, mode);
432                IF (decl. name. CharAt(0) # "(") THEN
433                  (* Gross hack: If the declarations name doesn't look like a
434                     name, then omit it from the output.  This can (but
435                     probably shouldn't ;-) be used to define functions and
436                     variables that actually expand to expressions or macros.
437                     Introduced to allow "(float)sin" as function name in
438                     RealMath.Mod.  *)
439                  w. AddDeclaration (decl);
440                  IF (ptr IS Sym.ProcDecl) &
441                     ptr(Sym.ProcDecl).IsTypeBound() THEN
442                    AddTypeBoundHelpers (w, ptr(Sym.ProcDecl));
443                  END;
444                END;
445              END;
446            END;
447          END
448        ELSE                               (* ignore non-declarations *)
449        END;
450        ptr := ptr. nextNested
451      END
452    END ConvertTopLevel;
453
454  PROCEDURE ConvertNestedTypes (topLevel, root: Sym.Item);
455  (* Add C definitions for type declarations placed within procedures.
456     They need to be placed on the top level, because type declarations
457     are ignored when translating procedures.  *)
458    VAR
459      ptr: Sym.Item;
460      decl: DeclWriter.Declaration;
461    BEGIN
462      ptr := root. nestedItems;
463      WHILE (ptr # NIL) DO
464        WITH ptr: Sym.ProcDecl DO
465          ConvertNestedTypes (topLevel, ptr);
466        | ptr: Sym.TypeDecl DO
467          IF (root # topLevel) THEN
468            decl := ConvertDecl (w, ptr, mode);
469            w. AddDeclaration (decl);
470          END;
471        ELSE                             (* ignore everything else *)
472        END;
473        ptr := ptr. nextNested
474      END
475    END ConvertNestedTypes;
476
477  BEGIN
478    IF writeExported THEN
479      mode := modeWriteExported
480    ELSE
481      mode := modeWritePrivate
482    END;
483    ConvertTopLevel (symTab, m, mode);
484
485    IF writeExported THEN
486      fctType := w.NewFunction(w.basicType[DeclWriter.void], FALSE);
487      fctType.AddParameter(w.NewDeclaration("client", DeclWriter.tqNone,
488                                            DeclWriter.scAuto,
489                                            w.NewTypeRef(DeclWriter.refTypedef,
490                                                         "RT0__Module")));
491
492      w. AddDeclaration
493          (w. NewDeclaration
494           (Naming.NameOfModuleInit (symTab, TRUE, FALSE),
495            DeclWriter.tqNone,
496            DeclWriter.scExtern,
497            w. NewFunction (w. basicType[DeclWriter.void], FALSE)));
498      w. AddDeclaration
499          (w. NewDeclaration
500           (Naming.NameOfModuleInit (symTab, TRUE, TRUE),
501            DeclWriter.tqNone,
502            DeclWriter.scExtern,
503            fctType));
504      w. AddDeclaration
505          (w. NewDeclaration
506           (Naming.NameOfModuleInit (symTab, FALSE, FALSE),
507            DeclWriter.tqNone,
508            DeclWriter.scExtern,
509            w. NewFunction (w. basicType[DeclWriter.void], FALSE)));
510      w. AddDeclaration
511          (w. NewDeclaration
512           (Naming.NameOfModuleInit (symTab, FALSE, TRUE),
513            DeclWriter.tqNone,
514            DeclWriter.scExtern,
515            fctType));
516    ELSE
517      ConvertNestedTypes (symTab, symTab);
518    END;
519  END ConvertSymTab;
520
521PROCEDURE GetProc* (w: DeclWriter.Writer; procDecl: Sym.ProcDecl;
522                    nestedPrototype: BOOLEAN): DeclWriter.Declaration;
523(**Creates the header of a C function definition matching the procedure
524   declaration @oparam{procDecl}.  The declaration instance is created using
525   the factory methods of @oparam{w}.  *)
526  BEGIN
527    IF nestedPrototype THEN
528      RETURN ConvertDecl (w, procDecl, modeWritePrivate);
529    ELSE
530      RETURN ConvertDecl (w, procDecl, modeWriteFctDef);
531    END;
532  END GetProc;
533
534PROCEDURE GetDecl* (w: DeclWriter.Writer;
535                    decl: Sym.Declaration): DeclWriter.Declaration;
536(**Creates a C declaration for the object @oparam{decl}.  *)
537  BEGIN
538    RETURN ConvertDecl (w, decl, modeWriteFctDef)
539  END GetDecl;
540
541PROCEDURE GetTypeRef* (w: DeclWriter.Writer;
542                       type: Sym.Type): DeclWriter.Type;
543(**Creates a C type expression for the object @oparam{type}.  *)
544  BEGIN
545    IF (type. namingDecl # NIL) & ~(type IS Sym.PredefType) THEN
546      RETURN w. NewTypeRef (DeclWriter.refTypedef,
547                            Naming.NameOfType (type));
548    ELSE
549      RETURN ConvertType (w, type, type);
550    END;
551  END GetTypeRef;
552
553PROCEDURE GetPointerDecl* (w: DeclWriter.Writer;
554                           paramDecl: Sym.VarDecl): DeclWriter.Declaration;
555(**Produces a declaration that defines a pointer either to the element type of
556   @oparam{paramDecl} (if it is an array), or a pointer to the type of
557   @oparam{paramDecl} (otherwise).  *)
558  VAR
559    elemType: Sym.Type;
560  BEGIN
561    IF (paramDecl. type IS Sym.Array) THEN
562      elemType := paramDecl. type(Sym.Array). GetNonOpenElementType();
563    ELSE
564      elemType := paramDecl. type;
565    END;
566
567    RETURN w. NewDeclaration
568        (Naming.NameOfDeclaration (paramDecl),
569         DeclWriter.tqNone,
570         DeclWriter.scAuto,
571         w. NewPointer (DeclWriter.tqNone, GetTypeRef (w, elemType)));
572  END GetPointerDecl;
573
574END OOC:C:ConvertDecl.
575