From d68e0b268f98456967e8141925edee0286a0ac2d Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Mon, 19 Dec 2022 18:52:46 -0600 Subject: [PATCH] Generate more efficient code for a single return at end of function. 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. --- CGI.Comments | 11 ++++ CGI.Debug | 3 +- CGI.pas | 2 +- DAG.pas | 9 ++++ Gen.pas | 139 ++++++++++++++++++++++++++++++++------------------- Parser.pas | 87 +++++++++++++++++++------------- 6 files changed, 164 insertions(+), 87 deletions(-) diff --git a/CGI.Comments b/CGI.Comments index b38d76f..e04c8fa 100644 --- a/CGI.Comments +++ b/CGI.Comments @@ -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) } diff --git a/CGI.Debug b/CGI.Debug index be3219b..56e5ac5 100644 --- a/CGI.Debug +++ b/CGI.Debug @@ -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 diff --git a/CGI.pas b/CGI.pas index 731d85a..ffd53fd 100644 --- a/CGI.pas +++ b/CGI.pas @@ -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} {-----------------} diff --git a/DAG.pas b/DAG.pas index 13d6cca..ca69f34 100644 --- a/DAG.pas +++ b/DAG.pas @@ -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; diff --git a/Gen.pas b/Gen.pas index 64dd28d..90884f5 100644 --- a/Gen.pas +++ b/Gen.pas @@ -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); diff --git a/Parser.pas b/Parser.pas index 8f2b469..04be7e1 100644 --- a/Parser.pas +++ b/Parser.pas @@ -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;