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

Generate more efficient code for a single return at end of function.

Browse Source 
When a function has a single return statement at the end and meets certain other constraints, we now generate a different intermediate code instruction to evaluate the return value as part of the return operation, rather than assigning it to (effectively) a variable and then reading that value again to return it.

This approach could actually be used for all returns in C code, but for now we only use it for a single return at the end. Directly applying it in other cases could increase the code size by duplicating the function epilogue code.
This commit is contained in:
Stephen Heumann 2022-12-19 18:52:46 -06:00
parent 265a16d2f5
commit d68e0b268f
6 changed files with 164 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
CGI.Comments
View File

@ -795,6 +795,17 @@
{ into the stack frame. }
{ }
{ }
{ pc_rev - return a value from a subroutine }
{ }
{ Gen0t(pc_rev, type) }
{ }
{ This pcode is used to return from a function. The type is }
{ the type of the function, and is used to tell the code }
{ generator what type of value to return. It may be cgByte, }
{ cgUByte, cgWord, cgUWord, cgLong, or cgULong. The value }
{ to return is removed from the evaluation stack. }
{ }
{ }
{ pc_cui - call user procedure, indirect }
{ }
{ Gen1t(pc_cui, repair, ftype) }

3
CGI.Debug
View File

@ -133,6 +133,7 @@ opt[pc_slq] := 'slq';
opt[pc_sqr] := 'sqr';
opt[pc_wsr] := 'wsr';
opt[pc_rbo] := 'rbo';
opt[pc_rev] := 'rev';
end; {InitWriteCode}
@ -287,7 +288,7 @@ with code^ do
write(' ', q:1, ':', r:1, ':', s:1);
pc_equ,pc_neq,pc_geq,pc_leq,pc_grt,pc_les,pc_pop,pc_ret,pc_bno,
pc_cpi,pc_sto,pc_tri,pc_stk,pc_idl,pc_iil,pc_ili,pc_ild:
pc_cpi,pc_sto,pc_tri,pc_stk,pc_idl,pc_iil,pc_ili,pc_ild,pc_rev:
WriteType(optype);
pc_cnv,pc_cnn: begin

2
CGI.pas
View File

@ -254,7 +254,7 @@ type
pc_gli,pc_gdl,pc_gld,pc_cpi,pc_tri,pc_lbu,pc_lbf,pc_sbf,pc_cbf,dc_cns,
dc_prm,pc_nat,pc_bno,pc_nop,pc_psh,pc_ili,pc_iil,pc_ild,pc_idl,
pc_bqr,pc_bqx,pc_baq,pc_bnq,pc_ngq,pc_adq,pc_sbq,pc_mpq,pc_umq,pc_dvq,
pc_udq,pc_mdq,pc_uqm,pc_slq,pc_sqr,pc_wsr,pc_rbo,pc_fix);
pc_udq,pc_mdq,pc_uqm,pc_slq,pc_sqr,pc_wsr,pc_rbo,pc_fix,pc_rev);
{intermediate code}
{-----------------}

9
DAG.pas
View File

@ -5534,6 +5534,15 @@ case code^.opcode of
Push(code);
end;
pc_rev:
begin
code^.left := Pop;
if (lint & lintReturn) <> 0 then
if fIsNoreturn or ((code^.optype <> cgVoid) and not doingMain) then
CheckReturn;
Push(code);
end;
pc_cnn:
begin
code^.opcode := pc_cnv;

139
Gen.pas
View File

