administrator/blaise
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

hand source: sync five codegen/semantic gaps for self-hosting fixpoint

Browse source 
- TSymbol gains ConstString field; AnalyseConstDecls stores CD.StrVal
- TIdentExpr gains ConstString and NoArgFuncDecl fields
- AnalyseIdent propagates ConstString to identifier exprs
- EmitExpr: string constants emit 'l copy $__sN' not 'w copy 0'
- IsNoArgFuncCall now set unconditionally for any skFunction with a
  return type; NoArgFuncDecl is looked up from FProcIndex so codegen
  can emit a proper call $FuncName() for user-defined zero-arg functions
- EmitExpr no-arg call path forwards NoArgFuncDecl as ResolvedDecl so
  EmitFuncCall finds the declaration instead of falling through to
  builtin dispatch and raising ECodeGenError
- TFieldAccessExpr IsMethodCall/PropRead/IsClassAccess paths use
  VarRef(RecordName, IsGlobal) instead of hardcoded %%_var_ prefix,
  fixing global-variable receivers such as Source.GetText
This commit is contained in:
Graeme Geldenhuys 2026-04-25 13:06:04 +01:00
parent 2ca052a271
commit c547ab2f16
1 changed files with 39 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

70
tests/blaise-compiler.pas
View file

@ -1749,11 +1749,12 @@ type
Kind: TSymbolKind; Kind: TSymbolKind;
TypeDesc: TTypeDesc; TypeDesc: TTypeDesc;
Params: TObjectList; Params: TObjectList;
ConstValue: Int64; ConstValue: Int64;
IsWeak: Boolean; ConstString: string;
IsWeak: Boolean;
IsGlobal: Boolean; IsGlobal: Boolean;
procedure Create(const AName: string; AKind: TSymbolKind; AType: TTypeDesc); procedure Create(const AName: string; AKind: TSymbolKind; AType: TTypeDesc);
procedure Destroy; procedure Destroy;
@ -2548,15 +2549,17 @@ type
TIdentExpr = class(TASTExpr) TIdentExpr = class(TASTExpr)
Name: string; Name: string;
IsVarParam: Boolean; IsVarParam: Boolean;
IsConstant: Boolean; IsConstant: Boolean;
ConstValue: Int64; ConstValue: Int64;
IsNoArgFuncCall: Boolean; ConstString: string;
IsGlobal: Boolean; IsNoArgFuncCall: Boolean;
IsImplicitSelf: Boolean; NoArgFuncDecl: TObject;
ImplicitFieldInfo: TObject; IsGlobal: Boolean;
IsImplicitSelfMethod: Boolean; IsImplicitSelf: Boolean;
ImplicitMethodDecl: TObject; ImplicitFieldInfo: TObject;
IsImplicitSelfMethod: Boolean;
ImplicitMethodDecl: TObject;
end; end;
TFieldAccessExpr = class(TASTExpr) TFieldAccessExpr = class(TASTExpr)
@ -6696,8 +6699,9 @@ begin
TD := FTable.TypeString TD := FTable.TypeString
else else
TD := FTable.TypeInteger; TD := FTable.TypeInteger;
Sym := TSymbol.Create(CD.Name, skConstant, TD); Sym := TSymbol.Create(CD.Name, skConstant, TD);
Sym.ConstValue := CD.IntVal; Sym.ConstValue := CD.IntVal;
Sym.ConstString := CD.StrVal;
if not FTable.Define(Sym) then if not FTable.Define(Sym) then
Sym.Free; Sym.Free;
end; end;
@ -8465,9 +8469,10 @@ end;
function TSemanticAnalyser.AnalyseExpr(AExpr: TASTExpr): TTypeDesc; function TSemanticAnalyser.AnalyseExpr(AExpr: TASTExpr): TTypeDesc;
var var
Sym: TSymbol; Sym: TSymbol;
FldInfo: TFieldInfo; FldInfo: TFieldInfo;
PropInfo: TPropertyInfo; PropInfo: TPropertyInfo;
NoArgIdx: Integer;
begin begin
if AExpr is TNilLiteral then if AExpr is TNilLiteral then
Result := FTable.TypeNil Result := FTable.TypeNil
@ -8545,13 +8550,18 @@ begin
TIdentExpr(AExpr).IsGlobal := Sym.IsGlobal; TIdentExpr(AExpr).IsGlobal := Sym.IsGlobal;
if Sym.Kind = skConstant then if Sym.Kind = skConstant then
begin begin
TIdentExpr(AExpr).IsConstant := True; TIdentExpr(AExpr).IsConstant := True;
TIdentExpr(AExpr).ConstValue := Sym.ConstValue; TIdentExpr(AExpr).ConstValue := Sym.ConstValue;
TIdentExpr(AExpr).ConstString := Sym.ConstString;
end; end;
if (Sym.Kind = skFunction) and (Sym.TypeDesc <> nil) and if (Sym.Kind = skFunction) and (Sym.TypeDesc <> nil) then
(FProcIndex.IndexOf(TIdentExpr(AExpr).Name) < 0) then begin
TIdentExpr(AExpr).IsNoArgFuncCall := True; TIdentExpr(AExpr).IsNoArgFuncCall := True;
NoArgIdx := FProcIndex.IndexOf(TIdentExpr(AExpr).Name);
if NoArgIdx >= 0 then
TIdentExpr(AExpr).NoArgFuncDecl := FProcIndex.GetObject(NoArgIdx);
end;
Result := Sym.TypeDesc; Result := Sym.TypeDesc;
end end
else if AExpr is TFuncCallExpr then else if AExpr is TFuncCallExpr then
@ -11748,10 +11758,9 @@ begin
end end
else if FldAccess.IsMethodCall then else if FldAccess.IsMethodCall then
begin begin
MDecl := TMethodDecl(FldAccess.ResolvedMethod); MDecl := TMethodDecl(FldAccess.ResolvedMethod);
L := AllocTemp; L := AllocTemp;
EmitLine(Format(' %s =l loadl %%_var_%s', L, FldAccess.RecordName)); EmitLine(Format(' %s =l loadl %s', L, VarRef(FldAccess.RecordName, FldAccess.IsGlobal)));
QType := QbeTypeOf(MDecl.ResolvedReturnType); QType := QbeTypeOf(MDecl.ResolvedReturnType);
T := AllocTemp; T := AllocTemp;
EmitLine(Format(' %s =%s call $%s_%s(l %s)', T, QType, MDecl.OwnerTypeName, FldAccess.FieldName, L)); EmitLine(Format(' %s =%s call $%s_%s(l %s)', T, QType, MDecl.OwnerTypeName, FldAccess.FieldName, L));
@ -11776,9 +11785,8 @@ begin
end end
else if FldAccess.PropRead <> nil then else if FldAccess.PropRead <> nil then
begin begin
L := AllocTemp; L := AllocTemp;
EmitLine(Format(' %s =l loadl %%_var_%s', L, FldAccess.RecordName)); EmitLine(Format(' %s =l loadl %s', L, VarRef(FldAccess.RecordName, FldAccess.IsGlobal)));
T := AllocTemp; T := AllocTemp;
QType := QbeTypeOf(FldAccess.PropRead.TypeDesc); QType := QbeTypeOf(FldAccess.PropRead.TypeDesc);
EmitLine(Format(' %s =%s call $%s_%s(l %s)', T, QType, QBEMangle(FldAccess.PropOwnerType), EmitLine(Format(' %s =%s call $%s_%s(l %s)', T, QType, QBEMangle(FldAccess.PropOwnerType),
@ -11787,9 +11795,8 @@ begin
end end
else if FldAccess.IsClassAccess then else if FldAccess.IsClassAccess then
begin begin
L := AllocTemp; L := AllocTemp;
EmitLine(Format(' %s =l loadl %%_var_%s', L, FldAccess.RecordName)); EmitLine(Format(' %s =l loadl %s', L, VarRef(FldAccess.RecordName, FldAccess.IsGlobal)));
if FldAccess.FieldInfo.Offset > 0 then if FldAccess.FieldInfo.Offset > 0 then
begin begin
Ptr := AllocTemp; Ptr := AllocTemp;
@ -11866,13 +11873,11 @@ begin
end end
else if TIdentExpr(AExpr).IsNoArgFuncCall then else if TIdentExpr(AExpr).IsNoArgFuncCall then
begin begin
NoArgCall := TFuncCallExpr.Create; NoArgCall := TFuncCallExpr.Create;
try try
NoArgCall.Name := TIdentExpr(AExpr).Name; NoArgCall.Name := TIdentExpr(AExpr).Name;
NoArgCall.ResolvedType := AExpr.ResolvedType; NoArgCall.ResolvedType := AExpr.ResolvedType;
NoArgCall.ResolvedDecl := TIdentExpr(AExpr).NoArgFuncDecl;
Result := EmitExpr(NoArgCall); Result := EmitExpr(NoArgCall);
finally finally
NoArgCall.Free; NoArgCall.Free;
@ -11881,7 +11886,10 @@ begin
end end
else if TIdentExpr(AExpr).IsConstant then else if TIdentExpr(AExpr).IsConstant then
begin begin
EmitLine(Format(' %s =w copy %d', T, TIdentExpr(AExpr).ConstValue)); if (AExpr.ResolvedType <> nil) and (AExpr.ResolvedType.Kind = tyString) then
EmitLine(Format(' %s =l copy %s', T, EmitStrLit(TIdentExpr(AExpr).ConstString)))
else
EmitLine(Format(' %s =w copy %d', T, TIdentExpr(AExpr).ConstValue));
end end
else if TIdentExpr(AExpr).IsVarParam then else if TIdentExpr(AExpr).IsVarParam then
begin begin