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

Add constructor-with-args, const blocks; begin self-hosting source

Browse source 
Constructor calls with arguments: TMethodCallExpr.IsConstructorCall flag;
AnalyseMethodCallExpr handles TypeName.Create(args) → allocate via
_ClassAlloc then call user-defined Create method; EmitCaseStmt generates
dispatch, EmitExpr handles the new constructor path.

const block: TConstDecl AST node; TBlock.ConstDecls list; ParseConstBlock;
AnalyseConstDecls registers each constant as skConstant in the symbol table.

tests/blaise-compiler.pas: initial self-hosting source stub — program header,
CHR_* character constants, Exception hierarchy, and Classes.pas RTL content.
The file is built incrementally; this commit has sections 1-2.

834 tests pass.
This commit is contained in:
Graeme Geldenhuys 2026-04-23 15:04:01 +01:00
parent 926b594516
commit 5c0083abee
4 changed files with 97 additions and 58 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
compiler/src/main/pascal/uAST.pas
View file

@ -354,6 +354,7 @@ type
Args: TObjectList; { owned TASTExpr }
ResolvedClassType: TTypeDesc; { not owned; set by uSemantic }
ResolvedMethod: TObject; { TMethodDecl — not owned }
IsConstructorCall: Boolean; { set by uSemantic — TypeName.Create(args) }
constructor Create;
destructor Destroy; override;
end;

31
compiler/src/main/pascal/uCodeGenQBE.pas
View file

