diff --git a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas index 1d67d48..59125ec 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas @@ -12033,8 +12033,16 @@ begin Exit; end; if (SSA.ResolvedArrayType <> nil) and - (SSA.ResolvedArrayType.Kind = tyDynArray) then + (SSA.ResolvedArrayType.Kind in [tyDynArray, tyOpenArray]) then begin + { Open arrays share the dynamic-array element-write path: both address the + element as data_ptr + I*elemsize. The one difference is the var-param + deref below — an open-array param slot already holds the data pointer + directly, so it must NOT be dereferenced a second time (issue #130 + bug5). } + if SSA.ResolvedArrayType.Kind = tyOpenArray then + DAElemType := TOpenArrayTypeDesc(SSA.ResolvedArrayType).ElementType + else DAElemType := TDynArrayTypeDesc(SSA.ResolvedArrayType).ElementType; { Chained / multi-dimensional write A[I][J] := V where the inner array is itself a dynamic array: BaseExpr (A[I]) evaluates to the inner @@ -12116,7 +12124,10 @@ begin else if Self.IsLocal(SSA.ArrayName) then begin Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(SSA.ArrayName)])); - if SSA.IsVarParam then + { An open-array param slot already holds the data pointer, so it is NOT + dereferenced again (a var dynamic-array slot holds the caller-var + address and does need the extra load). } + if SSA.IsVarParam and (SSA.ResolvedArrayType.Kind <> tyOpenArray) then { var/out param: slot -> caller var -> data pointer. } Self.Emit(#9'movq (%rcx), %rcx'); end diff --git a/compiler/src/main/pascal/blaise.codegen.qbe.pas b/compiler/src/main/pascal/blaise.codegen.qbe.pas index b8de531..1e3493c 100644 --- a/compiler/src/main/pascal/blaise.codegen.qbe.pas +++ b/compiler/src/main/pascal/blaise.codegen.qbe.pas @@ -12011,6 +12011,18 @@ begin EmitLine(Format(' %s =w loadw %%_cap_%s', [T, TIdentExpr(AExpr).Name])); end; end + else if (AExpr.ResolvedType <> nil) and + (AExpr.ResolvedType.Kind = tyOpenArray) then + begin + { Open-array parameter: the %_var_X slot holds the DATA POINTER directly + (the caller passes base ptr + high as two params), for BOTH const and + var open arrays. A single load yields that data pointer. Without this + guard a `var` open array fell into the var-param scalar branch below and + dereferenced the data pointer a second time, reading garbage and + crashing (issue #130 bug5). } + EmitLine(Format(' %s =l loadl %%_var_%s', [T, TIdentExpr(AExpr).Name])); + Exit(T); + end else if TIdentExpr(AExpr).ParamMode = pmJumboSetValue then begin { Jumbo set value param: the QBE backend spills it into a local inline diff --git a/compiler/src/main/pascal/uSemantic.pas b/compiler/src/main/pascal/uSemantic.pas index 5948402..ab87ff7 100644 --- a/compiler/src/main/pascal/uSemantic.pas +++ b/compiler/src/main/pascal/uSemantic.pas @@ -11665,6 +11665,28 @@ begin Format('''%s'' element', [AStmt.ArrayName]), AStmt.Line, AStmt.Col); Exit; end; + { Open-array parameter subscript write: a[I] := V. An open-array param is a + (data ptr, high) pair; an element write needs a var/out param so the pointer + refers to the caller's storage. A `const` open array is read-only and + rejected. (issue #130 bug5) } + if Sym.TypeDesc.Kind = tyOpenArray then + begin + if Sym.Kind <> skVarParameter then + SemanticError(Format( + 'cannot assign to an element of ''%s'': a const open-array parameter ' + + 'is read-only (declare it ''var'')', [AStmt.ArrayName]), + AStmt.Line, AStmt.Col); + AStmt.IsGlobal := False; + AStmt.IsVarParam := True; + AStmt.ResolvedArrayType := Sym.TypeDesc; + IdxType := AnalyseExpr(AStmt.IndexExpr); + if not IdxType.IsNumeric() then + SemanticError('Open array index must be numeric', AStmt.Line, AStmt.Col); + ValType := AnalyseExpr(AStmt.ValueExpr); + CheckTypesMatch(TOpenArrayTypeDesc(Sym.TypeDesc).ElementType, ValType, + Format('''%s'' element', [AStmt.ArrayName]), AStmt.Line, AStmt.Col); + Exit; + end; if Sym.TypeDesc.Kind <> tyStaticArray then SemanticError( Format('''%s'' is not a static array or dynamic array', [AStmt.ArrayName]), diff --git a/compiler/src/test/pascal/cp.test.e2e.openarray.pas b/compiler/src/test/pascal/cp.test.e2e.openarray.pas index 23c14fe..362971c 100644 --- a/compiler/src/test/pascal/cp.test.e2e.openarray.pas +++ b/compiler/src/test/pascal/cp.test.e2e.openarray.pas @@ -56,6 +56,13 @@ type { Empty bracket literal [] as an open-array argument } procedure TestRun_EmptyLiteral_ToOpenArray; procedure TestRun_EmptyLiteral_OverloadDisambiguation; + + { var open-array parameter (issue #130 bug5): element READ used to segfault + on QBE (extra deref of the data pointer) and element WRITE was a semantic + error / native codegen error. A const open array stays read-only. } + procedure TestRun_VarOpenArray_ElementRead; + procedure TestRun_VarOpenArray_ElementWrite; + procedure TestRun_VarOpenArray_ReadModifyWrite; end; implementation @@ -536,6 +543,68 @@ begin AssertRunsOnAll(Src, 'oa 0' + #10 + 'oa 1' + #10 + 'int' + #10, 0); end; +procedure TE2EOpenArrayTests.TestRun_VarOpenArray_ElementRead; +const + { Read-only body on a var open array — the exact issue #130 repro. } + Src = ''' + program P; + procedure SumVar(var a: array of Integer); + var i, s: Integer; + begin s := 0; for i := 0 to High(a) do s := s + a[i]; WriteLn(s) end; + var x: array[0..2] of Integer; + begin x[0] := 1; x[1] := 2; x[2] := 3; SumVar(x) end. + '''; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(Src, '6' + #10, 0); +end; + +procedure TE2EOpenArrayTests.TestRun_VarOpenArray_ElementWrite; +const + { Element write through a var open array mutates the caller's storage. } + Src = ''' + program P; + procedure Zero(var a: array of Integer); + var i: Integer; + begin for i := 0 to High(a) do a[i] := 0 end; + var x: array[0..2] of Integer; i: Integer; + begin + x[0] := 1; x[1] := 2; x[2] := 3; + Zero(x); + for i := 0 to 2 do WriteLn(x[i]) + end. + '''; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(Src, '0' + #10 + '0' + #10 + '0' + #10, 0); +end; + +procedure TE2EOpenArrayTests.TestRun_VarOpenArray_ReadModifyWrite; +const + { Read and write the same element (a[i] := a[i] * by) through a var open + array, then read it back via a const open array. } + Src = ''' + program P; + procedure Scale(var a: array of Integer; by: Integer); + var i: Integer; + begin for i := 0 to High(a) do a[i] := a[i] * by end; + function SumC(const a: array of Integer): Integer; + var i: Integer; + begin Result := 0; for i := 0 to High(a) do Result := Result + a[i] end; + var x: array[0..3] of Integer; i: Integer; + begin + for i := 0 to 3 do x[i] := i + 1; + Scale(x, 10); + for i := 0 to 3 do WriteLn(x[i]); + WriteLn('sum=', SumC(x)) + end. + '''; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(Src, + '10' + #10 + '20' + #10 + '30' + #10 + '40' + #10 + 'sum=100' + #10, 0); +end; + initialization RegisterTest(TE2EOpenArrayTests); diff --git a/compiler/src/test/pascal/cp.test.semantic.pas b/compiler/src/test/pascal/cp.test.semantic.pas index a6e4504..5ed7692 100644 --- a/compiler/src/test/pascal/cp.test.semantic.pas +++ b/compiler/src/test/pascal/cp.test.semantic.pas @@ -83,6 +83,10 @@ type { Full program analysis } procedure TestProgram_HelloWorld_OK; procedure TestProgram_ArithmeticAndPrint_OK; + + { var/const open-array element write (issue #130 bug5) } + procedure TestVarOpenArray_ElementWrite_OK; + procedure TestConstOpenArray_ElementWrite_RaisesError; end; implementation @@ -549,6 +553,24 @@ begin ).Free(); end; +procedure TSemanticTests.TestVarOpenArray_ElementWrite_OK; +begin + { Writing an element of a VAR open-array parameter is allowed. } + Analyse( + 'program P; ' + + 'procedure Z(var a: array of Integer); begin a[0] := 9 end; ' + + 'var x: array[0..1] of Integer; begin x[0]:=1; x[1]:=2; Z(x) end.').Free(); +end; + +procedure TSemanticTests.TestConstOpenArray_ElementWrite_RaisesError; +begin + { Writing an element of a CONST open-array parameter is rejected. } + AnalyseExpectError( + 'program P; ' + + 'procedure B(const a: array of Integer); begin a[0] := 9 end; ' + + 'var x: array[0..1] of Integer; begin x[0]:=1; x[1]:=2; B(x) end.'); +end; + initialization RegisterTest(TSemanticTests);