| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869 |
- Listing:
- 1 (* Release 3.10 *)
- 2 (*-------------------------------------------------------------------------*
- 3 * *
- 4 * FIO.MOD - File input/output *
- 5 * *
- 6 * COPYRIGHT (C) 1987..1992 Clarion Software Corporation. *
- 7 * All Rights Reserved *
- 8 * *
- 9 *--------------------------------------------------------------------------*)
- 10
- 11 (*%F _fdata *)
- 12 (*# call(seg_name => null) *)
- 13 (*# data(seg_name => null) *)
- 14 (*%E *)
- 15 (*# call(o_a_copy => off) *)
- 16 (*# check(stack=>off,index=>off,range=>off,overflow=>off,nil_ptr=>off) *)
- 17
- 18 IMPLEMENTATION MODULE FIO;
- 19
- 20 IMPORT CoreFile,CoreIO,CoreMain,CoreSig,Lib,Str,SYSTEM;
- 21 (*%T _OS2 *)
- 22 IMPORT Dos,Err;
- 23
- 24 FROM Dos IMPORT QCurDisk, FindFirst, FindNext;
- ***** ^ duplicate identifier
- 25 (*%E *)
- 26
- 27 (*%T _mthread *)
- 28 IMPORT Process, CoreProc;
- 29 (*%E *)
- 30 CONST
- 31 TrueStr = 'TRUE';
- ***** ^ not supported yet
- 32
- 33 VAR
- 34 (* CoreFile.BufInf : ARRAY[0..MaxHandle] OF FileInf; *) (* NB in CoreFile *)
- 35 (*%T _mthread *)
- 36 IOR: ARRAY [1..Process.MaxProcess] OF CARDINAL;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 37 OKTable: ARRAY [1..Process.MaxProcess] OF BOOLEAN;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 38 EOFTable: ARRAY [1..Process.MaxProcess] OF BOOLEAN;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 39 (*%E *)
- 40 (*%F _mthread *)
- 41 IOR: CARDINAL;
- 42 (*%E *)
- 43 TYPE
- 44 Str80 = ARRAY[0..79] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 45
- 46 (*%T _mthread *)
- 47 PROCEDURE SetIOR(Num: CARDINAL);
- 48
- 49 BEGIN
- 50 IOR[CoreProc._getTID()] := Num;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 51 END SetIOR;
- ***** ^ not supported yet
- 52
- 53 PROCEDURE SetThreadOK( b : BOOLEAN);
- 54
- 55 BEGIN
- 56 OKTable[CoreProc._getTID()] := b;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 57 END SetThreadOK;
- ***** ^ not supported yet
- 58
- 59 PROCEDURE SetThreadEOF( b : BOOLEAN);
- 60
- 61 BEGIN
- 62 EOFTable[CoreProc._getTID()] := b;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 63 END SetThreadEOF;
- ***** ^ not supported yet
- 64
- 65
- 66
- 67 (*%E *)
- 68
- 69
- 70
- 71 PROCEDURE ErrorCheck(Code: CARDINAL; ErrNum: CARDINAL; Msg, Name: ARRAY OF CHAR);
- ***** ^ not supported yet
- 72
- 73 VAR
- 74 ErrMsg: ARRAY [0..119] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 75 NumStr: ARRAY [0..19] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 76 OK: BOOLEAN;
- 77 BEGIN
- 78 IF ErrNum = 0 THEN
- 79 ErrNum := Lib.SysErrno();
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 80 END;
- 81 IF IOcheck THEN
- ***** ^ undeclared identifier
- 82 Str.Copy(ErrMsg, Msg);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 83 Str.Append(ErrMsg, Name);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 84 Str.Append(ErrMsg, '. Dos Error Code ');
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 85 Str.CardToStr(LONGCARD(ErrNum), NumStr, 10, OK);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 86 Str.Append(ErrMsg, NumStr);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 87 (* Lib.WrDosError(SHORTCARD(ErrNum)); *)
- 88 Lib.RunTimeError(CoreSig._FatalErrorPos(), Code+0A0H, ErrMsg);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 89 END;
- 90 (*%T _mthread *)
- 91 SetIOR(ErrNum);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 92 (*%E *)
- 93 (*%F _mthread *)
- 94 IOR := ErrNum;
- 95 (*%E *)
- 96 END ErrorCheck;
- ***** ^ not supported yet
- 97
- 98 PROCEDURE IOresult () : CARDINAL;
- 99 BEGIN
- 100 (*%T _mthread *)
- 101 RETURN IOR[CoreProc._getTID()];
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 102 (*%E *)
- 103 (*%F _mthread *)
- 104 RETURN IOR;
- 105 (*%E *)
- 106 END IOresult;
- ***** ^ not supported yet
- 107
- 108 (*%T _OS2 *)
- 109 (*%T _mthread *)
- 110 PROCEDURE StreamLock(F: FileInf);
- ***** ^ undeclared identifier
- 111
- 112 VAR
- 113 ThisThread: SHORTCARD;
- 114 BEGIN
- 115 ThisThread := SHORTCARD(CoreProc._getTID());
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 116 IF F^.Ctrl # ThisThread THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 117 IF Dos.SemRequest(ADR(F^.Sem), -1) # 0 THEN ErrorCheck(18H, 0, 'StreamLock : ', Lib.NilStr) END;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 118 F^.Ctrl := ThisThread;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 119 END;
- 120 INC(F^.SCnt);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 121 END StreamLock;
- ***** ^ not supported yet
- 122
- 123 PROCEDURE StreamUnlock(F: FileInf);
- ***** ^ undeclared identifier
- 124
- 125 BEGIN
- 126 DEC(F^.SCnt);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 127 IF F^.SCnt = 0 THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 128 IF Dos.SemClear(ADR(F^.Sem)) # 0 THEN ErrorCheck(19H, 0, 'StreamUnlock : ', Lib.NilStr) END;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 129 F^.Ctrl := 0;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 130 END;
- 131 END StreamUnlock;
- ***** ^ not supported yet
- 132
- 133 (*%E *)
- 134
- 135 (*%E *)
- 136
- 137 PROCEDURE FlsBuf(F: FileInf): INTEGER;
- ***** ^ undeclared identifier
- 138 VAR
- 139 Wnum : CARDINAL;
- 140 nr,sr : INTEGER;
- 141 Pos : LONGINT;
- 142 zbuf : ARRAY [0..127] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 143 BEGIN
- 144 WITH F^ DO
- ***** ^ not supported yet
- 145 IF (Flag = {}) OR ((Flag * (CoreIO._F_ERR + CoreIO._F_EOF + CoreIO._F_IN)) # {}) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 146 RETURN -1;
- 147 END; (*IF*)
- 148 IF (Flag >= CoreIO._F_RST) THEN (* set up reset buffer for output *)
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 149 Flag := Flag - CoreIO._F_RST;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 150 Flag := Flag + CoreIO._F_OUT;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 151 Cnt := Size;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 152 Ptr := Base;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 153 RETURN 1; (* return - buffer wasn't full *)
- 154 END; (*IF*)
- 155 IF Cnt < 0 THEN
- ***** ^ undeclared identifier
- 156 Cnt := 0;
- ***** ^ undeclared identifier
- 157 END; (*IF*)
- 158 Wnum := Size - Cnt;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 159 IF Wnum = 0 THEN
- 160 RETURN 0;
- 161 END; (*IF*)
- 162 IF (Flag >= CoreIO._F_APP) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 163 Pos := CoreIO.lseek(Handle,-128,CoreIO.SEEK_END); (* append *)
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 164 IF Pos < 0 THEN
- 165 CoreIO.lseek(Handle,0,CoreIO.SEEK_SET);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 166 END; (*IF*)
- 167 nr := CoreIO._read(Handle,ADR(zbuf),128);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 168 sr := nr;
- 169 IF nr = -1 THEN
- 170 RETURN -1;
- 171 END; (*IF*)
- 172 REPEAT
- 173 DEC(sr);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 174 UNTIL (sr < 0) OR (zbuf[sr] # 26C);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 175 Pos := LONGINT(sr) - LONGINT(nr) + 1;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 176 CoreIO.lseek(Handle,Pos,CoreIO.SEEK_END); (* append after first cltZ *)
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 177 END; (*IF*)
- 178 IF CoreIO._write(Handle,Base,Wnum) # INTEGER(Wnum) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 179 Flag := Flag + CoreIO._F_ERR;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 180 Cnt := 0;
- ***** ^ undeclared identifier
- 181 RETURN -1;
- 182 END; (*IF*)
- 183 Cnt := Size; (* set buffer pointers *)
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 184 Ptr := Base;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 185 Flag := Flag + CoreIO._F_OUT; (* set output flag *)
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 186 RETURN Wnum;
- 187 END; (*WITH*)
- ***** ^ not supported yet
- 188 END FlsBuf;
- ***** ^ not supported yet
- 189
- 190 PROCEDURE FilBuf(F: FileInf): INTEGER;
- ***** ^ undeclared identifier
- 191
- 192 VAR
- 193 NumRead: INTEGER;
- 194 BEGIN
- 195 WITH F^ DO
- ***** ^ not supported yet
- 196 IF (Flag = {}) OR ((Flag * (CoreIO._F_ERR + CoreIO._F_OUT)) # {}) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 197 RETURN -1;
- 198 END;
- 199 IF (Flag >= CoreIO._F_EOF) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 200 RETURN 0;
- 201 END;
- 202 IF (Flag >= CoreIO._F_RST) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 203 Flag := Flag - CoreIO._F_RST;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 204 END;
- 205 NumRead := CoreIO._read(Handle, Base, Size);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 206 Ptr := Base;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 207 IF (NumRead = -1) AND (NumRead # Size) THEN
- ***** ^ undeclared identifier
- 208 Flag := Flag + CoreIO._F_ERR;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 209 Cnt := 0;
- ***** ^ undeclared identifier
- 210 RETURN -1;
- 211 END;
- 212 Cnt := NumRead; (* reset pointers *)
- ***** ^ undeclared identifier
- 213 Flag := Flag + CoreIO._F_IN; (* set input flag *)
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 214 IF NumRead = 0 THEN
- 215 Flag := Flag + CoreIO._F_EOF; (* end of file *)
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 216 (*%T _mthread *)
- 217 SetThreadEOF(TRUE);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 218 (*%E *)
- 219 EOF := TRUE;
- ***** ^ undeclared identifier
- 220 RETURN 0;
- 221 END;
- 222 RETURN NumRead;
- 223 END;
- ***** ^ not supported yet
- 224 END FilBuf;
- ***** ^ not supported yet
- 225
- 226 PROCEDURE WrBin(F:File;Buf:ARRAY OF BYTE;Count:CARDINAL);
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 227 VAR
- 228 NumWrit : INTEGER;
- 229 NumToWrite : INTEGER;
- 230 NumLeft : CARDINAL;
- 231 ST : POINTER TO CoreFile.CStream;
- ***** ^ not supported yet
- 232 Buffer : CoreFile.StreamPtr;
- ***** ^ not supported yet
- 233 BEGIN
- 234 (*%T _mthread *)
- 235 SetIOR(0);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 236 SetThreadOK(TRUE);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 237 (*%E *)
- 238 (*%F _mthread *)
- 239 IOR := 0;
- 240 (*%E *)
- 241 OK := TRUE;
- ***** ^ undeclared identifier
- 242 NumWrit := 0;
- 243 IF Count # 0 THEN
- 244 IF (F <= CoreFile._open_max) & (CoreFile.BufInf[F] # NIL) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 245 WITH CoreFile.BufInf[F]^ DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 246 IF (Flag = {}) OR ((Flag * (CoreIO._F_ERR + CoreIO._F_EOF)) # {}) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 247 ErrorCheck(6, CoreIO.EBADF, 'WrBin : ', Lib.NilStr);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 248 (*%T _mthread *)
- 249 SetThreadOK(FALSE);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 250 (*%E *)
- 251 OK := FALSE;
- ***** ^ undeclared identifier
- 252 RETURN;
- 253 END; (*IF*)
- 254 IF ((Flag * CoreIO._F_WRIT) = {}) OR (Flag >= CoreIO._F_IN) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 255 Flag := Flag + CoreIO._F_ERR;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 256 ErrorCheck(6, CoreIO.EACCES, 'WrBin : ', Lib.NilStr);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 257 (*%T _mthread *)
- 258 SetThreadOK(FALSE);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 259 (*%E *)
- 260 OK := FALSE;
- ***** ^ undeclared identifier
- 261 RETURN;
- 262 END;
- 263 (*%T _mthread *)
- 264 (*%F _OS2 *)
- 265 Process.Lock();
- 266 (*%E *)
- 267 (*%T _OS2 *)
- 268 StreamLock(CoreFile.BufInf[F]);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 269 (*%E *)
- 270 (*%E *)
- 271 Flag := Flag + CoreIO._F_OUT;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 272 IF Flag * CoreIO._F_RST # {} THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 273 IF FlsBuf(CoreFile.BufInf[F]) <= 0 THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 274 ErrorCheck(6, 0, 'WrBin : ', Lib.NilStr);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 275 (*%T _mthread *)
- 276 SetThreadOK(FALSE);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 277 (*%E *)
- 278 OK := FALSE;
- ***** ^ undeclared identifier
- 279 (*%T _mthread *)
- 280 (*%F _OS2 *)
- 281 Process.Unlock();
- 282 (*%E *)
- 283 (*%T _OS2 *)
- 284 StreamUnlock(CoreFile.BufInf[F]);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 285 (*%E *)
- 286 (*%E *)
- 287 RETURN;
- 288 END; (*IF*)
- 289 END; (*IF*)
- 290 NumLeft := Count;
- 291 Buffer := CoreFile.StreamPtr(ADR(Buf));
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 292 LOOP
- 293 IF(CARDINAL(Cnt) >= NumLeft) THEN (* write entire item *)
- ***** ^ undeclared identifier
- 294 NumToWrite := INTEGER(NumLeft);
- ***** ^ not supported yet
- 295 ELSE
- 296 NumToWrite := Cnt; (* write entire buffer *)
- ***** ^ undeclared identifier
- 297 END; (*IF*)
- 298 IF NumToWrite > 0 THEN
- 299 Lib.Move(Buffer,Ptr,NumToWrite);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 300 DEC(Cnt,NumToWrite);
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 301 INC(CARDINAL(Buffer),NumToWrite);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 302 INC(CARDINAL(Ptr),NumToWrite);
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 303 DEC(NumLeft,CARDINAL(NumToWrite));
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 304 INC(NumWrit,NumToWrite);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 305 END; (*IF*)
- 306 IF (Cnt = 0) & (FlsBuf(CoreFile.BufInf[F]) <= 0) THEN (* flush full buffer *)
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 307 EXIT; (* error or EOF *)
- 308 END; (*IF*)
- 309 IF NumLeft = 0 THEN
- 310 EXIT;
- 311 END; (*IF*)
- 312 END; (*LOOP*)
- 313 IF (Flag >= CoreIO._F_LBUF) & (FlsBuf(CoreFile.BufInf[F]) < 0) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 314 ErrorCheck(6, 0, 'WrBin : ', Lib.NilStr);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 315 (*%T _mthread *)
- 316 SetThreadOK(FALSE);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 317 (*%E *)
- 318 OK := FALSE;
- ***** ^ undeclared identifier
- 319 END; (*IF*)
- 320 END; (*WITH*)
- ***** ^ not supported yet
- 321 (*%T _mthread *)
- 322 (*%F _OS2 *)
- 323 Process.Unlock();
- 324 (*%E *)
- 325 (*%T _OS2 *)
- 326 StreamUnlock(CoreFile.BufInf[F]);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 327 (*%E *)
- 328 (*%E *)
- 329 ELSE
- 330 (*%T _mthread *)
- 331 (*%F _OS2 *)
- 332 Process.Lock();
- 333 (*%E *)
- 334 (*%E *)
- 335 IF CoreFile._openfd[F] >= CoreIO.O_APPEND THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 336 CoreIO.lseek(F, 0, CoreIO.SEEK_END);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 337 END; (*IF*)
- 338 NumWrit := CoreIO._write(F,CoreFile.StreamPtr(ADR(Buf)),Count);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 339 (*%T _mthread *)
- 340 (*%F _OS2 *)
- 341 Process.Unlock();
- 342 (*%E *)
- 343 (*%E *)
- 344 END; (*IF*)
- 345 IF CARDINAL(NumWrit) # Count THEN
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 346 ErrorCheck(6, CoreIO.EDISKFUL, 'WrBin : ', Lib.NilStr);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 347 OK := FALSE;
- ***** ^ undeclared identifier
- 348 (*%T _mthread *)
- 349 SetThreadOK(FALSE);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 350 (*%E *)
- 351 END; (*IF*)
- 352 END; (*IF*)
- 353 END WrBin;
- ***** ^ not supported yet
- 354
- 355 PROCEDURE Flush(F: File);
- ***** ^ undeclared identifier
- 356
- 357 VAR
- 358 ret: INTEGER;
- 359 BEGIN
- 360 (*%T _mthread *)
- 361 SetIOR(0);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 362 (*%E *)
- 363 (*%F _mthread *)
- 364 IOR := 0;
- 365 (*%E *)
- 366 IF (F > CoreFile._open_max) OR (CoreFile.BufInf[F] = NIL) THEN RETURN END;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 367 WITH CoreFile.BufInf[F]^ DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 368 IF (Flag = {}) OR ((Flag * (CoreIO._F_ERR + CoreIO._F_EOF)) # {}) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 369 RETURN;
- 370 END;
- 371 (*%T _mthread *)
- 372 (*%F _OS2 *)
- 373 Process.Lock();
- 374 (*%E *)
- 375 (*%T _OS2 *)
- 376 StreamLock(CoreFile.BufInf[F]);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 377 (*%E *)
- 378 (*%E *)
- 379 IF (Flag >= CoreIO._F_OUT) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 380 ret :=FlsBuf(CoreFile.BufInf[F]); (* flush output buffer *)
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 381 IF ret < 0 THEN
- 382 ErrorCheck(8, 0, 'Flush : ', Lib.NilStr);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 383 END;
- 384 ELSIF (Flag * CoreIO._F_DEV = {}) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 385 Seek(F, GetPos(F));
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 386 END;
- 387 WITH CoreFile.BufInf[F]^ DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 388 Pback := 0; (* reset buffer *)
- ***** ^ undeclared identifier
- 389 Cnt := 0;
- ***** ^ undeclared identifier
- 390 Flag := Flag + CoreIO._F_RST;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 391 Flag := Flag - (CoreIO._F_OUT + CoreIO._F_IN);
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 392 END;
- ***** ^ not supported yet
- 393 (*%T _mthread *)
- 394 (*%F _OS2 *)
- 395 Process.Unlock();
- 396 (*%E *)
- 397 (*%T _OS2 *)
- 398 StreamUnlock(CoreFile.BufInf[F]);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 399 (*%E *)
- 400 (*%E *)
- 401 END;
- ***** ^ not supported yet
- 402 RETURN;
- 403 END Flush;
- ***** ^ not supported yet
- 404
- 405 (*%F _OS2 *)
- 406 PROCEDURE Truncate(F: File);
- 407
- 408 BEGIN
- 409 (*%T _mthread *)
- 410 SetIOR(0);
- 411 (*%E *)
- 412 (*%F _mthread *)
- 413 IOR := 0;
- 414 (*%E *)
- 415 (*%T _mthread *)
- 416 Process.Lock();
- 417 (*%E *)
- 418 Flush( F );
- 419 IF CoreIO._write(F, NIL, 0) = -1 THEN
- 420 ErrorCheck(0CH, 0, 'Truncate : ', Lib.NilStr);
- 421 END;
- 422 (*%T _mthread *)
- 423 Process.Unlock();
- 424 (*%E *)
- 425 END Truncate;
- 426 (*%E *)
- 427
- 428 (*%T _OS2 *)
- 429 PROCEDURE Truncate(F: File);
- ***** ^ undeclared identifier
- 430 VAR IOR, r : CARDINAL; l : LONGCARD;
- ***** ^ undeclared identifier
- 431 BEGIN
- 432 Flush(F);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 433 IOR := Dos.ChgFilePtr(F,0,1,l);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 434 IF IOR = 0 THEN IOR := Dos.NewSize(F,l) END;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 435 IF IOR # 0 THEN ErrorCheck(0CH, IOR, 'Truncate : ', Lib.NilStr) END;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 436 END Truncate;
- ***** ^ not supported yet
- 437 (*%E *)
- 438
- 439
- 440 PROCEDURE RdBin(F: File; VAR Buf: ARRAY OF BYTE; Count: CARDINAL) : CARDINAL;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 441 VAR
- 442 NumRead : CARDINAL;
- 443 NumToRead : CARDINAL;
- 444 NumLeft : LONGCARD;
- ***** ^ undeclared identifier
- 445 Buffer : CoreFile.StreamPtr;
- ***** ^ not supported yet
- 446 Res : INTEGER;
- 447 BEGIN
- 448 (*%T _mthread *)
- 449 SetIOR(0);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 450 (*%E *)
- 451 (*%F _mthread *)
- 452 IOR := 0;
- 453 (*%E *)
- 454 OK := TRUE;
- ***** ^ undeclared identifier
- 455 (*%T _mthread *)
- 456 SetThreadOK(TRUE);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 457 SetThreadEOF(FALSE);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 458 (*%E *)
- 459 EOF := FALSE;
- ***** ^ undeclared identifier
- 460 Res := 0;
- 461 NumRead := 0;
- 462 IF Count = 0 THEN RETURN 0 END;
- 463 IF (F <= CoreFile._open_max) AND (CoreFile.BufInf[F] # NIL) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 464 WITH CoreFile.BufInf[F]^ DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 465 IF (Flag = {}) OR ((Flag * (CoreIO._F_ERR + CoreIO._F_EOF)) # {}) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 466 ErrorCheck(7, CoreIO.EBADF, 'RdBin : ', Lib.NilStr);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 467 OK := FALSE;
- ***** ^ undeclared identifier
- 468 (*%T _mthread *)
- 469 SetThreadOK(FALSE);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 470 (*%E *)
- 471 RETURN MAX(CARDINAL);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 472 END;
- 473 IF (Flag >= CoreIO._F_OUT) OR ((Flag * CoreIO._F_READ) = {} ) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 474 Flag := Flag + CoreIO._F_ERR;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 475 ErrorCheck(7, CoreIO.EACCES, 'RdBin : ', Lib.NilStr);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 476 OK := FALSE;
- ***** ^ undeclared identifier
- 477 (*%T _mthread *)
- 478 SetThreadOK(FALSE);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 479 (*%E *)
- 480 RETURN MAX(CARDINAL);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 481 END;
- 482 (*%T _mthread *)
- 483 (*%F _OS2 *)
- 484 Process.Lock();
- 485 (*%E *)
- 486 (*%T _OS2 *)
- 487 StreamLock(CoreFile.BufInf[F]);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 488 (*%E *)
- 489 (*%E *)
- 490 Flag := Flag + CoreIO._F_IN;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 491 NumLeft := LONGCARD(Count);
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 492 NumRead := 0;
- 493 Buffer := CoreFile.StreamPtr(ADR(Buf));
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 494 LOOP
- 495 IF Cnt = 0 THEN (* fill empty buffer *)
- ***** ^ undeclared identifier
- 496 Res := FilBuf(CoreFile.BufInf[F]);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 497 IF (INTEGER(Res) = -1)OR(Res = 0) THEN
- ***** ^ not supported yet
- 498 EXIT; (* error or EOF *)
- 499 END;
- 500 END;
- 501 IF(LONGCARD(Cnt) >= NumLeft) THEN (* read entire item *)
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 502 NumToRead := CARDINAL(NumLeft);
- ***** ^ not supported yet
- 503 ELSE
- 504 NumToRead := Cnt; (* read entire buffer *)
- ***** ^ undeclared identifier
- 505 END;
- 506 Lib.Move(Ptr, Buffer, NumToRead);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 507 DEC(Cnt,NumToRead);
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 508 INC(CARDINAL(Buffer), NumToRead);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 509 INC(CARDINAL(Ptr), NumToRead);
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 510 NumLeft := NumLeft - LONGCARD(NumToRead);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 511 INC(NumRead, NumToRead);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 512 IF NumLeft = 0 THEN EXIT END;
- ***** ^ not supported yet
- 513 END;
- 514 END;
- ***** ^ not supported yet
- 515 (*%T _mthread *)
- 516 (*%F _OS2 *)
- 517 Process.Unlock();
- 518 (*%E *)
- 519 (*%T _OS2 *)
- 520 StreamUnlock(CoreFile.BufInf[F]);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 521 (*%E *)
- 522 (*%E *)
- 523 ELSE
- 524 (*%T _mthread *)
- 525 (*%F _OS2 *)
- 526 Process.Lock();
- 527 (*%E *)
- 528 (*%E *)
- 529 NumRead := CoreIO._read(F, CoreFile.StreamPtr(ADR(Buf)), Count);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 530 IF NumRead=MAX(CARDINAL) THEN Res := -1 END;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 531 (*%T _mthread *)
- 532 (*%F _OS2 *)
- 533 Process.Unlock();
- 534 (*%E *)
- 535 (*%E *)
- 536 END;
- 537 IF NumRead # Count THEN
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 538 (*%T _mthread *)
- 539 SetThreadOK(FALSE);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 540 (*%E *)
- 541 OK := FALSE;
- ***** ^ undeclared identifier
- 542 IF Res = -1 THEN
- ***** ^ undeclared identifier
- 543 ErrorCheck(7, 0, 'RbBin : ', Lib.NilStr);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 544 NumRead := 0;
- ***** ^ undeclared identifier
- 545 ELSE
- 546 (*%T _mthread *)
- 547 SetThreadEOF(TRUE);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 548 (*%E *)
- 549 EOF := TRUE;
- ***** ^ undeclared identifier
- 550 END;
- 551 END;
- 552 RETURN NumRead;
- ***** ^ undeclared identifier
- 553 END RdBin;
- ***** ^ not supported yet
- 554
- 555
- 556 PROCEDURE WrStr(F: File; Buf: ARRAY OF CHAR);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 557 BEGIN
- 558 WrBin( F,Buf,Str.Length( Buf ) );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 559 END WrStr;
- ***** ^ not supported yet
- 560
- 561 PROCEDURE WrLn(F: File);
- ***** ^ undeclared identifier
- 562 TYPE a = ARRAY [ 0..1 ] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 563 BEGIN
- 564 WrBin( F, a( CHR( 13 ),CHR( 10 ) ), 2 )
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 565 END WrLn;
- ***** ^ not supported yet
- 566
- 567 PROCEDURE RdChar(F: File ) : CHAR;
- ***** ^ undeclared identifier
- 568 VAR c : CHAR;
- 569 BEGIN
- 570 (*%T _mthread *)
- 571 SetIOR(0);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 572 (*%E *)
- 573 (*%F _mthread *)
- 574 IOR := 0;
- 575 (*%E *)
- 576 OK := TRUE;
- ***** ^ undeclared identifier
- 577 (*%T _mthread *)
- 578 SetThreadOK(TRUE);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 579 (*%E *)
- 580 IF (F <= CoreFile._open_max) AND (CoreFile.BufInf[F] # NIL) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 581 (*%T _mthread *)
- 582 (*%F _OS2 *)
- 583 Process.Lock();
- 584 (*%E *)
- 585 (*%T _OS2 *)
- 586 StreamLock(CoreFile.BufInf[F]);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 587 (*%E *)
- 588 (*%E *)
- 589 WITH CoreFile.BufInf[F]^ DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 590 DEC(Cnt);
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 591 IF Cnt < 0 THEN
- ***** ^ undeclared identifier
- 592 IF FilBuf(CoreFile.BufInf[F]) <= 0 THEN;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ 'END' expected
- 593 (*%T _mthread *)
- 594 SetThreadEOF((Flag >= CoreIO._F_EOF));
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 595 (*%E *)
- 596 EOF := (Flag >= CoreIO._F_EOF);
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 597 (*%T _mthread *)
- 598 SetThreadOK(FALSE);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 599 (*%E *)
- 600 OK := FALSE;
- ***** ^ undeclared identifier
- 601 (*%T _mthread *)
- 602 (*%F _OS2 *)
- 603 Process.Unlock();
- 604 (*%E *)
- 605 (*%T _OS2 *)
- 606 StreamUnlock(CoreFile.BufInf[F]);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 607 (*%E *)
- 608 (*%E *)
- 609 RETURN CHR(26);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 610 END;
- 611 DEC(Cnt);
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 612 END;
- ***** ^ not supported yet
- 613 c := Ptr^;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 614 INC(CARDINAL(Ptr), 1);
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 615 (*%T _mthread *)
- 616 SetThreadEOF((Flag >= CoreIO._F_EOF) OR (c = CHR(26)));
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 617 (*%E *)
- 618 EOF := ((Flag >= CoreIO._F_EOF) OR (c = CHR(26)));
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 619 (*%T _mthread *)
- 620 (*%F _OS2 *)
- 621 Process.Unlock();
- 622 (*%E *)
- 623 (*%T _OS2 *)
- 624 StreamUnlock(CoreFile.BufInf[F]);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 625 (*%E *)
- 626 (*%E *)
- 627 RETURN c;
- ***** ^ undeclared identifier
- 628 END;
- 629 END;
- ***** ^ ident expected
- 630 (*%T _mthread *)
- 631 (*%F _OS2 *)
- 632 Process.Lock();
- 633 (*%E *)
- 634 (*%E *)
- 635 IF CoreIO._read(F, CoreFile.StreamPtr(ADR(c)), 1) <= 0 THEN
- 636 OK := FALSE;
- 637 (*%T _mthread *)
- 638 SetThreadOK(FALSE);
- 639 (*%E *)
- 640 c := CHR(26);
- 641 END;
- 642 (*%T _mthread *)
- 643 SetThreadEOF((c = CHR(26)));
- 644 (*%E *)
- 645 EOF := (c = CHR(26));
- 646 (*%T _mthread *)
- 647 (*%F _OS2 *)
- 648 Process.Unlock();
- 649 (*%E *)
- 650 (*%E *)
- 651 RETURN c;
- 652 END RdChar;
- 653
- 654
- 655 PROCEDURE RdStr(F: File; VAR Buf: ARRAY OF CHAR);
- 656 VAR
- 657 i,h : CARDINAL;
- 658 c : CHAR;
- 659 BEGIN
- 660 i := 0;
- 661 h := HIGH( Buf );
- 662 (*%T _mthread *)
- 663 SetThreadOK(TRUE);
- 664 (*%E *)
- 665 OK := TRUE;
- 666 LOOP
- 667 IF i > h THEN RETURN END;
- 668 c := RdChar( F );
- 669 IF c = CHR( 26 ) THEN
- 670 Buf[ i ] := CHR(0);
- 671 (*%T _mthread *)
- 672 SetThreadEOF((i = 0));
- 673 (*%E *)
- 674 EOF := (i = 0);
- 675 RETURN;
- 676 ELSIF c = EOL THEN
- 677 Buf[ i ] := CHR(0);
- 678 RETURN;
- 679 ELSIF (c # CHR( 10 )) AND (c # CHR( 13 )) THEN
- 680 Buf[ i ] := c;
- 681 INC( i );
- 682 END;
- 683 END;
- 684 END RdStr;
- 685
- 686 PROCEDURE RdItem( F : File; VAR S : ARRAY OF CHAR );
- 687 VAR c : CHAR; i,L : CARDINAL;
- 688 BEGIN
- 689 i := 0;
- 690 LOOP
- 691 c := RdChar( F );
- 692 IF NOT (*%T _mthread *) ThreadOK() (*%E *) (*%F _mthread *) OK (*%E *)
- 693 OR NOT (c IN Separators) THEN EXIT; END;
- 694 END;
- 695 L := HIGH( S );
- 696 LOOP
- 697 IF NOT (*%T _mthread *) ThreadOK() (*%E *) (*%F _mthread *) OK (*%E *)
- 698 OR ( c IN Separators ) THEN EXIT; END;
- 699 S[i] := c;
- 700 INC( i );
- 701 IF i > L THEN
- 702 EXIT;
- 703 ELSE
- 704 c := RdChar( F );
- 705 IF c = CHR(26) THEN
- 706 (*%T _mthread *)
- 707 SetThreadOK(TRUE);
- 708 (*%E *)
- 709 OK := TRUE;
- 710 EXIT;
- 711 ELSIF c = CHR(13) THEN
- 712 c := RdChar(F);
- 713 EXIT;
- 714 END;
- 715 END;
- 716 END;
- 717 IF i <= L THEN S[i] := 0C; END;
- 718 END RdItem;
- 719
- 720 (*# save,
- 721 call(o_a_copy => on) *)
- 722
- 723 PROCEDURE WrStrAdj(F: File; S: ARRAY OF CHAR; Length: INTEGER);
- 724 VAR
- 725 L : CARDINAL;
- 726 a : INTEGER;
- 727 BEGIN
- 728 (*%T _mthread *)
- 729 SetThreadOK(TRUE);
- 730 (*%E *)
- 731 OK := TRUE;
- 732 L := Str.Length( S );
- 733 a := ABS( Length ) - INTEGER( L );
- 734 IF (a < 0) AND ChopOff THEN
- 735 L := CARDINAL(ABS(Length));
- 736 IF L>HIGH(S) THEN
- 737 L := HIGH(S)+1;
- 738 ELSE
- 739 S[L] := CHR(0);
- 740 END;
- 741 WHILE (L>0) DO DEC(L) ; S[L] := '?'; END;
- 742 (*%T _mthread *)
- 743 SetThreadOK(FALSE);
- 744 (*%E *)
- 745 OK := FALSE;
- 746 a := 0;
- 747 END;
- 748 IF (Length > 0) AND (a > 0) THEN WrCharRep( F, PrefixChar, a ); END;
- 749 WrStr( F,S );
- 750 IF (Length < 0) AND (a > 0) THEN WrCharRep( F, SuffixChar, a ); END;
- 751 END WrStrAdj;
- 752
- 753 (*# restore *)
- 754
- 755 PROCEDURE WrChar(F: File; V: CHAR);
- 756 BEGIN
- 757 (*%T _mthread *)
- 758 SetThreadOK(TRUE);
- 759 (*%E *)
- 760 OK := TRUE;
- 761 IF (F <= CoreFile._open_max) AND (CoreFile.BufInf[F] # NIL) THEN
- 762 (*%T _mthread *)
- 763 (*%F _OS2 *)
- 764 Process.Lock();
- 765 (*%E *)
- 766 (*%T _OS2 *)
- 767 StreamLock(CoreFile.BufInf[F]);
- 768 (*%E *)
- 769 (*%E *)
- 770 WITH CoreFile.BufInf[F]^ DO
- 771 DEC(Cnt);
- 772 IF Cnt < 0 THEN
- 773 IF FlsBuf(CoreFile.BufInf[F]) <= 0 THEN
- 774 (*%T _mthread *)
- 775 SetThreadOK(FALSE);
- 776 (*%E *)
- 777 OK := FALSE;
- 778 (*%T _mthread *)
- 779 (*%F _OS2 *)
- 780 Process.Unlock();
- 781 (*%E *)
- 782 (*%T _OS2 *)
- 783 StreamUnlock(CoreFile.BufInf[F]);
- 784 (*%E *)
- 785 (*%E *)
- 786 RETURN;
- 787 END;
- 788 DEC(Cnt);
- 789 END;
- 790 Ptr^ := V;
- 791 INC(CARDINAL(Ptr), 1);
- 792 RETURN;
- 793 END;
- 794 END;
- 795 (*%T _mthread *)
- 796 (*%F _OS2 *)
- 797 Process.Lock();
- 798 (*%E *)
- 799 (*%E *)
- 800 IF CoreIO._write(F, CoreFile.StreamPtr(ADR(V)), 1) = 0 THEN
- 801 (*%T _mthread *)
- 802 SetThreadOK(FALSE);
- 803 (*%E *)
- 804 OK := FALSE;
- 805 END;
- 806 (*%T _mthread *)
- 807 (*%F _OS2 *)
- 808 Process.Unlock();
- 809 (*%E *)
- 810 (*%E *)
- 811 RETURN;
- 812 END WrChar;
- 813
- 814 PROCEDURE WrCharRep(F: File; V: CHAR ; Count: CARDINAL);
- 815 VAR
- 816 S : Str80;
- 817 i,j : CARDINAL;
- 818 BEGIN
- 819 WHILE Count>0 DO
- 820 i := SIZE(S);
- 821 IF i > Count THEN i := Count END;
- 822 DEC(Count,i);
- 823 FOR j := 0 TO i-1 DO S[j] := V END;
- 824 WrBin( F,S,i );
- 825 IF NOT (*%T _mthread *) ThreadOK() (*%E *) (*%F _mthread *) OK (*%E *) THEN RETURN END ;
- 826 END;
- 827 END WrCharRep;
- 828
- 829 PROCEDURE WrBool(F: File; V: BOOLEAN; Length: INTEGER);
- 830 BEGIN
- 831 IF V THEN
- 832 WrStrAdj( F,TrueStr,Length );
- 833 ELSE
- 834 WrStrAdj( F,'FALSE',Length );
- 835 END;
- 836 END WrBool;
- 837
- 838 PROCEDURE WrShtInt(F: File; V: SHORTINT; Length: INTEGER);
- 839 VAR
- 840 S : Str80;
- 841 b : BOOLEAN;
- 842 BEGIN
- 843 Str.IntToStr( LONGINT(V),S,10,b);
- 844 (*%T _mthread *)
- 845 SetThreadOK(b);
- 846 (*%E *)
- 847 IF b THEN
- 848 WrStrAdj(F,S,Length );
- 849 END;
- 850 OK := b;
- 851 END WrShtInt;
- 852
- 853 PROCEDURE WrInt(F: File; V: INTEGER; Length: INTEGER);
- 854 VAR
- 855 S : Str80;
- 856 b : BOOLEAN;
- 857 BEGIN
- 858 Str.IntToStr( LONGINT(V),S,10,b);
- 859 (*%T _mthread *)
- 860 SetThreadOK(b);
- 861 (*%E *)
- 862 IF b THEN
- 863 WrStrAdj(F,S,Length );
- 864 END;
- 865 OK := b;
- 866 END WrInt;
- 867
- 868 PROCEDURE WrLngInt(F: File; V: LONGINT; Length: INTEGER);
- 869 VAR
- 870 S : Str80;
- 871 b : BOOLEAN;
- 872 BEGIN
- 873 Str.IntToStr( V,S,10,b);
- 874 (*%T _mthread *)
- 875 SetThreadOK(b);
- 876 (*%E *)
- 877 IF b THEN
- 878 WrStrAdj(F,S,Length );
- 879 END;
- 880 OK := b;
- 881 END WrLngInt;
- 882
- 883 PROCEDURE WrShtCard(F: File; V: SHORTCARD; Length: INTEGER);
- 884 VAR S : Str80;
- 885 b : BOOLEAN;
- 886 BEGIN
- 887 Str.CardToStr(LONGCARD(V),S,10,b);
- 888 (*%T _mthread *)
- 889 SetThreadOK(b);
- 890 (*%E *)
- 891 IF b THEN
- 892 WrStrAdj(F,S,Length );
- 893 END;
- 894 OK := b;
- 895 END WrShtCard;
- 896
- 897 PROCEDURE WrCard(F: File; V: CARDINAL; Length: INTEGER);
- 898 VAR
- 899 S : Str80;
- 900 b : BOOLEAN;
- 901 BEGIN
- 902 Str.CardToStr(LONGCARD(V),S,10,b);
- 903 (*%T _mthread *)
- 904 SetThreadOK(b);
- 905 (*%E *)
- 906 IF b THEN
- 907 WrStrAdj(F,S,Length );
- 908 END;
- 909 OK := b;
- 910 END WrCard;
- 911
- 912 PROCEDURE WrLngCard(F: File; V: LONGCARD; Length: INTEGER);
- 913 VAR
- 914 S : Str80;
- 915 b : BOOLEAN;
- 916 BEGIN
- 917 Str.CardToStr(V,S,10,b);
- 918 (*%T _mthread *)
- 919 SetThreadOK(b);
- 920 (*%E *)
- 921 IF b THEN
- 922 WrStrAdj(F,S,Length );
- 923 END;
- 924 OK := b;
- 925 END WrLngCard;
- 926
- 927 PROCEDURE WrShtHex(F: File; V: SHORTCARD; Length: INTEGER);
- 928 VAR
- 929 S : Str80;
- 930 b : BOOLEAN;
- 931 BEGIN
- 932 Str.CardToStr(LONGCARD(V),S,16,b);
- 933 (*%T _mthread *)
- 934 SetThreadOK(b);
- 935 (*%E *)
- 936 IF b THEN
- 937 WrStrAdj(F,S,Length );
- 938 END;
- 939 OK := b;
- 940 END WrShtHex;
- 941
- 942 PROCEDURE WrHex(F: File; V: CARDINAL; Length: INTEGER);
- 943 VAR
- 944 S : Str80;
- 945 b : BOOLEAN;
- 946 BEGIN
- 947 Str.CardToStr(LONGCARD(V),S,16,b);
- 948 (*%T _mthread *)
- 949 SetThreadOK(b);
- 950 (*%E *)
- 951 IF b THEN
- 952 WrStrAdj(F,S,Length );
- 953 END;
- 954 OK := b;
- 955 END WrHex;
- 956
- 957 PROCEDURE WrLngHex(F: File; V: LONGCARD; Length: INTEGER);
- 958 VAR S : Str80;
- 959 b : BOOLEAN;
- 960 BEGIN
- 961 Str.CardToStr(V,S,16,b);
- 962 (*%T _mthread *)
- 963 SetThreadOK(b);
- 964 (*%E *)
- 965 IF b THEN
- 966 WrStrAdj(F,S,Length );
- 967 END;
- 968 OK := b;
- 969 END WrLngHex;
- 970
- 971 PROCEDURE WrReal(F: File; V: REAL; Precision: CARDINAL; Length: INTEGER);
- 972 VAR
- 973 S : Str80;
- 974 b : BOOLEAN;
- 975 BEGIN
- 976 Str.RealToStr( LONGREAL ( V ),Precision,Eng,S,b);
- 977 (*%T _mthread *)
- 978 SetThreadOK(b);
- 979 (*%E *)
- 980 IF b THEN
- 981 WrStrAdj(F,S,Length );
- 982 END;
- 983 OK := b;
- 984 END WrReal;
- 985
- 986 PROCEDURE WrFixReal(F: File; V: REAL; Precision: CARDINAL; Length: INTEGER);
- 987 VAR
- 988 S : Str80;
- 989 b : BOOLEAN;
- 990 BEGIN
- 991 Str.FixRealToStr( LONGREAL ( V ),Precision,S,b );
- 992 (*%T _mthread *)
- 993 SetThreadOK(b);
- 994 (*%E *)
- 995 IF b THEN
- 996 WrStrAdj(F,S,Length );
- 997 END;
- 998 OK := b;
- 999 END WrFixReal;
- 1000
- 1001 PROCEDURE WrLngReal(F: File; V : LONGREAL; Precision: CARDINAL; Length: INTEGER);
- 1002 VAR
- 1003 S : Str80;
- 1004 b : BOOLEAN;
- 1005 BEGIN
- 1006 Str.RealToStr( V,Precision,Eng,S,b);
- 1007 (*%T _mthread *)
- 1008 SetThreadOK(b);
- 1009 (*%E *)
- 1010 IF b THEN
- 1011 WrStrAdj(F,S,Length );
- 1012 END;
- 1013 OK := b;
- 1014 END WrLngReal;
- 1015
- 1016 PROCEDURE WrFixLngReal(F: File; V: LONGREAL; Precision: CARDINAL; Length: INTEGER);
- 1017 VAR
- 1018 S : Str80;
- 1019 b : BOOLEAN;
- 1020 BEGIN
- 1021 Str.FixRealToStr(V,Precision,S,b );
- 1022 (*%T _mthread *)
- 1023 SetThreadOK(b);
- 1024 (*%E *)
- 1025 IF b THEN
- 1026 WrStrAdj(F,S,Length );
- 1027 END;
- 1028 OK := b;
- 1029 END WrFixLngReal;
- 1030
- 1031 PROCEDURE RdBool(F: File): BOOLEAN;
- 1032 VAR s : Str80;
- 1033 BEGIN
- 1034 RdItem( F,s );
- 1035 RETURN Str.Compare( s,TrueStr )=0;
- 1036 END RdBool;
- 1037
- 1038 PROCEDURE RdShtInt(F: File) : SHORTINT;
- 1039 VAR
- 1040 S : Str80;
- 1041 i : LONGINT;
- 1042 b : BOOLEAN;
- 1043 BEGIN
- 1044 RdItem(F,S );
- 1045 i := Str.StrToInt( S,10,b );
- 1046 (*%T _mthread *)
- 1047 SetThreadOK(b AND (i >= -80H) AND (i < 80H));
- 1048 (*%E *)
- 1049 OK := b AND (i >= -80H) AND (i < 80H);
- 1050 RETURN SHORTINT( i );
- 1051 END RdShtInt;
- 1052
- 1053 PROCEDURE RdInt(F: File) : INTEGER;
- 1054 VAR
- 1055 S : Str80;
- 1056 i : LONGINT;
- 1057 b : BOOLEAN;
- 1058 BEGIN
- 1059 RdItem(F,S);
- 1060 i := Str.StrToInt( S,10,b );
- 1061 (*%T _mthread *)
- 1062 SetThreadOK(b AND (i >= -8000H) AND (i < 8000H));
- 1063 (*%E *)
- 1064 OK := b AND (i >= -8000H) AND (i < 8000H);
- 1065 RETURN INTEGER(i);
- 1066 END RdInt;
- 1067
- 1068 PROCEDURE RdLngInt(F: File) : LONGINT;
- 1069 VAR
- 1070 S : Str80;
- 1071 i : LONGINT;
- 1072 b : BOOLEAN;
- 1073 BEGIN
- 1074 RdItem(F,S);
- 1075 i := Str.StrToInt( S,10,b );
- 1076 (*%T _mthread *)
- 1077 SetThreadOK(b);
- 1078 (*%E *)
- 1079 OK := b;
- 1080 RETURN i;
- 1081 END RdLngInt;
- 1082
- 1083 PROCEDURE RdShtCard(F: File) : SHORTCARD;
- 1084 VAR
- 1085 S : Str80;
- 1086 i : LONGCARD;
- 1087 b : BOOLEAN;
- 1088 BEGIN
- 1089 RdItem(F,S);
- 1090 i := Str.StrToCard( S,10,b );
- 1091 (*%T _mthread *)
- 1092 SetThreadOK(b AND (i < 100H));
- 1093 (*%E *)
- 1094 OK := b AND (i < 100H);
- 1095 RETURN SHORTCARD( i );
- 1096 END RdShtCard;
- 1097
- 1098 PROCEDURE RdShtHex(F: File) : SHORTCARD;
- 1099 VAR
- 1100 S : Str80;
- 1101 i : LONGCARD;
- 1102 b : BOOLEAN;
- 1103 BEGIN
- 1104 RdItem(F,S);
- 1105 i := Str.StrToCard( S,16,b );
- 1106 (*%T _mthread *)
- 1107 SetThreadOK(b AND (i < 100H));
- 1108 (*%E *)
- 1109 OK := b AND (i < 100H);
- 1110 RETURN SHORTCARD( i );
- 1111 END RdShtHex;
- 1112
- 1113 PROCEDURE RdCard(F: File) : CARDINAL;
- 1114 VAR
- 1115 S : Str80;
- 1116 i : LONGCARD;
- 1117 b : BOOLEAN;
- 1118 BEGIN
- 1119 RdItem(F,S);
- 1120 i := Str.StrToCard( S,10,b );
- 1121 (*%T _mthread *)
- 1122 SetThreadOK(b AND (i < 10000H));
- 1123 (*%E *)
- 1124 OK := b AND (i < 10000H);
- 1125 RETURN CARDINAL( i );
- 1126 END RdCard;
- 1127
- 1128 PROCEDURE RdHex(F: File) : CARDINAL;
- 1129 VAR
- 1130 S : Str80;
- 1131 i : LONGCARD;
- 1132 b : BOOLEAN;
- 1133 BEGIN
- 1134 RdItem(F,S);
- 1135 i := Str.StrToCard( S,16,b );
- 1136 (*%T _mthread *)
- 1137 SetThreadOK(b AND (i < 10000H));
- 1138 (*%E *)
- 1139 OK := b AND (i < 10000H);
- 1140 RETURN CARDINAL( i );
- 1141 END RdHex;
- 1142
- 1143 PROCEDURE RdLngCard(F: File) : LONGCARD;
- 1144 VAR
- 1145 S : Str80;
- 1146 i : LONGCARD;
- 1147 b : BOOLEAN;
- 1148 BEGIN
- 1149 RdItem(F,S);
- 1150 i := Str.StrToCard( S,10,b );
- 1151 (*%T _mthread *)
- 1152 SetThreadOK(b);
- 1153 (*%E *)
- 1154 OK := b;
- 1155 RETURN i;
- 1156 END RdLngCard;
- 1157
- 1158 PROCEDURE RdLngHex(F: File) : LONGCARD;
- 1159 VAR
- 1160 S : Str80;
- 1161 i : LONGCARD;
- 1162 b : BOOLEAN;
- 1163 BEGIN
- 1164 RdItem(F,S);
- 1165 i := Str.StrToCard( S,16,b );
- 1166 (*%T _mthread *)
- 1167 SetThreadOK(b);
- 1168 (*%E *)
- 1169 OK := b;
- 1170 RETURN i;
- 1171 END RdLngHex ;
- 1172
- 1173 PROCEDURE RdReal(F: File) : REAL;
- 1174 VAR
- 1175 S : Str80;
- 1176 r : LONGREAL;
- 1177 b : BOOLEAN;
- 1178 BEGIN
- 1179 RdItem(F,S );
- 1180 r := Str.StrToReal( S,b);
- 1181 (*%T _mthread *)
- 1182 SetThreadOK(b AND (ABS(r) <= 3.4E38 ));
- 1183 (*%E *)
- 1184 OK := b AND (ABS(r) <= 3.4E38 );
- 1185 RETURN REAL ( r );
- 1186 END RdReal;
- 1187
- 1188 PROCEDURE RdLngReal(F: File) : LONGREAL;
- 1189 VAR
- 1190 S : Str80;
- 1191 r : LONGREAL;
- 1192 b : BOOLEAN;
- 1193 BEGIN
- 1194 RdItem(F,S);
- 1195 r := Str.StrToReal( S,b);
- 1196 (*%T _mthread *)
- 1197 SetThreadOK(b);
- 1198 (*%E *)
- 1199 OK := b;
- 1200 RETURN r;
- 1201 END RdLngReal;
- 1202
- 1203
- 1204 PROCEDURE GetName(name: ARRAY OF CHAR; VAR fn: PathStr);
- 1205 (* Makes Null terminated filename, also sets IOR to 0 *)
- 1206 BEGIN
- 1207 Str.Copy(fn,name);
- 1208 fn[HIGH(fn)] := CHR(0);
- 1209 (*%T _mthread *)
- 1210 SetIOR(0);
- 1211 (*%E *)
- 1212 (*%F _mthread *)
- 1213 IOR := 0;
- 1214 (*%E *)
- 1215 END GetName;
- 1216
- 1217 PROCEDURE Open(Name: ARRAY OF CHAR) : File;
- 1218 VAR
- 1219 fn: PathStr;
- 1220 H: File;
- 1221 BEGIN
- 1222 GetName(Name,fn);
- 1223 (*%F _OS2 *)
- 1224 H := CoreIO._open(fn, CARDINAL(CoreIO.O_RDWR + ShareMode));
- 1225 (*%E *)
- 1226 (*%T _OS2 *)
- 1227 H := CoreIO._os2_open(fn, CARDINAL(CoreIO.O_RDWR + ShareMode), 0, 1);
- 1228 (*%E *)
- 1229 IF H <> MAX(CARDINAL) THEN
- 1230 CoreFile._openfd[H] := (CoreIO.O_RDWR+CoreIO.O_BINARY);
- 1231 IF CoreIO.isatty(H) # 0 THEN
- 1232 CoreFile._openfd[H] := CoreFile._openfd[H] + CoreIO.O_DEVICE;
- 1233 END;
- 1234 ELSE
- 1235 ErrorCheck(2, 0, 'Open : ', fn);
- 1236 END;
- 1237 RETURN H;
- 1238 END Open;
- 1239
- 1240 PROCEDURE OpenRead( Name: ARRAY OF CHAR) : File;
- 1241 VAR
- 1242 fn: PathStr;
- 1243 H: File;
- 1244 BEGIN
- 1245 GetName(Name,fn);
- 1246 (*%F _OS2 *)
- 1247 H := CoreIO._open(fn, CARDINAL(CoreIO.O_RDONLY + ShareMode));
- 1248 (*%E *)
- 1249 (*%T _OS2 *)
- 1250 H := CoreIO._os2_open(fn, CARDINAL(CoreIO.O_RDONLY + ShareMode), 1, 1);
- 1251 (*%E *)
- 1252 IF H <> MAX(CARDINAL) THEN
- 1253 CoreFile._openfd[H] := (CoreIO.O_RDONLY+CoreIO.O_BINARY);
- 1254 IF CoreIO.isatty(H) # 0 THEN
- 1255 CoreFile._openfd[H] := CoreFile._openfd[H] + CoreIO.O_DEVICE;
- 1256 END;
- 1257 ELSE
- 1258 ErrorCheck(3, 0, 'OpenRead : ', fn);
- 1259 END;
- 1260 RETURN H;
- 1261 END OpenRead;
- 1262
- 1263 (*%F _OS2 *)
- 1264 PROCEDURE Exists(Name: ARRAY OF CHAR) : BOOLEAN;
- 1265 VAR
- 1266 r : SYSTEM.Registers ;
- 1267 fn: PathStr;
- 1268 BEGIN
- 1269 GetName(Name,fn);
- 1270 r.AX := 4300H ; (* get file attr *)
- 1271 r.DS := Seg(fn);
- 1272 r.DX := Ofs(fn);
- 1273 Lib.Dos(r);
- 1274 RETURN NOT(SYSTEM.CarryFlag IN r.Flags);
- 1275 END Exists;
- 1276 (*%E *)
- 1277
- 1278 (*%T _OS2 *)
- 1279 PROCEDURE Exists(Name: ARRAY OF CHAR) : BOOLEAN;
- 1280 VAR a : CARDINAL ;
- 1281 fn: PathStr;
- 1282 BEGIN
- 1283 GetName(Name,fn);
- 1284 RETURN Dos.QFileMode(fn,a,0)=0;
- 1285 END Exists;
- 1286 (*%E *)
- 1287
- 1288
- 1289 PROCEDURE Append(Name: ARRAY OF CHAR) : File;
- 1290 VAR
- 1291 fn: PathStr;
- 1292 H: File;
- 1293 BEGIN
- 1294 GetName(Name,fn);
- 1295 (*%F _OS2 *)
- 1296 H := CoreIO._open(fn, CARDINAL(CoreIO.O_RDWR));
- 1297 (*%E *)
- 1298 (*%T _OS2 *)
- 1299 H := CoreIO._os2_open(fn, CARDINAL(CoreIO.O_RDWR), 0, 1H);
- 1300 (*%E *)
- 1301 IF H <> MAX(CARDINAL) THEN
- 1302 CoreFile._openfd[H] := (CoreIO.O_RDWR+CoreIO.O_BINARY+CoreIO.O_APPEND);
- 1303 Seek(H, Size(H));
- 1304 IF CoreIO.isatty(H) # 0 THEN
- 1305 CoreFile._openfd[H] := CoreFile._openfd[H] + CoreIO.O_DEVICE;
- 1306 END;
- 1307 ELSE
- 1308 ErrorCheck(4, 0, 'Append : ', fn);
- 1309 END;
- 1310 RETURN H;
- 1311 END Append;
- 1312
- 1313 PROCEDURE Create(Name: ARRAY OF CHAR) : File;
- 1314 VAR
- 1315 fn: PathStr;
- 1316 H: File;
- 1317 BEGIN
- 1318 GetName(Name,fn);
- 1319 (*%F _OS2 *)
- 1320 H := CoreIO._creat_trunc(fn, 0);
- 1321 (*%E *)
- 1322 (*%T _OS2 *)
- 1323 H := CoreIO._os2_open(fn, CARDINAL(CoreIO.O_RDWR), 0, 12H);
- 1324 (*%E *)
- 1325 IF H <> MAX(CARDINAL) THEN
- 1326 CoreFile._openfd[H] := (CoreIO.O_RDWR+CoreIO.O_BINARY);
- 1327 ELSE
- 1328 ErrorCheck(5, 0, 'Create : ', Name);
- 1329 END;
- 1330 RETURN H;
- 1331 END Create;
- 1332
- 1333 PROCEDURE Close(F: File);
- 1334 VAR
- 1335 x : FileInf;
- 1336 BEGIN
- 1337 (*%T _mthread *)
- 1338 SetIOR(0);
- 1339 (*%E *)
- 1340 (*%F _mthread *)
- 1341 IOR := 0;
- 1342 (*%E *)
- 1343 IF F <= CoreFile._open_max THEN
- 1344 IF CoreFile.BufInf[F] # NIL THEN
- 1345 (*%T _mthread *)
- 1346 (*%F _OS2 *)
- 1347 Process.Lock();
- 1348 (*%E *)
- 1349 (*%T _OS2 *)
- 1350 StreamLock(CoreFile.BufInf[F]);
- 1351 (*%E *)
- 1352 (*%E *)
- 1353 Flush( F );
- 1354 CoreFile.BufInf[F]^.Flag := {};
- 1355 (*%T _mthread *)
- 1356 (*%T _OS2 *)
- 1357 x := CoreFile.BufInf[F];
- 1358 (*%E *)
- 1359 (*%E *)
- 1360 CoreFile.BufInf[F] := NIL;
- 1361 (*%T _mthread *)
- 1362 (*%F _OS2 *)
- 1363 Process.Unlock();
- 1364 (*%E *)
- 1365 (*%T _OS2 *)
- 1366 StreamUnlock(x);
- 1367 (*%E *)
- 1368 (*%E *)
- 1369 END;
- 1370 CoreFile._openfd[F] := {};
- 1371 END;
- 1372 IF CoreIO._close(F) = -1 THEN
- 1373 ErrorCheck(0, 0, 'Close : ', Lib.NilStr);
- 1374 END;
- 1375 RETURN;
- 1376 END Close;
- 1377
- 1378 PROCEDURE GetPos(F: File) : LONGCARD;
- 1379 VAR
- 1380 Ret, Pos: LONGCARD;
- 1381 BEGIN
- 1382 (*%T _mthread *)
- 1383 SetIOR(0);
- 1384 (*%E *)
- 1385 (*%F _mthread *)
- 1386 IOR := 0;
- 1387 (*%E *)
- 1388 OK := TRUE;
- 1389 (*%T _mthread *)
- 1390 OKTable[CoreProc._getTID()] := TRUE;
- 1391 (*%E *)
- 1392 (*%T _mthread *)
- 1393 (*%F _OS2 *)
- 1394 Process.Lock();
- 1395 (*%E *)
- 1396 (*%E *)
- 1397 IF (F > CoreFile._open_max) OR (CoreFile.BufInf[F] = NIL) OR (CoreFile.BufInf[F]^.Flag >= CoreIO._F_RST) THEN
- 1398 Ret := CoreIO.tell(F);
- 1399 ELSE
- 1400 (*%T _mthread *)
- 1401 (*%T _OS2 *)
- 1402 StreamLock(CoreFile.BufInf[F]);
- 1403 (*%E *)
- 1404 (*%E *)
- 1405 IF ( CoreFile.BufInf[F]^.Flag = {}) OR (CoreFile.BufInf[F]^.Flag >= CoreIO._F_ERR) THEN
- 1406 ErrorCheck(9, CoreIO.EBADF, 'GetPos : ', Lib.NilStr);
- 1407 Ret := MAX(LONGCARD);
- 1408 END;
- 1409 IF (CoreFile.BufInf[F]^.Flag >= CoreIO._F_OUT) THEN
- 1410 IF FlsBuf(CoreFile.BufInf[F]) # -1 THEN (* flush stream *)
- 1411 Ret := CoreIO.tell(F);
- 1412 ELSE
- 1413 Ret := MAX(LONGCARD);
- 1414 END;
- 1415 ELSE
- 1416 Pos := CoreIO.tell(F); (* input stream *)
- 1417 IF CoreFile.BufInf[F]^.Pback # 0 THEN
- 1418 DEC(Pos);
- 1419 END;
- 1420 Ret := Pos-LONGCARD(CoreFile.BufInf[F]^.Cnt);
- 1421 END;
- 1422 (*%T _mthread *)
- 1423 (*%T _OS2 *)
- 1424 StreamUnlock(CoreFile.BufInf[F]);
- 1425 (*%E *)
- 1426 (*%E *)
- 1427 END;
- 1428 (*%T _mthread *)
- 1429 (*%F _OS2 *)
- 1430 Process.Unlock();
- 1431 (*%E *)
- 1432 (*%E *)
- 1433 IF Ret = MAX(LONGCARD) THEN
- 1434 ErrorCheck(9, 0, 'GetPos : ', Lib.NilStr);
- 1435 OK := FALSE;
- 1436 (*%T _mthread *)
- 1437 OKTable[CoreProc._getTID()] := FALSE;
- 1438 (*%E *)
- 1439 END;
- 1440 RETURN Ret;
- 1441 END GetPos;
- 1442
- 1443
- 1444 PROCEDURE Seek( F : File; pos:LONGCARD );
- 1445 VAR Ret: LONGINT;
- 1446 BEGIN
- 1447 (*%T _mthread *)
- 1448 SetIOR(0);
- 1449 (*%E *)
- 1450 (*%F _mthread *)
- 1451 IOR := 0;
- 1452 (*%E *)
- 1453 (*%T _mthread *)
- 1454 (*%F _OS2 *)
- 1455 Process.Lock();
- 1456 (*%E *)
- 1457 (*%E *)
- 1458 IF (F > CoreFile._open_max) OR (CoreFile.BufInf[F] = NIL) THEN
- 1459 Ret := CoreIO.lseek(F, pos, CoreIO.SEEK_SET);
- 1460 ELSE
- 1461 (*%T _mthread *)
- 1462 (*%T _OS2 *)
- 1463 StreamLock(CoreFile.BufInf[F]);
- 1464 (*%E *)
- 1465 (*%E *)
- 1466 WITH CoreFile.BufInf[F]^ DO
- 1467 IF (Flag = {}) OR (Flag >= CoreIO._F_ERR) THEN
- 1468 Ret := -1;
- 1469 ELSE
- 1470 IF (Flag >= CoreIO._F_OUT) THEN (* flush output buffer *)
- 1471 IF FlsBuf(CoreFile.BufInf[F]) = -1 THEN
- 1472 Ret := -1;
- 1473 END;
- 1474 END;
- 1475 Pback := 0; (* reset buffer *)
- 1476 Cnt := 0;
- 1477 Flag := Flag + CoreIO._F_RST;
- 1478 Ret := CoreIO.lseek(F, pos, CoreIO.SEEK_SET);
- 1479 Flag := Flag - (CoreIO._F_IN + CoreIO._F_OUT +CoreIO._F_EOF +CoreIO._F_CTZ);
- 1480 END;
- 1481 END;
- 1482 (*%T _mthread *)
- 1483 (*%T _OS2 *)
- 1484 StreamUnlock(CoreFile.BufInf[F]);
- 1485 (*%E *)
- 1486 (*%E *)
- 1487 END;
- 1488 CoreFile._openfd[F] := CoreFile._openfd[F] - (CoreIO._O_EOF);
- 1489 (*%T _mthread *)
- 1490 (*%F _OS2 *)
- 1491 Process.Unlock();
- 1492 (*%E *)
- 1493 (*%E *)
- 1494 IF Ret = -1 THEN
- 1495 ErrorCheck(0AH, 0, 'Seek : ', Lib.NilStr);
- 1496 END;
- 1497 END Seek;
- 1498
- 1499
- 1500 PROCEDURE Size(F: File) : LONGCARD;
- 1501 VAR
- 1502 Ret: LONGCARD;
- 1503 CurPos: LONGCARD;
- 1504 BEGIN
- 1505 (*%T _mthread *)
- 1506 Process.Lock();
- 1507 (*%E *)
- 1508 CurPos := GetPos(F);
- 1509 IF NOT (*%T _mthread *) ThreadOK() (*%E *) (*%F _mthread *) OK (*%E *) THEN RETURN 0 END;
- 1510 Ret := CoreIO.lseek(F, 0, CoreIO.SEEK_END);
- 1511 Seek(F, CurPos);
- 1512 (*%T _mthread *)
- 1513 Process.Unlock();
- 1514 (*%E *)
- 1515 RETURN Ret;
- 1516 END Size;
- 1517
- 1518
- 1519 PROCEDURE Erase(Name:ARRAY OF CHAR);
- 1520
- 1521 VAR
- 1522 fn : PathStr;
- 1523 BEGIN
- 1524 GetName(Name,fn);
- 1525 IF(CoreIO.unlink(fn) = -1) THEN
- 1526 ErrorCheck(0EH, 0, 'Erase : ', fn);
- 1527 END;
- 1528 END Erase;
- 1529
- 1530
- 1531 PROCEDURE Rename(Name,newname: ARRAY OF CHAR);
- 1532 VAR
- 1533 fn: PathStr;
- 1534 fn2: PathStr;
- 1535 BEGIN
- 1536 GetName(Name,fn);
- 1537 GetName(newname,fn2);
- 1538 IF(CoreIO.rename(fn, fn2) = -1) THEN
- 1539 ErrorCheck(0FH, 0, 'Rename : ', fn);
- 1540 END;
- 1541 END Rename;
- 1542
- 1543 (*%F _OS2 *)
- 1544 PROCEDURE ReadFirstEntry ( DirName : ARRAY OF CHAR;
- 1545 Attr : FileAttr;
- 1546 VAR D : DirEntry) : BOOLEAN;
- 1547 VAR
- 1548 r : SYSTEM.Registers;
- 1549 fn : PathStr;
- 1550 BEGIN
- 1551 GetName(DirName,fn);
- 1552 WITH r DO
- 1553 AH := 1AH;
- 1554 DS := Seg(D);
- 1555 DX := Ofs(D);
- 1556 Lib.Dos(r); (* set DTA *)
- 1557 AH := 4EH;
- 1558 DS := Seg(fn);
- 1559 DX := Ofs(fn);
- 1560 CL := SHORTCARD(Attr);
- 1561 CH := SHORTCARD(0);
- 1562 Lib.Dos(r);
- 1563 IF (BITSET{SYSTEM.CarryFlag} * Flags) # BITSET{} THEN
- 1564 IF (AX <> 18) THEN
- 1565 ErrorCheck(14H, AX, 'ReadFirstEntry : ', DirName);
- 1566 END;
- 1567 RETURN FALSE;
- 1568 END;
- 1569 END;
- 1570 RETURN TRUE;
- 1571 END ReadFirstEntry;
- 1572
- 1573 PROCEDURE ReadNextEntry(VAR D: DirEntry) : BOOLEAN;
- 1574 VAR
- 1575 r : SYSTEM.Registers;
- 1576 BEGIN
- 1577 (*%T _mthread *)
- 1578 SetIOR(0);
- 1579 (*%E *)
- 1580 (*%F _mthread *)
- 1581 IOR := 0;
- 1582 (*%E *)
- 1583 WITH r DO
- 1584 AH := 1AH;
- 1585 DS := Seg(D);
- 1586 DX := Ofs(D);
- 1587 Lib.Dos(r); (* set DTA *)
- 1588 AH := 4FH;
- 1589 Lib.Dos(r);
- 1590 IF (BITSET{SYSTEM.CarryFlag} * Flags) # BITSET{} THEN
- 1591 IF (AX <> 18) THEN
- 1592 ErrorCheck(15H, AX, 'ReadNextEntry : ', Lib.NilStr);
- 1593 END;
- 1594 RETURN FALSE;
- 1595 END;
- 1596 END;
- 1597 RETURN TRUE;
- 1598 END ReadNextEntry;
- 1599 (*%E *)
- 1600
- 1601 (*%T _OS2 *)
- 1602 CONST
- 1603 GuardHandle = MAX(CARDINAL)-1;
- 1604
- 1605 PROCEDURE CopyResult(VAR D: DirEntry; VAR d: Dos.FILEFINDBUF);
- 1606
- 1607 BEGIN
- 1608 D.attr:=FileAttr(d.attrFile);
- 1609 D.time:=d.ftimeCreation;
- 1610 D.date:=d.fdateCreation;
- 1611 D.size:=d.fileSize;
- 1612 Str.Copy(D.Name, d.name);
- 1613 END CopyResult;
- 1614
- 1615
- 1616 PROCEDURE ReadFirstEntry ( DirName : ARRAY OF CHAR;
- 1617 Attr : FileAttr;
- 1618 VAR D : DirEntry) : BOOLEAN;
- 1619
- 1620 PROCEDURE WildInName(): BOOLEAN;
- 1621 BEGIN
- 1622 RETURN (Str.CharPos(DirName, '*') # MAX(CARDINAL))
- 1623 OR (Str.CharPos(DirName, '?') # MAX(CARDINAL));
- 1624 END WildInName;
- 1625
- 1626 VAR
- 1627 b : Dos.FILEFINDBUF;
- 1628 fn : PathStr;
- 1629 status: CARDINAL;
- 1630 Handle, Count: CARDINAL;
- 1631 BEGIN
- 1632 GetName(DirName,fn);
- 1633 Handle:=MAX(CARDINAL);
- 1634 Count:=1;
- 1635 status:=FindFirst(fn, Handle, CARDINAL(SHORTCARD(Attr)), b, SIZE(b), Count, LONGCARD(0));
- 1636 IF status # 0 THEN
- 1637 IF status <> Err.ERROR_NO_MORE_FILES THEN
- 1638 ErrorCheck(14H, status, 'ReadFirstEntry : ', fn);
- 1639 END;
- 1640 RETURN FALSE;
- 1641 END;
- 1642 IF WildInName() THEN
- 1643 D.Reserved_Handle:=Handle;
- 1644 ELSE
- 1645 D.Reserved_Handle:=GuardHandle;
- 1646 Dos.FindClose(Handle);
- 1647 END;
- 1648 CopyResult(D, b);
- 1649 RETURN TRUE;
- 1650 END ReadFirstEntry;
- 1651
- 1652 PROCEDURE ReadNextEntry(VAR D: DirEntry) : BOOLEAN;
- 1653
- 1654 VAR
- 1655 b : Dos.FILEFINDBUF;
- 1656 status: CARDINAL;
- 1657 Handle, Count: CARDINAL;
- 1658 BEGIN
- 1659 Handle:=(D.Reserved_Handle);
- 1660 (*%T _mthread *)
- 1661 SetIOR(0);
- 1662 (*%E *)
- 1663 (*%F _mthread *)
- 1664 IOR := 0;
- 1665 (*%E *)
- 1666 IF Handle = GuardHandle THEN
- 1667 RETURN FALSE;
- 1668 END;
- 1669 Count:=1;
- 1670 status:=FindNext(Handle, b, SIZE(b), Count);
- 1671 IF status # 0 THEN
- 1672 Dos.FindClose(Handle);
- 1673 IF status <> Err.ERROR_NO_MORE_FILES THEN
- 1674 ErrorCheck(15H, status, 'ReadNextEntry : ', Lib.NilStr);
- 1675 END;
- 1676 RETURN FALSE;
- 1677 END;
- 1678 CopyResult(D, b);
- 1679 RETURN TRUE;
- 1680 END ReadNextEntry;
- 1681 (*%E *)
- 1682
- 1683 PROCEDURE ChDir(Name: ARRAY OF CHAR);
- 1684 VAR
- 1685 fn : PathStr;
- 1686 BEGIN
- 1687 (*%T _mthread *)
- 1688 SetIOR(0);
- 1689 (*%E *)
- 1690 (*%F _mthread *)
- 1691 IOR := 0;
- 1692 (*%E *)
- 1693 GetName(Name,fn);
- 1694 IF CoreIO.chdir(fn) = -1 THEN
- 1695 ErrorCheck(10H, 0, 'ChDir : ', Name);
- 1696 RETURN;
- 1697 END;
- 1698 IF (Str.Length(Name) > 1) AND (Name[1] = ':') THEN
- 1699 IF SetDrive(SHORTCARD(CAP(Name[0]) - 'A') + 1) = 0 THEN
- 1700 ErrorCheck(10H, 0, 'ChDir : ', Name);
- 1701 END;
- 1702 END;
- 1703 END ChDir;
- 1704
- 1705 PROCEDURE MkDir(Name: ARRAY OF CHAR);
- 1706 VAR
- 1707 fn : PathStr;
- 1708 BEGIN
- 1709 (*%T _mthread *)
- 1710 SetIOR(0);
- 1711 (*%E *)
- 1712 (*%F _mthread *)
- 1713 IOR := 0;
- 1714 (*%E *)
- 1715 GetName(Name,fn);
- 1716 IF CoreIO.mkdir(fn) = -1 THEN
- 1717 ErrorCheck(11H, 0, 'MkDir : ', Name);
- 1718 END;
- 1719 END MkDir;
- 1720
- 1721 PROCEDURE RmDir(Name: ARRAY OF CHAR);
- 1722 VAR
- 1723 fn : PathStr;
- 1724 BEGIN
- 1725 (*%T _mthread *)
- 1726 SetIOR(0);
- 1727 (*%E *)
- 1728 (*%F _mthread *)
- 1729 IOR := 0;
- 1730 (*%E *)
- 1731 GetName(Name,fn);
- 1732 IF CoreIO.rmdir(fn) = -1 THEN
- 1733 ErrorCheck(12H, 0, 'RmDir : ', Name);
- 1734 END;
- 1735 END RmDir;
- 1736
- 1737 PROCEDURE GetDir(drive: SHORTCARD; VAR Name: ARRAY OF CHAR);
- 1738 VAR
- 1739 fn : PathStr;
- 1740 BEGIN
- 1741 (*%T _mthread *)
- 1742 SetIOR(0);
- 1743 (*%E *)
- 1744 (*%F _mthread *)
- 1745 IOR := 0;
- 1746 (*%E *)
- 1747 IF CoreIO.getcurdir(CARDINAL(drive), fn) = -1 THEN
- 1748 ErrorCheck(13H, 0, 'GetDir : ', Lib.NilStr);
- 1749 END;
- 1750 Str.Concat(Name,'\',fn);
- 1751 END GetDir;
- 1752
- 1753 PROCEDURE AssignBuffer(F:File;VAR Buf:ARRAY OF BYTE);
- 1754
- 1755 PROCEDURE FindFreeStream():FileInf;
- 1756 VAR
- 1757 n : CARDINAL;
- 1758 BEGIN
- 1759 n := 0;
- 1760 (*%T _mthread *)
- 1761 Process.Lock();
- 1762 (*%E *)
- 1763 WHILE n < CoreFile._open_max DO
- 1764 IF CoreFile._iob[n].Flag = {} THEN
- 1765 (*%T _mthread *)
- 1766 Process.Unlock();
- 1767 (*%E *)
- 1768 RETURN FileInf(ADR(CoreFile._iob[n]));
- 1769 END; (*IF*)
- 1770 INC(n);
- 1771 END; (*WHILE*)
- 1772 (*%T _mthread *)
- 1773 Process.Unlock();
- 1774 (*%E *)
- 1775 RETURN NIL;
- 1776 END FindFreeStream;
- 1777
- 1778 BEGIN
- 1779 (*%T _mthread *)
- 1780 SetIOR(0);
- 1781 (*%E *)
- 1782 (*%F _mthread *)
- 1783 IOR := 0;
- 1784 (*%E *)
- 1785 IF (F > CoreFile._open_max) (*%F _WINDOWS *) OR (CoreFile._openfd[F] = {}) (*%E *) THEN
- 1786 ErrorCheck(19H,CoreIO.EBADF,'AssignBuffer : ',Lib.NilStr);
- 1787 RETURN;
- 1788 END; (*IF*)
- 1789 IF (HIGH(Buf) = 0) OR (HIGH(Buf) > MAX(INTEGER)) THEN
- 1790 ErrorCheck(1AH,CoreIO.EINVAL,'AssignBuffer : ',Lib.NilStr);
- 1791 RETURN;
- 1792 END; (*IF*)
- 1793 (*%T _WINDOWS *)
- 1794 IF (CoreFile._openfd[F] = {}) THEN
- 1795 CoreFile._openfd[F] := (CoreIO.O_RDWR + CoreIO.O_BINARY);
- 1796 END; (*IF*)
- 1797 (*%E *)
- 1798 IF CoreFile.BufInf[F] # NIL THEN
- 1799 RETURN;
- 1800 END; (*IF*)
- 1801 CoreFile.BufInf[F] := FindFreeStream();
- 1802 IF CoreFile.BufInf[F] = NIL THEN
- 1803 ErrorCheck(1BH,CoreIO.EMFILE,'AssignBuffer : ',Lib.NilStr);
- 1804 RETURN;
- 1805 END; (*IF*)
- 1806 WITH CoreFile.BufInf[F]^ DO
- 1807 Ptr := CoreFile.StreamPtr(ADR(Buf));
- 1808 Base := Ptr;
- 1809 Size := HIGH(Buf) + 1;
- 1810 Cnt := 0;
- 1811 Pback := 0;
- 1812 Handle := F;
- 1813 IF (CoreFile._openfd[F] >= CoreIO.O_DEVICE) THEN
- 1814 Flag := CoreIO._F_DEV;
- 1815 ELSE
- 1816 Flag := {};
- 1817 END; (*IF*)
- 1818 IF (CoreFile._openfd[F] * CoreIO.O_RDWR # {}) OR (CoreFile._openfd[F] * CoreIO.O_WRONLY # {}) THEN
- 1819 Flag := Flag + CoreIO._F_RDWR;
- 1820 ELSE
- 1821 Flag := Flag + CoreIO._F_READ;
- 1822 END; (*IF*)
- 1823 IF CoreFile._openfd[F] >= CoreIO.O_APPEND THEN
- 1824 Flag := Flag + CoreIO._F_APP;
- 1825 END; (*IF*)
- 1826 Flag := Flag + (CoreIO._F_BIN + CoreIO._F_UBUF + CoreIO._F_RST);
- 1827 END; (*WITH*)
- 1828 END AssignBuffer;
- 1829
- 1830 PROCEDURE AppendHandle(F: File; ReadOnly: BOOLEAN);
- 1831
- 1832 BEGIN
- 1833 IF F < CoreFile._open_max THEN
- 1834 IF ReadOnly THEN
- 1835 CoreFile._openfd[F] := (CoreIO.O_RDONLY+CoreIO.O_BINARY);
- 1836 ELSE
- 1837 CoreFile._openfd[F] := (CoreIO.O_RDWR+CoreIO.O_BINARY);
- 1838 END;
- 1839 IF CoreIO.isatty(F) # 0 THEN
- 1840 CoreFile._openfd[F] := CoreFile._openfd[F] + CoreIO.O_DEVICE;
- 1841 END;
- 1842 END;
- 1843 END AppendHandle;
- 1844
- 1845
- 1846 PROCEDURE AppendStream(St: FileInf): File;
- 1847
- 1848 VAR
- 1849 F: File;
- 1850 BEGIN
- 1851 F := St^.Handle;
- 1852 CoreFile.BufInf[F] := St;
- 1853 RETURN F;
- 1854 END AppendStream;
- 1855
- 1856 PROCEDURE GetStreamPointer(F: File): FileInf;
- 1857
- 1858 BEGIN
- 1859 RETURN CoreFile.BufInf[F];
- 1860 END GetStreamPointer;
- 1861
- 1862 (*%F _OS2 *)
- 1863 PROCEDURE GetDrive() : SHORTCARD ;
- 1864
- 1865 (* Returns the currently selected drive *)
- 1866 (* A=1,B=2,C=3 etc *)
- 1867
- 1868 VAR
- 1869 r : SYSTEM.Registers;
- 1870 BEGIN
- 1871 (*%T _mthread *)
- 1872 SetIOR(0);
- 1873 (*%E *)
- 1874 (*%F _mthread *)
- 1875 IOR := 0;
- 1876 (*%E *)
- 1877 r.AH := 19H ;
- 1878 Lib.Dos(r);
- 1879 RETURN r.AL+1 ;
- 1880 END GetDrive ;
- 1881
- 1882 PROCEDURE SetDrive(Drive: SHORTCARD): SHORTCARD;
- 1883
- 1884 (* Sets the default drive *)
- 1885 (* A=1,B=2,C=3 etc *)
- 1886
- 1887 VAR
- 1888 r : SYSTEM.Registers;
- 1889 BEGIN
- 1890 (*%T _mthread *)
- 1891 SetIOR(0);
- 1892 (*%E *)
- 1893 (*%F _mthread *)
- 1894 IOR := 0;
- 1895 (*%E *)
- 1896 r.AH := 0EH ;
- 1897 r.DL := Drive-1;
- 1898 Lib.Dos(r);
- 1899 RETURN r.AL;
- 1900 END SetDrive ;
- 1901
- 1902 PROCEDURE GetCurrentDate () : LONGCARD ;
- 1903 VAR r : SYSTEM.Registers;
- 1904 l : RECORD
- 1905 CASE : BOOLEAN OF
- 1906 TRUE : fl,fh : CARDINAL; |
- 1907 FALSE : l : LONGCARD;
- 1908 END;
- 1909 END;
- 1910 BEGIN
- 1911 WITH r DO
- 1912 AH := 2CH;
- 1913 Lib.Dos(r);
- 1914 l.fl := (VAL(CARDINAL,CH) << 11)+(VAL(CARDINAL,CL) << 5)+(VAL(CARDINAL,DH)>>1);
- 1915 AH := 2AH ;
- 1916 Lib.Dos(r);
- 1917 l.fh := ((CX-1980)<< 9)+(VAL(CARDINAL,DH)<<5)+VAL(CARDINAL,DL);
- 1918 END;
- 1919 RETURN l.l;
- 1920 END GetCurrentDate ;
- 1921
- 1922 PROCEDURE GetFileDate( f : File) : LONGCARD;
- 1923 VAR r : SYSTEM.Registers;
- 1924 l : RECORD
- 1925 CASE : BOOLEAN OF
- 1926 TRUE : fl,fh : CARDINAL; |
- 1927 FALSE : l : LONGCARD;
- 1928 END;
- 1929 END;
- 1930 BEGIN
- 1931 WITH r DO
- 1932 AX := 5700H;
- 1933 BX := f;
- 1934 Lib.Dos(r);
- 1935 l.fl := CX;
- 1936 l.fh := DX;
- 1937 END;
- 1938 RETURN l.l;
- 1939 END GetFileDate;
- 1940
- 1941 PROCEDURE SetFileDate( f : File ; d : LONGCARD ) ;
- 1942 VAR r : SYSTEM.Registers;
- 1943 l : RECORD
- 1944 CASE : BOOLEAN OF
- 1945 TRUE : fl,fh : CARDINAL; |
- 1946 FALSE : l : LONGCARD;
- 1947 END;
- 1948 END;
- 1949 BEGIN
- 1950 WITH r DO
- 1951 l.l := d ;
- 1952 AX := 5701H;
- 1953 BX := f;
- 1954 CX := l.fl ;
- 1955 DX := l.fh ;
- 1956 Lib.Dos(r);
- 1957 END;
- 1958 END SetFileDate;
- 1959 (*%E *)
- 1960
- 1961 (*%T _OS2 *)
- 1962 PROCEDURE GetDrive() : SHORTCARD ;
- 1963
- 1964 (* Returns the currently selected drive *)
- 1965 (* A=1,B=2,C=3 etc *)
- 1966
- 1967 VAR
- 1968 Dr : CARDINAL;
- 1969 BitMap: LONGCARD;
- 1970 BEGIN
- 1971 SYSTEM.Eval(QCurDisk(Dr, BitMap));
- 1972 RETURN SHORTCARD(Dr);
- 1973 END GetDrive ;
- 1974
- 1975 PROCEDURE SetDrive(Drive: SHORTCARD): SHORTCARD;
- 1976
- 1977 (* Sets the default drive *)
- 1978 (* A=1,B=2,C=3 etc *)
- 1979
- 1980 BEGIN
- 1981 SYSTEM.Eval(Dos.SelectDisk(CARDINAL(Drive)));
- 1982 RETURN MAX(SHORTCARD);
- 1983 END SetDrive ;
- 1984
- 1985 PROCEDURE GetCurrentDate () : LONGCARD ;
- 1986
- 1987 VAR
- 1988 l : RECORD
- 1989 CASE : BOOLEAN OF
- 1990 TRUE : fl,fh : CARDINAL; |
- 1991 FALSE : l : LONGCARD;
- 1992 END;
- 1993 END;
- 1994 Info: Dos.DATETIME;
- 1995 BEGIN
- 1996 SYSTEM.Eval(Dos.GetDateTime(Info));
- 1997 l.fl := (CARDINAL(Info.hours) << 11)+(CARDINAL(Info.minutes) << 5)+(CARDINAL(Info.seconds)>>1);
- 1998 l.fh := ((Info.year-1980)<< 9)+(CARDINAL(Info.month)<<5)+CARDINAL(Info.day);
- 1999 RETURN l.l;
- 2000 END GetCurrentDate ;
- 2001
- 2002 TYPE
- 2003 FileInfo = RECORD
- 2004 CDate, CTime, ADate, ATime, WDate, WTime: CARDINAL;
- 2005 CBFile, CGFileA: LONGCARD;
- 2006 Attr: SHORTCARD;
- 2007 cchName: SHORTCARD;
- 2008 achName: ARRAY [0..12] OF CHAR;
- 2009 END;
- 2010 DT = RECORD
- 2011 CASE : BOOLEAN OF
- 2012 TRUE : fl,fh : CARDINAL; |
- 2013 FALSE : l : LONGCARD;
- 2014 END;
- 2015 END;
- 2016
- 2017 PROCEDURE GetFileDate( f : File) : LONGCARD;
- 2018
- 2019 VAR
- 2020 Buffer: FileInfo;
- 2021 T: DT;
- 2022 BEGIN
- 2023 IF Dos.QFileInfo(f, CARDINAL(1), FarADR(Buffer), SIZE(Buffer)) # 0 THEN
- 2024 RETURN MAX(LONGCARD);
- 2025 END;
- 2026 T.fh := Buffer.WDate;
- 2027 T.fl := Buffer.WTime;
- 2028 RETURN T.l;
- 2029 END GetFileDate;
- 2030
- 2031 PROCEDURE SetFileDate( f : File ; d : LONGCARD ) ;
- 2032
- 2033 VAR
- 2034 Buffer: FileInfo;
- 2035 T: DT;
- 2036 BEGIN
- 2037 IF Dos.QFileInfo(f, CARDINAL(1), FarADR(Buffer), SIZE(Buffer)) # 0 THEN RETURN END;
- 2038 T.l:= d;
- 2039 Buffer.WDate := T.fh;
- 2040 Buffer.WTime := T.fl;
- 2041 IF Dos.SetFileInfo(f, CARDINAL(1), FarADR(Buffer), SIZE(Buffer)) # 0 THEN END;
- 2042 END SetFileDate;
- 2043 (*%E *)
- 2044
- 2045 PROCEDURE ThreadEOF(): BOOLEAN;
- 2046
- 2047 BEGIN
- 2048 (*%T _mthread *)
- 2049 RETURN EOFTable[CoreProc._getTID()];
- 2050 (*%E *)
- 2051 (*%F _mthread *)
- 2052 RETURN EOF;
- 2053 (*%E *)
- 2054 END ThreadEOF;
- 2055
- 2056 PROCEDURE ThreadOK(): BOOLEAN;
- 2057
- 2058 BEGIN
- 2059 (*%T _mthread *)
- 2060 RETURN OKTable[CoreProc._getTID()];
- 2061 (*%E *)
- 2062 (*%F _mthread *)
- 2063 RETURN OK;
- 2064 (*%E *)
- 2065 END ThreadOK;
- 2066
- 2067 PROCEDURE GetFileStamp(f : File ; VAR b: FileStamp) : BOOLEAN;
- 2068
- 2069 VAR
- 2070 DT : RECORD
- 2071 CASE : BOOLEAN OF
- 2072 TRUE : ft,fd : CARDINAL; |
- 2073 FALSE : l : LONGCARD;
- 2074 END;
- 2075 END;
- 2076 BEGIN
- 2077 DT.l := GetFileDate(f);
- 2078 IF DT.l = MAX(LONGCARD) THEN
- 2079 RETURN FALSE;
- 2080 ELSE
- 2081 b.Year := SHORTCARD(DT.fd>>9+80) ;
- 2082 b.Month := SHORTCARD((DT.fd>>5) MOD 16) ;
- 2083 b.Day := SHORTCARD(DT.fd MOD 32) ;
- 2084 b.Hour := SHORTCARD(DT.ft>>11) ;
- 2085 b.Min := SHORTCARD((DT.ft>>5) MOD 64) ;
- 2086 b.Sec := SHORTCARD(DT.ft MOD 32) ;
- 2087 RETURN TRUE;
- 2088 END;
- 2089 END GetFileStamp;
- 2090
- 2091 (*# save,call(c_conv=>on) *)
- 2092 PROCEDURE Cleanup();
- 2093 VAR
- 2094 n : CARDINAL;
- 2095 BEGIN
- 2096 FOR n := 0 TO CoreFile._open_max - 1 DO
- 2097 IF CoreFile._iob[n].Flag # {} THEN
- 2098 CoreFile.BufInf[n] := ADR(CoreFile._iob[n]);
- 2099 Flush(n);
- 2100 END; (*IF*)
- 2101 END; (*FOR*)
- 2102 END Cleanup;
- 2103 (*# restore *)
- 2104
- 2105 (*%T _mthread *)
- 2106 VAR
- 2107 n : [1..Process.MaxProcess];
- 2108 (*%E *)
- 2109 BEGIN
- 2110 (*%T _mthread *)
- 2111 n := 1;
- 2112 WHILE n <= Process.MaxProcess DO
- 2113 IOR[n] := 0;
- 2114 EOFTable[n] := FALSE;
- 2115 OKTable[n] := TRUE;
- 2116 INC(n);
- 2117 END;
- 2118 (*%E *)
- 2119 (*%F _mthread *)
- 2120 IOR := 0;
- 2121 (*%E *)
- 2122 Eng := FALSE;
- 2123 IOcheck := TRUE;
- 2124 OK := TRUE;
- 2125 ChopOff := FALSE;
- 2126 EOF := FALSE;
- 2127 EOL := CHR (10);
- 2128 PrefixChar := ' ';
- 2129 SuffixChar := ' ';
- 2130 ShareMode := ShareCompat;
- 2131 Separators := Str.CHARSET{CHR(9),CHR(10),CHR(13),CHR(26),' '};
- 2132 CoreFile.BufInf[StandardInput] := ADR(CoreFile._iob[StandardInput]);
- 2133 CoreFile.BufInf[StandardOutput] := ADR(CoreFile._iob[StandardOutput]);
- 2134 CoreMain._exit_io := Cleanup;
- 2135 END FIO.
- 2136
- 727 errors
|
