From: Gaius Mulley Date: Tue, 25 Jul 2023 02:21:12 +0000 (+0100) Subject: PR modula2/110174 Bugfixes to M2GenGCC.mod:CodeInline preventing an ICE X-Git-Tag: basepoints/gcc-15~7382 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=c4637cbed3f23095b98962b41063380c4ab9eda9;p=thirdparty%2Fgcc.git 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. Signed-off-by: Gaius Mulley --- diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.def b/gcc/m2/gm2-compiler/M2GCCDeclare.def index 38ca33f1486a..91b66fab3ba6 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 92de4b4b2e6a..37235f08e979 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 d701543df764..bcef4e70c405 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 3a4059513cd9..3fc9dfbdb34b 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 51c2835d0828..44648deb49fc 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 5be6af4ddcb3..a4772753bf51 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 0a82e6b97f18..b5cdbfeb64f0 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 e50620e0a4e3..bcff7579164d 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 c829a6ee0b0e..c1ab70d5875d 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 c5fd2ebcdfbc..e89448927e24 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 dd6f48c446f2..b46d505d30c9 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 52a29384e8df..d502c9323c4f 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 000000000000..6447c771bb6f --- /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 +# . + +# 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 000000000000..79e2a6f667e0 --- /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 000000000000..03bfbd03e91e --- /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 +# . + +# 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 000000000000..da111142ea60 --- /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 63345896c509..4efe2d4b4294 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,