oldlinux.pp 139 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2000 by Michael Van Canneyt,
  4. BSD parts (c) 2000 by Marco van de Voort
  5. members 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 oldlinux;
  13. Interface
  14. Const
  15. { Things for LSEEK call }
  16. Seek_set = 0;
  17. Seek_Cur = 1;
  18. Seek_End = 2;
  19. { Things for OPEN call - after linux/fcntl.h }
  20. Open_Accmode = 3;
  21. Open_RdOnly = 0;
  22. Open_WrOnly = 1;
  23. Open_RdWr = 2;
  24. Open_Creat = 1 shl 6;
  25. Open_Excl = 2 shl 6;
  26. Open_NoCtty = 4 shl 6;
  27. Open_Trunc = 1 shl 9;
  28. Open_Append = 2 shl 9;
  29. Open_NonBlock = 4 shl 9;
  30. Open_NDelay = Open_NonBlock;
  31. Open_Sync = 1 shl 12;
  32. Open_Direct = 4 shl 12;
  33. Open_LargeFile = 1 shl 15;
  34. Open_Directory = 2 shl 15;
  35. Open_NoFollow = 4 shl 15;
  36. { The waitpid uses the following options:}
  37. Wait_NoHang = 1;
  38. Wait_UnTraced = 2;
  39. Wait_Any = -1;
  40. Wait_MyPGRP = 0;
  41. Wait_Clone = $80000000;
  42. { Constants to check stat.mode }
  43. STAT_IFMT = $f000; {00170000}
  44. STAT_IFSOCK = $c000; {0140000}
  45. STAT_IFLNK = $a000; {0120000}
  46. STAT_IFREG = $8000; {0100000}
  47. STAT_IFBLK = $6000; {0060000}
  48. STAT_IFDIR = $4000; {0040000}
  49. STAT_IFCHR = $2000; {0020000}
  50. STAT_IFIFO = $1000; {0010000}
  51. STAT_ISUID = $0800; {0004000}
  52. STAT_ISGID = $0400; {0002000}
  53. STAT_ISVTX = $0200; {0001000}
  54. { Constants to check permissions }
  55. STAT_IRWXO = $7;
  56. STAT_IROTH = $4;
  57. STAT_IWOTH = $2;
  58. STAT_IXOTH = $1;
  59. STAT_IRWXG = STAT_IRWXO shl 3;
  60. STAT_IRGRP = STAT_IROTH shl 3;
  61. STAT_IWGRP = STAT_IWOTH shl 3;
  62. STAT_IXGRP = STAT_IXOTH shl 3;
  63. STAT_IRWXU = STAT_IRWXO shl 6;
  64. STAT_IRUSR = STAT_IROTH shl 6;
  65. STAT_IWUSR = STAT_IWOTH shl 6;
  66. STAT_IXUSR = STAT_IXOTH shl 6;
  67. { Constants to test the type of filesystem }
  68. fs_old_ext2 = $ef51;
  69. fs_ext2 = $ef53;
  70. fs_ext = $137d;
  71. fs_iso = $9660;
  72. fs_minix = $137f;
  73. fs_minix_30 = $138f;
  74. fs_minux_V2 = $2468;
  75. fs_msdos = $4d44;
  76. fs_nfs = $6969;
  77. fs_proc = $9fa0;
  78. fs_xia = $012FD16D;
  79. { Constansts for MMAP }
  80. MAP_PRIVATE =2;
  81. MAP_ANONYMOUS =$20;
  82. {Constansts Termios/Ioctl (used in Do_IsDevice) }
  83. IOCtl_TCGETS=$5401; // TCGETS is also in termios.inc, but the sysunix needs only this
  84. type
  85. {
  86. Linux system calls take arguments as follows :
  87. cpui386/m68k:
  88. %eax/%d0 : System call number
  89. %ebx/%d1 : first argument
  90. %ecx/%d2 : second argument
  91. %edx/%d3 : third argumens
  92. %esi/%d3 : fourth argument
  93. %edi/%d4 : fifth argument
  94. That is why we define a special type, with only these arguments
  95. To make it processor independent, we don't give any system dependent
  96. names, but the rather abstract reg1,reg2 etc;
  97. }
  98. SysCallRegs=record
  99. reg1,reg2,reg3,reg4,reg5,reg6 : longint;
  100. end;
  101. PSysCallRegs=^SysCallRegs;
  102. TSysCallRegs=SysCallRegs;
  103. { The following are records for system calls }
  104. dirent = packed record
  105. ino,
  106. off : longint;
  107. reclen : word;
  108. name : array [0..255] of char;
  109. end;
  110. pdirent =^dirent;
  111. TDirEnt = dirent;
  112. TDir = packed record
  113. fd : integer;
  114. loc : longint;
  115. size : integer;
  116. buf : pdirent;
  117. {The following are used in libc, but NOT in the linux kernel sources ??}
  118. nextoff: longint;
  119. dd_max : integer; {size of buf. Irrelevant, as buf is of type dirent}
  120. lock : pointer;
  121. end;
  122. PDir =^TDir;
  123. dev_t = word;
  124. Stat = packed record
  125. dev : dev_t;
  126. pad1 : word;
  127. ino : longint;
  128. mode,
  129. nlink,
  130. uid,
  131. gid : word;
  132. rdev : dev_t;
  133. pad2 : word;
  134. size,
  135. blksize,
  136. blocks,
  137. atime,
  138. unused1,
  139. mtime,
  140. unused2,
  141. ctime,
  142. unused3,
  143. unused4,
  144. unused5 : longint;
  145. end;
  146. PStat=^Stat;
  147. TStat=Stat;
  148. Statfs = packed record
  149. fstype, { File system type }
  150. bsize, { Optimal block trensfer size }
  151. blocks, { Data blocks in system }
  152. bfree, { free blocks in system }
  153. bavail, { Available free blocks to non-root users }
  154. files, { File nodes in system }
  155. ffree, { Free file nodes in system }
  156. fsid, { File system ID }
  157. namelen : longint; { Maximum name length in system }
  158. spare : array [0..6] of longint; { For later use }
  159. end;
  160. PStatFS=^StatFS;
  161. TStatFS=StatFS;
  162. fdSet=array[0..7] of longint;{=256 bits}
  163. pfdset=^fdset;
  164. TFDSet=fdset;
  165. timeval = packed record
  166. sec,usec:longint
  167. end;
  168. ptimeval=^timeval;
  169. TTimeVal=timeval;
  170. timespec = packed record
  171. tv_sec,tv_nsec:longint;
  172. end;
  173. timezone = packed record
  174. minuteswest,dsttime:longint;
  175. end;
  176. ptimezone =^timezone;
  177. TTimeZone = timezone;
  178. utsname = packed record
  179. sysname,
  180. nodename,
  181. release,
  182. version,
  183. machine,
  184. domainname : Array[0..64] of char;
  185. end;
  186. PUTSName=^UTSName;
  187. TUTSName=UTSName;
  188. { Get System call numbers and error-numbers}
  189. const
  190. syscall_nr_setup = 0;
  191. syscall_nr_exit = 1;
  192. syscall_nr_fork = 2;
  193. syscall_nr_read = 3;
  194. syscall_nr_write = 4;
  195. syscall_nr_open = 5;
  196. syscall_nr_close = 6;
  197. syscall_nr_waitpid = 7;
  198. syscall_nr_creat = 8;
  199. syscall_nr_link = 9;
  200. syscall_nr_unlink = 10;
  201. syscall_nr_execve = 11;
  202. syscall_nr_chdir = 12;
  203. syscall_nr_time = 13;
  204. syscall_nr_mknod = 14;
  205. syscall_nr_chmod = 15;
  206. syscall_nr_chown = 16;
  207. syscall_nr_break = 17;
  208. syscall_nr_oldstat = 18;
  209. syscall_nr_lseek = 19;
  210. syscall_nr_getpid = 20;
  211. syscall_nr_mount = 21;
  212. syscall_nr_umount = 22;
  213. syscall_nr_setuid = 23;
  214. syscall_nr_getuid = 24;
  215. syscall_nr_stime = 25;
  216. syscall_nr_ptrace = 26;
  217. syscall_nr_alarm = 27;
  218. syscall_nr_oldfstat = 28;
  219. syscall_nr_pause = 29;
  220. syscall_nr_utime = 30;
  221. syscall_nr_stty = 31;
  222. syscall_nr_gtty = 32;
  223. syscall_nr_access = 33;
  224. syscall_nr_nice = 34;
  225. syscall_nr_ftime = 35;
  226. syscall_nr_sync = 36;
  227. syscall_nr_kill = 37;
  228. syscall_nr_rename = 38;
  229. syscall_nr_mkdir = 39;
  230. syscall_nr_rmdir = 40;
  231. syscall_nr_dup = 41;
  232. syscall_nr_pipe = 42;
  233. syscall_nr_times = 43;
  234. syscall_nr_prof = 44;
  235. syscall_nr_brk = 45;
  236. syscall_nr_setgid = 46;
  237. syscall_nr_getgid = 47;
  238. syscall_nr_signal = 48;
  239. syscall_nr_geteuid = 49;
  240. syscall_nr_getegid = 50;
  241. syscall_nr_acct = 51;
  242. syscall_nr_phys = 52;
  243. syscall_nr_lock = 53;
  244. syscall_nr_ioctl = 54;
  245. syscall_nr_fcntl = 55;
  246. syscall_nr_mpx = 56;
  247. syscall_nr_setpgid = 57;
  248. syscall_nr_ulimit = 58;
  249. syscall_nr_oldolduname = 59;
  250. syscall_nr_umask = 60;
  251. syscall_nr_chroot = 61;
  252. syscall_nr_ustat = 62;
  253. syscall_nr_dup2 = 63;
  254. syscall_nr_getppid = 64;
  255. syscall_nr_getpgrp = 65;
  256. syscall_nr_setsid = 66;
  257. syscall_nr_sigaction = 67;
  258. syscall_nr_sgetmask = 68;
  259. syscall_nr_ssetmask = 69;
  260. syscall_nr_setreuid = 70;
  261. syscall_nr_setregid = 71;
  262. syscall_nr_sigsuspend = 72;
  263. syscall_nr_sigpending = 73;
  264. syscall_nr_sethostname = 74;
  265. syscall_nr_setrlimit = 75;
  266. syscall_nr_getrlimit = 76;
  267. syscall_nr_getrusage = 77;
  268. syscall_nr_gettimeofday = 78;
  269. syscall_nr_settimeofday = 79;
  270. syscall_nr_getgroups = 80;
  271. syscall_nr_setgroups = 81;
  272. syscall_nr_select = 82;
  273. syscall_nr_symlink = 83;
  274. syscall_nr_oldlstat = 84;
  275. syscall_nr_readlink = 85;
  276. syscall_nr_uselib = 86;
  277. syscall_nr_swapon = 87;
  278. syscall_nr_reboot = 88;
  279. syscall_nr_readdir = 89;
  280. syscall_nr_mmap = 90;
  281. syscall_nr_munmap = 91;
  282. syscall_nr_truncate = 92;
  283. syscall_nr_ftruncate = 93;
  284. syscall_nr_fchmod = 94;
  285. syscall_nr_fchown = 95;
  286. syscall_nr_getpriority = 96;
  287. syscall_nr_setpriority = 97;
  288. syscall_nr_profil = 98;
  289. syscall_nr_statfs = 99;
  290. syscall_nr_fstatfs = 100;
  291. syscall_nr_ioperm = 101;
  292. syscall_nr_socketcall = 102;
  293. syscall_nr_syslog = 103;
  294. syscall_nr_setitimer = 104;
  295. syscall_nr_getitimer = 105;
  296. syscall_nr_stat = 106;
  297. syscall_nr_lstat = 107;
  298. syscall_nr_fstat = 108;
  299. syscall_nr_olduname = 109;
  300. syscall_nr_iopl = 110;
  301. syscall_nr_vhangup = 111;
  302. syscall_nr_idle = 112;
  303. syscall_nr_vm86old = 113;
  304. syscall_nr_wait4 = 114;
  305. syscall_nr_swapoff = 115;
  306. syscall_nr_sysinfo = 116;
  307. syscall_nr_ipc = 117;
  308. syscall_nr_fsync = 118;
  309. syscall_nr_sigreturn = 119;
  310. syscall_nr_clone = 120;
  311. syscall_nr_setdomainname = 121;
  312. syscall_nr_uname = 122;
  313. syscall_nr_modify_ldt = 123;
  314. syscall_nr_adjtimex = 124;
  315. syscall_nr_mprotect = 125;
  316. syscall_nr_sigprocmask = 126;
  317. syscall_nr_create_module = 127;
  318. syscall_nr_init_module = 128;
  319. syscall_nr_delete_module = 129;
  320. syscall_nr_get_kernel_syms = 130;
  321. syscall_nr_quotactl = 131;
  322. syscall_nr_getpgid = 132;
  323. syscall_nr_fchdir = 133;
  324. syscall_nr_bdflush = 134;
  325. syscall_nr_sysfs = 135;
  326. syscall_nr_personality = 136;
  327. syscall_nr_afs_syscall = 137;
  328. syscall_nr_setfsuid = 138;
  329. syscall_nr_setfsgid = 139;
  330. syscall_nr__llseek = 140;
  331. syscall_nr_getdents = 141;
  332. syscall_nr__newselect = 142;
  333. syscall_nr_flock = 143;
  334. syscall_nr_msync = 144;
  335. syscall_nr_readv = 145;
  336. syscall_nr_writev = 146;
  337. syscall_nr_getsid = 147;
  338. syscall_nr_fdatasync = 148;
  339. syscall_nr__sysctl = 149;
  340. syscall_nr_mlock = 150;
  341. syscall_nr_munlock = 151;
  342. syscall_nr_mlockall = 152;
  343. syscall_nr_munlockall = 153;
  344. syscall_nr_sched_setparam = 154;
  345. syscall_nr_sched_getparam = 155;
  346. syscall_nr_sched_setscheduler = 156;
  347. syscall_nr_sched_getscheduler = 157;
  348. syscall_nr_sched_yield = 158;
  349. syscall_nr_sched_get_priority_max = 159;
  350. syscall_nr_sched_get_priority_min = 160;
  351. syscall_nr_sched_rr_get_interval = 161;
  352. syscall_nr_nanosleep = 162;
  353. syscall_nr_mremap = 163;
  354. syscall_nr_setresuid = 164;
  355. syscall_nr_getresuid = 165;
  356. syscall_nr_vm86 = 166;
  357. syscall_nr_query_module = 167;
  358. syscall_nr_poll = 168;
  359. syscall_nr_sigaltstack = 186;
  360. {$IFDEF SYSCALL_DEBUG}
  361. const
  362. Sys_nr_txt : array[0..168] of string[15]=(
  363. 'Setup', { 0 }
  364. 'Exit', { 1 }
  365. 'Fork', { 2 }
  366. 'Read', { 3 }
  367. 'Write', { 4 }
  368. 'Open', { 5 }
  369. 'Close', { 6 }
  370. 'WaitPid', { 7 }
  371. 'Create', { 8 }
  372. 'Link', { 9 }
  373. 'UnLink', { 10 }
  374. 'ExecVe', { 11 }
  375. 'ChDir', { 12 }
  376. 'Time', { 13 }
  377. 'MkNod', { 14 }
  378. 'ChMod', { 15 }
  379. 'ChOwn', { 16 }
  380. 'Break', { 17 }
  381. 'OldState', { 18 }
  382. 'LSeek', { 19 }
  383. 'GetPid', { 20 }
  384. 'Mount', { 21 }
  385. 'UMount', { 22 }
  386. 'SetUid', { 23 }
  387. 'GetUid', { 24 }
  388. 'STime', { 25 }
  389. 'PTrace', { 26 }
  390. 'Alarm', { 27 }
  391. 'OldFStat', { 28 }
  392. 'Pause', { 29 }
  393. 'UTime', { 30 }
  394. 'STTY', { 31 }
  395. 'GTTY', { 32 }
  396. 'Access', { 33 }
  397. 'Nice', { 34 }
  398. 'FTime', { 35 }
  399. 'Sync', { 36 }
  400. 'Kill', { 37 }
  401. 'Rename', { 38 }
  402. 'MkDir', { 39 }
  403. 'RmDir', { 40 }
  404. 'Dup', { 41 }
  405. 'Pipe', { 42 }
  406. 'Times', { 43 }
  407. 'Prof', { 44 }
  408. 'Break', { 45 }
  409. 'SetGid', { 46 }
  410. 'GetGid', { 47 }
  411. 'Signal', { 48 }
  412. 'GetEUid', { 49 }
  413. 'GetEGid', { 50 }
  414. 'Acct', { 51 }
  415. 'Phys', { 52 }
  416. 'Lock', { 53 }
  417. 'IOCtl', { 54 }
  418. 'FCNtl', { 55 }
  419. 'Mpx', { 56 }
  420. 'SetPGid', { 57 }
  421. 'ULimit', { 58 }
  422. 'OldOldUName', { 59 }
  423. 'UMask', { 60 }
  424. 'ChRoot', { 61 }
  425. 'UStat', { 62 }
  426. 'Dup2', { 63 }
  427. 'GetPPid', { 64 }
  428. 'GetPGrp', { 65 }
  429. 'SetSid', { 66 }
  430. 'SigAction', { 67 }
  431. 'SGetMask', { 68 }
  432. 'SSetMask', { 69 }
  433. 'SetReUid', { 70 }
  434. 'SetReGid', { 71 }
  435. 'SigSuspend', { 72 }
  436. 'SigPending', { 73 }
  437. 'SetHostName', { 74 }
  438. 'SetRLimit', { 75 }
  439. 'GetRLimit', { 76 }
  440. 'GetRUsage', { 77 }
  441. 'GetTimeOfDay', { 78 }
  442. 'SetTimeOfDay', { 79 }
  443. 'GetGroups', { 80 }
  444. 'SetGroups', { 81 }
  445. 'Select', { 82 }
  446. 'SymLink', { 83 }
  447. 'OldLStat', { 84 }
  448. 'ReadLink', { 85 }
  449. 'UseLib', { 86 }
  450. 'SwapOn', { 87 }
  451. 'Reboot', { 88 }
  452. 'ReadDir', { 89 }
  453. 'MMap', { 90 }
  454. 'MunMap', { 91 }
  455. 'Truncate', { 92 }
  456. 'FTruncate', { 93 }
  457. 'FChMod', { 94 }
  458. 'FChOwn', { 95 }
  459. 'GetPriority', { 96 }
  460. 'SetPriority', { 97 }
  461. 'Profile', { 98 }
  462. 'StatFs', { 99 }
  463. 'FStatFs', { 100 }
  464. 'IOPerm', { 101 }
  465. 'SocketCall', { 102 }
  466. 'SysLog', { 103 }
  467. 'SetITimer', { 104 }
  468. 'GetITimer', { 105 }
  469. 'Stat', { 106 }
  470. 'LStat', { 107 }
  471. 'FStat', { 108 }
  472. 'OldUName', { 109 }
  473. 'IOPl', { 110 }
  474. 'VHangup', { 111 }
  475. 'Idle', { 112 }
  476. 'VM86', { 113 }
  477. 'Wait4', { 114 }
  478. 'SwapOff', { 115 }
  479. 'SysInfo', { 116 }
  480. 'IPC', { 117 }
  481. 'FSync', { 118 }
  482. 'SigReturn', { 119 }
  483. 'Clone', { 120 }
  484. 'SetDomainName', { 121 }
  485. 'UName', { 122 }
  486. 'Modify_Ldt', { 123 }
  487. 'AdjTimeX', { 124 }
  488. 'MProtect', { 125 }
  489. 'SigProcMask', { 126 }
  490. 'Create_Module', { 127 }
  491. 'Init_Module', { 128 }
  492. 'Delete_Module', { 129 }
  493. 'Get_Kernel_Syms', { 130 }
  494. 'QuotaCtl', { 131 }
  495. 'GetPGid', { 132 }
  496. 'FChDir', { 133 }
  497. 'BDFlush', { 134 }
  498. 'SysFs', { 135 }
  499. 'Personality', { 136 }
  500. 'AFS_SysCall', { 137 }
  501. 'SetFsUid', { 138 }
  502. 'SetFsGid', { 139 }
  503. '__LLSeek', { 140 }
  504. 'GetDents', { 141 }
  505. '__NewSelect', { 142 }
  506. 'FLock', { 143 }
  507. 'MSync', { 144 }
  508. 'ReadV', { 145 }
  509. 'WriteV', { 146 }
  510. 'GetSid', { 147 }
  511. 'FDataSync', { 148 }
  512. '__SysCtl', { 149 }
  513. 'MLock', { 150 }
  514. 'MUnLock', { 151 }
  515. 'MLockAll', { 152 }
  516. 'MUnLockAll', { 153 }
  517. 'MSchdSetParam', { 154 }
  518. 'MSchdGetParam', { 155 }
  519. 'MSchdSetSchd', { 156 }
  520. 'MSchdGetSchd', { 157 }
  521. 'MSchdYield', { 158 }
  522. 'MSchdGetPriMax', { 159 }
  523. 'MSchdGetPriMin', { 160 }
  524. 'MSchdRRGetInt', { 161 }
  525. 'NanoSleep', { 162 }
  526. 'MRemap', { 163 }
  527. 'SetReSuid', { 164 }
  528. 'GetReSuid', { 165 }
  529. 'vm86', { 166 }
  530. 'QueryModule', { 167 }
  531. 'Poll'); { 168 }
  532. {$ENDIF}
  533. Const
  534. Sys_EPERM = 1; { Operation not permitted }
  535. Sys_ENOENT = 2; { No such file or directory }
  536. Sys_ESRCH = 3; { No such process }
  537. Sys_EINTR = 4; { Interrupted system call }
  538. Sys_EIO = 5; { I/O error }
  539. Sys_ENXIO = 6; { No such device or address }
  540. Sys_E2BIG = 7; { Arg list too long }
  541. Sys_ENOEXEC = 8; { Exec format error }
  542. Sys_EBADF = 9; { Bad file number }
  543. Sys_ECHILD = 10; { No child processes }
  544. Sys_EAGAIN = 11; { Try again }
  545. Sys_ENOMEM = 12; { Out of memory }
  546. Sys_EACCES = 13; { Permission denied }
  547. Sys_EFAULT = 14; { Bad address }
  548. Sys_ENOTBLK = 15; { Block device required, NOT POSIX! }
  549. Sys_EBUSY = 16; { Device or resource busy }
  550. Sys_EEXIST = 17; { File exists }
  551. Sys_EXDEV = 18; { Cross-device link }
  552. Sys_ENODEV = 19; { No such device }
  553. Sys_ENOTDIR = 20; { Not a directory }
  554. Sys_EISDIR = 21; { Is a directory }
  555. Sys_EINVAL = 22; { Invalid argument }
  556. Sys_ENFILE = 23; { File table overflow }
  557. Sys_EMFILE = 24; { Too many open files }
  558. Sys_ENOTTY = 25; { Not a typewriter }
  559. Sys_ETXTBSY = 26; { Text file busy. The new process was
  560. a pure procedure (shared text) file which was
  561. open for writing by another process, or file
  562. which was open for writing by another process,
  563. or while the pure procedure file was being
  564. executed an open(2) call requested write access
  565. requested write access.}
  566. Sys_EFBIG = 27; { File too large }
  567. Sys_ENOSPC = 28; { No space left on device }
  568. Sys_ESPIPE = 29; { Illegal seek }
  569. Sys_EROFS = 30; { Read-only file system }
  570. Sys_EMLINK = 31; { Too many links }
  571. Sys_EPIPE = 32; { Broken pipe }
  572. Sys_EDOM = 33; { Math argument out of domain of func }
  573. Sys_ERANGE = 34; { Math result not representable }
  574. Sys_EDEADLK = 35; { Resource deadlock would occur }
  575. Sys_ENAMETOOLONG= 36; { File name too long }
  576. Sys_ENOLCK = 37; { No record locks available }
  577. Sys_ENOSYS = 38; { Function not implemented }
  578. Sys_ENOTEMPTY= 39; { Directory not empty }
  579. Sys_ELOOP = 40; { Too many symbolic links encountered }
  580. Sys_EWOULDBLOCK = Sys_EAGAIN; { Operation would block }
  581. Sys_ENOMSG = 42; { No message of desired type }
  582. Sys_EIDRM = 43; { Identifier removed }
  583. Sys_ECHRNG = 44; { Channel number out of range }
  584. Sys_EL2NSYNC= 45; { Level 2 not synchronized }
  585. Sys_EL3HLT = 46; { Level 3 halted }
  586. Sys_EL3RST = 47; { Level 3 reset }
  587. Sys_ELNRNG = 48; { Link number out of range }
  588. Sys_EUNATCH = 49; { Protocol driver not attached }
  589. Sys_ENOCSI = 50; { No CSI structure available }
  590. Sys_EL2HLT = 51; { Level 2 halted }
  591. Sys_EBADE = 52; { Invalid exchange }
  592. Sys_EBADR = 53; { Invalid request descriptor }
  593. Sys_EXFULL = 54; { Exchange full }
  594. Sys_ENOANO = 55; { No anode }
  595. Sys_EBADRQC = 56; { Invalid request code }
  596. Sys_EBADSLT = 57; { Invalid slot }
  597. Sys_EDEADLOCK= 58; { File locking deadlock error }
  598. Sys_EBFONT = 59; { Bad font file format }
  599. Sys_ENOSTR = 60; { Device not a stream }
  600. Sys_ENODATA = 61; { No data available }
  601. Sys_ETIME = 62; { Timer expired }
  602. Sys_ENOSR = 63; { Out of streams resources }
  603. Sys_ENONET = 64; { Machine is not on the network }
  604. Sys_ENOPKG = 65; { Package not installed }
  605. Sys_EREMOTE = 66; { Object is remote }
  606. Sys_ENOLINK = 67; { Link has been severed }
  607. Sys_EADV = 68; { Advertise error }
  608. Sys_ESRMNT = 69; { Srmount error }
  609. Sys_ECOMM = 70; { Communication error on send }
  610. Sys_EPROTO = 71; { Protocol error }
  611. Sys_EMULTIHOP= 72; { Multihop attempted }
  612. Sys_EDOTDOT = 73; { RFS specific error }
  613. Sys_EBADMSG = 74; { Not a data message }
  614. Sys_EOVERFLOW= 75; { Value too large for defined data type }
  615. Sys_ENOTUNIQ= 76; { Name not unique on network }
  616. Sys_EBADFD = 77; { File descriptor in bad state }
  617. Sys_EREMCHG = 78; { Remote address changed }
  618. Sys_ELIBACC = 79; { Can not access a needed shared library }
  619. Sys_ELIBBAD = 80; { Accessing a corrupted shared library }
  620. Sys_ELIBSCN = 81; { .lib section in a.out corrupted }
  621. Sys_ELIBMAX = 82; { Attempting to link in too many shared libraries }
  622. Sys_ELIBEXEC= 83; { Cannot exec a shared library directly }
  623. Sys_EILSEQ = 84; { Illegal byte sequence }
  624. Sys_ERESTART= 85; { Interrupted system call should be restarted }
  625. Sys_ESTRPIPE= 86; { Streams pipe error }
  626. Sys_EUSERS = 87; { Too many users }
  627. Sys_ENOTSOCK= 88; { Socket operation on non-socket }
  628. Sys_EDESTADDRREQ= 89; { Destination address required }
  629. Sys_EMSGSIZE= 90; { Message too long }
  630. Sys_EPROTOTYPE= 91; { Protocol wrong type for socket }
  631. Sys_ENOPROTOOPT= 92; { Protocol not available }
  632. Sys_EPROTONOSUPPORT= 93; { Protocol not supported }
  633. Sys_ESOCKTNOSUPPORT= 94; { Socket type not supported }
  634. Sys_EOPNOTSUPP= 95; { Operation not supported on transport endpoint }
  635. Sys_EPFNOSUPPORT= 96; { Protocol family not supported }
  636. Sys_EAFNOSUPPORT= 97; { Address family not supported by protocol }
  637. Sys_EADDRINUSE= 98; { Address already in use }
  638. Sys_EADDRNOTAVAIL= 99; { Cannot assign requested address }
  639. Sys_ENETDOWN= 100; { Network is down }
  640. Sys_ENETUNREACH= 101; { Network is unreachable }
  641. Sys_ENETRESET= 102; { Network dropped connection because of reset }
  642. Sys_ECONNABORTED= 103; { Software caused connection abort }
  643. Sys_ECONNRESET= 104; { Connection reset by peer }
  644. Sys_ENOBUFS = 105; { No buffer space available }
  645. Sys_EISCONN = 106; { Transport endpoint is already connected }
  646. Sys_ENOTCONN= 107; { Transport endpoint is not connected }
  647. Sys_ESHUTDOWN= 108; { Cannot send after transport endpoint shutdown }
  648. Sys_ETOOMANYREFS= 109; { Too many references: cannot splice }
  649. Sys_ETIMEDOUT= 110; { Connection timed out }
  650. Sys_ECONNREFUSED= 111; { Connection refused }
  651. Sys_EHOSTDOWN= 112; { Host is down }
  652. Sys_EHOSTUNREACH= 113; { No route to host }
  653. Sys_EALREADY= 114; { Operation already in progress }
  654. Sys_EINPROGRESS= 115; { Operation now in progress }
  655. Sys_ESTALE = 116; { Stale NFS file handle }
  656. Sys_EUCLEAN = 117; { Structure needs cleaning }
  657. Sys_ENOTNAM = 118; { Not a XENIX named type file }
  658. Sys_ENAVAIL = 119; { No XENIX semaphores available }
  659. Sys_EISNAM = 120; { Is a named type file }
  660. Sys_EREMOTEIO= 121; { Remote I/O error }
  661. Sys_EDQUOT = 122; { Quota exceeded }
  662. { This value was suggested by Daniel
  663. based on infos from www.linuxassembly.org }
  664. Sys_ERROR_MAX = $fff;
  665. {$packrecords C}
  666. {********************
  667. Signal
  668. ********************}
  669. type
  670. SigSet = Longint;
  671. PSigSet = ^SigSet;
  672. Const
  673. { For sending a signal }
  674. SA_NOCLDSTOP = 1;
  675. SA_SHIRQ = $04000000;
  676. SA_STACK = $08000000;
  677. SA_RESTART = $10000000;
  678. SA_INTERRUPT = $20000000;
  679. SA_NOMASK = $40000000;
  680. SA_ONESHOT = $80000000;
  681. SA_ONSTACK = SA_STACK;
  682. SIG_BLOCK = 0;
  683. SIG_UNBLOCK = 1;
  684. SIG_SETMASK = 2;
  685. SIG_DFL = 0 ;
  686. SIG_IGN = 1 ;
  687. SIG_ERR = -1 ;
  688. SIGHUP = 1;
  689. SIGINT = 2;
  690. SIGQUIT = 3;
  691. SIGILL = 4;
  692. SIGTRAP = 5;
  693. SIGABRT = 6;
  694. SIGIOT = 6;
  695. SIGBUS = 7;
  696. SIGFPE = 8;
  697. SIGKILL = 9;
  698. SIGUSR1 = 10;
  699. SIGSEGV = 11;
  700. SIGUSR2 = 12;
  701. SIGPIPE = 13;
  702. SIGALRM = 14;
  703. SIGTerm = 15;
  704. SIGSTKFLT = 16;
  705. SIGCHLD = 17;
  706. SIGCONT = 18;
  707. SIGSTOP = 19;
  708. SIGTSTP = 20;
  709. SIGTTIN = 21;
  710. SIGTTOU = 22;
  711. SIGURG = 23;
  712. SIGXCPU = 24;
  713. SIGXFSZ = 25;
  714. SIGVTALRM = 26;
  715. SIGPROF = 27;
  716. SIGWINCH = 28;
  717. SIGIO = 29;
  718. SIGPOLL = SIGIO;
  719. SIGPWR = 30;
  720. SIGUNUSED = 31;
  721. const
  722. SI_PAD_SIZE = ((128/sizeof(longint)) - 3);
  723. type
  724. Size_T = cardinal;
  725. tfpreg = record
  726. significand: array[0..3] of word;
  727. exponent: word;
  728. end;
  729. pfpstate = ^tfpstate;
  730. tfpstate = record
  731. cw, sw, tag, ipoff, cssel, dataoff, datasel: cardinal;
  732. st: array[0..7] of tfpreg;
  733. status: cardinal;
  734. end;
  735. PSigContextRec = ^SigContextRec;
  736. SigContextRec = record
  737. gs, __gsh: word;
  738. fs, __fsh: word;
  739. es, __esh: word;
  740. ds, __dsh: word;
  741. edi: cardinal;
  742. esi: cardinal;
  743. ebp: cardinal;
  744. esp: cardinal;
  745. ebx: cardinal;
  746. edx: cardinal;
  747. ecx: cardinal;
  748. eax: cardinal;
  749. trapno: cardinal;
  750. err: cardinal;
  751. eip: cardinal;
  752. cs, __csh: word;
  753. eflags: cardinal;
  754. esp_at_signal: cardinal;
  755. ss, __ssh: word;
  756. fpstate: pfpstate;
  757. oldmask: cardinal;
  758. cr2: cardinal;
  759. end;
  760. (*
  761. PSigInfoRec = ^SigInfoRec;
  762. SigInfoRec = record
  763. si_signo: longint;
  764. si_errno: longint;
  765. si_code: longint;
  766. case longint of
  767. 0:
  768. (pad: array[SI_PAD_SIZE] of longint);
  769. 1: { kill }
  770. ( kill: record
  771. pid: longint; { sender's pid }
  772. uid : longint; { sender's uid }
  773. end );
  774. 2: { POSIX.1b timers }
  775. ( timer : record
  776. timer1 : cardinal;
  777. timer2 : cardinal;
  778. end );
  779. 3: { POSIX.1b signals }
  780. ( rt : record
  781. pid : longint; { sender's pid }
  782. uid : longint; { sender's uid }
  783. sigval : longint;
  784. end );
  785. 4: { SIGCHLD }
  786. ( sigchld : record
  787. pid : longint; { which child }
  788. uid : longint; { sender's uid }
  789. status : longint; { exit code }
  790. utime : timeval;
  791. stime : timeval;
  792. end );
  793. 5: { SIGILL, SIGFPE, SIGSEGV, SIGBUS }
  794. ( sigfault : record
  795. addr : pointer;{ faulting insn/memory ref. }
  796. end );
  797. 6:
  798. ( sigpoll : record
  799. band : longint; { POLL_IN, POLL_OUT, POLL_MSG }
  800. fd : longint;
  801. end );
  802. end;
  803. *)
  804. SignalHandler = Procedure(Sig : Longint);cdecl;
  805. PSignalHandler = ^SignalHandler;
  806. SignalRestorer = Procedure;cdecl;
  807. PSignalRestorer = ^SignalRestorer;
  808. TSigAction = procedure(Sig: Longint; SigContext: SigContextRec);cdecl;
  809. SigActionRec = packed record
  810. Handler : record
  811. case byte of
  812. 0: (Sh: SignalHandler);
  813. 1: (Sa: TSigAction);
  814. end;
  815. Sa_Mask : SigSet;
  816. Sa_Flags : Longint;
  817. Sa_restorer : SignalRestorer; { Obsolete - Don't use }
  818. end;
  819. PSigActionRec = ^SigActionRec;
  820. const
  821. SS_ONSTACK = 1;
  822. SS_DISABLE = 2;
  823. MINSIGSTKSZ = 2048;
  824. SIGSTKSZ = 8192;
  825. type
  826. SigAltStack = record
  827. ss_sp : pointer;
  828. ss_flags : longint;
  829. ss_size : size_t;
  830. end;
  831. stack_t = sigaltstack;
  832. PSigAltStack = ^SigAltStack;
  833. pstack_t = ^stack_t;
  834. var
  835. ErrNo,
  836. LinuxError : Longint;
  837. {********************
  838. Process
  839. ********************}
  840. const
  841. {Checked for BSD using Linuxthreads port}
  842. { cloning flags }
  843. CSIGNAL = $000000ff; // signal mask to be sent at exit
  844. CLONE_VM = $00000100; // set if VM shared between processes
  845. CLONE_FS = $00000200; // set if fs info shared between processes
  846. CLONE_FILES = $00000400; // set if open files shared between processes
  847. CLONE_SIGHAND = $00000800; // set if signal handlers shared
  848. CLONE_PID = $00001000; // set if pid shared
  849. type
  850. TCloneFunc=function(args:pointer):longint;cdecl;
  851. const
  852. { For getting/setting priority }
  853. Prio_Process = 0;
  854. Prio_PGrp = 1;
  855. Prio_User = 2;
  856. {$ifdef Solaris}
  857. WNOHANG = $100;
  858. WUNTRACED = $4;
  859. {$ELSE}
  860. WNOHANG = $1;
  861. WUNTRACED = $2;
  862. __WCLONE = $80000000;
  863. {$ENDIF}
  864. {********************
  865. File
  866. ********************}
  867. Const
  868. P_IN = 1;
  869. P_OUT = 2;
  870. Const
  871. LOCK_SH = 1;
  872. LOCK_EX = 2;
  873. LOCK_UN = 8;
  874. LOCK_NB = 4;
  875. Type
  876. Tpipe = array[1..2] of longint;
  877. pglob = ^tglob;
  878. tglob = record
  879. name : pchar;
  880. next : pglob;
  881. end;
  882. ComStr = String[255];
  883. PathStr = String[255];
  884. DirStr = String[255];
  885. NameStr = String[255];
  886. ExtStr = String[255];
  887. const
  888. { For testing access rights }
  889. R_OK = 4;
  890. W_OK = 2;
  891. X_OK = 1;
  892. F_OK = 0;
  893. {$ifndef newreaddir}
  894. { For File control mechanism }
  895. F_GetFd = 1;
  896. F_SetFd = 2;
  897. F_GetFl = 3;
  898. F_SetFl = 4;
  899. {$ifdef Solaris}
  900. F_DupFd = 0;
  901. F_Dup2Fd = 9;
  902. F_GetOwn = 23;
  903. F_SetOwn = 24;
  904. F_GetLk = 14;
  905. F_SetLk = 6;
  906. F_SetLkW = 7;
  907. F_FreeSp = 11;
  908. {$else}
  909. F_GetLk = 5;
  910. F_SetLk = 6;
  911. F_SetLkW = 7;
  912. F_SetOwn = 8;
  913. F_GetOwn = 9;
  914. {$endif}
  915. {$endif}
  916. {********************
  917. IOCtl(TermIOS)
  918. ********************}
  919. {Is too freebsd/Linux specific}
  920. {********************
  921. IOCtl(TermIOS)
  922. ********************}
  923. Const
  924. { Amount of Control Chars }
  925. NCCS = 32;
  926. NCC = 8;
  927. {$Ifndef BSD}
  928. { For Terminal handling }
  929. TCGETS = $5401;
  930. TCSETS = $5402;
  931. TCSETSW = $5403;
  932. TCSETSF = $5404;
  933. TCGETA = $5405;
  934. TCSETA = $5406;
  935. TCSETAW = $5407;
  936. TCSETAF = $5408;
  937. TCSBRK = $5409;
  938. TCXONC = $540A;
  939. TCFLSH = $540B;
  940. TIOCEXCL = $540C;
  941. TIOCNXCL = $540D;
  942. TIOCSCTTY = $540E;
  943. TIOCGPGRP = $540F;
  944. TIOCSPGRP = $5410;
  945. TIOCOUTQ = $5411;
  946. TIOCSTI = $5412;
  947. TIOCGWINSZ = $5413;
  948. TIOCSWINSZ = $5414;
  949. TIOCMGET = $5415;
  950. TIOCMBIS = $5416;
  951. TIOCMBIC = $5417;
  952. TIOCMSET = $5418;
  953. TIOCGSOFTCAR = $5419;
  954. TIOCSSOFTCAR = $541A;
  955. FIONREAD = $541B;
  956. TIOCINQ = FIONREAD;
  957. TIOCLINUX = $541C;
  958. TIOCCONS = $541D;
  959. TIOCGSERIAL = $541E;
  960. TIOCSSERIAL = $541F;
  961. TIOCPKT = $5420;
  962. FIONBIO = $5421;
  963. TIOCNOTTY = $5422;
  964. TIOCSETD = $5423;
  965. TIOCGETD = $5424;
  966. TCSBRKP = $5425;
  967. TIOCTTYGSTRUCT = $5426;
  968. FIONCLEX = $5450;
  969. FIOCLEX = $5451;
  970. FIOASYNC = $5452;
  971. TIOCSERCONFIG = $5453;
  972. TIOCSERGWILD = $5454;
  973. TIOCSERSWILD = $5455;
  974. TIOCGLCKTRMIOS = $5456;
  975. TIOCSLCKTRMIOS = $5457;
  976. TIOCSERGSTRUCT = $5458;
  977. TIOCSERGETLSR = $5459;
  978. TIOCSERGETMULTI = $545A;
  979. TIOCSERSETMULTI = $545B;
  980. TIOCMIWAIT = $545C;
  981. TIOCGICOUNT = $545D;
  982. TIOCPKT_DATA = 0;
  983. TIOCPKT_FLUSHREAD = 1;
  984. TIOCPKT_FLUSHWRITE = 2;
  985. TIOCPKT_STOP = 4;
  986. TIOCPKT_START = 8;
  987. TIOCPKT_NOSTOP = 16;
  988. TIOCPKT_DOSTOP = 32;
  989. {$else}
  990. {$endif}
  991. Type
  992. winsize = packed record
  993. ws_row,
  994. ws_col,
  995. ws_xpixel,
  996. ws_ypixel : word;
  997. end;
  998. TWinSize=winsize;
  999. Termio = packed record
  1000. c_iflag, { input mode flags }
  1001. c_oflag, { output mode flags }
  1002. c_cflag, { control mode flags }
  1003. c_lflag : Word; { local mode flags }
  1004. c_line : Word; { line discipline - careful, only High byte in use}
  1005. c_cc : array [0..NCC-1] of char;{ control characters }
  1006. end;
  1007. TTermio=Termio;
  1008. {$PACKRECORDS C}
  1009. Termios = record
  1010. c_iflag,
  1011. c_oflag,
  1012. c_cflag,
  1013. c_lflag : Cardinal;
  1014. c_line : char;
  1015. c_cc : array[0..NCCS-1] of byte;
  1016. c_ispeed,
  1017. c_ospeed : longint;
  1018. end;
  1019. TTermios=Termios;
  1020. {$PACKRECORDS Default}
  1021. {const
  1022. 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);}
  1023. const
  1024. {c_cc characters}
  1025. VINTR = 0;
  1026. VQUIT = 1;
  1027. VERASE = 2;
  1028. VKILL = 3;
  1029. VEOF = 4;
  1030. VTIME = 5;
  1031. VMIN = 6;
  1032. VSWTC = 7;
  1033. VSTART = 8;
  1034. VSTOP = 9;
  1035. VSUSP = 10;
  1036. VEOL = 11;
  1037. VREPRINT = 12;
  1038. VDISCARD = 13;
  1039. VWERASE = 14;
  1040. VLNEXT = 15;
  1041. VEOL2 = 16;
  1042. {c_iflag bits}
  1043. IGNBRK = $0000001;
  1044. BRKINT = $0000002;
  1045. IGNPAR = $0000004;
  1046. PARMRK = $0000008;
  1047. INPCK = $0000010;
  1048. ISTRIP = $0000020;
  1049. INLCR = $0000040;
  1050. IGNCR = $0000080;
  1051. ICRNL = $0000100;
  1052. IUCLC = $0000200;
  1053. IXON = $0000400;
  1054. IXANY = $0000800;
  1055. IXOFF = $0001000;
  1056. IMAXBEL = $0002000;
  1057. {c_oflag bits}
  1058. OPOST = $0000001;
  1059. OLCUC = $0000002;
  1060. ONLCR = $0000004;
  1061. OCRNL = $0000008;
  1062. ONOCR = $0000010;
  1063. ONLRET = $0000020;
  1064. OFILL = $0000040;
  1065. OFDEL = $0000080;
  1066. NLDLY = $0000100;
  1067. NL0 = $0000000;
  1068. NL1 = $0000100;
  1069. CRDLY = $0000600;
  1070. CR0 = $0000000;
  1071. CR1 = $0000200;
  1072. CR2 = $0000400;
  1073. CR3 = $0000600;
  1074. TABDLY = $0001800;
  1075. TAB0 = $0000000;
  1076. TAB1 = $0000800;
  1077. TAB2 = $0001000;
  1078. TAB3 = $0001800;
  1079. XTABS = $0001800;
  1080. BSDLY = $0002000;
  1081. BS0 = $0000000;
  1082. BS1 = $0002000;
  1083. VTDLY = $0004000;
  1084. VT0 = $0000000;
  1085. VT1 = $0004000;
  1086. FFDLY = $0008000;
  1087. FF0 = $0000000;
  1088. FF1 = $0008000;
  1089. {c_cflag bits}
  1090. CBAUD = $000100F;
  1091. B0 = $0000000;
  1092. B50 = $0000001;
  1093. B75 = $0000002;
  1094. B110 = $0000003;
  1095. B134 = $0000004;
  1096. B150 = $0000005;
  1097. B200 = $0000006;
  1098. B300 = $0000007;
  1099. B600 = $0000008;
  1100. B1200 = $0000009;
  1101. B1800 = $000000A;
  1102. B2400 = $000000B;
  1103. B4800 = $000000C;
  1104. B9600 = $000000D;
  1105. B19200 = $000000E;
  1106. B38400 = $000000F;
  1107. EXTA = B19200;
  1108. EXTB = B38400;
  1109. CSIZE = $0000030;
  1110. CS5 = $0000000;
  1111. CS6 = $0000010;
  1112. CS7 = $0000020;
  1113. CS8 = $0000030;
  1114. CSTOPB = $0000040;
  1115. CREAD = $0000080;
  1116. PARENB = $0000100;
  1117. PARODD = $0000200;
  1118. HUPCL = $0000400;
  1119. CLOCAL = $0000800;
  1120. CBAUDEX = $0001000;
  1121. B57600 = $0001001;
  1122. B115200 = $0001002;
  1123. B230400 = $0001003;
  1124. B460800 = $0001004;
  1125. CIBAUD = $100F0000;
  1126. CMSPAR = $40000000;
  1127. CRTSCTS = $80000000;
  1128. {c_lflag bits}
  1129. ISIG = $0000001;
  1130. ICANON = $0000002;
  1131. XCASE = $0000004;
  1132. ECHO = $0000008;
  1133. ECHOE = $0000010;
  1134. ECHOK = $0000020;
  1135. ECHONL = $0000040;
  1136. NOFLSH = $0000080;
  1137. TOSTOP = $0000100;
  1138. ECHOCTL = $0000200;
  1139. ECHOPRT = $0000400;
  1140. ECHOKE = $0000800;
  1141. FLUSHO = $0001000;
  1142. PENDIN = $0004000;
  1143. IEXTEN = $0008000;
  1144. {c_line bits}
  1145. TIOCM_LE = $001;
  1146. TIOCM_DTR = $002;
  1147. TIOCM_RTS = $004;
  1148. TIOCM_ST = $008;
  1149. TIOCM_SR = $010;
  1150. TIOCM_CTS = $020;
  1151. TIOCM_CAR = $040;
  1152. TIOCM_RNG = $080;
  1153. TIOCM_DSR = $100;
  1154. TIOCM_CD = TIOCM_CAR;
  1155. TIOCM_RI = TIOCM_RNG;
  1156. TIOCM_OUT1 = $2000;
  1157. TIOCM_OUT2 = $4000;
  1158. {TCSetAttr}
  1159. TCSANOW = 0;
  1160. TCSADRAIN = 1;
  1161. TCSAFLUSH = 2;
  1162. {TCFlow}
  1163. TCOOFF = 0;
  1164. TCOON = 1;
  1165. TCIOFF = 2;
  1166. TCION = 3;
  1167. {TCFlush}
  1168. TCIFLUSH = 0;
  1169. TCOFLUSH = 1;
  1170. TCIOFLUSH = 2;
  1171. {********************
  1172. Info
  1173. ********************}
  1174. Type
  1175. UTimBuf = packed record{in BSD array[0..1] of timeval, but this is
  1176. backwards compatible with linux version}
  1177. actime,
  1178. modtime
  1179. : longint;
  1180. end;
  1181. UTimeBuf=UTimBuf;
  1182. TUTimeBuf=UTimeBuf;
  1183. PUTimeBuf=^UTimeBuf;
  1184. TSysinfo = packed record
  1185. uptime : longint;
  1186. loads : array[1..3] of longint;
  1187. totalram,
  1188. freeram,
  1189. sharedram,
  1190. bufferram,
  1191. totalswap,
  1192. freeswap : longint;
  1193. procs : integer;
  1194. s : string[18];
  1195. end;
  1196. PSysInfo = ^TSysInfo;
  1197. {******************************************************************************
  1198. Procedure/Functions
  1199. ******************************************************************************}
  1200. Function SysCall(callnr:longint;var regs:SysCallregs):longint;
  1201. {**************************
  1202. Time/Date Handling
  1203. ***************************}
  1204. var
  1205. tzdaylight : boolean;
  1206. tzseconds : longint;
  1207. tzname : array[boolean] of pchar;
  1208. { timezone support }
  1209. procedure GetLocalTimezone(timer:longint;var leap_correct,leap_hit:longint);
  1210. procedure GetLocalTimezone(timer:longint);
  1211. procedure ReadTimezoneFile(fn:string);
  1212. function GetTimezoneFile:string;
  1213. Procedure GetTimeOfDay(var tv:timeval);
  1214. Function GetTimeOfDay:longint;
  1215. Function GetEpochTime: longint;
  1216. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
  1217. Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
  1218. procedure GetTime(var hour,min,sec,msec,usec:word);
  1219. procedure GetTime(var hour,min,sec,sec100:word);
  1220. procedure GetTime(var hour,min,sec:word);
  1221. Procedure GetDate(Var Year,Month,Day:Word);
  1222. Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
  1223. function SetTime(Hour,Min,Sec:word) : Boolean;
  1224. function SetDate(Year,Month,Day:Word) : Boolean;
  1225. function SetDateTime(Year,Month,Day,hour,minute,second:Word) : Boolean;
  1226. {**************************
  1227. Process Handling
  1228. ***************************}
  1229. function CreateShellArgV(const prog:string):ppchar;
  1230. function CreateShellArgV(const prog:Ansistring):ppchar;
  1231. Procedure Execve(Path: pathstr;args:ppchar;ep:ppchar);
  1232. Procedure Execve(Path: AnsiString;args:ppchar;ep:ppchar);
  1233. Procedure Execve(path: pchar;args:ppchar;ep:ppchar);
  1234. Procedure Execv(const path:pathstr;args:ppchar);
  1235. Procedure Execv(const path: AnsiString;args:ppchar);
  1236. Procedure Execvp(Path: Pathstr;Args:ppchar;Ep:ppchar);
  1237. Procedure Execvp(Path: AnsiString; Args:ppchar;Ep:ppchar);
  1238. Procedure Execl(const Todo: String);
  1239. Procedure Execl(const Todo: Ansistring);
  1240. Procedure Execle(Todo: String;Ep:ppchar);
  1241. Procedure Execle(Todo: AnsiString;Ep:ppchar);
  1242. Procedure Execlp(Todo: string;Ep:ppchar);
  1243. Procedure Execlp(Todo: Ansistring;Ep:ppchar);
  1244. Function Shell(const Command:String):Longint;
  1245. Function Shell(const Command:AnsiString):Longint;
  1246. Function Fork:longint;
  1247. {Clone for FreeBSD is copied from the LinuxThread port, and rfork based}
  1248. function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
  1249. Procedure ExitProcess(val:longint);
  1250. Function WaitPid(Pid:longint;Status:pointer;Options:Longint):Longint; {=>PID (Status Valid), 0 (No Status), -1: Error, special case errno=EINTR }
  1251. Function WaitProcess(Pid:longint):Longint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
  1252. Procedure Nice(N:integer);
  1253. Function GetPriority(Which,Who:Integer):integer;
  1254. Procedure SetPriority(Which:Integer;Who:Integer;What:Integer);
  1255. function WEXITSTATUS(Status: Integer): Integer;
  1256. function WTERMSIG(Status: Integer): Integer;
  1257. function WSTOPSIG(Status: Integer): Integer;
  1258. Function WIFEXITED(Status: Integer): Boolean;
  1259. Function WIFSTOPPED(Status: Integer): Boolean;
  1260. Function WIFSIGNALED(Status: Integer): Boolean;
  1261. Function W_EXITCODE(ReturnCode, Signal: Integer): Integer;
  1262. Function W_STOPCODE(Signal: Integer): Integer;
  1263. Function GetPid:LongInt;
  1264. Function GetPPid:LongInt;
  1265. Function GetUid:Longint;
  1266. Function GetEUid:Longint;
  1267. Function GetGid:Longint;
  1268. Function GetEGid:Longint;
  1269. {**************************
  1270. File Handling
  1271. ***************************}
  1272. Function fdOpen(pathname:string;flags:longint):longint;
  1273. Function fdOpen(pathname:string;flags,mode:longint):longint;
  1274. Function fdOpen(pathname:pchar;flags:longint):longint;
  1275. Function fdOpen(pathname:pchar;flags,mode:longint):longint;
  1276. Function fdClose(fd:longint):boolean;
  1277. Function fdRead(fd:longint;var buf;size:longint):longint;
  1278. Function fdWrite(fd:longint;const buf;size:longint):longint;
  1279. Function fdTruncate(fd,size:longint):boolean;
  1280. Function fdSeek (fd,pos,seektype :longint): longint;
  1281. Function fdFlush (fd : Longint) : Boolean;
  1282. Function Link(OldPath,NewPath:pathstr):boolean;
  1283. Function SymLink(OldPath,NewPath:pathstr):boolean;
  1284. Function ReadLink(name,linkname:pchar;maxlen:longint):longint;
  1285. Function ReadLink(name:pathstr):pathstr;
  1286. Function UnLink(Path:pathstr):boolean;
  1287. Function UnLink(Path:pchar):Boolean;
  1288. Function FReName (OldName,NewName : Pchar) : Boolean;
  1289. Function FReName (OldName,NewName : String) : Boolean;
  1290. Function Chown(path:pathstr;NewUid,NewGid:longint):boolean;
  1291. Function Chmod(path:pathstr;Newmode:longint):boolean;
  1292. Function Utime(const path:pathstr;utim:utimebuf):boolean;
  1293. Function Access(Path:Pathstr ;mode:integer):boolean;
  1294. Function Umask(Mask:Integer):integer;
  1295. Function Flock (fd,mode : longint) : boolean;
  1296. Function Flock (var T : text;mode : longint) : boolean;
  1297. Function Flock (var F : File;mode : longint) : boolean;
  1298. Function FStat(Path:Pathstr;Var Info:stat):Boolean;
  1299. Function FStat(Fd:longint;Var Info:stat):Boolean;
  1300. Function FStat(var F:Text;Var Info:stat):Boolean;
  1301. Function FStat(var F:File;Var Info:stat):Boolean;
  1302. Function Lstat(Filename: PathStr;var Info:stat):Boolean;
  1303. Function FSStat(Path:Pathstr;Var Info:statfs):Boolean;
  1304. Function FSStat(Fd: Longint;Var Info:statfs):Boolean;
  1305. Function Fcntl(Fd:longint;Cmd:longint):longint;
  1306. Procedure Fcntl(Fd:longint;Cmd:longint;Arg:Longint);
  1307. Function Fcntl(var Fd:Text;Cmd:longint):longint;
  1308. Procedure Fcntl(var Fd:Text;Cmd:longint;Arg:Longint);
  1309. Function Dup(oldfile:longint;var newfile:longint):Boolean;
  1310. Function Dup(var oldfile,newfile:text):Boolean;
  1311. Function Dup(var oldfile,newfile:file):Boolean;
  1312. Function Dup2(oldfile,newfile:longint):Boolean;
  1313. Function Dup2(var oldfile,newfile:text):Boolean;
  1314. Function Dup2(var oldfile,newfile:file):Boolean;
  1315. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
  1316. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
  1317. Function SelectText(var T:Text;TimeOut :PTimeVal):Longint;
  1318. Function SelectText(var T:Text;TimeOut :Longint):Longint;
  1319. {**************************
  1320. Directory Handling
  1321. ***************************}
  1322. {$ifndef newreaddir} {only for FreeBSD, temporary solution}
  1323. Function OpenDir(f:pchar):pdir;
  1324. Function OpenDir(f: String):pdir;
  1325. function CloseDir(p:pdir):integer;
  1326. Function ReadDir(p:pdir):pdirent;
  1327. procedure SeekDir(p:pdir;off:longint);
  1328. function TellDir(p:pdir):longint;
  1329. {$else}
  1330. Function OpenDir(name:pchar):pdir;
  1331. Function OpenDir(f: String):pdir;
  1332. function CloseDir(dirp:pdir):integer;
  1333. Function ReadDir(p:pdir):pdirent;
  1334. procedure SeekDir(dirp:pdir;loc:longint);
  1335. function TellDir(dirp:pdir):longint;
  1336. {$endif}
  1337. {**************************
  1338. Pipe/Fifo/Stream
  1339. ***************************}
  1340. Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
  1341. Function AssignPipe(var pipe_in,pipe_out:text):boolean;
  1342. Function AssignPipe(var pipe_in,pipe_out:file):boolean;
  1343. Function PClose(Var F:text) : longint;
  1344. Function PClose(Var F:file) : longint;
  1345. Procedure POpen(var F:text;const Prog:String;rw:char);
  1346. Procedure POpen(var F:file;const Prog:String;rw:char);
  1347. Function mkFifo(pathname:string;mode:longint):boolean;
  1348. function AssignStream(Var StreamIn,Streamout:text;Const Prog:String) : longint;
  1349. function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: String): LongInt;
  1350. {**************************
  1351. General information
  1352. ***************************}
  1353. Function GetEnv(P:string):Pchar;
  1354. Function GetDomainName:String;
  1355. Function GetHostName:String;
  1356. Function Sysinfo(var Info:TSysinfo):Boolean;
  1357. Function Uname(var unamerec:utsname):Boolean;
  1358. {**************************
  1359. Signal
  1360. ***************************}
  1361. Procedure SigAction(Signum:longint;Act,OldAct:PSigActionRec );
  1362. Procedure SigProcMask (How:longint;SSet,OldSSet:PSigSet);
  1363. Function SigPending:SigSet;
  1364. Procedure SigSuspend(Mask:Sigset);
  1365. Function Signal(Signum:longint;Handler:SignalHandler):SignalHandler;
  1366. Function Kill(Pid:longint;Sig:longint):integer;
  1367. Procedure SigRaise(Sig:integer);
  1368. Function Alarm(Sec : Longint) : longint;
  1369. Procedure Pause;
  1370. Function NanoSleep(const req : timespec;var rem : timespec) : longint;
  1371. {**************************
  1372. IOCtl/Termios Functions
  1373. ***************************}
  1374. Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
  1375. Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
  1376. Function TCSetAttr(fd:longint;OptAct:longint;const tios:TermIOS):boolean;
  1377. Procedure CFSetISpeed(var tios:TermIOS;speed:Cardinal);
  1378. Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal);
  1379. Procedure CFMakeRaw(var tios:TermIOS);
  1380. Function TCSendBreak(fd,duration:longint):boolean;
  1381. Function TCSetPGrp(fd,id:longint):boolean;
  1382. Function TCGetPGrp(fd:longint;var id:longint):boolean;
  1383. Function TCFlush(fd,qsel:longint):boolean;
  1384. Function TCDrain(fd:longint):boolean;
  1385. Function TCFlow(fd,act:longint):boolean;
  1386. Function IsATTY(Handle:Longint):Boolean;
  1387. Function IsATTY(var f:text):Boolean;
  1388. function TTYname(Handle:Longint):string;
  1389. function TTYname(var F:Text):string;
  1390. {**************************
  1391. Memory functions
  1392. ***************************}
  1393. const
  1394. PROT_READ = $1; { page can be read }
  1395. PROT_WRITE = $2; { page can be written }
  1396. PROT_EXEC = $4; { page can be executed }
  1397. PROT_NONE = $0; { page can not be accessed }
  1398. MAP_SHARED = $1; { Share changes }
  1399. // MAP_PRIVATE = $2; { Changes are private }
  1400. MAP_TYPE = $f; { Mask for type of mapping }
  1401. MAP_FIXED = $10; { Interpret addr exactly }
  1402. // MAP_ANONYMOUS = $20; { don't use a file }
  1403. MAP_GROWSDOWN = $100; { stack-like segment }
  1404. MAP_DENYWRITE = $800; { ETXTBSY }
  1405. MAP_EXECUTABLE = $1000; { mark it as an executable }
  1406. MAP_LOCKED = $2000; { pages are locked }
  1407. MAP_NORESERVE = $4000; { don't check for reservations }
  1408. type
  1409. tmmapargs=record
  1410. address : longint;
  1411. size : longint;
  1412. prot : longint;
  1413. flags : longint;
  1414. fd : longint;
  1415. offset : longint;
  1416. end;
  1417. function MMap(const m:tmmapargs):longint;
  1418. function MUnMap (P : Pointer; Size : Longint) : Boolean;
  1419. {**************************
  1420. Port IO functions
  1421. ***************************}
  1422. Function IOperm (From,Num : Cardinal; Value : Longint) : boolean;
  1423. Function IoPL(Level : longint) : Boolean;
  1424. {$ifdef cpui386}
  1425. Procedure WritePort (Port : Longint; Value : Byte);oldfpccall;
  1426. Procedure WritePort (Port : Longint; Value : Word);oldfpccall;
  1427. Procedure WritePort (Port : Longint; Value : Longint);oldfpccall;
  1428. Procedure WritePortB (Port : Longint; Value : Byte);oldfpccall;
  1429. Procedure WritePortW (Port : Longint; Value : Word);oldfpccall;
  1430. Procedure WritePortL (Port : Longint; Value : Longint);oldfpccall;
  1431. Procedure WritePortL (Port : Longint; Var Buf; Count: longint);oldfpccall;
  1432. Procedure WritePortW (Port : Longint; Var Buf; Count: longint);oldfpccall;
  1433. Procedure WritePortB (Port : Longint; Var Buf; Count: longint);oldfpccall;
  1434. Procedure ReadPort (Port : Longint; Var Value : Byte);oldfpccall;
  1435. Procedure ReadPort (Port : Longint; Var Value : Word);oldfpccall;
  1436. Procedure ReadPort (Port : Longint; Var Value : Longint);oldfpccall;
  1437. function ReadPortB (Port : Longint): Byte;oldfpccall;
  1438. function ReadPortW (Port : Longint): Word;oldfpccall;
  1439. function ReadPortL (Port : Longint): LongInt;oldfpccall;
  1440. Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);oldfpccall;
  1441. Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);oldfpccall;
  1442. Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);oldfpccall;
  1443. {$endif}
  1444. {**************************
  1445. Utility functions
  1446. ***************************}
  1447. Function Octal(l:longint):longint;
  1448. Function FExpand(Const Path: PathStr):PathStr;
  1449. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  1450. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  1451. Function Dirname(Const path:pathstr):pathstr;
  1452. Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
  1453. Function FNMatch(const Pattern,Name:string):Boolean;
  1454. Function Glob(Const path:pathstr):pglob;
  1455. Procedure Globfree(var p:pglob);
  1456. Function StringToPPChar(Var S:String):ppchar;
  1457. Function StringToPPChar(Var S:AnsiString):ppchar;
  1458. Function StringToPPChar(S : Pchar):ppchar;
  1459. Function GetFS(var T:Text):longint;
  1460. Function GetFS(Var F:File):longint;
  1461. {Filedescriptorsets}
  1462. Procedure FD_Zero(var fds:fdSet);
  1463. Procedure FD_Clr(fd:longint;var fds:fdSet);
  1464. Procedure FD_Set(fd:longint;var fds:fdSet);
  1465. Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
  1466. {Stat.Mode Types}
  1467. Function S_ISLNK(m:word):boolean;
  1468. Function S_ISREG(m:word):boolean;
  1469. Function S_ISDIR(m:word):boolean;
  1470. Function S_ISCHR(m:word):boolean;
  1471. Function S_ISBLK(m:word):boolean;
  1472. Function S_ISFIFO(m:word):boolean;
  1473. Function S_ISSOCK(m:word):boolean;
  1474. {******************************************************************************
  1475. Implementation
  1476. ******************************************************************************}
  1477. Implementation
  1478. Uses Strings;
  1479. { Get the definitions of textrec and filerec }
  1480. {$i textrec.inc}
  1481. {$i filerec.inc}
  1482. {No debugging for syslinux include !}
  1483. {$IFDEF SYS_LINUX}
  1484. {$UNDEF SYSCALL_DEBUG}
  1485. {$ENDIF SYS_LINUX}
  1486. {*****************************************************************************
  1487. --- Main:The System Call Self ---
  1488. *****************************************************************************}
  1489. {$ifdef FPC_PROFILE}
  1490. {$define PROFILE_WAS_ACTIVE}
  1491. {$profile off}
  1492. {$else}
  1493. {$undef PROFILE_WAS_ACTIVE}
  1494. {$endif}
  1495. Procedure Do_SysCall( callnr:longint;var regs : SysCallregs );oldfpccall;assembler;
  1496. {
  1497. This function puts the registers in place, does the call, and then
  1498. copies back the registers as they are after the SysCall.
  1499. }
  1500. {$ifdef cpui386}
  1501. {$ASMMODE ATT}
  1502. asm
  1503. { load the registers... }
  1504. movl 12(%ebp),%eax
  1505. movl 4(%eax),%ebx
  1506. movl 8(%eax),%ecx
  1507. movl 12(%eax),%edx
  1508. movl 16(%eax),%esi
  1509. movl 20(%eax),%edi
  1510. { set the call number }
  1511. movl 8(%ebp),%eax
  1512. { Go ! }
  1513. int $0x80
  1514. { Put back the registers... }
  1515. pushl %eax
  1516. movl 12(%ebp),%eax
  1517. movl %edi,20(%eax)
  1518. movl %esi,16(%eax)
  1519. movl %edx,12(%eax)
  1520. movl %ecx,8(%eax)
  1521. movl %ebx,4(%eax)
  1522. popl %ebx
  1523. movl %ebx,(%eax)
  1524. end;
  1525. {$ASMMODE DEFAULT}
  1526. {$else}
  1527. {$ifdef cpum68k}
  1528. asm
  1529. { load the registers... }
  1530. move.l 12(a6),a0
  1531. move.l 4(a0),d1
  1532. move.l 8(a0),d2
  1533. move.l 12(a0),d3
  1534. move.l 16(a0),d4
  1535. move.l 20(a0),d5
  1536. { set the call number }
  1537. move.l 8(a6),d0
  1538. { Go ! }
  1539. trap #0
  1540. { Put back the registers... }
  1541. move.l d0,-(sp)
  1542. move.l 12(a6),a0
  1543. move.l d5,20(a0)
  1544. move.l d4,16(a0)
  1545. move.l d3,12(a0)
  1546. move.l d2,8(a0)
  1547. move.l d1,4(a0)
  1548. move.l (sp)+,d1
  1549. move.l d1,(a0)
  1550. end;
  1551. {$else}
  1552. {$error Cannot decide which processor you have ! define cpui386 or m68k }
  1553. {$endif}
  1554. {$endif}
  1555. {$IFDEF SYSCALL_DEBUG}
  1556. Const
  1557. DoSysCallDebug : Boolean = False;
  1558. var
  1559. LastCnt,
  1560. LastEax,
  1561. LastCall : longint;
  1562. DebugTxt : string[20];
  1563. {$ENDIF}
  1564. Function SysCall( callnr:longint;var regs : SysCallregs ):longint;
  1565. {
  1566. This function serves as an interface to do_SysCall.
  1567. If the SysCall returned a negative number, it returns -1, and puts the
  1568. SysCall result in errno. Otherwise, it returns the SysCall return value
  1569. }
  1570. begin
  1571. do_SysCall(callnr,regs);
  1572. if (regs.reg1<0) and (regs.reg1>=-Sys_ERROR_MAX) then
  1573. begin
  1574. {$IFDEF SYSCALL_DEBUG}
  1575. If DoSysCallDebug then
  1576. debugtxt:=' syscall error: ';
  1577. {$endif}
  1578. ErrNo:=-regs.reg1;
  1579. SysCall:=-1;
  1580. end
  1581. else
  1582. begin
  1583. {$IFDEF SYSCALL_DEBUG}
  1584. if DoSysCallDebug then
  1585. debugtxt:=' syscall returned: ';
  1586. {$endif}
  1587. SysCall:=regs.reg1;
  1588. errno:=0
  1589. end;
  1590. {$IFDEF SYSCALL_DEBUG}
  1591. if DoSysCallDebug then
  1592. begin
  1593. inc(lastcnt);
  1594. if (callnr<>lastcall) or (regs.reg1<>lasteax) then
  1595. begin
  1596. if lastcnt>1 then
  1597. writeln(sys_nr_txt[lastcall],debugtxt,lasteax,' (',lastcnt,'x)');
  1598. lastcall:=callnr;
  1599. lasteax:=regs.reg1;
  1600. lastcnt:=0;
  1601. writeln(sys_nr_txt[lastcall],debugtxt,lasteax);
  1602. end;
  1603. end;
  1604. {$endif}
  1605. end;
  1606. {$ifdef PROFILE_WAS_ACTIVE}
  1607. {$profile on}
  1608. {$undef PROFILE_WAS_ACTIVE}
  1609. {$endif}
  1610. Function Sys_Time:longint;
  1611. var
  1612. regs : SysCallregs;
  1613. begin
  1614. regs.reg2:=0;
  1615. Sys_Time:=SysCall(SysCall_nr_time,regs);
  1616. end;
  1617. {*****************************************************************************
  1618. --- File:File handling related calls ---
  1619. *****************************************************************************}
  1620. Function Sys_Open(f:pchar;flags:longint;mode:integer):longint;
  1621. var
  1622. regs : SysCallregs;
  1623. Begin
  1624. regs.reg2:=longint(f);
  1625. regs.reg3:=flags;
  1626. regs.reg4:=mode;
  1627. Sys_Open:=SysCall(SysCall_nr_open,regs);
  1628. End;
  1629. Function Sys_Close(f:longint):longint;
  1630. var
  1631. regs : SysCallregs;
  1632. begin
  1633. regs.reg2:=f;
  1634. Sys_Close:=SysCall(SysCall_nr_close,regs);
  1635. end;
  1636. Function Sys_Lseek(F:longint;Off:longint;Whence:longint):longint;
  1637. var
  1638. regs : SysCallregs;
  1639. begin
  1640. regs.reg2:=f;
  1641. regs.reg3:=off;
  1642. regs.reg4:=Whence;
  1643. Sys_lseek:=SysCall(SysCall_nr_lseek,regs);
  1644. end;
  1645. Function Sys_Read(f:longint;buffer:pchar;count:longint):longint;
  1646. var
  1647. regs : SysCallregs;
  1648. begin
  1649. regs.reg2:=f;
  1650. regs.reg3:=longint(buffer);
  1651. regs.reg4:=count;
  1652. Sys_Read:=SysCall(SysCall_nr_read,regs);
  1653. end;
  1654. Function Sys_Write(f:longint;buffer:pchar;count:longint):longint;
  1655. var
  1656. regs : SysCallregs;
  1657. begin
  1658. regs.reg2:=f;
  1659. regs.reg3:=longint(buffer);
  1660. regs.reg4:=count;
  1661. Sys_Write:=SysCall(SysCall_nr_write,regs);
  1662. end;
  1663. Function Sys_Unlink(Filename:pchar):longint;
  1664. var
  1665. regs : SysCallregs;
  1666. begin
  1667. regs.reg2:=longint(filename);
  1668. Sys_Unlink:=SysCall(SysCall_nr_unlink,regs);
  1669. end;
  1670. Function Sys_fstat(fd : longint;var Info:stat):Longint;
  1671. var
  1672. regs : SysCallregs;
  1673. begin
  1674. regs.reg2:=fd;
  1675. regs.reg3:=longint(@Info);
  1676. Sys_fStat:=SysCall(SysCall_nr_fstat,regs);
  1677. end;
  1678. Function Sys_Rename(Oldname,Newname:pchar):longint;
  1679. var
  1680. regs : SysCallregs;
  1681. begin
  1682. regs.reg2:=longint(oldname);
  1683. regs.reg3:=longint(newname);
  1684. Sys_Rename:=SysCall(SysCall_nr_rename,regs);
  1685. end;
  1686. Function Sys_Stat(Filename:pchar;var Buffer: stat):longint;
  1687. {
  1688. We need this for getcwd
  1689. }
  1690. var
  1691. regs : SysCallregs;
  1692. begin
  1693. regs.reg2:=longint(filename);
  1694. regs.reg3:=longint(@buffer);
  1695. Sys_Stat:=SysCall(SysCall_nr_stat,regs);
  1696. end;
  1697. Function Sys_Symlink(oldname,newname:pchar):longint;
  1698. {
  1699. We need this for erase
  1700. }
  1701. var
  1702. regs : SysCallregs;
  1703. begin
  1704. regs.reg2:=longint(oldname);
  1705. regs.reg3:=longint(newname);
  1706. Sys_symlink:=SysCall(SysCall_nr_symlink,regs);
  1707. end;
  1708. Function Sys_ReadLink(name,linkname:pchar;maxlen:longint):longint;
  1709. var
  1710. regs : SysCallRegs;
  1711. begin
  1712. regs.reg2:=longint(name);
  1713. regs.reg3:=longint(linkname);
  1714. regs.reg4:=maxlen;
  1715. Sys_ReadLink:=SysCall(Syscall_nr_readlink,regs);
  1716. end;
  1717. {*****************************************************************************
  1718. --- Directory:Directory related calls ---
  1719. *****************************************************************************}
  1720. Function Sys_Chdir(Filename:pchar):longint;
  1721. var
  1722. regs : SysCallregs;
  1723. begin
  1724. regs.reg2:=longint(filename);
  1725. Sys_ChDir:=SysCall(SysCall_nr_chdir,regs);
  1726. end;
  1727. Function Sys_Mkdir(Filename:pchar;mode:longint):longint;
  1728. var
  1729. regs : SysCallregs;
  1730. begin
  1731. regs.reg2:=longint(filename);
  1732. regs.reg3:=mode;
  1733. Sys_MkDir:=SysCall(SysCall_nr_mkdir,regs);
  1734. end;
  1735. Function Sys_Rmdir(Filename:pchar):longint;
  1736. var
  1737. regs : SysCallregs;
  1738. begin
  1739. regs.reg2:=longint(filename);
  1740. Sys_Rmdir:=SysCall(SysCall_nr_rmdir,regs);
  1741. end;
  1742. { we need this for getcwd }
  1743. Function OpenDir(f:pchar):pdir;
  1744. var
  1745. fd:integer;
  1746. st:stat;
  1747. ptr:pdir;
  1748. begin
  1749. opendir:=nil;
  1750. if sys_stat(f,st)<0 then
  1751. exit;
  1752. { Is it a dir ? }
  1753. if not((st.mode and $f000)=$4000)then
  1754. begin
  1755. errno:=sys_enotdir;
  1756. exit
  1757. end;
  1758. { Open it}
  1759. fd:=sys_open(f,OPEN_RDONLY,438);
  1760. if fd<0 then
  1761. exit;
  1762. new(ptr);
  1763. if ptr=nil then
  1764. exit;
  1765. new(ptr^.buf);
  1766. if ptr^.buf=nil then
  1767. exit;
  1768. ptr^.fd:=fd;
  1769. ptr^.loc:=0;
  1770. ptr^.size:=0;
  1771. ptr^.dd_max:=sizeof(ptr^.buf^);
  1772. opendir:=ptr;
  1773. end;
  1774. function CloseDir(p:pdir):integer;
  1775. begin
  1776. closedir:=sys_close(p^.fd);
  1777. dispose(p^.buf);
  1778. dispose(p);
  1779. end;
  1780. Function Sys_ReadDir(p:pdir):pdirent;
  1781. var
  1782. regs :SysCallregs;
  1783. dummy:longint;
  1784. begin
  1785. regs.reg3:=longint(p^.buf);
  1786. regs.reg2:=p^.fd;
  1787. regs.reg4:=1;
  1788. dummy:=SysCall(SysCall_nr_readdir,regs);
  1789. { the readdir system call returns the number of bytes written }
  1790. if dummy=0 then
  1791. sys_readdir:=nil
  1792. else
  1793. sys_readdir:=p^.buf
  1794. end;
  1795. {*****************************************************************************
  1796. --- Process:Process & program handling - related calls ---
  1797. *****************************************************************************}
  1798. Function Sys_GetPid:LongInt;
  1799. var
  1800. regs : SysCallregs;
  1801. begin
  1802. Sys_GetPid:=SysCall(SysCall_nr_getpid,regs);
  1803. end;
  1804. Procedure Sys_Exit(ExitCode:Integer);
  1805. var
  1806. regs : SysCallregs;
  1807. begin
  1808. regs.reg2:=exitcode;
  1809. SysCall(SysCall_nr_exit,regs)
  1810. end;
  1811. Procedure SigAction(Signum:longint;Act,OldAct:PSigActionRec );
  1812. {
  1813. Change action of process upon receipt of a signal.
  1814. Signum specifies the signal (all except SigKill and SigStop).
  1815. If Act is non-nil, it is used to specify the new action.
  1816. If OldAct is non-nil the previous action is saved there.
  1817. }
  1818. Var
  1819. sr : Syscallregs;
  1820. begin
  1821. sr.reg2:=Signum;
  1822. sr.reg3:=Longint(act);
  1823. sr.reg4:=Longint(oldact);
  1824. SysCall(Syscall_nr_sigaction,sr);
  1825. end;
  1826. function Sys_FTruncate(Handle,Pos:longint):longint; //moved from sysunix.inc Do_Truncate
  1827. var
  1828. sr : syscallregs;
  1829. begin
  1830. sr.reg2:=Handle;
  1831. sr.reg3:=Pos;
  1832. Sys_FTruncate:=syscall(syscall_nr_ftruncate,sr);
  1833. end;
  1834. Function Sys_mmap(adr,len,prot,flags,fdes,off:longint):longint; // moved from sysunix.inc, used in sbrk
  1835. type
  1836. tmmapargs=packed record
  1837. address : longint;
  1838. size : longint;
  1839. prot : longint;
  1840. flags : longint;
  1841. fd : longint;
  1842. offset : longint;
  1843. end;
  1844. var
  1845. t : syscallregs;
  1846. mmapargs : tmmapargs;
  1847. begin
  1848. mmapargs.address:=adr;
  1849. mmapargs.size:=len;
  1850. mmapargs.prot:=prot;
  1851. mmapargs.flags:=flags;
  1852. mmapargs.fd:=fdes;
  1853. mmapargs.offset:=off;
  1854. t.reg2:=longint(@mmapargs);
  1855. do_syscall(syscall_nr_mmap,t);
  1856. Sys_mmap:=t.reg1;
  1857. if t.reg1=-1 then
  1858. errno:=-1;
  1859. end;
  1860. {
  1861. Interface to Unix ioctl call.
  1862. Performs various operations on the filedescriptor Handle.
  1863. Ndx describes the operation to perform.
  1864. Data points to data needed for the Ndx function. The structure of this
  1865. data is function-dependent.
  1866. }
  1867. Function Sys_IOCtl(Handle,Ndx: Longint;Data: Pointer):LongInt; // This was missing here, instead hardcode in Do_IsDevice
  1868. var
  1869. sr: SysCallRegs;
  1870. begin
  1871. sr.reg2:=Handle;
  1872. sr.reg3:=Ndx;
  1873. sr.reg4:=Longint(Data);
  1874. Sys_IOCtl:=SysCall(Syscall_nr_ioctl,sr);
  1875. end;
  1876. Function Sys_SigAltStack(ss, oss :psigaltstack):longint;
  1877. var
  1878. regs : SysCallregs;
  1879. begin
  1880. regs.reg2:=longint(ss);
  1881. regs.reg3:=longint(oss);
  1882. sys_sigaltstack:=SysCall(syscall_nr_sigaltstack,regs);
  1883. end;
  1884. Function Fork:longint;
  1885. {
  1886. This function issues the 'fork' System call. the program is duplicated in memory
  1887. and Execution continues in parent and child process.
  1888. In the parent process, fork returns the PID of the child. In the child process,
  1889. zero is returned.
  1890. A negative value indicates that an error has occurred, the error is returned in
  1891. LinuxError.
  1892. }
  1893. var
  1894. regs:SysCallregs;
  1895. begin
  1896. Fork:=SysCall(SysCall_nr_fork,regs);
  1897. LinuxError:=Errno;
  1898. End;
  1899. function clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
  1900. begin
  1901. if (pointer(func)=nil) or (sp=nil) then
  1902. begin
  1903. LinuxError:=Sys_EInval;
  1904. exit(-1); // give an error result
  1905. end;
  1906. {$ifdef cpui386}
  1907. {$ASMMODE ATT}
  1908. asm
  1909. { Insert the argument onto the new stack. }
  1910. movl sp,%ecx
  1911. subl $8,%ecx
  1912. movl args,%eax
  1913. movl %eax,4(%ecx)
  1914. { Save the function pointer as the zeroth argument.
  1915. It will be popped off in the child in the ebx frobbing below. }
  1916. movl func,%eax
  1917. movl %eax,0(%ecx)
  1918. { Do the system call }
  1919. pushl %ebx
  1920. movl flags,%ebx
  1921. movl SysCall_nr_clone,%eax
  1922. int $0x80
  1923. popl %ebx
  1924. test %eax,%eax
  1925. jnz .Lclone_end
  1926. { We're in the new thread }
  1927. subl %ebp,%ebp { terminate the stack frame }
  1928. call *%ebx
  1929. { exit process }
  1930. movl %eax,%ebx
  1931. movl $1,%eax
  1932. int $0x80
  1933. .Lclone_end:
  1934. movl %eax,__RESULT
  1935. end;
  1936. {$endif cpui386}
  1937. {$ifdef cpum68k}
  1938. { No yet translated, my m68k assembler is too weak for such things PM }
  1939. (*
  1940. asm
  1941. { Insert the argument onto the new stack. }
  1942. movl sp,%ecx
  1943. subl $8,%ecx
  1944. movl args,%eax
  1945. movl %eax,4(%ecx)
  1946. { Save the function pointer as the zeroth argument.
  1947. It will be popped off in the child in the ebx frobbing below. }
  1948. movl func,%eax
  1949. movl %eax,0(%ecx)
  1950. { Do the system call }
  1951. pushl %ebx
  1952. movl flags,%ebx
  1953. movl SysCall_nr_clone,%eax
  1954. int $0x80
  1955. popl %ebx
  1956. test %eax,%eax
  1957. jnz .Lclone_end
  1958. { We're in the new thread }
  1959. subl %ebp,%ebp { terminate the stack frame }
  1960. call *%ebx
  1961. { exit process }
  1962. movl %eax,%ebx
  1963. movl $1,%eax
  1964. int $0x80
  1965. .Lclone_end:
  1966. movl %eax,__RESULT
  1967. end;
  1968. *)
  1969. {$endif cpum68k}
  1970. end;
  1971. Procedure Execve(path:pathstr;args:ppchar;ep:ppchar);
  1972. {
  1973. Replaces the current program by the program specified in path,
  1974. arguments in args are passed to Execve.
  1975. environment specified in ep is passed on.
  1976. }
  1977. var
  1978. regs:SysCallregs;
  1979. begin
  1980. path:=path+#0;
  1981. regs.reg2:=longint(@path[1]);
  1982. regs.reg3:=longint(args);
  1983. regs.reg4:=longint(ep);
  1984. SysCall(SysCall_nr_Execve,regs);
  1985. { This only gets set when the call fails, otherwise we don't get here ! }
  1986. Linuxerror:=errno;
  1987. end;
  1988. Procedure Execve(path:pchar;args:ppchar;ep:ppchar);
  1989. {
  1990. Replaces the current program by the program specified in path,
  1991. arguments in args are passed to Execve.
  1992. environment specified in ep is passed on.
  1993. }
  1994. var
  1995. regs:SysCallregs;
  1996. begin
  1997. regs.reg2:=longint(path);
  1998. regs.reg3:=longint(args);
  1999. regs.reg4:=longint(ep);
  2000. SysCall(SysCall_nr_Execve,regs);
  2001. { This only gets set when the call fails, otherwise we don't get here ! }
  2002. Linuxerror:=errno;
  2003. end;
  2004. Procedure ExitProcess(val:longint);
  2005. var
  2006. regs : SysCallregs;
  2007. begin
  2008. regs.reg2:=val;
  2009. SysCall(SysCall_nr_exit,regs);
  2010. end;
  2011. Function WaitPid(Pid:longint;Status:pointer;Options:Longint):Longint;
  2012. {
  2013. Waits until a child with PID Pid exits, or returns if it is exited already.
  2014. Any resources used by the child are freed.
  2015. The exit status is reported in the adress referred to by Status. It should
  2016. be a longint.
  2017. }
  2018. var
  2019. regs : SysCallregs;
  2020. begin
  2021. regs.reg2:=pid;
  2022. regs.reg3:=longint(status);
  2023. regs.reg4:=options;
  2024. WaitPid:=SysCall(SysCall_nr_waitpid,regs);
  2025. LinuxError:=errno;
  2026. end;
  2027. Procedure GetTimeOfDay(var tv:timeval);
  2028. {
  2029. Get the number of seconds since 00:00, January 1 1970, GMT
  2030. the time NOT corrected any way
  2031. }
  2032. var
  2033. regs : SysCallregs;
  2034. begin
  2035. regs.reg2:=longint(@tv);
  2036. regs.reg3:=0;
  2037. SysCall(SysCall_nr_gettimeofday,regs);
  2038. LinuxError:=Errno;
  2039. end;
  2040. Function GetPriority(Which,Who:Integer):integer;
  2041. {
  2042. Get Priority of process, process group, or user.
  2043. Which : selects what kind of priority is used.
  2044. can be one of the following predefined Constants :
  2045. Prio_User.
  2046. Prio_PGrp.
  2047. Prio_Process.
  2048. Who : depending on which, this is , respectively :
  2049. Uid
  2050. Pid
  2051. Process Group id
  2052. Errors are reported in linuxerror _only_. (priority can be negative)
  2053. }
  2054. var
  2055. sr : Syscallregs;
  2056. begin
  2057. errno:=0;
  2058. if (which<prio_process) or (which>prio_user) then
  2059. begin
  2060. { We can save an interrupt here }
  2061. getpriority:=0;
  2062. linuxerror:=Sys_einval;
  2063. end
  2064. else
  2065. begin
  2066. sr.reg2:=which;
  2067. sr.reg3:=who;
  2068. getpriority:=SysCall(Syscall_nr_getpriority,sr);
  2069. linuxerror:=errno;
  2070. end;
  2071. end;
  2072. Procedure SetPriority(Which:Integer;Who:Integer;What:Integer);
  2073. {
  2074. Set Priority of process, process group, or user.
  2075. Which : selects what kind of priority is used.
  2076. can be one of the following predefined Constants :
  2077. Prio_User.
  2078. Prio_PGrp.
  2079. Prio_Process.
  2080. Who : depending on value of which, this is, respectively :
  2081. Uid
  2082. Pid
  2083. Process Group id
  2084. what : A number between -20 and 20. -20 is most favorable, 20 least.
  2085. 0 is the default.
  2086. }
  2087. var
  2088. sr : Syscallregs;
  2089. begin
  2090. errno:=0;
  2091. if ((which<prio_process) or (which>prio_user)) or ((what<-20) or (what>20)) then
  2092. linuxerror:=Sys_einval { We can save an interrupt here }
  2093. else
  2094. begin
  2095. sr.reg2:=which;
  2096. sr.reg3:=who;
  2097. sr.reg4:=what;
  2098. SysCall(Syscall_nr_setpriority,sr);
  2099. linuxerror:=errno;
  2100. end;
  2101. end;
  2102. Procedure Nice(N:integer);
  2103. {
  2104. Set process priority. A positive N means a lower priority.
  2105. A negative N decreases priority.
  2106. }
  2107. var
  2108. sr : Syscallregs;
  2109. begin
  2110. sr.reg2:=n;
  2111. SysCall(Syscall_nr_nice,sr);
  2112. linuxerror:=errno;
  2113. end;
  2114. Function GetPid:LongInt;
  2115. {
  2116. Get Process ID.
  2117. }
  2118. var
  2119. regs : SysCallregs;
  2120. begin
  2121. GetPid:=SysCall(SysCall_nr_getpid,regs);
  2122. linuxerror:=errno;
  2123. end;
  2124. Function GetPPid:LongInt;
  2125. {
  2126. Get Process ID of parent process.
  2127. }
  2128. var
  2129. regs : SysCallregs;
  2130. begin
  2131. GetPpid:=SysCall(SysCall_nr_getppid,regs);
  2132. linuxerror:=errno;
  2133. end;
  2134. Function GetUid:Longint;
  2135. {
  2136. Get User ID.
  2137. }
  2138. var
  2139. regs : SysCallregs;
  2140. begin
  2141. GetUid:=SysCall(SysCall_nr_getuid,regs);
  2142. Linuxerror:=errno;
  2143. end;
  2144. Function GetEUid:Longint;
  2145. {
  2146. Get _effective_ User ID.
  2147. }
  2148. var
  2149. regs : SysCallregs;
  2150. begin
  2151. GetEuid:=SysCall(SysCall_nr_geteuid,regs);
  2152. Linuxerror:=errno;
  2153. end;
  2154. Function GetGid:Longint;
  2155. {
  2156. Get Group ID.
  2157. }
  2158. var
  2159. regs : SysCallregs;
  2160. begin
  2161. Getgid:=SysCall(SysCall_nr_getgid,regs);
  2162. Linuxerror:=errno;
  2163. end;
  2164. Function GetEGid:Longint;
  2165. {
  2166. Get _effective_ Group ID.
  2167. }
  2168. var
  2169. regs : SysCallregs;
  2170. begin
  2171. GetEgid:=SysCall(SysCall_nr_getegid,regs);
  2172. Linuxerror:=errno;
  2173. end;
  2174. Function GetTimeOfDay: longint;
  2175. {
  2176. Get the number of seconds since 00:00, January 1 1970, GMT
  2177. the time NOT corrected any way
  2178. }
  2179. var
  2180. regs : SysCallregs;
  2181. tv : timeval;
  2182. begin
  2183. regs.reg2:=longint(@tv);
  2184. regs.reg3:=0;
  2185. SysCall(SysCall_nr_gettimeofday,regs);
  2186. LinuxError:=Errno;
  2187. GetTimeOfDay:=tv.sec;
  2188. end;
  2189. Function fdTruncate(fd,size:longint):boolean;
  2190. var
  2191. Regs : SysCallRegs;
  2192. begin
  2193. Regs.reg2:=fd;
  2194. Regs.reg3:=size;
  2195. fdTruncate:=(SysCall(Syscall_nr_ftruncate,regs)=0);
  2196. LinuxError:=Errno;
  2197. end;
  2198. Function fdFlush (fd : Longint) : Boolean;
  2199. var
  2200. SR: SysCallRegs;
  2201. begin
  2202. SR.reg2 := fd;
  2203. fdFlush := (SysCall(syscall_nr_fsync, SR)=0);
  2204. LinuxError:=Errno;
  2205. end;
  2206. Function Fcntl(Fd:longint;Cmd:longint): longint;
  2207. {
  2208. Read or manipulate a file.(See also fcntl (2) )
  2209. Possible values for Cmd are :
  2210. F_GetFd,F_GetFl,F_GetOwn
  2211. Errors are reported in Linuxerror;
  2212. If Cmd is different from the allowed values, linuxerror=Sys_eninval.
  2213. }
  2214. var
  2215. sr : Syscallregs;
  2216. begin
  2217. if (cmd in [F_GetFd,F_GetFl,F_GetOwn]) then
  2218. begin
  2219. sr.reg2:=Fd;
  2220. sr.reg3:=cmd;
  2221. Linuxerror:=SysCall(Syscall_nr_fcntl,sr);
  2222. if linuxerror=-1 then
  2223. begin
  2224. linuxerror:=errno;
  2225. fcntl:=0;
  2226. end
  2227. else
  2228. begin
  2229. fcntl:=linuxerror;
  2230. linuxerror:=0;
  2231. end;
  2232. end
  2233. else
  2234. begin
  2235. linuxerror:=Sys_einval;
  2236. Fcntl:=0;
  2237. end;
  2238. end;
  2239. Procedure Fcntl(Fd:longint;Cmd:LongInt;Arg:Longint);
  2240. {
  2241. Read or manipulate a file. (See also fcntl (2) )
  2242. Possible values for Cmd are :
  2243. F_setFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkW,F_SetOwn;
  2244. Errors are reported in Linuxerror;
  2245. If Cmd is different from the allowed values, linuxerror=Sys_eninval.
  2246. F_DupFD is not allowed, due to the structure of Files in Pascal.
  2247. }
  2248. var
  2249. sr : Syscallregs;
  2250. begin
  2251. if (cmd in [F_SetFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkw,F_SetOwn]) then
  2252. begin
  2253. sr.reg2:=Fd;
  2254. sr.reg3:=cmd;
  2255. sr.reg4:=arg;
  2256. SysCall(Syscall_nr_fcntl,sr);
  2257. linuxerror:=errno;
  2258. end
  2259. else
  2260. linuxerror:=Sys_einval;
  2261. end;
  2262. Function Chmod(path:pathstr;Newmode:longint):Boolean;
  2263. {
  2264. Changes the permissions of a file.
  2265. }
  2266. var
  2267. sr : Syscallregs;
  2268. begin
  2269. path:=path+#0;
  2270. sr.reg2:=longint(@(path[1]));
  2271. sr.reg3:=newmode;
  2272. Chmod:=(SysCall(Syscall_nr_chmod,sr)=0);
  2273. linuxerror:=errno;
  2274. end;
  2275. Function Chown(path:pathstr;NewUid,NewGid:longint):boolean;
  2276. {
  2277. Change the owner and group of a file.
  2278. A user can only change the group to a group of which he is a member.
  2279. The super-user can change uid and gid of any file.
  2280. }
  2281. var
  2282. sr : Syscallregs;
  2283. begin
  2284. path:=path+#0;
  2285. sr.reg2:=longint(@(path[1]));
  2286. sr.reg3:=newuid;
  2287. sr.reg4:=newgid;
  2288. ChOwn:=(Syscall(Syscall_nr_chown,sr)=0);
  2289. linuxerror:=errno;
  2290. end;
  2291. Function Utime(const path:pathstr;utim:utimebuf):boolean;
  2292. var
  2293. sr : Syscallregs;
  2294. buf : pathstr;
  2295. begin
  2296. buf:=path+#0;
  2297. sr.reg2:=longint(@(buf[1]));
  2298. sr.reg3:=longint(@utim);
  2299. Utime:=SysCall(Syscall_nr_utime,sr)=0;
  2300. linuxerror:=errno;
  2301. end;
  2302. Function Flock (fd,mode : longint) : boolean;
  2303. var
  2304. sr : Syscallregs;
  2305. begin
  2306. sr.reg2:=fd;
  2307. sr.reg3:=mode;
  2308. flock:=Syscall(Syscall_nr_flock,sr)=0;
  2309. LinuxError:=errno;
  2310. end;
  2311. Function Fstat(Fd:Longint;var Info:stat):Boolean;
  2312. {
  2313. Get all information on a file descriptor, and return it in info.
  2314. }
  2315. var
  2316. regs : SysCallregs;
  2317. begin
  2318. regs.reg2:=Fd;
  2319. regs.reg3:=longint(@Info);
  2320. FStat:=(SysCall(SysCall_nr_fstat,regs)=0);
  2321. LinuxError:=Errno;
  2322. end;
  2323. Function Lstat(Filename: PathStr;var Info:stat):Boolean;
  2324. {
  2325. Get all information on a link (the link itself), and return it in info.
  2326. }
  2327. var
  2328. regs : SysCallregs;
  2329. begin
  2330. FileName:=FileName+#0;
  2331. regs.reg2:=longint(@filename[1]);
  2332. regs.reg3:=longint(@Info);
  2333. LStat:=(SysCall(SysCall_nr_lstat,regs)=0);
  2334. LinuxError:=Errno;
  2335. end;
  2336. Function FSStat(Path:Pathstr;Var Info:statfs):Boolean;
  2337. {
  2338. Get all information on a fileSystem, and return it in Info.
  2339. Path is the name of a file/directory on the fileSystem you wish to
  2340. investigate.
  2341. }
  2342. var
  2343. regs : SysCallregs;
  2344. begin
  2345. path:=path+#0;
  2346. regs.reg2:=longint(@path[1]);
  2347. regs.reg3:=longint(@Info);
  2348. FSStat:=(SysCall(SysCall_nr_statfs,regs)=0);
  2349. LinuxError:=errno;
  2350. end;
  2351. Function FSStat(Fd:Longint;Var Info:statfs):Boolean;
  2352. {
  2353. Get all information on a fileSystem, and return it in Info.
  2354. Fd is the file descriptor of a file/directory on the fileSystem
  2355. you wish to investigate.
  2356. }
  2357. var
  2358. regs : SysCallregs;
  2359. begin
  2360. regs.reg2:=Fd;
  2361. regs.reg3:=longint(@Info);
  2362. FSStat:=(SysCall(SysCall_nr_fstatfs,regs)=0);
  2363. LinuxError:=errno;
  2364. end;
  2365. Function Link(OldPath,NewPath:pathstr):boolean;
  2366. {
  2367. Proceduces a hard link from new to old.
  2368. In effect, new will be the same file as old.
  2369. }
  2370. var
  2371. regs : SysCallregs;
  2372. begin
  2373. oldpath:=oldpath+#0;
  2374. newpath:=newpath+#0;
  2375. regs.reg2:=longint(@oldpath[1]);
  2376. regs.reg3:=longint(@newpath[1]);
  2377. Link:=SysCall(SysCall_nr_link,regs)=0;
  2378. linuxerror:=errno;
  2379. end;
  2380. Function Umask(Mask:Integer):integer;
  2381. {
  2382. Sets file creation mask to (Mask and 0777 (octal) ), and returns the
  2383. previous value.
  2384. }
  2385. var
  2386. sr : Syscallregs;
  2387. begin
  2388. sr.reg2:=mask;
  2389. Umask:=SysCall(Syscall_nr_umask,sr);
  2390. linuxerror:=0;
  2391. end;
  2392. Function Access(Path:Pathstr ;mode:integer):boolean;
  2393. {
  2394. Test users access rights on the specified file.
  2395. Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
  2396. R,W,X stand for read,write and Execute access, simultaneously.
  2397. F_OK checks whether the test would be allowed on the file.
  2398. i.e. It checks the search permissions in all directory components
  2399. of the path.
  2400. The test is done with the real user-ID, instead of the effective.
  2401. If access is denied, or an error occurred, false is returned.
  2402. If access is granted, true is returned.
  2403. Errors other than no access,are reported in linuxerror.
  2404. }
  2405. var
  2406. sr : Syscallregs;
  2407. begin
  2408. path:=path+#0;
  2409. sr.reg2:=longint(@(path[1]));
  2410. sr.reg3:=mode;
  2411. access:=(SysCall(Syscall_nr_access,sr)=0);
  2412. linuxerror:=errno;
  2413. end;
  2414. Function Dup(oldfile:longint;var newfile:longint):Boolean;
  2415. {
  2416. Copies the filedescriptor oldfile to newfile
  2417. }
  2418. var
  2419. sr : Syscallregs;
  2420. begin
  2421. sr.reg2:=oldfile;
  2422. newfile:=Syscall(Syscall_nr_dup,sr);
  2423. linuxerror:=errno;
  2424. Dup:=(LinuxError=0);
  2425. end;
  2426. Function Dup2(oldfile,newfile:longint):Boolean;
  2427. {
  2428. Copies the filedescriptor oldfile to newfile
  2429. }
  2430. var
  2431. sr : Syscallregs;
  2432. begin
  2433. sr.reg2:=oldfile;
  2434. sr.reg3:=newfile;
  2435. SysCall(Syscall_nr_dup2,sr);
  2436. linuxerror:=errno;
  2437. Dup2:=(LinuxError=0);
  2438. end;
  2439. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
  2440. {
  2441. Select checks whether the file descriptor sets in readfs/writefs/exceptfs
  2442. have changed.
  2443. }
  2444. Var
  2445. SelectArray : Array[1..5] of longint;
  2446. Sr : Syscallregs;
  2447. begin
  2448. SelectArray[1]:=n;
  2449. SelectArray[2]:=longint(Readfds);
  2450. Selectarray[3]:=longint(Writefds);
  2451. selectarray[4]:=longint(exceptfds);
  2452. Selectarray[5]:=longint(TimeOut);
  2453. sr.reg2:=longint(@selectarray);
  2454. Select:=SysCall(Syscall_nr_select,sr);
  2455. LinuxError:=Errno;
  2456. end;
  2457. Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
  2458. {
  2459. Sets up a pair of file variables, which act as a pipe. The first one can
  2460. be read from, the second one can be written to.
  2461. If the operation was unsuccesful, linuxerror is set.
  2462. }
  2463. var
  2464. pip : tpipe;
  2465. regs : SysCallregs;
  2466. begin
  2467. regs.reg2:=longint(@pip);
  2468. SysCall(SysCall_nr_pipe,regs);
  2469. pipe_in:=pip[1];
  2470. pipe_out:=pip[2];
  2471. linuxerror:=errno;
  2472. AssignPipe:=(LinuxError=0);
  2473. end;
  2474. Function PClose(Var F:text) :longint;
  2475. var
  2476. sr : syscallregs;
  2477. pl : ^longint;
  2478. res : longint;
  2479. begin
  2480. sr.reg2:=Textrec(F).Handle;
  2481. SysCall (syscall_nr_close,sr);
  2482. { closed our side, Now wait for the other - this appears to be needed ?? }
  2483. pl:=plongint(@(textrec(f).userdata[2]));
  2484. waitpid(pl^,@res,0);
  2485. pclose:=res shr 8;
  2486. end;
  2487. Function PClose(Var F:file) : longint;
  2488. var
  2489. sr : syscallregs;
  2490. pl : ^longint;
  2491. res : longint;
  2492. begin
  2493. sr.reg2:=FileRec(F).Handle;
  2494. SysCall (Syscall_nr_close,sr);
  2495. { closed our side, Now wait for the other - this appears to be needed ?? }
  2496. pl:=plongint(@(filerec(f).userdata[2]));
  2497. waitpid(pl^,@res,0);
  2498. pclose:=res shr 8;
  2499. end;
  2500. Function Sysinfo(var Info:TSysinfo):Boolean;
  2501. {
  2502. Get system info
  2503. }
  2504. var
  2505. regs : SysCallregs;
  2506. Begin
  2507. regs.reg2:=longint(@info);
  2508. Sysinfo:=SysCall(SysCall_nr_Sysinfo,regs)=0;
  2509. End;
  2510. Function mkFifo(pathname:string;mode:longint):boolean;
  2511. var
  2512. regs : SysCallRegs;
  2513. begin
  2514. pathname:=pathname+#0;
  2515. regs.reg2:=longint(@pathname[1]);
  2516. regs.reg3:=mode or STAT_IFIFO;
  2517. regs.reg4:=0;
  2518. mkFifo:=(SysCall(syscall_nr_mknod,regs)=0);
  2519. end;
  2520. Function Uname(var unamerec:utsname):Boolean;
  2521. {
  2522. Get machine's names
  2523. }
  2524. var
  2525. regs : SysCallregs;
  2526. Begin
  2527. regs.reg2:=longint(@unamerec);
  2528. Uname:=SysCall(SysCall_nr_uname,regs)=0;
  2529. LinuxError:=Errno;
  2530. End;
  2531. Function Kill(Pid:longint;Sig:longint):integer;
  2532. {
  2533. Send signal 'sig' to a process, or a group of processes.
  2534. If Pid > 0 then the signal is sent to pid
  2535. pid=-1 to all processes except process 1
  2536. pid < -1 to process group -pid
  2537. Return value is zero, except for case three, where the return value
  2538. is the number of processes to which the signal was sent.
  2539. }
  2540. var
  2541. regs : Syscallregs;
  2542. begin
  2543. regs.reg2:=Pid;
  2544. regs.reg3:=Sig;
  2545. kill:=SysCall(Syscall_nr_kill,regs);
  2546. if kill<0 then
  2547. Kill:=0;
  2548. linuxerror:=errno;
  2549. end;
  2550. Procedure SigProcMask(How:longint;SSet,OldSSet:PSigSet);
  2551. {
  2552. Change the list of currently blocked signals.
  2553. How determines which signals will be blocked :
  2554. SigBlock : Add SSet to the current list of blocked signals
  2555. SigUnBlock : Remove the signals in SSet from the list of blocked signals.
  2556. SigSetMask : Set the list of blocked signals to SSet
  2557. if OldSSet is non-null, the old set will be saved there.
  2558. }
  2559. Var
  2560. sr : SyscallRegs;
  2561. begin
  2562. sr.reg2:=how;
  2563. sr.reg3:=longint(SSet);
  2564. sr.reg4:=longint(OldSSet);
  2565. SysCall(Syscall_nr_sigprocmask,sr);
  2566. linuxerror:=errno;
  2567. end;
  2568. Function SigPending:SigSet;
  2569. {
  2570. Allows examination of pending signals. The signal mask of pending
  2571. signals is set in SSet
  2572. }
  2573. Var
  2574. sr : SyscallRegs;
  2575. dummy : Sigset;
  2576. begin
  2577. sr.reg2:=longint(@dummy);
  2578. SysCall(Syscall_nr_sigpending,sr);
  2579. linuxerror:=errno;
  2580. Sigpending:=dummy;
  2581. end;
  2582. Procedure SigSuspend(Mask:Sigset);
  2583. {
  2584. Set the signal mask with Mask, and suspend the program until a signal
  2585. is received.
  2586. }
  2587. Var
  2588. sr : SyscallRegs;
  2589. begin
  2590. sr.reg2:=mask;
  2591. SysCall(Syscall_nr_sigsuspend,sr);
  2592. linuxerror:=errno;
  2593. end;
  2594. Function Signal(Signum:longint;Handler:SignalHandler):SignalHandler;
  2595. {
  2596. Install a new handler for signal Signum.
  2597. The old signal handler is returned.
  2598. This call does, in fact, the same as SigAction.
  2599. }
  2600. var
  2601. sr : Syscallregs;
  2602. begin
  2603. sr.reg2:=signum;
  2604. sr.reg3:=longint(handler);
  2605. Linuxerror:=SysCall(Syscall_nr_signal,sr);
  2606. If linuxerror=Sig_Err then
  2607. begin
  2608. Signal:=nil;
  2609. Linuxerror:=errno;
  2610. end
  2611. else
  2612. begin
  2613. Signal:=signalhandler(Linuxerror);
  2614. linuxerror:=0;
  2615. end;
  2616. end;
  2617. Function Alarm(Sec : Longint) : longint;
  2618. Var Sr : Syscallregs;
  2619. begin
  2620. sr.reg2:=Sec;
  2621. Alarm:=Syscall(syscall_nr_alarm,sr);
  2622. end;
  2623. Procedure Pause;
  2624. Var Sr : Syscallregs;
  2625. begin
  2626. syscall(syscall_nr_pause,sr);
  2627. end;
  2628. Function NanoSleep(const req : timespec;var rem : timespec) : longint;
  2629. var Sr : Syscallregs;
  2630. begin
  2631. sr.reg2:=longint(@req);
  2632. sr.reg3:=longint(@rem);
  2633. NanoSleep:=Syscall(syscall_nr_nanosleep,sr);
  2634. LinuxError:=Errno;
  2635. end;
  2636. Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
  2637. {
  2638. Interface to Unix ioctl call.
  2639. Performs various operations on the filedescriptor Handle.
  2640. Ndx describes the operation to perform.
  2641. Data points to data needed for the Ndx function. The structure of this
  2642. data is function-dependent.
  2643. }
  2644. var
  2645. sr: SysCallRegs;
  2646. begin
  2647. sr.reg2:=Handle;
  2648. sr.reg3:=Ndx;
  2649. sr.reg4:=Longint(Data);
  2650. IOCtl:=(SysCall(Syscall_nr_ioctl,sr)=0);
  2651. LinuxError:=Errno;
  2652. end;
  2653. function MMap(const m:tmmapargs):longint;
  2654. Var
  2655. Sr : Syscallregs;
  2656. begin
  2657. Sr.reg2:=longint(@m);
  2658. MMap:=syscall(syscall_nr_mmap,sr);
  2659. LinuxError:=Errno;
  2660. end;
  2661. function MUnMap (P : Pointer; Size : Longint) : Boolean;
  2662. Var
  2663. Sr : Syscallregs;
  2664. begin
  2665. Sr.reg2:=longint(P);
  2666. sr.reg3:=Size;
  2667. MUnMap:=syscall(syscall_nr_munmap,sr)=0;
  2668. LinuxError:=Errno;
  2669. end;
  2670. {--------------------------------
  2671. Port IO functions
  2672. --------------------------------}
  2673. Function IOperm (From,Num : Cardinal; Value : Longint) : boolean;
  2674. {
  2675. Set permissions on NUM ports starting with port FROM to VALUE
  2676. this works ONLY as root.
  2677. }
  2678. Var
  2679. Sr : Syscallregs;
  2680. begin
  2681. Sr.Reg2:=From;
  2682. Sr.Reg3:=Num;
  2683. Sr.Reg4:=Value;
  2684. IOPerm:=Syscall(Syscall_nr_ioperm,sr)=0;
  2685. LinuxError:=Errno;
  2686. end;
  2687. Function IoPL(Level : longint) : Boolean;
  2688. Var
  2689. Sr : Syscallregs;
  2690. begin
  2691. Sr.Reg2:=Level;
  2692. IOPL:=Syscall(Syscall_nr_iopl,sr)=0;
  2693. LinuxError:=Errno;
  2694. end;
  2695. {******************************************************************************
  2696. Process related calls
  2697. ******************************************************************************}
  2698. { Most calls of WaitPID do not handle the result correctly, this funktion treats errors more correctly }
  2699. Function WaitProcess(Pid:longint):Longint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
  2700. var r,s : LongInt;
  2701. begin
  2702. repeat
  2703. s:=$7F00;
  2704. r:=WaitPid(Pid,@s,0);
  2705. until (r<>-1) or (LinuxError<>Sys_EINTR);
  2706. if (r=-1) or (r=0) then // 0 is not a valid return and should never occur (it means status invalid when using WNOHANG)
  2707. WaitProcess:=-1 // return -1 to indicate an error
  2708. else
  2709. begin
  2710. {$ifdef solaris}
  2711. if (s and $FF)=0 then // Only this is a valid returncode
  2712. {$else solaris}
  2713. { the following is at least correct for Linux and Darwin (JM) }
  2714. if (s and $7F)=0 then
  2715. {$endif solaris}
  2716. WaitProcess:=s shr 8
  2717. else if (s>0) then // Until now there is not use of the highest bit , but check this for the future
  2718. WaitProcess:=-s // normal case
  2719. else
  2720. WaitProcess:=s; // s<0 should not occur, but wie return also a negativ value
  2721. end;
  2722. end;
  2723. function InternalCreateShellArgV(cmd:pChar; len:longint):ppchar;
  2724. {
  2725. Create an argv which executes a command in a shell using /bin/sh -c
  2726. }
  2727. const Shell = '/bin/sh'#0'-c'#0;
  2728. var
  2729. pp,p : ppchar;
  2730. // temp : string; !! Never pass a local var back!!
  2731. begin
  2732. getmem(pp,4*4);
  2733. p:=pp;
  2734. p^:=@Shell[1];
  2735. inc(p);
  2736. p^:=@Shell[9];
  2737. inc(p);
  2738. getmem(p^,len+1);
  2739. move(cmd^,p^^,len);
  2740. pchar(p^)[len]:=#0;
  2741. inc(p);
  2742. p^:=Nil;
  2743. InternalCreateShellArgV:=pp;
  2744. end;
  2745. function CreateShellArgV(const prog:string):ppchar;
  2746. begin
  2747. CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog));
  2748. end;
  2749. function CreateShellArgV(const prog:Ansistring):ppchar;
  2750. {
  2751. Create an argv which executes a command in a shell using /bin/sh -c
  2752. using a AnsiString;
  2753. }
  2754. begin
  2755. CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog)); // if ppc works like delphi this also work when @prog[1] is invalid (len=0)
  2756. end;
  2757. procedure FreeShellArgV(p:ppchar);
  2758. begin
  2759. if (p<>nil) then begin
  2760. freemem(p[2]);
  2761. freemem(p);
  2762. end;
  2763. end;
  2764. Procedure Execve(Path: AnsiString;args:ppchar;ep:ppchar);
  2765. {
  2766. overloaded ansistring version.
  2767. }
  2768. begin
  2769. ExecVE(PChar(Path),args,ep);
  2770. end;
  2771. Procedure Execv(const path: AnsiString;args:ppchar);
  2772. {
  2773. Overloaded ansistring version.
  2774. }
  2775. begin
  2776. ExecVe(Path,Args,envp)
  2777. end;
  2778. Procedure Execvp(Path: AnsiString; Args:ppchar;Ep:ppchar);
  2779. {
  2780. Overloaded ansistring version
  2781. }
  2782. var
  2783. thepath : Ansistring;
  2784. begin
  2785. if path[1]<>'/' then
  2786. begin
  2787. Thepath:=strpas(getenv('PATH'));
  2788. if thepath='' then
  2789. thepath:='.';
  2790. Path:=FSearch(path,thepath)
  2791. end
  2792. else
  2793. Path:='';
  2794. if Path='' then
  2795. linuxerror:=Sys_enoent
  2796. else
  2797. Execve(Path,args,ep);{On error linuxerror will get set there}
  2798. end;
  2799. Procedure Execv(const path:pathstr;args:ppchar);
  2800. {
  2801. Replaces the current program by the program specified in path,
  2802. arguments in args are passed to Execve.
  2803. the current environment is passed on.
  2804. }
  2805. begin
  2806. Execve(path,args,envp); {On error linuxerror will get set there}
  2807. end;
  2808. Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
  2809. {
  2810. This does the same as Execve, only it searches the PATH environment
  2811. for the place of the Executable, except when Path starts with a slash.
  2812. if the PATH environment variable is unavailable, the path is set to '.'
  2813. }
  2814. var
  2815. thepath : string;
  2816. begin
  2817. if path[1]<>'/' then
  2818. begin
  2819. Thepath:=strpas(getenv('PATH'));
  2820. if thepath='' then
  2821. thepath:='.';
  2822. Path:=FSearch(path,thepath)
  2823. end
  2824. else
  2825. Path:='';
  2826. if Path='' then
  2827. linuxerror:=Sys_enoent
  2828. else
  2829. Execve(Path,args,ep);{On error linuxerror will get set there}
  2830. end;
  2831. Procedure Execle(Todo:string;Ep:ppchar);
  2832. {
  2833. This procedure takes the string 'Todo', parses it for command and
  2834. command options, and Executes the command with the given options.
  2835. The string 'Todo' shoud be of the form 'command options', options
  2836. separated by commas.
  2837. the PATH environment is not searched for 'command'.
  2838. The specified environment(in 'ep') is passed on to command
  2839. }
  2840. var
  2841. p : ppchar;
  2842. begin
  2843. p:=StringToPPChar(ToDo);
  2844. if (p=nil) or (p^=nil) then
  2845. exit;
  2846. ExecVE(p^,p,EP);
  2847. end;
  2848. Procedure Execle(Todo:AnsiString;Ep:ppchar);
  2849. {
  2850. This procedure takes the string 'Todo', parses it for command and
  2851. command options, and Executes the command with the given options.
  2852. The string 'Todo' shoud be of the form 'command options', options
  2853. separated by commas.
  2854. the PATH environment is not searched for 'command'.
  2855. The specified environment(in 'ep') is passed on to command
  2856. }
  2857. var
  2858. p : ppchar;
  2859. begin
  2860. p:=StringToPPChar(ToDo);
  2861. if (p=nil) or (p^=nil) then
  2862. exit;
  2863. ExecVE(p^,p,EP);
  2864. end;
  2865. Procedure Execl(const Todo:string);
  2866. {
  2867. This procedure takes the string 'Todo', parses it for command and
  2868. command options, and Executes the command with the given options.
  2869. The string 'Todo' shoud be of the form 'command options', options
  2870. separated by commas.
  2871. the PATH environment is not searched for 'command'.
  2872. The current environment is passed on to command
  2873. }
  2874. begin
  2875. ExecLE(ToDo,EnvP);
  2876. end;
  2877. Procedure Execl(const Todo:Ansistring);
  2878. {
  2879. Overloaded AnsiString Version of ExecL.
  2880. }
  2881. begin
  2882. ExecLE(ToDo,EnvP);
  2883. end;
  2884. Procedure Execlp(Todo:string;Ep:ppchar);
  2885. {
  2886. This procedure takes the string 'Todo', parses it for command and
  2887. command options, and Executes the command with the given options.
  2888. The string 'Todo' shoud be of the form 'command options', options
  2889. separated by commas.
  2890. the PATH environment is searched for 'command'.
  2891. The specified environment (in 'ep') is passed on to command
  2892. }
  2893. var
  2894. p : ppchar;
  2895. begin
  2896. p:=StringToPPchar(todo);
  2897. if (p=nil) or (p^=nil) then
  2898. exit;
  2899. ExecVP(StrPas(p^),p,EP);
  2900. end;
  2901. Procedure Execlp(Todo: Ansistring;Ep:ppchar);
  2902. {
  2903. Overloaded ansistring version.
  2904. }
  2905. var
  2906. p : ppchar;
  2907. begin
  2908. p:=StringToPPchar(todo);
  2909. if (p=nil) or (p^=nil) then
  2910. exit;
  2911. ExecVP(StrPas(p^),p,EP);
  2912. end;
  2913. Function Shell(const Command:String):Longint;
  2914. {
  2915. Executes the shell, and passes it the string Command. (Through /bin/sh -c)
  2916. The current environment is passed to the shell.
  2917. It waits for the shell to exit, and returns its exit status.
  2918. If the Exec call failed exit status 127 is reported.
  2919. }
  2920. { Changed the structure:
  2921. - the previous version returns an undefinied value if fork fails
  2922. - it returns the status of Waitpid instead of the Process returnvalue (see the doc to Shell)
  2923. - it uses exit(127) not ExitProc (The Result in pp386: going on Compiling in 2 processes!)
  2924. - ShellArgs are now released
  2925. - The Old CreateShellArg gives back pointers to a local var
  2926. }
  2927. var
  2928. p : ppchar;
  2929. pid,r,s : longint;
  2930. begin
  2931. p:=CreateShellArgv(command);
  2932. pid:=fork;
  2933. if pid=0 then // We are in the Child
  2934. begin
  2935. {This is the child.}
  2936. Execve(p^,p,envp);
  2937. ExitProcess(127); // was Exit(127)
  2938. end
  2939. else if (pid<>-1) then // Successfull started
  2940. begin
  2941. repeat
  2942. s:=$7F00;
  2943. r:=WaitPid(Pid,@s,0);
  2944. until (r<>-1) or (LinuxError<>Sys_EINTR);
  2945. if (r=-1) or (r=0) then
  2946. Shell:=-1
  2947. else
  2948. Shell:=s;
  2949. end
  2950. else // no success
  2951. Shell:=-1; // indicate an error
  2952. FreeShellArgV(p);
  2953. end;
  2954. Function Shell(const Command:AnsiString):Longint;
  2955. {
  2956. AnsiString version of Shell
  2957. }
  2958. var
  2959. p : ppchar;
  2960. pid : longint;
  2961. begin { Changes as above }
  2962. p:=CreateShellArgv(command);
  2963. pid:=fork;
  2964. if pid=0 then // We are in the Child
  2965. begin
  2966. Execve(p^,p,envp);
  2967. ExitProcess(127); // was exit(127)!! We must exit the Process, not the function
  2968. end
  2969. else if (pid<>-1) then // Successfull started
  2970. Shell:=WaitProcess(pid) {Linuxerror is set there}
  2971. else // no success
  2972. Shell:=-1;
  2973. FreeShellArgV(p);
  2974. end;
  2975. function WEXITSTATUS(Status: Integer): Integer;
  2976. begin
  2977. WEXITSTATUS:=(Status and $FF00) shr 8;
  2978. end;
  2979. function WTERMSIG(Status: Integer): Integer;
  2980. begin
  2981. WTERMSIG:=(Status and $7F);
  2982. end;
  2983. function WSTOPSIG(Status: Integer): Integer;
  2984. begin
  2985. WSTOPSIG:=WEXITSTATUS(Status);
  2986. end;
  2987. Function WIFEXITED(Status: Integer): Boolean;
  2988. begin
  2989. WIFEXITED:=(WTERMSIG(Status)=0);
  2990. end;
  2991. Function WIFSTOPPED(Status: Integer): Boolean;
  2992. begin
  2993. WIFSTOPPED:=((Status and $FF)=$7F);
  2994. end;
  2995. Function WIFSIGNALED(Status: Integer): Boolean;
  2996. begin
  2997. WIFSIGNALED:=(not WIFSTOPPED(Status)) and
  2998. (not WIFEXITED(Status));
  2999. end;
  3000. Function W_EXITCODE(ReturnCode, Signal: Integer): Integer;
  3001. begin
  3002. W_EXITCODE:=(ReturnCode shl 8) or Signal;
  3003. end;
  3004. Function W_STOPCODE(Signal: Integer): Integer;
  3005. begin
  3006. W_STOPCODE:=(Signal shl 8) or $7F;
  3007. end;
  3008. {******************************************************************************
  3009. Date and Time related calls
  3010. ******************************************************************************}
  3011. Const
  3012. {Date Translation}
  3013. C1970=2440588;
  3014. D0 = 1461;
  3015. D1 = 146097;
  3016. D2 =1721119;
  3017. Function GregorianToJulian(Year,Month,Day:Longint):LongInt;
  3018. Var
  3019. Century,XYear: LongInt;
  3020. Begin
  3021. If Month<=2 Then
  3022. Begin
  3023. Dec(Year);
  3024. Inc(Month,12);
  3025. End;
  3026. Dec(Month,3);
  3027. Century:=(longint(Year Div 100)*D1) shr 2;
  3028. XYear:=(longint(Year Mod 100)*D0) shr 2;
  3029. GregorianToJulian:=((((Month*153)+2) div 5)+Day)+D2+XYear+Century;
  3030. End;
  3031. Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
  3032. Var
  3033. YYear,XYear,Temp,TempMonth : LongInt;
  3034. Begin
  3035. Temp:=((JulianDN-D2) shl 2)-1;
  3036. JulianDN:=Temp Div D1;
  3037. XYear:=(Temp Mod D1) or 3;
  3038. YYear:=(XYear Div D0);
  3039. Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
  3040. Day:=((Temp Mod 153)+5) Div 5;
  3041. TempMonth:=Temp Div 153;
  3042. If TempMonth>=10 Then
  3043. Begin
  3044. inc(YYear);
  3045. dec(TempMonth,12);
  3046. End;
  3047. inc(TempMonth,3);
  3048. Month := TempMonth;
  3049. Year:=YYear+(JulianDN*100);
  3050. end;
  3051. Function GetEpochTime: longint;
  3052. {
  3053. Get the number of seconds since 00:00, January 1 1970, GMT
  3054. the time NOT corrected any way
  3055. }
  3056. begin
  3057. GetEpochTime:=GetTimeOfDay;
  3058. end;
  3059. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
  3060. {
  3061. Transforms Epoch time into local time (hour, minute,seconds)
  3062. }
  3063. Var
  3064. DateNum: LongInt;
  3065. Begin
  3066. inc(Epoch,TZSeconds);
  3067. Datenum:=(Epoch Div 86400) + c1970;
  3068. JulianToGregorian(DateNum,Year,Month,day);
  3069. Epoch:=Abs(Epoch Mod 86400);
  3070. Hour:=Epoch Div 3600;
  3071. Epoch:=Epoch Mod 3600;
  3072. Minute:=Epoch Div 60;
  3073. Second:=Epoch Mod 60;
  3074. End;
  3075. Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
  3076. {
  3077. Transforms local time (year,month,day,hour,minutes,second) to Epoch time
  3078. (seconds since 00:00, january 1 1970, corrected for local time zone)
  3079. }
  3080. Begin
  3081. LocalToEpoch:=((GregorianToJulian(Year,Month,Day)-c1970)*86400)+
  3082. (LongInt(Hour)*3600)+(Minute*60)+Second-TZSeconds;
  3083. End;
  3084. procedure GetTime(var hour,min,sec,msec,usec:word);
  3085. {
  3086. Gets the current time, adjusted to local time
  3087. }
  3088. var
  3089. year,day,month:Word;
  3090. t : timeval;
  3091. begin
  3092. gettimeofday(t);
  3093. EpochToLocal(t.sec,year,month,day,hour,min,sec);
  3094. msec:=t.usec div 1000;
  3095. usec:=t.usec mod 1000;
  3096. end;
  3097. procedure GetTime(var hour,min,sec,sec100:word);
  3098. {
  3099. Gets the current time, adjusted to local time
  3100. }
  3101. var
  3102. usec : word;
  3103. begin
  3104. gettime(hour,min,sec,sec100,usec);
  3105. sec100:=sec100 div 10;
  3106. end;
  3107. Procedure GetTime(Var Hour,Min,Sec:Word);
  3108. {
  3109. Gets the current time, adjusted to local time
  3110. }
  3111. var
  3112. msec,usec : Word;
  3113. Begin
  3114. gettime(hour,min,sec,msec,usec);
  3115. End;
  3116. Procedure GetDate(Var Year,Month,Day:Word);
  3117. {
  3118. Gets the current date, adjusted to local time
  3119. }
  3120. var
  3121. hour,minute,second : word;
  3122. Begin
  3123. EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
  3124. End;
  3125. Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
  3126. {
  3127. Gets the current date, adjusted to local time
  3128. }
  3129. Begin
  3130. EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
  3131. End;
  3132. {$ifndef BSD} {Fix for 1.0.x starting compiler only}
  3133. {$ifdef linux}
  3134. Function stime (t : longint) : Boolean;
  3135. var
  3136. sr : Syscallregs;
  3137. begin
  3138. sr.reg2:=longint(@t);
  3139. SysCall(Syscall_nr_stime,sr);
  3140. linuxerror:=errno;
  3141. stime:=linuxerror=0;
  3142. end;
  3143. {$endif}
  3144. {$endif}
  3145. {$ifdef BSD}
  3146. Function stime (t : longint) : Boolean;
  3147. begin
  3148. stime:=false;
  3149. end;
  3150. {$endif}
  3151. Function SetTime(Hour,Min,Sec:word) : boolean;
  3152. var
  3153. Year, Month, Day : Word;
  3154. begin
  3155. GetDate (Year, Month, Day);
  3156. SetTime:=stime ( LocalToEpoch ( Year, Month, Day, Hour, Min, Sec ) );
  3157. end;
  3158. Function SetDate(Year,Month,Day:Word) : boolean;
  3159. var
  3160. Hour, Minute, Second, Sec100 : Word;
  3161. begin
  3162. GetTime ( Hour, Minute, Second, Sec100 );
  3163. SetDate:=stime ( LocalToEpoch ( Year, Month, Day, Hour, Minute, Second ) );
  3164. end;
  3165. Function SetDateTime(Year,Month,Day,hour,minute,second:Word) : Boolean;
  3166. begin
  3167. SetDateTime:=stime ( LocalToEpoch ( Year, Month, Day, Hour, Minute, Second ) );
  3168. end;
  3169. { Include timezone handling routines which use /usr/share/timezone info }
  3170. type
  3171. plongint=^longint;
  3172. pbyte=^byte;
  3173. ttzhead=packed record
  3174. tzh_reserved : array[0..19] of byte;
  3175. tzh_ttisgmtcnt,
  3176. tzh_ttisstdcnt,
  3177. tzh_leapcnt,
  3178. tzh_timecnt,
  3179. tzh_typecnt,
  3180. tzh_charcnt : longint;
  3181. end;
  3182. pttinfo=^tttinfo;
  3183. tttinfo=packed record
  3184. offset : longint;
  3185. isdst : boolean;
  3186. idx : byte;
  3187. isstd : byte;
  3188. isgmt : byte;
  3189. end;
  3190. pleap=^tleap;
  3191. tleap=record
  3192. transition : longint;
  3193. change : longint;
  3194. end;
  3195. var
  3196. num_transitions,
  3197. num_leaps,
  3198. num_types : longint;
  3199. transitions : plongint;
  3200. type_idxs : pbyte;
  3201. types : pttinfo;
  3202. zone_names : pchar;
  3203. leaps : pleap;
  3204. function find_transition(timer:longint):pttinfo;
  3205. var
  3206. i : longint;
  3207. begin
  3208. if (num_transitions=0) or (timer<transitions[0]) then
  3209. begin
  3210. i:=0;
  3211. while (i<num_types) and (types[i].isdst) do
  3212. inc(i);
  3213. if (i=num_types) then
  3214. i:=0;
  3215. end
  3216. else
  3217. begin
  3218. for i:=1 to num_transitions do
  3219. if (timer<transitions[i]) then
  3220. break;
  3221. i:=type_idxs[i-1];
  3222. end;
  3223. find_transition:=@types[i];
  3224. end;
  3225. procedure GetLocalTimezone(timer:longint;var leap_correct,leap_hit:longint);
  3226. var
  3227. info : pttinfo;
  3228. i : longint;
  3229. begin
  3230. { reset }
  3231. TZDaylight:=false;
  3232. TZSeconds:=0;
  3233. TZName[false]:=nil;
  3234. TZName[true]:=nil;
  3235. leap_correct:=0;
  3236. leap_hit:=0;
  3237. { get info }
  3238. info:=find_transition(timer);
  3239. if not assigned(info) then
  3240. exit;
  3241. TZDaylight:=info^.isdst;
  3242. TZSeconds:=info^.offset;
  3243. i:=0;
  3244. while (i<num_types) do
  3245. begin
  3246. tzname[types[i].isdst]:=@zone_names[types[i].idx];
  3247. inc(i);
  3248. end;
  3249. tzname[info^.isdst]:=@zone_names[info^.idx];
  3250. i:=num_leaps;
  3251. repeat
  3252. if i=0 then
  3253. exit;
  3254. dec(i);
  3255. until (timer>leaps[i].transition);
  3256. leap_correct:=leaps[i].change;
  3257. if (timer=leaps[i].transition) and
  3258. (((i=0) and (leaps[i].change>0)) or
  3259. (leaps[i].change>leaps[i-1].change)) then
  3260. begin
  3261. leap_hit:=1;
  3262. while (i>0) and
  3263. (leaps[i].transition=leaps[i-1].transition+1) and
  3264. (leaps[i].change=leaps[i-1].change+1) do
  3265. begin
  3266. inc(leap_hit);
  3267. dec(i);
  3268. end;
  3269. end;
  3270. end;
  3271. procedure GetLocalTimezone(timer:longint);
  3272. var
  3273. lc,lh : longint;
  3274. begin
  3275. GetLocalTimezone(timer,lc,lh);
  3276. end;
  3277. procedure ReadTimezoneFile(fn:string);
  3278. procedure decode(var l:longint);
  3279. var
  3280. k : longint;
  3281. p : pbyte;
  3282. begin
  3283. p:=pbyte(@l);
  3284. if (p[0] and (1 shl 7))<>0 then
  3285. k:=not 0
  3286. else
  3287. k:=0;
  3288. k:=(k shl 8) or p[0];
  3289. k:=(k shl 8) or p[1];
  3290. k:=(k shl 8) or p[2];
  3291. k:=(k shl 8) or p[3];
  3292. l:=k;
  3293. end;
  3294. var
  3295. f : longint;
  3296. tzdir : string;
  3297. tzhead : ttzhead;
  3298. i : longint;
  3299. chars : longint;
  3300. buf : pbyte;
  3301. begin
  3302. if fn='' then
  3303. fn:='localtime';
  3304. if fn[1]<>'/' then
  3305. begin
  3306. tzdir:=getenv('TZDIR');
  3307. if tzdir='' then
  3308. tzdir:='/usr/share/zoneinfo';
  3309. if tzdir[length(tzdir)]<>'/' then
  3310. tzdir:=tzdir+'/';
  3311. fn:=tzdir+fn;
  3312. end;
  3313. f:=fdopen(fn,Open_RdOnly);
  3314. if f<0 then
  3315. exit;
  3316. i:=fdread(f,tzhead,sizeof(tzhead));
  3317. if i<>sizeof(tzhead) then
  3318. exit;
  3319. decode(tzhead.tzh_timecnt);
  3320. decode(tzhead.tzh_typecnt);
  3321. decode(tzhead.tzh_charcnt);
  3322. decode(tzhead.tzh_leapcnt);
  3323. decode(tzhead.tzh_ttisstdcnt);
  3324. decode(tzhead.tzh_ttisgmtcnt);
  3325. num_transitions:=tzhead.tzh_timecnt;
  3326. num_types:=tzhead.tzh_typecnt;
  3327. chars:=tzhead.tzh_charcnt;
  3328. reallocmem(transitions,num_transitions*sizeof(longint));
  3329. reallocmem(type_idxs,num_transitions);
  3330. reallocmem(types,num_types*sizeof(tttinfo));
  3331. reallocmem(zone_names,chars);
  3332. reallocmem(leaps,num_leaps*sizeof(tleap));
  3333. fdread(f,transitions^,num_transitions*4);
  3334. fdread(f,type_idxs^,num_transitions);
  3335. for i:=0 to num_transitions-1 do
  3336. decode(transitions[i]);
  3337. for i:=0 to num_types-1 do
  3338. begin
  3339. fdread(f,types[i].offset,4);
  3340. fdread(f,types[i].isdst,1);
  3341. fdread(f,types[i].idx,1);
  3342. decode(types[i].offset);
  3343. types[i].isstd:=0;
  3344. types[i].isgmt:=0;
  3345. end;
  3346. fdread(f,zone_names^,chars);
  3347. for i:=0 to num_leaps-1 do
  3348. begin
  3349. fdread(f,leaps[i].transition,4);
  3350. fdread(f,leaps[i].change,4);
  3351. decode(leaps[i].transition);
  3352. decode(leaps[i].change);
  3353. end;
  3354. getmem(buf,tzhead.tzh_ttisstdcnt);
  3355. fdread(f,buf^,tzhead.tzh_ttisstdcnt);
  3356. for i:=0 to tzhead.tzh_ttisstdcnt-1 do
  3357. types[i].isstd:=byte(buf[i]<>0);
  3358. freemem(buf);
  3359. getmem(buf,tzhead.tzh_ttisgmtcnt);
  3360. fdread(f,buf^,tzhead.tzh_ttisgmtcnt);
  3361. for i:=0 to tzhead.tzh_ttisgmtcnt-1 do
  3362. types[i].isgmt:=byte(buf[i]<>0);
  3363. freemem(buf);
  3364. fdclose(f);
  3365. end;
  3366. Const
  3367. // Debian system; contains location of timezone file.
  3368. TimeZoneLocationFile = '/etc/timezone';
  3369. // SuSE has link in /usr/lib/zoneinfo/localtime to /etc/localtime
  3370. // RedHat uses /etc/localtime
  3371. TimeZoneFile = '/usr/lib/zoneinfo/localtime';
  3372. AltTimeZoneFile = '/etc/localtime';
  3373. function GetTimezoneFile:string;
  3374. var
  3375. f,len : longint;
  3376. s : string;
  3377. info : stat;
  3378. begin
  3379. GetTimezoneFile:='';
  3380. f:=fdopen(TimeZoneLocationFile,Open_RdOnly);
  3381. if f>0 then
  3382. begin
  3383. len:=fdread(f,s[1],high(s));
  3384. s[0]:=chr(len);
  3385. len:=pos(#10,s);
  3386. if len<>0 then
  3387. s[0]:=chr(len-1);
  3388. fdclose(f);
  3389. GetTimezoneFile:=s;
  3390. end
  3391. // Try SuSE
  3392. else if fstat(TimeZoneFile,info) then
  3393. GetTimeZoneFile:=TimeZoneFile
  3394. // Try RedHat
  3395. else If fstat(AltTimeZoneFile,Info) then
  3396. GetTimeZoneFile:=AltTimeZoneFile;
  3397. end;
  3398. procedure InitLocalTime;
  3399. begin
  3400. ReadTimezoneFile(GetTimezoneFile);
  3401. GetLocalTimezone(GetTimeOfDay);
  3402. end;
  3403. procedure DoneLocalTime;
  3404. begin
  3405. if assigned(transitions) then
  3406. freemem(transitions);
  3407. if assigned(type_idxs) then
  3408. freemem(type_idxs);
  3409. if assigned(types) then
  3410. freemem(types);
  3411. if assigned(zone_names) then
  3412. freemem(zone_names);
  3413. if assigned(leaps) then
  3414. freemem(leaps);
  3415. num_transitions:=0;
  3416. num_leaps:=0;
  3417. num_types:=0;
  3418. end;
  3419. {******************************************************************************
  3420. FileSystem calls
  3421. ******************************************************************************}
  3422. Function fdOpen(pathname:string;flags:longint):longint;
  3423. begin
  3424. pathname:=pathname+#0;
  3425. fdOpen:=Sys_Open(@pathname[1],flags,438);
  3426. LinuxError:=Errno;
  3427. end;
  3428. Function fdOpen(pathname:string;flags,mode:longint):longint;
  3429. begin
  3430. pathname:=pathname+#0;
  3431. fdOpen:=Sys_Open(@pathname[1],flags,mode);
  3432. LinuxError:=Errno;
  3433. end;
  3434. Function fdOpen(pathname:pchar;flags:longint):longint;
  3435. begin
  3436. fdOpen:=Sys_Open(pathname,flags,0);
  3437. LinuxError:=Errno;
  3438. end;
  3439. Function fdOpen(pathname:pchar;flags,mode:longint):longint;
  3440. begin
  3441. fdOpen:=Sys_Open(pathname,flags,mode);
  3442. LinuxError:=Errno;
  3443. end;
  3444. Function fdClose(fd:longint):boolean;
  3445. begin
  3446. fdClose:=(Sys_Close(fd)=0);
  3447. LinuxError:=Errno;
  3448. end;
  3449. Function fdRead(fd:longint;var buf;size:longint):longint;
  3450. begin
  3451. fdRead:=Sys_Read(fd,pchar(@buf),size);
  3452. LinuxError:=Errno;
  3453. end;
  3454. Function fdWrite(fd:longint;const buf;size:longint):longint;
  3455. begin
  3456. fdWrite:=Sys_Write(fd,pchar(@buf),size);
  3457. LinuxError:=Errno;
  3458. end;
  3459. Function fdSeek (fd,pos,seektype :longint): longint;
  3460. {
  3461. Do a Seek on a file descriptor fd to position pos, starting from seektype
  3462. }
  3463. begin
  3464. fdseek:=Sys_LSeek (fd,pos,seektype);
  3465. LinuxError:=Errno;
  3466. end;
  3467. {$ifdef BSD}
  3468. Function Fcntl(Fd:longint;Cmd:longint):longint;
  3469. {
  3470. Read or manipulate a file.(See also fcntl (2) )
  3471. Possible values for Cmd are :
  3472. F_GetFd,F_GetFl,F_GetOwn
  3473. Errors are reported in Linuxerror;
  3474. If Cmd is different from the allowed values, linuxerror=Sys_eninval.
  3475. }
  3476. begin
  3477. if (cmd in [F_GetFd,F_GetFl,F_GetOwn]) then
  3478. begin
  3479. Linuxerror:=sys_fcntl(fd,cmd,0);
  3480. if linuxerror=-1 then
  3481. begin
  3482. linuxerror:=errno;
  3483. fcntl:=0;
  3484. end
  3485. else
  3486. begin
  3487. fcntl:=linuxerror;
  3488. linuxerror:=0;
  3489. end;
  3490. end
  3491. else
  3492. begin
  3493. linuxerror:=Sys_einval;
  3494. Fcntl:=0;
  3495. end;
  3496. end;
  3497. Procedure Fcntl(Fd:longint;Cmd:longint;Arg:Longint);
  3498. {
  3499. Read or manipulate a file. (See also fcntl (2) )
  3500. Possible values for Cmd are :
  3501. F_setFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkW,F_SetOwn;
  3502. Errors are reported in Linuxerror;
  3503. If Cmd is different from the allowed values, linuxerror=Sys_eninval.
  3504. F_DupFD is not allowed, due to the structure of Files in Pascal.
  3505. }
  3506. begin
  3507. if (cmd in [F_SetFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkw,F_SetOwn]) then
  3508. begin
  3509. sys_fcntl(fd,cmd,arg);
  3510. LinuxError:=ErrNo;
  3511. end
  3512. else
  3513. linuxerror:=Sys_einval;
  3514. end;
  3515. {$endif}
  3516. Function Fcntl(var Fd:Text;Cmd:longint):longint;
  3517. begin
  3518. Fcntl := Fcntl(textrec(Fd).handle, Cmd);
  3519. end;
  3520. Procedure Fcntl(var Fd:Text;Cmd,Arg:Longint);
  3521. begin
  3522. Fcntl(textrec(Fd).handle, Cmd, Arg);
  3523. end;
  3524. Function Flock (var T : text;mode : longint) : boolean;
  3525. begin
  3526. Flock:=Flock(TextRec(T).Handle,mode);
  3527. end;
  3528. Function Flock (var F : File;mode : longint) : boolean;
  3529. begin
  3530. Flock:=Flock(FileRec(F).Handle,mode);
  3531. end;
  3532. Function FStat(Path:Pathstr;Var Info:stat):Boolean;
  3533. {
  3534. Get all information on a file, and return it in Info.
  3535. }
  3536. begin
  3537. path:=path+#0;
  3538. FStat:=(Sys_stat(@(path[1]),Info)=0);
  3539. LinuxError:=errno;
  3540. end;
  3541. Function FStat(var F:Text;Var Info:stat):Boolean;
  3542. {
  3543. Get all information on a text file, and return it in info.
  3544. }
  3545. begin
  3546. FStat:=Fstat(TextRec(F).Handle,INfo);
  3547. end;
  3548. Function FStat(var F:File;Var Info:stat):Boolean;
  3549. {
  3550. Get all information on a untyped file, and return it in info.
  3551. }
  3552. begin
  3553. FStat:=Fstat(FileRec(F).Handle,Info);
  3554. end;
  3555. Function SymLink(OldPath,newPath:pathstr):boolean;
  3556. {
  3557. Proceduces a soft link from new to old.
  3558. }
  3559. begin
  3560. oldpath:=oldpath+#0;
  3561. newpath:=newpath+#0;
  3562. Symlink:=Sys_symlink(pchar(@(oldpath[1])),pchar(@(newpath[1])))=0;
  3563. linuxerror:=errno;
  3564. end;
  3565. Function ReadLink(name,linkname:pchar;maxlen:longint):longint;
  3566. {
  3567. Read a link (where it points to)
  3568. }
  3569. begin
  3570. Readlink:=Sys_readlink(Name,LinkName,maxlen);
  3571. linuxerror:=errno;
  3572. end;
  3573. Function ReadLink(Name:pathstr):pathstr;
  3574. {
  3575. Read a link (where it points to)
  3576. }
  3577. var
  3578. LinkName : pathstr;
  3579. i : longint;
  3580. begin
  3581. Name:=Name+#0;
  3582. i:=ReadLink(@Name[1],@LinkName[1],high(linkname));
  3583. if i>0 then
  3584. begin
  3585. linkname[0]:=chr(i);
  3586. ReadLink:=LinkName;
  3587. end
  3588. else
  3589. ReadLink:='';
  3590. end;
  3591. Function UnLink(Path:pathstr):boolean;
  3592. {
  3593. Removes the file in 'Path' (that is, it decreases the link count with one.
  3594. if the link count is zero, the file is removed from the disk.
  3595. }
  3596. begin
  3597. path:=path+#0;
  3598. Unlink:=Sys_unlink(pchar(@(path[1])))=0;
  3599. linuxerror:=errno;
  3600. end;
  3601. Function UnLink(Path:pchar):Boolean;
  3602. {
  3603. Removes the file in 'Path' (that is, it decreases the link count with one.
  3604. if the link count is zero, the file is removed from the disk.
  3605. }
  3606. begin
  3607. Unlink:=(Sys_unlink(path)=0);
  3608. linuxerror:=errno;
  3609. end;
  3610. Function FRename (OldName,NewName : Pchar) : Boolean;
  3611. begin
  3612. FRename:=Sys_rename(OldName,NewName)=0;
  3613. LinuxError:=Errno;
  3614. end;
  3615. Function FRename (OldName,NewName : String) : Boolean;
  3616. begin
  3617. OldName:=OldName+#0;
  3618. NewName:=NewName+#0;
  3619. FRename:=FRename (@OldName[1],@NewName[1]);
  3620. end;
  3621. Function Dup(var oldfile,newfile:text):Boolean;
  3622. {
  3623. Copies the filedescriptor oldfile to newfile, after flushing the buffer of
  3624. oldfile.
  3625. After which the two textfiles are, in effect, the same, except
  3626. that they don't share the same buffer, and don't share the same
  3627. close_on_exit flag.
  3628. }
  3629. begin
  3630. flush(oldfile);{ We cannot share buffers, so we flush them. }
  3631. textrec(newfile):=textrec(oldfile);
  3632. textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
  3633. Dup:=Dup(textrec(oldfile).handle,textrec(newfile).handle);
  3634. end;
  3635. Function Dup(var oldfile,newfile:file):Boolean;
  3636. {
  3637. Copies the filedescriptor oldfile to newfile
  3638. }
  3639. begin
  3640. filerec(newfile):=filerec(oldfile);
  3641. Dup:=Dup(filerec(oldfile).handle,filerec(newfile).handle);
  3642. end;
  3643. Function Dup2(var oldfile,newfile:text):Boolean;
  3644. {
  3645. Copies the filedescriptor oldfile to newfile, after flushing the buffer of
  3646. oldfile. It closes newfile if it was still open.
  3647. After which the two textfiles are, in effect, the same, except
  3648. that they don't share the same buffer, and don't share the same
  3649. close_on_exit flag.
  3650. }
  3651. var
  3652. tmphandle : word;
  3653. begin
  3654. case TextRec(oldfile).mode of
  3655. fmOutput, fmInOut, fmAppend :
  3656. flush(oldfile);{ We cannot share buffers, so we flush them. }
  3657. end;
  3658. case TextRec(newfile).mode of
  3659. fmOutput, fmInOut, fmAppend :
  3660. flush(newfile);
  3661. end;
  3662. tmphandle:=textrec(newfile).handle;
  3663. textrec(newfile):=textrec(oldfile);
  3664. textrec(newfile).handle:=tmphandle;
  3665. textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
  3666. Dup2:=Dup2(textrec(oldfile).handle,textrec(newfile).handle);
  3667. end;
  3668. Function Dup2(var oldfile,newfile:file):Boolean;
  3669. {
  3670. Copies the filedescriptor oldfile to newfile
  3671. }
  3672. begin
  3673. filerec(newfile):=filerec(oldfile);
  3674. Dup2:=Dup2(filerec(oldfile).handle,filerec(newfile).handle);
  3675. end;
  3676. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
  3677. {
  3678. Select checks whether the file descriptor sets in readfs/writefs/exceptfs
  3679. have changed.
  3680. This function allows specification of a timeout as a longint.
  3681. }
  3682. var
  3683. p : PTimeVal;
  3684. tv : TimeVal;
  3685. begin
  3686. if TimeOut=-1 then
  3687. p:=nil
  3688. else
  3689. begin
  3690. tv.Sec:=Timeout div 1000;
  3691. tv.Usec:=(Timeout mod 1000)*1000;
  3692. p:=@tv;
  3693. end;
  3694. Select:=Select(N,Readfds,WriteFds,ExceptFds,p);
  3695. end;
  3696. Function SelectText(var T:Text;TimeOut :PTimeval):Longint;
  3697. Var
  3698. F:FDSet;
  3699. begin
  3700. if textrec(t).mode=fmclosed then
  3701. begin
  3702. LinuxError:=Sys_EBADF;
  3703. exit(-1);
  3704. end;
  3705. FD_Zero(f);
  3706. FD_Set(textrec(T).handle,f);
  3707. if textrec(T).mode=fminput then
  3708. SelectText:=select(textrec(T).handle+1,@f,nil,nil,TimeOut)
  3709. else
  3710. SelectText:=select(textrec(T).handle+1,nil,@f,nil,TimeOut);
  3711. end;
  3712. Function SelectText(var T:Text;TimeOut :Longint):Longint;
  3713. var
  3714. p : PTimeVal;
  3715. tv : TimeVal;
  3716. begin
  3717. if TimeOut=-1 then
  3718. p:=nil
  3719. else
  3720. begin
  3721. tv.Sec:=Timeout div 1000;
  3722. tv.Usec:=(Timeout mod 1000)*1000;
  3723. p:=@tv;
  3724. end;
  3725. SelectText:=SelectText(T,p);
  3726. end;
  3727. {******************************************************************************
  3728. Directory
  3729. ******************************************************************************}
  3730. Function OpenDir(F:String):PDir;
  3731. begin
  3732. F:=F+#0;
  3733. OpenDir:=OpenDir(@F[1]);
  3734. LinuxError:=ErrNo;
  3735. end;
  3736. {$ifndef newreaddir}
  3737. procedure SeekDir(p:pdir;off:longint);
  3738. begin
  3739. if p=nil then
  3740. begin
  3741. errno:=Sys_EBADF;
  3742. exit;
  3743. end;
  3744. {$ifndef bsd}
  3745. p^.nextoff:=Sys_lseek(p^.fd,off,seek_set);
  3746. {$endif}
  3747. p^.size:=0;
  3748. p^.loc:=0;
  3749. end;
  3750. function TellDir(p:pdir):longint;
  3751. begin
  3752. if p=nil then
  3753. begin
  3754. errno:=Sys_EBADF;
  3755. telldir:=-1;
  3756. exit;
  3757. end;
  3758. telldir:=Sys_lseek(p^.fd,0,seek_cur)
  3759. { We could try to use the nextoff field here, but on my 1.2.13
  3760. kernel, this gives nothing... This may have to do with
  3761. the readdir implementation of libc... I also didn't find any trace of
  3762. the field in the kernel code itself, So I suspect it is an artifact of libc.
  3763. Michael. }
  3764. end;
  3765. {$endif}
  3766. Function ReadDir(P:pdir):pdirent;
  3767. begin
  3768. ReadDir:=Sys_ReadDir(p);
  3769. LinuxError:=Errno;
  3770. end;
  3771. {******************************************************************************
  3772. Pipes/Fifo
  3773. ******************************************************************************}
  3774. Procedure OpenPipe(var F:Text);
  3775. begin
  3776. case textrec(f).mode of
  3777. fmoutput :
  3778. if textrec(f).userdata[1]<>P_OUT then
  3779. textrec(f).mode:=fmclosed;
  3780. fminput :
  3781. if textrec(f).userdata[1]<>P_IN then
  3782. textrec(f).mode:=fmclosed;
  3783. else
  3784. textrec(f).mode:=fmclosed;
  3785. end;
  3786. end;
  3787. Procedure IOPipe(var F:text);
  3788. begin
  3789. case textrec(f).mode of
  3790. fmoutput :
  3791. begin
  3792. { first check if we need something to write, else we may
  3793. get a SigPipe when Close() is called (PFV) }
  3794. if textrec(f).bufpos>0 then
  3795. Sys_write(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufpos);
  3796. end;
  3797. fminput :
  3798. textrec(f).bufend:=Sys_read(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufsize);
  3799. end;
  3800. textrec(f).bufpos:=0;
  3801. end;
  3802. Procedure FlushPipe(var F:Text);
  3803. begin
  3804. if (textrec(f).mode=fmoutput) and (textrec(f).bufpos<>0) then
  3805. IOPipe(f);
  3806. textrec(f).bufpos:=0;
  3807. end;
  3808. Procedure ClosePipe(var F:text);
  3809. begin
  3810. textrec(f).mode:=fmclosed;
  3811. Sys_close(textrec(f).handle);
  3812. end;
  3813. Function AssignPipe(var pipe_in,pipe_out:text):boolean;
  3814. {
  3815. Sets up a pair of file variables, which act as a pipe. The first one can
  3816. be read from, the second one can be written to.
  3817. If the operation was unsuccesful, linuxerror is set.
  3818. }
  3819. var
  3820. f_in,f_out : longint;
  3821. begin
  3822. if not AssignPipe(f_in,f_out) then
  3823. begin
  3824. AssignPipe:=false;
  3825. exit;
  3826. end;
  3827. { Set up input }
  3828. Assign(Pipe_in,'');
  3829. Textrec(Pipe_in).Handle:=f_in;
  3830. Textrec(Pipe_in).Mode:=fmInput;
  3831. Textrec(Pipe_in).userdata[1]:=P_IN;
  3832. TextRec(Pipe_in).OpenFunc:=@OpenPipe;
  3833. TextRec(Pipe_in).InOutFunc:=@IOPipe;
  3834. TextRec(Pipe_in).FlushFunc:=@FlushPipe;
  3835. TextRec(Pipe_in).CloseFunc:=@ClosePipe;
  3836. { Set up output }
  3837. Assign(Pipe_out,'');
  3838. Textrec(Pipe_out).Handle:=f_out;
  3839. Textrec(Pipe_out).Mode:=fmOutput;
  3840. Textrec(Pipe_out).userdata[1]:=P_OUT;
  3841. TextRec(Pipe_out).OpenFunc:=@OpenPipe;
  3842. TextRec(Pipe_out).InOutFunc:=@IOPipe;
  3843. TextRec(Pipe_out).FlushFunc:=@FlushPipe;
  3844. TextRec(Pipe_out).CloseFunc:=@ClosePipe;
  3845. AssignPipe:=true;
  3846. end;
  3847. Function AssignPipe(var pipe_in,pipe_out:file):boolean;
  3848. {
  3849. Sets up a pair of file variables, which act as a pipe. The first one can
  3850. be read from, the second one can be written to.
  3851. If the operation was unsuccesful, linuxerror is set.
  3852. }
  3853. var
  3854. f_in,f_out : longint;
  3855. begin
  3856. if not AssignPipe(f_in,f_out) then
  3857. begin
  3858. AssignPipe:=false;
  3859. exit;
  3860. end;
  3861. { Set up input }
  3862. Assign(Pipe_in,'');
  3863. Filerec(Pipe_in).Handle:=f_in;
  3864. Filerec(Pipe_in).Mode:=fmInput;
  3865. Filerec(Pipe_in).recsize:=1;
  3866. Filerec(Pipe_in).userdata[1]:=P_IN;
  3867. { Set up output }
  3868. Assign(Pipe_out,'');
  3869. Filerec(Pipe_out).Handle:=f_out;
  3870. Filerec(Pipe_out).Mode:=fmoutput;
  3871. Filerec(Pipe_out).recsize:=1;
  3872. Filerec(Pipe_out).userdata[1]:=P_OUT;
  3873. AssignPipe:=true;
  3874. end;
  3875. Procedure PCloseText(Var F:text);
  3876. {
  3877. May not use @PClose due overloading
  3878. }
  3879. begin
  3880. PClose(f);
  3881. end;
  3882. Procedure POpen(var F:text;const Prog:String;rw:char);
  3883. {
  3884. Starts the program in 'Prog' and makes it's input or out put the
  3885. other end of a pipe. If rw is 'w' or 'W', then whatever is written to
  3886. F, will be read from stdin by the program in 'Prog'. The inverse is true
  3887. for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
  3888. read from 'f'.
  3889. }
  3890. var
  3891. pipi,
  3892. pipo : text;
  3893. pid : longint;
  3894. pl : ^longint;
  3895. pp : ppchar;
  3896. begin
  3897. LinuxError:=0;
  3898. rw:=upcase(rw);
  3899. if not (rw in ['R','W']) then
  3900. begin
  3901. LinuxError:=Sys_enoent;
  3902. exit;
  3903. end;
  3904. AssignPipe(pipi,pipo);
  3905. if Linuxerror<>0 then
  3906. exit;
  3907. pid:=fork;
  3908. if linuxerror<>0 then
  3909. begin
  3910. close(pipi);
  3911. close(pipo);
  3912. exit;
  3913. end;
  3914. if pid=0 then
  3915. begin
  3916. {$ifdef BSD} // FreeBSD checked only
  3917. { We're in the child }
  3918. close(pipi);
  3919. if textrec(pipo).handle<>textrec(output).handle Then
  3920. begin
  3921. dup2(textrec(pipo).handle,textrec(output).handle);
  3922. if rw='W' Then
  3923. dup2(textrec(output).handle,textrec(input).handle);
  3924. end
  3925. else
  3926. if (rw='W') and (textrec(pipi).handle<>textrec(input).handle) then
  3927. dup2(textrec(output).handle,textrec(input).handle);
  3928. close(pipo);
  3929. if linuxerror<>0 then
  3930. halt(127);
  3931. pp:=createshellargv(prog);
  3932. Execve(pp^,pp,envp);
  3933. halt(127);
  3934. end
  3935. {$else}
  3936. { We're in the child }
  3937. if rw='W' then
  3938. begin
  3939. close(pipo);
  3940. dup2(pipi,input);
  3941. close(pipi);
  3942. if linuxerror<>0 then
  3943. halt(127);
  3944. end
  3945. else
  3946. begin
  3947. close(pipi);
  3948. dup2(pipo,output);
  3949. close(pipo);
  3950. if linuxerror<>0 then
  3951. halt(127);
  3952. end;
  3953. pp:=createshellargv(prog);
  3954. Execve(pp^,pp,envp);
  3955. halt(127);
  3956. end
  3957. {$endif}
  3958. else
  3959. begin
  3960. { We're in the parent }
  3961. if rw='W' then
  3962. begin
  3963. close(pipi);
  3964. f:=pipo;
  3965. textrec(f).bufptr:=@textrec(f).buffer;
  3966. end
  3967. else
  3968. begin
  3969. close(pipo);
  3970. f:=pipi;
  3971. textrec(f).bufptr:=@textrec(f).buffer;
  3972. end;
  3973. {Save the process ID - needed when closing }
  3974. pl:=plongint(@(textrec(f).userdata[2]));
  3975. pl^:=pid;
  3976. textrec(f).closefunc:=@PCloseText;
  3977. end;
  3978. end;
  3979. Procedure POpen(var F:file;const Prog:String;rw:char);
  3980. {
  3981. Starts the program in 'Prog' and makes it's input or out put the
  3982. other end of a pipe. If rw is 'w' or 'W', then whatever is written to
  3983. F, will be read from stdin by the program in 'Prog'. The inverse is true
  3984. for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
  3985. read from 'f'.
  3986. }
  3987. var
  3988. pipi,
  3989. pipo : file;
  3990. pid : longint;
  3991. pl : ^longint;
  3992. p,pp : ppchar;
  3993. temp : string[255];
  3994. begin
  3995. LinuxError:=0;
  3996. rw:=upcase(rw);
  3997. if not (rw in ['R','W']) then
  3998. begin
  3999. LinuxError:=Sys_enoent;
  4000. exit;
  4001. end;
  4002. AssignPipe(pipi,pipo);
  4003. if Linuxerror<>0 then
  4004. exit;
  4005. pid:=fork;
  4006. if linuxerror<>0 then
  4007. begin
  4008. close(pipi);
  4009. close(pipo);
  4010. exit;
  4011. end;
  4012. if pid=0 then
  4013. begin
  4014. { We're in the child }
  4015. if rw='W' then
  4016. begin
  4017. close(pipo);
  4018. dup2(filerec(pipi).handle,stdinputhandle);
  4019. close(pipi);
  4020. if linuxerror<>0 then
  4021. halt(127);
  4022. end
  4023. else
  4024. begin
  4025. close(pipi);
  4026. dup2(filerec(pipo).handle,stdoutputhandle);
  4027. close(pipo);
  4028. if linuxerror<>0 then
  4029. halt(127);
  4030. end;
  4031. getmem(pp,sizeof(pchar)*4);
  4032. temp:='/bin/sh'#0'-c'#0+prog+#0;
  4033. p:=pp;
  4034. p^:=@temp[1];
  4035. inc(p);
  4036. p^:=@temp[9];
  4037. inc(p);
  4038. p^:=@temp[12];
  4039. inc(p);
  4040. p^:=Nil;
  4041. Execve('/bin/sh',pp,envp);
  4042. halt(127);
  4043. end
  4044. else
  4045. begin
  4046. { We're in the parent }
  4047. if rw='W' then
  4048. begin
  4049. close(pipi);
  4050. f:=pipo;
  4051. end
  4052. else
  4053. begin
  4054. close(pipo);
  4055. f:=pipi;
  4056. end;
  4057. {Save the process ID - needed when closing }
  4058. pl:=plongint(@(filerec(f).userdata[2]));
  4059. pl^:=pid;
  4060. end;
  4061. end;
  4062. Function AssignStream(Var StreamIn,Streamout:text;Const Prog:String) : longint;
  4063. {
  4064. Starts the program in 'Prog' and makes its input and output the
  4065. other end of two pipes, which are the stdin and stdout of a program
  4066. specified in 'Prog'.
  4067. streamout can be used to write to the program, streamin can be used to read
  4068. the output of the program. See the following diagram :
  4069. Parent Child
  4070. STreamout --> Input
  4071. Streamin <-- Output
  4072. Return value is the process ID of the process being spawned, or -1 in case of failure.
  4073. }
  4074. var
  4075. pipi,
  4076. pipo : text;
  4077. pid : longint;
  4078. pl : ^Longint;
  4079. begin
  4080. LinuxError:=0;
  4081. AssignStream:=-1;
  4082. AssignPipe(streamin,pipo);
  4083. if Linuxerror<>0 then
  4084. exit;
  4085. AssignPipe(pipi,streamout);
  4086. if Linuxerror<>0 then
  4087. exit;
  4088. pid:=fork;
  4089. if linuxerror<>0 then
  4090. begin
  4091. close(pipi);
  4092. close(pipo);
  4093. close (streamin);
  4094. close (streamout);
  4095. exit;
  4096. end;
  4097. if pid=0 then
  4098. begin
  4099. { We're in the child }
  4100. { Close what we don't need }
  4101. close(streamout);
  4102. close(streamin);
  4103. dup2(pipi,input);
  4104. if linuxerror<>0 then
  4105. halt(127);
  4106. close(pipi);
  4107. dup2(pipo,output);
  4108. if linuxerror<>0 then
  4109. halt (127);
  4110. close(pipo);
  4111. Execl(Prog);
  4112. halt(127);
  4113. end
  4114. else
  4115. begin
  4116. { we're in the parent}
  4117. close(pipo);
  4118. close(pipi);
  4119. {Save the process ID - needed when closing }
  4120. pl:=plongint(@(textrec(StreamIn).userdata[2]));
  4121. pl^:=pid;
  4122. textrec(StreamIn).closefunc:=@PCloseText;
  4123. {Save the process ID - needed when closing }
  4124. pl:=plongint(@(textrec(StreamOut).userdata[2]));
  4125. pl^:=pid;
  4126. textrec(StreamOut).closefunc:=@PCloseText;
  4127. AssignStream:=Pid;
  4128. end;
  4129. end;
  4130. function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: String): LongInt;
  4131. {
  4132. Starts the program in 'prog' and makes its input, output and error output the
  4133. other end of three pipes, which are the stdin, stdout and stderr of a program
  4134. specified in 'prog'.
  4135. StreamOut can be used to write to the program, StreamIn can be used to read
  4136. the output of the program, StreamErr reads the error output of the program.
  4137. See the following diagram :
  4138. Parent Child
  4139. StreamOut --> StdIn (input)
  4140. StreamIn <-- StdOut (output)
  4141. StreamErr <-- StdErr (error output)
  4142. }
  4143. var
  4144. PipeIn, PipeOut, PipeErr: text;
  4145. pid: LongInt;
  4146. pl: ^LongInt;
  4147. begin
  4148. LinuxError := 0;
  4149. AssignStream := -1;
  4150. // Assign pipes
  4151. AssignPipe(StreamIn, PipeOut);
  4152. if LinuxError <> 0 then exit;
  4153. AssignPipe(StreamErr, PipeErr);
  4154. if LinuxError <> 0 then begin
  4155. Close(StreamIn);
  4156. Close(PipeOut);
  4157. exit;
  4158. end;
  4159. AssignPipe(PipeIn, StreamOut);
  4160. if LinuxError <> 0 then begin
  4161. Close(StreamIn);
  4162. Close(PipeOut);
  4163. Close(StreamErr);
  4164. Close(PipeErr);
  4165. exit;
  4166. end;
  4167. // Fork
  4168. pid := Fork;
  4169. if LinuxError <> 0 then begin
  4170. Close(StreamIn);
  4171. Close(PipeOut);
  4172. Close(StreamErr);
  4173. Close(PipeErr);
  4174. Close(PipeIn);
  4175. Close(StreamOut);
  4176. exit;
  4177. end;
  4178. if pid = 0 then begin
  4179. // *** We are in the child ***
  4180. // Close what we don not need
  4181. Close(StreamOut);
  4182. Close(StreamIn);
  4183. Close(StreamErr);
  4184. // Connect pipes
  4185. dup2(PipeIn, Input);
  4186. if LinuxError <> 0 then Halt(127);
  4187. Close(PipeIn);
  4188. dup2(PipeOut, Output);
  4189. if LinuxError <> 0 then Halt(127);
  4190. Close(PipeOut);
  4191. dup2(PipeErr, StdErr);
  4192. if LinuxError <> 0 then Halt(127);
  4193. Close(PipeErr);
  4194. // Execute program
  4195. Execl(Prog);
  4196. Halt(127);
  4197. end else begin
  4198. // *** We are in the parent ***
  4199. Close(PipeErr);
  4200. Close(PipeOut);
  4201. Close(PipeIn);
  4202. // Save the process ID - needed when closing
  4203. pl := plongint(@(TextRec(StreamIn).userdata[2]));
  4204. pl^ := pid;
  4205. TextRec(StreamIn).closefunc := @PCloseText;
  4206. // Save the process ID - needed when closing
  4207. pl := plongint(@(TextRec(StreamOut).userdata[2]));
  4208. pl^ := pid;
  4209. TextRec(StreamOut).closefunc := @PCloseText;
  4210. // Save the process ID - needed when closing
  4211. pl := plongint(@(TextRec(StreamErr).userdata[2]));
  4212. pl^ := pid;
  4213. TextRec(StreamErr).closefunc := @PCloseText;
  4214. AssignStream := pid;
  4215. end;
  4216. end;
  4217. {******************************************************************************
  4218. General information calls
  4219. ******************************************************************************}
  4220. Function GetEnv(P:string):Pchar;
  4221. {
  4222. Searches the environment for a string with name p and
  4223. returns a pchar to it's value.
  4224. A pchar is used to accomodate for strings of length > 255
  4225. }
  4226. var
  4227. ep : ppchar;
  4228. found : boolean;
  4229. Begin
  4230. p:=p+'='; {Else HOST will also find HOSTNAME, etc}
  4231. ep:=envp;
  4232. found:=false;
  4233. if ep<>nil then
  4234. begin
  4235. while (not found) and (ep^<>nil) do
  4236. begin
  4237. if strlcomp(@p[1],(ep^),length(p))=0 then
  4238. found:=true
  4239. else
  4240. inc(ep);
  4241. end;
  4242. end;
  4243. if found then
  4244. getenv:=ep^+length(p)
  4245. else
  4246. getenv:=nil;
  4247. end;
  4248. {$ifndef bsd}
  4249. Function GetDomainName:String;
  4250. {
  4251. Get machines domain name. Returns empty string if not set.
  4252. }
  4253. Var
  4254. Sysn : utsname;
  4255. begin
  4256. Uname(Sysn);
  4257. linuxerror:=errno;
  4258. If linuxerror<>0 then
  4259. getdomainname:=''
  4260. else
  4261. getdomainname:=strpas(@Sysn.domainname[0]);
  4262. end;
  4263. Function GetHostName:String;
  4264. {
  4265. Get machines name. Returns empty string if not set.
  4266. }
  4267. Var
  4268. Sysn : utsname;
  4269. begin
  4270. uname(Sysn);
  4271. linuxerror:=errno;
  4272. If linuxerror<>0 then
  4273. gethostname:=''
  4274. else
  4275. gethostname:=strpas(@Sysn.nodename[0]);
  4276. end;
  4277. {$endif}
  4278. {******************************************************************************
  4279. Signal handling calls
  4280. ******************************************************************************}
  4281. procedure SigRaise(sig:integer);
  4282. begin
  4283. Kill(GetPid,Sig);
  4284. end;
  4285. {******************************************************************************
  4286. IOCtl and Termios calls
  4287. ******************************************************************************}
  4288. Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
  4289. begin
  4290. {$ifndef BSD}
  4291. TCGetAttr:=IOCtl(fd,TCGETS,@tios);
  4292. {$else}
  4293. TCGETAttr:=IoCtl(Fd,TIOCGETA,@tios);
  4294. {$endif}
  4295. end;
  4296. Function TCSetAttr(fd:longint;OptAct:longint;const tios:TermIOS):boolean;
  4297. var
  4298. nr:longint;
  4299. begin
  4300. {$ifndef BSD}
  4301. case OptAct of
  4302. TCSANOW : nr:=TCSETS;
  4303. TCSADRAIN : nr:=TCSETSW;
  4304. TCSAFLUSH : nr:=TCSETSF;
  4305. {$else}
  4306. case OptAct of
  4307. TCSANOW : nr:=TIOCSETA;
  4308. TCSADRAIN : nr:=TIOCSETAW;
  4309. TCSAFLUSH : nr:=TIOCSETAF;
  4310. {$endif}
  4311. else
  4312. begin
  4313. ErrNo:=Sys_EINVAL;
  4314. TCSetAttr:=false;
  4315. exit;
  4316. end;
  4317. end;
  4318. TCSetAttr:=IOCtl(fd,nr,@Tios);
  4319. end;
  4320. Procedure CFSetISpeed(var tios:TermIOS;speed:Cardinal);
  4321. begin
  4322. {$ifndef BSD}
  4323. tios.c_cflag:=Cardinal(tios.c_cflag and cardinal(not CBAUD)) or speed;
  4324. {$else}
  4325. tios.c_ispeed:=speed; {Probably the Bxxxx speed constants}
  4326. {$endif}
  4327. end;
  4328. Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal);
  4329. begin
  4330. {$ifndef BSD}
  4331. CFSetISpeed(tios,speed);
  4332. {$else}
  4333. tios.c_ospeed:=speed;
  4334. {$endif}
  4335. end;
  4336. Procedure CFMakeRaw(var tios:TermIOS);
  4337. begin
  4338. {$ifndef BSD}
  4339. with tios do
  4340. begin
  4341. c_iflag:=c_iflag and cardinal(not (IGNBRK or BRKINT or PARMRK or ISTRIP or
  4342. INLCR or IGNCR or ICRNL or IXON));
  4343. c_oflag:=c_oflag and cardinal(not OPOST);
  4344. c_lflag:=c_lflag and cardinal(not (ECHO or ECHONL or ICANON or ISIG or IEXTEN));
  4345. c_cflag:=(c_cflag and cardinal(not (CSIZE or PARENB))) or CS8;
  4346. end;
  4347. {$else}
  4348. with tios do
  4349. begin
  4350. c_iflag:=c_iflag and (not (IMAXBEL or IXOFF or INPCK or BRKINT or
  4351. PARMRK or ISTRIP or INLCR or IGNCR or ICRNL or IXON or
  4352. IGNPAR));
  4353. c_iflag:=c_iflag OR IGNBRK;
  4354. c_oflag:=c_oflag and (not OPOST);
  4355. c_lflag:=c_lflag and (not (ECHO or ECHOE or ECHOK or ECHONL or ICANON or
  4356. ISIG or IEXTEN or NOFLSH or TOSTOP or PENDIN));
  4357. c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or (CS8 OR cread);
  4358. c_cc[VMIN]:=1;
  4359. c_cc[VTIME]:=0;
  4360. end;
  4361. {$endif}
  4362. end;
  4363. Function TCSendBreak(fd,duration:longint):boolean;
  4364. begin
  4365. {$ifndef BSD}
  4366. TCSendBreak:=IOCtl(fd,TCSBRK,pointer(duration));
  4367. {$else}
  4368. TCSendBreak:=IOCtl(fd,TIOCSBRK,0);
  4369. {$endif}
  4370. end;
  4371. Function TCSetPGrp(fd,id:longint):boolean;
  4372. begin
  4373. TCSetPGrp:=IOCtl(fd,TIOCSPGRP,pointer(id));
  4374. end;
  4375. Function TCGetPGrp(fd:longint;var id:longint):boolean;
  4376. begin
  4377. TCGetPGrp:=IOCtl(fd,TIOCGPGRP,@id);
  4378. end;
  4379. Function TCDrain(fd:longint):boolean;
  4380. begin
  4381. {$ifndef BSD}
  4382. TCDrain:=IOCtl(fd,TCSBRK,pointer(1));
  4383. {$else}
  4384. TCDrain:=IOCtl(fd,TIOCDRAIN,0); {Should set timeout to 1 first?}
  4385. {$endif}
  4386. end;
  4387. Function TCFlow(fd,act:longint):boolean;
  4388. begin
  4389. {$ifndef BSD}
  4390. TCFlow:=IOCtl(fd,TCXONC,pointer(act));
  4391. {$else}
  4392. case act OF
  4393. TCOOFF : TCFlow:=Ioctl(fd,TIOCSTOP,0);
  4394. TCOOn : TCFlow:=IOctl(Fd,TIOCStart,0);
  4395. TCIOFF : {N/I}
  4396. end;
  4397. {$endif}
  4398. end;
  4399. Function TCFlush(fd,qsel:longint):boolean;
  4400. begin
  4401. {$ifndef BSD}
  4402. TCFlush:=IOCtl(fd,TCFLSH,pointer(qsel));
  4403. {$else}
  4404. TCFlush:=IOCtl(fd,TIOCFLUSH,pointer(qsel));
  4405. {$endif}
  4406. end;
  4407. Function IsATTY(Handle:Longint):Boolean;
  4408. {
  4409. Check if the filehandle described by 'handle' is a TTY (Terminal)
  4410. }
  4411. var
  4412. t : Termios;
  4413. begin
  4414. IsAtty:=TCGetAttr(Handle,t);
  4415. end;
  4416. Function IsATTY(var f: text):Boolean;
  4417. {
  4418. Idem as previous, only now for text variables.
  4419. }
  4420. begin
  4421. IsATTY:=IsaTTY(textrec(f).handle);
  4422. end;
  4423. function TTYName(Handle:Longint):string;
  4424. {
  4425. Return the name of the current tty described by handle f.
  4426. returns empty string in case of an error.
  4427. }
  4428. {$ifdef BSD}
  4429. var
  4430. mydev,
  4431. myino : cardinal;
  4432. {$else not BSD}
  4433. var
  4434. mydev,
  4435. myino : longint;
  4436. {$endif not BSD}
  4437. st : stat;
  4438. function mysearch(n:string): boolean;
  4439. {searches recursively for the device in the directory given by n,
  4440. returns true if found and sets the name of the device in ttyname}
  4441. var dirstream : pdir;
  4442. d : pdirent;
  4443. name : string;
  4444. st : stat;
  4445. begin
  4446. dirstream:=opendir(n);
  4447. if (linuxerror<>0) then
  4448. exit;
  4449. d:=Readdir(dirstream);
  4450. while (d<>nil) do
  4451. begin
  4452. name:=n+'/'+strpas(@(d^.name[0]));
  4453. fstat(name,st);
  4454. if linuxerror=0 then
  4455. begin
  4456. if ((st.mode and $E000)=$4000) and { if it is a directory }
  4457. (strpas(@(d^.name[0]))<>'.') and { but not ., .. and fd subdirs }
  4458. (strpas(@(d^.name[0]))<>'..') and
  4459. (strpas(@(d^.name[0]))<>'') and
  4460. (strpas(@(d^.name[0]))<>'fd') then
  4461. begin {we found a directory, search inside it}
  4462. if mysearch(name) then
  4463. begin {the device is here}
  4464. closedir(dirstream); {then don't continue searching}
  4465. mysearch:=true;
  4466. exit;
  4467. end;
  4468. end
  4469. else if (d^.ino=myino) and (st.dev=mydev) then
  4470. begin
  4471. closedir(dirstream);
  4472. ttyname:=name;
  4473. mysearch:=true;
  4474. exit;
  4475. end;
  4476. end;
  4477. d:=Readdir(dirstream);
  4478. end;
  4479. closedir(dirstream);
  4480. mysearch:=false;
  4481. end;
  4482. begin
  4483. TTYName:='';
  4484. fstat(handle,st);
  4485. if (errno<>0) and isatty (handle) then
  4486. exit;
  4487. mydev:=st.dev;
  4488. myino:=st.ino;
  4489. mysearch('/dev');
  4490. end;
  4491. function TTYName(var F:Text):string;
  4492. {
  4493. Idem as previous, only now for text variables;
  4494. }
  4495. begin
  4496. TTYName:=TTYName(textrec(f).handle);
  4497. end;
  4498. {******************************************************************************
  4499. Utility calls
  4500. ******************************************************************************}
  4501. Function Octal(l:longint):longint;
  4502. {
  4503. Convert an octal specified number to decimal;
  4504. }
  4505. var
  4506. octnr,
  4507. oct : longint;
  4508. begin
  4509. octnr:=0;
  4510. oct:=0;
  4511. while (l>0) do
  4512. begin
  4513. oct:=oct or ((l mod 10) shl octnr);
  4514. l:=l div 10;
  4515. inc(octnr,3);
  4516. end;
  4517. Octal:=oct;
  4518. end;
  4519. Function StringToPPChar(S: PChar):ppchar;
  4520. var
  4521. nr : longint;
  4522. Buf : ^char;
  4523. p : ppchar;
  4524. begin
  4525. buf:=s;
  4526. nr:=0;
  4527. while(buf^<>#0) do
  4528. begin
  4529. while (buf^ in [' ',#9,#10]) do
  4530. inc(buf);
  4531. inc(nr);
  4532. while not (buf^ in [' ',#0,#9,#10]) do
  4533. inc(buf);
  4534. end;
  4535. getmem(p,(nr+1)*4);
  4536. StringToPPChar:=p;
  4537. if p=nil then
  4538. begin
  4539. LinuxError:=sys_enomem;
  4540. exit;
  4541. end;
  4542. buf:=s;
  4543. while (buf^<>#0) do
  4544. begin
  4545. while (buf^ in [' ',#9,#10]) do
  4546. begin
  4547. buf^:=#0;
  4548. inc(buf);
  4549. end;
  4550. p^:=buf;
  4551. inc(p);
  4552. p^:=nil;
  4553. while not (buf^ in [' ',#0,#9,#10]) do
  4554. inc(buf);
  4555. end;
  4556. end;
  4557. Function StringToPPChar(Var S:String):ppchar;
  4558. {
  4559. Create a PPChar to structure of pchars which are the arguments specified
  4560. in the string S. Especially useful for creating an ArgV for Exec-calls
  4561. Note that the string S is destroyed by this call.
  4562. }
  4563. begin
  4564. S:=S+#0;
  4565. StringToPPChar:=StringToPPChar(@S[1]);
  4566. end;
  4567. Function StringToPPChar(Var S:AnsiString):ppchar;
  4568. {
  4569. Create a PPChar to structure of pchars which are the arguments specified
  4570. in the string S. Especially useful for creating an ArgV for Exec-calls
  4571. }
  4572. begin
  4573. StringToPPChar:=StringToPPChar(PChar(S));
  4574. end;
  4575. {
  4576. function FExpand (const Path: PathStr): PathStr;
  4577. - declared in fexpand.inc
  4578. }
  4579. {$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
  4580. {$DEFINE FPC_FEXPAND_GETENVPCHAR} { GetEnv result is a PChar }
  4581. const
  4582. LFNSupport = true;
  4583. FileNameCaseSensitive = true;
  4584. {$I fexpand.inc}
  4585. {$UNDEF FPC_FEXPAND_GETENVPCHAR}
  4586. {$UNDEF FPC_FEXPAND_TILDE}
  4587. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  4588. {
  4589. Searches for a file 'path' in the list of direcories in 'dirlist'.
  4590. returns an empty string if not found. Wildcards are NOT allowed.
  4591. If dirlist is empty, it is set to '.'
  4592. }
  4593. Var
  4594. NewDir : PathStr;
  4595. p1 : Longint;
  4596. Info : Stat;
  4597. Begin
  4598. {Replace ':' with ';'}
  4599. for p1:=1to length(dirlist) do
  4600. if dirlist[p1]=':' then
  4601. dirlist[p1]:=';';
  4602. {Check for WildCards}
  4603. If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
  4604. FSearch:='' {No wildcards allowed in these things.}
  4605. Else
  4606. Begin
  4607. Dirlist:='.;'+dirlist;{Make sure current dir is first to be searched.}
  4608. Repeat
  4609. p1:=Pos(';',DirList);
  4610. If p1=0 Then
  4611. p1:=255;
  4612. NewDir:=Copy(DirList,1,P1 - 1);
  4613. if NewDir[Length(NewDir)]<>'/' then
  4614. NewDir:=NewDir+'/';
  4615. NewDir:=NewDir+Path;
  4616. Delete(DirList,1,p1);
  4617. if FStat(NewDir,Info) then
  4618. Begin
  4619. If Pos('./',NewDir)=1 Then
  4620. Delete(NewDir,1,2);
  4621. {DOS strips off an initial .\}
  4622. End
  4623. Else
  4624. NewDir:='';
  4625. Until (DirList='') or (Length(NewDir) > 0);
  4626. FSearch:=NewDir;
  4627. End;
  4628. End;
  4629. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  4630. Var
  4631. DotPos,SlashPos,i : longint;
  4632. Begin
  4633. SlashPos:=0;
  4634. DotPos:=256;
  4635. i:=Length(Path);
  4636. While (i>0) and (SlashPos=0) Do
  4637. Begin
  4638. If (DotPos=256) and (Path[i]='.') Then
  4639. begin
  4640. DotPos:=i;
  4641. end;
  4642. If (Path[i]='/') Then
  4643. SlashPos:=i;
  4644. Dec(i);
  4645. End;
  4646. Ext:=Copy(Path,DotPos,255);
  4647. Dir:=Copy(Path,1,SlashPos);
  4648. Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
  4649. End;
  4650. Function Dirname(Const path:pathstr):pathstr;
  4651. {
  4652. This function returns the directory part of a complete path.
  4653. Unless the directory is root '/', The last character is not
  4654. a slash.
  4655. }
  4656. var
  4657. Dir : PathStr;
  4658. Name : NameStr;
  4659. Ext : ExtStr;
  4660. begin
  4661. FSplit(Path,Dir,Name,Ext);
  4662. if length(Dir)>1 then
  4663. Delete(Dir,length(Dir),1);
  4664. DirName:=Dir;
  4665. end;
  4666. Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
  4667. {
  4668. This function returns the filename part of a complete path. If suf is
  4669. supplied, it is cut off the filename.
  4670. }
  4671. var
  4672. Dir : PathStr;
  4673. Name : NameStr;
  4674. Ext : ExtStr;
  4675. begin
  4676. FSplit(Path,Dir,Name,Ext);
  4677. if Suf<>Ext then
  4678. Name:=Name+Ext;
  4679. BaseName:=Name;
  4680. end;
  4681. Function FNMatch(const Pattern,Name:string):Boolean;
  4682. Var
  4683. LenPat,LenName : longint;
  4684. Function DoFNMatch(i,j:longint):Boolean;
  4685. Var
  4686. Found : boolean;
  4687. Begin
  4688. Found:=true;
  4689. While Found and (i<=LenPat) Do
  4690. Begin
  4691. Case Pattern[i] of
  4692. '?' : Found:=(j<=LenName);
  4693. '*' : Begin
  4694. {find the next character in pattern, different of ? and *}
  4695. while Found and (i<LenPat) do
  4696. begin
  4697. inc(i);
  4698. case Pattern[i] of
  4699. '*' : ;
  4700. '?' : begin
  4701. inc(j);
  4702. Found:=(j<=LenName);
  4703. end;
  4704. else
  4705. Found:=false;
  4706. end;
  4707. end;
  4708. {Now, find in name the character which i points to, if the * or ?
  4709. wasn't the last character in the pattern, else, use up all the
  4710. chars in name}
  4711. Found:=true;
  4712. if (i<=LenPat) then
  4713. begin
  4714. repeat
  4715. {find a letter (not only first !) which maches pattern[i]}
  4716. while (j<=LenName) and (name[j]<>pattern[i]) do
  4717. inc (j);
  4718. if (j<LenName) then
  4719. begin
  4720. if DoFnMatch(i+1,j+1) then
  4721. begin
  4722. i:=LenPat;
  4723. j:=LenName;{we can stop}
  4724. Found:=true;
  4725. end
  4726. else
  4727. inc(j);{We didn't find one, need to look further}
  4728. end;
  4729. until (j>=LenName);
  4730. end
  4731. else
  4732. j:=LenName;{we can stop}
  4733. end;
  4734. else {not a wildcard character in pattern}
  4735. Found:=(j<=LenName) and (pattern[i]=name[j]);
  4736. end;
  4737. inc(i);
  4738. inc(j);
  4739. end;
  4740. DoFnMatch:=Found and (j>LenName);
  4741. end;
  4742. Begin {start FNMatch}
  4743. LenPat:=Length(Pattern);
  4744. LenName:=Length(Name);
  4745. FNMatch:=DoFNMatch(1,1);
  4746. End;
  4747. Procedure Globfree(var p : pglob);
  4748. {
  4749. Release memory occupied by pglob structure, and names in it.
  4750. sets p to nil.
  4751. }
  4752. var
  4753. temp : pglob;
  4754. begin
  4755. while assigned(p) do
  4756. begin
  4757. temp:=p^.next;
  4758. if assigned(p^.name) then
  4759. freemem(p^.name);
  4760. dispose(p);
  4761. p:=temp;
  4762. end;
  4763. end;
  4764. Function Glob(Const path:pathstr):pglob;
  4765. {
  4766. Fills a tglob structure with entries matching path,
  4767. and returns a pointer to it. Returns nil on error,
  4768. linuxerror is set accordingly.
  4769. }
  4770. var
  4771. temp,
  4772. temp2 : string[255];
  4773. thedir : pdir;
  4774. buffer : pdirent;
  4775. root,
  4776. current : pglob;
  4777. begin
  4778. { Get directory }
  4779. temp:=dirname(path);
  4780. if temp='' then
  4781. temp:='.';
  4782. temp:=temp+#0;
  4783. thedir:=opendir(@temp[1]);
  4784. if thedir=nil then
  4785. begin
  4786. glob:=nil;
  4787. linuxerror:=errno;
  4788. exit;
  4789. end;
  4790. temp:=basename(path,''); { get the pattern }
  4791. if thedir^.fd<0 then
  4792. begin
  4793. linuxerror:=errno;
  4794. glob:=nil;
  4795. exit;
  4796. end;
  4797. {get the entries}
  4798. root:=nil;
  4799. current:=nil;
  4800. repeat
  4801. buffer:=Sys_readdir(thedir);
  4802. if buffer=nil then
  4803. break;
  4804. temp2:=strpas(@(buffer^.name[0]));
  4805. if fnmatch(temp,temp2) then
  4806. begin
  4807. if root=nil then
  4808. begin
  4809. new(root);
  4810. current:=root;
  4811. end
  4812. else
  4813. begin
  4814. new(current^.next);
  4815. current:=current^.next;
  4816. end;
  4817. if current=nil then
  4818. begin
  4819. linuxerror:=Sys_ENOMEM;
  4820. globfree(root);
  4821. break;
  4822. end;
  4823. current^.next:=nil;
  4824. getmem(current^.name,length(temp2)+1);
  4825. if current^.name=nil then
  4826. begin
  4827. linuxerror:=Sys_ENOMEM;
  4828. globfree(root);
  4829. break;
  4830. end;
  4831. move(buffer^.name[0],current^.name^,length(temp2)+1);
  4832. end;
  4833. until false;
  4834. closedir(thedir);
  4835. glob:=root;
  4836. end;
  4837. {--------------------------------
  4838. FiledescriptorSets
  4839. --------------------------------}
  4840. Procedure FD_Zero(var fds:fdSet);
  4841. {
  4842. Clear the set of filedescriptors
  4843. }
  4844. begin
  4845. FillChar(fds,sizeof(fdSet),0);
  4846. end;
  4847. Procedure FD_Clr(fd:longint;var fds:fdSet);
  4848. {
  4849. Remove fd from the set of filedescriptors
  4850. }
  4851. begin
  4852. fds[fd shr 5]:=fds[fd shr 5] and (not (1 shl (fd and 31)));
  4853. end;
  4854. Procedure FD_Set(fd:longint;var fds:fdSet);
  4855. {
  4856. Add fd to the set of filedescriptors
  4857. }
  4858. begin
  4859. fds[fd shr 5]:=fds[fd shr 5] or (1 shl (fd and 31));
  4860. end;
  4861. Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
  4862. {
  4863. Test if fd is part of the set of filedescriptors
  4864. }
  4865. begin
  4866. FD_IsSet:=((fds[fd shr 5] and (1 shl (fd and 31)))<>0);
  4867. end;
  4868. Function GetFS (var T:Text):longint;
  4869. {
  4870. Get File Descriptor of a text file.
  4871. }
  4872. begin
  4873. if textrec(t).mode=fmclosed then
  4874. exit(-1)
  4875. else
  4876. GETFS:=textrec(t).Handle
  4877. end;
  4878. Function GetFS(Var F:File):longint;
  4879. {
  4880. Get File Descriptor of an unTyped file.
  4881. }
  4882. begin
  4883. { Handle and mode are on the same place in textrec and filerec. }
  4884. if filerec(f).mode=fmclosed then
  4885. exit(-1)
  4886. else
  4887. GETFS:=filerec(f).Handle
  4888. end;
  4889. {--------------------------------
  4890. Stat.Mode Macro's
  4891. --------------------------------}
  4892. Function S_ISLNK(m:word):boolean;
  4893. {
  4894. Check mode field of inode for link.
  4895. }
  4896. begin
  4897. S_ISLNK:=(m and STAT_IFMT)=STAT_IFLNK;
  4898. end;
  4899. Function S_ISREG(m:word):boolean;
  4900. {
  4901. Check mode field of inode for regular file.
  4902. }
  4903. begin
  4904. S_ISREG:=(m and STAT_IFMT)=STAT_IFREG;
  4905. end;
  4906. Function S_ISDIR(m:word):boolean;
  4907. {
  4908. Check mode field of inode for directory.
  4909. }
  4910. begin
  4911. S_ISDIR:=(m and STAT_IFMT)=STAT_IFDIR;
  4912. end;
  4913. Function S_ISCHR(m:word):boolean;
  4914. {
  4915. Check mode field of inode for character device.
  4916. }
  4917. begin
  4918. S_ISCHR:=(m and STAT_IFMT)=STAT_IFCHR;
  4919. end;
  4920. Function S_ISBLK(m:word):boolean;
  4921. {
  4922. Check mode field of inode for block device.
  4923. }
  4924. begin
  4925. S_ISBLK:=(m and STAT_IFMT)=STAT_IFBLK;
  4926. end;
  4927. Function S_ISFIFO(m:word):boolean;
  4928. {
  4929. Check mode field of inode for named pipe (FIFO).
  4930. }
  4931. begin
  4932. S_ISFIFO:=(m and STAT_IFMT)=STAT_IFIFO;
  4933. end;
  4934. Function S_ISSOCK(m:word):boolean;
  4935. {
  4936. Check mode field of inode for socket.
  4937. }
  4938. begin
  4939. S_ISSOCK:=(m and STAT_IFMT)=STAT_IFSOCK;
  4940. end;
  4941. Procedure WritePort (Port : Longint; Value : Byte);oldfpccall;
  4942. {
  4943. Writes 'Value' to port 'Port'
  4944. }
  4945. begin
  4946. asm
  4947. movl port,%edx
  4948. movb value,%al
  4949. outb %al,%dx
  4950. end ['EAX','EDX'];
  4951. end;
  4952. Procedure WritePort (Port : Longint; Value : Word);oldfpccall;
  4953. {
  4954. Writes 'Value' to port 'Port'
  4955. }
  4956. begin
  4957. asm
  4958. movl port,%edx
  4959. movw value,%ax
  4960. outw %ax,%dx
  4961. end ['EAX','EDX'];
  4962. end;
  4963. Procedure WritePort (Port : Longint; Value : Longint);oldfpccall;
  4964. {
  4965. Writes 'Value' to port 'Port'
  4966. }
  4967. begin
  4968. asm
  4969. movl port,%edx
  4970. movl value,%eax
  4971. outl %eax,%dx
  4972. end ['EAX','EDX'];
  4973. end;
  4974. Procedure WritePortB (Port : Longint; Value : Byte);oldfpccall;
  4975. {
  4976. Writes 'Value' to port 'Port'
  4977. }
  4978. begin
  4979. asm
  4980. movl port,%edx
  4981. movb value,%al
  4982. outb %al,%dx
  4983. end ['EAX','EDX'];
  4984. end;
  4985. Procedure WritePortW (Port : Longint; Value : Word);oldfpccall;
  4986. {
  4987. Writes 'Value' to port 'Port'
  4988. }
  4989. begin
  4990. asm
  4991. movl port,%edx
  4992. movw value,%ax
  4993. outw %ax,%dx
  4994. end ['EAX','EDX'];
  4995. end;
  4996. Procedure WritePortL (Port : Longint; Value : Longint);oldfpccall;
  4997. {
  4998. Writes 'Value' to port 'Port'
  4999. }
  5000. begin
  5001. asm
  5002. movl port,%edx
  5003. movl value,%eax
  5004. outl %eax,%dx
  5005. end ['EAX','EDX'];
  5006. end;
  5007. Procedure WritePortl (Port : Longint; Var Buf; Count: longint);oldfpccall;
  5008. {
  5009. Writes 'Count' longints from 'Buf' to Port
  5010. }
  5011. begin
  5012. asm
  5013. movl count,%ecx
  5014. movl buf,%esi
  5015. movl port,%edx
  5016. cld
  5017. rep
  5018. outsl
  5019. end ['ECX','ESI','EDX'];
  5020. end;
  5021. Procedure WritePortW (Port : Longint; Var Buf; Count: longint);oldfpccall;
  5022. {
  5023. Writes 'Count' words from 'Buf' to Port
  5024. }
  5025. begin
  5026. asm
  5027. movl count,%ecx
  5028. movl buf,%esi
  5029. movl port,%edx
  5030. cld
  5031. rep
  5032. outsw
  5033. end ['ECX','ESI','EDX'];
  5034. end;
  5035. Procedure WritePortB (Port : Longint; Var Buf; Count: longint);oldfpccall;
  5036. {
  5037. Writes 'Count' bytes from 'Buf' to Port
  5038. }
  5039. begin
  5040. asm
  5041. movl count,%ecx
  5042. movl buf,%esi
  5043. movl port,%edx
  5044. cld
  5045. rep
  5046. outsb
  5047. end ['ECX','ESI','EDX'];
  5048. end;
  5049. Procedure ReadPort (Port : Longint; Var Value : Byte);oldfpccall;
  5050. {
  5051. Reads 'Value' from port 'Port'
  5052. }
  5053. begin
  5054. asm
  5055. movl port,%edx
  5056. inb %dx,%al
  5057. movl value,%edx
  5058. movb %al,(%edx)
  5059. end ['EAX','EDX'];
  5060. end;
  5061. Procedure ReadPort (Port : Longint; Var Value : Word);oldfpccall;
  5062. {
  5063. Reads 'Value' from port 'Port'
  5064. }
  5065. begin
  5066. asm
  5067. movl port,%edx
  5068. inw %dx,%ax
  5069. movl value,%edx
  5070. movw %ax,(%edx)
  5071. end ['EAX','EDX'];
  5072. end;
  5073. Procedure ReadPort (Port : Longint; Var Value : Longint);oldfpccall;
  5074. {
  5075. Reads 'Value' from port 'Port'
  5076. }
  5077. begin
  5078. asm
  5079. movl port,%edx
  5080. inl %dx,%eax
  5081. movl value,%edx
  5082. movl %eax,(%edx)
  5083. end ['EAX','EDX'];
  5084. end;
  5085. function ReadPortB (Port : Longint): Byte;oldfpccall; assembler;
  5086. {
  5087. Reads a byte from port 'Port'
  5088. }
  5089. asm
  5090. xorl %eax,%eax
  5091. movl port,%edx
  5092. inb %dx,%al
  5093. end ['EAX','EDX'];
  5094. function ReadPortW (Port : Longint): Word;oldfpccall; assembler;
  5095. {
  5096. Reads a word from port 'Port'
  5097. }
  5098. asm
  5099. xorl %eax,%eax
  5100. movl port,%edx
  5101. inw %dx,%ax
  5102. end ['EAX','EDX'];
  5103. function ReadPortL (Port : Longint): LongInt;oldfpccall; assembler;
  5104. {
  5105. Reads a LongInt from port 'Port'
  5106. }
  5107. asm
  5108. movl port,%edx
  5109. inl %dx,%eax
  5110. end ['EAX','EDX'];
  5111. Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);oldfpccall;
  5112. {
  5113. Reads 'Count' longints from port 'Port' to 'Buf'.
  5114. }
  5115. begin
  5116. asm
  5117. movl count,%ecx
  5118. movl buf,%edi
  5119. movl port,%edx
  5120. cld
  5121. rep
  5122. insl
  5123. end ['ECX','EDI','EDX'];
  5124. end;
  5125. Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);oldfpccall;
  5126. {
  5127. Reads 'Count' words from port 'Port' to 'Buf'.
  5128. }
  5129. begin
  5130. asm
  5131. movl count,%ecx
  5132. movl buf,%edi
  5133. movl port,%edx
  5134. cld
  5135. rep
  5136. insw
  5137. end ['ECX','EDI','EDX'];
  5138. end;
  5139. Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);oldfpccall;
  5140. {
  5141. Reads 'Count' bytes from port 'Port' to 'Buf'.
  5142. }
  5143. begin
  5144. asm
  5145. movl count,%ecx
  5146. movl buf,%edi
  5147. movl port,%edx
  5148. cld
  5149. rep
  5150. insb
  5151. end ['ECX','EDI','EDX'];
  5152. end;
  5153. {--------------------------------
  5154. Memory functions
  5155. --------------------------------}
  5156. Initialization
  5157. InitLocalTime;
  5158. finalization
  5159. DoneLocalTime;
  5160. End.