Apple-2gs-SW/ORCA-C
1
0
Fork 0
mirror of https://github.com/byteworksinc/ORCA-C.git synced 2024-06-06 12:29:33 +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 } { Calls a user procedure or function through the address on }
{ the top of the evaluation stack. FTYPE is the return type. } { 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 } { pc_cup - call user procedure }
@ -795,8 +797,9 @@
{ Gen1tName(pc_cup, repair, name, ftype) } { Gen1tName(pc_cup, repair, name, ftype) }
{ } { }
{ Calls a user procedure or function. Ftype is the type. } { Calls a user procedure or function. Ftype is the 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 }
{ NAME is the name of the procedure. } { 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 } { dc_loc - define local label }

12
Gen.pas
View File

@ -5467,7 +5467,7 @@ procedure GenTree {op: icptr};
end; {if} end; {if}
{save the stack register} {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 if stackSaveDepth <> 0 then begin
GenNative(m_ldx_dir, direct, stackLoc, nil, 0); GenNative(m_ldx_dir, direct, stackLoc, nil, 0);
GenImplied(m_phx); GenImplied(m_phx);
@ -5525,7 +5525,7 @@ procedure GenTree {op: icptr};
GenImplied(m_rtl); GenImplied(m_rtl);
GenLab(lab1); GenLab(lab1);
if checkStack then begin if checkStack and (op^.q >= 0) then begin
{check the stack for errors} {check the stack for errors}
stackSaveDepth := stackSaveDepth - 1; stackSaveDepth := stackSaveDepth - 1;
GenNative(m_ldy_dir, direct, stackLoc, nil, 0); GenNative(m_ldy_dir, direct, stackLoc, nil, 0);
@ -5535,7 +5535,7 @@ procedure GenTree {op: icptr};
GenNative(m_sty_dir, direct, stackLoc, nil, 0); GenNative(m_sty_dir, direct, stackLoc, nil, 0);
end; {if} end; {if}
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; stackSaveDepth := stackSaveDepth - 1;
if not (op^.optype in [cgVoid,cgByte,cgUByte,cgWord,cgUWord,cgQuad,cgUQuad]) if not (op^.optype in [cgVoid,cgByte,cgUByte,cgWord,cgUWord,cgQuad,cgUQuad])
then then
@ -5587,7 +5587,7 @@ procedure GenTree {op: icptr};
end; {if} end; {if}
{save the stack register} {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 if stackSaveDepth <> 0 then begin
GenNative(m_ldx_dir, direct, stackLoc, nil, 0); GenNative(m_ldx_dir, direct, stackLoc, nil, 0);
GenImplied(m_phx); GenImplied(m_phx);
@ -5633,7 +5633,7 @@ procedure GenTree {op: icptr};
GenNative(m_jsl, longAbs, 0, op^.lab, 0); GenNative(m_jsl, longAbs, 0, op^.lab, 0);
{check the stack for errors} {check the stack for errors}
if checkStack then begin if checkStack and (op^.q >= 0) then begin
stackSaveDepth := stackSaveDepth - 1; stackSaveDepth := stackSaveDepth - 1;
GenNative(m_ldy_dir, direct, stackLoc, nil, 0); GenNative(m_ldy_dir, direct, stackLoc, nil, 0);
GenCall(76); GenCall(76);
@ -5643,7 +5643,7 @@ procedure GenTree {op: icptr};
end; {if} end; {if}
GenImplied(m_tay); GenImplied(m_tay);
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; stackSaveDepth := stackSaveDepth - 1;
if not (op^.optype in [cgVoid,cgByte,cgUByte,cgWord,cgUWord,cgQuad,cgUQuad]) if not (op^.optype in [cgVoid,cgByte,cgUByte,cgWord,cgUWord,cgQuad,cgUQuad])
then then