dpmiexcp.pp 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1997-98 by Pierre Muller
  5. DPMI Exception routines for Go32V2
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. Unit DPMIExcp;
  13. { If linking to C code we must avoid loading of the dpmiexcp.o
  14. in libc.a from the equivalent C code
  15. => all global functions from dpmiexcp.c must be aliased PM
  16. Problem this is only valid for DJGPP v2.01 }
  17. interface
  18. uses
  19. go32;
  20. { No stack checking ! }
  21. {$S-}
  22. { Error Messages }
  23. function do_faulting_finish_message : integer;
  24. { SetJmp/LongJmp }
  25. type
  26. dpmi_jmp_buf = packed record
  27. eax,ebx,ecx,edx,esi,edi,ebp,esp,eip,flags : longint;
  28. cs,ds,es,fs,gs,ss : word;
  29. end;
  30. pdpmi_jmp_buf = ^dpmi_jmp_buf;
  31. function dpmi_setjmp(var rec : dpmi_jmp_buf) : longint;
  32. procedure dpmi_longjmp(var rec : dpmi_jmp_buf;return_value : longint);
  33. { Signals }
  34. const
  35. SIGABRT = 288;
  36. SIGFPE = 289;
  37. SIGILL = 290;
  38. SIGSEGV = 291;
  39. SIGTERM = 292;
  40. SIGALRM = 293;
  41. SIGHUP = 294;
  42. SIGINT = 295;
  43. SIGKILL = 296;
  44. SIGPIPE = 297;
  45. SIGQUIT = 298;
  46. SIGUSR1 = 299;
  47. SIGUSR2 = 300;
  48. SIGNOFP = 301;
  49. SIGTRAP = 302;
  50. SIGTIMR = 303; { Internal for setitimer (SIGALRM, SIGPROF) }
  51. SIGPROF = 304;
  52. SIGMAX = 320;
  53. SIG_BLOCK = 1;
  54. SIG_SETMASK = 2;
  55. SIG_UNBLOCK = 3;
  56. function SIG_DFL( x: longint) : longint;
  57. function SIG_ERR( x: longint) : longint;
  58. function SIG_IGN( x: longint) : longint;
  59. type
  60. SignalHandler = function (v : longint) : longint;
  61. PSignalHandler = SignalHandler; { to be compatible with linux.pp }
  62. function signal(sig : longint;func : SignalHandler) : SignalHandler;
  63. function _raise(sig : longint) : longint;
  64. { Exceptions }
  65. type
  66. texception_state = record
  67. __eax, __ebx, __ecx, __edx, __esi : longint;
  68. __edi, __ebp, __esp, __eip, __eflags : longint;
  69. __cs, __ds, __es, __fs, __gs, __ss : word;
  70. __sigmask : longint; { for POSIX signals only }
  71. __signum : longint; { for expansion }
  72. __exception_ptr : longint; { pointer to previous exception }
  73. __fpu_state : array [0..108-1] of byte; { for future use }
  74. end;
  75. pexception_state = ^texception_state;
  76. procedure djgpp_exception_toggle;
  77. procedure djgpp_exception_setup;
  78. function djgpp_exception_state : pexception_state;
  79. function djgpp_set_ctrl_c(enable : boolean) : boolean;
  80. { Other }
  81. function dpmi_set_coprocessor_emulation(flag : longint) : longint;
  82. implementation
  83. {$ASMMODE DIRECT}
  84. {$L exceptn.o}
  85. var
  86. v2prt0_ds_alias : pointer;external name '___v2prt0_ds_alias';
  87. djgpp_ds_alias : pointer;external name '___djgpp_ds_alias';
  88. endtext : byte;external name '_etext';
  89. starttext : byte;external name 'start';
  90. djgpp_old_kbd : tseginfo;external name '___djgpp_old_kbd';
  91. djgpp_hw_lock_start : longint;external name '___djgpp_hw_lock_start';
  92. djgpp_hw_lock_end : longint;external name '___djgpp_hw_lock_end';
  93. djgpp_hwint_flags : longint;external name '___djgpp_hwint_flags';
  94. djgpp_dos_sel : word;external name '___djgpp_dos_sel';
  95. djgpp_exception_table : array[0..0] of pointer;external name '___djgpp_exception_table';
  96. procedure djgpp_i24;external name ' ___djgpp_i24';
  97. procedure djgpp_iret;external name ' ___djgpp_iret';
  98. procedure djgpp_npx_hdlr;external name '___djgpp_npx_hdlr';
  99. procedure djgpp_kbd_hdlr;external name '___djgpp_kbd_hdlr';
  100. procedure djgpp_kbd_hdlr_pc98;external name '___djgpp_kbd_hdlr_pc98';
  101. procedure djgpp_cbrk_hdlr;external name '___djgpp_cbrk_hdlr';
  102. var
  103. exceptions_on : boolean;
  104. const
  105. cbrk_vect : byte = $1b;
  106. exception_level : longint = 0;
  107. {****************************************************************************
  108. Helpers
  109. ****************************************************************************}
  110. procedure err(const x : string);
  111. begin
  112. write(stderr, x);
  113. end;
  114. procedure errln(const x : string);
  115. begin
  116. writeln(stderr, x);
  117. end;
  118. procedure itox(v,len : longint);
  119. var
  120. st : string;
  121. begin
  122. st:=hexstr(v,len);
  123. err(st);
  124. end;
  125. {****************************************************************************
  126. SetJmp/LongJmp
  127. ****************************************************************************}
  128. function dpmi_setjmp(var rec : dpmi_jmp_buf) : longint;
  129. begin
  130. asm
  131. pushl %edi
  132. movl rec,%edi
  133. movl %eax,(%edi)
  134. movl %ebx,4(%edi)
  135. movl %ecx,8(%edi)
  136. movl %edx,12(%edi)
  137. movl %esi,16(%edi)
  138. { load edi }
  139. movl -4(%ebp),%eax
  140. { ... and store it }
  141. movl %eax,20(%edi)
  142. { ebp ... }
  143. movl (%ebp),%eax
  144. movl %eax,24(%edi)
  145. { esp ... }
  146. movl %esp,%eax
  147. addl $12,%eax
  148. movl %eax,28(%edi)
  149. { the return address }
  150. movl 4(%ebp),%eax
  151. movl %eax,32(%edi)
  152. { flags ... }
  153. pushfl
  154. popl 36(%edi)
  155. { !!!!! the segment registers, not yet needed }
  156. { you need them if the exception comes from
  157. an interrupt or a seg_move }
  158. movw %cs,40(%edi)
  159. movw %ds,42(%edi)
  160. movw %es,44(%edi)
  161. movw %fs,46(%edi)
  162. movw %gs,48(%edi)
  163. movw %ss,50(%edi)
  164. movl ___djgpp_exception_state_ptr, %eax
  165. movl %eax, 60(%edi)
  166. { restore EDI }
  167. pop %edi
  168. { we come from the initial call }
  169. xorl %eax,%eax
  170. leave
  171. ret $4
  172. end;
  173. end;
  174. procedure dpmi_longjmp(var rec : dpmi_jmp_buf;return_value : longint);
  175. begin
  176. if (@rec=pdpmi_jmp_buf(djgpp_exception_state)) and (exception_level>0) then
  177. dec(exception_level);
  178. asm
  179. { restore compiler shit }
  180. popl %ebp
  181. { copy from longjmp.S }
  182. movl 4(%esp),%edi { get dpmi_jmp_buf }
  183. movl 8(%esp),%eax { store retval in j->eax }
  184. movl %eax,0(%edi)
  185. movw 46(%edi),%fs
  186. movw 48(%edi),%gs
  187. movl 4(%edi),%ebx
  188. movl 8(%edi),%ecx
  189. movl 12(%edi),%edx
  190. movl 24(%edi),%ebp
  191. { Now for some uglyness. The dpmi_jmp_buf structure may be ABOVE the
  192. point on the new SS:ESP we are moving to. We don't allow overlap,
  193. but do force that it always be valid. We will use ES:ESI for
  194. our new stack before swapping to it. }
  195. movw 50(%edi),%es
  196. movl 28(%edi),%esi
  197. subl $28,%esi { We need 7 working longwords on stack }
  198. movl 60(%edi),%eax
  199. es
  200. movl %eax,(%esi) { Exception pointer }
  201. movzwl 42(%edi),%eax
  202. es
  203. movl %eax,4(%esi) { DS }
  204. movl 20(%edi),%eax
  205. es
  206. movl %eax,8(%esi) { EDI }
  207. movl 16(%edi),%eax
  208. es
  209. movl %eax,12(%esi) { ESI }
  210. movl 32(%edi),%eax
  211. es
  212. movl %eax,16(%esi) { EIP - start of IRET frame }
  213. movl 40(%edi),%eax
  214. es
  215. movl %eax,20(%esi) { CS }
  216. movl 36(%edi),%eax
  217. es
  218. movl %eax,24(%esi) { EFLAGS }
  219. movl 0(%edi),%eax
  220. movw 44(%edi),%es
  221. movw 50(%edi),%ss
  222. movl %esi,%esp
  223. popl ___djgpp_exception_state_ptr
  224. popl %ds
  225. popl %edi
  226. popl %esi
  227. iret { actually jump to new cs:eip loading flags }
  228. end;
  229. end;
  230. {****************************************************************************
  231. Signals
  232. ****************************************************************************}
  233. var
  234. signal_list : Array[0..SIGMAX] of SignalHandler;
  235. function SIG_ERR(x:longint):longint;
  236. begin
  237. SIG_ERR:=-1;
  238. end;
  239. function SIG_IGN(x:longint):longint;
  240. begin
  241. SIG_IGN:=-1;
  242. end;
  243. function SIG_DFL(x:longint):longint;
  244. begin
  245. SIG_DFL:=0;
  246. end;
  247. function signal(sig : longint;func : SignalHandler) : SignalHandler;
  248. var
  249. temp : SignalHandler;
  250. begin
  251. if ((sig <= 0) or (sig > SIGMAX) or (sig = SIGKILL)) then
  252. begin
  253. signal:=@SIG_ERR;
  254. runerror(201);
  255. end;
  256. temp := signal_list[sig - 1];
  257. signal_list[sig - 1] := func;
  258. signal:=temp;
  259. end;
  260. { C counter part }
  261. function c_signal(sig : longint;func : SignalHandler) : SignalHandler;cdecl;[public,alias : '_signal'];
  262. var
  263. temp : SignalHandler;
  264. begin
  265. temp:=signal(sig,func);
  266. c_signal:=temp;
  267. end;
  268. const
  269. signames : array [0..14] of string[4] = (
  270. 'ABRT','FPE ','ILL ','SEGV','TERM','ALRM','HUP ',
  271. 'INT ','KILL','PIPE','QUIT','USR1','USR2','NOFP','TRAP');
  272. function _raise(sig : longint) : longint;
  273. var
  274. temp : SignalHandler;
  275. label
  276. traceback_exit;
  277. begin
  278. if(sig <= 0) or (sig > SIGMAX) then
  279. exit(-1);
  280. temp:=signal_list[sig - 1];
  281. if (temp = SignalHandler(@SIG_IGN)) then
  282. exit(0);
  283. if (temp = SignalHandler(@SIG_DFL)) then
  284. begin
  285. traceback_exit:
  286. if ((sig >= SIGABRT) and (sig <= SIGTRAP)) then
  287. begin
  288. err('Exiting due to signal SIG');
  289. err(signames[sig-sigabrt]);
  290. end
  291. else
  292. begin
  293. err('Exiting due to signal $');
  294. itox(sig, 4);
  295. end;
  296. errln('');
  297. do_faulting_finish_message(); { Exits, does not return }
  298. exit(-1);
  299. end;
  300. if ((longint(temp) < longint(starttext)) or (longint(temp) > longint(endtext))) then
  301. begin
  302. errln('Bad signal handler, ');
  303. goto traceback_exit;
  304. end;
  305. temp(sig);
  306. exit(0);
  307. end;
  308. function c_raise(sig : longint) : longint;cdecl;[public,alias : '_raise'];
  309. begin
  310. c_raise:=_raise(sig);
  311. end;
  312. {****************************************************************************
  313. Exceptions
  314. ****************************************************************************}
  315. function except_to_sig(excep : longint) : longint;
  316. begin
  317. case excep of
  318. 5,8,9,11,12,13,14 : exit(SIGSEGV);
  319. 0,4,16 : exit(SIGFPE);
  320. 1,3 : exit(SIGTRAP);
  321. 7 : exit(SIGNOFP);
  322. else
  323. begin
  324. case excep of
  325. $75 : exit(SIGFPE);
  326. $78 : exit(SIGTIMR);
  327. $1b,
  328. $79 : exit(SIGINT);
  329. else
  330. exit(SIGILL);
  331. end;
  332. end;
  333. end;
  334. end;
  335. procedure show_call_frame;
  336. begin
  337. errln('Call frame traceback EIPs:');
  338. errln(' 0x'+hexstr(djgpp_exception_state^.__eip, 8));
  339. dump_stack(djgpp_exception_state^.__ebp);
  340. end;
  341. const
  342. EXCEPTIONCOUNT = 18;
  343. exception_names : array[0..EXCEPTIONCOUNT-1] of pchar = (
  344. 'Division by Zero',
  345. 'Debug',
  346. 'NMI',
  347. 'Breakpoint',
  348. 'Overflow',
  349. 'Bounds Check',
  350. 'Invalid Opcode',
  351. 'Coprocessor not available',
  352. 'Double Fault',
  353. 'Coprocessor overrun',
  354. 'Invalid TSS',
  355. 'Segment Not Present',
  356. 'Stack Fault',
  357. 'General Protection Fault',
  358. 'Page fault',
  359. ' ',
  360. 'Coprocessor Error',
  361. 'Alignment Check');
  362. has_error : array [0..EXCEPTIONCOUNT-1] of byte =
  363. (0,0,0,0,0,0,0,0,1,0,1,1,1,1,1,0,0,1);
  364. cbrk_hooked : boolean = false;
  365. old_video_mode : byte = 3;
  366. procedure dump_selector(const name : string; sel : word);
  367. var
  368. base,limit : longint;
  369. begin
  370. err(name);
  371. err(': sel=');
  372. itox(sel, 4);
  373. if (sel<>0) then
  374. begin
  375. base:=get_segment_base_address(sel);
  376. err(' base='); itox(base, 8);
  377. limit:=get_segment_limit(sel);
  378. err(' limit='); itox(limit, 8);
  379. end;
  380. errln('');
  381. end;
  382. function farpeekb(sel : word;offset : longint) : byte;
  383. var
  384. b : byte;
  385. begin
  386. seg_move(sel,offset,get_ds,longint(@b),1);
  387. farpeekb:=b;
  388. end;
  389. function do_faulting_finish_message : integer;
  390. var
  391. en : pchar;
  392. signum,i : longint;
  393. old_vid : byte;
  394. begin
  395. do_faulting_finish_message:=0;
  396. signum:=djgpp_exception_state^.__signum;
  397. { check video mode for original here and reset (not if PC98) */ }
  398. if ((go32_info_block.linear_address_of_primary_screen <> $a0000) and
  399. (farpeekb(dosmemselector, $449) <> old_video_mode)) then
  400. begin
  401. old_vid:=old_video_mode;
  402. asm
  403. pusha
  404. movzbl old_vid,%eax
  405. int $0x10
  406. popa
  407. nop
  408. end;
  409. end;
  410. if (signum >= EXCEPTIONCOUNT) then
  411. begin
  412. case signum of
  413. $75 : en:='Floating Point exception';
  414. $1b : en:='Control-Break Pressed';
  415. $79 : en:='Control-C Pressed';
  416. else
  417. en:=nil;
  418. end;
  419. end
  420. else
  421. en:=exception_names[signum];
  422. if (en = nil) then
  423. begin
  424. err('Exception ');
  425. itox(signum, 2);
  426. err(' at eip=');
  427. itox(djgpp_exception_state^.__eip, 8);
  428. end
  429. else
  430. begin
  431. write(stderr, 'FPC ',en);
  432. err(' at eip=');
  433. itox(djgpp_exception_state^.__eip, 8);
  434. end;
  435. { Control-C should stop the program also !}
  436. {if (signum = $79) then
  437. begin
  438. errln('');
  439. exit(-1);
  440. end;}
  441. if ((signum < EXCEPTIONCOUNT) and (has_error[signum]=1)) then
  442. begin
  443. errorcode := djgpp_exception_state^.__sigmask and $ffff;
  444. if(errorcode<>0) then
  445. begin
  446. err(', error=');
  447. itox(errorcode, 4);
  448. end;
  449. end;
  450. errln('');
  451. err('eax=');
  452. itox(djgpp_exception_state^.__eax, 8);
  453. err(' ebx='); itox(djgpp_exception_state^.__ebx, 8);
  454. err(' ecx='); itox(djgpp_exception_state^.__ecx, 8);
  455. err(' edx='); itox(djgpp_exception_state^.__edx, 8);
  456. err(' esi='); itox(djgpp_exception_state^.__esi, 8);
  457. err(' edi='); itox(djgpp_exception_state^.__edi, 8);
  458. errln('');
  459. err('ebp='); itox(djgpp_exception_state^.__ebp, 8);
  460. err(' esp='); itox(djgpp_exception_state^.__esp, 8);
  461. err(' program=');
  462. errln(paramstr(0));
  463. dump_selector('cs', djgpp_exception_state^.__cs);
  464. dump_selector('ds', djgpp_exception_state^.__ds);
  465. dump_selector('es', djgpp_exception_state^.__es);
  466. dump_selector('fs', djgpp_exception_state^.__fs);
  467. dump_selector('gs', djgpp_exception_state^.__gs);
  468. dump_selector('ss', djgpp_exception_state^.__ss);
  469. errln('');
  470. if (djgpp_exception_state^.__cs = get_cs) then
  471. show_call_frame;
  472. { must not return !! }
  473. if exceptions_on then
  474. djgpp_exception_toggle;
  475. asm
  476. pushw $1
  477. call ___exit
  478. end;
  479. end;
  480. function djgpp_exception_state:pexception_state;assembler;
  481. asm
  482. movl ___djgpp_exception_state_ptr,%eax
  483. end;
  484. procedure djgpp_exception_processor;[public,alias : '___djgpp_exception_processor'];
  485. var
  486. sig : longint;
  487. begin
  488. inc(exception_level);
  489. sig:=djgpp_exception_state^.__signum;
  490. if (exception_level=1) or (sig=$78) then
  491. begin
  492. sig := except_to_sig(sig);
  493. _raise(sig);
  494. if (djgpp_exception_state^.__signum >= EXCEPTIONCOUNT) then
  495. { Not exception so continue OK }
  496. dpmi_longjmp(pdpmi_jmp_buf(djgpp_exception_state)^, djgpp_exception_state^.__eax);
  497. { User handler did not exit or longjmp, we must exit }
  498. err('FPC cannot continue from exception, exiting due to signal ');
  499. itox(sig, 4);
  500. errln('');
  501. end
  502. else
  503. begin
  504. if exception_level>2 then
  505. begin
  506. errln('FPC triple exception, exiting !!! ');
  507. if (exceptions_on) then
  508. djgpp_exception_toggle;
  509. asm
  510. pushw $1
  511. call ___exit
  512. end;
  513. end;
  514. err('FPC double exception, exiting due to signal ');
  515. itox(sig, 4);
  516. errln('');
  517. end;
  518. do_faulting_finish_message;
  519. end;
  520. type
  521. trealseginfo = tseginfo;
  522. pseginfo = ^tseginfo;
  523. var
  524. except_ori : array [0..EXCEPTIONCOUNT-1] of tseginfo;
  525. kbd_ori : tseginfo;
  526. npx_ori : tseginfo;
  527. cbrk_ori,
  528. cbrk_rmcb : trealseginfo;
  529. cbrk_regs : registers;
  530. procedure djgpp_exception_toggle;[alias : '___djgpp_exception_toggle'];
  531. var
  532. _except : tseginfo;
  533. i : longint;
  534. local_ex : boolean;
  535. begin
  536. {$ifdef SYSTEMDEBUG}
  537. if exceptions_on then
  538. errln('Disabling FPC exceptions')
  539. else
  540. errln('Enabling FPC exceptions');
  541. {$endif SYSTEMDEBUG}
  542. { toggle here to avoid infinite recursion }
  543. { if a subfunction calls runerror !! }
  544. exceptions_on:=not exceptions_on;
  545. local_ex:=exceptions_on;
  546. asm
  547. movzbl local_ex,%eax
  548. movl %eax,_v2prt0_exceptions_on
  549. end;
  550. for i:=0 to EXCEPTIONCOUNT-1 do
  551. begin
  552. if get_pm_exception_handler(i,_except) then
  553. begin
  554. if (i <> 2) {or (_crt0_startup_flags & _CRT0_FLAG_NMI_SIGNAL))} then
  555. begin
  556. if not set_pm_exception_handler(i,except_ori[i]) then
  557. errln('error setting exception nø'+hexstr(i,2));
  558. end;
  559. except_ori[i]:=_except;
  560. end
  561. else
  562. begin
  563. if get_exception_handler(i,_except) then
  564. begin
  565. if (i <> 2) {or (_crt0_startup_flags & _CRT0_FLAG_NMI_SIGNAL))} then
  566. begin
  567. if not set_exception_handler(i,except_ori[i]) then
  568. errln('error setting exception nø'+hexstr(i,2));
  569. end;
  570. except_ori[i]:=_except;
  571. end;
  572. end;
  573. end;
  574. get_pm_interrupt($75,_except);
  575. set_pm_interrupt($75,npx_ori);
  576. npx_ori:=_except;
  577. get_pm_interrupt(9,_except);
  578. set_pm_interrupt(9,kbd_ori);
  579. kbd_ori:=_except;
  580. if (cbrk_hooked) then
  581. begin
  582. set_rm_interrupt(cbrk_vect,cbrk_ori);
  583. free_rm_callback(cbrk_rmcb);
  584. cbrk_hooked := false;
  585. {$ifdef SYSTEMDEBUG}
  586. errln('back to ori rm cbrk '+hexstr(cbrk_ori.segment,4)+':'+hexstr(longint(cbrk_ori.offset),4));
  587. {$endif SYSTEMDEBUG}
  588. end
  589. else
  590. begin
  591. get_rm_interrupt(cbrk_vect, cbrk_ori);
  592. {$ifdef SYSTEMDEBUG}
  593. errln('ori rm cbrk '+hexstr(cbrk_ori.segment,4)+':'+hexstr(longint(cbrk_ori.offset),4));
  594. {$endif SYSTEMDEBUG}
  595. get_rm_callback(@djgpp_cbrk_hdlr, cbrk_regs, cbrk_rmcb);
  596. set_rm_interrupt(cbrk_vect, cbrk_rmcb);
  597. {$ifdef SYSTEMDEBUG}
  598. errln('now rm cbrk '+hexstr(cbrk_rmcb.segment,4)+':'+hexstr(longint(cbrk_rmcb.offset),4));
  599. {$endif SYSTEMDEBUG}
  600. cbrk_hooked := true;
  601. end;
  602. end;
  603. function dpmi_set_coprocessor_emulation(flag : longint) : longint;
  604. var
  605. res : longint;
  606. begin
  607. asm
  608. movl flag,%ebx
  609. movl $0xe01,%eax
  610. int $0x31
  611. jc .L_coproc_error
  612. xorl %eax,%eax
  613. .L_coproc_error:
  614. movl %eax,res
  615. end;
  616. dpmi_set_coprocessor_emulation:=res;
  617. end;
  618. procedure dpmiexcp_exit{(status : longint)};[public,alias : 'excep_exit'];
  619. { We need to restore hardware interrupt handlers even if somebody calls
  620. `_exit' directly, or else we crash the machine in nested programs.
  621. We only toggle the handlers if the original keyboard handler is intact
  622. (otherwise, they might have already toggled them). }
  623. begin
  624. if (exceptions_on) then
  625. djgpp_exception_toggle;
  626. asm
  627. xorl %eax,%eax
  628. movl %eax,_exception_exit
  629. movl %eax,_swap_in
  630. movl %eax,_swap_out
  631. end;
  632. { restore the FPU state }
  633. dpmi_set_coprocessor_emulation(1);
  634. end;
  635. { _exit in dpmiexcp.c
  636. is already present in v2prt0.as PM}
  637. { used by dos.pp for swap vectors }
  638. procedure dpmi_swap_in;[public,alias : 'swap_in'];
  639. begin
  640. if not (exceptions_on) then
  641. djgpp_exception_toggle;
  642. end;
  643. procedure dpmi_swap_out;[public,alias : 'swap_out'];
  644. begin
  645. if (exceptions_on) then
  646. djgpp_exception_toggle;
  647. end;
  648. procedure djgpp_exception_setup;[alias : '___djgpp_exception_setup'];
  649. var
  650. temp_kbd,
  651. temp_npx : pointer;
  652. _except,
  653. old_kbd : tseginfo;
  654. locksize : longint;
  655. i : longint;
  656. begin
  657. asm
  658. movl _exception_exit,%eax
  659. xorl %eax,%eax
  660. jne .L_already
  661. leal excep_exit,%eax
  662. movl %eax,_exception_exit
  663. leal swap_in,%eax
  664. movl %eax,_swap_in
  665. leal swap_out,%eax
  666. movl %eax,_swap_out
  667. end;
  668. { reset signals }
  669. for i := 0 to SIGMAX-1 do
  670. signal_list[i] := SignalHandler(@SIG_DFL);
  671. { app_DS only used when converting HW interrupts to exceptions }
  672. asm
  673. movw %ds,___djgpp_app_DS
  674. movw %ds,___djgpp_our_DS
  675. end;
  676. djgpp_dos_sel:=dosmemselector;
  677. { lock addresses which may see HW interrupts }
  678. lock_code(@djgpp_hw_lock_start,@djgpp_hw_lock_end-@djgpp_hw_lock_start);
  679. _except.segment:=get_cs;
  680. _except.offset:=@djgpp_exception_table;
  681. for i:=0 to ExceptionCount-1 do
  682. begin
  683. except_ori[i] := _except; { New value to set }
  684. inc(_except.offset,4); { This is the size of push n, jmp }
  685. end;
  686. kbd_ori.segment:=_except.segment;
  687. npx_ori.segment:=_except.segment;
  688. npx_ori.offset:=@djgpp_npx_hdlr;
  689. if (go32_info_block.linear_address_of_primary_screen <> $a0000) then
  690. kbd_ori.offset:=@djgpp_kbd_hdlr
  691. else
  692. begin
  693. kbd_ori.offset:=@djgpp_kbd_hdlr_pc98;
  694. cbrk_vect := $06;
  695. _except.offset:=@djgpp_iret;
  696. set_pm_interrupt($23,_except);
  697. end;
  698. _except.offset:=@djgpp_i24;
  699. set_pm_interrupt($24, _except);
  700. get_pm_interrupt(9,djgpp_old_kbd);
  701. djgpp_exception_toggle; { Set new values & save old values }
  702. { get original video mode and save }
  703. old_video_mode := farpeekb(dosmemselector, $449);
  704. asm
  705. .L_already:
  706. end;
  707. end;
  708. function djgpp_set_ctrl_c(enable : boolean) : boolean;
  709. begin
  710. djgpp_set_ctrl_c:=(djgpp_hwint_flags and 1)=0;
  711. if enable then
  712. djgpp_hwint_flags:=djgpp_hwint_flags and (not 1)
  713. else
  714. djgpp_hwint_flags:=djgpp_hwint_flags or 1;
  715. end;
  716. function c_djgpp_set_ctrl_c(enable : longint) : boolean;cdecl;[public,alias : '___djgpp_set_ctrl_c'];
  717. begin
  718. c_djgpp_set_ctrl_c:=djgpp_set_ctrl_c(boolean(enable));
  719. end;
  720. procedure InitDPMIExcp;
  721. begin
  722. djgpp_ds_alias:=v2prt0_ds_alias;
  723. djgpp_exception_setup;
  724. end;
  725. begin
  726. InitDPMIExcp;
  727. end.
  728. {
  729. $Log$
  730. Revision 1.10 1998-10-13 21:42:42 peter
  731. * cleanup and use of external var
  732. * fixed ctrl-break crashes
  733. Revision 1.9 1998/08/20 08:08:36 pierre
  734. * dpmiexcp did not compile with older versions
  735. due to the proc to procvar bug
  736. * makefile separator problem fixed
  737. Revision 1.8 1998/08/19 10:56:33 pierre
  738. + added some special code for C interface
  739. to avoid loading of crt1.o or dpmiexcp.o from the libc.a
  740. Revision 1.7 1998/08/15 17:01:13 peter
  741. * smartlinking the units works now
  742. * setjmp/longjmp -> dmpi_setjmp/dpmi_longjmp to solve systemunit
  743. conflict
  744. Revision 1.6 1998/08/04 13:31:32 pierre
  745. * changed all FPK into FPC
  746. Revision 1.5 1998/07/08 12:02:19 carl
  747. * make it compiler under fpc v0995
  748. Revision 1.4 1998/06/26 08:19:08 pierre
  749. + all debug in ifdef SYSTEMDEBUG
  750. + added local arrays :
  751. opennames names of opened files
  752. fileopen boolean array to know if still open
  753. usefull with gdb if you get problems about too
  754. many open files !!
  755. Revision 1.3 1998/05/31 14:18:23 peter
  756. * force att or direct assembling
  757. * cleanup of some files
  758. Revision 1.2 1998/04/21 14:46:33 pierre
  759. + debug info better output
  760. no normal code changed
  761. }