diff options
Diffstat (limited to 'avx512-0037785/packages/pastojs/src/fppas2js.pp')
| -rw-r--r-- | avx512-0037785/packages/pastojs/src/fppas2js.pp | 264 |
1 files changed, 171 insertions, 93 deletions
diff --git a/avx512-0037785/packages/pastojs/src/fppas2js.pp b/avx512-0037785/packages/pastojs/src/fppas2js.pp index 7d5d6756a7..f60b74be61 100644 --- a/avx512-0037785/packages/pastojs/src/fppas2js.pp +++ b/avx512-0037785/packages/pastojs/src/fppas2js.pp @@ -506,6 +506,7 @@ const nDuplicateMessageIdXAtY = 4029; nDispatchRequiresX = 4030; nConstRefNotForXAsConst = 4031; + nSymbolCannotBeExportedFromALibrary = 4032; // resourcestring patterns of messages resourcestring sPasElementNotSupported = 'Pascal element not supported: %s'; @@ -539,6 +540,7 @@ resourcestring sDuplicateMessageIdXAtY = 'Duplicate message id "%s" at %s'; sDispatchRequiresX = 'Dispatch requires %s'; sConstRefNotForXAsConst = 'ConstRef not yet implemented for %s. Treating as Const'; + sSymbolCannotBeExportedFromALibrary = 'The symbol cannot be exported from a library'; const ExtClassBracketAccessor = '[]'; // external name '[]' marks the array param getter/setter @@ -606,6 +608,7 @@ type pbifnValEnum, pbifnFreeLocalVar, pbifnFreeVar, + pbifnLibraryMain, pbifnOverflowCheckInt, pbifnProcType_Create, pbifnProcType_CreateSafe, @@ -671,6 +674,7 @@ type pbivnImplCode, pbivnMessageInt, pbivnMessageStr, + pbivnLibrary, // library pbivnLocalModuleRef, pbivnLocalProcRef, pbivnLocalTypeRef, @@ -682,6 +686,7 @@ type pbivnPtrClass, pbivnPtrRecord, pbivnProcOk, + pbivnProgram, // program pbivnResourceStrings, pbivnResourceStringOrig, pbivnRTL, @@ -791,6 +796,7 @@ const 'valEnum', // pbifnValEnum rtl.valEnum 'freeLoc', // pbifnFreeLocalVar rtl.freeLoc 'free', // pbifnFreeVar rtl.free + '$main', // pbifnLibraryMain 'oc', // pbifnOverflowCheckInt rtl.oc 'createCallback', // pbifnProcType_Create rtl.createCallback 'createSafeCallback', // pbifnProcType_CreateSafe rtl.createSafeCallback @@ -855,6 +861,7 @@ const '$implcode', // pbivnImplCode '$msgint', // pbivnMessageInt '$msgstr', // pbivnMessageStr + 'library', // pbivnLibrary pas.library '$lm', // pbivnLocalModuleRef '$lp', // pbivnLocalProcRef '$lt', // pbivnLocalTypeRef @@ -866,6 +873,7 @@ const '$class', // pbivnPtrClass, ClassType '$record', // pbivnPtrRecord, hidden recordtype '$ok', // pbivnProcOk + 'program', // pbivnProgram pas.program '$resourcestrings', // pbivnResourceStrings 'org', // pbivnResourceStringOrig 'rtl', // pbivnRTL @@ -1538,6 +1546,7 @@ type Params: TParamsExpr); override; procedure FinishPropertyParamAccess(Params: TParamsExpr; Prop: TPasProperty ); override; + procedure FinishExportSymbol(El: TPasExportSymbol); override; procedure FindCreatorArrayOfConst(Args: TFPList; ErrorEl: TPasElement); function FindProc_ArrLitToArrayOfConst(ErrorEl: TPasElement): TPasFunction; virtual; function FindSystemExternalClassType(const aClassName, JSName: string; @@ -2071,7 +2080,7 @@ type Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual; Procedure AddHeaderStatement(JS: TJSElement; PosEl: TPasElement; aContext: TConvertContext); virtual; Procedure AddImplHeaderStatement(JS: TJSElement; PosEl: TPasElement; aContext: TConvertContext); virtual; - Procedure AddDelayedInits(El: TPasProgram; Src: TJSSourceElements; AContext: TConvertContext); virtual; + Procedure AddDelayedInits(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual; Procedure AddDelaySpecializeInit(El: TPasGenericType; Src: TJSSourceElements; AContext: TConvertContext); virtual; // enum and sets Function CreateReferencedSet(El: TPasElement; SetExpr: TJSElement): TJSElement; virtual; @@ -3945,6 +3954,7 @@ var begin Lines:=El.Tokens; if Lines=nil then exit; + // ToDo: resolve explicit references end; procedure TPas2JSResolver.ResolveNameExpr(El: TPasExpr; const aName: string; @@ -4880,6 +4890,41 @@ begin FindCreatorArrayOfConst(Args,Params); end; +procedure TPas2JSResolver.FinishExportSymbol(El: TPasExportSymbol); +var + ResolvedEl: TPasResolverResult; + DeclEl: TPasElement; + Proc: TPasProcedure; +begin + if El.Parent is TLibrarySection then + // ok + else + // everywhere else: not supported + RaiseMsg(20210106224720,nNotSupportedX,sNotSupportedX,['non library export'],El.ExportIndex); + if El.ExportIndex<>nil then + RaiseMsg(20210106223403,nNotSupportedX,sNotSupportedX,['export index'],El.ExportIndex); + + inherited FinishExportSymbol(El); + + ComputeElement(El,ResolvedEl,[]); + DeclEl:=ResolvedEl.IdentEl; + if DeclEl=nil then + RaiseMsg(20210106223620,nSymbolCannotBeExportedFromALibrary, + sSymbolCannotBeExportedFromALibrary,[],El) + else if DeclEl is TPasProcedure then + begin + Proc:=TPasProcedure(DeclEl); + if Proc.Parent is TPasSection then + // ok + else + RaiseMsg(20210106224436,nSymbolCannotBeExportedFromALibrary, + sSymbolCannotBeExportedFromALibrary,[],El); + end + else + RaiseMsg(20210106223621,nSymbolCannotBeExportedFromALibrary, + sSymbolCannotBeExportedFromALibrary,[],El); +end; + procedure TPas2JSResolver.FindCreatorArrayOfConst(Args: TFPList; ErrorEl: TPasElement); var @@ -8083,6 +8128,18 @@ Program: }; }); +Library: + rtl.module('library', + [<uses1>,<uses2>, ...], + function(){ + var $mod = this; + <librarysection> + this.$main=function(){ + <initialization> + }; + }); + export1 = pas.unit1.func1; + Unit without implementation: rtl.module('<unitname>', [<interface uses1>,<uses2>, ...], @@ -8136,6 +8193,7 @@ begin ModScope:=nil; OuterSrc:=TJSSourceElements(CreateElement(TJSSourceElements, El)); Result:=OuterSrc; + IntfContext:=nil; ok:=false; try // create 'rtl.module(...)' @@ -8145,7 +8203,7 @@ begin ArgArray := RegModuleCall.Args; RegModuleCall.Args:=ArgArray; - // add unitname parameter: unitname + // add module name parameter ModuleName:=TransformModuleName(El,false,AContext); ArgArray.Elements.AddElement.Expr:=CreateLiteralString(El,ModuleName); @@ -8183,95 +8241,88 @@ begin IntfContext:=TInterfaceSectionContext.Create(El,Src,AContext) else IntfContext:=TSectionContext.Create(El,Src,AContext); - try - // add "var $mod = this;" - IntfContext.ThisVar.Element:=El; - IntfContext.ThisVar.Kind:=cvkGlobal; - if El.CustomData is TPasModuleScope then - IntfContext.ScannerBoolSwitches:=TPasModuleScope(El.CustomData).BoolSwitches; - ModVarName:=GetBIName(pbivnModule); - IntfContext.AddLocalVar(ModVarName,El,cvkGlobal,false); - AddToSourceElements(Src,CreateVarStatement(ModVarName, - CreatePrimitiveDotExpr('this',El),El)); - - if (ModScope<>nil) then - RestoreImplJSLocals(ModScope,IntfContext); - - if (El is TPasProgram) then - begin // program - Prg:=TPasProgram(El); - if Assigned(Prg.ProgramSection) then - AddToSourceElements(Src,ConvertDeclarations(Prg.ProgramSection,IntfContext)); - AddDelayedInits(Prg,Src,IntfContext); - CreateInitSection(Prg,Src,IntfContext); - end - else if El is TPasLibrary then - begin // library - Lib:=TPasLibrary(El); - if Assigned(Lib.LibrarySection) then - AddToSourceElements(Src,ConvertDeclarations(Lib.LibrarySection,IntfContext)); - // ToDo AddDelayedInits(Lib,Src,IntfContext); - CreateInitSection(Lib,Src,IntfContext); - end - else - begin // unit - IntfSecCtx:=TInterfaceSectionContext(IntfContext); - if Assigned(El.ImplementationSection) then - begin - // add var $impl = $mod.$impl - ImplVarSt:=CreateVarStatement(GetBIName(pbivnImplementation), - CreateMemberExpression([ModVarName,GetBIName(pbivnImplementation)]),El); - AddToSourceElements(Src,ImplVarSt); - // register local var $impl - IntfSecCtx.AddLocalVar(GetBIName(pbivnImplementation),El.ImplementationSection,cvkGlobal,false); - end; - if Assigned(El.InterfaceSection) then - AddToSourceElements(Src,ConvertDeclarations(El.InterfaceSection,IntfSecCtx)); + // add "var $mod = this;" + IntfContext.ThisVar.Element:=El; + IntfContext.ThisVar.Kind:=cvkGlobal; + if El.CustomData is TPasModuleScope then + IntfContext.ScannerBoolSwitches:=TPasModuleScope(El.CustomData).BoolSwitches; + ModVarName:=GetBIName(pbivnModule); + IntfContext.AddLocalVar(ModVarName,El,cvkGlobal,false); + AddToSourceElements(Src,CreateVarStatement(ModVarName, + CreatePrimitiveDotExpr('this',El),El)); + + if (ModScope<>nil) then + RestoreImplJSLocals(ModScope,IntfContext); - ImplFunc:=CreateImplementationSection(El,IntfSecCtx); - // add $mod.$implcode = ImplFunc; - AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El)); - AssignSt.LHS:=CreateMemberExpression([ModVarName,GetBIName(pbivnImplCode)]); - AssignSt.Expr:=ImplFunc; - AddToSourceElements(Src,AssignSt); - - // append initialization section - CreateInitSection(El,Src,IntfSecCtx); + if (El is TPasProgram) then + begin // program + Prg:=TPasProgram(El); + if Assigned(Prg.ProgramSection) then + AddToSourceElements(Src,ConvertDeclarations(Prg.ProgramSection,IntfContext)); + AddDelayedInits(Prg,Src,IntfContext); + CreateInitSection(Prg,Src,IntfContext); + end + else if El is TPasLibrary then + begin // library + Lib:=TPasLibrary(El); + if Assigned(Lib.LibrarySection) then + AddToSourceElements(Src,ConvertDeclarations(Lib.LibrarySection,IntfContext)); + AddDelayedInits(Lib,Src,IntfContext); + CreateInitSection(Lib,Src,IntfContext); + // ToDo: append exports + end + else + begin // unit + IntfSecCtx:=TInterfaceSectionContext(IntfContext); + if Assigned(El.ImplementationSection) then + begin + // add var $impl = $mod.$impl + ImplVarSt:=CreateVarStatement(GetBIName(pbivnImplementation), + CreateMemberExpression([ModVarName,GetBIName(pbivnImplementation)]),El); + AddToSourceElements(Src,ImplVarSt); + // register local var $impl + IntfSecCtx.AddLocalVar(GetBIName(pbivnImplementation),El.ImplementationSection,cvkGlobal,false); + end; + if Assigned(El.InterfaceSection) then + AddToSourceElements(Src,ConvertDeclarations(El.InterfaceSection,IntfSecCtx)); + + ImplFunc:=CreateImplementationSection(El,IntfSecCtx); + // add $mod.$implcode = ImplFunc; + AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El)); + AssignSt.LHS:=CreateMemberExpression([ModVarName,GetBIName(pbivnImplCode)]); + AssignSt.Expr:=ImplFunc; + AddToSourceElements(Src,AssignSt); - if TJSSourceElements(ImplFunc.AFunction.Body.A).Statements.Count=0 then - begin - // empty implementation - - // remove unneeded $impl from interface - RemoveFromSourceElements(Src,ImplVarSt); - // remove unneeded $mod.$implcode = function(){} - RemoveFromSourceElements(Src,AssignSt); - HasImplUsesClause:=(El.ImplementationSection<>nil) - and (length(El.ImplementationSection.UsesClause)>0); - end - else - begin - HasImplUsesClause:=true; - end; + // append initialization section + CreateInitSection(El,Src,IntfSecCtx); - if HasImplUsesClause then - // add implementation uses list: [<implementation uses1>,<uses2>, ...] - ArgArray.AddElement(CreateUsesList(El.ImplementationSection,AContext)); + if TJSSourceElements(ImplFunc.AFunction.Body.A).Statements.Count=0 then + begin + // empty implementation + // remove unneeded $impl from interface + RemoveFromSourceElements(Src,ImplVarSt); + // remove unneeded $mod.$implcode = function(){} + RemoveFromSourceElements(Src,AssignSt); + HasImplUsesClause:=(El.ImplementationSection<>nil) + and (length(El.ImplementationSection.UsesClause)>0); + end + else + begin + HasImplUsesClause:=true; end; - if (ModScope<>nil) and (coStoreImplJS in Options) then - StoreImplJSLocals(ModScope,IntfContext); - finally - IntfContext.Free; - end; + if HasImplUsesClause then + // add implementation uses list: [<implementation uses1>,<uses2>, ...] + ArgArray.AddElement(CreateUsesList(El.ImplementationSection,AContext)); - // add implementation function - if ImplVarSt<>nil then - begin - end; + end; // end unit + + if (ModScope<>nil) and (coStoreImplJS in Options) then + StoreImplJSLocals(ModScope,IntfContext); ok:=true; finally + IntfContext.Free; if not ok then FreeAndNil(Result); end; @@ -13348,6 +13399,15 @@ begin Result:=Add; exit; end + else if bt in btAllJSInteger then + begin + // ord(integer) + Result:=CheckOrdConstant(aResolver,Param); + if Result<>nil then exit; + // ord(integer) -> integer + Result:=ConvertExpression(Param,AContext); + exit; + end else if bt=btContext then begin C:=ParamResolved.LoTypeEl.ClassType; @@ -15397,6 +15457,8 @@ begin end else if C=TPasAttributes then continue + else if C=TPasExportSymbol then + continue else RaiseNotSupported(P as TPasElement,AContext,20161024191434); Add(E,P); @@ -17148,11 +17210,21 @@ begin Scope:=nil; end; - IsMain:=(El is TPasProgram); - if IsMain then + if El.ClassType=TPasProgram then + begin + IsMain:=true; FunName:=GetBIName(pbifnProgramMain) + end + else if El.ClassType=TPasLibrary then + begin + IsMain:=true; + FunName:=GetBIName(pbifnLibraryMain) + end else + begin + IsMain:=false; FunName:=GetBIName(pbifnUnitInit); + end; NeedRTLCheckVersion:=IsMain and (coRTLVersionCheckMain in Options); RootContext:=AContext.GetRootContext as TRootContext; @@ -17489,6 +17561,7 @@ var L: TJSLiteral; AsmLines: TStrings; Line, Col, StartLine: integer; + Statements: TJSStatementList; begin if AContext=nil then ; AsmLines:=El.Tokens; @@ -17507,6 +17580,15 @@ begin L:=TJSLiteral.Create(Line+StartLine,Col,El.SourceFilename); L.Value.CustomValue:=TJSString(s); Result:=L; + if Pos(';',s)>0 then + begin + // multi statement JS + // for example "if e then asm a;b end;" + // -> if (e){ a;b } + Statements:=TJSStatementList.Create(L.Line,L.Column,L.Source); + Statements.A:=L; + Result:=Statements; + end; end; end; @@ -17680,7 +17762,7 @@ begin IntfSec.AddImplHeaderStatement(JS); end; -procedure TPasToJSConverter.AddDelayedInits(El: TPasProgram; +procedure TPasToJSConverter.AddDelayedInits(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); var aResolver: TPas2JSResolver; @@ -26397,13 +26479,7 @@ begin or (C=TPasClassDestructor) then AddGlobalClassMethod(FuncContext,TPasProcedure(P)) else - begin Methods.Add(P); - if (C=TPasConstructor) - or ((aResolver<>nil) and aResolver.IsClassMethod(P) - and not aResolver.MethodIsStatic(TPasProcedure(P))) then - IsComplex:=true; // needs $record - end; end else if C=TPasAttributes then else @@ -26617,8 +26693,10 @@ begin if Result<>'' then exit; end; - if El is TPasProgram then - Result:='program' + if El.ClassType=TPasProgram then + Result:=GetBIName(pbivnProgram) + else if El.ClassType=TPasLibrary then + Result:=GetBIName(pbivnLibrary) else begin Result:=''; |