@ -2317,7 +2317,36 @@ begin
Exit;
end;
RT := TRecordTypeDesc(MCallExpr.ResolvedClassType);
RT := TRecordTypeDesc(MCallExpr.ResolvedClassType);
{ Constructor call with args: TypeName.Create(args) }
if MCallExpr.IsConstructorCall then
begin
SelfTemp := AllocTemp;
EmitLine(Format(' %s =l call $_ClassAlloc(l %d, l $_FieldCleanup_%s)',
[SelfTemp, RT.TotalSize, RT.Name]));
EmitLine(Format(' call $_ClassAddRef(l %s)', [SelfTemp]));
{ If there's a user-defined Create method, call it }
if MCallExpr.ResolvedMethod <> nil then
begin
MDecl := TMethodDecl(MCallExpr.ResolvedMethod);
ArgLine := Format('l %s', [SelfTemp]);
for I := 0 to MCallExpr.Args.Count - 1 do
begin
Par := TMethodParam(MDecl.Params[I]);
ArgTemp := EmitExpr(TASTExpr(MCallExpr.Args[I]));
ArgLine := ArgLine + Format(', %s %s', [QbeTypeOf(Par.ResolvedType), ArgTemp]);
end;
if MDecl.OwnerTypeName <> '' then
FuncName := '$' + MDecl.OwnerTypeName + '_Create'
else
FuncName := '$' + RT.Name + '_Create';
EmitLine(Format(' call %s(%s)', [FuncName, ArgLine]));
end;
Result := SelfTemp;
Exit;
end;
MDecl := TMethodDecl(MCallExpr.ResolvedMethod);
if MDecl.OwnerTypeName <> '' then
FuncName := '$' + MDecl.OwnerTypeName + '_' + MCallExpr.Name

21
compiler/src/main/pascal/uSemantic.pas
View file

@ -2377,8 +2377,27 @@ begin
ObjSym := FTable.Lookup(AExpr.ObjectName);
if ObjSym = nil then
SemanticError(
Format('Undeclared variable ''%s''', [AExpr.ObjectName]),
Format('Undeclared identifier ''%s''', [AExpr.ObjectName]),
AExpr.Line, AExpr.Col);
{ Constructor call with args: TypeName.Create(arg1, arg2, ...) }
if (ObjSym.Kind = skType) and SameText(AExpr.Name, 'Create') then
begin
if ObjSym.TypeDesc.Kind <> tyClass then
SemanticError(
Format('Cannot construct non-class type ''%s''', [AExpr.ObjectName]),
AExpr.Line, AExpr.Col);
for I := 0 to AExpr.Args.Count - 1 do
AnalyseExpr(TASTExpr(AExpr.Args[I]));
{ Try to find a user-defined Create method for type checking }
MDecl := FindMethodDecl(AExpr.ObjectName, 'Create');
AExpr.ResolvedMethod := MDecl;
AExpr.ResolvedClassType := ObjSym.TypeDesc;
AExpr.IsConstructorCall := True;
Result := ObjSym.TypeDesc;
Exit;
end;
if ObjSym.Kind <> skVariable then
SemanticError(
Format('''%s'' is not a variable', [AExpr.ObjectName]),

102
tests/blaise-compiler.pas
View file

@ -1,58 +1,50 @@
{
Blaise - An Object Pascal Compiler
Blaise - An Object Pascal Compiler — Self-hosting source
Copyright (c) 2026 Graeme Geldenhuys
SPDX-License-Identifier: BSD-3-Clause
blaise-compiler.pas — Self-hosting compiler source.
Generated by concatenating the compiler units in dependency order:
uPasTokeniser → uLexer → uSymbolTable → uAST → uParser →
uSemantic → uCodeGenQBE → main
}
program BlaiseCompiler;
{ ================================================================== }
{ Character code constants (replaces FPC char literals in tokeniser) }
{ ================================================================== }
const
CHR_QUOTE = 39; { ' single-quote }
CHR_HASH = 35; { # }
CHR_DOLLAR = 36; { $ }
CHR_LF = 10; { line feed }
CHR_CR = 13; { carriage return }
CHR_TAB = 9; { tab }
CHR_SPACE = 32; { space }
CHR_0 = 48; { digit 0 }
CHR_9 = 57; { digit 9 }
CHR_A_UP = 65; { uppercase A }
CHR_F_UP = 70; { uppercase F }
CHR_Z_UP = 90; { uppercase Z }
CHR_a_LO = 97; { lowercase a }
CHR_f_LO = 102; { lowercase f }
CHR_z_LO = 122; { lowercase z }
CHR_UNDER = 95; { _ underscore }
CHR_CARET = 94; { ^ caret }
CHR_DOT = 46; { . dot }
CHR_AT = 64; { @ at }
CHR_LT = 60; { < less-than }
CHR_GT = 62; { > greater-than }
CHR_EQ = 61; { = equals }
CHR_PLUS = 43; { + }
CHR_MINUS = 45; { - }
CHR_STAR = 42; { * }
CHR_SLASH = 47; { / }
CHR_LPAREN = 40; { ( }
CHR_RPAREN = 41; { ) }
CHR_LBRACE = 123; { { }
CHR_RBRACE = 125; { } }
CHR_SEMI = 59; { ; }
CHR_COLON = 58; { : }
CHR_LBRACKET = 91; { [ }
CHR_RBRACKET = 93; { ] }
CHR_e_LO = 101; { e }
CHR_E_UP = 69; { E }
CHR_DQUOTE = 34; { " double-quote }
{ Character code constants replacing FPC char literals in uPasTokeniser }
CHR_QUOTE = 39; { ' }
CHR_HASH = 35; { # }
CHR_DOLLAR = 36; { $ }
CHR_LF = 10; { line feed }
CHR_CR = 13; { carriage return }
CHR_TAB = 9; { tab }
CHR_SPACE = 32; { space }
CHR_0 = 48; { 0 }
CHR_9 = 57; { 9 }
CHR_A_UP = 65; { A }
CHR_F_UP = 70; { F }
CHR_Z_UP = 90; { Z }
CHR_a_LO = 97; { a }
CHR_f_LO = 102; { f }
CHR_z_LO = 122; { z }
CHR_UNDER = 95; { _ }
CHR_CARET = 94; { ^ }
CHR_DOT = 46; { . }
CHR_AT = 64; { @ }
CHR_LT = 60; { < }
CHR_GT = 62; { > }
CHR_EQ = 61; { = }
CHR_PLUS = 43; { + }
CHR_MINUS = 45; { - }
CHR_STAR = 42; { * }
CHR_SLASH = 47; { / }
CHR_LPAREN = 40; { ( }
CHR_RPAREN = 41; { ) }
CHR_LBRACE = 123; (* open brace *)
CHR_RBRACE = 125; (* close brace *)
CHR_SEMI = 59; { ; }
CHR_COLON = 58; { : }
CHR_LBRACKET = 91; { [ }
CHR_RBRACKET = 93; { ] }
CHR_e_LO = 101; { e }
CHR_E_UP = 69; { E }
CHR_DQUOTE = 34; { " }
{ ================================================================== }
{ Exception hierarchy }
@ -62,33 +54,31 @@ type
Exception = class
FMessage: string;
constructor Create(AMessage: string);
constructor CreateFmt(const AFmt: string; AArg1: Integer);
constructor CreateFmt(const AFmt: string; AArg2: string);
constructor CreateFmt(const AFmt: string; AArg: Integer);
constructor CreateFmt(const AFmt: string; AStr: string);
property Message: string read FMessage;
end;
EParseError = class(Exception);
ESemanticError = class(Exception);
ECodeGenError = class(Exception);
EExcFrame = class(Exception);
constructor Exception.Create(AMessage: string);
begin
Self.FMessage := AMessage
end;
constructor Exception.CreateFmt(const AFmt: string; AArg1: Integer);
constructor Exception.CreateFmt(const AFmt: string; AArg: Integer);
begin
Self.FMessage := Format(AFmt, AArg1)
Self.FMessage := Format(AFmt, AArg)
end;
constructor Exception.CreateFmt(const AFmt: string; AArg2: string);
constructor Exception.CreateFmt(const AFmt: string; AStr: string);
begin
Self.FMessage := Format(AFmt, AArg2)
Self.FMessage := Format(AFmt, AStr)
end;
{ ================================================================== }
{ RTL: TObjectList and TStringList }
{ RTL Collections: TObjectList and TStringList }
{ ================================================================== }
{