@ -6967,15 +6967,40 @@ procedure GenTree {op: icptr};
end; {GenRealBinOp}
procedure GenRet (op: icptr);
procedure GenRetRev (op: icptr);
{ Generate code for a pc_ret }
{ Generate code for a pc_ret or pc_rev }
var
size: integer; {localSize + parameterSize}
lab1: integer; {label}
valuePushed: boolean; {return value pushed on stack?}
begin {GenRet}
begin {GenRetRev}
size := localSize + parameterSize;
{calculate return value, if necessary}
if op^.opcode = pc_rev then begin
valuePushed := namePushed or debugFlag or profileFlag
or ((parameterSize <> 0) and (size > 253));
if valuePushed then
gLong.preference := onStack
else
gLong.preference := A_X;
GenTree(op^.left);
if op^.optype in [cgByte,cgUByte,cgWord,cgUWord] then begin
if valuePushed then
GenImplied(m_pha)
else
GenImplied(m_tay);
end {if}
else {if op^.optype in [cgLong,cgULong] then} begin
valuePushed := gLong.where = onStack;
if not valuePushed then
GenImplied(m_tay);
end; {else}
end;
{pop the name record}
if namePushed then
GenCall(2);
@ -6984,8 +7009,7 @@ procedure GenTree {op: icptr};
if debugFlag or profileFlag then
GenNative(m_cop, immediate, 4, nil, 0);
{if anything needs to be removed from the stack, move the return val}
size := localSize + parameterSize;
{if anything needs to be removed from the stack, move the return address}
if parameterSize <> 0 then begin
if localSize > 253 then begin
GenNative(m_ldx_imm, immediate, localSize+1, nil, 0);
@ -7014,54 +7038,66 @@ procedure GenTree {op: icptr};
end; {else}
end; {else}
end; {if}
{load the value to return}
case op^.optype of
cgVoid: ;
cgByte,cgUByte: begin
GenNative(m_lda_dir, direct, funLoc, nil, 0);
GenNative(m_and_imm, immediate, $00FF, nil, 0);
if op^.optype = cgByte then begin
GenNative(m_bit_imm, immediate, $0080, nil, 0);
lab1 := GenLabel;
GenNative(m_beq, relative, lab1, nil, 0);
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
GenLab(lab1);
end; {if}
if size <> 2 then
GenImplied(m_tay);
end;
cgWord,cgUWord:
if op^.opcode = pc_rev then begin
if valuePushed then begin
if size = 2 then
GenNative(m_lda_dir, direct, funLoc, nil, 0)
GenImplied(m_pla)
else
GenImplied(m_ply);
if op^.optype in [cgLong,cgULong] then
GenImplied(m_plx);
end {if}
else if size = 2 then
GenImplied(m_tya);
end {if}
else
case op^.optype of {load the value to return}
cgVoid: ;
cgByte,cgUByte: begin
GenNative(m_lda_dir, direct, funLoc, nil, 0);
GenNative(m_and_imm, immediate, $00FF, nil, 0);
if op^.optype = cgByte then begin
GenNative(m_bit_imm, immediate, $0080, nil, 0);
lab1 := GenLabel;
GenNative(m_beq, relative, lab1, nil, 0);
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
GenLab(lab1);
end; {if}
if size <> 2 then
GenImplied(m_tay);
end;
cgWord,cgUWord:
if size = 2 then
GenNative(m_lda_dir, direct, funLoc, nil, 0)
else
GenNative(m_ldy_dir, direct, funLoc, nil, 0);
cgReal:
GenCall(3);
cgDouble:
GenCall(4);
cgComp:
GenCall(64);
cgExtended:
GenCall(65);
cgLong,cgULong: begin
GenNative(m_ldx_dir, direct, funLoc+2, nil, 0);
GenNative(m_ldy_dir, direct, funLoc, nil, 0);
end;
cgReal:
GenCall(3);
cgQuad,cgUQuad: ; {return value was already written}
cgDouble:
GenCall(4);
cgComp:
GenCall(64);
cgExtended:
GenCall(65);
cgLong,cgULong: begin
GenNative(m_ldx_dir, direct, funLoc+2, nil, 0);
GenNative(m_ldy_dir, direct, funLoc, nil, 0);
end;
cgQuad,cgUQuad: ; {return value was already written}
otherwise:
Error(cge1);
end; {case}
otherwise:
Error(cge1);
end; {case}
{restore data bank reg}
if dataBank then begin
@ -7092,7 +7128,8 @@ procedure GenTree {op: icptr};
end;
cgLong,cgULong,cgReal,cgDouble,cgComp,cgExtended: begin
GenImplied(m_tya);
if size <> 2 then
GenImplied(m_tya);
if toolParms then begin {save value on stack for tools}
GenNative(m_sta_s, direct, returnSize+1, nil, 0);
GenImplied(m_txa);
@ -7108,7 +7145,7 @@ procedure GenTree {op: icptr};
{return to the caller}
GenImplied(m_rtl);
end; {GenRet}
end; {GenRetRev}
procedure GenSbfCbf (op: icptr);
@ -7472,7 +7509,7 @@ case op^.opcode of
pc_pop: GenPop(op);
pc_psh: GenPsh(op);
pc_rbo: GenRbo(op);
pc_ret: GenRet(op);
pc_ret,pc_rev: GenRetRev(op);
pc_sbf,pc_cbf: GenSbfCbf(op);
pc_sbi: GenSbi(op);
pc_shl,pc_shr,pc_usr: GenShlShrUsr(op);

87
Parser.pas
View File

