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