syslinux.pp 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by Michael Van Canneyt,
  5. member of the Free Pascal development team.
  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. { These things are set in the makefile, }
  13. { But you can override them here.}
  14. { If you want to link to the C library, set the conditional crtlib }
  15. { $define crtlib}
  16. { If you use an aout system, set the conditional AOUT}
  17. { $Define AOUT}
  18. Unit SysLinux;
  19. Interface
  20. {$ifdef m68k}
  21. { used for single computations }
  22. const
  23. BIAS4 = $7f-1;
  24. {$endif}
  25. {$define newsignal}
  26. {$I systemh.inc}
  27. {$I heaph.inc}
  28. const
  29. UnusedHandle = -1;
  30. StdInputHandle = 0;
  31. StdOutputHandle = 1;
  32. StdErrorHandle = 2;
  33. var
  34. argc : longint;
  35. argv : ppchar;
  36. envp : ppchar;
  37. Implementation
  38. {$I system.inc}
  39. {$ifdef crtlib}
  40. Procedure _rtl_exit(l: longint); cdecl;
  41. Function _rtl_paramcount: longint; cdecl;
  42. Procedure _rtl_paramstr(st: pchar; l: longint); cdecl;
  43. Function _rtl_open(f: pchar; flags: longint): longint; cdecl;
  44. Procedure _rtl_close(h: longint); cdecl;
  45. Procedure _rtl_write(h: longint; addr: longInt; len : longint); cdecl;
  46. Procedure _rtl_erase(p: pchar); cdecl;
  47. Procedure _rtl_rename(p1: pchar; p2 : pchar); cdecl;
  48. Function _rtl_read(h: longInt; addr: longInt; len : longint) : longint; cdecl;
  49. Function _rtl_filepos(Handle: longint): longint; cdecl;
  50. Procedure _rtl_seek(Handle: longint; pos:longint); cdecl;
  51. Function _rtl_filesize(Handle:longint): longInt; cdecl;
  52. Procedure _rtl_rmdir(buffer: pchar); cdecl;
  53. Procedure _rtl_mkdir(buffer: pchar); cdecl;
  54. Procedure _rtl_chdir(buffer: pchar); cdecl;
  55. {$else}
  56. { used in syscall to report errors.}
  57. var
  58. Errno : longint;
  59. { Include constant and type definitions }
  60. {$i errno.inc } { Error numbers }
  61. {$i sysnr.inc } { System call numbers }
  62. {$i sysconst.inc } { Miscellaneous constants }
  63. {$i systypes.inc } { Types needed for system calls }
  64. { Read actual system call definitions. }
  65. {$i syscalls.inc }
  66. {$endif}
  67. {*****************************************************************************
  68. Misc. System Dependent Functions
  69. *****************************************************************************}
  70. procedure prthaltproc;external name '_haltproc';
  71. procedure System_exit;
  72. begin
  73. {$ifdef i386}
  74. asm
  75. jmp prthaltproc
  76. end;
  77. {$else}
  78. asm
  79. jmp prthaltproc
  80. end;
  81. {$endif}
  82. End;
  83. Function ParamCount: Longint;
  84. Begin
  85. Paramcount:=argc-1
  86. End;
  87. Function ParamStr(l: Longint): String;
  88. var
  89. link,
  90. hs : string;
  91. i : longint;
  92. begin
  93. if l=0 then
  94. begin
  95. str(sys_getpid,hs);
  96. hs:='/proc/'+hs+'/exe'#0;
  97. i:=Sys_readlink(@hs[1],@link[1],high(link));
  98. if i>0 then
  99. begin
  100. link[0]:=chr(i);
  101. paramstr:=link;
  102. end
  103. else
  104. paramstr:=strpas(argv[0]);
  105. end
  106. else
  107. if (l>0) and (l<argc) then
  108. paramstr:=strpas(argv[l])
  109. else
  110. paramstr:='';
  111. end;
  112. Procedure Randomize;
  113. Begin
  114. randseed:=sys_time;
  115. End;
  116. {*****************************************************************************
  117. Heap Management
  118. *****************************************************************************}
  119. var
  120. _HEAP : longint;external name 'HEAP';
  121. _HEAPSIZE : longint;external name 'HEAPSIZE';
  122. function getheapstart:pointer;assembler;
  123. {$ifdef i386}
  124. asm
  125. leal _HEAP,%eax
  126. end ['EAX'];
  127. {$else}
  128. asm
  129. lea.l _HEAP,a0
  130. move.l a0,d0
  131. end;
  132. {$endif}
  133. function getheapsize:longint;assembler;
  134. {$ifdef i386}
  135. asm
  136. movl _HEAPSIZE,%eax
  137. end ['EAX'];
  138. {$else}
  139. asm
  140. move.l _HEAPSIZE,d0
  141. end ['D0'];
  142. {$endif}
  143. {$ifdef bsd}
  144. Function sbrk(size : longint) : Longint;
  145. CONST MAP_PRIVATE =2;
  146. MAP_ANONYMOUS =$1000; {$20 under linux}
  147. begin
  148. Sbrk:=do_syscall(syscall_nr_mmap,0,size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0,0);
  149. if ErrNo<>0 then
  150. Sbrk:=0;
  151. end;
  152. {$else}
  153. Function sbrk(size : longint) : Longint;
  154. type
  155. tmmapargs=packed record
  156. address : longint;
  157. size : longint;
  158. prot : longint;
  159. flags : longint;
  160. fd : longint;
  161. offset : longint;
  162. end;
  163. var
  164. t : syscallregs;
  165. mmapargs : tmmapargs;
  166. begin
  167. mmapargs.address:=0;
  168. mmapargs.size:=Size;
  169. mmapargs.prot:=3;
  170. mmapargs.flags:=$22;
  171. mmapargs.fd:=-1;
  172. mmapargs.offset:=0;
  173. t.reg2:=longint(@mmapargs);
  174. Sbrk:=syscall(syscall_nr_mmap,t);
  175. if ErrNo<>0 then
  176. Sbrk:=0;
  177. end;
  178. {$endif}
  179. { include standard heap management }
  180. {$I heap.inc}
  181. {*****************************************************************************
  182. Low Level File Routines
  183. *****************************************************************************}
  184. {
  185. The lowlevel file functions should take care of setting the InOutRes to the
  186. correct value if an error has occured, else leave it untouched
  187. }
  188. Procedure Errno2Inoutres;
  189. {
  190. Convert ErrNo error to the correct Inoutres value
  191. }
  192. begin
  193. if ErrNo=0 then { Else it will go through all the cases }
  194. exit;
  195. case ErrNo of
  196. Sys_ENFILE,
  197. Sys_EMFILE : Inoutres:=4;
  198. Sys_ENOENT : Inoutres:=2;
  199. Sys_EBADF : Inoutres:=6;
  200. Sys_ENOMEM,
  201. Sys_EFAULT : Inoutres:=217;
  202. Sys_EINVAL : Inoutres:=218;
  203. Sys_EPIPE,
  204. Sys_EINTR,
  205. Sys_EIO,
  206. Sys_EAGAIN,
  207. Sys_ENOSPC : Inoutres:=101;
  208. Sys_ENAMETOOLONG,
  209. Sys_ELOOP,
  210. Sys_ENOTDIR : Inoutres:=3;
  211. Sys_EROFS,
  212. Sys_EEXIST,
  213. Sys_EACCES : Inoutres:=5;
  214. Sys_ETXTBSY : Inoutres:=162;
  215. end;
  216. end;
  217. Procedure Do_Close(Handle:Longint);
  218. Begin
  219. {$ifdef crtlib}
  220. _rtl_close(Handle);
  221. {$else}
  222. sys_close(Handle);
  223. {$endif}
  224. End;
  225. Procedure Do_Erase(p:pchar);
  226. Begin
  227. {$ifdef crtlib}
  228. _rtl_erase(p);
  229. {$else}
  230. sys_unlink(p);
  231. Errno2Inoutres;
  232. {$endif}
  233. End;
  234. Procedure Do_Rename(p1,p2:pchar);
  235. Begin
  236. {$ifdef crtlib}
  237. _rtl_rename(p1,p2);
  238. {$else }
  239. sys_rename(p1,p2);
  240. Errno2Inoutres;
  241. {$endif}
  242. End;
  243. Function Do_Write(Handle,Addr,Len:Longint):longint;
  244. Begin
  245. {$ifdef crtlib}
  246. _rtl_write(Handle,addr,len);
  247. Do_Write:=Len;
  248. {$else}
  249. Do_Write:=sys_write(Handle,pchar(addr),len);
  250. Errno2Inoutres;
  251. {$endif}
  252. if Do_Write<0 then
  253. Do_Write:=0;
  254. End;
  255. Function Do_Read(Handle,Addr,Len:Longint):Longint;
  256. Begin
  257. {$ifdef crtlib}
  258. Do_Read:=_rtl_read(Handle,addr,len);
  259. {$else}
  260. Do_Read:=sys_read(Handle,pchar(addr),len);
  261. Errno2Inoutres;
  262. {$endif}
  263. if Do_Read<0 then
  264. Do_Read:=0;
  265. End;
  266. Function Do_FilePos(Handle: Longint): Longint;
  267. Begin
  268. {$ifdef crtlib}
  269. Do_FilePos:=_rtl_filepos(Handle);
  270. {$else}
  271. Do_FilePos:=sys_lseek(Handle, 0, Seek_Cur);
  272. Errno2Inoutres;
  273. {$endif}
  274. End;
  275. Procedure Do_Seek(Handle,Pos:Longint);
  276. Begin
  277. {$ifdef crtlib}
  278. _rtl_seek(Handle, Pos);
  279. {$else}
  280. sys_lseek(Handle, pos, Seek_set);
  281. {$endif}
  282. End;
  283. Function Do_SeekEnd(Handle:Longint): Longint;
  284. begin
  285. {$ifdef crtlib}
  286. Do_SeekEnd:=_rtl_filesize(Handle);
  287. {$else}
  288. Do_SeekEnd:=sys_lseek(Handle,0,Seek_End);
  289. {$endif}
  290. end;
  291. {$ifdef BSD}
  292. Function Do_FileSize(Handle:Longint): Longint;
  293. {$ifndef crtlib}
  294. var
  295. Info : Stat;
  296. {$endif}
  297. Begin
  298. {$ifdef crtlib}
  299. Do_FileSize:=_rtl_filesize(Handle);
  300. {$else}
  301. if do_SysCall(syscall_nr_fstat,handle,longint(@info))=0 then
  302. Do_FileSize:=Info.Size
  303. else
  304. Do_FileSize:=0;
  305. Errno2Inoutres;
  306. {$endif}
  307. End;
  308. {$ELSE}
  309. Function Do_FileSize(Handle:Longint): Longint;
  310. {$ifndef crtlib}
  311. var
  312. regs : Syscallregs;
  313. Info : Stat;
  314. {$endif}
  315. Begin
  316. {$ifdef crtlib}
  317. Do_FileSize:=_rtl_filesize(Handle);
  318. {$else}
  319. regs.reg2:=Handle;
  320. regs.reg3:=longint(@Info);
  321. if SysCall(SysCall_nr_fstat,regs)=0 then
  322. Do_FileSize:=Info.Size
  323. else
  324. Do_FileSize:=0;
  325. Errno2Inoutres;
  326. {$endif}
  327. End;
  328. {$endif}
  329. Procedure Do_Truncate(Handle,Pos:longint);
  330. {$ifndef crtlib}
  331. {$ifndef bsd}
  332. var
  333. sr : syscallregs;
  334. {$endif}
  335. {$endif}
  336. begin
  337. {$ifndef crtlib}
  338. {$ifdef bsd}
  339. do_syscall(syscall_nr_ftruncate,handle,pos,0);
  340. {$else}
  341. sr.reg2:=Handle;
  342. sr.reg3:=Pos;
  343. syscall(syscall_nr_ftruncate,sr);
  344. {$endif}
  345. Errno2Inoutres;
  346. {$endif}
  347. end;
  348. Procedure Do_Open(var f;p:pchar;flags:longint);
  349. {
  350. FileRec and textrec have both Handle and mode as the first items so
  351. they could use the same routine for opening/creating.
  352. when (flags and $100) the file will be append
  353. when (flags and $1000) the file will be truncate/rewritten
  354. when (flags and $10000) there is no check for close (needed for textfiles)
  355. }
  356. var
  357. {$ifndef crtlib}
  358. oflags : longint;
  359. {$endif}
  360. Begin
  361. { close first if opened }
  362. if ((flags and $10000)=0) then
  363. begin
  364. case FileRec(f).mode of
  365. fminput,fmoutput,fminout : Do_Close(FileRec(f).Handle);
  366. fmclosed : ;
  367. else
  368. begin
  369. inoutres:=102; {not assigned}
  370. exit;
  371. end;
  372. end;
  373. end;
  374. { reset file Handle }
  375. FileRec(f).Handle:=UnusedHandle;
  376. { We do the conversion of filemodes here, concentrated on 1 place }
  377. case (flags and 3) of
  378. 0 : begin
  379. oflags :=Open_RDONLY;
  380. FileRec(f).mode:=fminput;
  381. end;
  382. 1 : begin
  383. oflags :=Open_WRONLY;
  384. FileRec(f).mode:=fmoutput;
  385. end;
  386. 2 : begin
  387. oflags :=Open_RDWR;
  388. FileRec(f).mode:=fminout;
  389. end;
  390. end;
  391. if (flags and $1000)=$1000 then
  392. oflags:=oflags or (Open_CREAT or Open_TRUNC)
  393. else
  394. if (flags and $100)=$100 then
  395. oflags:=oflags or (Open_APPEND);
  396. { empty name is special }
  397. if p[0]=#0 then
  398. begin
  399. case FileRec(f).mode of
  400. fminput :
  401. FileRec(f).Handle:=StdInputHandle;
  402. fminout, { this is set by rewrite }
  403. fmoutput :
  404. FileRec(f).Handle:=StdOutputHandle;
  405. fmappend :
  406. begin
  407. FileRec(f).Handle:=StdOutputHandle;
  408. FileRec(f).mode:=fmoutput; {fool fmappend}
  409. end;
  410. end;
  411. exit;
  412. end;
  413. { real open call }
  414. {$ifdef crtlib}
  415. FileRec(f).Handle:=_rtl_open(p, oflags);
  416. if FileRec(f).Handle<0 then
  417. InOutRes:=2
  418. else
  419. InOutRes:=0;
  420. {$else}
  421. FileRec(f).Handle:=sys_open(p,oflags,438);
  422. if (ErrNo=Sys_EROFS) and ((OFlags and Open_RDWR)<>0) then
  423. begin
  424. Oflags:=Oflags and not(Open_RDWR);
  425. FileRec(f).Handle:=sys_open(p,oflags,438);
  426. end;
  427. Errno2Inoutres;
  428. {$endif}
  429. End;
  430. Function Do_IsDevice(Handle:Longint):boolean;
  431. {
  432. Interface to Unix ioctl call.
  433. Performs various operations on the filedescriptor Handle.
  434. Ndx describes the operation to perform.
  435. Data points to data needed for the Ndx function. The structure of this
  436. data is function-dependent.
  437. }
  438. var
  439. {$ifndef BSD}
  440. sr: SysCallRegs;
  441. {$endif}
  442. Data : array[0..255] of byte; {Large enough for termios info}
  443. begin
  444. {$ifdef BSD}
  445. Do_IsDevice:=(do_SysCall(syscall_nr_ioctl,handle,$5401,longint(@data))=0);
  446. {$else}
  447. sr.reg2:=Handle;
  448. sr.reg3:=$5401; {=TCGETS}
  449. sr.reg4:=Longint(@Data);
  450. Do_IsDevice:=(SysCall(Syscall_nr_ioctl,sr)=0);
  451. {$endif}
  452. end;
  453. {*****************************************************************************
  454. UnTyped File Handling
  455. *****************************************************************************}
  456. {$i file.inc}
  457. {*****************************************************************************
  458. Typed File Handling
  459. *****************************************************************************}
  460. {$i typefile.inc}
  461. {*****************************************************************************
  462. Text File Handling
  463. *****************************************************************************}
  464. {$DEFINE SHORT_LINEBREAK}
  465. {$DEFINE EXTENDED_EOF}
  466. {$i text.inc}
  467. {*****************************************************************************
  468. Directory Handling
  469. *****************************************************************************}
  470. Procedure MkDir(Const s: String);[IOCheck];
  471. Var
  472. Buffer: Array[0..255] of Char;
  473. Begin
  474. If InOutRes <> 0 then exit;
  475. Move(s[1], Buffer, Length(s));
  476. Buffer[Length(s)] := #0;
  477. {$ifdef crtlib}
  478. _rtl_mkdir(@buffer);
  479. {$else}
  480. sys_mkdir(@buffer, 511);
  481. Errno2Inoutres;
  482. {$endif}
  483. End;
  484. Procedure RmDir(Const s: String);[IOCheck];
  485. Var
  486. Buffer: Array[0..255] of Char;
  487. Begin
  488. If InOutRes <> 0 then exit;
  489. Move(s[1], Buffer, Length(s));
  490. Buffer[Length(s)] := #0;
  491. {$ifdef crtlib}
  492. _rtl_rmdir(@buffer);
  493. {$else}
  494. sys_rmdir(@buffer);
  495. Errno2Inoutres;
  496. {$endif}
  497. End;
  498. Procedure ChDir(Const s: String);[IOCheck];
  499. Var
  500. Buffer: Array[0..255] of Char;
  501. Begin
  502. If InOutRes <> 0 then exit;
  503. Move(s[1], Buffer, Length(s));
  504. Buffer[Length(s)] := #0;
  505. {$ifdef crtlib}
  506. _rtl_chdir(@buffer);
  507. {$else}
  508. sys_chdir(@buffer);
  509. Errno2Inoutres;
  510. {$endif}
  511. End;
  512. procedure getdir(drivenr : byte;var dir : shortstring);
  513. {$ifndef crtlib}
  514. var
  515. thisdir : stat;
  516. rootino,
  517. thisino,
  518. dotdotino : longint;
  519. rootdev,
  520. thisdev,
  521. {$ifdef bsd}
  522. dotdotdev : longint;
  523. {$else}
  524. dotdotdev : word;
  525. {$endif}
  526. thedir,dummy : string[255];
  527. dirstream : pdir;
  528. d : pdirent;
  529. mountpoint,validdir : boolean;
  530. predot : string[255];
  531. {$endif}
  532. begin
  533. drivenr:=0;
  534. dir:='';
  535. {$ifndef crtlib}
  536. thedir:='/'#0;
  537. if sys_stat(@thedir[1],thisdir)<0 then
  538. exit;
  539. rootino:=thisdir.ino;
  540. rootdev:=thisdir.dev;
  541. thedir:='.'#0;
  542. if sys_stat(@thedir[1],thisdir)<0 then
  543. exit;
  544. thisino:=thisdir.ino;
  545. thisdev:=thisdir.dev;
  546. { Now we can uniquely identify the current and root dir }
  547. thedir:='';
  548. predot:='';
  549. while not ((thisino=rootino) and (thisdev=rootdev)) do
  550. begin
  551. { Are we on a mount point ? }
  552. dummy:=predot+'..'#0;
  553. if sys_stat(@dummy[1],thisdir)<0 then
  554. exit;
  555. dotdotino:=thisdir.ino;
  556. dotdotdev:=thisdir.dev;
  557. mountpoint:=(thisdev<>dotdotdev);
  558. { Now, Try to find the name of this dir in the previous one }
  559. dirstream:=opendir (@dummy[1]);
  560. if dirstream=nil then
  561. exit;
  562. repeat
  563. d:=sys_readdir (dirstream);
  564. validdir:=false;
  565. if (d<>nil) and
  566. (not ((d^.name[0]='.') and ((d^.name[1]=#0) or ((d^.name[1]='.')
  567. and (d^.name[2]=#0))))) and
  568. (mountpoint or (d^.ino=thisino)) then
  569. begin
  570. dummy:=predot+'../'+strpas(@(d^.name[0]))+#0;
  571. validdir:=not (sys_stat (@(dummy[1]),thisdir)<0);
  572. end
  573. else
  574. validdir:=false;
  575. until (d=nil) or
  576. ((validdir) and (thisdir.dev=thisdev) and (thisdir.ino=thisino) );
  577. if (closedir(dirstream)<0) or (d=nil) then
  578. exit;
  579. { At this point, d.name contains the name of the current dir}
  580. thedir:='/'+strpas(@(d^.name[0]))+thedir;
  581. thisdev:=dotdotdev;
  582. thisino:=dotdotino;
  583. predot:=predot+'../';
  584. end;
  585. { Now rootino=thisino and rootdev=thisdev so we've reached / }
  586. dir:=thedir
  587. {$endif}
  588. end;
  589. {*****************************************************************************
  590. SystemUnit Initialization
  591. *****************************************************************************}
  592. {$ifdef I386}
  593. { this should be defined in i386 directory !! PM }
  594. const
  595. fpucw : word = $1332;
  596. FPU_Invalid = 1;
  597. FPU_Denormal = 2;
  598. FPU_DivisionByZero = 4;
  599. FPU_Overflow = 8;
  600. FPU_Underflow = $10;
  601. FPU_StackUnderflow = $20;
  602. FPU_StackOverflow = $40;
  603. {$endif I386}
  604. Procedure ResetFPU;
  605. begin
  606. {$ifdef I386}
  607. {$ifndef CORRECTFLDCW}
  608. {$asmmode direct}
  609. {$endif}
  610. asm
  611. fninit
  612. fldcw fpucw
  613. end;
  614. {$ifndef CORRECTFLDCW}
  615. {$asmmode att}
  616. {$endif}
  617. {$endif I386}
  618. end;
  619. {$ifndef BSD}
  620. {$ifndef newSignal}
  621. Procedure SignalToRunError(Sig:longint);
  622. begin
  623. case sig of
  624. 8 : begin
  625. { this is not allways necessary but I don't know yet
  626. how to tell if it is or not PM }
  627. ResetFPU;
  628. HandleError(200);
  629. end;
  630. 11 : HandleError(216);
  631. end;
  632. end;
  633. Procedure InstallSignals;
  634. var
  635. sr : syscallregs;
  636. begin
  637. sr.reg3:=longint(@SignalToRunError);
  638. { sigsegv }
  639. sr.reg2:=11;
  640. syscall(syscall_nr_signal,sr);
  641. { sigfpe }
  642. sr.reg2:=8;
  643. syscall(syscall_nr_signal,sr);
  644. end;
  645. {$else newSignal}
  646. {$i i386/signal.inc}
  647. procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec); cdecl;
  648. var
  649. res,fpustate : word;
  650. begin
  651. res:=0;
  652. case sig of
  653. 8 : begin
  654. { this is not allways necessary but I don't know yet
  655. how to tell if it is or not PM }
  656. {$ifdef I386}
  657. fpustate:=0;
  658. res:=200;
  659. if assigned(SigContext.fpstate) then
  660. fpuState:=SigContext.fpstate^.sw;
  661. {$ifdef SYSTEMDEBUG}
  662. Writeln(stderr,'FpuState = ',Hexstr(FpuState,4));
  663. {$endif SYSTEMDEBUG}
  664. if (FpuState and $7f) <> 0 then
  665. begin
  666. { first check te more precise options }
  667. if (FpuState and FPU_DivisionByZero)<>0 then
  668. res:=200
  669. else if (FpuState and FPU_Overflow)<>0 then
  670. res:=205
  671. else if (FpuState and FPU_Underflow)<>0 then
  672. res:=206
  673. else if (FpuState and FPU_Denormal)<>0 then
  674. res:=216
  675. else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow))<>0 then
  676. res:=207
  677. else if (FpuState and FPU_Invalid)<>0 then
  678. res:=216
  679. else
  680. res:=207; {'Coprocessor Error'}
  681. end;
  682. {$endif I386}
  683. ResetFPU;
  684. end;
  685. 11 : res:=216;
  686. end;
  687. { give runtime error at the position where the signal was raised }
  688. if res<>0 then
  689. begin
  690. {$ifdef I386}
  691. HandleErrorAddrFrame(res,SigContext.eip,SigContext.ebp);
  692. {$else}
  693. HandleError(res);
  694. {$endif}
  695. end;
  696. end;
  697. Procedure InstallSignals;
  698. const
  699. act: SigActionRec = (handler:(Sa:@SignalToRunError);sa_mask:0;sa_flags:0;
  700. Sa_restorer: NIL);
  701. oldact: PSigActionRec = Nil;
  702. begin
  703. ResetFPU;
  704. SigAction(8,@act,oldact);
  705. SigAction(11,@act,oldact);
  706. end;
  707. {$endif newSignal}
  708. {$endif bsd}
  709. procedure SetupCmdLine;
  710. var
  711. bufsize,
  712. len,j,
  713. size,i : longint;
  714. found : boolean;
  715. buf : array[0..1026] of char;
  716. procedure AddBuf;
  717. begin
  718. reallocmem(cmdline,size+bufsize);
  719. move(buf,cmdline[size],bufsize);
  720. inc(size,bufsize);
  721. bufsize:=0;
  722. end;
  723. begin
  724. size:=0;
  725. bufsize:=0;
  726. i:=0;
  727. while (i<argc) do
  728. begin
  729. len:=strlen(argv[i]);
  730. if len>sizeof(buf)-2 then
  731. len:=sizeof(buf)-2;
  732. found:=false;
  733. for j:=1 to len do
  734. if argv[i][j]=' ' then
  735. begin
  736. found:=true;
  737. break;
  738. end;
  739. if bufsize+len>=sizeof(buf)-2 then
  740. AddBuf;
  741. if found then
  742. begin
  743. buf[bufsize]:='"';
  744. inc(bufsize);
  745. end;
  746. move(argv[i]^,buf[bufsize],len);
  747. inc(bufsize,len);
  748. if found then
  749. begin
  750. buf[bufsize]:='"';
  751. inc(bufsize);
  752. end;
  753. if i<argc then
  754. buf[bufsize]:=' '
  755. else
  756. buf[bufsize]:=#0;
  757. inc(bufsize);
  758. inc(i);
  759. end;
  760. AddBuf;
  761. end;
  762. Begin
  763. { Set up signals handlers }
  764. {$ifndef bsd}
  765. InstallSignals;
  766. {$endif}
  767. { Setup heap }
  768. InitHeap;
  769. InitExceptions;
  770. { Arguments }
  771. SetupCmdLine;
  772. { Setup stdin, stdout and stderr }
  773. OpenStdIO(Input,fmInput,StdInputHandle);
  774. OpenStdIO(Output,fmOutput,StdOutputHandle);
  775. OpenStdIO(StdOut,fmOutput,StdOutputHandle);
  776. OpenStdIO(StdErr,fmOutput,StdErrorHandle);
  777. { Reset IO Error }
  778. InOutRes:=0;
  779. End.
  780. {
  781. $Log$
  782. Revision 1.47 2000-05-11 17:55:13 peter
  783. * changed order of fpustate checking to first check the more
  784. specific states
  785. Revision 1.46 2000/05/08 14:27:36 peter
  786. * released newsignal
  787. * newsignal gives now better backtraces using the sigcontext eip/ebp
  788. fields
  789. Revision 1.45 2000/04/16 16:07:58 marco
  790. * BSD fixes
  791. Revision 1.44 2000/04/14 13:04:53 marco
  792. * Merged bsd/syslinux.pp and 1.43 linux/syslinux.pp to this file with ifdefs
  793. Revision 1.43 2000/04/07 14:56:36 peter
  794. * switch to direct asm if not correctfldcw defined
  795. Revision 1.42 2000/03/31 23:26:32 pierre
  796. * FPU needs reset for all SIGFPE even from integer division by zero
  797. Revision 1.41 2000/03/31 23:21:19 pierre
  798. * multiple exception handling works
  799. (for linux only if syslinux is compiled with -dnewsignal)
  800. Revision 1.40 2000/03/31 13:24:28 jonas
  801. * signal handling using sigaction when compiled with -dnewsignal
  802. (allows multiple signals to be received in one run)
  803. Revision 1.39 2000/03/25 12:28:37 peter
  804. * patch for getdir from Pierre
  805. Revision 1.38 2000/03/23 15:24:18 peter
  806. * remove handle check for do_close
  807. Revision 1.37 2000/02/09 16:59:32 peter
  808. * truncated log
  809. Revision 1.36 2000/02/09 12:17:51 peter
  810. * moved halt to system.inc
  811. * syslinux doesn't use direct asm anymore
  812. Revision 1.35 2000/02/08 11:47:09 peter
  813. * paramstr(0) support
  814. Revision 1.34 2000/01/20 23:38:02 peter
  815. * support fm_inout as stdoutput for assign(f,'');rewrite(f,1); becuase
  816. rewrite opens always with filemode 2
  817. Revision 1.33 2000/01/16 22:25:38 peter
  818. * check handle for file closing
  819. Revision 1.32 2000/01/07 16:41:41 daniel
  820. * copyright 2000
  821. Revision 1.31 2000/01/07 16:32:28 daniel
  822. * copyright 2000 added
  823. Revision 1.30 1999/12/01 22:57:31 peter
  824. * cmdline support
  825. Revision 1.29 1999/11/06 14:39:12 peter
  826. * truncated log
  827. Revision 1.28 1999/10/28 09:50:06 peter
  828. * use mmap instead of brk
  829. Revision 1.27 1999/09/10 15:40:35 peter
  830. * fixed do_open flags to be > $100, becuase filemode can be upto 255
  831. Revision 1.26 1999/09/08 16:14:43 peter
  832. * pointer fixes
  833. Revision 1.25 1999/07/28 23:18:36 peter
  834. * closedir fixes, which now disposes the pdir itself
  835. }