From 7584f8185cd89ad21062ca82a259b24dc699780e Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Tue, 19 Oct 2021 22:07:58 -0500 Subject: [PATCH] Add ability to force stack repair and checking off for certain calls. This can be used on library calls generated by the compiler for internal purposes. --- CGI.Comments | 9 ++++++--- Gen.pas | 12 ++++++------ 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/CGI.Comments b/CGI.Comments index a11d7dc..91caadf 100644 --- a/CGI.Comments +++ b/CGI.Comments @@ -787,7 +787,9 @@ { } { Calls a user procedure or function through the address on } { the top of the evaluation stack. FTYPE is the return type. } -{ Repair is 1 if stack repair should be forced, and 0 if not. } +{ Repair is 1 if stack repair should be forced, -1 if stack } +{ repair and checking should be disabled, or 0 if the regular } +{ settings should be used. } { } { } { pc_cup - call user procedure } @@ -795,8 +797,9 @@ { Gen1tName(pc_cup, repair, name, ftype) } { } { Calls a user procedure or function. Ftype is the type. } -{ Repair is 1 if stack repair should be forced, and 0 if not. } -{ NAME is the name of the procedure. } +{ Repair is 1 if stack repair should be forced, -1 if stack } +{ repair and checking should be disabled, or 0 if the regular } +{ settings should be used. NAME is the name of the procedure. } { } { } { dc_loc - define local label } diff --git a/Gen.pas b/Gen.pas index 158b53d..51e6959 100644 --- a/Gen.pas +++ b/Gen.pas @@ -5467,7 +5467,7 @@ procedure GenTree {op: icptr}; end; {if} {save the stack register} - if saveStack or checkStack or (op^.q <> 0) then begin + if ((saveStack or checkStack) and (op^.q >= 0)) or (op^.q > 0) then begin if stackSaveDepth <> 0 then begin GenNative(m_ldx_dir, direct, stackLoc, nil, 0); GenImplied(m_phx); @@ -5525,7 +5525,7 @@ procedure GenTree {op: icptr}; GenImplied(m_rtl); GenLab(lab1); - if checkStack then begin + if checkStack and (op^.q >= 0) then begin {check the stack for errors} stackSaveDepth := stackSaveDepth - 1; GenNative(m_ldy_dir, direct, stackLoc, nil, 0); @@ -5535,7 +5535,7 @@ procedure GenTree {op: icptr}; GenNative(m_sty_dir, direct, stackLoc, nil, 0); end; {if} end {if} - else if saveStack or (op^.q <> 0) then begin + else if (saveStack and (op^.q >= 0)) or (op^.q > 0) then begin stackSaveDepth := stackSaveDepth - 1; if not (op^.optype in [cgVoid,cgByte,cgUByte,cgWord,cgUWord,cgQuad,cgUQuad]) then @@ -5587,7 +5587,7 @@ procedure GenTree {op: icptr}; end; {if} {save the stack register} - if saveStack or checkStack or (op^.q <> 0) then begin + if ((saveStack or checkStack) and (op^.q >= 0)) or (op^.q > 0) then begin if stackSaveDepth <> 0 then begin GenNative(m_ldx_dir, direct, stackLoc, nil, 0); GenImplied(m_phx); @@ -5633,7 +5633,7 @@ procedure GenTree {op: icptr}; GenNative(m_jsl, longAbs, 0, op^.lab, 0); {check the stack for errors} - if checkStack then begin + if checkStack and (op^.q >= 0) then begin stackSaveDepth := stackSaveDepth - 1; GenNative(m_ldy_dir, direct, stackLoc, nil, 0); GenCall(76); @@ -5643,7 +5643,7 @@ procedure GenTree {op: icptr}; end; {if} GenImplied(m_tay); end {if} - else if saveStack or (op^.q <> 0) then begin + else if (saveStack and (op^.q >= 0)) or (op^.q > 0) then begin stackSaveDepth := stackSaveDepth - 1; if not (op^.optype in [cgVoid,cgByte,cgUByte,cgWord,cgUWord,cgQuad,cgUQuad]) then