@ -197,6 +197,8 @@ var
compoundLiteralToAllocate: identPtr; {compound literal that needs space allocated}
vaInfoLLN: integer; {label number of internal va info (0 for none)}
declaredTagOrEnumConst: boolean; {was a tag or enum const declared?}
returnCount: integer; {number of return statements}
skipReturn: boolean; {skip the ordinary return at end of function?}
{parameter processing variables}
{------------------------------}
@ -358,41 +360,43 @@ stPtr := statementList; {pop the statement record}
statementList := stPtr^.next;
doingFunction := statementList <> nil; {see if we're done with the function}
if not doingFunction then begin {if so, finish it off}
if doingMain then begin {executing to the end of main returns 0}
if fType^.kind = scalarType then begin
if fType^.baseType in [cgByte,cgUByte,cgWord,cgUWord] then begin
Gen1t(pc_ldc, 0, fType^.baseType);
Gen2t(pc_str, 0, 0, fType^.baseType);
if not skipReturn then begin
if doingMain then begin {executing to the end of main returns 0}
if fType^.kind = scalarType then begin
if fType^.baseType in [cgByte,cgUByte,cgWord,cgUWord] then begin
Gen1t(pc_ldc, 0, fType^.baseType);
Gen2t(pc_str, 0, 0, fType^.baseType);
end {if}
else if fType^.baseType in [cgLong,cgULong] then begin
GenLdcLong(0);
Gen2t(pc_str, 0, 0, fType^.baseType);
end; {else if}
end {if}
else if fType^.baseType in [cgLong,cgULong] then begin
GenLdcLong(0);
Gen2t(pc_str, 0, 0, fType^.baseType);
else if fType^.kind = enumType then begin
Gen1t(pc_ldc, 0, cgWord);
Gen2t(pc_str, 0, 0, cgWord);
end; {else if}
end {if}
else if fType^.kind = enumType then begin
Gen1t(pc_ldc, 0, cgWord);
Gen2t(pc_str, 0, 0, cgWord);
end; {else if}
end; {if}
Gen1(dc_lab, returnLabel);
if vaInfoLLN <> 0 then begin {clean up variable args, if any}
Gen2(pc_lda, vaInfoLLN, 0);
Gen0t(pc_stk, cgULong);
Gen1tName(pc_cup, -1, cgVoid, @'__va_end');
end; {if}
with fType^ do {generate the pc_ret instruction}
case kind of
scalarType : Gen0t(pc_ret, baseType);
arrayType : ;
structType ,
unionType ,
pointerType : Gen0t(pc_ret, cgULong);
functionType: ;
enumConst : ;
enumType : Gen0t(pc_ret, cgWord);
definedType : ;
otherwise: Error(57);
end; {case}
end; {if}
Gen1(dc_lab, returnLabel);
if vaInfoLLN <> 0 then begin {clean up variable args, if any}
Gen2(pc_lda, vaInfoLLN, 0);
Gen0t(pc_stk, cgULong);
Gen1tName(pc_cup, -1, cgVoid, @'__va_end');
end; {if}
with fType^ do {generate the pc_ret instruction}
case kind of
scalarType : Gen0t(pc_ret, baseType);
arrayType : ;
structType ,
unionType ,
pointerType : Gen0t(pc_ret, cgULong);
functionType: ;
enumConst : ;
enumType : Gen0t(pc_ret, cgWord);
definedType : ;
otherwise: Error(57);
end; {case}
Gen0 (dc_enp); {finish the segment}
CheckGotoList; {make sure all labels are declared}
while tempList <> nil do begin {dump the local labels}
@ -849,9 +853,20 @@ var
Expression(normalExpression, [semicolonch]);
AssignmentConversion(fType, expressionType, lastWasConst, lastConst,
true, false);
Match(semicolonch, 22); {insist on a closing ';'}
case fType^.kind of
scalarType: if fType^.baseType in [cgQuad,cgUQuad] then
Gen0t(pc_sto, fType^.baseType)
else if (returnCount = 0)
and (token.kind = rbracech)
and (statementList^.next = nil)
and (vaInfoLLN = 0)
and (fType^.baseType in
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong])
then begin
Gen0t(pc_rev, fType^.baseType);
skipReturn := true;
end {else if}
else
Gen2t(pc_str, 0, 0, fType^.baseType);
enumType: Gen2t(pc_str, 0, 0, cgWord);
@ -868,9 +883,11 @@ var
if (fType^.kind <> scalarType) or (fType^.baseType <> cgVoid) then
if ((lint & lintC99Syntax) <> 0) or ((lint & lintReturn) <> 0) then
Error(152);
Match(semicolonch, 22); {insist on a closing ';'}
end; {else}
Gen1(pc_ujp, returnLabel); {branch to the exit point}
Match(semicolonch, 22); {insist on a closing ';'}
if not skipReturn then
Gen1(pc_ujp, returnLabel); {branch to the exit point}
returnCount := returnCount + 1;
end; {ReturnStatement}
@ -4087,6 +4104,8 @@ if isFunction then begin
end; {while}
gotoList := nil; {initialize the label list}
fenvAccessInFunction := fenvAccess;
skipReturn := false;
returnCount := 0;
if isAsm then begin
AsmFunction(variable); {handle assembly language functions}
PopTable;