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) ;
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,
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.
*)
DeclareConstant, TryDeclareConstant,
DeclareConstructor, TryDeclareConstructor,
StartDeclareScope, EndDeclareScope,
- PromoteToString, DeclareLocalVariable,
+ PromoteToString, PromoteToCString, DeclareLocalVariable,
CompletelyResolved,
PoisonSymbols, GetTypeMin, GetTypeMax,
IsProcedureGccNested, DeclareParameters,
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 ;
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 : |
*)
PROCEDURE BuildTreeFromInterface (sym: CARDINAL) : Tree ;
+CONST
+ DebugTokPos = FALSE ;
VAR
tok : CARDINAL ;
i : CARDINAL ;
i := 1 ;
REPEAT
GetRegInterface (sym, i, tok, name, str, obj) ;
- IF str#NulSym
+ IF str # NulSym
THEN
IF IsConstString (str)
THEN
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)
*)
PROCEDURE BuildTrashTreeFromInterface (sym: CARDINAL) : Tree ;
+CONST
+ DebugTokPos = FALSE ;
VAR
tok : CARDINAL ;
i : CARDINAL ;
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 ;
(*
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 ;
BuildCodeOn, BuildCodeOff,
BuildProfileOn, BuildProfileOff,
BuildOptimizeOn, BuildOptimizeOff,
- BuildInline, BuildStmtNote, BuildLineNo, PushLineNo,
+ BuildAsm, BuildStmtNote, BuildLineNo, PushLineNo,
BuildConstructor,
BuildConstructorStart,
BuildConstructorEnd,
(*
- 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) ;
(*
(*
- 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 ;
(*
*)
PROCEDURE BuildAsmElement (input, output: BOOLEAN) ;
+CONST
+ DebugAsmTokPos = FALSE ;
VAR
+ s : String ;
n, str, expr, tokpos,
CurrentInterface,
CurrentAsm, name : CARDINAL ;
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) ;
EndBuildInit,
BuildProcedureStart,
BuildProcedureEnd,
- BuildAssignment,
- BuildInline ;
+ BuildAssignment ;
FROM P1SymBuild IMPORT P1StartBuildProgramModule,
P1EndBuildProgramModule,
BuildProcedureStart,
BuildProcedureEnd,
BuildAssignment,
- BuildInline,
AddRecordToList, AddVarientToList,
IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto, DisplayStack ;
BuildProcedureCall, BuildReturn, BuildNulExpression,
CheckBuildFunction,
StartBuildWith, EndBuildWith,
- BuildInline,
+ BuildAsm,
BuildCaseStart,
BuildCaseOr,
BuildCaseElse,
"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
%
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)
%
)
=:
BuildElsif1, BuildElsif2,
BuildProcedureCall, BuildReturn, BuildNulExpression,
StartBuildWith, EndBuildWith,
- BuildInline,
BuildCaseStart,
BuildCaseOr,
BuildCaseElse,
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
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 ;
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 ;
}
/* 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)
}
/* 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)
}
/* 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)
}
#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
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);
--- /dev/null
+# 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
+}
--- /dev/null
+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.
--- /dev/null
+# 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
+}
--- /dev/null
+MODULE fooasm ;
+
+VAR
+ x: INTEGER ;
+
+PROCEDURE test ;
+BEGIN
+ ASM("" : : "m"(x))
+END test ;
+
+BEGIN
+ test
+END fooasm.
EndBuildInit,
BuildProcedureStart,
BuildProcedureEnd,
- BuildAssignment,
- BuildInline ;
+ BuildAssignment ;
FROM P1SymBuild IMPORT P1StartBuildProgramModule,
P1EndBuildProgramModule,
projects / thirdparty / gcc.git / commitdiff
