public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-7659] PR modula2/110174 Bugfixes to M2GenGCC.mod:CodeInline preventing an ICE
@ 2023-07-31 0:05 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2023-07-31 0:05 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:c8024088ccc263833d005afe7df835109db1965b
commit r13-7659-gc8024088ccc263833d005afe7df835109db1965b
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date: Mon Jul 31 01:05:20 2023 +0100
PR modula2/110174 Bugfixes to M2GenGCC.mod:CodeInline preventing an ICE
This patch calls skip_const_decl before chaining parameter values and
ensures that all strings passed to build_stmt (..., ASM_EXPR, ...) are
nul terminated. It also improves the accuracy of locations in
function calls and asm statements.
gcc/m2/
PR modula2/110174
* gm2-compiler/M2GCCDeclare.def (PromoteToCString): New procedure
function.
* gm2-compiler/M2GCCDeclare.mod (PromoteToCString): New procedure
function.
* gm2-compiler/M2GenGCC.mod (BuildTreeFromInterface): Call
skip_const_decl before chaining the parameter value.
Use PromoteToCString to ensure the string is nul terminated.
(CodeInline): Remove all parameters and replace with quad.
Use GetQuadOtok to get operand token numbers.
Remove call to DeclareConstant and replace it with PromoteToCString.
* gm2-compiler/M2Quads.def (BuildInline): Rename into ...
(BuildAsm): ... this.
* gm2-compiler/M2Quads.mod: (BuildInline): Rename into ...
(BuildAsm): ... this.
(BuildAsmElement): Add debugging.
* gm2-compiler/P1Build.bnf: Remove import of BuildInline.
* gm2-compiler/P2Build.bnf: Remove import of BuildInline.
* gm2-compiler/P3Build.bnf: Remove import of BuildInline and
import BuildAsm.
* gm2-compiler/PHBuild.bnf: Remove import of BuildInline.
* gm2-libs-iso/SysClock.mod (foo): Remove.
* gm2-libs/FIO.mod (BufferedRead): Rename parameter a to dest.
Rename variable t to src.
* m2pp.cc (pf): Correct block comment.
(pe): Correct block comment.
(m2pp_asm_expr): New function.
(m2pp_statement): Call m2pp_asm_expr.
gcc/testsuite/
PR modula2/110174
* gm2/pim/pass/program2.mod: Remove import of BuildInline.
* gm2/extensions/asm/fail/extensions-asm-fail.exp: New test.
* gm2/extensions/asm/fail/stressreturn.mod: New test.
* gm2/extensions/asm/pass/extensions-asm-pass.exp: New test.
* gm2/extensions/asm/pass/fooasm.mod: New test.
(cherry picked from commit c4637cbed3f23095b98962b41063380c4ab9eda9)
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2GCCDeclare.def | 23 ++++---
gcc/m2/gm2-compiler/M2GCCDeclare.mod | 27 ++++++++
gcc/m2/gm2-compiler/M2GenGCC.mod | 73 ++++++++++++++--------
gcc/m2/gm2-compiler/M2Quads.def | 20 +++---
gcc/m2/gm2-compiler/M2Quads.mod | 39 ++++++++----
gcc/m2/gm2-compiler/P1Build.bnf | 3 +-
gcc/m2/gm2-compiler/P2Build.bnf | 1 -
gcc/m2/gm2-compiler/P3Build.bnf | 38 +++++------
gcc/m2/gm2-compiler/PHBuild.bnf | 1 -
gcc/m2/gm2-libs-iso/SysClock.mod | 10 ---
gcc/m2/gm2-libs/FIO.mod | 48 +++++++-------
gcc/m2/m2pp.cc | 39 ++++++++++--
.../extensions/asm/fail/extensions-asm-fail.exp | 37 +++++++++++
.../gm2/extensions/asm/fail/stressreturn.mod | 14 +++++
.../extensions/asm/pass/extensions-asm-pass.exp | 37 +++++++++++
gcc/testsuite/gm2/extensions/asm/pass/fooasm.mod | 13 ++++
gcc/testsuite/gm2/pim/pass/program2.mod | 3 +-
17 files changed, 302 insertions(+), 124 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.def b/gcc/m2/gm2-compiler/M2GCCDeclare.def
index 38ca33f1486..91b66fab3ba 100644
--- a/gcc/m2/gm2-compiler/M2GCCDeclare.def
+++ b/gcc/m2/gm2-compiler/M2GCCDeclare.def
@@ -32,18 +32,6 @@ DEFINITION MODULE M2GCCDeclare ;
FROM SYSTEM IMPORT WORD ;
FROM m2tree IMPORT Tree ;
-EXPORT QUALIFIED FoldConstants,
- DeclareConstant, TryDeclareConstant,
- DeclareConstructor, TryDeclareConstructor,
- DeclareLocalVariables, PromoteToString, DeclareLocalVariable,
- InitDeclarations, StartDeclareScope, EndDeclareScope,
- DeclareModuleVariables, IsProcedureGccNested,
- DeclareProcedure, PoisonSymbols, DeclareParameters,
- CompletelyResolved, MarkExported, PrintSym,
- ConstantKnownAndUsed,
- PutToBeSolvedByQuads,
- GetTypeMin, GetTypeMax,
- WalkAction, IsAction ;
TYPE
WalkAction = PROCEDURE (WORD) ;
@@ -173,6 +161,17 @@ PROCEDURE PoisonSymbols (sym: CARDINAL) ;
PROCEDURE PromoteToString (tokenno: CARDINAL; sym: CARDINAL) : Tree ;
+(*
+ PromoteToCString - declare, sym, and then promote it to a string.
+ Note that if sym is a single character we do
+ *not* record it as a string
+ but as a char however we always
+ return a string constant.
+*)
+
+PROCEDURE PromoteToCString (tokenno: CARDINAL; sym: CARDINAL) : Tree ;
+
+
(*
CompletelyResolved - returns TRUE if a symbol has been completely resolved
and is not partially declared (such as a record,
diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
index 92de4b4b2e6..37235f08e97 100644
--- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod
+++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
@@ -1583,6 +1583,33 @@ BEGIN
END PromoteToString ;
+(*
+ PromoteToCString - declare, sym, and then promote it to a string.
+ Note that if sym is a single character we do
+ *not* record it as a string
+ but as a char however we always
+ return a string constant.
+*)
+
+PROCEDURE PromoteToCString (tokenno: CARDINAL; sym: CARDINAL) : Tree ;
+VAR
+ size: CARDINAL ;
+ ch : CHAR ;
+BEGIN
+ DeclareConstant (tokenno, sym) ;
+ IF IsConst (sym) AND (GetSType (sym) = Char)
+ THEN
+ PushValue (sym) ;
+ ch := PopChar (tokenno) ;
+ RETURN BuildCStringConstant (string (InitStringChar (ch)), 1)
+ ELSE
+ size := GetStringLength (sym) ;
+ RETURN BuildCStringConstant (KeyToCharStar (GetString (sym)),
+ size)
+ END
+END PromoteToCString ;
+
+
(*
WalkConstructor - walks all dependants of, sym.
*)
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index d701543df76..bcef4e70c40 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -150,7 +150,7 @@ FROM M2GCCDeclare IMPORT WalkAction,
DeclareConstant, TryDeclareConstant,
DeclareConstructor, TryDeclareConstructor,
StartDeclareScope, EndDeclareScope,
- PromoteToString, DeclareLocalVariable,
+ PromoteToString, PromoteToCString, DeclareLocalVariable,
CompletelyResolved,
PoisonSymbols, GetTypeMin, GetTypeMax,
IsProcedureGccNested, DeclareParameters,
@@ -208,10 +208,11 @@ FROM m2expr IMPORT GetIntegerZero, GetIntegerOne,
BuildAddAddress,
BuildIfInRangeGoto, BuildIfNotInRangeGoto ;
-FROM m2tree IMPORT Tree, debug_tree ;
+FROM m2tree IMPORT Tree, debug_tree, skip_const_decl ;
FROM m2linemap IMPORT location_t ;
-FROM m2decl IMPORT BuildStringConstant, DeclareKnownConstant, GetBitsPerBitset,
+FROM m2decl IMPORT BuildStringConstant, BuildCStringConstant,
+ DeclareKnownConstant, GetBitsPerBitset,
BuildIntegerConstant,
BuildModuleCtor, DeclareModuleCtor ;
@@ -530,7 +531,7 @@ BEGIN
SavePriorityOp : CodeSavePriority (op1, op2, op3) |
RestorePriorityOp : CodeRestorePriority (op1, op2, op3) |
- InlineOp : CodeInline (location, CurrentQuadToken, op3) |
+ InlineOp : CodeInline (q) |
StatementNoteOp : CodeStatementNote (op3) |
CodeOnOp : | (* the following make no sense with gcc *)
CodeOffOp : |
@@ -702,6 +703,8 @@ END FindType ;
*)
PROCEDURE BuildTreeFromInterface (sym: CARDINAL) : Tree ;
+CONST
+ DebugTokPos = FALSE ;
VAR
tok : CARDINAL ;
i : CARDINAL ;
@@ -717,7 +720,7 @@ BEGIN
i := 1 ;
REPEAT
GetRegInterface (sym, i, tok, name, str, obj) ;
- IF str#NulSym
+ IF str # NulSym
THEN
IF IsConstString (str)
THEN
@@ -726,11 +729,18 @@ BEGIN
THEN
gccName := NIL
ELSE
- gccName := BuildStringConstant (KeyToCharStar (name), LengthKey (name))
+ gccName := BuildCStringConstant (KeyToCharStar (name), LengthKey (name))
END ;
- tree := ChainOnParamValue (tree, gccName, PromoteToString (tok, str), Mod2Gcc (obj))
+ tree := ChainOnParamValue (tree, gccName, PromoteToCString (tok, str),
+ skip_const_decl (Mod2Gcc (obj))) ;
+ IF DebugTokPos
+ THEN
+ WarnStringAt (InitString ('input expression'), tok)
+ END
ELSE
- WriteFormat0 ('a constraint to the GNU ASM statement must be a constant string')
+ MetaErrorT1 (tok,
+ 'a constraint to the GNU ASM statement must be a constant string and not a {%1Ed}',
+ str)
END
END ;
INC(i)
@@ -745,6 +755,8 @@ END BuildTreeFromInterface ;
*)
PROCEDURE BuildTrashTreeFromInterface (sym: CARDINAL) : Tree ;
+CONST
+ DebugTokPos = FALSE ;
VAR
tok : CARDINAL ;
i : CARDINAL ;
@@ -763,9 +775,15 @@ BEGIN
THEN
IF IsConstString (str)
THEN
- tree := AddStringToTreeList (tree, PromoteToString (tok, str))
+ tree := AddStringToTreeList (tree, PromoteToCString (tok, str)) ;
+ IF DebugTokPos
+ THEN
+ WarnStringAt (InitString ('trash expression'), tok)
+ END
ELSE
- WriteFormat0 ('a constraint to the GNU ASM statement must be a constant string')
+ MetaErrorT1 (tok,
+ 'a constraint to the GNU ASM statement must be a constant string and not a {%1Ed}',
+ str)
END
END ;
(*
@@ -785,33 +803,34 @@ END BuildTrashTreeFromInterface ;
CodeInline - InlineOp is a quadruple which has the following format:
InlineOp NulSym NulSym Sym
-
- The inline asm statement, Sym, is written to standard output.
*)
-PROCEDURE CodeInline (location: location_t; tokenno: CARDINAL; GnuAsm: CARDINAL) ;
+PROCEDURE CodeInline (quad: CARDINAL) ;
VAR
- string : CARDINAL ;
+ overflowChecking: BOOLEAN ;
+ op : QuadOperator ;
+ op1, op2, GnuAsm: CARDINAL ;
+ op1pos, op2pos,
+ op3pos, asmpos : CARDINAL ;
+ string : CARDINAL ;
inputs,
outputs,
trash,
- labels : Tree ;
+ labels : Tree ;
+ location : location_t ;
BEGIN
- (*
- no need to explicity flush the outstanding instructions as
- per M2GenDyn486 and M2GenAPU. The GNU ASM statements in GCC
- can handle the register dependency providing the user
- specifies VOLATILE and input/output/trash sets correctly.
- *)
- inputs := BuildTreeFromInterface (GetGnuAsmInput(GnuAsm)) ;
- outputs := BuildTreeFromInterface (GetGnuAsmOutput(GnuAsm)) ;
- trash := BuildTrashTreeFromInterface (GetGnuAsmTrash(GnuAsm)) ;
- labels := NIL ; (* at present it makes no sence for Modula-2 to jump to a label,
+ GetQuadOtok (quad, asmpos, op, op1, op2, GnuAsm, overflowChecking,
+ op1pos, op2pos, op3pos) ;
+ location := TokenToLocation (asmpos) ;
+ inputs := BuildTreeFromInterface (GetGnuAsmInput (GnuAsm)) ;
+ outputs := BuildTreeFromInterface (GetGnuAsmOutput (GnuAsm)) ;
+ trash := BuildTrashTreeFromInterface (GetGnuAsmTrash (GnuAsm)) ;
+ labels := NIL ; (* At present it makes no sence for Modula-2 to jump to a label,
given that labels are not allowed in Modula-2. *)
string := GetGnuAsm (GnuAsm) ;
- DeclareConstant (tokenno, string) ;
BuildAsm (location,
- Mod2Gcc (string), IsGnuAsmVolatile (GnuAsm), IsGnuAsmSimple (GnuAsm),
+ PromoteToCString (GetDeclaredMod (string), string),
+ IsGnuAsmVolatile (GnuAsm), IsGnuAsmSimple (GnuAsm),
inputs, outputs, trash, labels)
END CodeInline ;
diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def
index 3a4059513cd..3fc9dfbdb34 100644
--- a/gcc/m2/gm2-compiler/M2Quads.def
+++ b/gcc/m2/gm2-compiler/M2Quads.def
@@ -88,7 +88,7 @@ EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile, EndBuildFile,
BuildCodeOn, BuildCodeOff,
BuildProfileOn, BuildProfileOff,
BuildOptimizeOn, BuildOptimizeOff,
- BuildInline, BuildStmtNote, BuildLineNo, PushLineNo,
+ BuildAsm, BuildStmtNote, BuildLineNo, PushLineNo,
BuildConstructor,
BuildConstructorStart,
BuildConstructorEnd,
@@ -2518,23 +2518,23 @@ PROCEDURE BuildOptimizeOff ;
(*
- BuildInline - builds an Inline pseudo quadruple operator.
- The inline interface, Sym, is stored as the operand
- to the operator InlineOp.
+ BuildAsm - builds an Inline pseudo quadruple operator.
+ The inline interface, Sym, is stored as the operand
+ to the operator InlineOp.
- The stack is expected to contain:
+ The stack is expected to contain:
Entry Exit
===== ====
- Ptr ->
- +--------------+
- | Sym | Empty
- |--------------|
+ Ptr ->
+ +--------------+
+ | Sym | Empty
+ |--------------|
*)
-PROCEDURE BuildInline ;
+PROCEDURE BuildAsm (tok: CARDINAL) ;
(*
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 51c2835d082..44648deb49f 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -14121,29 +14121,29 @@ END BuildOptimizeOff ;
(*
- BuildInline - builds an Inline pseudo quadruple operator.
- The inline interface, Sym, is stored as the operand
- to the operator InlineOp.
+ BuildAsm - builds an Inline pseudo quadruple operator.
+ The inline interface, Sym, is stored as the operand
+ to the operator InlineOp.
- The stack is expected to contain:
+ The stack is expected to contain:
Entry Exit
===== ====
- Ptr ->
- +--------------+
- | Sym | Empty
- |--------------|
+ Ptr ->
+ +--------------+
+ | Sym | Empty
+ |--------------|
*)
-PROCEDURE BuildInline ;
+PROCEDURE BuildAsm (tok: CARDINAL) ;
VAR
Sym: CARDINAL ;
BEGIN
PopT (Sym) ;
- GenQuad (InlineOp, NulSym, NulSym, Sym)
-END BuildInline ;
+ GenQuadO (tok, InlineOp, NulSym, NulSym, Sym, FALSE)
+END BuildAsm ;
(*
@@ -14541,7 +14541,10 @@ END AddVarientEquality ;
*)
PROCEDURE BuildAsmElement (input, output: BOOLEAN) ;
+CONST
+ DebugAsmTokPos = FALSE ;
VAR
+ s : String ;
n, str, expr, tokpos,
CurrentInterface,
CurrentAsm, name : CARDINAL ;
@@ -14561,12 +14564,22 @@ BEGIN
IF input
THEN
PutRegInterface (tokpos, CurrentInterface, n, name, str, expr,
- NextQuad, 0)
+ NextQuad, 0) ;
+ IF DebugAsmTokPos
+ THEN
+ s := InitString ('input expression') ;
+ WarnStringAt (s, tokpos)
+ END
END ;
IF output
THEN
PutRegInterface (tokpos, CurrentInterface, n, name, str, expr,
- 0, NextQuad)
+ 0, NextQuad) ;
+ IF DebugAsmTokPos
+ THEN
+ s := InitString ('output expression') ;
+ WarnStringAt (s, tokpos)
+ END
END ;
PushT (n) ;
PushT (CurrentAsm) ;
diff --git a/gcc/m2/gm2-compiler/P1Build.bnf b/gcc/m2/gm2-compiler/P1Build.bnf
index 5be6af4ddcb..a4772753bf5 100644
--- a/gcc/m2/gm2-compiler/P1Build.bnf
+++ b/gcc/m2/gm2-compiler/P1Build.bnf
@@ -64,8 +64,7 @@ FROM M2Quads IMPORT PushT, PopT,
EndBuildInit,
BuildProcedureStart,
BuildProcedureEnd,
- BuildAssignment,
- BuildInline ;
+ BuildAssignment ;
FROM P1SymBuild IMPORT P1StartBuildProgramModule,
P1EndBuildProgramModule,
diff --git a/gcc/m2/gm2-compiler/P2Build.bnf b/gcc/m2/gm2-compiler/P2Build.bnf
index 0a82e6b97f1..b5cdbfeb64f 100644
--- a/gcc/m2/gm2-compiler/P2Build.bnf
+++ b/gcc/m2/gm2-compiler/P2Build.bnf
@@ -60,7 +60,6 @@ FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing, OperandT, PushTFA, T
BuildProcedureStart,
BuildProcedureEnd,
BuildAssignment,
- BuildInline,
AddRecordToList, AddVarientToList,
IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto, DisplayStack ;
diff --git a/gcc/m2/gm2-compiler/P3Build.bnf b/gcc/m2/gm2-compiler/P3Build.bnf
index e50620e0a4e..bcff7579164 100644
--- a/gcc/m2/gm2-compiler/P3Build.bnf
+++ b/gcc/m2/gm2-compiler/P3Build.bnf
@@ -98,7 +98,7 @@ FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing, Annotate,
BuildProcedureCall, BuildReturn, BuildNulExpression,
CheckBuildFunction,
StartBuildWith, EndBuildWith,
- BuildInline,
+ BuildAsm,
BuildCaseStart,
BuildCaseOr,
BuildCaseElse,
@@ -1461,17 +1461,19 @@ Definition := "CONST" { ConstantDeclaration ";" } |
"VAR" { VariableDeclaration ";" } |
DefProcedureHeading ";" =:
-AsmStatement := % VAR CurrentAsm: CARDINAL ; %
+AsmStatement := % VAR CurrentAsm: CARDINAL ;
+ tok: CARDINAL ; %
+ % tok := GetTokenNo () %
'ASM' % PushAutoOn ;
- PushT(0) ; (* operand count *)
- PushT(MakeGnuAsm())
+ PushT (0) ; (* operand count *)
+ PushT (MakeGnuAsm ())
%
- [ 'VOLATILE' % PopT(CurrentAsm) ;
- PutGnuAsmVolatile(CurrentAsm) ;
- PushT(CurrentAsm)
+ [ 'VOLATILE' % PopT (CurrentAsm) ;
+ PutGnuAsmVolatile (CurrentAsm) ;
+ PushT (CurrentAsm)
%
] '(' AsmOperands % PopNothing ; (* throw away interface sym *)
- BuildInline ;
+ BuildAsm (tok) ;
PopNothing ; (* throw away count *)
PopAuto
%
@@ -1480,22 +1482,22 @@ AsmStatement := % VAR
AsmOperands := % VAR CurrentAsm, count: CARDINAL ;
str: CARDINAL ;
%
- ConstExpression % PopT(str) ;
- PopT(CurrentAsm) ;
- Assert(IsGnuAsm(CurrentAsm) OR IsGnuAsmVolatile(CurrentAsm)) ;
- PopT(count) ;
+ ConstExpression % PopT (str) ;
+ PopT (CurrentAsm) ;
+ Assert (IsGnuAsm (CurrentAsm) OR IsGnuAsmVolatile (CurrentAsm)) ;
+ PopT (count) ;
IF DebugAsm
THEN
- printf1('1: count of asm operands: %d\n', count)
+ printf1 ('1: count of asm operands: %d\n', count)
END ;
- PushT(count) ;
+ PushT (count) ;
(* adds the name/instruction for this asm *)
- PutGnuAsm(CurrentAsm, str) ;
- PushT(CurrentAsm) ;
- PushT(NulSym) (* the InterfaceSym *)
+ PutGnuAsm (CurrentAsm, str) ;
+ PushT (CurrentAsm) ;
+ PushT (NulSym) (* the InterfaceSym *)
%
( AsmOperandSpec | % (* epsilon *)
- PutGnuAsmSimple(CurrentAsm)
+ PutGnuAsmSimple (CurrentAsm)
%
)
=:
diff --git a/gcc/m2/gm2-compiler/PHBuild.bnf b/gcc/m2/gm2-compiler/PHBuild.bnf
index c829a6ee0b0..c1ab70d5875 100644
--- a/gcc/m2/gm2-compiler/PHBuild.bnf
+++ b/gcc/m2/gm2-compiler/PHBuild.bnf
@@ -79,7 +79,6 @@ FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing, Annotate,
BuildElsif1, BuildElsif2,
BuildProcedureCall, BuildReturn, BuildNulExpression,
StartBuildWith, EndBuildWith,
- BuildInline,
BuildCaseStart,
BuildCaseOr,
BuildCaseElse,
diff --git a/gcc/m2/gm2-libs-iso/SysClock.mod b/gcc/m2/gm2-libs-iso/SysClock.mod
index c5fd2ebcdfb..e89448927e2 100644
--- a/gcc/m2/gm2-libs-iso/SysClock.mod
+++ b/gcc/m2/gm2-libs-iso/SysClock.mod
@@ -114,16 +114,6 @@ BEGIN
END IsValidDateTime ;
-(*
- foo -
-*)
-
-PROCEDURE foo () : CARDINAL ;
-BEGIN
- RETURN 1
-END foo ;
-
-
PROCEDURE GetClock (VAR userData: DateTime) ;
(* Assigns local date and time of the day to userData *)
VAR
diff --git a/gcc/m2/gm2-libs/FIO.mod b/gcc/m2/gm2-libs/FIO.mod
index dd6f48c446f..b46d505d30c 100644
--- a/gcc/m2/gm2-libs/FIO.mod
+++ b/gcc/m2/gm2-libs/FIO.mod
@@ -664,9 +664,9 @@ END ReadNBytes ;
Useful when performing small reads.
*)
-PROCEDURE BufferedRead (f: File; nBytes: CARDINAL; a: ADDRESS) : INTEGER ;
+PROCEDURE BufferedRead (f: File; nBytes: CARDINAL; dest: ADDRESS) : INTEGER ;
VAR
- t : ADDRESS ;
+ src : ADDRESS ;
total,
n : INTEGER ;
p : POINTER TO BYTE ;
@@ -674,52 +674,52 @@ VAR
BEGIN
IF f#Error
THEN
- fd := GetIndice(FileInfo, f) ;
+ fd := GetIndice (FileInfo, f) ;
total := 0 ; (* how many bytes have we read *)
IF fd#NIL
THEN
WITH fd^ DO
(* extract from the buffer first *)
- IF buffer#NIL
+ IF buffer # NIL
THEN
WITH buffer^ DO
- WHILE nBytes>0 DO
- IF (left>0) AND valid
+ WHILE nBytes > 0 DO
+ IF (left > 0) AND valid
THEN
- IF nBytes=1
+ IF nBytes = 1
THEN
(* too expensive to call memcpy for 1 character *)
- p := a ;
+ p := dest ;
p^ := contents^[position] ;
- DEC(left) ; (* remove consumed byte *)
- INC(position) ; (* move onwards n byte *)
- INC(total) ;
+ DEC (left) ; (* remove consumed byte *)
+ INC (position) ; (* move onwards n byte *)
+ INC (total) ;
RETURN( total )
ELSE
- n := Min(left, nBytes) ;
- t := address ;
- INC(t, position) ;
- p := memcpy(a, t, n) ;
- DEC(left, n) ; (* remove consumed bytes *)
- INC(position, n) ; (* move onwards n bytes *)
+ n := Min (left, nBytes) ;
+ src := address ;
+ INC (src, position) ;
+ p := memcpy (dest, src, n) ;
+ DEC (left, n) ; (* remove consumed bytes *)
+ INC (position, n) ; (* move onwards n bytes *)
(* move onwards ready for direct reads *)
- INC(a, n) ;
- DEC(nBytes, n) ; (* reduce the amount for future direct *)
+ INC (dest, n) ;
+ DEC (nBytes, n) ; (* reduce the amount for future direct *)
(* read *)
- INC(total, n)
+ INC (total, n)
END
ELSE
(* refill buffer *)
- n := read(unixfd, address, size) ;
- IF n>=0
+ n := read (unixfd, address, size) ;
+ IF n >= 0
THEN
valid := TRUE ;
position := 0 ;
left := n ;
filled := n ;
bufstart := abspos ;
- INC(abspos, n) ;
- IF n=0
+ INC (abspos, n) ;
+ IF n = 0
THEN
(* eof reached *)
state := endoffile ;
diff --git a/gcc/m2/m2pp.cc b/gcc/m2/m2pp.cc
index 21d1cb9dce7..5938b6be8fb 100644
--- a/gcc/m2/m2pp.cc
+++ b/gcc/m2/m2pp.cc
@@ -183,7 +183,7 @@ do_pf (tree t, int bits)
}
/* pf print function. Expected to be printed interactively from
- the debugger: print pf(func), or to be called from code. */
+ the debugger: print modula2::pf(func), or to be called from code. */
void
pf (tree t)
@@ -192,7 +192,7 @@ pf (tree t)
}
/* pe print expression. Expected to be printed interactively from
- the debugger: print pe(expr), or to be called from code. */
+ the debugger: print modula2::pe(expr), or to be called from code. */
void
pe (tree t)
@@ -206,8 +206,8 @@ pe (tree t)
}
/* pet print expression and its type. Expected to be printed
- interactively from the debugger: print pet(expr), or to be called
- from code. */
+ interactively from the debugger: print modula2::pet(expr), or to
+ be called from code. */
void
pet (tree t)
@@ -2209,6 +2209,34 @@ m2pp_if_stmt (pretty *s, tree t)
}
#endif
+static void
+m2pp_asm_expr (pretty *state, tree node)
+{
+ m2pp_begin (state);
+ m2pp_print (state, "ASM");
+ m2pp_needspace (state);
+ if (ASM_VOLATILE_P (node))
+ {
+ m2pp_print (state, "VOLATILE");
+ m2pp_needspace (state);
+ }
+ m2pp_print (state, "(");
+ m2pp_expression (state, ASM_STRING (node));
+ m2pp_print (state, ":");
+ m2pp_needspace (state);
+ m2pp_expression (state, ASM_OUTPUTS (node));
+ m2pp_print (state, ":");
+ m2pp_needspace (state);
+ m2pp_expression (state, ASM_INPUTS (node));
+ if (ASM_CLOBBERS (node) != NULL)
+ {
+ m2pp_print (state, ":");
+ m2pp_needspace (state);
+ m2pp_expression (state, ASM_CLOBBERS (node));
+ }
+ m2pp_print (state, ");\n");
+}
+
/* m2pp_statement attempts to reconstruct a statement. */
static void
@@ -2271,6 +2299,9 @@ m2pp_statement (pretty *s, tree t)
case CATCH_EXPR:
m2pp_catch_expr (s, t);
break;
+ case ASM_EXPR:
+ m2pp_asm_expr (s, t);
+ break;
#if defined(CPP)
case IF_STMT:
m2pp_if_stmt (s, t);
diff --git a/gcc/testsuite/gm2/extensions/asm/fail/extensions-asm-fail.exp b/gcc/testsuite/gm2/extensions/asm/fail/extensions-asm-fail.exp
new file mode 100644
index 00000000000..6447c771bb6
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/asm/fail/extensions-asm-fail.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2023 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/extensions/asm/fail"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $testcase] then {
+ continue
+ }
+
+ gm2-torture-fail $testcase
+}
diff --git a/gcc/testsuite/gm2/extensions/asm/fail/stressreturn.mod b/gcc/testsuite/gm2/extensions/asm/fail/stressreturn.mod
new file mode 100644
index 00000000000..79e2a6f667e
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/asm/fail/stressreturn.mod
@@ -0,0 +1,14 @@
+MODULE stressreturn ;
+FROM Builtins IMPORT return_address;
+FROM SYSTEM IMPORT ADDRESS;
+
+VAR x: ADDRESS;
+
+PROCEDURE test;
+BEGIN
+ ASM VOLATILE("" : "=m"(x) : "m"(return_address(0)) : );
+END test;
+
+BEGIN
+ test
+END stressreturn.
diff --git a/gcc/testsuite/gm2/extensions/asm/pass/extensions-asm-pass.exp b/gcc/testsuite/gm2/extensions/asm/pass/extensions-asm-pass.exp
new file mode 100644
index 00000000000..03bfbd03e91
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/asm/pass/extensions-asm-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2023 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaiusmod2@gmail.com)
+# for GNU Modula-2.
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/extensions/asm/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $testcase] then {
+ continue
+ }
+
+ gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/extensions/asm/pass/fooasm.mod b/gcc/testsuite/gm2/extensions/asm/pass/fooasm.mod
new file mode 100644
index 00000000000..da111142ea6
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/asm/pass/fooasm.mod
@@ -0,0 +1,13 @@
+MODULE fooasm ;
+
+VAR
+ x: INTEGER ;
+
+PROCEDURE test ;
+BEGIN
+ ASM("" : : "m"(x))
+END test ;
+
+BEGIN
+ test
+END fooasm.
diff --git a/gcc/testsuite/gm2/pim/pass/program2.mod b/gcc/testsuite/gm2/pim/pass/program2.mod
index 63345896c50..4efe2d4b429 100644
--- a/gcc/testsuite/gm2/pim/pass/program2.mod
+++ b/gcc/testsuite/gm2/pim/pass/program2.mod
@@ -37,8 +37,7 @@ FROM M2Quads IMPORT PushT, PopT,
EndBuildInit,
BuildProcedureStart,
BuildProcedureEnd,
- BuildAssignment,
- BuildInline ;
+ BuildAssignment ;
FROM P1SymBuild IMPORT P1StartBuildProgramModule,
P1EndBuildProgramModule,
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-07-31 0:05 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-07-31 0:05 [gcc r13-7659] PR modula2/110174 Bugfixes to M2GenGCC.mod:CodeInline preventing an ICE Gaius Mulley
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).