development/compilers/freepascal/compiler/tpexcept.pas

   1 {
   2     $Id$
   3     Copyright (c) 1998-2000 by Florian Klaempfl
   4
   5     SetJmp and LongJmp implementation for recovery handling of the
   6     compiler
   7
   8     This program is free software; you can redistribute it and/or modify
   9     it under the terms of the GNU General Public License as published by
  10     the Free Software Foundation; either version 2 of the License, or
  11     (at your option) any later version.
  12
  13     This program is distributed in the hope that it will be useful,
  14     but WITHOUT ANY WARRANTY; without even the implied warranty of
  15     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16     GNU General Public License for more details.
  17
  18     You should have received a copy of the GNU General Public License
  19     along with this program; if not, write to the Free Software
  20     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21
  22  ****************************************************************************}
  23 unit tpexcept;
  24 interface
  25
  26 {$ifndef LINUX}
  27   {$S-}
  28 {$endif}
  29 {$ifdef Delphi}
  30 {$undef TP}
  31 {$endif Delphi}
  32
  33 type
  34    jmp_buf = record
  35 {$ifdef TP}
  36       _ax,_bx,_cx,_dx,_si,_di,_bp,_sp,_ip,flags : word;
  37       _cs,_ds,_es,_ss : word;
  38 {$else}
  39   {$ifdef Delphi} { must preserve: ebx, esi, edi, ebp, esp, eip only }
  40      _ebx,_esi,_edi,_ebp,_esp,_eip : longint;
  41   {$else}
  42       eax,ebx,ecx,edx,esi,edi,ebp,esp,eip,flags : longint;
  43       cs,ds,es,fs,gs,ss : word;
  44   {$endif Delphi}
  45 {$endif TP}
  46    end;
  47
  48    pjmp_buf = ^jmp_buf;
  49
  50 {$ifdef TP}
  51   function setjmp(var rec : jmp_buf) : integer;
  52   procedure longjmp(const rec : jmp_buf;return_value : integer);
  53 {$else}
  54   function setjmp(var rec : jmp_buf) : longint;
  55     {$ifdef Delphi}stdcall;{$endif}
  56   procedure longjmp(const rec : jmp_buf;return_value : longint);
  57     {$ifdef Delphi}stdcall;{$endif}
  58 {$endif TP}
  59
  60   const
  61      recoverpospointer : pjmp_buf = nil;
  62      longjump_used : boolean = false;
  63
  64 implementation
  65
  66
  67 {*****************************************************************************
  68                              Exception Helpers
  69 *****************************************************************************}
  70
  71 {$ifdef TP}
  72
  73     function setjmp(var rec : jmp_buf) : integer;
  74       begin
  75          asm
  76             push di
  77             push es
  78             les di,rec
  79             mov es:[di].jmp_buf._ax,ax
  80             mov es:[di].jmp_buf._bx,bx
  81             mov es:[di].jmp_buf._cx,cx
  82             mov es:[di].jmp_buf._dx,dx
  83             mov es:[di].jmp_buf._si,si
  84
  85             { load di }
  86             mov ax,[bp-4]
  87
  88             { ... and store it }
  89             mov es:[di].jmp_buf._di,ax
  90
  91             { load es }
  92             mov ax,[bp-6]
  93
  94             { ... and store it }
  95             mov es:[di].jmp_buf._es,ax
  96
  97             { bp ... }
  98             mov ax,[bp]
  99             mov es:[di].jmp_buf._bp,ax
 100
 101             { sp ... }
 102             mov ax,bp
 103             add ax,10
 104             mov es:[di].jmp_buf._sp,ax
 105
 106             { the return address }
 107             mov ax,[bp+2]
 108             mov es:[di].jmp_buf._ip,ax
 109             mov ax,[bp+4]
 110             mov es:[di].jmp_buf._cs,ax
 111
 112             { flags ... }
 113             pushf
 114             pop word ptr es:[di].jmp_buf.flags
 115
 116             mov es:[di].jmp_buf._ds,ds
 117             mov es:[di].jmp_buf._ss,ss
 118
 119             { restore es:di }
 120             pop es
 121             pop di
 122
 123             { we come from the initial call }
 124             xor ax,ax
 125             leave
 126             retf 4
 127          end;
 128       end;
 129
 130     procedure longjmp(const rec : jmp_buf;return_value : integer);
 131       begin
 132          asm
 133
 134             { this is the address of rec }
 135             lds di,rec
 136
 137             { save return value }
 138             mov ax,return_value
 139             mov ds:[di].jmp_buf._ax,ax
 140
 141             { restore compiler shit }
 142             pop bp
 143
 144             { restore some registers }
 145             mov bx,ds:[di].jmp_buf._bx
 146             mov cx,ds:[di].jmp_buf._cx
 147             mov dx,ds:[di].jmp_buf._dx
 148             mov bp,ds:[di].jmp_buf._bp
 149
 150             { create a stack frame for the return }
 151             mov es,ds:[di].jmp_buf._ss
 152             mov si,ds:[di].jmp_buf._sp
 153
 154             sub si,12
 155
 156             { store ds }
 157             mov ax,ds:[di].jmp_buf._ds
 158             mov es:[si],ax
 159
 160             { store di }
 161             mov ax,ds:[di].jmp_buf._di
 162             mov es:[si+2],ax
 163
 164             { store si }
 165             mov ax,ds:[di].jmp_buf._si
 166             mov es:[si+4],ax
 167
 168             { store flags }
 169             mov ax,ds:[di].jmp_buf.flags
 170             mov es:[si+6],ax
 171
 172             { store ip }
 173             mov ax,ds:[di].jmp_buf._ip
 174             mov es:[si+8],ax
 175
 176             { store cs }
 177             mov ax,ds:[di].jmp_buf._cs
 178             mov es:[si+10],ax
 179
 180             { load stack }
 181             mov ax,es
 182             mov ss,ax
 183             mov sp,si
 184
 185             { load return value }
 186             mov ax,ds:[di].jmp_buf._ax
 187
 188             { load old ES }
 189             mov es,ds:[di].jmp_buf._es
 190
 191             pop ds
 192             pop di
 193             pop si
 194
 195             popf
 196             retf
 197          end;
 198       end;
 199
 200 {$else}
 201 {$ifdef Delphi}
 202
 203     {$STACKFRAMES ON}
 204     function setjmp(var rec : jmp_buf) : longint; assembler;
 205     { [ebp+12]: [ebp+8]:@rec, [ebp+4]:eip', [ebp+0]:ebp' }
 206     asm // free: eax, ecx, edx
 207       { push ebp; mov ebp,esp }
 208       mov  edx,rec
 209       mov  [edx].jmp_buf._ebx,ebx  { ebx }
 210       mov  [edx].jmp_buf._esi,esi  { esi }
 211       mov  [edx].jmp_buf._edi,edi  { edi }
 212       mov  eax,[ebp]               { ebp (caller stack frame) }
 213       mov  [edx].jmp_buf._ebp,eax
 214       lea  eax,[ebp+12] { esp [12]: [8]:@rec, [4]:eip, [0]:ebp }
 215       mov  [edx].jmp_buf._esp,eax
 216       mov  eax,[ebp+4]
 217       mov  [edx].jmp_buf._eip,eax
 218       xor  eax,eax
 219       { leave }
 220       { ret  4 }
 221     end;
 222
 223     procedure longjmp(const rec : jmp_buf; return_value : longint);assembler;
 224     { [ebp+12]: return_value [ebp+8]:@rec, [ebp+4]:eip', [ebp+0]:ebp' }
 225     asm
 226       { push ebp, mov ebp,esp }
 227       mov  edx,rec
 228       mov  ecx,return_value
 229       mov  ebx,[edx].jmp_buf._ebx  { ebx }
 230       mov  esi,[edx].jmp_buf._esi  { esi }
 231       mov  edi,[edx].jmp_buf._edi  { edi }
 232       mov  ebp,[edx].jmp_buf._ebp  { ebp }
 233       mov  esp,[edx].jmp_buf._esp  { esp }
 234       mov  eax,[edx].jmp_buf._eip  { eip }
 235       push eax
 236       mov  eax,ecx
 237       ret  0
 238     end;
 239
 240 {$else Delphi}
 241
 242 {$asmmode ATT}
 243
 244     function setjmp(var rec : jmp_buf) : longint;
 245       begin
 246          asm
 247             pushl %edi
 248             movl rec,%edi
 249             movl %eax,(%edi)
 250             movl %ebx,4(%edi)
 251             movl %ecx,8(%edi)
 252             movl %edx,12(%edi)
 253             movl %esi,16(%edi)
 254
 255             { load edi }
 256             movl -4(%ebp),%eax
 257
 258             { ... and store it }
 259             movl %eax,20(%edi)
 260
 261             { ebp ... }
 262             movl (%ebp),%eax
 263             movl %eax,24(%edi)
 264
 265             { esp ... }
 266             leal 12(%ebp),%eax
 267             movl %eax,28(%edi)
 268
 269             { the return address }
 270             movl 4(%ebp),%eax
 271             movl %eax,32(%edi)
 272
 273             { flags ... }
 274             pushfl
 275             popl 36(%edi)
 276
 277             { !!!!! the segment registers, not yet needed }
 278             { you need them if the exception comes from
 279             an interrupt or a seg_move }
 280             movw %cs,40(%edi)
 281             movw %ds,42(%edi)
 282             movw %es,44(%edi)
 283             movw %fs,46(%edi)
 284             movw %gs,48(%edi)
 285             movw %ss,50(%edi)
 286
 287             { restore EDI }
 288             pop %edi
 289
 290             { we come from the initial call }
 291             xorl %eax,%eax
 292
 293             leave
 294             ret $4
 295          end;
 296       end;
 297
 298
 299     procedure longjmp(const rec : jmp_buf;return_value : longint);
 300       begin
 301          asm
 302             { restore compiler shit }
 303             popl %ebp
 304             { this is the address of rec }
 305             movl 4(%esp),%edi
 306
 307             { save return value }
 308             movl 8(%esp),%eax
 309             movl %eax,0(%edi)
 310
 311             { !!!!! load segment registers }
 312             movw 46(%edi),%fs
 313             movw 48(%edi),%gs
 314
 315             { ... and some other registers }
 316             movl 4(%edi),%ebx
 317             movl 8(%edi),%ecx
 318             movl 12(%edi),%edx
 319             movl 24(%edi),%ebp
 320
 321             { !!!!! movw 50(%edi),%es }
 322             movl 28(%edi),%esi
 323
 324             { create a stack frame for the return }
 325             subl $16,%esi
 326
 327             {
 328             movzwl 42(%edi),%eax
 329              !!!!! es
 330             movl %eax,(%esi)
 331             }
 332
 333             { edi }
 334             movl 20(%edi),%eax
 335             { !!!!! es }
 336             movl %eax,(%esi)
 337
 338             { esi }
 339             movl 16(%edi),%eax
 340             { !!!!! es }
 341             movl %eax,4(%esi)
 342
 343             { eip }
 344             movl 32(%edi),%eax
 345             { !!!!! es }
 346             movl %eax,12(%esi)
 347
 348             { !!!!! cs
 349             movl 40(%edi),%eax
 350             es
 351             movl %eax,16(%esi)
 352             }
 353
 354             { load and store flags }
 355             movl 36(%edi),%eax
 356             { !!!!!
 357             es
 358             }
 359             movl %eax,8(%esi)
 360
 361             { load return value }
 362             movl 0(%edi),%eax
 363
 364             { load old ES
 365             !!!!! movw 44(%edi),%es
 366             }
 367
 368             { load stack
 369             !!!!! movw 50(%edi),%ss }
 370             movl %esi,%esp
 371
 372             { !!!!
 373             popl %ds
 374             }
 375             popl %edi
 376             popl %esi
 377
 378             popfl
 379             ret
 380          end;
 381       end;
 382 {$endif Delphi}
 383 {$endif TP}
 384
 385 end.
 386 {
 387   $Log$
 388   Revision 1.1  2002/02/19 08:24:08  sasu
 389   Initial revision
 390
 391   Revision 1.1  2000/07/13 06:30:02  michael
 392   + Initial import
 393
 394   Revision 1.13  2000/05/11 09:36:22  pierre
 395    * Delphi implementation by Kovacs Attila Zoltan
 396
 397   Revision 1.12  2000/02/24 18:41:39  peter
 398     * removed warnings/notes
 399
 400   Revision 1.11  2000/02/11 23:59:35  jonas
 401     + $asmmode att for people with -Rintel in their ppc386.cfg
 402
 403   Revision 1.10  2000/02/09 13:23:08  peter
 404     * log truncated
 405
 406   Revision 1.9  2000/01/07 01:14:48  peter
 407     * updated copyright to 2000
 408
 409   Revision 1.8  1999/08/18 11:35:59  pierre
 410    * esp loading corrected
 411
 412 }