source: src/Validate/Autogen.cpp @ 91715ce1

ADTast-experimentalpthread-emulationqualifiedEnum
Last change on this file since 91715ce1 was 91715ce1, checked in by Thierry Delisle <tdelisle@…>, 21 months ago

Don't autogen for struct with flexible array members
fixes #261?

  • Property mode set to 100644
File size: 27.1 KB
RevLine 
[a488783]1//
2// Cforall Version 1.0.0 Copyright (C) 2015 University of Waterloo
3//
4// The contents of this file are covered under the licence agreement in the
5// file "LICENCE" distributed with Cforall.
6//
7// Autogen.cpp -- Generate automatic routines for data types.
8//
9// Author           : Andrew Beach
10// Created On       : Thu Dec  2 13:44:00 2021
11// Last Modified By : Andrew Beach
[00a8e19]12// Last Modified On : Thr Jan 27  9:29:00 2022
13// Update Count     : 1
[a488783]14//
15
16#include "Autogen.hpp"
17
18#include <algorithm>               // for count_if
19#include <cassert>                 // for strict_dynamic_cast, assert, assertf
20#include <iterator>                // for back_insert_iterator, back_inserter
21#include <list>                    // for list, _List_iterator, list<>::iter...
22#include <set>                     // for set, _Rb_tree_const_iterator
23#include <utility>                 // for pair
24#include <vector>                  // for vector
25
26#include "AST/Attribute.hpp"
27#include "AST/Decl.hpp"
28#include "AST/DeclReplacer.hpp"
29#include "AST/Expr.hpp"
[91715ce1]30#include "AST/Inspect.hpp"
[a488783]31#include "AST/Pass.hpp"
32#include "AST/Stmt.hpp"
33#include "AST/SymbolTable.hpp"
34#include "CodeGen/OperatorTable.h" // for isCtorDtor, isCtorDtorAssign
35#include "Common/ScopedMap.h"      // for ScopedMap<>::const_iterator, Scope...
36#include "Common/utility.h"        // for cloneAll, operator+
37#include "GenPoly/ScopedSet.h"     // for ScopedSet, ScopedSet<>::iterator
38#include "InitTweak/GenInit.h"     // for fixReturnStatements
[00a8e19]39#include "InitTweak/InitTweak.h"   // for isAssignment, isCopyConstructor
[a488783]40#include "SymTab/Mangler.h"        // for Mangler
41#include "CompilationState.h"
42
43// TODO: The other new ast function should be moved over to this file.
44#include "SymTab/Autogen.h"
45
46namespace Validate {
47
48namespace {
49
50// --------------------------------------------------------------------------
51struct AutogenerateRoutines_new final :
52                public ast::WithDeclsToAdd<>,
53                public ast::WithShortCircuiting {
54        void previsit( const ast::EnumDecl * enumDecl );
55        void previsit( const ast::StructDecl * structDecl );
56        void previsit( const ast::UnionDecl * structDecl );
57        void previsit( const ast::TypeDecl * typeDecl );
58        void previsit( const ast::TraitDecl * traitDecl );
59        void previsit( const ast::FunctionDecl * functionDecl );
60        void postvisit( const ast::FunctionDecl * functionDecl );
61
62private:
63        // Current level of nested functions.
64        unsigned int functionNesting = 0;
65};
66
67// --------------------------------------------------------------------------
68/// Class used to generate functions for a particular declaration.
69/// Note it isn't really stored, it is just a class for organization and to
70/// help pass around some of the common arguments.
71class FuncGenerator {
72public:
73        std::list<ast::ptr<ast::Decl>> forwards;
74        std::list<ast::ptr<ast::Decl>> definitions;
75
76        FuncGenerator( const ast::Type * type, unsigned int functionNesting ) :
77                type( type ), functionNesting( functionNesting )
78        {}
79
80        /// Generate functions (and forward decls.) and append them to the list.
81        void generateAndAppendFunctions( std::list<ast::ptr<ast::Decl>> & );
82
83        virtual bool shouldAutogen() const = 0;
84protected:
85        const ast::Type * type;
86        unsigned int functionNesting;
87        ast::Linkage::Spec proto_linkage = ast::Linkage::AutoGen;
88
89        // Internal helpers:
90        void genStandardFuncs();
91        void produceDecl( const ast::FunctionDecl * decl );
92        void produceForwardDecl( const ast::FunctionDecl * decl );
93
94        const CodeLocation& getLocation() const { return getDecl()->location; }
95        ast::FunctionDecl * genProto( const std::string& name,
96                std::vector<ast::ptr<ast::DeclWithType>>&& params,
97                std::vector<ast::ptr<ast::DeclWithType>>&& returns ) const;
98
99        ast::ObjectDecl * dstParam() const;
100        ast::ObjectDecl * srcParam() const;
101        ast::FunctionDecl * genCtorProto() const;
102        ast::FunctionDecl * genCopyProto() const;
103        ast::FunctionDecl * genDtorProto() const;
104        ast::FunctionDecl * genAssignProto() const;
105        ast::FunctionDecl * genFieldCtorProto( unsigned int fields ) const;
106
107        // Internal Hooks:
108        virtual void genFuncBody( ast::FunctionDecl * decl ) = 0;
109        virtual void genFieldCtors() = 0;
110        virtual bool isConcurrentType() const { return false; }
111        virtual const ast::Decl * getDecl() const = 0;
112};
113
114class StructFuncGenerator final : public FuncGenerator {
115        const ast::StructDecl * decl;
116public:
117        StructFuncGenerator( const ast::StructDecl * decl,
118                        const ast::StructInstType * type,
119                        unsigned int functionNesting ) :
120                FuncGenerator( type, functionNesting ), decl( decl )
121        {}
122
123        // Built-ins do not use autogeneration.
[91715ce1]124        bool shouldAutogen() const final { return !decl->linkage.is_builtin && !structHasFlexibleArray(decl); }
[a488783]125private:
126        void genFuncBody( ast::FunctionDecl * decl ) final;
127        void genFieldCtors() final;
128        bool isConcurrentType() const final {
129                return decl->is_thread() || decl->is_monitor();
130        }
131        virtual const ast::Decl * getDecl() const final { return decl; }
132
133        /// Generates a single struct member operation.
134        /// (constructor call, destructor call, assignment call)
135        // This is managed because it uses another helper that returns a ast::ptr.
136        ast::ptr<ast::Stmt> makeMemberOp(
137                const CodeLocation& location,
138                const ast::ObjectDecl * dstParam, const ast::Expr * src,
139                const ast::ObjectDecl * field, ast::FunctionDecl * func,
140                SymTab::LoopDirection direction );
141
142        /// Generates the body of a struct function by iterating the struct members
143        /// (via parameters). Generates default constructor, copy constructor,
144        /// copy assignment, and destructor bodies. No field constructor bodies.
145        template<typename Iterator>
146        void makeFunctionBody( Iterator member, Iterator end,
147                        ast::FunctionDecl * func, SymTab::LoopDirection direction );
148
149        /// Generate the body of a constructor which takes parameters that match
150        /// fields. (With arguments for one to all of the fields.)
151        template<typename Iterator>
152        void makeFieldCtorBody( Iterator member, Iterator end,
153                        ast::FunctionDecl * func );
154};
155
156class UnionFuncGenerator final : public FuncGenerator {
157        const ast::UnionDecl * decl;
158public:
159        UnionFuncGenerator( const ast::UnionDecl * decl,
160                        const ast::UnionInstType * type,
161                        unsigned int functionNesting ) :
162                FuncGenerator( type, functionNesting ), decl( decl )
163        {}
164
165        // Built-ins do not use autogeneration.
166        bool shouldAutogen() const final { return !decl->linkage.is_builtin; }
167private:
168        void genFuncBody( ast::FunctionDecl * decl ) final;
169        void genFieldCtors() final;
170        const ast::Decl * getDecl() const final { return decl; }
171
172        /// Generate a single union assignment expression (using memcpy).
173        ast::ExprStmt * makeAssignOp( const CodeLocation& location,
174                const ast::ObjectDecl * dstParam, const ast::ObjectDecl * srcParam );
175};
176
177class EnumFuncGenerator final : public FuncGenerator {
178        const ast::EnumDecl * decl;
179public:
180        EnumFuncGenerator( const ast::EnumDecl * decl,
181                        const ast::EnumInstType * type,
182                        unsigned int functionNesting ) :
183                FuncGenerator( type, functionNesting ), decl( decl )
184        {
185                // TODO: These functions are somewhere between instrinsic and autogen,
[3322180]186                // could possibly use a new linkage type. For now we just make the
187                // basic ones intrinsic to code-gen them as C assignments.
188                const auto & real_type = decl->base;
189                const auto & basic = real_type.as<ast::BasicType>();
190                if(!real_type || (basic && basic->isInteger())) proto_linkage = ast::Linkage::Intrinsic;
[a488783]191        }
192
193        bool shouldAutogen() const final { return true; }
194private:
195        void genFuncBody( ast::FunctionDecl * decl ) final;
196        void genFieldCtors() final;
197        const ast::Decl * getDecl() const final { return decl; }
198};
199
200class TypeFuncGenerator final : public FuncGenerator {
201        const ast::TypeDecl * decl;
202public:
203        TypeFuncGenerator( const ast::TypeDecl * decl,
204                        ast::TypeInstType * type,
205                        unsigned int functionNesting ) :
206                FuncGenerator( type, functionNesting ), decl( decl )
207        {}
208
209        bool shouldAutogen() const final { return true; }
210        void genFieldCtors() final;
211private:
212        void genFuncBody( ast::FunctionDecl * decl ) final;
213        const ast::Decl * getDecl() const final { return decl; }
214};
215
216// --------------------------------------------------------------------------
217const std::vector<ast::ptr<ast::TypeDecl>>& getGenericParams( const ast::Type * t ) {
218        if ( auto inst = dynamic_cast< const ast::StructInstType * >( t ) ) {
219                return inst->base->params;
220        } else if ( auto inst = dynamic_cast< const ast::UnionInstType * >( t ) ) {
221                return inst->base->params;
222        }
223        static std::vector<ast::ptr<ast::TypeDecl>> const empty;
224        return empty;
225}
226
227/// Changes the node inside a pointer so that it has the unused attribute.
228void addUnusedAttribute( ast::ptr<ast::DeclWithType> & declPtr ) {
229        ast::DeclWithType * decl = declPtr.get_and_mutate();
230        decl->attributes.push_back( new ast::Attribute( "unused" ) );
231}
232
233// --------------------------------------------------------------------------
234void AutogenerateRoutines_new::previsit( const ast::EnumDecl * enumDecl ) {
235        // Must visit children (enum constants) to add them to the symbol table.
236        if ( !enumDecl->body ) return;
237
238        ast::EnumInstType enumInst( enumDecl->name );
239        enumInst.base = enumDecl;
240        EnumFuncGenerator gen( enumDecl, &enumInst, functionNesting );
241        gen.generateAndAppendFunctions( declsToAddAfter );
242}
243
244void AutogenerateRoutines_new::previsit( const ast::StructDecl * structDecl ) {
245        visit_children = false;
246        if ( !structDecl->body ) return;
247
248        ast::StructInstType structInst( structDecl->name );
249        structInst.base = structDecl;
250        for ( const ast::TypeDecl * typeDecl : structDecl->params ) {
251                structInst.params.push_back( new ast::TypeExpr(
252                        typeDecl->location,
[b230091]253                        new ast::TypeInstType( typeDecl )
[a488783]254                ) );
255        }
256        StructFuncGenerator gen( structDecl, &structInst, functionNesting );
257        gen.generateAndAppendFunctions( declsToAddAfter );
258}
259
260void AutogenerateRoutines_new::previsit( const ast::UnionDecl * unionDecl ) {
261        visit_children = false;
262        if ( !unionDecl->body ) return;
263
264        ast::UnionInstType unionInst( unionDecl->name );
265        unionInst.base = unionDecl;
266        for ( const ast::TypeDecl * typeDecl : unionDecl->params ) {
267                unionInst.params.push_back( new ast::TypeExpr(
268                        unionDecl->location,
[b230091]269                        new ast::TypeInstType( typeDecl )
[a488783]270                ) );
271        }
272        UnionFuncGenerator gen( unionDecl, &unionInst, functionNesting );
273        gen.generateAndAppendFunctions( declsToAddAfter );
274}
275
276/// Generate ctor/dtors/assign for typedecls, e.g., otype T = int *;
277void AutogenerateRoutines_new::previsit( const ast::TypeDecl * typeDecl ) {
278        if ( !typeDecl->base ) return;
279
280        ast::TypeInstType refType( typeDecl->name, typeDecl );
281        TypeFuncGenerator gen( typeDecl, &refType, functionNesting );
282        gen.generateAndAppendFunctions( declsToAddAfter );
283}
284
285void AutogenerateRoutines_new::previsit( const ast::TraitDecl * ) {
286        // Ensure that we don't add assignment ops for types defined as part of the trait
287        visit_children = false;
288}
289
290void AutogenerateRoutines_new::previsit( const ast::FunctionDecl * ) {
291        // Track whether we're currently in a function.
292        // Can ignore function type idiosyncrasies, because function type can never
293        // declare a new type.
294        functionNesting += 1;
295}
296
297void AutogenerateRoutines_new::postvisit( const ast::FunctionDecl * ) {
298        functionNesting -= 1;
299}
300
301void FuncGenerator::generateAndAppendFunctions(
302                std::list<ast::ptr<ast::Decl>> & decls ) {
303        if ( !shouldAutogen() ) return;
304
305        // Generate the functions (they go into forwards and definitions).
306        genStandardFuncs();
307        genFieldCtors();
308
309        // Now export the lists contents.
310        decls.splice( decls.end(), forwards );
311        decls.splice( decls.end(), definitions );
312}
313
314void FuncGenerator::produceDecl( const ast::FunctionDecl * decl ) {
315        assert( nullptr != decl->stmts );
316
317        definitions.push_back( decl );
318}
319
320/// Make a forward declaration of the decl and add it to forwards.
321void FuncGenerator::produceForwardDecl( const ast::FunctionDecl * decl ) {
322        if (0 != functionNesting) return;
323        ast::FunctionDecl * fwd = ast::deepCopy( decl );
324        fwd->stmts = nullptr;
325        fwd->fixUniqueId();
326        forwards.push_back( fwd );
327}
328
329/// Generates a basic prototype function declaration.
330ast::FunctionDecl * FuncGenerator::genProto( const std::string& name,
331                std::vector<ast::ptr<ast::DeclWithType>>&& params,
332                std::vector<ast::ptr<ast::DeclWithType>>&& returns ) const {
333
334        // Handle generic prameters and assertions, if any.
335        auto const & old_type_params = getGenericParams( type );
336        std::vector<ast::ptr<ast::TypeDecl>> type_params;
337        std::vector<ast::ptr<ast::DeclWithType>> assertions;
338        for ( auto & old_param : old_type_params ) {
339                ast::TypeDecl * decl = ast::deepCopy( old_param );
340                for ( auto assertion : decl->assertions ) {
341                        assertions.push_back( assertion );
342                }
343                decl->assertions.clear();
344                type_params.push_back( decl );
345        }
346        // TODO: The values in params and returns still may point at the old
347        // generic params, that does not appear to be an issue but perhaps it
348        // should be addressed.
349
350        ast::FunctionDecl * decl = new ast::FunctionDecl(
351                // Auto-generated routines use the type declaration's location.
352                getLocation(),
353                name,
354                std::move( type_params ),
[7edd5c1]355                std::move( assertions ),
[a488783]356                std::move( params ),
357                std::move( returns ),
358                // Only a prototype, no body.
359                nullptr,
360                // Use static storage if we are at the top level.
361                (0 < functionNesting) ? ast::Storage::Classes() : ast::Storage::Static,
362                proto_linkage,
363                std::vector<ast::ptr<ast::Attribute>>(),
364                // Auto-generated routines are inline to avoid conflicts.
365                ast::Function::Specs( ast::Function::Inline ) );
366        decl->fixUniqueId();
367        return decl;
368}
369
370ast::ObjectDecl * FuncGenerator::dstParam() const {
371        return new ast::ObjectDecl( getLocation(), "_dst",
372                new ast::ReferenceType( ast::deepCopy( type ) ),
373                nullptr, {}, ast::Linkage::Cforall );
374}
375
376ast::ObjectDecl * FuncGenerator::srcParam() const {
377        return new ast::ObjectDecl( getLocation(), "_src",
378                ast::deepCopy( type ),
379                nullptr, {}, ast::Linkage::Cforall );
380}
381
382/// Use the current type T to create `void ?{}(T & _dst)`.
383ast::FunctionDecl * FuncGenerator::genCtorProto() const {
384        return genProto( "?{}", { dstParam() }, {} );
385}
386
387/// Use the current type T to create `void ?{}(T & _dst, T _src)`.
388ast::FunctionDecl * FuncGenerator::genCopyProto() const {
389        return genProto( "?{}", { dstParam(), srcParam() }, {} );
390}
391
392/// Use the current type T to create `void ?{}(T & _dst)`.
393ast::FunctionDecl * FuncGenerator::genDtorProto() const {
394        // The destructor must be mutex on a concurrent type.
395        auto dst = dstParam();
396        if ( isConcurrentType() ) {
397                add_qualifiers( dst->type, ast::CV::Qualifiers( ast::CV::Mutex ) );
398        }
399        return genProto( "^?{}", { dst }, {} );
400}
401
402/// Use the current type T to create `T ?{}(T & _dst, T _src)`.
403ast::FunctionDecl * FuncGenerator::genAssignProto() const {
404        // Only the name is different, so just reuse the generation function.
405        auto retval = srcParam();
406        retval->name = "_ret";
407        return genProto( "?=?", { dstParam(), srcParam() }, { retval } );
408}
409
410// This one can return null if the last field is an unnamed bitfield.
411ast::FunctionDecl * FuncGenerator::genFieldCtorProto(
412                unsigned int fields ) const {
413        assert( 0 < fields );
414        auto aggr = strict_dynamic_cast<const ast::AggregateDecl *>( getDecl() );
415
416        std::vector<ast::ptr<ast::DeclWithType>> params = { dstParam() };
417        for ( unsigned int index = 0 ; index < fields ; ++index ) {
418                auto member = aggr->members[index].strict_as<ast::DeclWithType>();
419                if ( SymTab::isUnnamedBitfield(
420                                dynamic_cast<const ast::ObjectDecl *>( member ) ) ) {
421                        if ( index == fields - 1 ) {
422                                return nullptr;
423                        }
424                        continue;
425                }
426
427                auto * paramType = ast::deepCopy( member->get_type() );
428                paramType->attributes.clear();
429                ast::ObjectDecl * param = new ast::ObjectDecl(
430                        getLocation(), member->name, paramType );
431                param->linkage = ast::Linkage::Cforall;
432                for ( auto & attr : member->attributes ) {
433                        if ( attr->isValidOnFuncParam() ) {
434                                param->attributes.push_back( attr );
435                        }
436                }
437                params.emplace_back( param );
438        }
439        return genProto( "?{}", std::move( params ), {} );
440}
441
442void appendReturnThis( ast::FunctionDecl * decl ) {
443        assert( 1 <= decl->params.size() );
444        assert( 1 == decl->returns.size() );
445        assert( decl->stmts );
446
447        const CodeLocation& location = (decl->stmts->kids.empty())
448                ? decl->stmts->location : decl->stmts->kids.back()->location;
449        const ast::DeclWithType * thisParam = decl->params.front();
450        decl->stmts.get_and_mutate()->push_back(
451                new ast::ReturnStmt( location,
452                        new ast::VariableExpr( location, thisParam )
453                )
454        );
455}
456
457void FuncGenerator::genStandardFuncs() {
458        // The order here determines the order that these functions are generated.
459        // Assignment should come last since it uses copy constructor in return.
460        ast::FunctionDecl *(FuncGenerator::*standardProtos[4])() const = {
461                        &FuncGenerator::genCtorProto, &FuncGenerator::genCopyProto,
462                        &FuncGenerator::genDtorProto, &FuncGenerator::genAssignProto };
463        for ( auto & generator : standardProtos ) {
464                ast::FunctionDecl * decl = (this->*generator)();
465                produceForwardDecl( decl );
466                genFuncBody( decl );
467                if ( CodeGen::isAssignment( decl->name ) ) {
468                        appendReturnThis( decl );
469                }
470                produceDecl( decl );
471        }
472}
473
474void StructFuncGenerator::genFieldCtors() {
475        // The field constructors are only generated if the default constructor
476        // and copy constructor are both generated, since the need both.
477        unsigned numCtors = std::count_if( definitions.begin(), definitions.end(),
478                [](const ast::Decl * decl){ return CodeGen::isConstructor( decl->name ); }
479        );
480        if ( 2 != numCtors ) return;
481
482        for ( unsigned int num = 1 ; num <= decl->members.size() ; ++num ) {
483                ast::FunctionDecl * ctor = genFieldCtorProto( num );
484                if ( nullptr == ctor ) {
485                        continue;
486                }
487                produceForwardDecl( ctor );
488                makeFieldCtorBody( decl->members.begin(), decl->members.end(), ctor );
489                produceDecl( ctor );
490        }
491}
492
493void StructFuncGenerator::genFuncBody( ast::FunctionDecl * functionDecl ) {
494        // Generate appropriate calls to member constructors and assignment.
495        // Destructor needs to do everything in reverse,
496        // so pass "forward" based on whether the function is a destructor
497        if ( CodeGen::isDestructor( functionDecl->name ) ) {
498                makeFunctionBody( decl->members.rbegin(), decl->members.rend(),
499                        functionDecl, SymTab::LoopBackward );
500        } else {
501                makeFunctionBody( decl->members.begin(), decl->members.end(),
502                        functionDecl, SymTab::LoopForward );
503        }
504}
505
506ast::ptr<ast::Stmt> StructFuncGenerator::makeMemberOp(
507                const CodeLocation& location, const ast::ObjectDecl * dstParam,
508                const ast::Expr * src, const ast::ObjectDecl * field,
509                ast::FunctionDecl * func, SymTab::LoopDirection direction ) {
510        InitTweak::InitExpander_new srcParam( src );
511        // Assign to destination.
512        ast::Expr * dstSelect = new ast::MemberExpr(
513                location,
514                field,
515                new ast::CastExpr(
516                        location,
517                        new ast::VariableExpr( location, dstParam ),
518                        dstParam->type.strict_as<ast::ReferenceType>()->base
519                )
520        );
521        return genImplicitCall(
522                srcParam, dstSelect, location, func->name,
523                field, direction
524        );
525}
526
527template<typename Iterator>
528void StructFuncGenerator::makeFunctionBody( Iterator current, Iterator end,
529                ast::FunctionDecl * func, SymTab::LoopDirection direction ) {
530        // Trying to get the best code location. Should probably use a helper or
531        // just figure out what that would be given where this is called.
532        assert( nullptr == func->stmts );
533        const CodeLocation& location = func->location;
534
535        ast::CompoundStmt * stmts = new ast::CompoundStmt( location );
536
537        for ( ; current != end ; ++current ) {
538                const ast::ptr<ast::Decl> & member = *current;
539                auto field = member.as<ast::ObjectDecl>();
540                if ( nullptr == field ) {
541                        continue;
542                }
543
544                // Don't assign to constant members (but do construct/destruct them).
545                if ( CodeGen::isAssignment( func->name ) ) {
546                        // For array types we need to strip off the array layers.
547                        const ast::Type * type = field->get_type();
548                        while ( auto at = dynamic_cast<const ast::ArrayType *>( type ) ) {
549                                type = at->base;
550                        }
551                        if ( type->is_const() ) {
552                                continue;
553                        }
554                }
555
556                assert( !func->params.empty() );
557                const ast::ObjectDecl * dstParam =
558                        func->params.front().strict_as<ast::ObjectDecl>();
559                const ast::ObjectDecl * srcParam = nullptr;
560                if ( 2 == func->params.size() ) {
561                        srcParam = func->params.back().strict_as<ast::ObjectDecl>();
562                }
563
564                ast::Expr * srcSelect = (srcParam) ? new ast::MemberExpr(
565                        location, field, new ast::VariableExpr( location, srcParam )
566                ) : nullptr;
567                ast::ptr<ast::Stmt> stmt =
568                        makeMemberOp( location, dstParam, srcSelect, field, func, direction );
569
570                if ( nullptr != stmt ) {
571                        stmts->kids.push_back( stmt );
572                }
573        }
574
575        func->stmts = stmts;
576}
577
578template<typename Iterator>
579void StructFuncGenerator::makeFieldCtorBody( Iterator current, Iterator end,
580                ast::FunctionDecl * func ) {
581        const CodeLocation& location = func->location;
582        auto & params = func->params;
583        // Need at least the constructed parameter and one field parameter.
584        assert( 2 <= params.size() );
585
586        ast::CompoundStmt * stmts = new ast::CompoundStmt( location );
587
588        auto dstParam = params.front().strict_as<ast::ObjectDecl>();
589        // Skip over the 'this' parameter.
590        for ( auto param = params.begin() + 1 ; current != end ; ++current ) {
591                const ast::ptr<ast::Decl> & member = *current;
592                ast::ptr<ast::Stmt> stmt = nullptr;
593                auto field = member.as<ast::ObjectDecl>();
594                // Not sure why it could be null.
595                // Don't make a function for a parameter that is an unnamed bitfield.
596                if ( nullptr == field || SymTab::isUnnamedBitfield( field ) ) {
597                        continue;
598                // Matching Parameter: Initialize the field by copy.
599                } else if ( params.end() != param ) {
600                        const ast::Expr *srcSelect = new ast::VariableExpr(
601                                func->location, param->get() );
602                        stmt = makeMemberOp( location, dstParam, srcSelect, field, func, SymTab::LoopForward );
603                        ++param;
604                // No Matching Parameter: Initialize the field by default constructor.
605                } else {
606                        stmt = makeMemberOp( location, dstParam, nullptr, field, func, SymTab::LoopForward );
607                }
608
609                if ( nullptr != stmt ) {
610                        stmts->kids.push_back( stmt );
611                }
612        }
613        func->stmts = stmts;
614}
615
616void UnionFuncGenerator::genFieldCtors() {
617        // Field constructors are only generated if default and copy constructor
618        // are generated, since they need access to both
619        unsigned numCtors = std::count_if( definitions.begin(), definitions.end(),
620                []( const ast::Decl * d ){ return CodeGen::isConstructor( d->name ); }
621        );
622        if ( 2 != numCtors ) {
623                return;
624        }
625
626        // Create a constructor which takes the first member type as a
627        // parameter. For example for `union A { int x; char y; };` generate
628        // a function with signature `void ?{}(A *, int)`. This mimics C's
629        // behaviour which initializes the first member of the union.
630
631        // Still, there must be some members.
632        if ( !decl->members.empty() ) {
633                ast::FunctionDecl * ctor = genFieldCtorProto( 1 );
634                if ( nullptr == ctor ) {
635                        return;
636                }
637                produceForwardDecl( ctor );
638                auto params = ctor->params;
639                auto dstParam = params.front().strict_as<ast::ObjectDecl>();
640                auto srcParam = params.back().strict_as<ast::ObjectDecl>();
641                ctor->stmts = new ast::CompoundStmt( getLocation(),
642                        { makeAssignOp( getLocation(), dstParam, srcParam ) }
643                );
644                produceDecl( ctor );
645        }
646}
647
648void UnionFuncGenerator::genFuncBody( ast::FunctionDecl * functionDecl ) {
649        const CodeLocation& location = functionDecl->location;
650        auto & params = functionDecl->params;
651        if ( InitTweak::isCopyConstructor( functionDecl )
652                        || InitTweak::isAssignment( functionDecl ) ) {
653                assert( 2 == params.size() );
654                auto dstParam = params.front().strict_as<ast::ObjectDecl>();
655                auto srcParam = params.back().strict_as<ast::ObjectDecl>();
656                functionDecl->stmts = new ast::CompoundStmt( location,
657                        { makeAssignOp( location, dstParam, srcParam ) }
658                );
659        } else {
660                assert( 1 == params.size() );
661                // Default constructor and destructor is empty.
662                functionDecl->stmts = new ast::CompoundStmt( location );
663                // Add unused attribute to parameter to silence warnings.
664                addUnusedAttribute( params.front() );
665
666                // Just an extra step to make the forward and declaration match.
667                if ( forwards.empty() ) return;
668                ast::FunctionDecl * fwd = strict_dynamic_cast<ast::FunctionDecl *>(
669                        forwards.back().get_and_mutate() );
670                addUnusedAttribute( fwd->params.front() );
671        }
672}
673
674ast::ExprStmt * UnionFuncGenerator::makeAssignOp( const CodeLocation& location,
675                const ast::ObjectDecl * dstParam, const ast::ObjectDecl * srcParam ) {
676        return new ast::ExprStmt( location, new ast::UntypedExpr(
677                location,
678                new ast::NameExpr( location, "__builtin_memcpy" ),
679                {
680                        new ast::AddressExpr( location,
681                                new ast::VariableExpr( location, dstParam ) ),
682                        new ast::AddressExpr( location,
683                                new ast::VariableExpr( location, srcParam ) ),
684                        new ast::SizeofExpr( location, srcParam->type ),
685                } ) );
686}
687
688void EnumFuncGenerator::genFieldCtors() {
689        // Enumerations to not have field constructors.
690}
691
692void EnumFuncGenerator::genFuncBody( ast::FunctionDecl * functionDecl ) {
693        const CodeLocation& location = functionDecl->location;
694        auto & params = functionDecl->params;
695        if ( InitTweak::isCopyConstructor( functionDecl )
696                        || InitTweak::isAssignment( functionDecl ) ) {
697                assert( 2 == params.size() );
698                auto dstParam = params.front().strict_as<ast::ObjectDecl>();
699                auto srcParam = params.back().strict_as<ast::ObjectDecl>();
700
701                /* This looks like a recursive call, but code-gen will turn it into
702                 * a C-style assignment.
703                 *
704                 * This is still before function pointer type conversion,
705                 * so this will have to do it manually.
706                 *
707                 * It will also reference the parent function declaration, creating
708                 * a cycle for references. This also means that the ref-counts are
709                 * now non-zero and the declaration will be deleted if it ever
710                 * returns to zero.
711                 */
712                auto callExpr = new ast::ApplicationExpr( location,
713                        ast::VariableExpr::functionPointer( location, functionDecl ),
714                        {
715                                new ast::VariableExpr( location, dstParam ),
716                                new ast::VariableExpr( location, srcParam ),
717                        }
718                );
719                functionDecl->stmts = new ast::CompoundStmt( location,
720                        { new ast::ExprStmt( location, callExpr ) }
721                );
722        } else {
723                assert( 1 == params.size() );
724                // Default constructor and destructor is empty.
725                functionDecl->stmts = new ast::CompoundStmt( location );
726                // Just add unused attribute to parameter to silence warnings.
727                addUnusedAttribute( params.front() );
728
729                // Just an extra step to make the forward and declaration match.
730                if ( forwards.empty() ) return;
731                ast::FunctionDecl * fwd = strict_dynamic_cast<ast::FunctionDecl *>(
732                        forwards.back().get_and_mutate() );
733                addUnusedAttribute( fwd->params.front() );
734        }
735}
736
737void TypeFuncGenerator::genFieldCtors() {
738        // Opaque types do not have field constructors.
739}
740
741void TypeFuncGenerator::genFuncBody( ast::FunctionDecl * functionDecl ) {
742        const CodeLocation& location = functionDecl->location;
743        auto & params = functionDecl->type->params;
744        assertf( 1 == params.size() || 2 == params.size(),
745                "Incorrect number of parameters in autogenerated typedecl function: %zd",
746                params.size() );
747        auto dstParam = params.front().strict_as<ast::ObjectDecl>();
748        auto srcParam = (2 == params.size())
749                ? params.back().strict_as<ast::ObjectDecl>() : nullptr;
750        // Generate appropriate calls to member constructor and assignment.
751        ast::UntypedExpr * expr = new ast::UntypedExpr( location,
752                new ast::NameExpr( location, functionDecl->name )
753        );
754        expr->args.push_back( new ast::CastExpr( location,
755                new ast::VariableExpr( location, dstParam ),
756                new ast::ReferenceType( decl->base )
757        ) );
758        if ( srcParam ) {
759                expr->args.push_back( new ast::CastExpr( location,
760                        new ast::VariableExpr( location, srcParam ),
761                        decl->base
762                ) );
763        }
764        functionDecl->stmts = new ast::CompoundStmt( location,
765                { new ast::ExprStmt( location, expr ) }
766        );
767}
768
769} // namespace
770
771void autogenerateRoutines( ast::TranslationUnit & translationUnit ) {
772        ast::Pass<AutogenerateRoutines_new>::run( translationUnit );
773}
774
775} // Validate
776
777// Local Variables: //
778// tab-width: 4 //
779// mode: c++ //
780// compile-command: "make install" //
781// End: //
Note: See TracBrowser for help on using the repository browser.