unix.pp 65 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894
  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. BSD parts (c) 2000 by Marco van de Voort
  6. members of the Free Pascal development team.
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY;without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. Unit Unix;
  14. Interface
  15. { Get Types and Constants }
  16. {$i sysconst.inc}
  17. {$i systypes.inc}
  18. { Get System call numbers and error-numbers}
  19. {$i sysnr.inc}
  20. {$i errno.inc}
  21. {$I signal.inc}
  22. var
  23. ErrNo,
  24. LinuxError : Longint;
  25. {********************
  26. Process
  27. ********************}
  28. const
  29. {Checked for BSD using Linuxthreads port}
  30. { cloning flags }
  31. CSIGNAL = $000000ff; // signal mask to be sent at exit
  32. CLONE_VM = $00000100; // set if VM shared between processes
  33. CLONE_FS = $00000200; // set if fs info shared between processes
  34. CLONE_FILES = $00000400; // set if open files shared between processes
  35. CLONE_SIGHAND = $00000800; // set if signal handlers shared
  36. CLONE_PID = $00001000; // set if pid shared
  37. type
  38. TCloneFunc=function(args:pointer):longint;cdecl;
  39. const
  40. { For getting/setting priority }
  41. Prio_Process = 0;
  42. Prio_PGrp = 1;
  43. Prio_User = 2;
  44. WNOHANG = $1;
  45. WUNTRACED = $2;
  46. __WCLONE = $80000000;
  47. {********************
  48. File
  49. ********************}
  50. Const
  51. P_IN = 1;
  52. P_OUT = 2;
  53. Const
  54. LOCK_SH = 1;
  55. LOCK_EX = 2;
  56. LOCK_UN = 8;
  57. LOCK_NB = 4;
  58. Type
  59. Tpipe = array[1..2] of longint;
  60. pglob = ^tglob;
  61. tglob = record
  62. name : pchar;
  63. next : pglob;
  64. end;
  65. ComStr = String[255];
  66. PathStr = String[255];
  67. DirStr = String[255];
  68. NameStr = String[255];
  69. ExtStr = String[255];
  70. const
  71. { For testing access rights }
  72. R_OK = 4;
  73. W_OK = 2;
  74. X_OK = 1;
  75. F_OK = 0;
  76. { For File control mechanism }
  77. F_GetFd = 1;
  78. F_SetFd = 2;
  79. F_GetFl = 3;
  80. F_SetFl = 4;
  81. F_GetLk = 5;
  82. F_SetLk = 6;
  83. F_SetLkW = 7;
  84. F_SetOwn = 8;
  85. F_GetOwn = 9;
  86. {********************
  87. IOCtl(TermIOS)
  88. ********************}
  89. {Is too freebsd/Linux specific}
  90. {$I termios.inc}
  91. {********************
  92. Info
  93. ********************}
  94. Type
  95. UTimBuf = packed record{in BSD array[0..1] of timeval, but this is
  96. backwards compatible with linux version}
  97. actime,
  98. {$ifdef BSD}
  99. uactime, {BSD Micro seconds}
  100. {$endif}
  101. modtime
  102. {$ifdef BSD}
  103. ,
  104. umodtime {BSD Micro seconds}
  105. {$endif}
  106. : longint;
  107. end;
  108. UTimeBuf=UTimBuf;
  109. TUTimeBuf=UTimeBuf;
  110. PUTimeBuf=^UTimeBuf;
  111. TSysinfo = packed record
  112. uptime : longint;
  113. loads : array[1..3] of longint;
  114. totalram,
  115. freeram,
  116. sharedram,
  117. bufferram,
  118. totalswap,
  119. freeswap : longint;
  120. procs : integer;
  121. s : string[18];
  122. end;
  123. PSysInfo = ^TSysInfo;
  124. {******************************************************************************
  125. Procedure/Functions
  126. ******************************************************************************}
  127. {$ifdef bsd}
  128. function Do_SysCall(sysnr:longint):longint;
  129. function Do_Syscall(sysnr,param1:integer):longint;
  130. function Do_SysCall(sysnr,param1:LONGINT):longint;
  131. function Do_SysCall(sysnr,param1,param2:LONGINT):longint;
  132. function Do_SysCall(sysnr,param1,param2,param3:LONGINT):longint;
  133. function Do_SysCall(sysnr,param1,param2,param3,param4:LONGINT):longint;
  134. function Do_SysCall(sysnr,param1,param2,param3,param4,param5:LONGINT):longint;
  135. function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:LONGINT):longint;
  136. function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6,param7:LONGINT):longint;
  137. {$else}
  138. Function SysCall(callnr:longint;var regs:SysCallregs):longint;
  139. {$endif}
  140. {**************************
  141. Time/Date Handling
  142. ***************************}
  143. var
  144. tzdaylight : boolean;
  145. tzseconds : longint;
  146. tzname : array[boolean] of pchar;
  147. { timezone support }
  148. procedure GetLocalTimezone(timer:longint;var leap_correct,leap_hit:longint);
  149. procedure GetLocalTimezone(timer:longint);
  150. procedure ReadTimezoneFile(fn:string);
  151. function GetTimezoneFile:string;
  152. Procedure GetTimeOfDay(var tv:timeval);
  153. Function GetTimeOfDay:longint;
  154. {$ifndef bsd}
  155. Function GetEpochTime: longint;
  156. {$endif}
  157. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
  158. Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
  159. procedure GetTime(var hour,min,sec,msec,usec:word);
  160. procedure GetTime(var hour,min,sec,sec100:word);
  161. procedure GetTime(var hour,min,sec:word);
  162. Procedure GetDate(Var Year,Month,Day:Word);
  163. Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
  164. {**************************
  165. Process Handling
  166. ***************************}
  167. function CreateShellArgV(const prog:string):ppchar;
  168. function CreateShellArgV(const prog:Ansistring):ppchar;
  169. Procedure Execve(Path:pathstr;args:ppchar;ep:ppchar);
  170. Procedure Execve(path:pchar;args:ppchar;ep:ppchar);
  171. Procedure Execv(const path:pathstr;args:ppchar);
  172. Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
  173. Procedure Execl(const Todo:string);
  174. Procedure Execle(Todo:string;Ep:ppchar);
  175. Procedure Execlp(Todo:string;Ep:ppchar);
  176. Function Shell(const Command:String):Longint;
  177. Function Shell(const Command:AnsiString):Longint;
  178. Function Fork:longint;
  179. {Clone for FreeBSD is copied from the LinuxThread port, and rfork based}
  180. function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
  181. Procedure ExitProcess(val:longint);
  182. Function WaitPid(Pid:longint;Status:pointer;Options:longint):Longint;
  183. Procedure Nice(N:integer);
  184. {$ifdef bsd}
  185. Function GetPriority(Which,Who:longint):longint;
  186. procedure SetPriority(Which,Who,What:longint);
  187. {$else}
  188. Function GetPriority(Which,Who:Integer):integer;
  189. Procedure SetPriority(Which:Integer;Who:Integer;What:Integer);
  190. {$endif}
  191. Function GetPid:LongInt;
  192. Function GetPPid:LongInt;
  193. Function GetUid:Longint;
  194. Function GetEUid:Longint;
  195. Function GetGid:Longint;
  196. Function GetEGid:Longint;
  197. {**************************
  198. File Handling
  199. ***************************}
  200. Function fdOpen(pathname:string;flags:longint):longint;
  201. Function fdOpen(pathname:string;flags,mode:longint):longint;
  202. Function fdOpen(pathname:pchar;flags:longint):longint;
  203. Function fdOpen(pathname:pchar;flags,mode:longint):longint;
  204. Function fdClose(fd:longint):boolean;
  205. Function fdRead(fd:longint;var buf;size:longint):longint;
  206. Function fdWrite(fd:longint;var buf;size:longint):longint;
  207. Function fdTruncate(fd,size:longint):boolean;
  208. Function fdSeek (fd,pos,seektype :longint): longint;
  209. Function fdFlush (fd : Longint) : Boolean;
  210. Function Link(OldPath,NewPath:pathstr):boolean;
  211. Function SymLink(OldPath,NewPath:pathstr):boolean;
  212. {$ifndef bsd}
  213. Function ReadLink(name,linkname:pchar;maxlen:longint):longint;
  214. Function ReadLink(name:pathstr):pathstr;
  215. {$endif}
  216. Function UnLink(Path:pathstr):boolean;
  217. Function UnLink(Path:pchar):Boolean;
  218. Function FReName (OldName,NewName : Pchar) : Boolean;
  219. Function FReName (OldName,NewName : String) : Boolean;
  220. Function Chown(path:pathstr;NewUid,NewGid:longint):boolean;
  221. Function Chmod(path:pathstr;Newmode:longint):boolean;
  222. Function Utime(path:pathstr;utim:utimebuf):boolean;
  223. {$ifdef BSD}
  224. Function Access(Path:Pathstr ;mode:longint):boolean;
  225. {$else}
  226. Function Access(Path:Pathstr ;mode:integer):boolean;
  227. {$endif}
  228. Function Umask(Mask:Integer):integer;
  229. Function Flock (fd,mode : longint) : boolean;
  230. Function Flock (var T : text;mode : longint) : boolean;
  231. Function Flock (var F : File;mode : longint) : boolean;
  232. Function FStat(Path:Pathstr;Var Info:stat):Boolean;
  233. Function FStat(Fd:longint;Var Info:stat):Boolean;
  234. Function FStat(var F:Text;Var Info:stat):Boolean;
  235. Function FStat(var F:File;Var Info:stat):Boolean;
  236. Function Lstat(Filename: PathStr;var Info:stat):Boolean;
  237. Function FSStat(Path:Pathstr;Var Info:statfs):Boolean;
  238. Function FSStat(Fd: Longint;Var Info:statfs):Boolean;
  239. {$ifdef bsd}
  240. Function Fcntl(Fd:longint;Cmd:longint):longint;
  241. Procedure Fcntl(Fd:longint;Cmd:longint;Arg:Longint);
  242. Function Fcntl(var Fd:Text;Cmd:longint):longint;
  243. Procedure Fcntl(var Fd:Text;Cmd:longint;Arg:Longint);
  244. {$else}
  245. Function Fcntl(Fd:longint;Cmd:Integer):integer;
  246. Procedure Fcntl(Fd:longint;Cmd:Integer;Arg:Longint);
  247. Function Fcntl(var Fd:Text;Cmd:Integer):integer;
  248. Procedure Fcntl(var Fd:Text;Cmd:Integer;Arg:Longint);
  249. {$endif}
  250. Function Dup(oldfile:longint;var newfile:longint):Boolean;
  251. Function Dup(var oldfile,newfile:text):Boolean;
  252. Function Dup(var oldfile,newfile:file):Boolean;
  253. Function Dup2(oldfile,newfile:longint):Boolean;
  254. Function Dup2(var oldfile,newfile:text):Boolean;
  255. Function Dup2(var oldfile,newfile:file):Boolean;
  256. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
  257. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
  258. Function SelectText(var T:Text;TimeOut :PTimeVal):Longint;
  259. {**************************
  260. Directory Handling
  261. ***************************}
  262. Function OpenDir(f:pchar):pdir;
  263. Function OpenDir(f: String):pdir;
  264. function CloseDir(p:pdir):integer;
  265. Function ReadDir(p:pdir):pdirent;
  266. procedure SeekDir(p:pdir;off:longint);
  267. function TellDir(p:pdir):longint;
  268. {**************************
  269. Pipe/Fifo/Stream
  270. ***************************}
  271. Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
  272. Function AssignPipe(var pipe_in,pipe_out:text):boolean;
  273. Function AssignPipe(var pipe_in,pipe_out:file):boolean;
  274. Function PClose(Var F:text) : longint;
  275. Function PClose(Var F:file) : longint;
  276. Procedure POpen(var F:text;const Prog:String;rw:char);
  277. Procedure POpen(var F:file;const Prog:String;rw:char);
  278. Function mkFifo(pathname:string;mode:longint):boolean;
  279. function AssignStream(Var StreamIn,Streamout:text;Const Prog:String) : longint;
  280. function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: String): LongInt;
  281. {**************************
  282. General information
  283. ***************************}
  284. Function GetEnv(P:string):Pchar;
  285. {$ifndef BSD}
  286. Function GetDomainName:String;
  287. Function GetHostName:String;
  288. Function Sysinfo(var Info:TSysinfo):Boolean;
  289. Function Uname(var unamerec:utsname):Boolean;
  290. {$endif}
  291. {**************************
  292. Signal
  293. ***************************}
  294. Procedure SigAction(Signum:longint;Act,OldAct:PSigActionRec );
  295. Procedure SigProcMask (How:longint;SSet,OldSSet:PSigSet);
  296. Function SigPending:SigSet;
  297. Procedure SigSuspend(Mask:Sigset);
  298. Function Signal(Signum:longint;Handler:SignalHandler):SignalHandler;
  299. Function Kill(Pid:longint;Sig:longint):integer;
  300. Procedure SigRaise(Sig:integer);
  301. {$ifndef BSD}
  302. Function Alarm(Sec : Longint) : longint;
  303. Procedure Pause;
  304. {$endif}
  305. Function NanoSleep(const req : timespec;var rem : timespec) : longint;
  306. {**************************
  307. IOCtl/Termios Functions
  308. ***************************}
  309. Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
  310. Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
  311. Function TCSetAttr(fd:longint;OptAct:longint;var tios:TermIOS):boolean;
  312. Procedure CFSetISpeed(var tios:TermIOS;speed:Longint);
  313. Procedure CFSetOSpeed(var tios:TermIOS;speed:Longint);
  314. Procedure CFMakeRaw(var tios:TermIOS);
  315. Function TCSendBreak(fd,duration:longint):boolean;
  316. Function TCSetPGrp(fd,id:longint):boolean;
  317. Function TCGetPGrp(fd:longint;var id:longint):boolean;
  318. Function TCFlush(fd,qsel:longint):boolean;
  319. Function TCDrain(fd:longint):boolean;
  320. Function TCFlow(fd,act:longint):boolean;
  321. Function IsATTY(Handle:Longint):Boolean;
  322. Function IsATTY(f:text):Boolean;
  323. function TTYname(Handle:Longint):string;
  324. function TTYname(var F:Text):string;
  325. {**************************
  326. Memory functions
  327. ***************************}
  328. const
  329. PROT_READ = $1; { page can be read }
  330. PROT_WRITE = $2; { page can be written }
  331. PROT_EXEC = $4; { page can be executed }
  332. PROT_NONE = $0; { page can not be accessed }
  333. MAP_SHARED = $1; { Share changes }
  334. MAP_PRIVATE = $2; { Changes are private }
  335. MAP_TYPE = $f; { Mask for type of mapping }
  336. MAP_FIXED = $10; { Interpret addr exactly }
  337. MAP_ANONYMOUS = $20; { don't use a file }
  338. MAP_GROWSDOWN = $100; { stack-like segment }
  339. MAP_DENYWRITE = $800; { ETXTBSY }
  340. MAP_EXECUTABLE = $1000; { mark it as an executable }
  341. MAP_LOCKED = $2000; { pages are locked }
  342. MAP_NORESERVE = $4000; { don't check for reservations }
  343. type
  344. tmmapargs=record
  345. address : longint;
  346. size : longint;
  347. prot : longint;
  348. flags : longint;
  349. fd : longint;
  350. offset : longint;
  351. end;
  352. function MMap(const m:tmmapargs):longint;
  353. function MUnMap (P : Pointer; Size : Longint) : Boolean;
  354. {**************************
  355. Port IO functions
  356. ***************************}
  357. Function IOperm (From,Num : Cardinal; Value : Longint) : boolean;
  358. {$ifdef i386}
  359. Procedure WritePort (Port : Longint; Value : Byte);
  360. Procedure WritePort (Port : Longint; Value : Word);
  361. Procedure WritePort (Port : Longint; Value : Longint);
  362. Procedure WritePortB (Port : Longint; Value : Byte);
  363. Procedure WritePortW (Port : Longint; Value : Word);
  364. Procedure WritePortL (Port : Longint; Value : Longint);
  365. Procedure WritePortL (Port : Longint; Var Buf; Count: longint);
  366. Procedure WritePortW (Port : Longint; Var Buf; Count: longint);
  367. Procedure WritePortB (Port : Longint; Var Buf; Count: longint);
  368. Procedure ReadPort (Port : Longint; Var Value : Byte);
  369. Procedure ReadPort (Port : Longint; Var Value : Word);
  370. Procedure ReadPort (Port : Longint; Var Value : Longint);
  371. function ReadPortB (Port : Longint): Byte;
  372. function ReadPortW (Port : Longint): Word;
  373. function ReadPortL (Port : Longint): LongInt;
  374. Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);
  375. Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);
  376. Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);
  377. {$endif}
  378. {**************************
  379. Utility functions
  380. ***************************}
  381. Function Octal(l:longint):longint;
  382. Function FExpand(Const Path: PathStr):PathStr;
  383. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  384. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  385. Function Dirname(Const path:pathstr):pathstr;
  386. Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
  387. Function FNMatch(const Pattern,Name:string):Boolean;
  388. Function Glob(Const path:pathstr):pglob;
  389. Procedure Globfree(var p:pglob);
  390. Function StringToPPChar(Var S:STring):ppchar;
  391. Function GetFS(var T:Text):longint;
  392. Function GetFS(Var F:File):longint;
  393. {Filedescriptorsets}
  394. Procedure FD_Zero(var fds:fdSet);
  395. Procedure FD_Clr(fd:longint;var fds:fdSet);
  396. Procedure FD_Set(fd:longint;var fds:fdSet);
  397. Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
  398. {Stat.Mode Types}
  399. Function S_ISLNK(m:word):boolean;
  400. Function S_ISREG(m:word):boolean;
  401. Function S_ISDIR(m:word):boolean;
  402. Function S_ISCHR(m:word):boolean;
  403. Function S_ISBLK(m:word):boolean;
  404. Function S_ISFIFO(m:word):boolean;
  405. Function S_ISSOCK(m:word):boolean;
  406. {******************************************************************************
  407. Implementation
  408. ******************************************************************************}
  409. Implementation
  410. Uses Strings;
  411. { Get the definitions of textrec and filerec }
  412. {$i textrec.inc}
  413. {$i filerec.inc}
  414. { Raw System calls are in Syscalls.inc}
  415. {$i syscalls.inc}
  416. {$ifdef BSD}
  417. {$i bsdsysca.inc}
  418. {$else}
  419. {$i linsysca.inc}
  420. {$endif}
  421. {******************************************************************************
  422. Process related calls
  423. ******************************************************************************}
  424. function CreateShellArgV(const prog:string):ppchar;
  425. {
  426. Create an argv which executes a command in a shell using /bin/sh -c
  427. }
  428. var
  429. pp,p : ppchar;
  430. temp : string;
  431. begin
  432. getmem(pp,4*4);
  433. temp:='/bin/sh'#0'-c'#0+prog+#0;
  434. p:=pp;
  435. p^:=@temp[1];
  436. inc(p);
  437. p^:=@temp[9];
  438. inc(p);
  439. p^:=@temp[12];
  440. inc(p);
  441. p^:=Nil;
  442. CreateShellArgV:=pp;
  443. end;
  444. function CreateShellArgV(const prog:Ansistring):ppchar;
  445. {
  446. Create an argv which executes a command in a shell using /bin/sh -c
  447. using a AnsiString;
  448. }
  449. var
  450. pp,p : ppchar;
  451. temp : AnsiString;
  452. begin
  453. getmem(pp,4*4);
  454. temp:='/bin/sh'#0'-c'#0+prog+#0;
  455. p:=pp;
  456. GetMem(p^,Length(Temp));
  457. Move(Temp[1],p^^,Length(Temp));
  458. inc(p);
  459. p^:=@pp[0][8];
  460. inc(p);
  461. p^:=@pp[0][11];
  462. inc(p);
  463. p^:=Nil;
  464. CreateShellArgV:=pp;
  465. end;
  466. Procedure Execv(const path:pathstr;args:ppchar);
  467. {
  468. Replaces the current program by the program specified in path,
  469. arguments in args are passed to Execve.
  470. the current environment is passed on.
  471. }
  472. begin
  473. Execve(path,args,envp); {On error linuxerror will get set there}
  474. end;
  475. Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
  476. {
  477. This does the same as Execve, only it searches the PATH environment
  478. for the place of the Executable, except when Path starts with a slash.
  479. if the PATH environment variable is unavailable, the path is set to '.'
  480. }
  481. var
  482. thepath : string;
  483. begin
  484. if path[1]<>'/' then
  485. begin
  486. Thepath:=strpas(getenv('PATH'));
  487. if thepath='' then
  488. thepath:='.';
  489. Path:=FSearch(path,thepath)
  490. end
  491. else
  492. Path:='';
  493. if Path='' then
  494. linuxerror:=Sys_enoent
  495. else
  496. Execve(Path,args,ep);{On error linuxerror will get set there}
  497. end;
  498. Procedure Execle(Todo:string;Ep:ppchar);
  499. {
  500. This procedure takes the string 'Todo', parses it for command and
  501. command options, and Executes the command with the given options.
  502. The string 'Todo' shoud be of the form 'command options', options
  503. separated by commas.
  504. the PATH environment is not searched for 'command'.
  505. The specified environment(in 'ep') is passed on to command
  506. }
  507. var
  508. p : ppchar;
  509. begin
  510. p:=StringToPPChar(ToDo);
  511. if (p=nil) or (p^=nil) then
  512. exit;
  513. ExecVE(p^,p,EP);
  514. end;
  515. Procedure Execl(const Todo:string);
  516. {
  517. This procedure takes the string 'Todo', parses it for command and
  518. command options, and Executes the command with the given options.
  519. The string 'Todo' shoud be of the form 'command options', options
  520. separated by commas.
  521. the PATH environment is not searched for 'command'.
  522. The current environment is passed on to command
  523. }
  524. begin
  525. ExecLE(ToDo,EnvP);
  526. end;
  527. Procedure Execlp(Todo:string;Ep:ppchar);
  528. {
  529. This procedure takes the string 'Todo', parses it for command and
  530. command options, and Executes the command with the given options.
  531. The string 'Todo' shoud be of the form 'command options', options
  532. separated by commas.
  533. the PATH environment is searched for 'command'.
  534. The specified environment (in 'ep') is passed on to command
  535. }
  536. var
  537. p : ppchar;
  538. begin
  539. p:=StringToPPchar(todo);
  540. if (p=nil) or (p^=nil) then
  541. exit;
  542. ExecVP(StrPas(p^),p,EP);
  543. end;
  544. Function Shell(const Command:String):Longint;
  545. {
  546. Executes the shell, and passes it the string Command. (Through /bin/sh -c)
  547. The current environment is passed to the shell.
  548. It waits for the shell to exit, and returns its exit status.
  549. If the Exec call failed exit status 127 is reported.
  550. }
  551. var
  552. p : ppchar;
  553. temp,pid : longint;
  554. begin
  555. pid:=fork;
  556. if pid=-1 then
  557. exit; {Linuxerror already set in Fork}
  558. if pid=0 then
  559. begin
  560. {This is the child.}
  561. p:=CreateShellArgv(command);
  562. Execve(p^,p,envp);
  563. exit(127);
  564. end;
  565. temp:=0;
  566. WaitPid(pid,@temp,0);{Linuxerror is set there}
  567. Shell:=temp;{ Return exit status }
  568. end;
  569. Function Shell(const Command:AnsiString):Longint;
  570. {
  571. AnsiString version of Shell
  572. }
  573. var
  574. p : ppchar;
  575. temp,pid : longint;
  576. begin
  577. pid:=fork;
  578. if pid=-1 then
  579. exit; {Linuxerror already set in Fork}
  580. if pid=0 then
  581. begin
  582. {This is the child.}
  583. p:=CreateShellArgv(command);
  584. Execve(p^,p,envp);
  585. exit(127);
  586. end;
  587. temp:=0;
  588. WaitPid(pid,@temp,0);{Linuxerror is set there}
  589. Shell:=temp;{ Return exit status }
  590. end;
  591. {******************************************************************************
  592. Date and Time related calls
  593. ******************************************************************************}
  594. Const
  595. {Date Translation}
  596. C1970=2440588;
  597. D0 = 1461;
  598. D1 = 146097;
  599. D2 =1721119;
  600. Function GregorianToJulian(Year,Month,Day:Longint):LongInt;
  601. Var
  602. Century,XYear: LongInt;
  603. Begin
  604. If Month<=2 Then
  605. Begin
  606. Dec(Year);
  607. Inc(Month,12);
  608. End;
  609. Dec(Month,3);
  610. Century:=(longint(Year Div 100)*D1) shr 2;
  611. XYear:=(longint(Year Mod 100)*D0) shr 2;
  612. GregorianToJulian:=((((Month*153)+2) div 5)+Day)+D2+XYear+Century;
  613. End;
  614. Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
  615. Var
  616. YYear,XYear,Temp,TempMonth : LongInt;
  617. Begin
  618. Temp:=((JulianDN-D2) shl 2)-1;
  619. JulianDN:=Temp Div D1;
  620. XYear:=(Temp Mod D1) or 3;
  621. YYear:=(XYear Div D0);
  622. Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
  623. Day:=((Temp Mod 153)+5) Div 5;
  624. TempMonth:=Temp Div 153;
  625. If TempMonth>=10 Then
  626. Begin
  627. inc(YYear);
  628. dec(TempMonth,12);
  629. End;
  630. inc(TempMonth,3);
  631. Month := TempMonth;
  632. Year:=YYear+(JulianDN*100);
  633. end;
  634. Function GetEpochTime: longint;
  635. {
  636. Get the number of seconds since 00:00, January 1 1970, GMT
  637. the time NOT corrected any way
  638. }
  639. begin
  640. GetEpochTime:=GetTimeOfDay;
  641. end;
  642. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
  643. {
  644. Transforms Epoch time into local time (hour, minute,seconds)
  645. }
  646. Var
  647. DateNum: LongInt;
  648. Begin
  649. inc(Epoch,TZSeconds);
  650. Datenum:=(Epoch Div 86400) + c1970;
  651. JulianToGregorian(DateNum,Year,Month,day);
  652. Epoch:=Epoch Mod 86400;
  653. Hour:=Epoch Div 3600;
  654. Epoch:=Epoch Mod 3600;
  655. Minute:=Epoch Div 60;
  656. Second:=Epoch Mod 60;
  657. End;
  658. Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
  659. {
  660. Transforms local time (year,month,day,hour,minutes,second) to Epoch time
  661. (seconds since 00:00, january 1 1970, corrected for local time zone)
  662. }
  663. Begin
  664. LocalToEpoch:=((GregorianToJulian(Year,Month,Day)-c1970)*86400)+
  665. (LongInt(Hour)*3600)+(Minute*60)+Second-TZSeconds;
  666. End;
  667. procedure GetTime(var hour,min,sec,msec,usec:word);
  668. {
  669. Gets the current time, adjusted to local time
  670. }
  671. var
  672. year,day,month:Word;
  673. t : timeval;
  674. begin
  675. gettimeofday(t);
  676. EpochToLocal(t.sec,year,month,day,hour,min,sec);
  677. msec:=t.usec div 1000;
  678. usec:=t.usec mod 1000;
  679. end;
  680. procedure GetTime(var hour,min,sec,sec100:word);
  681. {
  682. Gets the current time, adjusted to local time
  683. }
  684. var
  685. usec : word;
  686. begin
  687. gettime(hour,min,sec,sec100,usec);
  688. sec100:=sec100 div 10;
  689. end;
  690. Procedure GetTime(Var Hour,Min,Sec:Word);
  691. {
  692. Gets the current time, adjusted to local time
  693. }
  694. var
  695. msec,usec : Word;
  696. Begin
  697. gettime(hour,min,sec,msec,usec);
  698. End;
  699. Procedure GetDate(Var Year,Month,Day:Word);
  700. {
  701. Gets the current date, adjusted to local time
  702. }
  703. var
  704. hour,minute,second : word;
  705. Begin
  706. EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
  707. End;
  708. Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
  709. {
  710. Gets the current date, adjusted to local time
  711. }
  712. Begin
  713. EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
  714. End;
  715. { Include timezone handling routines which use /usr/share/timezone info }
  716. {$i timezone.inc}
  717. {******************************************************************************
  718. FileSystem calls
  719. ******************************************************************************}
  720. Function fdOpen(pathname:string;flags:longint):longint;
  721. begin
  722. pathname:=pathname+#0;
  723. fdOpen:=Sys_Open(@pathname[1],flags,438);
  724. LinuxError:=Errno;
  725. end;
  726. Function fdOpen(pathname:string;flags,mode:longint):longint;
  727. begin
  728. pathname:=pathname+#0;
  729. fdOpen:=Sys_Open(@pathname[1],flags,mode);
  730. LinuxError:=Errno;
  731. end;
  732. Function fdOpen(pathname:pchar;flags:longint):longint;
  733. begin
  734. fdOpen:=Sys_Open(pathname,flags,0);
  735. LinuxError:=Errno;
  736. end;
  737. Function fdOpen(pathname:pchar;flags,mode:longint):longint;
  738. begin
  739. fdOpen:=Sys_Open(pathname,flags,mode);
  740. LinuxError:=Errno;
  741. end;
  742. Function fdClose(fd:longint):boolean;
  743. begin
  744. fdClose:=(Sys_Close(fd)=0);
  745. LinuxError:=Errno;
  746. end;
  747. Function fdRead(fd:longint;var buf;size:longint):longint;
  748. begin
  749. fdRead:=Sys_Read(fd,pchar(@buf),size);
  750. LinuxError:=Errno;
  751. end;
  752. Function fdWrite(fd:longint;var buf;size:longint):longint;
  753. begin
  754. fdWrite:=Sys_Write(fd,pchar(@buf),size);
  755. LinuxError:=Errno;
  756. end;
  757. Function fdSeek (fd,pos,seektype :longint): longint;
  758. {
  759. Do a Seek on a file descriptor fd to position pos, starting from seektype
  760. }
  761. begin
  762. fdseek:=Sys_LSeek (fd,pos,seektype);
  763. LinuxError:=Errno;
  764. end;
  765. {$ifdef BSD}
  766. Function Fcntl(Fd:longint;Cmd:longint):longint;
  767. {
  768. Read or manipulate a file.(See also fcntl (2) )
  769. Possible values for Cmd are :
  770. F_GetFd,F_GetFl,F_GetOwn
  771. Errors are reported in Linuxerror;
  772. If Cmd is different from the allowed values, linuxerror=Sys_eninval.
  773. }
  774. begin
  775. if (cmd in [F_GetFd,F_GetFl,F_GetOwn]) then
  776. begin
  777. Linuxerror:=sys_fcntl(fd,cmd,0);
  778. if linuxerror=-1 then
  779. begin
  780. linuxerror:=errno;
  781. fcntl:=0;
  782. end
  783. else
  784. begin
  785. fcntl:=linuxerror;
  786. linuxerror:=0;
  787. end;
  788. end
  789. else
  790. begin
  791. linuxerror:=Sys_einval;
  792. Fcntl:=0;
  793. end;
  794. end;
  795. Procedure Fcntl(Fd:longint;Cmd:longint;Arg:Longint);
  796. {
  797. Read or manipulate a file. (See also fcntl (2) )
  798. Possible values for Cmd are :
  799. F_setFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkW,F_SetOwn;
  800. Errors are reported in Linuxerror;
  801. If Cmd is different from the allowed values, linuxerror=Sys_eninval.
  802. F_DupFD is not allowed, due to the structure of Files in Pascal.
  803. }
  804. begin
  805. if (cmd in [F_SetFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkw,F_SetOwn]) then
  806. begin
  807. sys_fcntl(fd,cmd,arg);
  808. LinuxError:=ErrNo;
  809. end
  810. else
  811. linuxerror:=Sys_einval;
  812. end;
  813. {$endif}
  814. {$ifdef BSD}
  815. Function Fcntl(var Fd:Text;Cmd:longint):longint;
  816. {$else}
  817. Function Fcntl(var Fd:Text;Cmd:integer):integer;
  818. {$endif}
  819. begin
  820. Fcntl := Fcntl(textrec(Fd).handle, Cmd);
  821. end;
  822. {$ifdef BSD}
  823. Procedure Fcntl(var Fd:Text;Cmd,Arg:Longint);
  824. {$else}
  825. Procedure Fcntl(var Fd:Text;Cmd:Integer;Arg:Longint);
  826. {$endif}
  827. begin
  828. Fcntl(textrec(Fd).handle, Cmd, Arg);
  829. end;
  830. Function Flock (var T : text;mode : longint) : boolean;
  831. begin
  832. Flock:=Flock(TextRec(T).Handle,mode);
  833. end;
  834. Function Flock (var F : File;mode : longint) : boolean;
  835. begin
  836. Flock:=Flock(FileRec(F).Handle,mode);
  837. end;
  838. Function FStat(Path:Pathstr;Var Info:stat):Boolean;
  839. {
  840. Get all information on a file, and return it in Info.
  841. }
  842. begin
  843. path:=path+#0;
  844. FStat:=(Sys_stat(@(path[1]),Info)=0);
  845. LinuxError:=errno;
  846. end;
  847. Function FStat(var F:Text;Var Info:stat):Boolean;
  848. {
  849. Get all information on a text file, and return it in info.
  850. }
  851. begin
  852. FStat:=Fstat(TextRec(F).Handle,INfo);
  853. end;
  854. Function FStat(var F:File;Var Info:stat):Boolean;
  855. {
  856. Get all information on a untyped file, and return it in info.
  857. }
  858. begin
  859. FStat:=Fstat(FileRec(F).Handle,Info);
  860. end;
  861. Function SymLink(OldPath,newPath:pathstr):boolean;
  862. {
  863. Proceduces a soft link from new to old.
  864. }
  865. begin
  866. oldpath:=oldpath+#0;
  867. newpath:=newpath+#0;
  868. Symlink:=Sys_symlink(pchar(@(oldpath[1])),pchar(@(newpath[1])))=0;
  869. linuxerror:=errno;
  870. end;
  871. Function ReadLink(name,linkname:pchar;maxlen:longint):longint;
  872. {
  873. Read a link (where it points to)
  874. }
  875. begin
  876. Readlink:=Sys_readlink(Name,LinkName,maxlen);
  877. linuxerror:=errno;
  878. end;
  879. Function ReadLink(Name:pathstr):pathstr;
  880. {
  881. Read a link (where it points to)
  882. }
  883. var
  884. LinkName : pathstr;
  885. i : longint;
  886. begin
  887. Name:=Name+#0;
  888. i:=ReadLink(@Name[1],@LinkName[1],high(linkname));
  889. if i>0 then
  890. begin
  891. linkname[0]:=chr(i);
  892. ReadLink:=LinkName;
  893. end
  894. else
  895. ReadLink:='';
  896. end;
  897. Function UnLink(Path:pathstr):boolean;
  898. {
  899. Removes the file in 'Path' (that is, it decreases the link count with one.
  900. if the link count is zero, the file is removed from the disk.
  901. }
  902. begin
  903. path:=path+#0;
  904. Unlink:=Sys_unlink(pchar(@(path[1])))=0;
  905. linuxerror:=errno;
  906. end;
  907. Function UnLink(Path:pchar):Boolean;
  908. {
  909. Removes the file in 'Path' (that is, it decreases the link count with one.
  910. if the link count is zero, the file is removed from the disk.
  911. }
  912. begin
  913. Unlink:=(Sys_unlink(path)=0);
  914. linuxerror:=errno;
  915. end;
  916. Function FRename (OldName,NewName : Pchar) : Boolean;
  917. begin
  918. FRename:=Sys_rename(OldName,NewName)=0;
  919. LinuxError:=Errno;
  920. end;
  921. Function FRename (OldName,NewName : String) : Boolean;
  922. begin
  923. OldName:=OldName+#0;
  924. NewName:=NewName+#0;
  925. FRename:=FRename (@OldName[1],@NewName[1]);
  926. end;
  927. Function Dup(var oldfile,newfile:text):Boolean;
  928. {
  929. Copies the filedescriptor oldfile to newfile, after flushing the buffer of
  930. oldfile.
  931. After which the two textfiles are, in effect, the same, except
  932. that they don't share the same buffer, and don't share the same
  933. close_on_exit flag.
  934. }
  935. begin
  936. flush(oldfile);{ We cannot share buffers, so we flush them. }
  937. textrec(newfile):=textrec(oldfile);
  938. textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
  939. Dup:=Dup(textrec(oldfile).handle,textrec(newfile).handle);
  940. end;
  941. Function Dup(var oldfile,newfile:file):Boolean;
  942. {
  943. Copies the filedescriptor oldfile to newfile
  944. }
  945. begin
  946. filerec(newfile):=filerec(oldfile);
  947. Dup:=Dup(filerec(oldfile).handle,filerec(newfile).handle);
  948. end;
  949. Function Dup2(var oldfile,newfile:text):Boolean;
  950. {
  951. Copies the filedescriptor oldfile to newfile, after flushing the buffer of
  952. oldfile. It closes newfile if it was still open.
  953. After which the two textfiles are, in effect, the same, except
  954. that they don't share the same buffer, and don't share the same
  955. close_on_exit flag.
  956. }
  957. var
  958. tmphandle : word;
  959. begin
  960. case TextRec(oldfile).mode of
  961. fmOutput, fmInOut, fmAppend :
  962. flush(oldfile);{ We cannot share buffers, so we flush them. }
  963. end;
  964. case TextRec(newfile).mode of
  965. fmOutput, fmInOut, fmAppend :
  966. flush(newfile);
  967. end;
  968. tmphandle:=textrec(newfile).handle;
  969. textrec(newfile):=textrec(oldfile);
  970. textrec(newfile).handle:=tmphandle;
  971. textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
  972. Dup2:=Dup2(textrec(oldfile).handle,textrec(newfile).handle);
  973. end;
  974. Function Dup2(var oldfile,newfile:file):Boolean;
  975. {
  976. Copies the filedescriptor oldfile to newfile
  977. }
  978. begin
  979. filerec(newfile):=filerec(oldfile);
  980. Dup2:=Dup2(filerec(oldfile).handle,filerec(newfile).handle);
  981. end;
  982. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
  983. {
  984. Select checks whether the file descriptor sets in readfs/writefs/exceptfs
  985. have changed.
  986. This function allows specification of a timeout as a longint.
  987. }
  988. var
  989. p : PTimeVal;
  990. tv : TimeVal;
  991. begin
  992. if TimeOut=-1 then
  993. p:=nil
  994. else
  995. begin
  996. tv.Sec:=Timeout div 1000;
  997. tv.Usec:=(Timeout mod 1000)*1000;
  998. p:=@tv;
  999. end;
  1000. Select:=Select(N,Readfds,WriteFds,ExceptFds,p);
  1001. end;
  1002. Function SelectText(var T:Text;TimeOut :PTimeval):Longint;
  1003. Var
  1004. F:FDSet;
  1005. begin
  1006. if textrec(t).mode=fmclosed then
  1007. begin
  1008. LinuxError:=Sys_EBADF;
  1009. exit(-1);
  1010. end;
  1011. FD_Zero(f);
  1012. FD_Set(textrec(T).handle,f);
  1013. if textrec(T).mode=fminput then
  1014. SelectText:=select(textrec(T).handle+1,@f,nil,nil,TimeOut)
  1015. else
  1016. SelectText:=select(textrec(T).handle+1,nil,@f,nil,TimeOut);
  1017. end;
  1018. {******************************************************************************
  1019. Directory
  1020. ******************************************************************************}
  1021. Function OpenDir(F:String):PDir;
  1022. begin
  1023. F:=F+#0;
  1024. OpenDir:=OpenDir(@F[1]);
  1025. end;
  1026. procedure SeekDir(p:pdir;off:longint);
  1027. begin
  1028. if p=nil then
  1029. begin
  1030. errno:=Sys_EBADF;
  1031. exit;
  1032. end;
  1033. {$ifndef bsd}
  1034. p^.nextoff:=Sys_lseek(p^.fd,off,seek_set);
  1035. {$endif}
  1036. p^.size:=0;
  1037. p^.loc:=0;
  1038. end;
  1039. function TellDir(p:pdir):longint;
  1040. begin
  1041. if p=nil then
  1042. begin
  1043. errno:=Sys_EBADF;
  1044. telldir:=-1;
  1045. exit;
  1046. end;
  1047. telldir:=Sys_lseek(p^.fd,0,seek_cur)
  1048. { We could try to use the nextoff field here, but on my 1.2.13
  1049. kernel, this gives nothing... This may have to do with
  1050. the readdir implementation of libc... I also didn't find any trace of
  1051. the field in the kernel code itself, So I suspect it is an artifact of libc.
  1052. Michael. }
  1053. end;
  1054. Function ReadDir(P:pdir):pdirent;
  1055. begin
  1056. ReadDir:=Sys_ReadDir(p);
  1057. LinuxError:=Errno;
  1058. end;
  1059. {******************************************************************************
  1060. Pipes/Fifo
  1061. ******************************************************************************}
  1062. Procedure OpenPipe(var F:Text);
  1063. begin
  1064. case textrec(f).mode of
  1065. fmoutput :
  1066. if textrec(f).userdata[1]<>P_OUT then
  1067. textrec(f).mode:=fmclosed;
  1068. fminput :
  1069. if textrec(f).userdata[1]<>P_IN then
  1070. textrec(f).mode:=fmclosed;
  1071. else
  1072. textrec(f).mode:=fmclosed;
  1073. end;
  1074. end;
  1075. Procedure IOPipe(var F:text);
  1076. begin
  1077. case textrec(f).mode of
  1078. fmoutput :
  1079. begin
  1080. { first check if we need something to write, else we may
  1081. get a SigPipe when Close() is called (PFV) }
  1082. if textrec(f).bufpos>0 then
  1083. Sys_write(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufpos);
  1084. end;
  1085. fminput :
  1086. textrec(f).bufend:=Sys_read(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufsize);
  1087. end;
  1088. textrec(f).bufpos:=0;
  1089. end;
  1090. Procedure FlushPipe(var F:Text);
  1091. begin
  1092. if (textrec(f).mode=fmoutput) and (textrec(f).bufpos<>0) then
  1093. IOPipe(f);
  1094. textrec(f).bufpos:=0;
  1095. end;
  1096. Procedure ClosePipe(var F:text);
  1097. begin
  1098. textrec(f).mode:=fmclosed;
  1099. Sys_close(textrec(f).handle);
  1100. end;
  1101. Function AssignPipe(var pipe_in,pipe_out:text):boolean;
  1102. {
  1103. Sets up a pair of file variables, which act as a pipe. The first one can
  1104. be read from, the second one can be written to.
  1105. If the operation was unsuccesful, linuxerror is set.
  1106. }
  1107. var
  1108. f_in,f_out : longint;
  1109. begin
  1110. if not AssignPipe(f_in,f_out) then
  1111. begin
  1112. AssignPipe:=false;
  1113. exit;
  1114. end;
  1115. { Set up input }
  1116. Assign(Pipe_in,'');
  1117. Textrec(Pipe_in).Handle:=f_in;
  1118. Textrec(Pipe_in).Mode:=fmInput;
  1119. Textrec(Pipe_in).userdata[1]:=P_IN;
  1120. TextRec(Pipe_in).OpenFunc:=@OpenPipe;
  1121. TextRec(Pipe_in).InOutFunc:=@IOPipe;
  1122. TextRec(Pipe_in).FlushFunc:=@FlushPipe;
  1123. TextRec(Pipe_in).CloseFunc:=@ClosePipe;
  1124. { Set up output }
  1125. Assign(Pipe_out,'');
  1126. Textrec(Pipe_out).Handle:=f_out;
  1127. Textrec(Pipe_out).Mode:=fmOutput;
  1128. Textrec(Pipe_out).userdata[1]:=P_OUT;
  1129. TextRec(Pipe_out).OpenFunc:=@OpenPipe;
  1130. TextRec(Pipe_out).InOutFunc:=@IOPipe;
  1131. TextRec(Pipe_out).FlushFunc:=@FlushPipe;
  1132. TextRec(Pipe_out).CloseFunc:=@ClosePipe;
  1133. AssignPipe:=true;
  1134. end;
  1135. Function AssignPipe(var pipe_in,pipe_out:file):boolean;
  1136. {
  1137. Sets up a pair of file variables, which act as a pipe. The first one can
  1138. be read from, the second one can be written to.
  1139. If the operation was unsuccesful, linuxerror is set.
  1140. }
  1141. var
  1142. f_in,f_out : longint;
  1143. begin
  1144. if not AssignPipe(f_in,f_out) then
  1145. begin
  1146. AssignPipe:=false;
  1147. exit;
  1148. end;
  1149. { Set up input }
  1150. Assign(Pipe_in,'');
  1151. Filerec(Pipe_in).Handle:=f_in;
  1152. Filerec(Pipe_in).Mode:=fmInput;
  1153. Filerec(Pipe_in).recsize:=1;
  1154. Filerec(Pipe_in).userdata[1]:=P_IN;
  1155. { Set up output }
  1156. Assign(Pipe_out,'');
  1157. Filerec(Pipe_out).Handle:=f_out;
  1158. Filerec(Pipe_out).Mode:=fmoutput;
  1159. Filerec(Pipe_out).recsize:=1;
  1160. Filerec(Pipe_out).userdata[1]:=P_OUT;
  1161. AssignPipe:=true;
  1162. end;
  1163. Procedure PCloseText(Var F:text);
  1164. {
  1165. May not use @PClose due overloading
  1166. }
  1167. begin
  1168. PClose(f);
  1169. end;
  1170. Procedure POpen(var F:text;const Prog:String;rw:char);
  1171. {
  1172. Starts the program in 'Prog' and makes it's input or out put the
  1173. other end of a pipe. If rw is 'w' or 'W', then whatever is written to
  1174. F, will be read from stdin by the program in 'Prog'. The inverse is true
  1175. for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
  1176. read from 'f'.
  1177. }
  1178. var
  1179. pipi,
  1180. pipo : text;
  1181. pid : longint;
  1182. pl : ^longint;
  1183. pp : ppchar;
  1184. begin
  1185. LinuxError:=0;
  1186. rw:=upcase(rw);
  1187. if not (rw in ['R','W']) then
  1188. begin
  1189. LinuxError:=Sys_enoent;
  1190. exit;
  1191. end;
  1192. AssignPipe(pipi,pipo);
  1193. if Linuxerror<>0 then
  1194. exit;
  1195. pid:=fork;
  1196. if linuxerror<>0 then
  1197. begin
  1198. close(pipi);
  1199. close(pipo);
  1200. exit;
  1201. end;
  1202. if pid=0 then
  1203. begin
  1204. { We're in the child }
  1205. if rw='W' then
  1206. begin
  1207. close(pipo);
  1208. dup2(pipi,input);
  1209. close(pipi);
  1210. if linuxerror<>0 then
  1211. halt(127);
  1212. end
  1213. else
  1214. begin
  1215. close(pipi);
  1216. dup2(pipo,output);
  1217. close(pipo);
  1218. if linuxerror<>0 then
  1219. halt(127);
  1220. end;
  1221. pp:=createshellargv(prog);
  1222. Execve(pp^,pp,envp);
  1223. halt(127);
  1224. end
  1225. else
  1226. begin
  1227. { We're in the parent }
  1228. if rw='W' then
  1229. begin
  1230. close(pipi);
  1231. f:=pipo;
  1232. textrec(f).bufptr:=@textrec(f).buffer;
  1233. end
  1234. else
  1235. begin
  1236. close(pipo);
  1237. f:=pipi;
  1238. textrec(f).bufptr:=@textrec(f).buffer;
  1239. end;
  1240. {Save the process ID - needed when closing }
  1241. pl:=@(textrec(f).userdata[2]);
  1242. pl^:=pid;
  1243. textrec(f).closefunc:=@PCloseText;
  1244. end;
  1245. end;
  1246. Procedure POpen(var F:file;const Prog:String;rw:char);
  1247. {
  1248. Starts the program in 'Prog' and makes it's input or out put the
  1249. other end of a pipe. If rw is 'w' or 'W', then whatever is written to
  1250. F, will be read from stdin by the program in 'Prog'. The inverse is true
  1251. for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
  1252. read from 'f'.
  1253. }
  1254. var
  1255. pipi,
  1256. pipo : file;
  1257. pid : longint;
  1258. pl : ^longint;
  1259. p,pp : ppchar;
  1260. temp : string[255];
  1261. begin
  1262. LinuxError:=0;
  1263. rw:=upcase(rw);
  1264. if not (rw in ['R','W']) then
  1265. begin
  1266. LinuxError:=Sys_enoent;
  1267. exit;
  1268. end;
  1269. AssignPipe(pipi,pipo);
  1270. if Linuxerror<>0 then
  1271. exit;
  1272. pid:=fork;
  1273. if linuxerror<>0 then
  1274. begin
  1275. close(pipi);
  1276. close(pipo);
  1277. exit;
  1278. end;
  1279. if pid=0 then
  1280. begin
  1281. { We're in the child }
  1282. if rw='W' then
  1283. begin
  1284. close(pipo);
  1285. dup2(filerec(pipi).handle,stdinputhandle);
  1286. close(pipi);
  1287. if linuxerror<>0 then
  1288. halt(127);
  1289. end
  1290. else
  1291. begin
  1292. close(pipi);
  1293. dup2(filerec(pipo).handle,stdoutputhandle);
  1294. close(pipo);
  1295. if linuxerror<>0 then
  1296. halt(127);
  1297. end;
  1298. getmem(pp,sizeof(pchar)*4);
  1299. temp:='/bin/sh'#0'-c'#0+prog+#0;
  1300. p:=pp;
  1301. p^:=@temp[1];
  1302. inc(p);
  1303. p^:=@temp[9];
  1304. inc(p);
  1305. p^:=@temp[12];
  1306. inc(p);
  1307. p^:=Nil;
  1308. Execve('/bin/sh',pp,envp);
  1309. halt(127);
  1310. end
  1311. else
  1312. begin
  1313. { We're in the parent }
  1314. if rw='W' then
  1315. begin
  1316. close(pipi);
  1317. f:=pipo;
  1318. end
  1319. else
  1320. begin
  1321. close(pipo);
  1322. f:=pipi;
  1323. end;
  1324. {Save the process ID - needed when closing }
  1325. pl:=@(filerec(f).userdata[2]);
  1326. pl^:=pid;
  1327. end;
  1328. end;
  1329. Function AssignStream(Var StreamIn,Streamout:text;Const Prog:String) : longint;
  1330. {
  1331. Starts the program in 'Prog' and makes its input and output the
  1332. other end of two pipes, which are the stdin and stdout of a program
  1333. specified in 'Prog'.
  1334. streamout can be used to write to the program, streamin can be used to read
  1335. the output of the program. See the following diagram :
  1336. Parent Child
  1337. STreamout --> Input
  1338. Streamin <-- Output
  1339. Return value is the process ID of the process being spawned, or -1 in case of failure.
  1340. }
  1341. var
  1342. pipi,
  1343. pipo : text;
  1344. pid : longint;
  1345. pl : ^Longint;
  1346. begin
  1347. LinuxError:=0;
  1348. AssignStream:=-1;
  1349. AssignPipe(streamin,pipo);
  1350. if Linuxerror<>0 then
  1351. exit;
  1352. AssignPipe(pipi,streamout);
  1353. if Linuxerror<>0 then
  1354. exit;
  1355. pid:=fork;
  1356. if linuxerror<>0 then
  1357. begin
  1358. close(pipi);
  1359. close(pipo);
  1360. close (streamin);
  1361. close (streamout);
  1362. exit;
  1363. end;
  1364. if pid=0 then
  1365. begin
  1366. { We're in the child }
  1367. { Close what we don't need }
  1368. close(streamout);
  1369. close(streamin);
  1370. dup2(pipi,input);
  1371. if linuxerror<>0 then
  1372. halt(127);
  1373. close(pipi);
  1374. dup2(pipo,output);
  1375. if linuxerror<>0 then
  1376. halt (127);
  1377. close(pipo);
  1378. Execl(Prog);
  1379. halt(127);
  1380. end
  1381. else
  1382. begin
  1383. { we're in the parent}
  1384. close(pipo);
  1385. close(pipi);
  1386. {Save the process ID - needed when closing }
  1387. pl:=@(textrec(StreamIn).userdata[2]);
  1388. pl^:=pid;
  1389. textrec(StreamIn).closefunc:=@PCloseText;
  1390. {Save the process ID - needed when closing }
  1391. pl:=@(textrec(StreamOut).userdata[2]);
  1392. pl^:=pid;
  1393. textrec(StreamOut).closefunc:=@PCloseText;
  1394. AssignStream:=Pid;
  1395. end;
  1396. end;
  1397. function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: String): LongInt;
  1398. {
  1399. Starts the program in 'prog' and makes its input, output and error output the
  1400. other end of three pipes, which are the stdin, stdout and stderr of a program
  1401. specified in 'prog'.
  1402. StreamOut can be used to write to the program, StreamIn can be used to read
  1403. the output of the program, StreamErr reads the error output of the program.
  1404. See the following diagram :
  1405. Parent Child
  1406. StreamOut --> StdIn (input)
  1407. StreamIn <-- StdOut (output)
  1408. StreamErr <-- StdErr (error output)
  1409. }
  1410. var
  1411. PipeIn, PipeOut, PipeErr: text;
  1412. pid: LongInt;
  1413. pl: ^LongInt;
  1414. begin
  1415. LinuxError := 0;
  1416. AssignStream := -1;
  1417. // Assign pipes
  1418. AssignPipe(StreamIn, PipeOut);
  1419. if LinuxError <> 0 then exit;
  1420. AssignPipe(StreamErr, PipeErr);
  1421. if LinuxError <> 0 then begin
  1422. Close(StreamIn);
  1423. Close(PipeOut);
  1424. exit;
  1425. end;
  1426. AssignPipe(PipeIn, StreamOut);
  1427. if LinuxError <> 0 then begin
  1428. Close(StreamIn);
  1429. Close(PipeOut);
  1430. Close(StreamErr);
  1431. Close(PipeErr);
  1432. exit;
  1433. end;
  1434. // Fork
  1435. pid := Fork;
  1436. if LinuxError <> 0 then begin
  1437. Close(StreamIn);
  1438. Close(PipeOut);
  1439. Close(StreamErr);
  1440. Close(PipeErr);
  1441. Close(PipeIn);
  1442. Close(StreamOut);
  1443. exit;
  1444. end;
  1445. if pid = 0 then begin
  1446. // *** We are in the child ***
  1447. // Close what we don not need
  1448. Close(StreamOut);
  1449. Close(StreamIn);
  1450. Close(StreamErr);
  1451. // Connect pipes
  1452. dup2(PipeIn, Input);
  1453. if LinuxError <> 0 then Halt(127);
  1454. Close(PipeIn);
  1455. dup2(PipeOut, Output);
  1456. if LinuxError <> 0 then Halt(127);
  1457. Close(PipeOut);
  1458. dup2(PipeErr, StdErr);
  1459. if LinuxError <> 0 then Halt(127);
  1460. Close(PipeErr);
  1461. // Execute program
  1462. Execl(Prog);
  1463. Halt(127);
  1464. end else begin
  1465. // *** We are in the parent ***
  1466. Close(PipeErr);
  1467. Close(PipeOut);
  1468. Close(PipeIn);
  1469. // Save the process ID - needed when closing
  1470. pl := @(TextRec(StreamIn).userdata[2]);
  1471. pl^ := pid;
  1472. TextRec(StreamIn).closefunc := @PCloseText;
  1473. // Save the process ID - needed when closing
  1474. pl := @(TextRec(StreamOut).userdata[2]);
  1475. pl^ := pid;
  1476. TextRec(StreamOut).closefunc := @PCloseText;
  1477. // Save the process ID - needed when closing
  1478. pl := @(TextRec(StreamErr).userdata[2]);
  1479. pl^ := pid;
  1480. TextRec(StreamErr).closefunc := @PCloseText;
  1481. AssignStream := pid;
  1482. end;
  1483. end;
  1484. {******************************************************************************
  1485. General information calls
  1486. ******************************************************************************}
  1487. Function GetEnv(P:string):Pchar;
  1488. {
  1489. Searches the environment for a string with name p and
  1490. returns a pchar to it's value.
  1491. A pchar is used to accomodate for strings of length > 255
  1492. }
  1493. var
  1494. ep : ppchar;
  1495. found : boolean;
  1496. Begin
  1497. p:=p+'='; {Else HOST will also find HOSTNAME, etc}
  1498. ep:=envp;
  1499. found:=false;
  1500. if ep<>nil then
  1501. begin
  1502. while (not found) and (ep^<>nil) do
  1503. begin
  1504. if strlcomp(@p[1],(ep^),length(p))=0 then
  1505. found:=true
  1506. else
  1507. inc(ep);
  1508. end;
  1509. end;
  1510. if found then
  1511. getenv:=ep^+length(p)
  1512. else
  1513. getenv:=nil;
  1514. end;
  1515. {$ifndef bsd}
  1516. Function GetDomainName:String;
  1517. {
  1518. Get machines domain name. Returns empty string if not set.
  1519. }
  1520. Var
  1521. Sysn : utsname;
  1522. begin
  1523. Uname(Sysn);
  1524. linuxerror:=errno;
  1525. If linuxerror<>0 then
  1526. getdomainname:=''
  1527. else
  1528. getdomainname:=strpas(@Sysn.domainname[0]);
  1529. end;
  1530. Function GetHostName:String;
  1531. {
  1532. Get machines name. Returns empty string if not set.
  1533. }
  1534. Var
  1535. Sysn : utsname;
  1536. begin
  1537. uname(Sysn);
  1538. linuxerror:=errno;
  1539. If linuxerror<>0 then
  1540. gethostname:=''
  1541. else
  1542. gethostname:=strpas(@Sysn.nodename[0]);
  1543. end;
  1544. {$endif}
  1545. {******************************************************************************
  1546. Signal handling calls
  1547. ******************************************************************************}
  1548. procedure SigRaise(sig:integer);
  1549. begin
  1550. Kill(GetPid,Sig);
  1551. end;
  1552. {******************************************************************************
  1553. IOCtl and Termios calls
  1554. ******************************************************************************}
  1555. Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
  1556. begin
  1557. {$ifndef BSD}
  1558. TCGetAttr:=IOCtl(fd,TCGETS,@tios);
  1559. {$else}
  1560. TCGETAttr:=IoCtl(Fd,TIOCGETA,@tios);
  1561. {$endif}
  1562. end;
  1563. Function TCSetAttr(fd:longint;OptAct:longint;var tios:TermIOS):boolean;
  1564. var
  1565. nr:longint;
  1566. begin
  1567. {$ifndef BSD}
  1568. case OptAct of
  1569. TCSANOW : nr:=TCSETS;
  1570. TCSADRAIN : nr:=TCSETSW;
  1571. TCSAFLUSH : nr:=TCSETSF;
  1572. {$else}
  1573. case OptAct of
  1574. TCSANOW : nr:=TIOCSETA;
  1575. TCSADRAIN : nr:=TIOCSETAW;
  1576. TCSAFLUSH : nr:=TIOCSETAF;
  1577. {$endif}
  1578. else
  1579. begin
  1580. ErrNo:=Sys_EINVAL;
  1581. TCSetAttr:=false;
  1582. exit;
  1583. end;
  1584. end;
  1585. TCSetAttr:=IOCtl(fd,nr,@Tios);
  1586. end;
  1587. Procedure CFSetISpeed(var tios:TermIOS;speed:Longint);
  1588. begin
  1589. {$ifndef BSD}
  1590. tios.c_cflag:=(tios.c_cflag and (not CBAUD)) or speed;
  1591. {$else}
  1592. tios.c_ispeed:=speed; {Probably the Bxxxx speed constants}
  1593. {$endif}
  1594. end;
  1595. Procedure CFSetOSpeed(var tios:TermIOS;speed:Longint);
  1596. begin
  1597. {$ifndef BSD}
  1598. CFSetISpeed(tios,speed);
  1599. {$else}
  1600. tios.c_ospeed:=speed;
  1601. {$endif}
  1602. end;
  1603. Procedure CFMakeRaw(var tios:TermIOS);
  1604. begin
  1605. {$ifndef BSD}
  1606. with tios do
  1607. begin
  1608. c_iflag:=c_iflag and (not (IGNBRK or BRKINT or PARMRK or ISTRIP or
  1609. INLCR or IGNCR or ICRNL or IXON));
  1610. c_oflag:=c_oflag and (not OPOST);
  1611. c_lflag:=c_lflag and (not (ECHO or ECHONL or ICANON or ISIG or IEXTEN));
  1612. c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or CS8;
  1613. end;
  1614. {$else}
  1615. with tios do
  1616. begin
  1617. c_iflag:=c_iflag and (not (IMAXBEL or IXOFF or INPCK or BRKINT or
  1618. PARMRK or ISTRIP or INLCR or IGNCR or ICRNL or IXON or
  1619. IGNPAR));
  1620. c_iflag:=c_iflag OR IGNBRK;
  1621. c_oflag:=c_oflag and (not OPOST);
  1622. c_lflag:=c_lflag and (not (ECHO or ECHOE or ECHOK or ECHONL or ICANON or
  1623. ISIG or IEXTEN or NOFLSH or TOSTOP or PENDIN));
  1624. c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or (CS8 OR cread);
  1625. c_cc[VMIN]:=1;
  1626. c_cc[VTIME]:=0;
  1627. end;
  1628. {$endif}
  1629. end;
  1630. Function TCSendBreak(fd,duration:longint):boolean;
  1631. begin
  1632. {$ifndef BSD}
  1633. TCSendBreak:=IOCtl(fd,TCSBRK,pointer(duration));
  1634. {$else}
  1635. TCSendBreak:=IOCtl(fd,TIOCSBRK,0);
  1636. {$endif}
  1637. end;
  1638. Function TCSetPGrp(fd,id:longint):boolean;
  1639. begin
  1640. TCSetPGrp:=IOCtl(fd,TIOCSPGRP,pointer(id));
  1641. end;
  1642. Function TCGetPGrp(fd:longint;var id:longint):boolean;
  1643. begin
  1644. TCGetPGrp:=IOCtl(fd,TIOCGPGRP,@id);
  1645. end;
  1646. Function TCDrain(fd:longint):boolean;
  1647. begin
  1648. {$ifndef BSD}
  1649. TCDrain:=IOCtl(fd,TCSBRK,pointer(1));
  1650. {$else}
  1651. TCDrain:=IOCtl(fd,TIOCDRAIN,0); {Should set timeout to 1 first?}
  1652. {$endif}
  1653. end;
  1654. Function TCFlow(fd,act:longint):boolean;
  1655. begin
  1656. {$ifndef BSD}
  1657. TCFlow:=IOCtl(fd,TCXONC,pointer(act));
  1658. {$else}
  1659. case act OF
  1660. TCOOFF : TCFlow:=Ioctl(fd,TIOCSTOP,0);
  1661. TCOOn : TCFlow:=IOctl(Fd,TIOCStart,0);
  1662. TCIOFF : {N/I}
  1663. end;
  1664. {$endif}
  1665. end;
  1666. Function TCFlush(fd,qsel:longint):boolean;
  1667. var com:longint;
  1668. begin
  1669. {$ifndef BSD}
  1670. TCFlush:=IOCtl(fd,TCFLSH,pointer(qsel));
  1671. {$else}
  1672. {
  1673. CASE Qsel of
  1674. TCIFLUSH : com:=fread;
  1675. TCOFLUSH : com:=FWRITE;
  1676. TCIOFLUSH: com:=FREAD OR FWRITE;
  1677. else
  1678. exit(false);
  1679. end;
  1680. }
  1681. TCFlush:=IOCtl(fd,TIOCFLUSH,pointer(qsel));
  1682. {$endif}
  1683. end;
  1684. Function IsATTY(Handle:Longint):Boolean;
  1685. {
  1686. Check if the filehandle described by 'handle' is a TTY (Terminal)
  1687. }
  1688. var
  1689. t : Termios;
  1690. begin
  1691. IsAtty:=TCGetAttr(Handle,t);
  1692. end;
  1693. Function IsATTY(f: text):Boolean;
  1694. {
  1695. Idem as previous, only now for text variables.
  1696. }
  1697. begin
  1698. IsATTY:=IsaTTY(textrec(f).handle);
  1699. end;
  1700. function TTYName(Handle:Longint):string;
  1701. {
  1702. Return the name of the current tty described by handle f.
  1703. returns empty string in case of an error.
  1704. }
  1705. var
  1706. mydev,
  1707. myino : longint;
  1708. st : stat;
  1709. function mysearch(n:string): boolean;
  1710. {searches recursively for the device in the directory given by n,
  1711. returns true if found and sets the name of the device in ttyname}
  1712. var dirstream : pdir;
  1713. d : pdirent;
  1714. name : string;
  1715. st : stat;
  1716. begin
  1717. dirstream:=opendir(n);
  1718. if (linuxerror<>0) then
  1719. exit;
  1720. d:=Readdir(dirstream);
  1721. while (d<>nil) do
  1722. begin
  1723. name:=n+'/'+strpas(@(d^.name));
  1724. fstat(name,st);
  1725. if linuxerror=0 then
  1726. begin
  1727. if ((st.mode and $E000)=$4000) and { if it is a directory }
  1728. (strpas(@(d^.name))<>'.') and { but not ., .. and fd subdirs }
  1729. (strpas(@(d^.name))<>'..') and
  1730. (strpas(@(d^.name))<>'fd') then
  1731. begin {we found a directory, search inside it}
  1732. if mysearch(name) then
  1733. begin {the device is here}
  1734. closedir(dirstream); {then don't continue searching}
  1735. mysearch:=true;
  1736. exit;
  1737. end;
  1738. end
  1739. else if (d^.ino=myino) and (st.dev=mydev) then
  1740. begin
  1741. closedir(dirstream);
  1742. ttyname:=name;
  1743. mysearch:=true;
  1744. exit;
  1745. end;
  1746. end;
  1747. d:=Readdir(dirstream);
  1748. end;
  1749. closedir(dirstream);
  1750. mysearch:=false;
  1751. end;
  1752. begin
  1753. TTYName:='';
  1754. fstat(handle,st);
  1755. if (errno<>0) and isatty (handle) then
  1756. exit;
  1757. mydev:=st.dev;
  1758. myino:=st.ino;
  1759. mysearch('/dev');
  1760. end;
  1761. function TTYName(var F:Text):string;
  1762. {
  1763. Idem as previous, only now for text variables;
  1764. }
  1765. begin
  1766. TTYName:=TTYName(textrec(f).handle);
  1767. end;
  1768. {******************************************************************************
  1769. Utility calls
  1770. ******************************************************************************}
  1771. Function Octal(l:longint):longint;
  1772. {
  1773. Convert an octal specified number to decimal;
  1774. }
  1775. var
  1776. octnr,
  1777. oct : longint;
  1778. begin
  1779. octnr:=0;
  1780. oct:=0;
  1781. while (l>0) do
  1782. begin
  1783. oct:=oct or ((l mod 10) shl octnr);
  1784. l:=l div 10;
  1785. inc(octnr,3);
  1786. end;
  1787. Octal:=oct;
  1788. end;
  1789. Function StringToPPChar(Var S:STring):ppchar;
  1790. {
  1791. Create a PPChar to structure of pchars which are the arguments specified
  1792. in the string S. Especially usefull for creating an ArgV for Exec-calls
  1793. }
  1794. var
  1795. nr : longint;
  1796. Buf : ^char;
  1797. p : ppchar;
  1798. begin
  1799. s:=s+#0;
  1800. buf:=@s[1];
  1801. nr:=0;
  1802. while(buf^<>#0) do
  1803. begin
  1804. while (buf^ in [' ',#8,#10]) do
  1805. inc(buf);
  1806. inc(nr);
  1807. while not (buf^ in [' ',#0,#8,#10]) do
  1808. inc(buf);
  1809. end;
  1810. getmem(p,nr*4);
  1811. StringToPPChar:=p;
  1812. if p=nil then
  1813. begin
  1814. LinuxError:=sys_enomem;
  1815. exit;
  1816. end;
  1817. buf:=@s[1];
  1818. while (buf^<>#0) do
  1819. begin
  1820. while (buf^ in [' ',#8,#10]) do
  1821. begin
  1822. buf^:=#0;
  1823. inc(buf);
  1824. end;
  1825. p^:=buf;
  1826. inc(p);
  1827. p^:=nil;
  1828. while not (buf^ in [' ',#0,#8,#10]) do
  1829. inc(buf);
  1830. end;
  1831. end;
  1832. (*
  1833. function FExpand (const Path: PathStr): PathStr;
  1834. - declared in fexpand.inc
  1835. *)
  1836. {$DEFINE FPC_FEXPAND_TILDE} (* Tilde is expanded to home *)
  1837. {$DEFINE FPC_FEXPAND_GETENVPCHAR} (* GetEnv result is a PChar *)
  1838. const
  1839. LFNSupport = true;
  1840. FileNameCaseSensitive = true;
  1841. {$I fexpand.inc}
  1842. {$UNDEF FPC_FEXPAND_GETENVPCHAR}
  1843. {$UNDEF FPC_FEXPAND_TILDE}
  1844. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  1845. {
  1846. Searches for a file 'path' in the list of direcories in 'dirlist'.
  1847. returns an empty string if not found. Wildcards are NOT allowed.
  1848. If dirlist is empty, it is set to '.'
  1849. }
  1850. Var
  1851. NewDir : PathStr;
  1852. p1 : Longint;
  1853. Info : Stat;
  1854. Begin
  1855. {Replace ':' with ';'}
  1856. for p1:=1to length(dirlist) do
  1857. if dirlist[p1]=':' then
  1858. dirlist[p1]:=';';
  1859. {Check for WildCards}
  1860. If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
  1861. FSearch:='' {No wildcards allowed in these things.}
  1862. Else
  1863. Begin
  1864. Dirlist:='.;'+dirlist;{Make sure current dir is first to be searched.}
  1865. Repeat
  1866. p1:=Pos(';',DirList);
  1867. If p1=0 Then
  1868. p1:=255;
  1869. NewDir:=Copy(DirList,1,P1 - 1);
  1870. if NewDir[Length(NewDir)]<>'/' then
  1871. NewDir:=NewDir+'/';
  1872. NewDir:=NewDir+Path;
  1873. Delete(DirList,1,p1);
  1874. if FStat(NewDir,Info) then
  1875. Begin
  1876. If Pos('./',NewDir)=1 Then
  1877. Delete(NewDir,1,2);
  1878. {DOS strips off an initial .\}
  1879. End
  1880. Else
  1881. NewDir:='';
  1882. Until (DirList='') or (Length(NewDir) > 0);
  1883. FSearch:=NewDir;
  1884. End;
  1885. End;
  1886. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  1887. Var
  1888. DotPos,SlashPos,i : longint;
  1889. Begin
  1890. SlashPos:=0;
  1891. DotPos:=256;
  1892. i:=Length(Path);
  1893. While (i>0) and (SlashPos=0) Do
  1894. Begin
  1895. If (DotPos=256) and (Path[i]='.') Then
  1896. begin
  1897. DotPos:=i;
  1898. end;
  1899. If (Path[i]='/') Then
  1900. SlashPos:=i;
  1901. Dec(i);
  1902. End;
  1903. Ext:=Copy(Path,DotPos,255);
  1904. Dir:=Copy(Path,1,SlashPos);
  1905. Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
  1906. End;
  1907. Function Dirname(Const path:pathstr):pathstr;
  1908. {
  1909. This function returns the directory part of a complete path.
  1910. Unless the directory is root '/', The last character is not
  1911. a slash.
  1912. }
  1913. var
  1914. Dir : PathStr;
  1915. Name : NameStr;
  1916. Ext : ExtStr;
  1917. begin
  1918. FSplit(Path,Dir,Name,Ext);
  1919. if length(Dir)>1 then
  1920. Delete(Dir,length(Dir),1);
  1921. DirName:=Dir;
  1922. end;
  1923. Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
  1924. {
  1925. This function returns the filename part of a complete path. If suf is
  1926. supplied, it is cut off the filename.
  1927. }
  1928. var
  1929. Dir : PathStr;
  1930. Name : NameStr;
  1931. Ext : ExtStr;
  1932. begin
  1933. FSplit(Path,Dir,Name,Ext);
  1934. if Suf<>Ext then
  1935. Name:=Name+Ext;
  1936. BaseName:=Name;
  1937. end;
  1938. Function FNMatch(const Pattern,Name:string):Boolean;
  1939. Var
  1940. LenPat,LenName : longint;
  1941. Function DoFNMatch(i,j:longint):Boolean;
  1942. Var
  1943. Found : boolean;
  1944. Begin
  1945. Found:=true;
  1946. While Found and (i<=LenPat) Do
  1947. Begin
  1948. Case Pattern[i] of
  1949. '?' : Found:=(j<=LenName);
  1950. '*' : Begin
  1951. {find the next character in pattern, different of ? and *}
  1952. while Found and (i<LenPat) do
  1953. begin
  1954. inc(i);
  1955. case Pattern[i] of
  1956. '*' : ;
  1957. '?' : begin
  1958. inc(j);
  1959. Found:=(j<=LenName);
  1960. end;
  1961. else
  1962. Found:=false;
  1963. end;
  1964. end;
  1965. {Now, find in name the character which i points to, if the * or ?
  1966. wasn't the last character in the pattern, else, use up all the
  1967. chars in name}
  1968. Found:=true;
  1969. if (i<=LenPat) then
  1970. begin
  1971. repeat
  1972. {find a letter (not only first !) which maches pattern[i]}
  1973. while (j<=LenName) and (name[j]<>pattern[i]) do
  1974. inc (j);
  1975. if (j<LenName) then
  1976. begin
  1977. if DoFnMatch(i+1,j+1) then
  1978. begin
  1979. i:=LenPat;
  1980. j:=LenName;{we can stop}
  1981. Found:=true;
  1982. end
  1983. else
  1984. inc(j);{We didn't find one, need to look further}
  1985. end;
  1986. until (j>=LenName);
  1987. end
  1988. else
  1989. j:=LenName;{we can stop}
  1990. end;
  1991. else {not a wildcard character in pattern}
  1992. Found:=(j<=LenName) and (pattern[i]=name[j]);
  1993. end;
  1994. inc(i);
  1995. inc(j);
  1996. end;
  1997. DoFnMatch:=Found and (j>LenName);
  1998. end;
  1999. Begin {start FNMatch}
  2000. LenPat:=Length(Pattern);
  2001. LenName:=Length(Name);
  2002. FNMatch:=DoFNMatch(1,1);
  2003. End;
  2004. Procedure Globfree(var p : pglob);
  2005. {
  2006. Release memory occupied by pglob structure, and names in it.
  2007. sets p to nil.
  2008. }
  2009. var
  2010. temp : pglob;
  2011. begin
  2012. while assigned(p) do
  2013. begin
  2014. temp:=p^.next;
  2015. if assigned(p^.name) then
  2016. freemem(p^.name);
  2017. dispose(p);
  2018. p:=temp;
  2019. end;
  2020. end;
  2021. Function Glob(Const path:pathstr):pglob;
  2022. {
  2023. Fills a tglob structure with entries matching path,
  2024. and returns a pointer to it. Returns nil on error,
  2025. linuxerror is set accordingly.
  2026. }
  2027. var
  2028. temp,
  2029. temp2 : string[255];
  2030. thedir : pdir;
  2031. buffer : pdirent;
  2032. root,
  2033. current : pglob;
  2034. begin
  2035. { Get directory }
  2036. temp:=dirname(path);
  2037. if temp='' then
  2038. temp:='.';
  2039. temp:=temp+#0;
  2040. thedir:=opendir(@temp[1]);
  2041. if thedir=nil then
  2042. begin
  2043. glob:=nil;
  2044. linuxerror:=errno;
  2045. exit;
  2046. end;
  2047. temp:=basename(path,''); { get the pattern }
  2048. if thedir^.fd<0 then
  2049. begin
  2050. linuxerror:=errno;
  2051. glob:=nil;
  2052. exit;
  2053. end;
  2054. {get the entries}
  2055. root:=nil;
  2056. current:=nil;
  2057. repeat
  2058. buffer:=Sys_readdir(thedir);
  2059. if buffer=nil then
  2060. break;
  2061. temp2:=strpas(@(buffer^.name[0]));
  2062. if fnmatch(temp,temp2) then
  2063. begin
  2064. if root=nil then
  2065. begin
  2066. new(root);
  2067. current:=root;
  2068. end
  2069. else
  2070. begin
  2071. new(current^.next);
  2072. current:=current^.next;
  2073. end;
  2074. if current=nil then
  2075. begin
  2076. linuxerror:=Sys_ENOMEM;
  2077. globfree(root);
  2078. break;
  2079. end;
  2080. current^.next:=nil;
  2081. getmem(current^.name,length(temp2)+1);
  2082. if current^.name=nil then
  2083. begin
  2084. linuxerror:=Sys_ENOMEM;
  2085. globfree(root);
  2086. break;
  2087. end;
  2088. move(buffer^.name[0],current^.name^,length(temp2)+1);
  2089. end;
  2090. until false;
  2091. closedir(thedir);
  2092. glob:=root;
  2093. end;
  2094. {--------------------------------
  2095. FiledescriptorSets
  2096. --------------------------------}
  2097. Procedure FD_Zero(var fds:fdSet);
  2098. {
  2099. Clear the set of filedescriptors
  2100. }
  2101. begin
  2102. FillChar(fds,sizeof(fdSet),0);
  2103. end;
  2104. Procedure FD_Clr(fd:longint;var fds:fdSet);
  2105. {
  2106. Remove fd from the set of filedescriptors
  2107. }
  2108. begin
  2109. fds[fd shr 5]:=fds[fd shr 5] and (not (1 shl (fd and 31)));
  2110. end;
  2111. Procedure FD_Set(fd:longint;var fds:fdSet);
  2112. {
  2113. Add fd to the set of filedescriptors
  2114. }
  2115. begin
  2116. fds[fd shr 5]:=fds[fd shr 5] or (1 shl (fd and 31));
  2117. end;
  2118. Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
  2119. {
  2120. Test if fd is part of the set of filedescriptors
  2121. }
  2122. begin
  2123. FD_IsSet:=((fds[fd shr 5] and (1 shl (fd and 31)))<>0);
  2124. end;
  2125. Function GetFS (var T:Text):longint;
  2126. {
  2127. Get File Descriptor of a text file.
  2128. }
  2129. begin
  2130. if textrec(t).mode=fmclosed then
  2131. exit(-1)
  2132. else
  2133. GETFS:=textrec(t).Handle
  2134. end;
  2135. Function GetFS(Var F:File):longint;
  2136. {
  2137. Get File Descriptor of an unTyped file.
  2138. }
  2139. begin
  2140. { Handle and mode are on the same place in textrec and filerec. }
  2141. if filerec(f).mode=fmclosed then
  2142. exit(-1)
  2143. else
  2144. GETFS:=filerec(f).Handle
  2145. end;
  2146. {--------------------------------
  2147. Stat.Mode Macro's
  2148. --------------------------------}
  2149. Function S_ISLNK(m:word):boolean;
  2150. {
  2151. Check mode field of inode for link.
  2152. }
  2153. begin
  2154. S_ISLNK:=(m and STAT_IFMT)=STAT_IFLNK;
  2155. end;
  2156. Function S_ISREG(m:word):boolean;
  2157. {
  2158. Check mode field of inode for regular file.
  2159. }
  2160. begin
  2161. S_ISREG:=(m and STAT_IFMT)=STAT_IFREG;
  2162. end;
  2163. Function S_ISDIR(m:word):boolean;
  2164. {
  2165. Check mode field of inode for directory.
  2166. }
  2167. begin
  2168. S_ISDIR:=(m and STAT_IFMT)=STAT_IFDIR;
  2169. end;
  2170. Function S_ISCHR(m:word):boolean;
  2171. {
  2172. Check mode field of inode for character device.
  2173. }
  2174. begin
  2175. S_ISCHR:=(m and STAT_IFMT)=STAT_IFCHR;
  2176. end;
  2177. Function S_ISBLK(m:word):boolean;
  2178. {
  2179. Check mode field of inode for block device.
  2180. }
  2181. begin
  2182. S_ISBLK:=(m and STAT_IFMT)=STAT_IFBLK;
  2183. end;
  2184. Function S_ISFIFO(m:word):boolean;
  2185. {
  2186. Check mode field of inode for named pipe (FIFO).
  2187. }
  2188. begin
  2189. S_ISFIFO:=(m and STAT_IFMT)=STAT_IFIFO;
  2190. end;
  2191. Function S_ISSOCK(m:word):boolean;
  2192. {
  2193. Check mode field of inode for socket.
  2194. }
  2195. begin
  2196. S_ISSOCK:=(m and STAT_IFMT)=STAT_IFSOCK;
  2197. end;
  2198. {--------------------------------
  2199. Memory functions
  2200. --------------------------------}
  2201. {$IFDEF I386}
  2202. Procedure WritePort (Port : Longint; Value : Byte);
  2203. {
  2204. Writes 'Value' to port 'Port'
  2205. }
  2206. begin
  2207. asm
  2208. movl port,%edx
  2209. movb value,%al
  2210. outb %al,%dx
  2211. end ['EAX','EDX'];
  2212. end;
  2213. Procedure WritePort (Port : Longint; Value : Word);
  2214. {
  2215. Writes 'Value' to port 'Port'
  2216. }
  2217. begin
  2218. asm
  2219. movl port,%edx
  2220. movw value,%ax
  2221. outw %ax,%dx
  2222. end ['EAX','EDX'];
  2223. end;
  2224. Procedure WritePort (Port : Longint; Value : Longint);
  2225. {
  2226. Writes 'Value' to port 'Port'
  2227. }
  2228. begin
  2229. asm
  2230. movl port,%edx
  2231. movl value,%eax
  2232. outl %eax,%dx
  2233. end ['EAX','EDX'];
  2234. end;
  2235. Procedure WritePortB (Port : Longint; Value : Byte);
  2236. {
  2237. Writes 'Value' to port 'Port'
  2238. }
  2239. begin
  2240. asm
  2241. movl port,%edx
  2242. movb value,%al
  2243. outb %al,%dx
  2244. end ['EAX','EDX'];
  2245. end;
  2246. Procedure WritePortW (Port : Longint; Value : Word);
  2247. {
  2248. Writes 'Value' to port 'Port'
  2249. }
  2250. begin
  2251. asm
  2252. movl port,%edx
  2253. movw value,%ax
  2254. outw %ax,%dx
  2255. end ['EAX','EDX'];
  2256. end;
  2257. Procedure WritePortL (Port : Longint; Value : Longint);
  2258. {
  2259. Writes 'Value' to port 'Port'
  2260. }
  2261. begin
  2262. asm
  2263. movl port,%edx
  2264. movl value,%eax
  2265. outl %eax,%dx
  2266. end ['EAX','EDX'];
  2267. end;
  2268. Procedure WritePortl (Port : Longint; Var Buf; Count: longint);
  2269. {
  2270. Writes 'Count' longints from 'Buf' to Port
  2271. }
  2272. begin
  2273. asm
  2274. movl count,%ecx
  2275. movl buf,%esi
  2276. movl port,%edx
  2277. cld
  2278. rep
  2279. outsl
  2280. end ['ECX','ESI','EDX'];
  2281. end;
  2282. Procedure WritePortW (Port : Longint; Var Buf; Count: longint);
  2283. {
  2284. Writes 'Count' words from 'Buf' to Port
  2285. }
  2286. begin
  2287. asm
  2288. movl count,%ecx
  2289. movl buf,%esi
  2290. movl port,%edx
  2291. cld
  2292. rep
  2293. outsw
  2294. end ['ECX','ESI','EDX'];
  2295. end;
  2296. Procedure WritePortB (Port : Longint; Var Buf; Count: longint);
  2297. {
  2298. Writes 'Count' bytes from 'Buf' to Port
  2299. }
  2300. begin
  2301. asm
  2302. movl count,%ecx
  2303. movl buf,%esi
  2304. movl port,%edx
  2305. cld
  2306. rep
  2307. outsb
  2308. end ['ECX','ESI','EDX'];
  2309. end;
  2310. Procedure ReadPort (Port : Longint; Var Value : Byte);
  2311. {
  2312. Reads 'Value' from port 'Port'
  2313. }
  2314. begin
  2315. asm
  2316. movl port,%edx
  2317. inb %dx,%al
  2318. movl value,%edx
  2319. movb %al,(%edx)
  2320. end ['EAX','EDX'];
  2321. end;
  2322. Procedure ReadPort (Port : Longint; Var Value : Word);
  2323. {
  2324. Reads 'Value' from port 'Port'
  2325. }
  2326. begin
  2327. asm
  2328. movl port,%edx
  2329. inw %dx,%ax
  2330. movl value,%edx
  2331. movw %ax,(%edx)
  2332. end ['EAX','EDX'];
  2333. end;
  2334. Procedure ReadPort (Port : Longint; Var Value : Longint);
  2335. {
  2336. Reads 'Value' from port 'Port'
  2337. }
  2338. begin
  2339. asm
  2340. movl port,%edx
  2341. inl %dx,%eax
  2342. movl value,%edx
  2343. movl %eax,(%edx)
  2344. end ['EAX','EDX'];
  2345. end;
  2346. function ReadPortB (Port : Longint): Byte; assembler;
  2347. {
  2348. Reads a byte from port 'Port'
  2349. }
  2350. asm
  2351. xorl %eax,%eax
  2352. movl port,%edx
  2353. inb %dx,%al
  2354. end ['EAX','EDX'];
  2355. function ReadPortW (Port : Longint): Word; assembler;
  2356. {
  2357. Reads a word from port 'Port'
  2358. }
  2359. asm
  2360. xorl %eax,%eax
  2361. movl port,%edx
  2362. inw %dx,%ax
  2363. end ['EAX','EDX'];
  2364. function ReadPortL (Port : Longint): LongInt; assembler;
  2365. {
  2366. Reads a LongInt from port 'Port'
  2367. }
  2368. asm
  2369. movl port,%edx
  2370. inl %dx,%eax
  2371. end ['EAX','EDX'];
  2372. Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);
  2373. {
  2374. Reads 'Count' longints from port 'Port' to 'Buf'.
  2375. }
  2376. begin
  2377. asm
  2378. movl count,%ecx
  2379. movl buf,%edi
  2380. movl port,%edx
  2381. cld
  2382. rep
  2383. insl
  2384. end ['ECX','EDI','EDX'];
  2385. end;
  2386. Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);
  2387. {
  2388. Reads 'Count' words from port 'Port' to 'Buf'.
  2389. }
  2390. begin
  2391. asm
  2392. movl count,%ecx
  2393. movl buf,%edi
  2394. movl port,%edx
  2395. cld
  2396. rep
  2397. insw
  2398. end ['ECX','EDI','EDX'];
  2399. end;
  2400. Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);
  2401. {
  2402. Reads 'Count' bytes from port 'Port' to 'Buf'.
  2403. }
  2404. begin
  2405. asm
  2406. movl count,%ecx
  2407. movl buf,%edi
  2408. movl port,%edx
  2409. cld
  2410. rep
  2411. insb
  2412. end ['ECX','EDI','EDX'];
  2413. end;
  2414. {$ENDIF}
  2415. Initialization
  2416. InitLocalTime;
  2417. finalization
  2418. DoneLocalTime;
  2419. End.
  2420. {
  2421. $Log$
  2422. Revision 1.5 2001-03-27 11:47:25 michael
  2423. + Fixed F_[G,S]etOwn constants. By Alexander Sychev
  2424. Revision 1.4 2001/03/17 16:04:37 hajny
  2425. * FExpand omission fixed
  2426. Revision 1.3 2001/03/16 20:09:58 hajny
  2427. * universal FExpand
  2428. Revision 1.2 2001/01/22 07:25:10 marco
  2429. * IOPERM for FreeBSD. Port routines moved from linsysca to Unix again .
  2430. Revision 1.1 2001/01/21 20:21:41 marco
  2431. * Rename fest II. Rtl OK
  2432. Revision 1.6 2000/12/28 20:42:12 peter
  2433. * ttyname fix from the mailinglist (merged)
  2434. Revision 1.5 2000/10/26 22:51:12 peter
  2435. * nano sleep (merged)
  2436. Revision 1.4 2000/10/11 13:59:16 marco
  2437. * FreeBSD TermIOS support and minor changes to some related files.
  2438. Revision 1.3 2000/10/10 12:02:35 marco
  2439. * Terminal stuff of Linux moved to separate file. I think it is too
  2440. much to do with ifdefs.
  2441. Revision 1.2 2000/09/18 13:14:50 marco
  2442. * Global Linux +bsd to (rtl/freebsd rtl/unix rtl/linux structure)
  2443. Revision 1.7 2000/09/12 08:51:43 marco
  2444. * fixed some small problems left from merging. (waitpid has now last param longint)
  2445. Revision 1.6 2000/09/11 14:05:31 marco
  2446. * FreeBSD support and removed old signalhandling
  2447. Revision 1.5 2000/09/06 20:47:34 peter
  2448. * removed previous fsplit() patch as it's not the correct behaviour for
  2449. LFNs. The code showing the bug could easily be adapted (merged)
  2450. Revision 1.4 2000/09/04 20:17:53 peter
  2451. * fixed previous commit (merged)
  2452. Revision 1.3 2000/09/04 19:38:13 peter
  2453. * fsplit with .. fix from Thomas (merged)
  2454. Revision 1.2 2000/07/13 11:33:48 michael
  2455. + removed logs
  2456. }