+ new target switch "FarProcsPushOddBP", which causes the i8086 compiler to push

odd values of BP if the procedure is far. Enabled this by default for Win16.

git-svn-id: trunk@31569 -

compiler/globtype.pas

@@ -247,7 +247,18 @@ interface
            accidental uses of uninitialised values }
          ts_init_locals,
          { emit a CLD instruction before using the x86 string instructions }
-         ts_cld
+         ts_cld,
+         { increment BP before pushing it in the function prologue and decrement
+           it after popping it in the function epilogue, iff the function is
+           going to terminate with a far ret. Thus, the BP value pushed on the
+           stack becomes odd if the function is far and even if the function is
+           near. This allows walking the BP chain on the stack and e.g.
+           obtaining a stack trace even if the program uses a mixture of near
+           and far calls. This is also required for Win16 real mode, because it
+           allows Windows to move code segments around (in order to defragment
+           memory) and then walk through the stacks of all running programs and
+           update the segment values of the segment that has moved. }
+         ts_x86_far_procs_push_odd_bp
        );
        ttargetswitches = set of ttargetswitch;
 
@@ -338,7 +349,8 @@ interface
          (name: 'THUMBINTERWORKING';   hasvalue: false; isglobal: true ; define: ''),
          (name: 'LOWERCASEPROCSTART';  hasvalue: false; isglobal: true ; define: ''),
          (name: 'INITLOCALS';          hasvalue: false; isglobal: true ; define: ''),
-         (name: 'CLD';                 hasvalue: false; isglobal: true ; define: 'FPC_ENABLED_CLD')
+         (name: 'CLD';                 hasvalue: false; isglobal: true ; define: 'FPC_ENABLED_CLD'),
+         (name: 'FARPROCSPUSHODDBP';   hasvalue: false; isglobal: true ; define: 'FPC_FAR_PROCS_PUSH_ODD_BP')
        );
 
        { switches being applied to all CPUs at the given level }

compiler/i8086/cgcpu.pas

@@ -1779,7 +1779,12 @@ unit cgcpu;
                   cg.a_op_const_reg(list,OP_ADD,OS_ADDR,stacksize,current_procinfo.framepointer);
               end
             else
-              generate_leave(list);
+              begin
+                generate_leave(list);
+                if (ts_x86_far_procs_push_odd_bp in current_settings.targetswitches) and
+                    is_proc_far(current_procinfo.procdef) then
+                  cg.a_op_const_reg(list,OP_SUB,OS_ADDR,1,current_procinfo.framepointer);
+              end;
             list.concat(tai_regalloc.dealloc(current_procinfo.framepointer,nil));
           end;
 

compiler/options.pas

@@ -3448,6 +3448,9 @@ begin
   if tf_cld in target_info.flags then
     if not UpdateTargetSwitchStr('CLD', init_settings.targetswitches, true) then
       InternalError(2013092801);
+  if tf_x86_far_procs_push_odd_bp in target_info.flags then
+    if not UpdateTargetSwitchStr('FARPROCSPUSHODDBP', init_settings.targetswitches, true) then
+      InternalError(2013092801);
 
   { Set up a default prefix for binutils when cross-compiling }
   if source_info.system<>target_info.system then

compiler/systems.pas

@@ -146,7 +146,9 @@ interface
               this is usefull for architectures which require a small code footprint }
             tf_no_objectfiles_when_smartlinking,
             { indicates that the default value of the ts_cld target switch is 'on' for this target }
-            tf_cld
+            tf_cld,
+            { indicates that the default value of the ts_x86_far_procs_push_odd_bp target switch is 'on' for this target }
+            tf_x86_far_procs_push_odd_bp
        );
 
        psysteminfo = ^tsysteminfo;

compiler/systems/i_win16.pas

@@ -42,7 +42,8 @@ unit i_win16;
             name         : 'Win16 for x86';
             shortname    : 'Win16';
             flags        : [tf_use_8_3,tf_smartlink_library,
-                            tf_no_objectfiles_when_smartlinking,tf_cld];
+                            tf_no_objectfiles_when_smartlinking,tf_cld,
+                            tf_x86_far_procs_push_odd_bp];
             cpu          : cpu_i8086;
             unit_env     : 'WIN16UNITS';
             extradefines : 'MSWINDOWS;WINDOWS';

compiler/x86/cgx86.pas

@@ -185,7 +185,7 @@ unit cgx86;
        globals,verbose,systems,cutils,
        defutil,paramgr,procinfo,
        tgobj,ncgutil,
-       fmodule,symsym;
+       fmodule,symsym,symcpu;
 
     function UseAVX: boolean;
       begin
@@ -2946,6 +2946,11 @@ unit cgx86;
               end
             else
               begin
+{$ifdef i8086}
+                if (ts_x86_far_procs_push_odd_bp in current_settings.targetswitches) and
+                    is_proc_far(current_procinfo.procdef) then
+                  cg.a_op_const_reg(list,OP_ADD,OS_ADDR,1,current_procinfo.framepointer);
+{$endif i8086}
                 { push <frame_pointer> }
                 inc(stackmisalignment,sizeof(pint));
                 include(rg[R_INTREGISTER].preserved_by_proc,RS_FRAME_POINTER_REG);