Apple-2gs-SW/ORCA-C
1
0
Fork 0
mirror of https://github.com/byteworksinc/ORCA-C.git synced 2025-01-02 19:29:21 +00:00
Code Issues Projects Releases Wiki Activity

Add ability to force stack repair and checking off for certain calls.

Browse Source 
This can be used on library calls generated by the compiler for internal purposes.
This commit is contained in:
Stephen Heumann 2021-10-19 22:07:58 -05:00
parent daede21819
commit 7584f8185c
2 changed files with 12 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
CGI.Comments
View File

@ -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 }

12
Gen.pas
View File

@ -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