linux.pp 80 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666
  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. Unit Linux;
  13. Interface
  14. { Get Types and Constants }
  15. {$i sysconst.inc}
  16. {$i systypes.inc}
  17. { Get System call numbers and error-numbers}
  18. {$i sysnr.inc}
  19. {$i errno.inc}
  20. var
  21. ErrNo,
  22. LinuxError : Longint;
  23. {********************
  24. Process
  25. ********************}
  26. const
  27. { cloning flags }
  28. CSIGNAL = $000000ff; // signal mask to be sent at exit
  29. CLONE_VM = $00000100; // set if VM shared between processes
  30. CLONE_FS = $00000200; // set if fs info shared between processes
  31. CLONE_FILES = $00000400; // set if open files shared between processes
  32. CLONE_SIGHAND = $00000800; // set if signal handlers shared
  33. CLONE_PID = $00001000; // set if pid shared
  34. type
  35. TCloneFunc=function(args:pointer):longint;cdecl;
  36. const
  37. { For getting/setting priority }
  38. Prio_Process = 0;
  39. Prio_PGrp = 1;
  40. Prio_User = 2;
  41. WNOHANG = $1;
  42. WUNTRACED = $2;
  43. __WCLONE = $80000000;
  44. {********************
  45. File
  46. ********************}
  47. Const
  48. P_IN = 1;
  49. P_OUT = 2;
  50. Const
  51. LOCK_SH = 1;
  52. LOCK_EX = 2;
  53. LOCK_UN = 8;
  54. LOCK_NB = 4;
  55. Type
  56. Tpipe = array[1..2] of longint;
  57. pglob = ^tglob;
  58. tglob = record
  59. name : pchar;
  60. next : pglob;
  61. end;
  62. ComStr = String[255];
  63. PathStr = String[255];
  64. DirStr = String[255];
  65. NameStr = String[255];
  66. ExtStr = String[255];
  67. const
  68. { For testing access rights }
  69. R_OK = 4;
  70. W_OK = 2;
  71. X_OK = 1;
  72. F_OK = 0;
  73. { For File control mechanism }
  74. F_GetFd = 1;
  75. F_SetFd = 2;
  76. F_GetFl = 3;
  77. F_SetFl = 4;
  78. F_GetLk = 5;
  79. F_SetLk = 6;
  80. F_SetLkW = 7;
  81. F_GetOwn = 8;
  82. F_SetOwn = 9;
  83. {********************
  84. Signal
  85. ********************}
  86. Const
  87. { For sending a signal }
  88. SA_NOCLDSTOP = 1;
  89. SA_SHIRQ = $04000000;
  90. SA_STACK = $08000000;
  91. SA_RESTART = $10000000;
  92. SA_INTERRUPT = $20000000;
  93. SA_NOMASK = $40000000;
  94. SA_ONESHOT = $80000000;
  95. SIG_BLOCK = 0;
  96. SIG_UNBLOCK = 1;
  97. SIG_SETMASK = 2;
  98. SIG_DFL = 0 ;
  99. SIG_IGN = 1 ;
  100. SIG_ERR = -1 ;
  101. SIGHUP = 1;
  102. SIGINT = 2;
  103. SIGQUIT = 3;
  104. SIGILL = 4;
  105. SIGTRAP = 5;
  106. SIGABRT = 6;
  107. SIGIOT = 6;
  108. SIGBUS = 7;
  109. SIGFPE = 8;
  110. SIGKILL = 9;
  111. SIGUSR1 = 10;
  112. SIGSEGV = 11;
  113. SIGUSR2 = 12;
  114. SIGPIPE = 13;
  115. SIGALRM = 14;
  116. SIGTerm = 15;
  117. SIGSTKFLT = 16;
  118. SIGCHLD = 17;
  119. SIGCONT = 18;
  120. SIGSTOP = 19;
  121. SIGTSTP = 20;
  122. SIGTTIN = 21;
  123. SIGTTOU = 22;
  124. SIGURG = 23;
  125. SIGXCPU = 24;
  126. SIGXFSZ = 25;
  127. SIGVTALRM = 26;
  128. SIGPROF = 27;
  129. SIGWINCH = 28;
  130. SIGIO = 29;
  131. SIGPOLL = SIGIO;
  132. SIGPWR = 30;
  133. SIGUNUSED = 31;
  134. Type
  135. SignalHandler = Procedure(Sig : LongInt);cdecl;
  136. PSignalHandler = ^SignalHandler;
  137. SignalRestorer = Procedure;cdecl;
  138. PSignalRestorer = ^SignalRestorer;
  139. SigSet = Longint;
  140. PSigSet = ^SigSet;
  141. SigActionRec = packed record
  142. Sa_Handler : SignalHandler;
  143. Sa_Mask : SigSet;
  144. Sa_Flags : Longint;
  145. Sa_restorer : SignalRestorer; { Obsolete - Don't use }
  146. end;
  147. PSigActionRec = ^SigActionRec;
  148. {********************
  149. IOCtl(TermIOS)
  150. ********************}
  151. Const
  152. { Amount of Control Chars }
  153. NCCS = 19;
  154. NCC = 8;
  155. { For Terminal handling }
  156. TCGETS = $5401;
  157. TCSETS = $5402;
  158. TCSETSW = $5403;
  159. TCSETSF = $5404;
  160. TCGETA = $5405;
  161. TCSETA = $5406;
  162. TCSETAW = $5407;
  163. TCSETAF = $5408;
  164. TCSBRK = $5409;
  165. TCXONC = $540A;
  166. TCFLSH = $540B;
  167. TIOCEXCL = $540C;
  168. TIOCNXCL = $540D;
  169. TIOCSCTTY = $540E;
  170. TIOCGPGRP = $540F;
  171. TIOCSPGRP = $5410;
  172. TIOCOUTQ = $5411;
  173. TIOCSTI = $5412;
  174. TIOCGWINSZ = $5413;
  175. TIOCSWINSZ = $5414;
  176. TIOCMGET = $5415;
  177. TIOCMBIS = $5416;
  178. TIOCMBIC = $5417;
  179. TIOCMSET = $5418;
  180. TIOCGSOFTCAR = $5419;
  181. TIOCSSOFTCAR = $541A;
  182. FIONREAD = $541B;
  183. TIOCINQ = FIONREAD;
  184. TIOCLINUX = $541C;
  185. TIOCCONS = $541D;
  186. TIOCGSERIAL = $541E;
  187. TIOCSSERIAL = $541F;
  188. TIOCPKT = $5420;
  189. FIONBIO = $5421;
  190. TIOCNOTTY = $5422;
  191. TIOCSETD = $5423;
  192. TIOCGETD = $5424;
  193. TCSBRKP = $5425;
  194. TIOCTTYGSTRUCT = $5426;
  195. FIONCLEX = $5450;
  196. FIOCLEX = $5451;
  197. FIOASYNC = $5452;
  198. TIOCSERCONFIG = $5453;
  199. TIOCSERGWILD = $5454;
  200. TIOCSERSWILD = $5455;
  201. TIOCGLCKTRMIOS = $5456;
  202. TIOCSLCKTRMIOS = $5457;
  203. TIOCSERGSTRUCT = $5458;
  204. TIOCSERGETLSR = $5459;
  205. TIOCSERGETMULTI = $545A;
  206. TIOCSERSETMULTI = $545B;
  207. TIOCMIWAIT = $545C;
  208. TIOCGICOUNT = $545D;
  209. TIOCPKT_DATA = 0;
  210. TIOCPKT_FLUSHREAD = 1;
  211. TIOCPKT_FLUSHWRITE = 2;
  212. TIOCPKT_STOP = 4;
  213. TIOCPKT_START = 8;
  214. TIOCPKT_NOSTOP = 16;
  215. TIOCPKT_DOSTOP = 32;
  216. Type
  217. winsize = packed record
  218. ws_row,
  219. ws_col,
  220. ws_xpixel,
  221. ws_ypixel : word;
  222. end;
  223. TWinSize=winsize;
  224. Termio = packed record
  225. c_iflag, { input mode flags }
  226. c_oflag, { output mode flags }
  227. c_cflag, { control mode flags }
  228. c_lflag : Word; { local mode flags }
  229. c_line : Word; { line discipline - careful, only High byte in use}
  230. c_cc : array [0..NCC-1] of char;{ control characters }
  231. end;
  232. TTermio=Termio;
  233. Termios = packed record
  234. c_iflag,
  235. c_oflag,
  236. c_cflag,
  237. c_lflag : longint;
  238. c_line : char;
  239. c_cc : array[0..NCCS-1] of byte;
  240. end;
  241. TTermios=Termios;
  242. const
  243. InitCC:array[0..NCCS-1] of byte=(3,34,177,25,4,0,1,0,21,23,32,0,22,17,27,26,0,0,0);
  244. const
  245. {c_cc characters}
  246. VINTR = 0;
  247. VQUIT = 1;
  248. VERASE = 2;
  249. VKILL = 3;
  250. VEOF = 4;
  251. VTIME = 5;
  252. VMIN = 6;
  253. VSWTC = 7;
  254. VSTART = 8;
  255. VSTOP = 9;
  256. VSUSP = 10;
  257. VEOL = 11;
  258. VREPRINT = 12;
  259. VDISCARD = 13;
  260. VWERASE = 14;
  261. VLNEXT = 15;
  262. VEOL2 = 16;
  263. {c_iflag bits}
  264. IGNBRK = $0000001;
  265. BRKINT = $0000002;
  266. IGNPAR = $0000004;
  267. PARMRK = $0000008;
  268. INPCK = $0000010;
  269. ISTRIP = $0000020;
  270. INLCR = $0000040;
  271. IGNCR = $0000080;
  272. ICRNL = $0000100;
  273. IUCLC = $0000200;
  274. IXON = $0000400;
  275. IXANY = $0000800;
  276. IXOFF = $0001000;
  277. IMAXBEL = $0002000;
  278. {c_oflag bits}
  279. OPOST = $0000001;
  280. OLCUC = $0000002;
  281. ONLCR = $0000004;
  282. OCRNL = $0000008;
  283. ONOCR = $0000010;
  284. ONLRET = $0000020;
  285. OFILL = $0000040;
  286. OFDEL = $0000080;
  287. NLDLY = $0000100;
  288. NL0 = $0000000;
  289. NL1 = $0000100;
  290. CRDLY = $0000600;
  291. CR0 = $0000000;
  292. CR1 = $0000200;
  293. CR2 = $0000400;
  294. CR3 = $0000600;
  295. TABDLY = $0001800;
  296. TAB0 = $0000000;
  297. TAB1 = $0000800;
  298. TAB2 = $0001000;
  299. TAB3 = $0001800;
  300. XTABS = $0001800;
  301. BSDLY = $0002000;
  302. BS0 = $0000000;
  303. BS1 = $0002000;
  304. VTDLY = $0004000;
  305. VT0 = $0000000;
  306. VT1 = $0004000;
  307. FFDLY = $0008000;
  308. FF0 = $0000000;
  309. FF1 = $0008000;
  310. {c_cflag bits}
  311. CBAUD = $000100F;
  312. B0 = $0000000;
  313. B50 = $0000001;
  314. B75 = $0000002;
  315. B110 = $0000003;
  316. B134 = $0000004;
  317. B150 = $0000005;
  318. B200 = $0000006;
  319. B300 = $0000007;
  320. B600 = $0000008;
  321. B1200 = $0000009;
  322. B1800 = $000000A;
  323. B2400 = $000000B;
  324. B4800 = $000000C;
  325. B9600 = $000000D;
  326. B19200 = $000000E;
  327. B38400 = $000000F;
  328. EXTA = B19200;
  329. EXTB = B38400;
  330. CSIZE = $0000030;
  331. CS5 = $0000000;
  332. CS6 = $0000010;
  333. CS7 = $0000020;
  334. CS8 = $0000030;
  335. CSTOPB = $0000040;
  336. CREAD = $0000080;
  337. PARENB = $0000100;
  338. PARODD = $0000200;
  339. HUPCL = $0000400;
  340. CLOCAL = $0000800;
  341. CBAUDEX = $0001000;
  342. B57600 = $0001001;
  343. B115200 = $0001002;
  344. B230400 = $0001003;
  345. B460800 = $0001004;
  346. CIBAUD = $100F0000;
  347. CMSPAR = $40000000;
  348. CRTSCTS = $80000000;
  349. {c_lflag bits}
  350. ISIG = $0000001;
  351. ICANON = $0000002;
  352. XCASE = $0000004;
  353. ECHO = $0000008;
  354. ECHOE = $0000010;
  355. ECHOK = $0000020;
  356. ECHONL = $0000040;
  357. NOFLSH = $0000080;
  358. TOSTOP = $0000100;
  359. ECHOCTL = $0000200;
  360. ECHOPRT = $0000400;
  361. ECHOKE = $0000800;
  362. FLUSHO = $0001000;
  363. PENDIN = $0004000;
  364. IEXTEN = $0008000;
  365. {c_line bits}
  366. TIOCM_LE = $001;
  367. TIOCM_DTR = $002;
  368. TIOCM_RTS = $004;
  369. TIOCM_ST = $008;
  370. TIOCM_SR = $010;
  371. TIOCM_CTS = $020;
  372. TIOCM_CAR = $040;
  373. TIOCM_RNG = $080;
  374. TIOCM_DSR = $100;
  375. TIOCM_CD = TIOCM_CAR;
  376. TIOCM_RI = TIOCM_RNG;
  377. TIOCM_OUT1 = $2000;
  378. TIOCM_OUT2 = $4000;
  379. {TCSetAttr}
  380. TCSANOW = 0;
  381. TCSADRAIN = 1;
  382. TCSAFLUSH = 2;
  383. {TCFlow}
  384. TCOOFF = 0;
  385. TCOON = 1;
  386. TCIOFF = 2;
  387. TCION = 3;
  388. {TCFlush}
  389. TCIFLUSH = 0;
  390. TCOFLUSH = 1;
  391. TCIOFLUSH = 2;
  392. {********************
  393. Info
  394. ********************}
  395. Type
  396. UTimBuf = packed record {in BSD array[0..1] of timeval, but this is
  397. backwards compatible with linux version}
  398. actime,
  399. dummy1,
  400. modtime,
  401. dummy2 : Longint;
  402. end;
  403. UTimeBuf=UTimBuf;
  404. TUTimeBuf=UTimeBuf;
  405. PUTimeBuf=^UTimeBuf;
  406. TSysinfo = packed record
  407. uptime : longint;
  408. loads : array[1..3] of longint;
  409. totalram,
  410. freeram,
  411. sharedram,
  412. bufferram,
  413. totalswap,
  414. freeswap : longint;
  415. procs : integer;
  416. s : string[18];
  417. end;
  418. PSysInfo = ^TSysInfo;
  419. {******************************************************************************
  420. Procedure/Functions
  421. ******************************************************************************}
  422. //Function SysCall(callnr:longint;var regs:SysCallregs):longint;
  423. {**************************
  424. Time/Date Handling
  425. ***************************}
  426. var
  427. tzdaylight : boolean;
  428. tzseconds : longint;
  429. tzname : array[boolean] of pchar;
  430. { timezone support }
  431. procedure GetLocalTimezone(timer:longint;var leap_correct,leap_hit:longint);
  432. procedure GetLocalTimezone(timer:longint);
  433. procedure ReadTimezoneFile(fn:string);
  434. function GetTimezoneFile:string;
  435. Procedure GetTimeOfDay(var tv:timeval);
  436. Function GetTimeOfDay:longint;
  437. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
  438. Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
  439. procedure GetTime(var hour,min,sec,msec,usec:word);
  440. procedure GetTime(var hour,min,sec,sec100:word);
  441. procedure GetTime(var hour,min,sec:word);
  442. Procedure GetDate(Var Year,Month,Day:Word);
  443. Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
  444. {**************************
  445. Process Handling
  446. ***************************}
  447. function CreateShellArgV(const prog:string):ppchar;
  448. function CreateShellArgV(const prog:Ansistring):ppchar;
  449. Procedure Execve(Path:pathstr;args:ppchar;ep:ppchar);
  450. Procedure Execve(path:pchar;args:ppchar;ep:ppchar);
  451. Procedure Execv(const path:pathstr;args:ppchar);
  452. Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
  453. Procedure Execl(const Todo:string);
  454. Procedure Execle(Todo:string;Ep:ppchar);
  455. Procedure Execlp(Todo:string;Ep:ppchar);
  456. Function Shell(const Command:String):Longint;
  457. Function Shell(const Command:AnsiString):Longint;
  458. Function Fork:longint;
  459. function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
  460. Procedure ExitProcess(val:longint);
  461. Function WaitPid(Pid:longint;Status:pointer;Options:Integer):Longint;
  462. Procedure Nice(N:integer);
  463. Function GetPriority(Which,Who:longint):longint;
  464. Procedure SetPriority(Which,Who,What:longint);
  465. Function GetPid:LongInt;
  466. Function GetPPid:LongInt;
  467. Function GetUid:Longint;
  468. Function GetEUid:Longint;
  469. Function GetGid:Longint;
  470. Function GetEGid:Longint;
  471. {**************************
  472. File Handling
  473. ***************************}
  474. Function fdOpen(pathname:string;flags:longint):longint;
  475. Function fdOpen(pathname:string;flags,mode:longint):longint;
  476. Function fdOpen(pathname:pchar;flags:longint):longint;
  477. Function fdOpen(pathname:pchar;flags,mode:longint):longint;
  478. Function fdClose(fd:longint):boolean;
  479. Function fdRead(fd:longint;var buf;size:longint):longint;
  480. Function fdWrite(fd:longint;var buf;size:longint):longint;
  481. Function fdTruncate(fd,size:longint):boolean;
  482. Function fdSeek (fd,pos,seektype :longint): longint;
  483. Function fdFlush (fd : Longint) : Boolean;
  484. Function Link(OldPath,NewPath:pathstr):boolean;
  485. Function SymLink(OldPath,NewPath:pathstr):boolean;
  486. Function UnLink(Path:pathstr):boolean;
  487. Function UnLink(Path:pchar):Boolean;
  488. Function FReName (OldName,NewName : Pchar) : Boolean;
  489. Function FReName (OldName,NewName : String) : Boolean;
  490. Function Chown(path:pathstr;NewUid,NewGid:longint):boolean;
  491. Function Chmod(path:pathstr;Newmode:longint):boolean;
  492. Function Utime(path:pathstr;utim:utimebuf):boolean;
  493. Function Access(Path:Pathstr ;mode:longint):boolean;
  494. Function Umask(Mask:Integer):integer;
  495. Function Flock (fd,mode : longint) : boolean;
  496. Function Flock (var T : text;mode : longint) : boolean;
  497. Function Flock (var F : File;mode : longint) : boolean;
  498. Function FStat(Path:Pathstr;Var Info:stat):Boolean;
  499. Function FStat(Fd:longint;Var Info:stat):Boolean;
  500. Function FStat(var F:Text;Var Info:stat):Boolean;
  501. Function FStat(var F:File;Var Info:stat):Boolean;
  502. Function Lstat(Filename: PathStr;var Info:stat):Boolean;
  503. Function FSStat(Path:Pathstr;Var Info:statfs):Boolean;
  504. Function FSStat(Fd: Longint;Var Info:statfs):Boolean;
  505. Function Fcntl(Fd:longint;Cmd:Integer):integer;
  506. Procedure Fcntl(Fd:longint;Cmd:Integer;Arg:Longint);
  507. Function Fcntl(var Fd:Text;Cmd:Integer):integer;
  508. Procedure Fcntl(var Fd:Text;Cmd:Integer;Arg:Longint);
  509. Function Dup(oldfile:longint;var newfile:longint):Boolean;
  510. Function Dup(var oldfile,newfile:text):Boolean;
  511. Function Dup(var oldfile,newfile:file):Boolean;
  512. Function Dup2(oldfile,newfile:longint):Boolean;
  513. Function Dup2(var oldfile,newfile:text):Boolean;
  514. Function Dup2(var oldfile,newfile:file):Boolean;
  515. {
  516. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
  517. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
  518. }
  519. Function SelectText(var T:Text;TimeOut :PTimeVal):Longint;
  520. {**************************
  521. Directory Handling
  522. ***************************}
  523. Function OpenDir(f:pchar):pdir;
  524. Function OpenDir(f: String):pdir;
  525. function CloseDir(p:pdir):integer;
  526. Function ReadDir(p:pdir):pdirent;
  527. procedure SeekDir(p:pdir;off:longint);
  528. function TellDir(p:pdir):longint;
  529. {**************************
  530. Pipe/Fifo/Stream
  531. ***************************}
  532. Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
  533. Function AssignPipe(var pipe_in,pipe_out:text):boolean;
  534. Function AssignPipe(var pipe_in,pipe_out:file):boolean;
  535. Function PClose(Var F:text) : longint;
  536. Function PClose(Var F:file) : longint;
  537. Procedure POpen(var F:text;const Prog:String;rw:char);
  538. Procedure POpen(var F:file;const Prog:String;rw:char);
  539. Function mkFifo(pathname:string;mode:longint):boolean;
  540. Procedure AssignStream(Var StreamIn,Streamout:text;Const Prog:String);
  541. function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: String): LongInt;
  542. {**************************
  543. General information
  544. ***************************}
  545. {
  546. Function GetDomainName:String;
  547. Function GetHostName:String;
  548. Function Sysinfo(var Info:TSysinfo):Boolean;
  549. Function Uname(var unamerec:utsname):Boolean;
  550. }
  551. Function GetEnv(P:string):Pchar;
  552. {**************************
  553. Signal
  554. ***************************}
  555. Procedure SigAction(Signum:Integer;Var Act,OldAct:PSigActionRec );
  556. Procedure SigProcMask (How:Integer;SSet,OldSSet:PSigSet);
  557. Function SigPending:SigSet;
  558. Procedure SigSuspend(Mask:Sigset);
  559. //Function Signal(Signum:Integer;Handler:SignalHandler):SignalHandler;
  560. Function Kill(Pid:longint;Sig:integer):integer;
  561. Procedure SigRaise(Sig:integer);
  562. {Function Alarm(Sec : Longint) : longint;
  563. Procedure Pause;
  564. }
  565. {**************************
  566. IOCtl/Termios Functions
  567. ***************************}
  568. Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
  569. Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
  570. Function TCSetAttr(fd:longint;OptAct:longint;var tios:TermIOS):boolean;
  571. Procedure CFSetISpeed(var tios:TermIOS;speed:Longint);
  572. Procedure CFSetOSpeed(var tios:TermIOS;speed:Longint);
  573. Procedure CFMakeRaw(var tios:TermIOS);
  574. Function TCSendBreak(fd,duration:longint):boolean;
  575. Function TCSetPGrp(fd,id:longint):boolean;
  576. Function TCGetPGrp(fd:longint;var id:longint):boolean;
  577. Function TCFlush(fd,qsel:longint):boolean;
  578. Function TCDrain(fd:longint):boolean;
  579. Function TCFlow(fd,act:longint):boolean;
  580. Function IsATTY(Handle:Longint):Boolean;
  581. Function IsATTY(f:text):Boolean;
  582. function TTYname(Handle:Longint):string;
  583. function TTYname(var F:Text):string;
  584. {**************************
  585. Memory functions
  586. ***************************}
  587. const
  588. PROT_READ = $1; { page can be read }
  589. PROT_WRITE = $2; { page can be written }
  590. PROT_EXEC = $4; { page can be executed }
  591. PROT_NONE = $0; { page can not be accessed }
  592. MAP_SHARED = $1; { Share changes }
  593. MAP_PRIVATE = $2; { Changes are private }
  594. MAP_TYPE = $f; { Mask for type of mapping }
  595. MAP_FIXED = $10; { Interpret addr exactly }
  596. MAP_ANONYMOUS = $20; { don't use a file }
  597. MAP_GROWSDOWN = $100; { stack-like segment }
  598. MAP_DENYWRITE = $800; { ETXTBSY }
  599. MAP_EXECUTABLE = $1000; { mark it as an executable }
  600. MAP_LOCKED = $2000; { pages are locked }
  601. MAP_NORESERVE = $4000; { don't check for reservations }
  602. type
  603. tmmapargs=record
  604. address : longint;
  605. size : longint;
  606. prot : longint;
  607. flags : longint;
  608. fd : longint;
  609. offset : longint;
  610. end;
  611. function MMap(const m:tmmapargs):longint;
  612. {**************************
  613. Port IO functions
  614. ***************************}
  615. {
  616. Function IOperm (From,Num : Cardinal; Value : Longint) : boolean;
  617. }
  618. {$IFDEF I386}
  619. Procedure WritePort (Port : Longint; Value : Byte);
  620. Procedure WritePort (Port : Longint; Value : Word);
  621. Procedure WritePort (Port : Longint; Value : Longint);
  622. Procedure WritePortl (Port : Longint; Var Buf; Count: longint);
  623. Procedure WritePortW (Port : Longint; Var Buf; Count: longint);
  624. Procedure WritePortB (Port : Longint; Var Buf; Count: longint);
  625. Procedure ReadPort (Port : Longint; Var Value : Byte);
  626. Procedure ReadPort (Port : Longint; Var Value : Word);
  627. Procedure ReadPort (Port : Longint; Var Value : Longint);
  628. Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);
  629. Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);
  630. Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);
  631. {$ENDIF}
  632. {**************************
  633. Utility functions
  634. ***************************}
  635. Function Octal(l:longint):longint;
  636. Function FExpand(Const Path: PathStr):PathStr;
  637. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  638. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  639. Function Dirname(Const path:pathstr):pathstr;
  640. Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
  641. Function FNMatch(const Pattern,Name:string):Boolean;
  642. Function Glob(Const path:pathstr):pglob;
  643. Procedure Globfree(var p:pglob);
  644. Function StringToPPChar(Var S:STring):ppchar;
  645. Function GetFS(var T:Text):longint;
  646. Function GetFS(Var F:File):longint;
  647. {Filedescriptorsets}
  648. Procedure FD_Zero(var fds:fdSet);
  649. Procedure FD_Clr(fd:longint;var fds:fdSet);
  650. Procedure FD_Set(fd:longint;var fds:fdSet);
  651. Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
  652. {Stat.Mode Types}
  653. Function S_ISLNK(m:word):boolean;
  654. Function S_ISREG(m:word):boolean;
  655. Function S_ISDIR(m:word):boolean;
  656. Function S_ISCHR(m:word):boolean;
  657. Function S_ISBLK(m:word):boolean;
  658. Function S_ISFIFO(m:word):boolean;
  659. Function S_ISSOCK(m:word):boolean;
  660. {******************************************************************************
  661. Implementation
  662. ******************************************************************************}
  663. Implementation
  664. Uses Strings;
  665. { Get the definitions of textrec and filerec }
  666. {$i textrec.inc}
  667. {$i filerec.inc}
  668. { Raw System calls are in Syscalls.inc}
  669. {$i syscalls.inc}
  670. {******************************************************************************
  671. Process related calls
  672. ******************************************************************************}
  673. function CreateShellArgV(const prog:string):ppchar;
  674. {
  675. Create an argv which executes a command in a shell using /bin/sh -c
  676. }
  677. var
  678. pp,p : ppchar;
  679. temp : string;
  680. begin
  681. getmem(pp,4*4);
  682. temp:='/bin/sh'#0'-c'#0+prog+#0;
  683. p:=pp;
  684. p^:=@temp[1];
  685. inc(p);
  686. p^:=@temp[9];
  687. inc(p);
  688. p^:=@temp[12];
  689. inc(p);
  690. p^:=Nil;
  691. CreateShellArgV:=pp;
  692. end;
  693. function CreateShellArgV(const prog:Ansistring):ppchar;
  694. {
  695. Create an argv which executes a command in a shell using /bin/sh -c
  696. using a AnsiString;
  697. }
  698. var
  699. pp,p : ppchar;
  700. temp : AnsiString;
  701. begin
  702. getmem(pp,4*4);
  703. temp:='/bin/sh'#0'-c'#0+prog+#0;
  704. p:=pp;
  705. GetMem(p^,Length(Temp));
  706. Move(@Temp[1],p^^,Length(Temp));
  707. inc(p);
  708. p^:=@pp[0][8];
  709. inc(p);
  710. p^:=@pp[0][11];
  711. inc(p);
  712. p^:=Nil;
  713. CreateShellArgV:=pp;
  714. end;
  715. Function Fork:longint;
  716. {
  717. This function issues the 'fork' System call. the program is duplicated in memory
  718. and Execution continues in parent and child process.
  719. In the parent process, fork returns the PID of the child. In the child process,
  720. zero is returned.
  721. A negative value indicates that an error has occurred, the error is returned in
  722. LinuxError.
  723. }
  724. Begin
  725. fork:=Do_syscall(2)
  726. LinuxError:=ErrNo;
  727. End;
  728. function clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
  729. {NOT IMPLEMENTED YET UNDER BSD}
  730. begin
  731. HALT;
  732. END;
  733. {
  734. if (pointer(func)=nil) or (sp=nil) then
  735. begin
  736. LinuxError:=Sys_EInval;
  737. exit;
  738. end;
  739. asm
  740. { Insert the argument onto the new stack. }
  741. movl sp,%ecx
  742. subl $8,%ecx
  743. movl args,%eax
  744. movl %eax,4(%ecx)
  745. { Save the function pointer as the zeroth argument.
  746. It will be popped off in the child in the ebx frobbing below. }
  747. movl func,%eax
  748. movl %eax,0(%ecx)
  749. { Do the system call }
  750. pushl %ebx
  751. pushl %ebx
  752. // movl flags,%ebx
  753. movl $251,%eax
  754. int $0x80
  755. popl %ebx
  756. popl %ebx
  757. test %eax,%eax
  758. jnz .Lclone_end
  759. { We're in the new thread }
  760. subl %ebp,%ebp { terminate the stack frame }
  761. call *%ebx
  762. { exit process }
  763. movl %eax,%ebx
  764. movl $1,%eax
  765. int $0x80
  766. .Lclone_end:
  767. movl %eax,__RESULT
  768. end;
  769. end;
  770. }
  771. Procedure Execve(path:pathstr;args:ppchar;ep:ppchar);
  772. {
  773. Replaces the current program by the program specified in path,
  774. arguments in args are passed to Execve.
  775. environment specified in ep is passed on.
  776. }
  777. Begin
  778. path:=path+#0;
  779. execve:=do_syscall(59,longint(@path[1]),Args,ep);
  780. LinuxError:=ErrNo;
  781. End;
  782. Procedure Execve(path:pchar;args:ppchar;ep:ppchar);
  783. {
  784. Replaces the current program by the program specified in path,
  785. arguments in args are passed to Execve.
  786. environment specified in ep is passed on.
  787. }
  788. {
  789. Replaces the current program by the program specified in path,
  790. arguments in args are passed to Execve.
  791. environment specified in ep is passed on.
  792. }
  793. Begin
  794. execve:=do_syscall(59,path,Args,ep);
  795. LinuxError:=ErrNo;
  796. End;
  797. Procedure Execv(const path:pathstr;args:ppchar);
  798. {
  799. Replaces the current program by the program specified in path,
  800. arguments in args are passed to Execve.
  801. the current environment is passed on.
  802. }
  803. begin
  804. Execve(path,args,envp); {On error linuxerror will get set there}
  805. end;
  806. Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
  807. {
  808. This does the same as Execve, only it searches the PATH environment
  809. for the place of the Executable, except when Path starts with a slash.
  810. if the PATH environment variable is unavailable, the path is set to '.'
  811. }
  812. var
  813. thepath : string;
  814. begin
  815. if path[1]<>'/' then
  816. begin
  817. Thepath:=strpas(getenv('PATH'));
  818. if thepath='' then
  819. thepath:='.';
  820. Path:=FSearch(path,thepath)
  821. end
  822. else
  823. Path:='';
  824. if Path='' then
  825. linuxerror:=Sys_enoent
  826. else
  827. Execve(Path,args,ep);{On error linuxerror will get set there}
  828. end;
  829. Procedure Execle(Todo:string;Ep:ppchar);
  830. {
  831. This procedure takes the string 'Todo', parses it for command and
  832. command options, and Executes the command with the given options.
  833. The string 'Todo' shoud be of the form 'command options', options
  834. separated by commas.
  835. the PATH environment is not searched for 'command'.
  836. The specified environment(in 'ep') is passed on to command
  837. }
  838. var
  839. p : ppchar;
  840. begin
  841. p:=StringToPPChar(ToDo);
  842. if (p=nil) or (p^=nil) then
  843. exit;
  844. ExecVE(p^,p,EP);
  845. end;
  846. Procedure Execl(const Todo:string);
  847. {
  848. This procedure takes the string 'Todo', parses it for command and
  849. command options, and Executes the command with the given options.
  850. The string 'Todo' shoud be of the form 'command options', options
  851. separated by commas.
  852. the PATH environment is not searched for 'command'.
  853. The current environment is passed on to command
  854. }
  855. begin
  856. ExecLE(ToDo,EnvP);
  857. end;
  858. Procedure Execlp(Todo:string;Ep:ppchar);
  859. {
  860. This procedure takes the string 'Todo', parses it for command and
  861. command options, and Executes the command with the given options.
  862. The string 'Todo' shoud be of the form 'command options', options
  863. separated by commas.
  864. the PATH environment is searched for 'command'.
  865. The specified environment (in 'ep') is passed on to command
  866. }
  867. var
  868. p : ppchar;
  869. begin
  870. p:=StringToPPchar(todo);
  871. if (p=nil) or (p^=nil) then
  872. exit;
  873. ExecVP(StrPas(p^),p,EP);
  874. end;
  875. Procedure ExitProcess(val:longint);
  876. begin
  877. ExitProcess:=do_syscall(1,val);
  878. LinuxError:=ErrNo;
  879. end;
  880. Function WaitPid(Pid:longint;Status:pointer;Options:Integer):Longint;
  881. {
  882. Waits until a child with PID Pid exits, or returns if it is exited already.
  883. Any resources used by the child are freed.
  884. The exit status is reported in the adress referred to by Status. It should
  885. be a longint.
  886. }
  887. begin
  888. WaitPID:=do_syscall(7,PID,Status,options,0);
  889. LinuxError:=ErrNo;
  890. end;
  891. Function Shell(const Command:String):Longint;
  892. {
  893. Executes the shell, and passes it the string Command. (Through /bin/sh -c)
  894. The current environment is passed to the shell.
  895. It waits for the shell to exit, and returns its exit status.
  896. If the Exec call failed exit status 127 is reported.
  897. }
  898. var
  899. p : ppchar;
  900. temp,pid : longint;
  901. begin
  902. pid:=fork;
  903. if pid=-1 then
  904. exit; {Linuxerror already set in Fork}
  905. if pid=0 then
  906. begin
  907. {This is the child.}
  908. p:=CreateShellArgv(command);
  909. Execve(p^,p,envp);
  910. exit(127);
  911. end;
  912. temp:=0;
  913. WaitPid(pid,@temp,0);{Linuxerror is set there}
  914. Shell:=temp;{ Return exit status }
  915. end;
  916. Function Shell(const Command:AnsiString):Longint;
  917. {
  918. AnsiString version of Shell
  919. }
  920. var
  921. p : ppchar;
  922. temp,pid : longint;
  923. begin
  924. pid:=fork;
  925. if pid=-1 then
  926. exit; {Linuxerror already set in Fork}
  927. if pid=0 then
  928. begin
  929. {This is the child.}
  930. p:=CreateShellArgv(command);
  931. Execve(p^,p,envp);
  932. exit(127);
  933. end;
  934. temp:=0;
  935. WaitPid(pid,@temp,0);{Linuxerror is set there}
  936. Shell:=temp;{ Return exit status }
  937. end;
  938. Function GetPriority(Which,Who:longint):longint;
  939. {
  940. Get Priority of process, process group, or user.
  941. Which : selects what kind of priority is used.
  942. can be one of the following predefined Constants :
  943. Prio_User.
  944. Prio_PGrp.
  945. Prio_Process.
  946. Who : depending on which, this is , respectively :
  947. Uid
  948. Pid
  949. Process Group id
  950. Errors are reported in linuxerror _only_. (priority can be negative)
  951. }
  952. begin
  953. errno:=0;
  954. if (which<prio_process) or (which>prio_user) then
  955. begin
  956. { We can save an interrupt here }
  957. getpriority:=0;
  958. linuxerror:=Sys_einval;
  959. end
  960. else
  961. begin
  962. GetPriority:=do_syscall(100,which,who);
  963. LinuxError:=ErrNo;
  964. end;
  965. end;
  966. Procedure SetPriority(Which,Who,What:longint);
  967. {
  968. Set Priority of process, process group, or user.
  969. Which : selects what kind of priority is used.
  970. can be one of the following predefined Constants :
  971. Prio_User.
  972. Prio_PGrp.
  973. Prio_Process.
  974. Who : depending on value of which, this is, respectively :
  975. Uid
  976. Pid
  977. Process Group id
  978. what : A number between -20 and 20. -20 is most favorable, 20 least.
  979. 0 is the default.
  980. }
  981. begin
  982. errno:=0;
  983. if ((which<prio_process) or (which>prio_user)) or ((what<-20) or (what>20)) then
  984. linuxerror:=Sys_einval { We can save an interrupt here }
  985. else
  986. begin
  987. do_syscall(96,which,who,what);
  988. LinuxError:=ErrNo;
  989. end;
  990. end;
  991. Procedure Nice(N:integer);
  992. {
  993. Set process priority. A positive N means a lower priority.
  994. A negative N decreases priority.
  995. Doesn't exist in BSD. Linux emu uses setpriority in a construct as below:
  996. }
  997. begin
  998. SetPriority(Prio_Process,0,N);
  999. end;
  1000. Function GetPid:LongInt;
  1001. {
  1002. Get Process ID.
  1003. }
  1004. begin
  1005. GetPID:=do_syscall(20);
  1006. LinuxError:=errno;
  1007. end;
  1008. Function GetPPid:LongInt;
  1009. {
  1010. Get Process ID of parent process.
  1011. }
  1012. begin
  1013. GetPPid:=do_syscall(39);
  1014. LinuxError:=errno;
  1015. end;
  1016. Function GetUid:Longint;
  1017. {
  1018. Get User ID.
  1019. }
  1020. begin
  1021. GetUID:=do_syscall(24);
  1022. LinuxError:=ErrNo;
  1023. end;
  1024. Function GetEUid:Longint;
  1025. {
  1026. Get _effective_ User ID.
  1027. }
  1028. begin
  1029. GetEUID:=do_syscall(25);
  1030. LinuxError:=ErrNo;
  1031. end;
  1032. Function GetGid:Longint;
  1033. {
  1034. Get Group ID.
  1035. }
  1036. begin
  1037. GetEUID:=do_syscall(47);
  1038. LinuxError:=ErrNo;
  1039. end;
  1040. Function GetEGid:Longint;
  1041. {
  1042. Get _effective_ Group ID.
  1043. }
  1044. begin
  1045. GetEGID:=do_syscall(43);
  1046. LinuxError:=ErrNo;
  1047. end;
  1048. {******************************************************************************
  1049. Date and Time related calls
  1050. ******************************************************************************}
  1051. Const
  1052. {Date Translation}
  1053. C1970=2440588;
  1054. D0 = 1461;
  1055. D1 = 146097;
  1056. D2 =1721119;
  1057. Function GregorianToJulian(Year,Month,Day:Longint):LongInt;
  1058. Var
  1059. Century,XYear: LongInt;
  1060. Begin
  1061. If Month<=2 Then
  1062. Begin
  1063. Dec(Year);
  1064. Inc(Month,12);
  1065. End;
  1066. Dec(Month,3);
  1067. Century:=(longint(Year Div 100)*D1) shr 2;
  1068. XYear:=(longint(Year Mod 100)*D0) shr 2;
  1069. GregorianToJulian:=((((Month*153)+2) div 5)+Day)+D2+XYear+Century;
  1070. End;
  1071. Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
  1072. Var
  1073. YYear,XYear,Temp,TempMonth : LongInt;
  1074. Begin
  1075. Temp:=((JulianDN-D2) shl 2)-1;
  1076. JulianDN:=Temp Div D1;
  1077. XYear:=(Temp Mod D1) or 3;
  1078. YYear:=(XYear Div D0);
  1079. Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
  1080. Day:=((Temp Mod 153)+5) Div 5;
  1081. TempMonth:=Temp Div 153;
  1082. If TempMonth>=10 Then
  1083. Begin
  1084. inc(YYear);
  1085. dec(TempMonth,12);
  1086. End;
  1087. inc(TempMonth,3);
  1088. Month := TempMonth;
  1089. Year:=YYear+(JulianDN*100);
  1090. end;
  1091. Procedure GetTimeOfDay(var tv:timeval);
  1092. {
  1093. Get the number of seconds since 00:00, January 1 1970, GMT
  1094. the time NOT corrected any way
  1095. }
  1096. var tz : timezone;
  1097. begin
  1098. do_syscall(116,@tv,@tz);
  1099. LinuxError:=Errno;
  1100. end;
  1101. Function GetTimeOfDay: longint;
  1102. {
  1103. Get the number of seconds since 00:00, January 1 1970, GMT
  1104. the time NOT corrected any way
  1105. }
  1106. begin
  1107. GetTimeOfDay:=Sys_time;
  1108. LinuxError:=Errno;
  1109. end;
  1110. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
  1111. {
  1112. Transforms Epoch time into local time (hour, minute,seconds)
  1113. }
  1114. Var
  1115. DateNum: LongInt;
  1116. Begin
  1117. inc(Epoch,TZSeconds);
  1118. Datenum:=(Epoch Div 86400) + c1970;
  1119. JulianToGregorian(DateNum,Year,Month,day);
  1120. Epoch:=Epoch Mod 86400;
  1121. Hour:=Epoch Div 3600;
  1122. Epoch:=Epoch Mod 3600;
  1123. Minute:=Epoch Div 60;
  1124. Second:=Epoch Mod 60;
  1125. End;
  1126. Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
  1127. {
  1128. Transforms local time (year,month,day,hour,minutes,second) to Epoch time
  1129. (seconds since 00:00, january 1 1970, corrected for local time zone)
  1130. }
  1131. Begin
  1132. LocalToEpoch:=((GregorianToJulian(Year,Month,Day)-c1970)*86400)+
  1133. (LongInt(Hour)*3600)+(Minute*60)+Second-TZSeconds;
  1134. End;
  1135. procedure GetTime(var hour,min,sec,msec,usec:word);
  1136. {
  1137. Gets the current time, adjusted to local time
  1138. }
  1139. var
  1140. year,day,month:Word;
  1141. t : timeval;
  1142. begin
  1143. gettimeofday(t);
  1144. EpochToLocal(t.sec,year,month,day,hour,min,sec);
  1145. msec:=t.usec div 1000;
  1146. usec:=t.usec mod 1000;
  1147. end;
  1148. procedure GetTime(var hour,min,sec,sec100:word);
  1149. {
  1150. Gets the current time, adjusted to local time
  1151. }
  1152. var
  1153. usec : word;
  1154. begin
  1155. gettime(hour,min,sec,sec100,usec);
  1156. sec100:=sec100 div 10;
  1157. end;
  1158. Procedure GetTime(Var Hour,Min,Sec:Word);
  1159. {
  1160. Gets the current time, adjusted to local time
  1161. }
  1162. var
  1163. msec,usec : Word;
  1164. Begin
  1165. gettime(hour,min,sec,msec,usec);
  1166. End;
  1167. Procedure GetDate(Var Year,Month,Day:Word);
  1168. {
  1169. Gets the current date, adjusted to local time
  1170. }
  1171. var
  1172. hour,minute,second : word;
  1173. Begin
  1174. EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
  1175. End;
  1176. Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
  1177. {
  1178. Gets the current date, adjusted to local time
  1179. }
  1180. Begin
  1181. EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
  1182. End;
  1183. { Include timezone handling routines which use /usr/share/timezone info }
  1184. {$i timezone.inc}
  1185. {******************************************************************************
  1186. FileSystem calls
  1187. ******************************************************************************}
  1188. Function fdOpen(pathname:string;flags:longint):longint;
  1189. begin
  1190. pathname:=pathname+#0;
  1191. fdOpen:=Sys_Open(@pathname[1],flags,438);
  1192. LinuxError:=Errno;
  1193. end;
  1194. Function fdOpen(pathname:string;flags,mode:longint):longint;
  1195. begin
  1196. pathname:=pathname+#0;
  1197. fdOpen:=Sys_Open(@pathname[1],flags,mode);
  1198. LinuxError:=Errno;
  1199. end;
  1200. Function fdOpen(pathname:pchar;flags:longint):longint;
  1201. begin
  1202. fdOpen:=Sys_Open(pathname,flags,0);
  1203. LinuxError:=Errno;
  1204. end;
  1205. Function fdOpen(pathname:pchar;flags,mode:longint):longint;
  1206. begin
  1207. fdOpen:=Sys_Open(pathname,flags,mode);
  1208. LinuxError:=Errno;
  1209. end;
  1210. Function fdClose(fd:longint):boolean;
  1211. begin
  1212. fdClose:=(Sys_Close(fd)=0);
  1213. LinuxError:=Errno;
  1214. end;
  1215. Function fdRead(fd:longint;var buf;size:longint):longint;
  1216. begin
  1217. fdRead:=Sys_Read(fd,pchar(@buf),size);
  1218. LinuxError:=Errno;
  1219. end;
  1220. Function fdWrite(fd:longint;var buf;size:longint):longint;
  1221. begin
  1222. fdWrite:=Sys_Write(fd,pchar(@buf),size);
  1223. LinuxError:=Errno;
  1224. end;
  1225. Function fdTruncate(fd,size:longint):boolean;
  1226. begin
  1227. fdtruncate:=do_syscall(201,fd,size);
  1228. LinuxError:=Errno;
  1229. end;
  1230. Function fdSeek (fd,pos,seektype :longint): longint;
  1231. {
  1232. Do a Seek on a file descriptor fd to position pos, starting from seektype
  1233. }
  1234. begin
  1235. fdseek:=Sys_LSeek (fd,pos,seektype);
  1236. LinuxError:=Errno;
  1237. end;
  1238. Function fdFlush (fd : Longint) : Boolean;
  1239. Var Retval : LONGINT;
  1240. begin
  1241. fdflush:=do_syscall(95,fd);
  1242. LinuxError:=Errno;
  1243. end;
  1244. function sys_fcntl(Fd:longint;Cmd:Integer;Arg:Longint):longint;
  1245. begin
  1246. sys_fcntl:=do_syscall(92,fd,cmd,arg)
  1247. LinuxError:=Errno;
  1248. end;
  1249. Function Fcntl(Fd:longint;Cmd:integer):integer;
  1250. {
  1251. Read or manipulate a file.(See also fcntl (2) )
  1252. Possible values for Cmd are :
  1253. F_GetFd,F_GetFl,F_GetOwn
  1254. Errors are reported in Linuxerror;
  1255. If Cmd is different from the allowed values, linuxerror=Sys_eninval.
  1256. }
  1257. begin
  1258. if (cmd in [F_GetFd,F_GetFl,F_GetOwn]) then
  1259. begin
  1260. Linuxerror:=sys_fcntl(fd,cmd,0);
  1261. if linuxerror=-1 then
  1262. begin
  1263. linuxerror:=errno;
  1264. fcntl:=0;
  1265. end
  1266. else
  1267. begin
  1268. fcntl:=linuxerror;
  1269. linuxerror:=0;
  1270. end;
  1271. end
  1272. else
  1273. begin
  1274. linuxerror:=Sys_einval;
  1275. Fcntl:=0;
  1276. end;
  1277. end;
  1278. Procedure Fcntl(Fd:longint;Cmd:Integer;Arg:Longint);
  1279. {
  1280. Read or manipulate a file. (See also fcntl (2) )
  1281. Possible values for Cmd are :
  1282. F_setFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkW,F_SetOwn;
  1283. Errors are reported in Linuxerror;
  1284. If Cmd is different from the allowed values, linuxerror=Sys_eninval.
  1285. F_DupFD is not allowed, due to the structure of Files in Pascal.
  1286. }
  1287. begin
  1288. if (cmd in [F_SetFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkw,F_SetOwn]) then
  1289. begin
  1290. sys_fcntl(fd,cmd,arg);
  1291. LinuxError:=ErrNo;
  1292. end
  1293. else
  1294. linuxerror:=Sys_einval;
  1295. end;
  1296. Function Fcntl(var Fd:Text;Cmd:integer):integer;
  1297. begin
  1298. Fcntl := Fcntl(textrec(Fd).handle, Cmd);
  1299. end;
  1300. Procedure Fcntl(var Fd:Text;Cmd:Integer;Arg:Longint);
  1301. begin
  1302. Fcntl(textrec(Fd).handle, Cmd, Arg);
  1303. end;
  1304. Function Chmod(path:pathstr;Newmode:longint):Boolean;
  1305. {
  1306. Changes the permissions of a file.
  1307. }
  1308. var
  1309. retval : longint;
  1310. begin
  1311. path:=path+#0;
  1312. chmod:=do_syscall(15,longint(@path[1]),newmode);
  1313. LinuxError:=Errno;
  1314. end;
  1315. Function Chown(path:pathstr;NewUid,NewGid:longint):boolean;
  1316. {
  1317. Change the owner and group of a file.
  1318. A user can only change the group to a group of which he is a member.
  1319. The super-user can change uid and gid of any file.
  1320. }
  1321. begin
  1322. path:=path+#0;
  1323. ChOwn:=do_syscall(16,longint(@path[1],newuid,newgid);
  1324. LinuxError:=Errno;
  1325. end;
  1326. Function Utime(path:pathstr;utim:utimebuf):boolean;
  1327. begin
  1328. UTime:=do_syscall(138,longint(@path[1],utim);
  1329. LinuxError:=Errno;
  1330. end;
  1331. Function Flock (fd,mode : longint) : boolean;
  1332. begin
  1333. Flock:=do_syscall(131,fd,mode)=0;
  1334. LinuxError:=Errno;
  1335. end;
  1336. Function Flock (var T : text;mode : longint) : boolean;
  1337. begin
  1338. Flock:=Flock(TextRec(T).Handle,mode);
  1339. end;
  1340. Function Flock (var F : File;mode : longint) : boolean;
  1341. begin
  1342. Flock:=Flock(FileRec(F).Handle,mode);
  1343. end;
  1344. Function FStat(Path:Pathstr;Var Info:stat):Boolean;
  1345. {
  1346. Get all information on a file, and return it in Info.
  1347. }
  1348. begin
  1349. path:=path+#0;
  1350. FStat:=(Sys_stat(@(path[1]),Info)=0);
  1351. LinuxError:=errno;
  1352. end;
  1353. Function Fstat(Fd:Longint;var Info:stat):Boolean;
  1354. {
  1355. Get all information on a file descriptor, and return it in info.
  1356. }
  1357. begin
  1358. FStat:=do_syscall(189,fd,info)=0;
  1359. LinuxError:=Errno;
  1360. end;
  1361. Function FStat(var F:Text;Var Info:stat):Boolean;
  1362. {
  1363. Get all information on a text file, and return it in info.
  1364. }
  1365. begin
  1366. FStat:=Fstat(TextRec(F).Handle,INfo);
  1367. end;
  1368. Function FStat(var F:File;Var Info:stat):Boolean;
  1369. {
  1370. Get all information on a untyped file, and return it in info.
  1371. }
  1372. begin
  1373. FStat:=Fstat(FileRec(F).Handle,Info);
  1374. end;
  1375. Function Lstat(Filename: PathStr;var Info:stat):Boolean;
  1376. {
  1377. Get all information on a link (the link itself), and return it in info.
  1378. }
  1379. var
  1380. Retval : longint;
  1381. begin
  1382. FileName:=FileName+#0;
  1383. LStat:=Do_syscall(189,info,longint(@filename[1]))=0;
  1384. LinuxError:=Errno;
  1385. end;
  1386. Function FSStat(Path:Pathstr;Var Info:statfs):Boolean;
  1387. {
  1388. Get all information on a fileSystem, and return it in Info.
  1389. Path is the name of a file/directory on the fileSystem you wish to
  1390. investigate.
  1391. }
  1392. begin
  1393. path:=path+#0;
  1394. FSStat:=DoSyscall(157,longint(@path[1]),info);
  1395. LinuxError:=Errno;
  1396. end;
  1397. Function FSStat(Fd:Longint;Var Info:statfs):Boolean;
  1398. {
  1399. Get all information on a fileSystem, and return it in Info.
  1400. Fd is the file descriptor of a file/directory on the fileSystem
  1401. you wish to investigate.
  1402. }
  1403. begin
  1404. FSStat:=do_syscall(158,fd,info);
  1405. LinuxError:=Errno;
  1406. end;
  1407. Function Link(OldPath,NewPath:pathstr):boolean;
  1408. {
  1409. Proceduces a hard link from new to old.
  1410. In effect, new will be the same file as old.
  1411. }
  1412. begin
  1413. oldpath:=oldpath+#0;
  1414. newpath:=newpath+#0;
  1415. Link:=DoSyscall(9,longint(@oldpath[1]),longint(@newpath[1]))=0;
  1416. LinuxError:=Errno;
  1417. end;
  1418. Function SymLink(OldPath,newPath:pathstr):boolean;
  1419. {
  1420. Proceduces a soft link from new to old.
  1421. }
  1422. bwgin
  1423. oldpath:=oldpath+#0;
  1424. newpath:=newpath+#0;
  1425. SymLink:=DoSyscall(57,longint(@oldpath[1]),longint(@newpath[1]))=0;
  1426. LinuxError:=Errno;
  1427. end;
  1428. Function UnLink(Path:pathstr):boolean;
  1429. {
  1430. Removes the file in 'Path' (that is, it decreases the link count with one.
  1431. if the link count is zero, the file is removed from the disk.
  1432. }
  1433. begin
  1434. path:=path+#0;
  1435. Unlink:=Sys_unlink(pchar(@(path[1])))=0;
  1436. linuxerror:=errno;
  1437. end;
  1438. Function UnLink(Path:pchar):Boolean;
  1439. {
  1440. Removes the file in 'Path' (that is, it decreases the link count with one.
  1441. if the link count is zero, the file is removed from the disk.
  1442. }
  1443. begin
  1444. Unlink:=(Sys_unlink(path)=0);
  1445. linuxerror:=errno;
  1446. end;
  1447. Function FRename (OldName,NewName : Pchar) : Boolean;
  1448. begin
  1449. FRename:=Sys_rename(OldName,NewName)=0;
  1450. LinuxError:=Errno;
  1451. end;
  1452. Function FRename (OldName,NewName : String) : Boolean;
  1453. begin
  1454. OldName:=OldName+#0;
  1455. NewName:=NewName+#0;
  1456. FRename:=FRename (@OldName[1],@NewName[1]);
  1457. end;
  1458. {!!}
  1459. Function Umask(Mask:Integer):integer;
  1460. {
  1461. Sets file creation mask to (Mask and 0777 (octal) ), and returns the
  1462. previous value.
  1463. }
  1464. begin
  1465. UMask:=Do_syscall(60,mask);
  1466. LinuxError:=0;
  1467. end;
  1468. Function Access(Path:Pathstr ;mode:longint):boolean;
  1469. {
  1470. Test users access rights on the specified file.
  1471. Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
  1472. R,W,X stand for read,write and Execute access, simultaneously.
  1473. F_OK checks whether the test would be allowed on the file.
  1474. i.e. It checks the search permissions in all directory components
  1475. of the path.
  1476. The test is done with the real user-ID, instead of the effective.
  1477. If access is denied, or an error occurred, false is returned.
  1478. If access is granted, true is returned.
  1479. Errors other than no access,are reported in linuxerror.
  1480. }
  1481. begin
  1482. path:=path+#0;
  1483. Access:=do_syscall(33,mode,longint(@path[1]));
  1484. LinuxError:=Errno;
  1485. end;
  1486. Function Dup(oldfile:longint;var newfile:longint):Boolean;
  1487. {
  1488. Copies the filedescriptor oldfile to newfile
  1489. }
  1490. begin
  1491. newfile:=Do_syscall($41,oldfile);
  1492. LinuxError:=Errno;
  1493. Dup:=(LinuxError=0);
  1494. end;
  1495. Function Dup(var oldfile,newfile:text):Boolean;
  1496. {
  1497. Copies the filedescriptor oldfile to newfile, after flushing the buffer of
  1498. oldfile.
  1499. After which the two textfiles are, in effect, the same, except
  1500. that they don't share the same buffer, and don't share the same
  1501. close_on_exit flag.
  1502. }
  1503. begin
  1504. flush(oldfile);{ We cannot share buffers, so we flush them. }
  1505. textrec(newfile):=textrec(oldfile);
  1506. textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
  1507. Dup:=Dup(textrec(oldfile).handle,textrec(newfile).handle);
  1508. end;
  1509. Function Dup(var oldfile,newfile:file):Boolean;
  1510. {
  1511. Copies the filedescriptor oldfile to newfile
  1512. }
  1513. begin
  1514. filerec(newfile):=filerec(oldfile);
  1515. Dup:=Dup(filerec(oldfile).handle,filerec(newfile).handle);
  1516. end;
  1517. Function Dup2(oldfile,newfile:longint):Boolean;
  1518. {
  1519. Copies the filedescriptor oldfile to newfile
  1520. }
  1521. begin
  1522. do_syscall(90,oldfile,newfile);
  1523. LinuxError:=Errno;
  1524. Dup2:=(LinuxError=0);
  1525. end;
  1526. Function Dup2(var oldfile,newfile:text):Boolean;
  1527. {
  1528. Copies the filedescriptor oldfile to newfile, after flushing the buffer of
  1529. oldfile. It closes newfile if it was still open.
  1530. After which the two textfiles are, in effect, the same, except
  1531. that they don't share the same buffer, and don't share the same
  1532. close_on_exit flag.
  1533. }
  1534. var
  1535. tmphandle : word;
  1536. begin
  1537. case TextRec(oldfile).mode of
  1538. fmOutput, fmInOut, fmAppend :
  1539. flush(oldfile);{ We cannot share buffers, so we flush them. }
  1540. end;
  1541. case TextRec(newfile).mode of
  1542. fmOutput, fmInOut, fmAppend :
  1543. flush(newfile);
  1544. end;
  1545. tmphandle:=textrec(newfile).handle;
  1546. textrec(newfile):=textrec(oldfile);
  1547. textrec(newfile).handle:=tmphandle;
  1548. textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
  1549. Dup2:=Dup2(textrec(oldfile).handle,textrec(newfile).handle);
  1550. end;
  1551. Function Dup2(var oldfile,newfile:file):Boolean;
  1552. {
  1553. Copies the filedescriptor oldfile to newfile
  1554. }
  1555. begin
  1556. filerec(newfile):=filerec(oldfile);
  1557. Dup2:=Dup2(filerec(oldfile).handle,filerec(newfile).handle);
  1558. end;
  1559. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
  1560. {
  1561. Select checks whether the file descriptor sets in readfs/writefs/exceptfs
  1562. have changed.
  1563. }
  1564. Var
  1565. Retval : LONGINT;
  1566. begin
  1567. Select:=do_syscall(93,n,readfds,writefds,exceptfds,timeout);
  1568. LinuxError:=Errno;
  1569. end;
  1570. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
  1571. {
  1572. Select checks whether the file descriptor sets in readfs/writefs/exceptfs
  1573. have changed.
  1574. This function allows specification of a timeout as a longint.
  1575. }
  1576. var
  1577. p : PTimeVal;
  1578. tv : TimeVal;
  1579. begin
  1580. if TimeOut=-1 then
  1581. p:=nil
  1582. else
  1583. begin
  1584. tv.Sec:=Timeout div 1000;
  1585. tv.Usec:=(Timeout mod 1000)*1000;
  1586. p:=@tv;
  1587. end;
  1588. Select:=Select(N,Readfds,WriteFds,ExceptFds,p);
  1589. end;
  1590. Function SelectText(var T:Text;TimeOut :PTimeval):Longint;
  1591. Var
  1592. F:FDSet;
  1593. begin
  1594. if textrec(t).mode=fmclosed then
  1595. begin
  1596. LinuxError:=Sys_EBADF;
  1597. exit(-1);
  1598. end;
  1599. FD_Zero(f);
  1600. FD_Set(textrec(T).handle,f);
  1601. if textrec(T).mode=fminput then
  1602. SelectText:=select(textrec(T).handle+1,@f,nil,nil,TimeOut)
  1603. else
  1604. SelectText:=select(textrec(T).handle+1,nil,@f,nil,TimeOut);
  1605. end;
  1606. {******************************************************************************
  1607. Directory
  1608. ******************************************************************************}
  1609. Function OpenDir(F:String):PDir;
  1610. begin
  1611. F:=F+#0;
  1612. OpenDir:=OpenDir(@F[1]);
  1613. end;
  1614. procedure SeekDir(p:pdir;off:longint);
  1615. begin
  1616. if p=nil then
  1617. begin
  1618. errno:=Sys_EBADF;
  1619. exit;
  1620. end;
  1621. p^.nextoff:=Sys_lseek(p^.fd,off,seek_set);
  1622. p^.size:=0;
  1623. p^.loc:=0;
  1624. end;
  1625. function TellDir(p:pdir):longint;
  1626. begin
  1627. if p=nil then
  1628. begin
  1629. errno:=Sys_EBADF;
  1630. telldir:=-1;
  1631. exit;
  1632. end;
  1633. telldir:=Sys_lseek(p^.fd,0,seek_cur)
  1634. { We could try to use the nextoff field here, but on my 1.2.13
  1635. kernel, this gives nothing... This may have to do with
  1636. the readdir implementation of libc... I also didn't find any trace of
  1637. the field in the kernel code itself, So I suspect it is an artifact of libc.
  1638. Michael. }
  1639. end;
  1640. Function ReadDir(P:pdir):pdirent;
  1641. begin
  1642. ReadDir:=Sys_ReadDir(p);
  1643. LinuxError:=Errno;
  1644. end;
  1645. {******************************************************************************
  1646. Pipes/Fifo
  1647. ******************************************************************************}
  1648. Procedure OpenPipe(var F:Text);
  1649. begin
  1650. case textrec(f).mode of
  1651. fmoutput :
  1652. if textrec(f).userdata[1]<>P_OUT then
  1653. textrec(f).mode:=fmclosed;
  1654. fminput :
  1655. if textrec(f).userdata[1]<>P_IN then
  1656. textrec(f).mode:=fmclosed;
  1657. else
  1658. textrec(f).mode:=fmclosed;
  1659. end;
  1660. end;
  1661. Procedure IOPipe(var F:text);
  1662. begin
  1663. case textrec(f).mode of
  1664. fmoutput :
  1665. begin
  1666. { first check if we need something to write, else we may
  1667. get a SigPipe when Close() is called (PFV) }
  1668. if textrec(f).bufpos>0 then
  1669. Sys_write(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufpos);
  1670. end;
  1671. fminput :
  1672. textrec(f).bufend:=Sys_read(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufsize);
  1673. end;
  1674. textrec(f).bufpos:=0;
  1675. end;
  1676. Procedure FlushPipe(var F:Text);
  1677. begin
  1678. if (textrec(f).mode=fmoutput) and (textrec(f).bufpos<>0) then
  1679. IOPipe(f);
  1680. textrec(f).bufpos:=0;
  1681. end;
  1682. Procedure ClosePipe(var F:text);
  1683. begin
  1684. textrec(f).mode:=fmclosed;
  1685. Sys_close(textrec(f).handle);
  1686. end;
  1687. Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
  1688. {
  1689. Sets up a pair of file variables, which act as a pipe. The first one can
  1690. be read from, the second one can be written to.
  1691. If the operation was unsuccesful, linuxerror is set.
  1692. }
  1693. var
  1694. pip : tpipe;
  1695. begin
  1696. do_syscall(42,longint(@pip));
  1697. checkreturnvalue(retval,retval);
  1698. LinuxError:=Errno;
  1699. pipe_in:=pip[1];
  1700. pipe_out:=pip[2];
  1701. AssignPipe:=(LinuxError=0);
  1702. end;
  1703. Function AssignPipe(var pipe_in,pipe_out:text):boolean;
  1704. {
  1705. Sets up a pair of file variables, which act as a pipe. The first one can
  1706. be read from, the second one can be written to.
  1707. If the operation was unsuccesful, linuxerror is set.
  1708. }
  1709. var
  1710. f_in,f_out : longint;
  1711. begin
  1712. if not AssignPipe(f_in,f_out) then
  1713. begin
  1714. AssignPipe:=false;
  1715. exit;
  1716. end;
  1717. { Set up input }
  1718. Assign(Pipe_in,'');
  1719. Textrec(Pipe_in).Handle:=f_in;
  1720. Textrec(Pipe_in).Mode:=fmInput;
  1721. Textrec(Pipe_in).userdata[1]:=P_IN;
  1722. TextRec(Pipe_in).OpenFunc:=@OpenPipe;
  1723. TextRec(Pipe_in).InOutFunc:=@IOPipe;
  1724. TextRec(Pipe_in).FlushFunc:=@FlushPipe;
  1725. TextRec(Pipe_in).CloseFunc:=@ClosePipe;
  1726. { Set up output }
  1727. Assign(Pipe_out,'');
  1728. Textrec(Pipe_out).Handle:=f_out;
  1729. Textrec(Pipe_out).Mode:=fmOutput;
  1730. Textrec(Pipe_out).userdata[1]:=P_OUT;
  1731. TextRec(Pipe_out).OpenFunc:=@OpenPipe;
  1732. TextRec(Pipe_out).InOutFunc:=@IOPipe;
  1733. TextRec(Pipe_out).FlushFunc:=@FlushPipe;
  1734. TextRec(Pipe_out).CloseFunc:=@ClosePipe;
  1735. AssignPipe:=true;
  1736. end;
  1737. Function AssignPipe(var pipe_in,pipe_out:file):boolean;
  1738. {
  1739. Sets up a pair of file variables, which act as a pipe. The first one can
  1740. be read from, the second one can be written to.
  1741. If the operation was unsuccesful, linuxerror is set.
  1742. }
  1743. var
  1744. f_in,f_out : longint;
  1745. begin
  1746. if not AssignPipe(f_in,f_out) then
  1747. begin
  1748. AssignPipe:=false;
  1749. exit;
  1750. end;
  1751. { Set up input }
  1752. Assign(Pipe_in,'');
  1753. Filerec(Pipe_in).Handle:=f_in;
  1754. Filerec(Pipe_in).Mode:=fmInput;
  1755. Filerec(Pipe_in).recsize:=1;
  1756. Filerec(Pipe_in).userdata[1]:=P_IN;
  1757. { Set up output }
  1758. Assign(Pipe_out,'');
  1759. Filerec(Pipe_out).Handle:=f_out;
  1760. Filerec(Pipe_out).Mode:=fmoutput;
  1761. Filerec(Pipe_out).recsize:=1;
  1762. Filerec(Pipe_out).userdata[1]:=P_OUT;
  1763. AssignPipe:=true;
  1764. end;
  1765. Function PClose(Var F:text) :longint;
  1766. var
  1767. pl : ^longint;
  1768. res : longint;
  1769. begin
  1770. do_syscall(6,Textrec(F).Handle);
  1771. { closed our side, Now wait for the other - this appears to be needed ?? }
  1772. pl:=@(textrec(f).userdata[2]);
  1773. waitpid(pl^,@res,0);
  1774. pclose:=res shr 8;
  1775. end;
  1776. Function PClose(Var F:file) : longint;
  1777. var
  1778. pl : ^longint;
  1779. res : longint;
  1780. begin
  1781. do_syscall(6,filerec(F).Handle);
  1782. { closed our side, Now wait for the other - this appears to be needed ?? }
  1783. pl:=@(filerec(f).userdata[2]);
  1784. waitpid(pl^,@res,0);
  1785. pclose:=res shr 8;
  1786. end;
  1787. Procedure PCloseText(Var F:text);
  1788. {
  1789. May not use @PClose due overloading
  1790. }
  1791. begin
  1792. PClose(f);
  1793. end;
  1794. Procedure POpen(var F:text;const Prog:String;rw:char);
  1795. {
  1796. Starts the program in 'Prog' and makes it's input or out put the
  1797. other end of a pipe. If rw is 'w' or 'W', then whatever is written to
  1798. F, will be read from stdin by the program in 'Prog'. The inverse is true
  1799. for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
  1800. read from 'f'.
  1801. }
  1802. var
  1803. pipi,
  1804. pipo : text;
  1805. pid : longint;
  1806. pl : ^longint;
  1807. pp : ppchar;
  1808. begin
  1809. LinuxError:=0;
  1810. rw:=upcase(rw);
  1811. if not (rw in ['R','W']) then
  1812. begin
  1813. LinuxError:=Sys_enoent;
  1814. exit;
  1815. end;
  1816. AssignPipe(pipi,pipo);
  1817. if Linuxerror<>0 then
  1818. exit;
  1819. pid:=fork;
  1820. if linuxerror<>0 then
  1821. begin
  1822. close(pipi);
  1823. close(pipo);
  1824. exit;
  1825. end;
  1826. if pid=0 then
  1827. begin
  1828. { We're in the child }
  1829. if rw='W' then
  1830. begin
  1831. close(pipo);
  1832. dup2(pipi,input);
  1833. close(pipi);
  1834. if linuxerror<>0 then
  1835. halt(127);
  1836. end
  1837. else
  1838. begin
  1839. close(pipi);
  1840. dup2(pipo,output);
  1841. close(pipo);
  1842. if linuxerror<>0 then
  1843. halt(127);
  1844. end;
  1845. pp:=createshellargv(prog);
  1846. Execve(pp^,pp,envp);
  1847. halt(127);
  1848. end
  1849. else
  1850. begin
  1851. { We're in the parent }
  1852. if rw='W' then
  1853. begin
  1854. close(pipi);
  1855. f:=pipo;
  1856. textrec(f).bufptr:=@textrec(f).buffer;
  1857. end
  1858. else
  1859. begin
  1860. close(pipo);
  1861. f:=pipi;
  1862. textrec(f).bufptr:=@textrec(f).buffer;
  1863. end;
  1864. {Save the process ID - needed when closing }
  1865. pl:=@(textrec(f).userdata[2]);
  1866. pl^:=pid;
  1867. textrec(f).closefunc:=@PCloseText;
  1868. end;
  1869. end;
  1870. Procedure POpen(var F:file;const Prog:String;rw:char);
  1871. {
  1872. Starts the program in 'Prog' and makes it's input or out put the
  1873. other end of a pipe. If rw is 'w' or 'W', then whatever is written to
  1874. F, will be read from stdin by the program in 'Prog'. The inverse is true
  1875. for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
  1876. read from 'f'.
  1877. }
  1878. var
  1879. pipi,
  1880. pipo : file;
  1881. pid : longint;
  1882. pl : ^longint;
  1883. p,pp : ppchar;
  1884. temp : string[255];
  1885. begin
  1886. LinuxError:=0;
  1887. rw:=upcase(rw);
  1888. if not (rw in ['R','W']) then
  1889. begin
  1890. LinuxError:=Sys_enoent;
  1891. exit;
  1892. end;
  1893. AssignPipe(pipi,pipo);
  1894. if Linuxerror<>0 then
  1895. exit;
  1896. pid:=fork;
  1897. if linuxerror<>0 then
  1898. begin
  1899. close(pipi);
  1900. close(pipo);
  1901. exit;
  1902. end;
  1903. if pid=0 then
  1904. begin
  1905. { We're in the child }
  1906. if rw='W' then
  1907. begin
  1908. close(pipo);
  1909. dup2(filerec(pipi).handle,stdinputhandle);
  1910. close(pipi);
  1911. if linuxerror<>0 then
  1912. halt(127);
  1913. end
  1914. else
  1915. begin
  1916. close(pipi);
  1917. dup2(filerec(pipo).handle,stdoutputhandle);
  1918. close(pipo);
  1919. if linuxerror<>0 then
  1920. halt(127);
  1921. end;
  1922. getmem(pp,sizeof(pchar)*4);
  1923. temp:='/bin/sh'#0'-c'#0+prog+#0;
  1924. p:=pp;
  1925. p^:=@temp[1];
  1926. inc(p);
  1927. p^:=@temp[9];
  1928. inc(p);
  1929. p^:=@temp[12];
  1930. inc(p);
  1931. p^:=Nil;
  1932. Execve('/bin/sh',pp,envp);
  1933. halt(127);
  1934. end
  1935. else
  1936. begin
  1937. { We're in the parent }
  1938. if rw='W' then
  1939. begin
  1940. close(pipi);
  1941. f:=pipo;
  1942. end
  1943. else
  1944. begin
  1945. close(pipo);
  1946. f:=pipi;
  1947. end;
  1948. {Save the process ID - needed when closing }
  1949. pl:=@(filerec(f).userdata[2]);
  1950. pl^:=pid;
  1951. end;
  1952. end;
  1953. Function mkFifo(pathname:string;mode:longint):boolean;
  1954. var retval : LONGINT;
  1955. begin
  1956. pathname:=pathname+#0;
  1957. mkfifo:=do_syscall(14,longint(@pathname[1]),mode or STAT_IFIFO,0)=0;
  1958. LinuxError:=Errno;
  1959. end;
  1960. Procedure AssignStream(Var StreamIn,Streamout:text;Const Prog:String);
  1961. {
  1962. Starts the program in 'Prog' and makes its input and output the
  1963. other end of two pipes, which are the stdin and stdout of a program
  1964. specified in 'Prog'.
  1965. streamout can be used to write to the program, streamin can be used to read
  1966. the output of the program. See the following diagram :
  1967. Parent Child
  1968. STreamout --> Input
  1969. Streamin <-- Output
  1970. }
  1971. var
  1972. pipi,
  1973. pipo : text;
  1974. pid : longint;
  1975. pl : ^Longint;
  1976. begin
  1977. LinuxError:=0;
  1978. AssignPipe(streamin,pipo);
  1979. if Linuxerror<>0 then
  1980. exit;
  1981. AssignPipe(pipi,streamout);
  1982. if Linuxerror<>0 then
  1983. exit;
  1984. pid:=fork;
  1985. if linuxerror<>0 then
  1986. begin
  1987. close(pipi);
  1988. close(pipo);
  1989. close (streamin);
  1990. close (streamout);
  1991. exit;
  1992. end;
  1993. if pid=0 then
  1994. begin
  1995. { We're in the child }
  1996. { Close what we don't need }
  1997. close(streamout);
  1998. close(streamin);
  1999. dup2(pipi,input);
  2000. if linuxerror<>0 then
  2001. halt(127);
  2002. close(pipi);
  2003. dup2(pipo,output);
  2004. if linuxerror<>0 then
  2005. halt (127);
  2006. close(pipo);
  2007. Execl(Prog);
  2008. halt(127);
  2009. end
  2010. else
  2011. begin
  2012. { we're in the parent}
  2013. close(pipo);
  2014. close(pipi);
  2015. {Save the process ID - needed when closing }
  2016. pl:=@(textrec(StreamIn).userdata[2]);
  2017. pl^:=pid;
  2018. textrec(StreamIn).closefunc:=@PCloseText;
  2019. {Save the process ID - needed when closing }
  2020. pl:=@(textrec(StreamOut).userdata[2]);
  2021. pl^:=pid;
  2022. textrec(StreamOut).closefunc:=@PCloseText;
  2023. end;
  2024. end;
  2025. function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: String): LongInt;
  2026. {
  2027. Starts the program in 'prog' and makes its input, output and error output the
  2028. other end of three pipes, which are the stdin, stdout and stderr of a program
  2029. specified in 'prog'.
  2030. StreamOut can be used to write to the program, StreamIn can be used to read
  2031. the output of the program, StreamErr reads the error output of the program.
  2032. See the following diagram :
  2033. Parent Child
  2034. StreamOut --> StdIn (input)
  2035. StreamIn <-- StdOut (output)
  2036. StreamErr <-- StdErr (error output)
  2037. }
  2038. var
  2039. PipeIn, PipeOut, PipeErr: text;
  2040. pid: LongInt;
  2041. pl: ^LongInt;
  2042. begin
  2043. LinuxError := 0;
  2044. AssignStream := -1;
  2045. // Assign pipes
  2046. AssignPipe(StreamIn, PipeOut);
  2047. if LinuxError <> 0 then exit;
  2048. AssignPipe(StreamErr, PipeErr);
  2049. if LinuxError <> 0 then begin
  2050. Close(StreamIn);
  2051. Close(PipeOut);
  2052. exit;
  2053. end;
  2054. AssignPipe(PipeIn, StreamOut);
  2055. if LinuxError <> 0 then begin
  2056. Close(StreamIn);
  2057. Close(PipeOut);
  2058. Close(StreamErr);
  2059. Close(PipeErr);
  2060. exit;
  2061. end;
  2062. // Fork
  2063. pid := Fork;
  2064. if LinuxError <> 0 then begin
  2065. Close(StreamIn);
  2066. Close(PipeOut);
  2067. Close(StreamErr);
  2068. Close(PipeErr);
  2069. Close(PipeIn);
  2070. Close(StreamOut);
  2071. exit;
  2072. end;
  2073. if pid = 0 then begin
  2074. // *** We are in the child ***
  2075. // Close what we don not need
  2076. Close(StreamOut);
  2077. Close(StreamIn);
  2078. Close(StreamErr);
  2079. // Connect pipes
  2080. dup2(PipeIn, Input);
  2081. if LinuxError <> 0 then Halt(127);
  2082. Close(PipeIn);
  2083. dup2(PipeOut, Output);
  2084. if LinuxError <> 0 then Halt(127);
  2085. Close(PipeOut);
  2086. dup2(PipeErr, StdErr);
  2087. if LinuxError <> 0 then Halt(127);
  2088. Close(PipeErr);
  2089. // Execute program
  2090. Execl(Prog);
  2091. Halt(127);
  2092. end else begin
  2093. // *** We are in the parent ***
  2094. Close(PipeErr);
  2095. Close(PipeOut);
  2096. Close(PipeIn);
  2097. // Save the process ID - needed when closing
  2098. pl := @(TextRec(StreamIn).userdata[2]);
  2099. pl^ := pid;
  2100. TextRec(StreamIn).closefunc := @PCloseText;
  2101. // Save the process ID - needed when closing
  2102. pl := @(TextRec(StreamOut).userdata[2]);
  2103. pl^ := pid;
  2104. TextRec(StreamOut).closefunc := @PCloseText;
  2105. // Save the process ID - needed when closing
  2106. pl := @(TextRec(StreamErr).userdata[2]);
  2107. pl^ := pid;
  2108. TextRec(StreamErr).closefunc := @PCloseText;
  2109. AssignStream := pid;
  2110. end;
  2111. end;
  2112. {******************************************************************************
  2113. General information calls
  2114. ******************************************************************************}
  2115. {
  2116. Function Sysinfo(var Info:TSysinfo):Boolean;
  2117. {
  2118. Get system info
  2119. }
  2120. var
  2121. regs : SysCallregs;
  2122. Begin
  2123. regs.reg2:=longint(@info);
  2124. Sysinfo:=SysCall(SysCall_nr_Sysinfo,regs)=0;
  2125. End;
  2126. }
  2127. {
  2128. Function Uname(var unamerec:utsname):Boolean;
  2129. {
  2130. Get machine's names
  2131. }
  2132. var
  2133. regs : SysCallregs;
  2134. Begin
  2135. regs.reg2:=longint(@unamerec);
  2136. Uname:=SysCall(SysCall_nr_uname,regs)=0;
  2137. LinuxError:=Errno;
  2138. End;
  2139. }
  2140. Function GetEnv(P:string):Pchar;
  2141. {
  2142. Searches the environment for a string with name p and
  2143. returns a pchar to it's value.
  2144. A pchar is used to accomodate for strings of length > 255
  2145. }
  2146. var
  2147. ep : ppchar;
  2148. found : boolean;
  2149. Begin
  2150. p:=p+'='; {Else HOST will also find HOSTNAME, etc}
  2151. ep:=envp;
  2152. found:=false;
  2153. if ep<>nil then
  2154. begin
  2155. while (not found) and (ep^<>nil) do
  2156. begin
  2157. if strlcomp(@p[1],(ep^),length(p))=0 then
  2158. found:=true
  2159. else
  2160. inc(ep);
  2161. end;
  2162. end;
  2163. if found then
  2164. getenv:=ep^+length(p)
  2165. else
  2166. getenv:=nil;
  2167. end;
  2168. {
  2169. Function GetDomainName:String;
  2170. {
  2171. Get machines domain name. Returns empty string if not set.
  2172. }
  2173. Var
  2174. Sysn : utsname;
  2175. begin
  2176. Uname(Sysn);
  2177. linuxerror:=errno;
  2178. If linuxerror<>0 then
  2179. getdomainname:=''
  2180. else
  2181. getdomainname:=strpas(@Sysn.domainname[0]);
  2182. end;
  2183. Function GetHostName:String;
  2184. {
  2185. Get machines name. Returns empty string if not set.
  2186. }
  2187. Var
  2188. Sysn : utsname;
  2189. begin
  2190. uname(Sysn);
  2191. linuxerror:=errno;
  2192. If linuxerror<>0 then
  2193. gethostname:=''
  2194. else
  2195. gethostname:=strpas(@Sysn.nodename[0]);
  2196. end;
  2197. }
  2198. {******************************************************************************
  2199. Signal handling calls
  2200. ******************************************************************************}
  2201. Function Kill(Pid:longint;Sig:integer):integer;
  2202. {
  2203. Send signal 'sig' to a process, or a group of processes.
  2204. If Pid > 0 then the signal is sent to pid
  2205. pid=-1 to all processes except process 1
  2206. pid < -1 to process group -pid
  2207. Return value is zero, except for case three, where the return value
  2208. is the number of processes to which the signal was sent.
  2209. }
  2210. begin
  2211. kill:=do_syscall(37,pid,sig);
  2212. if kill<0 THEN
  2213. Kill:=0;
  2214. LinuxError:=Errno;
  2215. end;
  2216. Procedure SigAction(Signum:Integer;Var Act,OldAct:PSigActionRec );
  2217. {
  2218. Change action of process upon receipt of a signal.
  2219. Signum specifies the signal (all except SigKill and SigStop).
  2220. If Act is non-nil, it is used to specify the new action.
  2221. If OldAct is non-nil the previous action is saved there.
  2222. }
  2223. begin
  2224. do_syscall(46,longint(signum),act,oldact);
  2225. LinuxError:=Errno;
  2226. end;
  2227. Procedure SigProcMask(How:Integer;SSet,OldSSet:PSigSet);
  2228. {
  2229. Change the list of currently blocked signals.
  2230. How determines which signals will be blocked :
  2231. SigBlock : Add SSet to the current list of blocked signals
  2232. SigUnBlock : Remove the signals in SSet from the list of blocked signals.
  2233. SigSetMask : Set the list of blocked signals to SSet
  2234. if OldSSet is non-null, the old set will be saved there.
  2235. }
  2236. begin
  2237. do_syscall(48,longint(how),sset,oldsset);
  2238. checkreturnvalue(retval,retval);
  2239. LinuxError:=Errno;
  2240. end;
  2241. Function SigPending:SigSet;
  2242. {
  2243. Allows examination of pending signals. The signal mask of pending
  2244. signals is set in SSet
  2245. }
  2246. Var
  2247. dummy : Sigset;
  2248. begin
  2249. do_syscall(52,longint(@dummy));
  2250. LinuxError:=Errno;
  2251. sigpending:=dummy;
  2252. end;
  2253. Procedure SigSuspend(Mask:Sigset);
  2254. {
  2255. Set the signal mask with Mask, and suspend the program until a signal
  2256. is received.
  2257. }
  2258. begin
  2259. do_syscall(111,mask);
  2260. LinuxError:=Errno;
  2261. end;
  2262. {
  2263. Function Signal(Signum:Integer;Handler:SignalHandler):SignalHandler;
  2264. {
  2265. Install a new handler for signal Signum.
  2266. The old signal handler is returned.
  2267. This call does, in fact, the same as SigAction.
  2268. }
  2269. begin
  2270. sr.reg2:=signum;
  2271. sr.reg3:=longint(handler);
  2272. Linuxerror:=SysCall(Syscall_nr_signal,sr);
  2273. If linuxerror=Sig_Err then
  2274. begin
  2275. Signal:=nil;
  2276. Linuxerror:=errno;
  2277. end
  2278. else
  2279. begin
  2280. Signal:=signalhandler(Linuxerror);
  2281. linuxerror:=0;
  2282. end;
  2283. end;
  2284. }
  2285. procedure SigRaise(sig:integer);
  2286. begin
  2287. Kill(GetPid,Sig);
  2288. end;
  2289. {
  2290. Function Alarm(Sec : Longint) : longint;
  2291. Var Sr : Syscallregs;
  2292. begin
  2293. sr.reg2:=Sec;
  2294. Alarm:=Syscall(syscall_nr_alarm,sr);
  2295. end;
  2296. Procedure Pause;
  2297. Var Sr : Syscallregs;
  2298. begin
  2299. syscall(syscall_nr_pause,sr);
  2300. end;
  2301. }
  2302. {******************************************************************************
  2303. IOCtl and Termios calls
  2304. ******************************************************************************}
  2305. Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
  2306. {
  2307. Interface to Unix ioctl call.
  2308. Performs various operations on the filedescriptor Handle.
  2309. Ndx describes the operation to perform.
  2310. Data points to data needed for the Ndx function. The structure of this
  2311. data is function-dependent.
  2312. }
  2313. begin
  2314. IOCtl:=Do_Syscall(54,handle,ndx,data);
  2315. LinuxError:=Errno;
  2316. end;
  2317. Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
  2318. begin
  2319. TCGetAttr:=IOCtl(fd,TCGETS,@tios);
  2320. end;
  2321. Function TCSetAttr(fd:longint;OptAct:longint;var tios:TermIOS):boolean;
  2322. var
  2323. nr:longint;
  2324. begin
  2325. case OptAct of
  2326. TCSANOW : nr:=TCSETS;
  2327. TCSADRAIN : nr:=TCSETSW;
  2328. TCSAFLUSH : nr:=TCSETSF;
  2329. else
  2330. begin
  2331. ErrNo:=Sys_EINVAL;
  2332. TCSetAttr:=false;
  2333. exit;
  2334. end;
  2335. end;
  2336. TCSetAttr:=IOCtl(fd,nr,@Tios);
  2337. end;
  2338. Procedure CFSetISpeed(var tios:TermIOS;speed:Longint);
  2339. begin
  2340. tios.c_cflag:=(tios.c_cflag and (not CBAUD)) or speed;
  2341. end;
  2342. Procedure CFSetOSpeed(var tios:TermIOS;speed:Longint);
  2343. begin
  2344. CFSetISpeed(tios,speed);
  2345. end;
  2346. Procedure CFMakeRaw(var tios:TermIOS);
  2347. begin
  2348. with tios do
  2349. begin
  2350. c_iflag:=c_iflag and (not (IGNBRK or BRKINT or PARMRK or ISTRIP or
  2351. INLCR or IGNCR or ICRNL or IXON));
  2352. c_oflag:=c_oflag and (not OPOST);
  2353. c_lflag:=c_lflag and (not (ECHO or ECHONL or ICANON or ISIG or IEXTEN));
  2354. c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or CS8;
  2355. end;
  2356. end;
  2357. Function TCSendBreak(fd,duration:longint):boolean;
  2358. begin
  2359. TCSendBreak:=IOCtl(fd,TCSBRK,pointer(duration));
  2360. end;
  2361. Function TCSetPGrp(fd,id:longint):boolean;
  2362. begin
  2363. TCSetPGrp:=IOCtl(fd,TIOCSPGRP,pointer(id));
  2364. end;
  2365. Function TCGetPGrp(fd:longint;var id:longint):boolean;
  2366. begin
  2367. TCGetPGrp:=IOCtl(fd,TIOCGPGRP,@id);
  2368. end;
  2369. Function TCDrain(fd:longint):boolean;
  2370. begin
  2371. TCDrain:=IOCtl(fd,TCSBRK,pointer(1));
  2372. end;
  2373. Function TCFlow(fd,act:longint):boolean;
  2374. begin
  2375. TCFlow:=IOCtl(fd,TCXONC,pointer(act));
  2376. end;
  2377. Function TCFlush(fd,qsel:longint):boolean;
  2378. begin
  2379. TCFlush:=IOCtl(fd,TCFLSH,pointer(qsel));
  2380. end;
  2381. Function IsATTY(Handle:Longint):Boolean;
  2382. {
  2383. Check if the filehandle described by 'handle' is a TTY (Terminal)
  2384. }
  2385. var
  2386. t : Termios;
  2387. begin
  2388. IsAtty:=TCGetAttr(Handle,t);
  2389. end;
  2390. Function IsATTY(f: text):Boolean;
  2391. {
  2392. Idem as previous, only now for text variables.
  2393. }
  2394. begin
  2395. IsATTY:=IsaTTY(textrec(f).handle);
  2396. end;
  2397. function TTYName(Handle:Longint):string;
  2398. {
  2399. Return the name of the current tty described by handle f.
  2400. returns empty string in case of an error.
  2401. }
  2402. Const
  2403. dev='/dev';
  2404. var
  2405. name : string;
  2406. st : stat;
  2407. mydev,
  2408. myino : longint;
  2409. dirstream : pdir;
  2410. d : pdirent;
  2411. begin
  2412. TTYName:='';
  2413. fstat(handle,st);
  2414. if (errno<>0) and isatty (handle) then
  2415. exit;
  2416. mydev:=st.dev;
  2417. myino:=st.ino;
  2418. dirstream:=opendir(dev);
  2419. if (linuxerror<>0) then
  2420. exit;
  2421. d:=Readdir(dirstream);
  2422. while (d<>nil) do
  2423. begin
  2424. if (d^.ino=myino) then
  2425. begin
  2426. name:=dev+'/'+strpas(@(d^.name));
  2427. fstat(name,st);
  2428. if (linuxerror=0) and (st.dev=mydev) then
  2429. begin
  2430. closedir(dirstream);
  2431. ttyname:=name;
  2432. exit;
  2433. end;
  2434. end;
  2435. d:=Readdir(dirstream);
  2436. end;
  2437. closedir(dirstream);
  2438. end;
  2439. function TTYName(var F:Text):string;
  2440. {
  2441. Idem as previous, only now for text variables;
  2442. }
  2443. begin
  2444. TTYName:=TTYName(textrec(f).handle);
  2445. end;
  2446. {******************************************************************************
  2447. Utility calls
  2448. ******************************************************************************}
  2449. Function Octal(l:longint):longint;
  2450. {
  2451. Convert an octal specified number to decimal;
  2452. }
  2453. var
  2454. octnr,
  2455. oct : longint;
  2456. begin
  2457. octnr:=0;
  2458. oct:=0;
  2459. while (l>0) do
  2460. begin
  2461. oct:=oct or ((l mod 10) shl octnr);
  2462. l:=l div 10;
  2463. inc(octnr,3);
  2464. end;
  2465. Octal:=oct;
  2466. end;
  2467. Function StringToPPChar(Var S:STring):ppchar;
  2468. {
  2469. Create a PPChar to structure of pchars which are the arguments specified
  2470. in the string S. Especially usefull for creating an ArgV for Exec-calls
  2471. }
  2472. var
  2473. nr : longint;
  2474. Buf : ^char;
  2475. p : ppchar;
  2476. begin
  2477. s:=s+#0;
  2478. buf:=@s[1];
  2479. nr:=0;
  2480. while(buf^<>#0) do
  2481. begin
  2482. while (buf^ in [' ',#8,#10]) do
  2483. inc(buf);
  2484. inc(nr);
  2485. while not (buf^ in [' ',#0,#8,#10]) do
  2486. inc(buf);
  2487. end;
  2488. getmem(p,nr*4);
  2489. StringToPPChar:=p;
  2490. if p=nil then
  2491. begin
  2492. LinuxError:=sys_enomem;
  2493. exit;
  2494. end;
  2495. buf:=@s[1];
  2496. while (buf^<>#0) do
  2497. begin
  2498. while (buf^ in [' ',#8,#10]) do
  2499. begin
  2500. buf^:=#0;
  2501. inc(buf);
  2502. end;
  2503. p^:=buf;
  2504. inc(p);
  2505. p^:=nil;
  2506. while not (buf^ in [' ',#0,#8,#10]) do
  2507. inc(buf);
  2508. end;
  2509. end;
  2510. Function FExpand(Const Path:PathStr):PathStr;
  2511. var
  2512. temp : pathstr;
  2513. i,j : longint;
  2514. p : pchar;
  2515. Begin
  2516. {Remove eventual drive - doesn't exist in Linux}
  2517. if path[2]=':' then
  2518. i:=3
  2519. else
  2520. i:=1;
  2521. temp:='';
  2522. {Replace ~/ with $HOME}
  2523. if (path[i]='~') and ((i+1>length(path)) or (path[i+1]='/')) then
  2524. begin
  2525. p:=getenv('HOME');
  2526. if not (p=nil) then
  2527. Insert(StrPas(p),temp,i);
  2528. i:=1;
  2529. temp:=temp+Copy(Path,2,255);
  2530. end;
  2531. {Do we have an absolute path ? No - prefix the current dir}
  2532. if temp='' then
  2533. begin
  2534. if path[i]<>'/' then
  2535. begin
  2536. {$I-}
  2537. getdir(0,temp);
  2538. {$I+}
  2539. if ioresult<>0 then;
  2540. end
  2541. else
  2542. inc(i);
  2543. temp:=temp+'/'+copy(path,i,length(path)-i+1)+'/';
  2544. end;
  2545. {First remove all references to '/./'}
  2546. while pos('/./',temp)<>0 do
  2547. delete(temp,pos('/./',temp),2);
  2548. {Now remove also all references to '/../' + of course previous dirs..}
  2549. repeat
  2550. i:=pos('/../',temp);
  2551. {Find the pos of the previous dir}
  2552. if i>1 then
  2553. begin
  2554. j:=i-1;
  2555. while (j>1) and (temp[j]<>'/') do
  2556. dec (j);{temp[1] is always '/'}
  2557. delete(temp,j,i-j+3);
  2558. end
  2559. else
  2560. if i=1 then {i=1, so we have temp='/../something', just delete '/../'}
  2561. delete(temp,1,3);
  2562. until i=0;
  2563. { Remove ending /.. }
  2564. i:=pos('/..',temp);
  2565. if (i<>0) and (i =length(temp)-2) then
  2566. begin
  2567. j:=i-1;
  2568. while (j>1) and (temp[j]<>'/') do
  2569. dec (j);
  2570. delete (temp,j,i-j+3);
  2571. end;
  2572. { if last character is / then remove it - dir is also a file :-) }
  2573. if (length(temp)>0) and (temp[length(temp)]='/') then
  2574. dec(byte(temp[0]));
  2575. fexpand:=temp;
  2576. End;
  2577. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  2578. {
  2579. Searches for a file 'path' in the list of direcories in 'dirlist'.
  2580. returns an empty string if not found. Wildcards are NOT allowed.
  2581. If dirlist is empty, it is set to '.'
  2582. }
  2583. Var
  2584. NewDir : PathStr;
  2585. p1 : Longint;
  2586. Info : Stat;
  2587. Begin
  2588. {Replace ':' with ';'}
  2589. for p1:=1to length(dirlist) do
  2590. if dirlist[p1]=':' then
  2591. dirlist[p1]:=';';
  2592. {Check for WildCards}
  2593. If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
  2594. FSearch:='' {No wildcards allowed in these things.}
  2595. Else
  2596. Begin
  2597. Dirlist:='.;'+dirlist;{Make sure current dir is first to be searched.}
  2598. Repeat
  2599. p1:=Pos(';',DirList);
  2600. If p1=0 Then
  2601. p1:=255;
  2602. NewDir:=Copy(DirList,1,P1 - 1);
  2603. if NewDir[Length(NewDir)]<>'/' then
  2604. NewDir:=NewDir+'/';
  2605. NewDir:=NewDir+Path;
  2606. Delete(DirList,1,p1);
  2607. if FStat(NewDir,Info) then
  2608. Begin
  2609. If Pos('./',NewDir)=1 Then
  2610. Delete(NewDir,1,2);
  2611. {DOS strips off an initial .\}
  2612. End
  2613. Else
  2614. NewDir:='';
  2615. Until (DirList='') or (Length(NewDir) > 0);
  2616. FSearch:=NewDir;
  2617. End;
  2618. End;
  2619. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  2620. Var
  2621. DotPos,SlashPos,i : longint;
  2622. Begin
  2623. SlashPos:=0;
  2624. DotPos:=256;
  2625. i:=Length(Path);
  2626. While (i>0) and (SlashPos=0) Do
  2627. Begin
  2628. If (DotPos=256) and (Path[i]='.') Then
  2629. DotPos:=i;
  2630. If (Path[i]='/') Then
  2631. SlashPos:=i;
  2632. Dec(i);
  2633. End;
  2634. Ext:=Copy(Path,DotPos,255);
  2635. Dir:=Copy(Path,1,SlashPos);
  2636. Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
  2637. End;
  2638. Function Dirname(Const path:pathstr):pathstr;
  2639. {
  2640. This function returns the directory part of a complete path.
  2641. Unless the directory is root '/', The last character is not
  2642. a slash.
  2643. }
  2644. var
  2645. Dir : PathStr;
  2646. Name : NameStr;
  2647. Ext : ExtStr;
  2648. begin
  2649. FSplit(Path,Dir,Name,Ext);
  2650. if length(Dir)>1 then
  2651. Delete(Dir,length(Dir),1);
  2652. DirName:=Dir;
  2653. end;
  2654. Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
  2655. {
  2656. This function returns the filename part of a complete path. If suf is
  2657. supplied, it is cut off the filename.
  2658. }
  2659. var
  2660. Dir : PathStr;
  2661. Name : NameStr;
  2662. Ext : ExtStr;
  2663. begin
  2664. FSplit(Path,Dir,Name,Ext);
  2665. if Suf<>Ext then
  2666. Name:=Name+Ext;
  2667. BaseName:=Name;
  2668. end;
  2669. Function FNMatch(const Pattern,Name:string):Boolean;
  2670. Var
  2671. LenPat,LenName : longint;
  2672. Function DoFNMatch(i,j:longint):Boolean;
  2673. Var
  2674. Found : boolean;
  2675. Begin
  2676. Found:=true;
  2677. While Found and (i<=LenPat) Do
  2678. Begin
  2679. Case Pattern[i] of
  2680. '?' : Found:=(j<=LenName);
  2681. '*' : Begin
  2682. {find the next character in pattern, different of ? and *}
  2683. while Found and (i<LenPat) do
  2684. begin
  2685. inc(i);
  2686. case Pattern[i] of
  2687. '*' : ;
  2688. '?' : begin
  2689. inc(j);
  2690. Found:=(j<=LenName);
  2691. end;
  2692. else
  2693. Found:=false;
  2694. end;
  2695. end;
  2696. {Now, find in name the character which i points to, if the * or ?
  2697. wasn't the last character in the pattern, else, use up all the
  2698. chars in name}
  2699. Found:=true;
  2700. if (i<=LenPat) then
  2701. begin
  2702. repeat
  2703. {find a letter (not only first !) which maches pattern[i]}
  2704. while (j<=LenName) and (name[j]<>pattern[i]) do
  2705. inc (j);
  2706. if (j<LenName) then
  2707. begin
  2708. if DoFnMatch(i+1,j+1) then
  2709. begin
  2710. i:=LenPat;
  2711. j:=LenName;{we can stop}
  2712. Found:=true;
  2713. end
  2714. else
  2715. inc(j);{We didn't find one, need to look further}
  2716. end;
  2717. until (j>=LenName);
  2718. end
  2719. else
  2720. j:=LenName;{we can stop}
  2721. end;
  2722. else {not a wildcard character in pattern}
  2723. Found:=(j<=LenName) and (pattern[i]=name[j]);
  2724. end;
  2725. inc(i);
  2726. inc(j);
  2727. end;
  2728. DoFnMatch:=Found and (j>LenName);
  2729. end;
  2730. Begin {start FNMatch}
  2731. LenPat:=Length(Pattern);
  2732. LenName:=Length(Name);
  2733. FNMatch:=DoFNMatch(1,1);
  2734. End;
  2735. Procedure Globfree(var p : pglob);
  2736. {
  2737. Release memory occupied by pglob structure, and names in it.
  2738. sets p to nil.
  2739. }
  2740. var
  2741. temp : pglob;
  2742. begin
  2743. while p<>nil do
  2744. begin
  2745. temp:=p^.next;
  2746. if p^.name<>nil then
  2747. freemem(p^.name,strlen(p^.name)+1);
  2748. dispose(p);
  2749. p:=temp;
  2750. end;
  2751. end;
  2752. Function Glob(Const path:pathstr):pglob;
  2753. {
  2754. Fills a tglob structure with entries matching path,
  2755. and returns a pointer to it. Returns nil on error,
  2756. linuxerror is set accordingly.
  2757. }
  2758. var
  2759. temp : string[255];
  2760. thedir : pdir;
  2761. buffer : pdirent;
  2762. root,run : pglob;
  2763. begin
  2764. { Get directory }
  2765. if dirname(path)='' then
  2766. temp:='.'
  2767. else
  2768. temp:=dirname(path);
  2769. temp:=temp+#0;
  2770. thedir:=opendir(@temp[1]);
  2771. if thedir=nil then
  2772. begin
  2773. glob:=nil;
  2774. linuxerror:=errno;
  2775. exit;
  2776. end;
  2777. temp:=basename(path,'');{ get the pattern }
  2778. if thedir^.fd<0 then
  2779. begin
  2780. linuxerror:=errno;
  2781. glob:=nil;
  2782. exit;
  2783. end;
  2784. {get the entries}
  2785. new(root);
  2786. root^.next:=nil;
  2787. root^.name:=nil;
  2788. run:=root;
  2789. repeat
  2790. buffer:=Sys_readdir(thedir);
  2791. if buffer<>nil then
  2792. begin
  2793. if fnmatch(temp,strpas(@(buffer^.name[0]))) then
  2794. begin
  2795. { get memory for pglob }
  2796. new(run^.next);
  2797. if run^.next=nil then
  2798. begin
  2799. linuxerror:=Sys_ENOMEM;
  2800. globfree(root);
  2801. glob:=nil;
  2802. exit;
  2803. end
  2804. else
  2805. begin
  2806. run:=run^.next;
  2807. run^.next:=nil;
  2808. end;
  2809. { Get memory for name }
  2810. getmem(run^.name,strlen(@(buffer^.name[0]))+1);
  2811. if run^.name=nil then
  2812. begin
  2813. linuxerror:=Sys_ENOMEM;
  2814. globfree(root);
  2815. glob:=nil;
  2816. exit;
  2817. end;
  2818. move(buffer^.name[0],run^.name^,strlen(@(buffer^.name[0]))+1);
  2819. end;{ if fnmatch }
  2820. end { buffer <> nil }
  2821. else
  2822. begin
  2823. run:=root;
  2824. if root^.next<>nil then
  2825. root:=root^.next;{ put root on first entry}
  2826. if run<>nil then
  2827. begin
  2828. run^.next:=nil;
  2829. globfree(run);
  2830. end;
  2831. end;
  2832. until buffer=nil;
  2833. if root^.name=nil then
  2834. begin
  2835. dispose(root);
  2836. linuxerror:=0;
  2837. glob:=nil;
  2838. end
  2839. else
  2840. glob:=root;
  2841. end;
  2842. {--------------------------------
  2843. FiledescriptorSets
  2844. --------------------------------}
  2845. Procedure FD_Zero(var fds:fdSet);
  2846. {
  2847. Clear the set of filedescriptors
  2848. }
  2849. begin
  2850. FillChar(fds,sizeof(fdSet),0);
  2851. end;
  2852. Procedure FD_Clr(fd:longint;var fds:fdSet);
  2853. {
  2854. Remove fd from the set of filedescriptors
  2855. }
  2856. begin
  2857. fds[fd shr 5]:=fds[fd shr 5] and (not (1 shl (fd and 31)));
  2858. end;
  2859. Procedure FD_Set(fd:longint;var fds:fdSet);
  2860. {
  2861. Add fd to the set of filedescriptors
  2862. }
  2863. begin
  2864. fds[fd shr 5]:=fds[fd shr 5] or (1 shl (fd and 31));
  2865. end;
  2866. Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
  2867. {
  2868. Test if fd is part of the set of filedescriptors
  2869. }
  2870. begin
  2871. FD_IsSet:=((fds[fd shr 5] and (1 shl (fd and 31)))<>0);
  2872. end;
  2873. Function GetFS (var T:Text):longint;
  2874. {
  2875. Get File Descriptor of a text file.
  2876. }
  2877. begin
  2878. if textrec(t).mode=fmclosed then
  2879. exit(-1)
  2880. else
  2881. GETFS:=textrec(t).Handle
  2882. end;
  2883. Function GetFS(Var F:File):longint;
  2884. {
  2885. Get File Descriptor of an unTyped file.
  2886. }
  2887. begin
  2888. { Handle and mode are on the same place in textrec and filerec. }
  2889. if filerec(f).mode=fmclosed then
  2890. exit(-1)
  2891. else
  2892. GETFS:=filerec(f).Handle
  2893. end;
  2894. {--------------------------------
  2895. Stat.Mode Macro's
  2896. --------------------------------}
  2897. Function S_ISLNK(m:word):boolean;
  2898. {
  2899. Check mode field of inode for link.
  2900. }
  2901. begin
  2902. S_ISLNK:=(m and STAT_IFMT)=STAT_IFLNK;
  2903. end;
  2904. Function S_ISREG(m:word):boolean;
  2905. {
  2906. Check mode field of inode for regular file.
  2907. }
  2908. begin
  2909. S_ISREG:=(m and STAT_IFMT)=STAT_IFREG;
  2910. end;
  2911. Function S_ISDIR(m:word):boolean;
  2912. {
  2913. Check mode field of inode for directory.
  2914. }
  2915. begin
  2916. S_ISDIR:=(m and STAT_IFMT)=STAT_IFDIR;
  2917. end;
  2918. Function S_ISCHR(m:word):boolean;
  2919. {
  2920. Check mode field of inode for character device.
  2921. }
  2922. begin
  2923. S_ISCHR:=(m and STAT_IFMT)=STAT_IFCHR;
  2924. end;
  2925. Function S_ISBLK(m:word):boolean;
  2926. {
  2927. Check mode field of inode for block device.
  2928. }
  2929. begin
  2930. S_ISBLK:=(m and STAT_IFMT)=STAT_IFBLK;
  2931. end;
  2932. Function S_ISFIFO(m:word):boolean;
  2933. {
  2934. Check mode field of inode for named pipe (FIFO).
  2935. }
  2936. begin
  2937. S_ISFIFO:=(m and STAT_IFMT)=STAT_IFIFO;
  2938. end;
  2939. Function S_ISSOCK(m:word):boolean;
  2940. {
  2941. Check mode field of inode for socket.
  2942. }
  2943. begin
  2944. S_ISSOCK:=(m and STAT_IFMT)=STAT_IFSOCK;
  2945. end;
  2946. {--------------------------------
  2947. Memory functions
  2948. --------------------------------}
  2949. function MMap(const m:tmmapargs):longint;
  2950. begin
  2951. {Last argument (offset) is actually 64-bit under BSD. Therefore extra 0}
  2952. do_syscall(197,m.address,m.size,m.prot,m.flags,m.fd,m.offset,0);
  2953. LinuxError:=Errno;
  2954. end;
  2955. {--------------------------------
  2956. Port IO functions
  2957. --------------------------------}
  2958. {
  2959. Function IOperm (From,Num : Cardinal; Value : Longint) : boolean;
  2960. {
  2961. Set permissions on NUM ports starting with port FROM to VALUE
  2962. this works ONLY as root.
  2963. }
  2964. Var
  2965. Sr : Syscallregs;
  2966. begin
  2967. Sr.Reg2:=From;
  2968. Sr.Reg3:=Num;
  2969. Sr.Reg4:=Value;
  2970. IOPerm:=Syscall(Syscall_nr_ioperm,sr)=0;
  2971. LinuxError:=Errno;
  2972. end;
  2973. }
  2974. {$IFDEF I386}
  2975. {$asmmode direct}
  2976. Procedure WritePort (Port : Longint; Value : Byte);
  2977. {
  2978. Writes 'Value' to port 'Port'
  2979. }
  2980. begin
  2981. asm
  2982. movl 8(%ebp),%edx
  2983. movb 12(%ebp),%al
  2984. outb %al,%dx
  2985. end ['EAX','EDX'];
  2986. end;
  2987. Procedure WritePort (Port : Longint; Value : Word);
  2988. {
  2989. Writes 'Value' to port 'Port'
  2990. }
  2991. begin
  2992. asm
  2993. movl 8(%ebp),%edx
  2994. movw 12(%ebp),%ax
  2995. outw %ax,%dx
  2996. end ['EAX','EDX'];
  2997. end;
  2998. Procedure WritePort (Port : Longint; Value : Longint);
  2999. {
  3000. Writes 'Value' to port 'Port'
  3001. }
  3002. begin
  3003. asm
  3004. movl 8(%ebp),%edx
  3005. movl 12(%ebp),%eax
  3006. outl %eax,%dx
  3007. end ['EAX','EDX'];
  3008. end;
  3009. Procedure WritePortl (Port : Longint; Var Buf; Count: longint);
  3010. {
  3011. Writes 'Count' longints from 'Buf' to Port
  3012. }
  3013. begin
  3014. asm
  3015. movl 16(%ebp),%ecx
  3016. movl 12(%ebp),%esi
  3017. movl 8(%ebp),%edx
  3018. cld
  3019. rep
  3020. outsl
  3021. end ['ECX','ESI','EDX'];
  3022. end;
  3023. Procedure WritePortW (Port : Longint; Var Buf; Count: longint);
  3024. {
  3025. Writes 'Count' words from 'Buf' to Port
  3026. }
  3027. begin
  3028. asm
  3029. movl 16(%ebp),%ecx
  3030. movl 12(%ebp),%esi
  3031. movl 8(%ebp),%edx
  3032. cld
  3033. rep
  3034. outsw
  3035. end ['ECX','ESI','EDX'];
  3036. end;
  3037. Procedure WritePortB (Port : Longint; Var Buf; Count: longint);
  3038. {
  3039. Writes 'Count' bytes from 'Buf' to Port
  3040. }
  3041. begin
  3042. asm
  3043. movl 16(%ebp),%ecx
  3044. movl 12(%ebp),%esi
  3045. movl 8(%ebp),%edx
  3046. cld
  3047. rep
  3048. outsb
  3049. end ['ECX','ESI','EDX'];
  3050. end;
  3051. Procedure ReadPort (Port : Longint; Var Value : Byte);
  3052. {
  3053. Reads 'Value' from port 'Port'
  3054. }
  3055. begin
  3056. asm
  3057. movl 8(%ebp),%edx
  3058. inb %dx,%al
  3059. andl $255,%eax
  3060. movl %eax,12(%ebp)
  3061. end ['EAX','EDX'];
  3062. end;
  3063. Procedure ReadPort (Port : Longint; Var Value : Word);
  3064. {
  3065. Reads 'Value' from port 'Port'
  3066. }
  3067. begin
  3068. asm
  3069. movl 8(%ebp),%edx
  3070. inw %dx,%ax
  3071. andl $65535,%eax
  3072. movl %eax,12(%ebp)
  3073. end ['EAX','EDX'];
  3074. end;
  3075. Procedure ReadPort (Port : Longint; Var Value : Longint);
  3076. {
  3077. Reads 'Value' from port 'Port'
  3078. }
  3079. begin
  3080. asm
  3081. movl 8(%ebp),%edx
  3082. inl %dx,%eax
  3083. movl %eax,12(%ebp)
  3084. end ['EAX','EDX'];
  3085. end;
  3086. Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);
  3087. {
  3088. Reads 'Count' longints from port 'Port' to 'Buf'.
  3089. }
  3090. begin
  3091. asm
  3092. movl 16(%ebp),%ecx
  3093. movl 12(%ebp),%edi
  3094. movl 8(%ebp),%edx
  3095. cld
  3096. rep
  3097. insl
  3098. end ['ECX','EDI','EDX'];
  3099. end;
  3100. Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);
  3101. {
  3102. Reads 'Count' words from port 'Port' to 'Buf'.
  3103. }
  3104. begin
  3105. asm
  3106. movl 16(%ebp),%ecx
  3107. movl 12(%ebp),%edi
  3108. movl 8(%ebp),%edx
  3109. cld
  3110. rep
  3111. insw
  3112. end ['ECX','EDI','EDX'];
  3113. end;
  3114. Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);
  3115. {
  3116. Reads 'Count' bytes from port 'Port' to 'Buf'.
  3117. }
  3118. begin
  3119. asm
  3120. movl 16(%ebp),%ecx
  3121. movl 12(%ebp),%edi
  3122. movl 8(%ebp),%edx
  3123. cld
  3124. rep
  3125. insb
  3126. end ['ECX','EDI','EDX'];
  3127. end;
  3128. {$ENDIF}
  3129. Initialization
  3130. InitLocalTime;
  3131. finalization
  3132. DoneLocalTime;
  3133. End.
  3134. {
  3135. $Log$
  3136. Revision 1.5 2000-03-01 20:04:38 marco
  3137. * some small fixes.
  3138. Revision 1.4 2000/03/01 17:27:46 marco
  3139. * Fixed first half of linux unit to portable syscall struct.
  3140. Revision 1.3 2000/02/04 16:53:26 marco
  3141. * Finished Linux (and rest syscalls) roughly. Some things still need to be
  3142. tested, and checked (off_t calls specially)
  3143. Revision 1.2 2000/02/04 12:05:04 marco
  3144. * a few functions added.
  3145. Revision 1.1 2000/02/03 17:03:36 marco
  3146. * initial version. Ported till line +/- 2000
  3147. }