LIB.LST 84 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147
  1. Listing:
  2. 1 (* Release 3.10 *)
  3. 2 (*-------------------------------------------------------------------------*
  4. 3 * *
  5. 4 * LIB.MOD - General library functions *
  6. 5 * *
  7. 6 * COPYRIGHT (C) 1987..1992 Clarion Software Corporation. *
  8. 7 * All Rights Reserved *
  9. 8 * *
  10. 9 *--------------------------------------------------------------------------*)
  11. 10
  12. 11 (*%F _fdata *)
  13. 12 (*# call(seg_name => null) *)
  14. 13 (*# data(seg_name => null) *)
  15. 14 (*%E *)
  16. 15 (*# module(implementation=>off) *)
  17. 16 (*# call(o_a_copy => off) *)
  18. 17 (*# check(stack=>off,
  19. 18 index=>off,
  20. 19 range=>off,
  21. 20 overflow=>off,
  22. 21 nil_ptr=>off) *)
  23. 22
  24. 23 IMPLEMENTATION MODULE Lib;
  25. 24
  26. 25 IMPORT SYSTEM,Str,SPAWN,CoreMain,CoreSig,CoreMath;
  27. 26 (*%F _OS2 *)
  28. 27 (*%T _WINDOWS*)
  29. 28 IMPORT Windows;
  30. 29 (*%E *)
  31. 30 (*%E *)
  32. 31 (*%T _OS2 *)
  33. 32 FROM Dos IMPORT DATETIME,GetDateTime,SIGHANDLER,SetSigHandler,Sleep,
  34. 33 SIG_CTRLC,SIG_CTRLBREAK,Beep,RESULTCODES,ExecPgm,
  35. 34 SearchPath,GetMessage,GetEnv,EXEC_SYNC, SetDateTime, Write;
  36. 35 (*%E *)
  37. 36
  38. 37 CONST
  39. 38 _DLLOVL = (_DLL OR _OVL) AND NOT _OS2;
  40. ***** ^ undeclared identifier
  41. ***** ^ undeclared identifier
  42. ***** ^ undeclared identifier
  43. 39 _NOTDLLORENV = (NOT _DLLOVL) OR _ENV;
  44. ***** ^ not supported yet
  45. ***** ^ undeclared identifier
  46. 40
  47. 41 (* Implemented In AsmLib *)
  48. 42 (*# save *)
  49. 43 (*%T _DLL *)
  50. 44 (*# call(seg_name=>LibDLL) *)
  51. 45 (*%E *)
  52. 46 PROCEDURE AddFarAddr(A: FarADDRESS; increment: CARDINAL) : FarADDRESS; IN AsmLib;
  53. ***** ^ undeclared identifier
  54. ***** ^ undeclared identifier
  55. ***** ^ not supported yet
  56. 47 PROCEDURE SubFarAddr(A: FarADDRESS; decrement: CARDINAL) : FarADDRESS; IN AsmLib;
  57. ***** ^ undeclared identifier
  58. ***** ^ undeclared identifier
  59. ***** ^ not supported yet
  60. 48 PROCEDURE IncFarAddr(VAR A: FarADDRESS; increment: CARDINAL); IN AsmLib;
  61. ***** ^ undeclared identifier
  62. ***** ^ not supported yet
  63. 49 PROCEDURE DecFarAddr(VAR A: FarADDRESS; decrement: CARDINAL); IN AsmLib;
  64. ***** ^ undeclared identifier
  65. ***** ^ not supported yet
  66. 50
  67. 51 (*%F _fdata *)
  68. 52 PROCEDURE NearMove (Source,Dest:NearADDRESS;Count:CARDINAL); IN AsmLib;
  69. 53 PROCEDURE NearFastMove(Source,Dest:NearADDRESS;Count:CARDINAL); IN AsmLib;
  70. 54 PROCEDURE NearWordMove(Source,Dest:NearADDRESS;WordCount:CARDINAL); IN AsmLib;
  71. 55 (*%E *)
  72. 56 PROCEDURE Move (Source,Dest:ADDRESS;Count:CARDINAL); IN AsmLib;
  73. ***** ^ undeclared identifier
  74. ***** ^ not supported yet
  75. 57 PROCEDURE FastMove(Source,Dest:ADDRESS;Count:CARDINAL); IN AsmLib;
  76. ***** ^ undeclared identifier
  77. ***** ^ not supported yet
  78. 58 PROCEDURE WordMove(Source,Dest:ADDRESS;WordCount:CARDINAL); IN AsmLib;
  79. ***** ^ undeclared identifier
  80. ***** ^ not supported yet
  81. 59
  82. 60 PROCEDURE FarMove (Source,Dest:FarADDRESS;Count:CARDINAL); IN AsmLib;
  83. ***** ^ undeclared identifier
  84. ***** ^ not supported yet
  85. 61 PROCEDURE FarFastMove(Source,Dest:FarADDRESS;Count:CARDINAL); IN AsmLib;
  86. ***** ^ undeclared identifier
  87. ***** ^ not supported yet
  88. 62 PROCEDURE FarWordMove(Source,Dest:FarADDRESS;WordCount:CARDINAL); IN AsmLib;
  89. ***** ^ undeclared identifier
  90. ***** ^ not supported yet
  91. 63
  92. 64 PROCEDURE Fill(Dest: ADDRESS; Count: CARDINAL; Value: BYTE); IN AsmLib;
  93. ***** ^ undeclared identifier
  94. ***** ^ undeclared identifier
  95. ***** ^ not supported yet
  96. 65 PROCEDURE FarFill(Dest: FarADDRESS; Count: CARDINAL; Value: BYTE); IN AsmLib;
  97. ***** ^ undeclared identifier
  98. ***** ^ undeclared identifier
  99. ***** ^ not supported yet
  100. 66
  101. 67 PROCEDURE WordFill(Dest: ADDRESS; WordCount: CARDINAL; Value: WORD); IN AsmLib;
  102. ***** ^ undeclared identifier
  103. ***** ^ undeclared identifier
  104. ***** ^ not supported yet
  105. 68 PROCEDURE FarWordFill(Dest: FarADDRESS; WordCount: CARDINAL; Value: WORD); IN AsmLib;
  106. ***** ^ undeclared identifier
  107. ***** ^ undeclared identifier
  108. ***** ^ not supported yet
  109. 69
  110. 70 PROCEDURE HashString(S: ARRAY OF CHAR; Range: CARDINAL) : CARDINAL; IN AsmLib;
  111. ***** ^ not supported yet
  112. ***** ^ not supported yet
  113. 71 PROCEDURE Terminate(P : PROC; VAR C: PROC); IN AsmLib;
  114. ***** ^ undeclared identifier
  115. ***** ^ undeclared identifier
  116. ***** ^ not supported yet
  117. 72 PROCEDURE SetReturnCode(code: SHORTCARD); IN AsmLib;
  118. ***** ^ not supported yet
  119. 73 PROCEDURE SetInProgramFlag(State: BOOLEAN); IN AsmLib;
  120. ***** ^ not supported yet
  121. 74 PROCEDURE GetInProgramFlag(): BOOLEAN; IN AsmLib;
  122. ***** ^ not supported yet
  123. 75
  124. 76 PROCEDURE CpuId ( VAR r : CpuRec ); IN AsmLib;
  125. ***** ^ undeclared identifier
  126. ***** ^ not supported yet
  127. 77
  128. 78 PROCEDURE ScanR (Dest: ADDRESS; Count: CARDINAL; Value: BYTE) : CARDINAL; IN AsmLib;
  129. ***** ^ undeclared identifier
  130. ***** ^ undeclared identifier
  131. ***** ^ not supported yet
  132. 79 PROCEDURE ScanL (Dest: ADDRESS; Count: CARDINAL; Value: BYTE) : CARDINAL; IN AsmLib;
  133. ***** ^ undeclared identifier
  134. ***** ^ undeclared identifier
  135. ***** ^ not supported yet
  136. 80 PROCEDURE ScanNeR(Dest: ADDRESS; Count: CARDINAL; Value: BYTE) : CARDINAL; IN AsmLib;
  137. ***** ^ undeclared identifier
  138. ***** ^ undeclared identifier
  139. ***** ^ not supported yet
  140. 81 PROCEDURE ScanNeL(Dest: ADDRESS; Count: CARDINAL; Value: BYTE) : CARDINAL; IN AsmLib;
  141. ***** ^ undeclared identifier
  142. ***** ^ undeclared identifier
  143. ***** ^ not supported yet
  144. 82 PROCEDURE Compare(Source,Dest: ADDRESS; Len: CARDINAL) : CARDINAL; IN AsmLib;
  145. ***** ^ undeclared identifier
  146. ***** ^ not supported yet
  147. 83
  148. 84 PROCEDURE UserBreak; IN AsmLib;
  149. ***** ^ not supported yet
  150. 85 PROCEDURE Sound(FreqHz: CARDINAL); IN AsmLib;
  151. ***** ^ not supported yet
  152. 86 PROCEDURE NoSound; IN AsmLib;
  153. ***** ^ not supported yet
  154. 87 PROCEDURE Dos(VAR R: SYSTEM.Registers); (* INT 21H Function Call *) IN AsmLib;
  155. ***** ^ duplicate identifier
  156. ***** ^ not supported yet
  157. ***** ^ not supported yet
  158. 88 PROCEDURE Intr(VAR R: SYSTEM.Registers; I: CARDINAL); IN AsmLib;
  159. ***** ^ not supported yet
  160. ***** ^ not supported yet
  161. 89
  162. 90 PROCEDURE AddressOK ( A : ADDRESS ) : BOOLEAN; IN AsmLib;
  163. ***** ^ undeclared identifier
  164. ***** ^ not supported yet
  165. 91 PROCEDURE SelectorLimit ( S : CARDINAL ) : CARDINAL; IN AsmLib;
  166. ***** ^ not supported yet
  167. 92 PROCEDURE ProtectedMode () : BOOLEAN; IN AsmLib;
  168. ***** ^ not supported yet
  169. 93
  170. 94 PROCEDURE SetJmp (VAR Lbl: LongLabel) : CARDINAL; IN AsmLib;
  171. ***** ^ undeclared identifier
  172. ***** ^ not supported yet
  173. 95 PROCEDURE LongJmp(VAR Lbl: LongLabel; result: CARDINAL); IN AsmLib;
  174. ***** ^ undeclared identifier
  175. ***** ^ not supported yet
  176. 96
  177. 97 (*%F _OS2 *)
  178. 98 (*# save *)
  179. 99 (*# call(near_call=>off, reg_param=>()) *)
  180. 100 PROCEDURE DosExec(name: ARRAY OF CHAR; paramblock: FarADDRESS) : CARDINAL; IN AsmLib;
  181. 101 (*# restore *)
  182. 102 PROCEDURE InternalEnableBreakCheck; IN AsmLib;
  183. 103 PROCEDURE InternalDisableBreakCheck; IN AsmLib;
  184. 104 PROCEDURE InternalDelay(Time: CARDINAL); IN AsmLib;
  185. 105 PROCEDURE InternalSound(Freq: CARDINAL); IN AsmLib;
  186. 106 PROCEDURE InternalNoSound(); IN AsmLib;
  187. 107 (*%E *)
  188. 108 (*# restore *)
  189. 109
  190. 110 PROCEDURE IsOfClass(Child, Parent: MTablePtr): BOOLEAN;
  191. ***** ^ undeclared identifier
  192. 111
  193. 112 VAR
  194. 113 ThisObject: MTablePtr;
  195. ***** ^ undeclared identifier
  196. 114
  197. 115 BEGIN
  198. 116 ThisObject:= Child;
  199. ***** ^ not supported yet
  200. ***** ^ not supported yet
  201. 117 IF ThisObject = Parent THEN RETURN TRUE END;
  202. ***** ^ not supported yet
  203. ***** ^ not supported yet
  204. 118 (*%T _fdata *)
  205. 119 WHILE ThisObject^.Parent # FarNIL DO
  206. ***** ^ not supported yet
  207. ***** ^ not supported yet
  208. ***** ^ undeclared identifier
  209. 120 (*%E *)
  210. 121 (*%F _fdata *)
  211. 122 WHILE ThisObject^.Parent # NearNIL DO
  212. 123 (*%E *)
  213. 124 IF ThisObject^.Parent = Parent THEN RETURN TRUE END;
  214. ***** ^ not supported yet
  215. ***** ^ not supported yet
  216. ***** ^ not supported yet
  217. 125 ThisObject := ThisObject^.Parent;
  218. ***** ^ not supported yet
  219. ***** ^ not supported yet
  220. ***** ^ not supported yet
  221. 126 END;
  222. 127 RETURN FALSE;
  223. 128 END IsOfClass;
  224. ***** ^ not supported yet
  225. 129
  226. 130
  227. 131
  228. 132 PROCEDURE HSort(N: CARDINAL; Less: CompareProc; Swap: SwapProc);
  229. ***** ^ undeclared identifier
  230. ***** ^ undeclared identifier
  231. 133 VAR
  232. 134 i,j,k : CARDINAL;
  233. 135 BEGIN
  234. 136 IF N > 1 THEN
  235. 137 i := N DIV 2;
  236. 138 REPEAT
  237. 139 j := i;
  238. 140 LOOP (* Note that total repeats <= N/4 * 1 + N/8 * 2 + N/16 * 3 + .... *)
  239. 141 k := j * 2;
  240. 142 IF k > N THEN EXIT END;
  241. 143 IF (k < N) AND Less(k,k+1) THEN INC(k) END;
  242. ***** ^ not supported yet
  243. ***** ^ not supported yet
  244. ***** ^ undeclared identifier
  245. ***** ^ not supported yet
  246. 144 IF Less(j,k) THEN Swap(j,k) ELSE EXIT END;
  247. ***** ^ not supported yet
  248. ***** ^ not supported yet
  249. ***** ^ not supported yet
  250. ***** ^ not supported yet
  251. 145 j := k;
  252. 146 END;
  253. 147 DEC(i);
  254. ***** ^ undeclared identifier
  255. ***** ^ not supported yet
  256. 148 UNTIL i = 0;
  257. 149
  258. 150 i := N;
  259. 151 REPEAT
  260. 152 j := 1;
  261. 153 Swap(j,i);
  262. ***** ^ not supported yet
  263. ***** ^ not supported yet
  264. 154 DEC(i);
  265. ***** ^ undeclared identifier
  266. ***** ^ not supported yet
  267. 155 LOOP
  268. 156 k := j * 2;
  269. 157 IF k > i THEN EXIT END;
  270. 158 IF ( k < i ) AND Less(k,k+1) THEN INC(k) END;
  271. ***** ^ not supported yet
  272. ***** ^ not supported yet
  273. ***** ^ undeclared identifier
  274. ***** ^ not supported yet
  275. 159 Swap(j,k);
  276. ***** ^ not supported yet
  277. ***** ^ not supported yet
  278. 160 j := k;
  279. 161 END;
  280. 162 LOOP
  281. 163 k := j DIV 2;
  282. 164 IF (k > 0) AND Less(k,j) THEN Swap(j,k); j := k ELSE EXIT END;
  283. ***** ^ not supported yet
  284. ***** ^ not supported yet
  285. ***** ^ not supported yet
  286. ***** ^ not supported yet
  287. 165 END;
  288. 166 UNTIL i = 0;
  289. 167 END;
  290. 168 END HSort;
  291. ***** ^ not supported yet
  292. 169
  293. 170
  294. 171 PROCEDURE QSort(N: CARDINAL; Less: CompareProc; Swap: SwapProc);
  295. ***** ^ undeclared identifier
  296. ***** ^ undeclared identifier
  297. 172
  298. 173 PROCEDURE Sort(l,r: CARDINAL);
  299. 174 VAR
  300. 175 i,j:CARDINAL;
  301. 176 BEGIN
  302. 177 WHILE r > l DO
  303. 178 i := l+1;
  304. 179 j := r;
  305. 180 WHILE i <= j DO
  306. 181 WHILE (i <= j) AND NOT Less(l,i) DO INC(i) END;
  307. ***** ^ not supported yet
  308. ***** ^ not supported yet
  309. ***** ^ undeclared identifier
  310. ***** ^ not supported yet
  311. 182 WHILE (i <= j) AND Less(l,j) DO DEC(j) END;
  312. ***** ^ not supported yet
  313. ***** ^ not supported yet
  314. ***** ^ undeclared identifier
  315. ***** ^ not supported yet
  316. 183 IF i <= j THEN Swap(i,j); INC(i); DEC(j) END;
  317. ***** ^ not supported yet
  318. ***** ^ not supported yet
  319. ***** ^ undeclared identifier
  320. ***** ^ not supported yet
  321. ***** ^ undeclared identifier
  322. ***** ^ not supported yet
  323. 184 END;
  324. 185 IF j # l THEN Swap(j,l) END;
  325. ***** ^ not supported yet
  326. ***** ^ not supported yet
  327. 186 IF j+j > r+l THEN (* small one recursively *)
  328. 187 Sort(j+1,r);
  329. ***** ^ not supported yet
  330. ***** ^ not supported yet
  331. 188 r := j-1;
  332. 189 ELSE
  333. 190 Sort(l,j-1);
  334. ***** ^ not supported yet
  335. ***** ^ not supported yet
  336. 191 l := j+1;
  337. 192 END;
  338. 193 END;
  339. 194 END Sort;
  340. ***** ^ not supported yet
  341. 195
  342. 196 BEGIN
  343. 197 Sort(1,N);
  344. ***** ^ not supported yet
  345. ***** ^ not supported yet
  346. 198 END QSort;
  347. ***** ^ not supported yet
  348. 199
  349. 200
  350. 201 PROCEDURE GetVector(Int:SHORTCARD):FarADDRESS;
  351. ***** ^ undeclared identifier
  352. 202 (*%F _OS2 *)
  353. 203 VAR
  354. 204 r : SYSTEM.Registers;
  355. 205 BEGIN
  356. 206 r.AH := 35H;
  357. 207 r.AL := Int;
  358. 208 Dos(r);
  359. 209 RETURN [r.ES:r.BX];
  360. 210 (*%E *)
  361. 211 (*%T _OS2 *)
  362. 212 BEGIN
  363. 213 RETURN FarNIL;
  364. ***** ^ undeclared identifier
  365. 214 (*%E *)
  366. 215 END GetVector;
  367. ***** ^ not supported yet
  368. 216
  369. 217 PROCEDURE SetVector(Int:SHORTCARD;Vector:FarADDRESS);
  370. ***** ^ undeclared identifier
  371. 218 (*%F _OS2 *)
  372. 219 VAR
  373. 220 r : SYSTEM.Registers;
  374. 221 BEGIN
  375. 222 r.AH := 25H;
  376. 223 r.AL := Int;
  377. 224 r.DS := Seg(Vector^);
  378. 225 r.DX := Ofs(Vector^);
  379. 226 Dos(r);
  380. 227 (*%E *)
  381. 228 END SetVector;
  382. ***** ^ not supported yet
  383. 229
  384. 230 (*%F _OS2 *)
  385. 231 PROCEDURE Execute(Name : ARRAY OF CHAR;
  386. 232 CommandLine : ARRAY OF CHAR;
  387. 233 StoreAddr : FarADDRESS; (* storage to execute in *)
  388. 234 StoreLen : CARDINAL (* length of store paragraphs *)
  389. 235 ):CARDINAL;
  390. 236 CONST
  391. 237 MinHeapNeeded = 4;
  392. 238
  393. 239 VAR
  394. 240 fullpath : ARRAY[0..80] OF CHAR;
  395. 241 cline : RECORD
  396. 242 len : SHORTCARD;
  397. 243 txt : ARRAY[0..255] OF CHAR;
  398. 244 END; (*cline*)
  399. 245 reply : CARDINAL;
  400. 246 LoadRec : RECORD
  401. 247 envseg : CARDINAL;
  402. 248 comline : FarADDRESS;
  403. 249 FCB1 : FarADDRESS;
  404. 250 FCB2 : FarADDRESS;
  405. 251 END; (*LoadRec*)
  406. 252 Progbase : CARDINAL;
  407. 253 MaxProgSize : CARDINAL;
  408. 254 residue : CARDINAL;
  409. 255
  410. 256 (*%T _NOTDLLORENV*)
  411. 257 PROCEDURE GiveBackHeap(StoreAddr:FarADDRESS; (* storage to execute in *)
  412. 258 StoreLen :CARDINAL); (* length of store paragraphs *)
  413. 259 VAR
  414. 260 R : SYSTEM.Registers;
  415. 261 temp : CARDINAL;
  416. 262 BEGIN
  417. 263 Progbase := Seg(StoreAddr^);
  418. 264 R.AH := 4AH;
  419. 265 R.ES := PSP;
  420. 266 R.BX := Seg(StoreAddr^)-PSP;
  421. 267 Lib.Dos(R); (* modify so all after seg free *)
  422. 268 R.BX := StoreLen-2;
  423. 269 R.AH := 48H;
  424. 270 Lib.Dos(R); (* allocate the seg we want *)
  425. 271 temp := R.AX;
  426. 272 R.BX := 0FFFFH; (* allocate all the rest *)
  427. 273 R.AH := 48H;
  428. 274 Lib.Dos(R); (* returns allocated in BX *)
  429. 275 R.AH := 48H;
  430. 276 Lib.Dos(R); (* do allocation *)
  431. 277 residue := R.AX;
  432. 278 R.AH := 49H;
  433. 279 R.ES := temp;
  434. 280 Lib.Dos(R); (* now free the bit we want *)
  435. 281 END GiveBackHeap;
  436. 282
  437. 283 PROCEDURE RetrieveHeap;
  438. 284 VAR
  439. 285 R : SYSTEM.Registers;
  440. 286 BEGIN
  441. 287 R.AH := 49H;
  442. 288 R.ES := residue;
  443. 289 Lib.Dos(R); (* now free the residue *)
  444. 290 R.BX := 0FFFFH; (* now modify PSP back to full size *)
  445. 291 R.AH := 4AH;
  446. 292 R.ES := PSP;
  447. 293 Lib.Dos(R); (* returns allocated in BX *)
  448. 294 R.AH := 4AH;
  449. 295 Lib.Dos(R); (* do modify *)
  450. 296 END RetrieveHeap;
  451. 297 (*%E *)
  452. 298
  453. 299 (*%F _NOTDLLORENV*)
  454. 300 PROCEDURE GiveBackHeap(StoreAddr:FarADDRESS;StoreLen:CARDINAL);
  455. 301 BEGIN
  456. 302 CoreMain._res_mem;
  457. 303 END GiveBackHeap;
  458. 304
  459. 305 PROCEDURE RetrieveHeap;
  460. 306 BEGIN
  461. 307 CoreMain._shr_mem;
  462. 308 END RetrieveHeap;
  463. 309 (*%E *)
  464. 310
  465. 311 BEGIN
  466. 312 GiveBackHeap(StoreAddr,StoreLen);
  467. 313 cline.len := SHORTCARD(Str.Length(CommandLine));
  468. 314 Str.Concat(cline.txt,CommandLine,CHR(13));
  469. 315 Str.Copy(fullpath,Name);
  470. 316 LoadRec.envseg := [PSP:2CH]^;
  471. 317 LoadRec.comline := FarADR(cline);
  472. 318 LoadRec.FCB1 := [PSP:5CH];
  473. 319 LoadRec.FCB2 := [PSP:6CH];
  474. 320 reply := DosExec(fullpath,FarADR(LoadRec));
  475. 321 RetrieveHeap;
  476. 322 RETURN reply;
  477. 323 END Execute;
  478. 324 (*%E *)
  479. 325
  480. 326 (*%T _OS2 *)
  481. 327 PROCEDURE Environment(N: CARDINAL): CommandType;
  482. ***** ^ undeclared identifier
  483. 328
  484. 329 VAR
  485. 330 Ret: FarADDRESS;
  486. ***** ^ undeclared identifier
  487. 331 BEGIN
  488. 332 Ret := FarADR(CoreMain._env_var[N]^);
  489. ***** ^ not supported yet
  490. ***** ^ undeclared identifier
  491. ***** ^ not supported yet
  492. ***** ^ not supported yet
  493. ***** ^ not supported yet
  494. 333 IF Ret = FarNIL THEN
  495. ***** ^ not supported yet
  496. ***** ^ undeclared identifier
  497. 334 RETURN CommandType(FarADR(NilStr));
  498. ***** ^ undeclared identifier
  499. ***** ^ undeclared identifier
  500. ***** ^ undeclared identifier
  501. 335 ELSE
  502. 336 RETURN CommandType(Ret);
  503. ***** ^ undeclared identifier
  504. ***** ^ not supported yet
  505. 337 END;
  506. 338 END Environment;
  507. ***** ^ not supported yet
  508. 339 (*%E *)
  509. 340
  510. 341 PROCEDURE EnvironmentFind ( name : ARRAY OF CHAR;
  511. ***** ^ not supported yet
  512. 342 VAR result : ARRAY OF CHAR );
  513. ***** ^ not supported yet
  514. 343 (* Find a string in the DOS environment *)
  515. 344 VAR
  516. 345 n, p : CARDINAL;
  517. 346 pi : ARRAY[0..14] OF CHAR;
  518. ***** ^ not supported yet
  519. ***** ^ not supported yet
  520. 347 pp : Lib.CommandType;
  521. ***** ^ not a type name
  522. ***** ^ not supported yet
  523. 348 c: CHAR;
  524. 349 BEGIN
  525. 350 n := 0;
  526. 351 LOOP
  527. 352 pp := Lib.Environment(n);
  528. ***** ^ not supported yet
  529. ***** ^ not supported yet
  530. ***** ^ not supported yet
  531. 353 p := 0;
  532. 354 REPEAT (* Don't use Str.Copy or it will stop after 126 chars *)
  533. 355 c := pp^[p];
  534. ***** ^ not supported yet
  535. ***** ^ not supported yet
  536. 356 result[p] := c;
  537. ***** ^ not supported yet
  538. ***** ^ not supported yet
  539. 357 INC(p);
  540. ***** ^ undeclared identifier
  541. ***** ^ not supported yet
  542. 358 UNTIL (c = 0C) OR (p > HIGH(result));
  543. ***** ^ undeclared identifier
  544. ***** ^ not supported yet
  545. 359 IF result[0] = CHR(0) THEN
  546. ***** ^ not supported yet
  547. ***** ^ not supported yet
  548. ***** ^ undeclared identifier
  549. ***** ^ not supported yet
  550. 360 RETURN;
  551. 361 END;
  552. 362 Str.ItemS(pi,result,' =',0);
  553. ***** ^ not supported yet
  554. ***** ^ not supported yet
  555. ***** ^ not supported yet
  556. ***** ^ not supported yet
  557. ***** ^ not supported yet
  558. ***** ^ not supported yet
  559. 363 IF Str.Match(pi,name) THEN
  560. ***** ^ not supported yet
  561. ***** ^ not supported yet
  562. ***** ^ not supported yet
  563. ***** ^ not supported yet
  564. 364 n := Str.CharPos(result, '=');
  565. ***** ^ not supported yet
  566. ***** ^ not supported yet
  567. ***** ^ not supported yet
  568. ***** ^ not supported yet
  569. 365 IF n=MAX(CARDINAL) THEN
  570. ***** ^ undeclared identifier
  571. ***** ^ not supported yet
  572. 366 n := Str.CharPos(result, ' ');
  573. ***** ^ not supported yet
  574. ***** ^ not supported yet
  575. ***** ^ not supported yet
  576. ***** ^ not supported yet
  577. 367 IF n=MAX(CARDINAL) THEN
  578. ***** ^ undeclared identifier
  579. ***** ^ not supported yet
  580. 368 result[0]:=0C;
  581. ***** ^ not supported yet
  582. ***** ^ not supported yet
  583. 369 RETURN;
  584. 370 END;
  585. 371 END;
  586. 372 Str.Delete(result, 0, n+1);
  587. ***** ^ not supported yet
  588. ***** ^ not supported yet
  589. ***** ^ not supported yet
  590. ***** ^ not supported yet
  591. 373 RETURN;
  592. 374 END;
  593. 375 INC(n);
  594. ***** ^ undeclared identifier
  595. ***** ^ not supported yet
  596. 376 END;
  597. 377 END EnvironmentFind;
  598. ***** ^ not supported yet
  599. 378
  600. 379 (*%T _OS2 *)
  601. 380 PROCEDURE Exec ( Path : ARRAY OF CHAR; Command : ARRAY OF CHAR; Env : ExecEnvPtr): CARDINAL;
  602. ***** ^ not supported yet
  603. ***** ^ not supported yet
  604. ***** ^ undeclared identifier
  605. 381
  606. 382 VAR
  607. 383 ParamArray: ARRAY [0..2] OF ADDRESS;
  608. ***** ^ not supported yet
  609. ***** ^ undeclared identifier
  610. 384 BEGIN
  611. 385 ParamArray[0]:=ADR(Path);
  612. ***** ^ not supported yet
  613. ***** ^ not supported yet
  614. ***** ^ undeclared identifier
  615. ***** ^ not supported yet
  616. 386 ParamArray[1]:=ADR(Command);
  617. ***** ^ not supported yet
  618. ***** ^ not supported yet
  619. ***** ^ undeclared identifier
  620. ***** ^ not supported yet
  621. 387 ParamArray[2]:=NIL;
  622. ***** ^ not supported yet
  623. ***** ^ not supported yet
  624. 388 RETURN SPAWN._beget(Path, ADR(ParamArray), Env, CARDINAL(ExecSearchPath));
  625. ***** ^ not supported yet
  626. ***** ^ not supported yet
  627. ***** ^ not supported yet
  628. ***** ^ undeclared identifier
  629. ***** ^ not supported yet
  630. ***** ^ not supported yet
  631. ***** ^ undeclared identifier
  632. 389 END Exec;
  633. ***** ^ not supported yet
  634. 390 (*%E *)
  635. 391
  636. 392 (*%T _OS2 *)
  637. 393 PROCEDURE ExecCmd(command:ARRAY OF CHAR):CARDINAL;
  638. ***** ^ not supported yet
  639. 394 VAR
  640. 395 Path : ARRAY [0..80] OF CHAR;
  641. ***** ^ not supported yet
  642. ***** ^ not supported yet
  643. 396 Params : ARRAY [0..3] OF ADDRESS;
  644. ***** ^ not supported yet
  645. ***** ^ undeclared identifier
  646. 397 BEGIN
  647. 398 EnvironmentFind('COMSPEC', Path);
  648. ***** ^ not supported yet
  649. ***** ^ not supported yet
  650. ***** ^ not supported yet
  651. 399 IF Path[0] = 0C THEN
  652. ***** ^ not supported yet
  653. ***** ^ not supported yet
  654. 400 Str.Copy(Path, "\CMD.EXE");
  655. ***** ^ not supported yet
  656. ***** ^ not supported yet
  657. ***** ^ not supported yet
  658. ***** ^ not supported yet
  659. 401 END; (*IF*)
  660. 402 Params[0] := ADR(Path);
  661. ***** ^ not supported yet
  662. ***** ^ not supported yet
  663. ***** ^ undeclared identifier
  664. ***** ^ not supported yet
  665. 403 Params[1] := ADR("/C");
  666. ***** ^ not supported yet
  667. ***** ^ not supported yet
  668. ***** ^ undeclared identifier
  669. ***** ^ not supported yet
  670. 404 Params[2] := ADR(command);
  671. ***** ^ not supported yet
  672. ***** ^ not supported yet
  673. ***** ^ undeclared identifier
  674. ***** ^ not supported yet
  675. 405 Params[3] := NIL;
  676. ***** ^ not supported yet
  677. ***** ^ not supported yet
  678. 406 RETURN SPAWN._beget(Path,ADR(Params),NIL,0);
  679. ***** ^ not supported yet
  680. ***** ^ not supported yet
  681. ***** ^ not supported yet
  682. ***** ^ undeclared identifier
  683. ***** ^ not supported yet
  684. ***** ^ not supported yet
  685. 407 END ExecCmd;
  686. ***** ^ not supported yet
  687. 408 (*%E *)
  688. 409
  689. 410 CONST
  690. 411 HistoryMax = 54;
  691. 412
  692. 413 VAR
  693. 414 HistoryPtr : CARDINAL;
  694. 415 LowerPtr : CARDINAL;
  695. 416 History : ARRAY [0..HistoryMax] OF CARDINAL;
  696. ***** ^ not supported yet
  697. ***** ^ not supported yet
  698. 417
  699. 418 PROCEDURE SEED(v:CARDINAL);
  700. 419 VAR
  701. 420 x : LONGCARD;
  702. ***** ^ undeclared identifier
  703. 421 i : CARDINAL;
  704. 422 BEGIN
  705. 423 HistoryPtr := HistoryMax;
  706. 424 LowerPtr := 23;
  707. 425 x := LONGCARD(v);
  708. ***** ^ not supported yet
  709. ***** ^ undeclared identifier
  710. ***** ^ not supported yet
  711. 426 i := 0;
  712. 427 REPEAT
  713. 428 x := (x*3141592621+17);
  714. ***** ^ not supported yet
  715. ***** ^ not supported yet
  716. 429 History[i] := CARDINAL(x DIV 10000H);
  717. ***** ^ not supported yet
  718. ***** ^ not supported yet
  719. ***** ^ not supported yet
  720. ***** ^ not supported yet
  721. 430 INC(i);
  722. ***** ^ undeclared identifier
  723. ***** ^ not supported yet
  724. 431 UNTIL i > HistoryMax;
  725. 432 END SEED;
  726. ***** ^ not supported yet
  727. 433
  728. 434 PROCEDURE RANDOM(Range: CARDINAL) : CARDINAL;
  729. 435 VAR res:CARDINAL;
  730. 436 BEGIN
  731. 437 IF HistoryPtr = 0 THEN
  732. 438 IF LowerPtr = 0 THEN
  733. 439 SEED(12345);
  734. ***** ^ not supported yet
  735. ***** ^ not supported yet
  736. 440 ELSE
  737. 441 HistoryPtr := HistoryMax;
  738. 442 LowerPtr := LowerPtr-1;
  739. 443 END;
  740. 444 ELSE
  741. 445 HistoryPtr := HistoryPtr-1;
  742. 446 IF LowerPtr = 0 THEN
  743. 447 LowerPtr := HistoryMax;
  744. 448 ELSE
  745. 449 LowerPtr := LowerPtr-1;
  746. 450 END;
  747. 451 END;
  748. 452 res := History[HistoryPtr]+History[LowerPtr];
  749. ***** ^ not supported yet
  750. ***** ^ not supported yet
  751. ***** ^ not supported yet
  752. ***** ^ not supported yet
  753. 453 History[HistoryPtr] := res;
  754. ***** ^ not supported yet
  755. ***** ^ not supported yet
  756. 454 IF Range = 0 THEN
  757. 455 RETURN res;
  758. 456 ELSE
  759. 457 RETURN res MOD Range;
  760. 458 END;
  761. 459 END RANDOM;
  762. ***** ^ not supported yet
  763. 460
  764. 461 PROCEDURE RANDOMIZE;
  765. 462 (*%T _WINDOWS *)
  766. 463 BEGIN
  767. 464 SEED(CARDINAL(Windows.GetCurrentTime()));
  768. ***** ^ not supported yet
  769. ***** ^ undeclared identifier
  770. ***** ^ not supported yet
  771. ***** ^ not supported yet
  772. 465 (*%E *)
  773. 466
  774. 467 (*%F _WINDOWS *)
  775. 468 (*%T _OS2 *)
  776. 469 VAR d : DATETIME;
  777. 470 r : CARDINAL;
  778. 471 BEGIN
  779. 472 r := GetDateTime(d);
  780. 473 SEED(CARDINAL(d.hundredths)*CARDINAL(d.seconds));
  781. 474 (*%E *)
  782. 475 (*%F _OS2 *)
  783. 476 VAR R : SYSTEM.Registers;
  784. 477 BEGIN
  785. 478 WITH R DO
  786. 479 AH := 2CH;
  787. 480 Lib.Dos(R);
  788. 481 SEED(DX+CX);
  789. 482 END;
  790. 483 (*%E *)
  791. 484 (*%E *)
  792. 485 END RANDOMIZE;
  793. ***** ^ not supported yet
  794. 486
  795. 487 PROCEDURE RAND(): REAL;
  796. 488 VAR
  797. 489 x:RECORD low,high:CARDINAL END;
  798. ***** ^ not supported yet
  799. 490 BEGIN
  800. 491 x.low := RANDOM(0);
  801. ***** ^ not supported yet
  802. ***** ^ not supported yet
  803. ***** ^ not supported yet
  804. ***** ^ not supported yet
  805. 492 x.high := RANDOM(0);
  806. ***** ^ not supported yet
  807. ***** ^ not supported yet
  808. ***** ^ not supported yet
  809. ***** ^ not supported yet
  810. 493 RETURN REAL(LONGCARD(x))/(REAL(MAX(LONGCARD))+1.1); (* NB Temp Fix *)
  811. ***** ^ undeclared identifier
  812. ***** ^ not supported yet
  813. ***** ^ undeclared identifier
  814. ***** ^ undeclared identifier
  815. 494 END RAND;
  816. ***** ^ not supported yet
  817. 495
  818. 496
  819. 497 PROCEDURE ParamStr(VAR S: ARRAY OF CHAR; N: CARDINAL);
  820. ***** ^ not supported yet
  821. 498 BEGIN
  822. 499 IF N >= CoreMain._argc THEN
  823. ***** ^ not supported yet
  824. ***** ^ not supported yet
  825. 500 S[0] := 0C;
  826. ***** ^ not supported yet
  827. ***** ^ not supported yet
  828. 501 ELSE
  829. 502 Str.Copy(S,CoreMain._argv[N]^);
  830. ***** ^ not supported yet
  831. ***** ^ not supported yet
  832. ***** ^ not supported yet
  833. ***** ^ not supported yet
  834. ***** ^ not supported yet
  835. ***** ^ not supported yet
  836. 503 END;
  837. 504 END ParamStr;
  838. ***** ^ not supported yet
  839. 505
  840. 506 PROCEDURE ParamCount() : CARDINAL;
  841. 507
  842. 508 BEGIN
  843. 509 RETURN CoreMain._argc-1;
  844. ***** ^ not supported yet
  845. ***** ^ not supported yet
  846. 510 END ParamCount;
  847. ***** ^ not supported yet
  848. 511
  849. 512 (*%T _OS2 *)
  850. 513 VAR
  851. 514 nullp[0:0] : SIGHANDLER;
  852. ***** ^ not supported yet
  853. ***** ^ not supported yet
  854. 515 nullac[0:0] : CARDINAL;
  855. ***** ^ not supported yet
  856. ***** ^ not supported yet
  857. 516
  858. 517 PROCEDURE EnableBreakCheck;
  859. 518 BEGIN
  860. 519 SetSigHandler(SIGHANDLER(0),nullp,nullac,0,SIG_CTRLC);
  861. ***** ^ not supported yet
  862. ***** ^ not supported yet
  863. ***** ^ not supported yet
  864. ***** ^ not supported yet
  865. ***** ^ not supported yet
  866. 520 SetSigHandler(SIGHANDLER(0),nullp,nullac,0,SIG_CTRLBREAK);
  867. ***** ^ not supported yet
  868. ***** ^ not supported yet
  869. ***** ^ not supported yet
  870. ***** ^ not supported yet
  871. ***** ^ not supported yet
  872. 521 END EnableBreakCheck;
  873. ***** ^ not supported yet
  874. 522
  875. 523 PROCEDURE DisableBreakCheck;
  876. 524 BEGIN
  877. 525 SetSigHandler(SIGHANDLER(0),nullp,nullac,1,SIG_CTRLC);
  878. ***** ^ not supported yet
  879. ***** ^ not supported yet
  880. ***** ^ not supported yet
  881. ***** ^ not supported yet
  882. ***** ^ not supported yet
  883. 526 SetSigHandler(SIGHANDLER(0),nullp,nullac,1,SIG_CTRLBREAK);
  884. ***** ^ not supported yet
  885. ***** ^ not supported yet
  886. ***** ^ not supported yet
  887. ***** ^ not supported yet
  888. ***** ^ not supported yet
  889. 527 END DisableBreakCheck;
  890. ***** ^ not supported yet
  891. 528
  892. 529 PROCEDURE Delay(t:CARDINAL);
  893. 530 BEGIN
  894. 531 Sleep(LONGCARD(t));
  895. ***** ^ not supported yet
  896. ***** ^ undeclared identifier
  897. ***** ^ not supported yet
  898. 532 END Delay;
  899. ***** ^ not supported yet
  900. 533
  901. 534 PROCEDURE Speaker(FreqHz,TimeMs: CARDINAL);
  902. 535 BEGIN
  903. 536 Beep(FreqHz,TimeMs);
  904. ***** ^ not supported yet
  905. ***** ^ not supported yet
  906. 537 END Speaker;
  907. ***** ^ not supported yet
  908. 538
  909. 539 (*%E *)
  910. 540
  911. 541 CONST
  912. 542 MErr = 'Math Error : ';
  913. ***** ^ not supported yet
  914. 543
  915. 544 PROCEDURE MathError(R: LONGREAL; STR: ARRAY OF CHAR);
  916. ***** ^ not supported yet
  917. 545 VAR str : ARRAY[0..40] OF CHAR;
  918. ***** ^ not supported yet
  919. ***** ^ not supported yet
  920. 546 BEGIN
  921. 547 Str.Concat ( str,MErr,STR );
  922. ***** ^ not supported yet
  923. ***** ^ not supported yet
  924. ***** ^ not supported yet
  925. ***** ^ not supported yet
  926. ***** ^ not supported yet
  927. 548 RunTimeError(CoreSig._FatalErrorPos(), 0D0H, str);
  928. ***** ^ undeclared identifier
  929. ***** ^ not supported yet
  930. ***** ^ not supported yet
  931. ***** ^ not supported yet
  932. ***** ^ not supported yet
  933. 549 END MathError;
  934. ***** ^ not supported yet
  935. 550
  936. 551 PROCEDURE MathError2(R1,R2: LONGREAL; STR: ARRAY OF CHAR);
  937. ***** ^ not supported yet
  938. 552 VAR str : ARRAY[0..40] OF CHAR;
  939. ***** ^ not supported yet
  940. ***** ^ not supported yet
  941. 553 BEGIN
  942. 554 RunTimeError(CoreSig._FatalErrorPos(), 0D1H, str);
  943. ***** ^ undeclared identifier
  944. ***** ^ not supported yet
  945. ***** ^ not supported yet
  946. ***** ^ not supported yet
  947. ***** ^ not supported yet
  948. 555 END MathError2;
  949. ***** ^ not supported yet
  950. 556
  951. 557 (*%F _OS2 *)
  952. 558 PROCEDURE EnableBreakCheck;
  953. 559 BEGIN
  954. 560 InternalEnableBreakCheck;
  955. 561 END EnableBreakCheck;
  956. 562
  957. 563
  958. 564 PROCEDURE DisableBreakCheck;
  959. 565 BEGIN
  960. 566 InternalDisableBreakCheck;
  961. 567 END DisableBreakCheck;
  962. 568
  963. 569 PROCEDURE Environment(N: CARDINAL): CommandType;
  964. 570
  965. 571 TYPE
  966. 572 (*# save *)
  967. 573 (*# data(near_ptr=>off) *)
  968. 574 CardPtr = POINTER TO CARDINAL;
  969. 575 (*# restore *)
  970. 576 VAR
  971. 577 Ret: CommandType;
  972. 578 c: CHAR;
  973. 579 BEGIN
  974. 580 Ret := [[PSP: 2CH CardPtr]^: 0];
  975. 581 WHILE N # 0 DO
  976. 582 IF Ret^[0] = 0C THEN
  977. 583 RETURN FarNIL;
  978. 584 END;
  979. 585 REPEAT
  980. 586 c := Ret^[0];
  981. 587 INC(CARDINAL(Ret));
  982. 588 UNTIL c = 0C;
  983. 589 DEC(N);
  984. 590 END;
  985. 591 RETURN Ret;
  986. 592 END Environment;
  987. 593
  988. 594
  989. 595 PROCEDURE Delay(Time: CARDINAL);
  990. 596 BEGIN
  991. 597 InternalDelay(Time);
  992. 598 END Delay;
  993. 599
  994. 600 PROCEDURE Speaker(FreqHz,TimeMs: CARDINAL);
  995. 601 BEGIN
  996. 602 Sound(FreqHz);
  997. 603 Delay(TimeMs);
  998. 604 NoSound;
  999. 605 END Speaker;
  1000. 606
  1001. 607 PROCEDURE Exec(Path:ARRAY OF CHAR;Command:ARRAY OF CHAR;Env:ExecEnvPtr):CARDINAL;
  1002. 608 VAR
  1003. 609 Params: ARRAY [0..2] OF ADDRESS;
  1004. 610 BEGIN
  1005. 611 Params[0] := ADR(Path);
  1006. 612 Params[1] := ADR(Command);
  1007. 613 Params[2] := NIL;
  1008. 614 RETURN SPAWN._beget(Path,ADR(Params),Env,CARDINAL(ExecSearchPath));
  1009. 615 END Exec;
  1010. 616
  1011. 617 PROCEDURE ExecCmd(command:ARRAY OF CHAR):CARDINAL;
  1012. 618 VAR
  1013. 619 Path : ARRAY [0..80] OF CHAR;
  1014. 620 ComLine : ARRAY [0..128] OF CHAR;
  1015. 621 p, n : CARDINAL;
  1016. 622 PBlock : CoreMain.ParamBlock;
  1017. 623 BEGIN
  1018. 624 (*%F _ENV*)
  1019. 625 IF CoreMain._fmemsetup THEN
  1020. 626 IF CoreMain._shr_mem() # 0 THEN
  1021. 627 RunTimeError(CoreSig._FatalErrorPos(),4AH,command);
  1022. 628 END; (*IF*)
  1023. 629 END; (*IF*)
  1024. 630 (*%E*)
  1025. 631 EnvironmentFind('COMSPEC',Path);
  1026. 632 IF Path[0] = 0C THEN
  1027. 633 Str.Copy(Path,"\COMMAND.COM");
  1028. 634 END; (*IF*)
  1029. 635 ComLine[1] := '/'; (* construct command line *)
  1030. 636 ComLine[2] := 'C';
  1031. 637 ComLine[3] := ' ';
  1032. 638 n := 4;
  1033. 639 p := 0;
  1034. 640 WHILE command[p] # 0C DO
  1035. 641 ComLine[n] := command[p];
  1036. 642 IF n > 127 THEN
  1037. 643 RunTimeError(CoreSig._FatalErrorPos(),4BH,command);
  1038. 644 END; (*IF*)
  1039. 645 INC(p);
  1040. 646 INC(n);
  1041. 647 END; (*WHILE*)
  1042. 648 ComLine[n] := CHR(0DH);
  1043. 649 ComLine[0] := CHR(n);
  1044. 650 PBlock.Com := FarADR(ComLine);
  1045. 651 PBlock.Env := 0;
  1046. 652 IF CoreMain._exec(Path,PBlock) # 0 THEN
  1047. 653 RunTimeError(CoreSig._FatalErrorPos(),4CH,command);
  1048. 654 END; (*IF*)
  1049. 655 IF (CoreMain._fmemsetup) THEN
  1050. 656 CoreMain._res_mem();
  1051. 657 END; (*IF*)
  1052. 658 RETURN CoreMain._get_retcode();
  1053. 659 END ExecCmd;
  1054. 660
  1055. 661
  1056. 662 PROCEDURE GetTime ( VAR Hrs,Mins,Secs,Hsecs : CARDINAL );
  1057. 663 VAR
  1058. 664 R : SYSTEM.Registers;
  1059. 665 BEGIN
  1060. 666 WITH R DO
  1061. 667 AH := 2CH;
  1062. 668 (*%T _WINDOWS *)
  1063. 669 DS := Seg(R);
  1064. 670 ES := Seg(R);
  1065. 671 (*%E *)
  1066. 672 Lib.Dos(R);
  1067. 673 Hrs := CARDINAL(CH);
  1068. 674 Mins := CARDINAL(CL);
  1069. 675 Secs := CARDINAL(DH);
  1070. 676 Hsecs := CARDINAL(DL);
  1071. 677 END;
  1072. 678 END GetTime;
  1073. 679
  1074. 680 PROCEDURE SetTime(Hrs,Mins,Secs,Hsecs:CARDINAL):BOOLEAN;
  1075. 681 VAR
  1076. 682 R : SYSTEM.Registers;
  1077. 683 BEGIN
  1078. 684 WITH R DO
  1079. 685 AH := 2DH;
  1080. 686 CH := SHORTCARD(Hrs);
  1081. 687 CL := SHORTCARD(Mins);
  1082. 688 DH := SHORTCARD(Secs);
  1083. 689 DL := SHORTCARD(Hsecs);
  1084. 690 Lib.Dos(R);
  1085. 691 RETURN AX=0;
  1086. 692 END; (*WITH*)
  1087. 693 END SetTime;
  1088. 694
  1089. 695 PROCEDURE GetDate(VAR Year,Month,Day : CARDINAL;
  1090. 696 VAR DayOfWeek : DayType );
  1091. 697 VAR
  1092. 698 R : SYSTEM.Registers;
  1093. 699 BEGIN
  1094. 700 WITH R DO
  1095. 701 AH := 2AH;
  1096. 702 (*%T _WINDOWS *)
  1097. 703 DS := Seg(R);
  1098. 704 ES := Seg(R);
  1099. 705 (*%E *)
  1100. 706 Lib.Dos(R);
  1101. 707 Year := CX;
  1102. 708 Month := CARDINAL(DH);
  1103. 709 Day := CARDINAL(DL);
  1104. 710 DayOfWeek := DayType(AL);
  1105. 711 END;
  1106. 712 END GetDate;
  1107. 713
  1108. 714 PROCEDURE SetDate(Year,Month,Day:CARDINAL):BOOLEAN;
  1109. 715 VAR
  1110. 716 R : SYSTEM.Registers;
  1111. 717 BEGIN
  1112. 718 WITH R DO
  1113. 719 AX := 2B00H;
  1114. 720 CX := Year;
  1115. 721 DH := SHORTCARD(Month);
  1116. 722 DL := SHORTCARD(Day);
  1117. 723 (*%T _WINDOWS *)
  1118. 724 DS := Seg(R);
  1119. 725 ES := Seg(R);
  1120. 726 (*%E *)
  1121. 727 Lib.Dos(R);
  1122. 728 RETURN AX=0;
  1123. 729 END; (*WITH*)
  1124. 730 END SetDate;
  1125. 731
  1126. 732 TYPE
  1127. 733 ErrStr = ARRAY [0..79] OF CHAR;
  1128. 734 ErrStrPtr = POINTER TO ErrStr;
  1129. 735 LA3 = ARRAY [0..2] OF SHORTCARD;
  1130. 736 CONST
  1131. 737 Ln = LA3(0DH, 0AH, 0);
  1132. 738
  1133. 739
  1134. 740 PROCEDURE WriteErrorString(Err: ErrStrPtr);
  1135. 741
  1136. 742 VAR
  1137. 743 R: SYSTEM.Registers;
  1138. 744 BEGIN
  1139. 745 R.AH := 40H;
  1140. 746 R.BX := 1;
  1141. 747 R.CX := Str.Length(Err^);
  1142. 748 R.DX := Ofs(Err^);
  1143. 749 R.DS := Seg(Err^);
  1144. 750 Dos(R);
  1145. 751 END WriteErrorString;
  1146. 752 (*%E *)
  1147. 753
  1148. 754 (*%T _OS2 *)
  1149. 755 VAR
  1150. 756 nullstr[0:0] : ARRAY[0..3] OF CHAR;
  1151. ***** ^ not supported yet
  1152. ***** ^ not supported yet
  1153. ***** ^ not supported yet
  1154. ***** ^ not supported yet
  1155. 757
  1156. 758 PROCEDURE Execute (Name : ARRAY OF CHAR; (* full name of program *)
  1157. ***** ^ not supported yet
  1158. 759 CommandLine : ARRAY OF CHAR; (* command line for program *)
  1159. ***** ^ not supported yet
  1160. 760 StoreAddr : FarADDRESS; (* storage to execute in, MSDOS only *)
  1161. ***** ^ undeclared identifier
  1162. 761 StoreLen : CARDINAL (* length of store paragraphs, MSDOS only *)
  1163. 762 ) : CARDINAL; (* DOS reply (0=OK) *)
  1164. 763 CONST
  1165. 764 max = 299;
  1166. 765 VAR
  1167. 766 retcode:RESULTCODES; ObjNameBuf:ARRAY [0..49] OF CHAR;
  1168. ***** ^ not supported yet
  1169. ***** ^ not supported yet
  1170. 767 i,j:CARDINAL;
  1171. 768 cline:ARRAY [0..max] OF CHAR;
  1172. ***** ^ not supported yet
  1173. ***** ^ not supported yet
  1174. 769 Ret: CARDINAL;
  1175. 770 BEGIN
  1176. 771 Str.Concat(cline,Name,' ');
  1177. ***** ^ not supported yet
  1178. ***** ^ not supported yet
  1179. ***** ^ not supported yet
  1180. ***** ^ not supported yet
  1181. ***** ^ not supported yet
  1182. 772 i := Str.Length(cline)-1;
  1183. ***** ^ not supported yet
  1184. ***** ^ not supported yet
  1185. ***** ^ not supported yet
  1186. 773 Str.Append(cline,CommandLine);
  1187. ***** ^ not supported yet
  1188. ***** ^ not supported yet
  1189. ***** ^ not supported yet
  1190. ***** ^ not supported yet
  1191. 774 j := Str.Length(cline);
  1192. ***** ^ not supported yet
  1193. ***** ^ not supported yet
  1194. ***** ^ not supported yet
  1195. 775 IF j<max THEN cline[j+1] := 0C END;
  1196. ***** ^ not supported yet
  1197. ***** ^ not supported yet
  1198. 776 cline[i]:= 0C;
  1199. ***** ^ not supported yet
  1200. ***** ^ not supported yet
  1201. 777 CoreMath._FloatExecSave;
  1202. ***** ^ not supported yet
  1203. ***** ^ not supported yet
  1204. 778 Ret := ExecPgm(ObjNameBuf,SIZE(ObjNameBuf),EXEC_SYNC,cline,
  1205. ***** ^ not supported yet
  1206. ***** ^ not supported yet
  1207. ***** ^ undeclared identifier
  1208. ***** ^ not supported yet
  1209. ***** ^ not supported yet
  1210. ***** ^ not supported yet
  1211. 779 nullstr,retcode,Name);
  1212. ***** ^ not supported yet
  1213. ***** ^ not supported yet
  1214. ***** ^ not supported yet
  1215. 780 CoreMath._FloatExecRestore;
  1216. ***** ^ not supported yet
  1217. ***** ^ not supported yet
  1218. 781 RETURN Ret;
  1219. 782 END Execute;
  1220. ***** ^ not supported yet
  1221. 783
  1222. 784 PROCEDURE OSErrorMessage ( N : CARDINAL; VAR S : ARRAY OF CHAR );
  1223. ***** ^ not supported yet
  1224. 785 CONST
  1225. 786 msgpath = 'OSO001.MSG';
  1226. ***** ^ not supported yet
  1227. 787 VAR
  1228. 788 dummy,len : CARDINAL;
  1229. 789 msg : ARRAY[0..255] OF CHAR;
  1230. ***** ^ not supported yet
  1231. ***** ^ not supported yet
  1232. 790 b : BOOLEAN;
  1233. 791 i,r : CARDINAL;
  1234. 792 path : ARRAY[0..64] OF CHAR;
  1235. ***** ^ not supported yet
  1236. ***** ^ not supported yet
  1237. 793 BEGIN
  1238. 794 IF ProtectedMode() THEN
  1239. ***** ^ not supported yet
  1240. ***** ^ not supported yet
  1241. 795 r := SearchPath(3,'DPATH',msgpath,FarADR(path),SIZE(path));
  1242. ***** ^ not supported yet
  1243. ***** ^ not supported yet
  1244. ***** ^ not supported yet
  1245. ***** ^ undeclared identifier
  1246. ***** ^ not supported yet
  1247. ***** ^ undeclared identifier
  1248. ***** ^ not supported yet
  1249. 796 ELSE
  1250. 797 Str.Copy(path,msgpath);
  1251. ***** ^ not supported yet
  1252. ***** ^ not supported yet
  1253. ***** ^ not supported yet
  1254. ***** ^ not supported yet
  1255. 798 r := 0;
  1256. 799 END;
  1257. 800 IF (r=0) AND (GetMessage(FarADR(dummy),0,msg,SIZE(msg)-1,N,path,len)=0) THEN
  1258. ***** ^ not supported yet
  1259. ***** ^ undeclared identifier
  1260. ***** ^ not supported yet
  1261. ***** ^ not supported yet
  1262. ***** ^ undeclared identifier
  1263. ***** ^ not supported yet
  1264. ***** ^ not supported yet
  1265. ***** ^ not supported yet
  1266. 801 IF len<SIZE(msg) THEN msg[len] := 0C END;
  1267. ***** ^ undeclared identifier
  1268. ***** ^ not supported yet
  1269. ***** ^ not supported yet
  1270. ***** ^ not supported yet
  1271. 802 Str.Concat(S,'Error: ',msg);
  1272. ***** ^ not supported yet
  1273. ***** ^ not supported yet
  1274. ***** ^ not supported yet
  1275. ***** ^ not supported yet
  1276. ***** ^ not supported yet
  1277. 803 ELSE
  1278. 804 i := 5;
  1279. 805 msg[i] := 0C;
  1280. ***** ^ not supported yet
  1281. ***** ^ not supported yet
  1282. 806 REPEAT
  1283. 807 DEC(i);
  1284. ***** ^ undeclared identifier
  1285. ***** ^ not supported yet
  1286. 808 msg[i] := CHR(ORD('0')+(N MOD 10));
  1287. ***** ^ not supported yet
  1288. ***** ^ not supported yet
  1289. ***** ^ undeclared identifier
  1290. ***** ^ undeclared identifier
  1291. ***** ^ not supported yet
  1292. ***** ^ not supported yet
  1293. 809 N := N DIV 10;
  1294. 810 UNTIL (N=0)OR(i=0);
  1295. 811 WHILE (i>0) DO DEC(i); msg[i] := ' ' END;
  1296. ***** ^ undeclared identifier
  1297. ***** ^ not supported yet
  1298. ***** ^ not supported yet
  1299. ***** ^ not supported yet
  1300. 812 Str.Concat(S,'OS/2 ERROR ',msg);
  1301. ***** ^ not supported yet
  1302. ***** ^ not supported yet
  1303. ***** ^ not supported yet
  1304. ***** ^ not supported yet
  1305. ***** ^ not supported yet
  1306. 813 END;
  1307. 814 END OSErrorMessage;
  1308. ***** ^ not supported yet
  1309. 815
  1310. 816 PROCEDURE OSFatalError( S : ARRAY OF CHAR;
  1311. ***** ^ not supported yet
  1312. 817 N : CARDINAL );
  1313. 818 VAR
  1314. 819 msg : ARRAY[0..255] OF CHAR;
  1315. ***** ^ not supported yet
  1316. ***** ^ not supported yet
  1317. 820 BEGIN
  1318. 821 IF N=0 THEN RETURN END;
  1319. 822 OSErrorMessage(N,msg);
  1320. ***** ^ not supported yet
  1321. ***** ^ not supported yet
  1322. 823 Str.Concat(msg,' ',msg);
  1323. ***** ^ not supported yet
  1324. ***** ^ not supported yet
  1325. ***** ^ not supported yet
  1326. ***** ^ not supported yet
  1327. 824 Str.Concat(msg,S,msg);
  1328. ***** ^ not supported yet
  1329. ***** ^ not supported yet
  1330. ***** ^ not supported yet
  1331. ***** ^ not supported yet
  1332. ***** ^ not supported yet
  1333. 825 RunTimeError(CoreSig._FatalErrorPos(), 0D2H, msg);
  1334. ***** ^ undeclared identifier
  1335. ***** ^ not supported yet
  1336. ***** ^ not supported yet
  1337. ***** ^ not supported yet
  1338. ***** ^ not supported yet
  1339. 826 END OSFatalError;
  1340. ***** ^ not supported yet
  1341. 827
  1342. 828 PROCEDURE GetTime ( VAR Hrs,Mins,Secs,Hsecs : CARDINAL );
  1343. 829
  1344. 830 VAR d : DATETIME;
  1345. 831 r : CARDINAL;
  1346. 832 BEGIN
  1347. 833 r := GetDateTime(d);
  1348. ***** ^ not supported yet
  1349. ***** ^ not supported yet
  1350. 834 Hrs := CARDINAL(d.hours);
  1351. ***** ^ not supported yet
  1352. ***** ^ not supported yet
  1353. 835 Mins := CARDINAL(d.minutes);
  1354. ***** ^ not supported yet
  1355. ***** ^ not supported yet
  1356. 836 Secs := CARDINAL(d.seconds);
  1357. ***** ^ not supported yet
  1358. ***** ^ not supported yet
  1359. 837 Hsecs := CARDINAL(d.hundredths);
  1360. ***** ^ not supported yet
  1361. ***** ^ not supported yet
  1362. 838 END GetTime;
  1363. ***** ^ not supported yet
  1364. 839
  1365. 840 PROCEDURE SetTime (Hrs,Mins,Secs,Hsecs : CARDINAL ): BOOLEAN;
  1366. 841
  1367. 842 VAR d : DATETIME;
  1368. 843 r : CARDINAL;
  1369. 844 BEGIN
  1370. 845 r := GetDateTime(d);
  1371. ***** ^ not supported yet
  1372. ***** ^ not supported yet
  1373. 846 d.hours:=SHORTCARD(Hrs);
  1374. ***** ^ not supported yet
  1375. ***** ^ not supported yet
  1376. ***** ^ not supported yet
  1377. 847 d.minutes:=SHORTCARD(Mins);
  1378. ***** ^ not supported yet
  1379. ***** ^ not supported yet
  1380. ***** ^ not supported yet
  1381. 848 d.seconds:=SHORTCARD(Secs);
  1382. ***** ^ not supported yet
  1383. ***** ^ not supported yet
  1384. ***** ^ not supported yet
  1385. 849 d.hundredths:=SHORTCARD(Hsecs);
  1386. ***** ^ not supported yet
  1387. ***** ^ not supported yet
  1388. ***** ^ not supported yet
  1389. 850 r := SetDateTime(d);
  1390. ***** ^ not supported yet
  1391. ***** ^ not supported yet
  1392. 851 RETURN BOOLEAN(r);
  1393. ***** ^ not supported yet
  1394. 852 END SetTime;
  1395. ***** ^ not supported yet
  1396. 853
  1397. 854 PROCEDURE GetDate ( VAR Year,Month,Day : CARDINAL;
  1398. 855 VAR DayOfWeek : DayType );
  1399. ***** ^ undeclared identifier
  1400. 856
  1401. 857 VAR d : DATETIME;
  1402. 858 r : CARDINAL;
  1403. 859 BEGIN
  1404. 860 r := GetDateTime(d);
  1405. ***** ^ not supported yet
  1406. ***** ^ not supported yet
  1407. 861 Year := CARDINAL(d.year);
  1408. ***** ^ not supported yet
  1409. ***** ^ not supported yet
  1410. 862 Month := CARDINAL(d.month);
  1411. ***** ^ not supported yet
  1412. ***** ^ not supported yet
  1413. 863 Day := CARDINAL(d.day);
  1414. ***** ^ not supported yet
  1415. ***** ^ not supported yet
  1416. 864 DayOfWeek := DayType(d.weekday);
  1417. ***** ^ not supported yet
  1418. ***** ^ undeclared identifier
  1419. ***** ^ not supported yet
  1420. ***** ^ not supported yet
  1421. 865 END GetDate;
  1422. ***** ^ not supported yet
  1423. 866
  1424. 867 PROCEDURE SetDate (Year,Month,Day : CARDINAL): BOOLEAN;
  1425. 868
  1426. 869 VAR d : DATETIME;
  1427. 870 r : CARDINAL;
  1428. 871 BEGIN
  1429. 872 r := GetDateTime(d);
  1430. ***** ^ not supported yet
  1431. ***** ^ not supported yet
  1432. 873 d.year:=CARDINAL(Year);
  1433. ***** ^ not supported yet
  1434. ***** ^ not supported yet
  1435. ***** ^ not supported yet
  1436. 874 d.month:=SHORTCARD(Month);
  1437. ***** ^ not supported yet
  1438. ***** ^ not supported yet
  1439. ***** ^ not supported yet
  1440. 875 d.day:=SHORTCARD(Day);
  1441. ***** ^ not supported yet
  1442. ***** ^ not supported yet
  1443. ***** ^ not supported yet
  1444. 876 r := SetDateTime(d);
  1445. ***** ^ not supported yet
  1446. ***** ^ not supported yet
  1447. 877 RETURN BOOLEAN(r);
  1448. ***** ^ not supported yet
  1449. 878 END SetDate;
  1450. ***** ^ not supported yet
  1451. 879
  1452. 880
  1453. 881 TYPE
  1454. 882 ErrStr = ARRAY [0..79] OF CHAR;
  1455. ***** ^ not supported yet
  1456. ***** ^ not supported yet
  1457. 883 ErrStrPtr = POINTER TO ErrStr;
  1458. ***** ^ not supported yet
  1459. 884 LA3 = ARRAY [0..2] OF SHORTCARD;
  1460. ***** ^ not supported yet
  1461. ***** ^ not supported yet
  1462. 885 CONST
  1463. 886 Ln = LA3(0DH, 0AH, 0);
  1464. ***** ^ not supported yet
  1465. 887
  1466. 888 PROCEDURE WriteErrorString(Err: ErrStrPtr);
  1467. 889
  1468. 890 VAR
  1469. 891 NumWrit: CARDINAL;
  1470. 892 BEGIN
  1471. 893 IF Write(1, FarADR(Err^), Str.Length(Err^)+1, NumWrit) = 0 THEN END;
  1472. ***** ^ not supported yet
  1473. ***** ^ undeclared identifier
  1474. ***** ^ not supported yet
  1475. ***** ^ not supported yet
  1476. ***** ^ not supported yet
  1477. ***** ^ not supported yet
  1478. ***** ^ not supported yet
  1479. 894 END WriteErrorString;
  1480. ***** ^ not supported yet
  1481. 895 (*%E *)
  1482. 896
  1483. 897 PROCEDURE FatalError(S : ARRAY OF CHAR);
  1484. ***** ^ not supported yet
  1485. 898
  1486. 899 BEGIN
  1487. 900 WriteErrorString(ADR(S));
  1488. ***** ^ not supported yet
  1489. ***** ^ undeclared identifier
  1490. ***** ^ not supported yet
  1491. 901 WriteErrorString(ADR(Ln));
  1492. ***** ^ not supported yet
  1493. ***** ^ undeclared identifier
  1494. ***** ^ not supported yet
  1495. 902 HALT;
  1496. ***** ^ undeclared identifier
  1497. 903 END FatalError;
  1498. ***** ^ not supported yet
  1499. 904
  1500. 905 PROCEDURE WrDosError ( ErrorNo : SHORTCARD );
  1501. 906
  1502. 907 VAR
  1503. 908 EStr: ErrStrPtr;
  1504. ***** ^ not supported yet
  1505. 909 Temp: ARRAY [0..9] OF CHAR;
  1506. ***** ^ not supported yet
  1507. ***** ^ not supported yet
  1508. 910 OK: BOOLEAN;
  1509. 911 BEGIN
  1510. 912 CASE ErrorNo OF
  1511. 913 0 : EStr := ADR('OK');
  1512. ***** ^ not supported yet
  1513. ***** ^ undeclared identifier
  1514. ***** ^ not supported yet
  1515. 914 | 1 : EStr := ADR('Invalid function number');
  1516. ***** ^ not supported yet
  1517. ***** ^ undeclared identifier
  1518. ***** ^ not supported yet
  1519. 915 | 2 : EStr := ADR('File not found');
  1520. ***** ^ not supported yet
  1521. ***** ^ undeclared identifier
  1522. ***** ^ not supported yet
  1523. 916 | 3 : EStr := ADR('Path not found');
  1524. ***** ^ not supported yet
  1525. ***** ^ undeclared identifier
  1526. ***** ^ not supported yet
  1527. 917 | 4 : EStr := ADR('Too many open files (no handles left)');
  1528. ***** ^ not supported yet
  1529. ***** ^ undeclared identifier
  1530. ***** ^ not supported yet
  1531. 918 | 5 : EStr := ADR('Access denied');
  1532. ***** ^ not supported yet
  1533. ***** ^ undeclared identifier
  1534. ***** ^ not supported yet
  1535. 919 | 6 : EStr := ADR('Invalid handle');
  1536. ***** ^ not supported yet
  1537. ***** ^ undeclared identifier
  1538. ***** ^ not supported yet
  1539. 920 | 7 : EStr := ADR('Memory control blocks destroyed');
  1540. ***** ^ not supported yet
  1541. ***** ^ undeclared identifier
  1542. ***** ^ not supported yet
  1543. 921 | 8 : EStr := ADR('Insufficient memory');
  1544. ***** ^ not supported yet
  1545. ***** ^ undeclared identifier
  1546. ***** ^ not supported yet
  1547. 922 | 9 : EStr := ADR('Invalid memory block address');
  1548. ***** ^ not supported yet
  1549. ***** ^ undeclared identifier
  1550. ***** ^ not supported yet
  1551. 923 | 10 : EStr := ADR('Invalid environment');
  1552. ***** ^ not supported yet
  1553. ***** ^ undeclared identifier
  1554. ***** ^ not supported yet
  1555. 924 | 11 : EStr := ADR('Invalid format');
  1556. ***** ^ not supported yet
  1557. ***** ^ undeclared identifier
  1558. ***** ^ not supported yet
  1559. 925 | 12 : EStr := ADR('Invalid access code');
  1560. ***** ^ not supported yet
  1561. ***** ^ undeclared identifier
  1562. ***** ^ not supported yet
  1563. 926 | 13 : EStr := ADR('Invalid data');
  1564. ***** ^ not supported yet
  1565. ***** ^ undeclared identifier
  1566. ***** ^ not supported yet
  1567. 927 (*14 : Reserved *)
  1568. 928 | 15 : EStr := ADR('Invalid drive was specified');
  1569. ***** ^ not supported yet
  1570. ***** ^ undeclared identifier
  1571. ***** ^ not supported yet
  1572. 929 | 16 : EStr := ADR('Attempt to remove the current directory');
  1573. ***** ^ not supported yet
  1574. ***** ^ undeclared identifier
  1575. ***** ^ not supported yet
  1576. 930 | 17 : EStr := ADR('Not same device');
  1577. ***** ^ not supported yet
  1578. ***** ^ undeclared identifier
  1579. ***** ^ not supported yet
  1580. 931 | 18 : EStr := ADR('No more files');
  1581. ***** ^ not supported yet
  1582. ***** ^ undeclared identifier
  1583. ***** ^ not supported yet
  1584. 932 | 19 : EStr := ADR('Attempt to write on write-protected diskette');
  1585. ***** ^ not supported yet
  1586. ***** ^ undeclared identifier
  1587. ***** ^ not supported yet
  1588. 933 | 20 : EStr := ADR('Unknown unit');
  1589. ***** ^ not supported yet
  1590. ***** ^ undeclared identifier
  1591. ***** ^ not supported yet
  1592. 934 | 21 : EStr := ADR('Drive not ready');
  1593. ***** ^ not supported yet
  1594. ***** ^ undeclared identifier
  1595. ***** ^ not supported yet
  1596. 935 | 22 : EStr := ADR('Unknown command');
  1597. ***** ^ not supported yet
  1598. ***** ^ undeclared identifier
  1599. ***** ^ not supported yet
  1600. 936 | 23 : EStr := ADR('Data error (CRC)');
  1601. ***** ^ not supported yet
  1602. ***** ^ undeclared identifier
  1603. ***** ^ not supported yet
  1604. 937 | 24 : EStr := ADR('Bad request structure length');
  1605. ***** ^ not supported yet
  1606. ***** ^ undeclared identifier
  1607. ***** ^ not supported yet
  1608. 938 | 25 : EStr := ADR('Seek error');
  1609. ***** ^ not supported yet
  1610. ***** ^ undeclared identifier
  1611. ***** ^ not supported yet
  1612. 939 | 26 : EStr := ADR('Unknown media type');
  1613. ***** ^ not supported yet
  1614. ***** ^ undeclared identifier
  1615. ***** ^ not supported yet
  1616. 940 | 27 : EStr := ADR('Sector not found');
  1617. ***** ^ not supported yet
  1618. ***** ^ undeclared identifier
  1619. ***** ^ not supported yet
  1620. 941 | 28 : EStr := ADR('Printer out of paper');
  1621. ***** ^ not supported yet
  1622. ***** ^ undeclared identifier
  1623. ***** ^ not supported yet
  1624. 942 | 29 : EStr := ADR('Write fault');
  1625. ***** ^ not supported yet
  1626. ***** ^ undeclared identifier
  1627. ***** ^ not supported yet
  1628. 943 | 30 : EStr := ADR('Read fault');
  1629. ***** ^ not supported yet
  1630. ***** ^ undeclared identifier
  1631. ***** ^ not supported yet
  1632. 944 | 31 : EStr := ADR('General failure');
  1633. ***** ^ not supported yet
  1634. ***** ^ undeclared identifier
  1635. ***** ^ not supported yet
  1636. 945 | 32 : EStr := ADR('Sharing Violation');
  1637. ***** ^ not supported yet
  1638. ***** ^ undeclared identifier
  1639. ***** ^ not supported yet
  1640. 946 | 33 : EStr := ADR('Lock Violation');
  1641. ***** ^ not supported yet
  1642. ***** ^ undeclared identifier
  1643. ***** ^ not supported yet
  1644. 947 | 34 : EStr := ADR('Invalid disk change');
  1645. ***** ^ not supported yet
  1646. ***** ^ undeclared identifier
  1647. ***** ^ not supported yet
  1648. 948 | 35 : EStr := ADR('FCB unavailable');
  1649. ***** ^ not supported yet
  1650. ***** ^ undeclared identifier
  1651. ***** ^ not supported yet
  1652. 949 (*36..79 : Reserved *)
  1653. 950 | 80 : EStr := ADR('File exists');
  1654. ***** ^ not supported yet
  1655. ***** ^ undeclared identifier
  1656. ***** ^ not supported yet
  1657. 951 (*81 : Reserved *)
  1658. 952 | 82 : EStr := ADR('Cannot Make');
  1659. ***** ^ not supported yet
  1660. ***** ^ undeclared identifier
  1661. ***** ^ not supported yet
  1662. 953 | 83 : EStr := ADR('Fail on INT 24');
  1663. ***** ^ not supported yet
  1664. ***** ^ undeclared identifier
  1665. ***** ^ not supported yet
  1666. 954 | 0F0H:EStr := ADR('Disk Full (write failed)'); (* JPI internal *)
  1667. ***** ^ not supported yet
  1668. ***** ^ undeclared identifier
  1669. ***** ^ not supported yet
  1670. 955 ELSE
  1671. 956 WriteErrorString(ADR('Unknown DOS Error : '));
  1672. ***** ^ not supported yet
  1673. ***** ^ undeclared identifier
  1674. ***** ^ not supported yet
  1675. 957 Str.CardToStr(LONGCARD(ErrorNo), Temp, 4, OK);
  1676. ***** ^ not supported yet
  1677. ***** ^ not supported yet
  1678. ***** ^ undeclared identifier
  1679. ***** ^ not supported yet
  1680. ***** ^ not supported yet
  1681. ***** ^ not supported yet
  1682. 958 WriteErrorString(ADR(Temp));
  1683. ***** ^ not supported yet
  1684. ***** ^ undeclared identifier
  1685. ***** ^ not supported yet
  1686. 959 RETURN;
  1687. 960 END;
  1688. 961 WriteErrorString(EStr);
  1689. ***** ^ not supported yet
  1690. ***** ^ not supported yet
  1691. 962 WriteErrorString(ADR(Ln));
  1692. ***** ^ not supported yet
  1693. ***** ^ undeclared identifier
  1694. ***** ^ not supported yet
  1695. 963 END WrDosError;
  1696. ***** ^ not supported yet
  1697. 964
  1698. 965 (*%F _OS2 *)
  1699. 966 PROCEDURE OSErrorMessage ( N : CARDINAL; VAR S : ARRAY OF CHAR );
  1700. 967 VAR
  1701. 968 NS : ARRAY[0..5] OF CHAR;
  1702. 969 i : CARDINAL;
  1703. 970 EStr: POINTER TO ErrStr;
  1704. 971 BEGIN
  1705. 972 CASE N OF
  1706. 973 0 : EStr := ADR('OK');
  1707. 974 | 1 : EStr := ADR('Invalid function number');
  1708. 975 | 2 : EStr := ADR('File not found');
  1709. 976 | 3 : EStr := ADR('Path not found');
  1710. 977 | 4 : EStr := ADR('Too many open files (no handles left)');
  1711. 978 | 5 : EStr := ADR('Access denied');
  1712. 979 | 6 : EStr := ADR('Invalid handle');
  1713. 980 | 7 : EStr := ADR('Memory control blocks destroyed');
  1714. 981 | 8 : EStr := ADR('Insufficient memory');
  1715. 982 | 9 : EStr := ADR('Invalid memory block address');
  1716. 983 | 10 : EStr := ADR('Invalid environment');
  1717. 984 | 11 : EStr := ADR('Invalid format');
  1718. 985 | 12 : EStr := ADR('Invalid access code');
  1719. 986 | 13 : EStr := ADR('Invalid data');
  1720. 987 (*14 : Reserved *)
  1721. 988 | 15 : EStr := ADR('Invalid drive was specified');
  1722. 989 | 16 : EStr := ADR('Attempt to remove the current directory');
  1723. 990 | 17 : EStr := ADR('Not same device');
  1724. 991 | 18 : EStr := ADR('No more files');
  1725. 992 | 19 : EStr := ADR('Attempt to write on write-protected diskette');
  1726. 993 | 20 : EStr := ADR('Unknown unit');
  1727. 994 | 21 : EStr := ADR('Drive not ready');
  1728. 995 | 22 : EStr := ADR('Unknown command');
  1729. 996 | 23 : EStr := ADR('Data error (CRC)');
  1730. 997 | 24 : EStr := ADR('Bad request structure length');
  1731. 998 | 25 : EStr := ADR('Seek error');
  1732. 999 | 26 : EStr := ADR('Unknown media type');
  1733. 1000 | 27 : EStr := ADR('Sector not found');
  1734. 1001 | 28 : EStr := ADR('Printer out of paper');
  1735. 1002 | 29 : EStr := ADR('Write fault');
  1736. 1003 | 30 : EStr := ADR('Read fault');
  1737. 1004 | 31 : EStr := ADR('General failure');
  1738. 1005 | 32 : EStr := ADR('Sharing Violation');
  1739. 1006 | 33 : EStr := ADR('Lock Violation');
  1740. 1007 | 34 : EStr := ADR('Invalid disk change');
  1741. 1008 | 35 : EStr := ADR('FCB unavailable');
  1742. 1009 (*36..79 : Reserved *)
  1743. 1010 | 80 : EStr := ADR('File exists');
  1744. 1011 (*81 : Reserved *)
  1745. 1012 | 82 : EStr := ADR('Cannot Make');
  1746. 1013 | 83 : EStr := ADR('Fail on INT 24');
  1747. 1014 | 0F0H:EStr := ADR('Disk Full (write failed)'); (* JPI internal *)
  1748. 1015 ELSE
  1749. 1016 Str.Copy(S,'Unknown DOS Error : ');
  1750. 1017 NS := ' ';
  1751. 1018 i := 4;
  1752. 1019 REPEAT
  1753. 1020 NS[i] := CHR(48+N MOD 10);
  1754. 1021 DEC(i);
  1755. 1022 N := N DIV 10;
  1756. 1023 UNTIL N=0;
  1757. 1024 Str.Append(S,NS);
  1758. 1025 RETURN;
  1759. 1026 END;
  1760. 1027 Str.Copy(S, EStr^);
  1761. 1028 END OSErrorMessage;
  1762. 1029
  1763. 1030 PROCEDURE OSFatalError ( S : ARRAY OF CHAR; N : CARDINAL );
  1764. 1031 VAR
  1765. 1032 S2:ARRAY[0..127] OF CHAR;
  1766. 1033 BEGIN
  1767. 1034 OSErrorMessage(N,S2);
  1768. 1035 Str.Concat(S2,S,S2);
  1769. 1036 WriteErrorString(ADR(S2));
  1770. 1037 RunTimeError(CoreSig._FatalErrorPos(), 0D2H, S);
  1771. 1038 END OSFatalError;
  1772. 1039 (*%E *)
  1773. 1040
  1774. 1041 PROCEDURE SysErrno(): CARDINAL;
  1775. 1042
  1776. 1043 VAR
  1777. 1044 EP: CoreSig.ErrnoPtr;
  1778. ***** ^ not supported yet
  1779. 1045 BEGIN
  1780. 1046 EP:=CoreSig._errno__();
  1781. ***** ^ not supported yet
  1782. ***** ^ not supported yet
  1783. ***** ^ not supported yet
  1784. ***** ^ not supported yet
  1785. 1047 RETURN CARDINAL(EP^);
  1786. ***** ^ not supported yet
  1787. 1048 END SysErrno;
  1788. ***** ^ not supported yet
  1789. 1049
  1790. 1050 PROCEDURE RunTimeErrorHandler(ErrAdd: LONGCARD; Code: CARDINAL; Msg: ARRAY OF CHAR);
  1791. ***** ^ undeclared identifier
  1792. ***** ^ not supported yet
  1793. 1051
  1794. 1052 BEGIN
  1795. 1053 WriteErrorString(ADR(Msg));
  1796. ***** ^ not supported yet
  1797. ***** ^ undeclared identifier
  1798. ***** ^ not supported yet
  1799. 1054 WriteErrorString(ADR(Ln));
  1800. ***** ^ not supported yet
  1801. ***** ^ undeclared identifier
  1802. ***** ^ not supported yet
  1803. 1055 CoreSig._FatalError(ErrAdd, Code);
  1804. ***** ^ not supported yet
  1805. ***** ^ not supported yet
  1806. ***** ^ not supported yet
  1807. ***** ^ not supported yet
  1808. 1056 END RunTimeErrorHandler;
  1809. ***** ^ not supported yet
  1810. 1057
  1811. 1058
  1812. 1059 PROCEDURE MakeAllPath(VAR Path: ARRAY OF CHAR; Drive, Dir, Name, Ext: ARRAY OF CHAR);
  1813. ***** ^ not supported yet
  1814. ***** ^ not supported yet
  1815. 1060
  1816. 1061 VAR
  1817. 1062 Pos: CARDINAL;
  1818. 1063 BEGIN
  1819. 1064 Str.Copy(Path, Drive);
  1820. ***** ^ not supported yet
  1821. ***** ^ not supported yet
  1822. ***** ^ not supported yet
  1823. ***** ^ not supported yet
  1824. 1065 IF Dir[0] # CHAR(0) THEN
  1825. ***** ^ not supported yet
  1826. ***** ^ not supported yet
  1827. ***** ^ not supported yet
  1828. 1066 Str.Append(Path, Dir);
  1829. ***** ^ not supported yet
  1830. ***** ^ not supported yet
  1831. ***** ^ not supported yet
  1832. ***** ^ not supported yet
  1833. 1067 Pos:=Str.Length(Path)-1;
  1834. ***** ^ not supported yet
  1835. ***** ^ not supported yet
  1836. ***** ^ not supported yet
  1837. 1068 IF NOT((Path[Pos] = '\') OR (Path[Pos] = '/')) THEN
  1838. ***** ^ not supported yet
  1839. ***** ^ not supported yet
  1840. ***** ^ not supported yet
  1841. ***** ^ not supported yet
  1842. 1069 Path[Pos+1]:='\';
  1843. ***** ^ not supported yet
  1844. ***** ^ not supported yet
  1845. 1070 Path[Pos+2]:=CHAR(0);
  1846. ***** ^ not supported yet
  1847. ***** ^ not supported yet
  1848. ***** ^ not supported yet
  1849. 1071 END;
  1850. 1072 END;
  1851. 1073 Str.Append(Path, Name);
  1852. ***** ^ not supported yet
  1853. ***** ^ not supported yet
  1854. ***** ^ not supported yet
  1855. ***** ^ not supported yet
  1856. 1074 IF Ext[0] # CHAR(0) THEN
  1857. ***** ^ not supported yet
  1858. ***** ^ not supported yet
  1859. ***** ^ not supported yet
  1860. 1075 IF Ext[0] # '.'THEN
  1861. ***** ^ not supported yet
  1862. ***** ^ not supported yet
  1863. 1076 Pos:=Str.Length(Path);
  1864. ***** ^ not supported yet
  1865. ***** ^ not supported yet
  1866. ***** ^ not supported yet
  1867. 1077 Path[Pos]:='.';
  1868. ***** ^ not supported yet
  1869. ***** ^ not supported yet
  1870. 1078 Path[Pos+1]:=CHAR(0);
  1871. ***** ^ not supported yet
  1872. ***** ^ not supported yet
  1873. ***** ^ not supported yet
  1874. 1079 END;
  1875. 1080 Str.Append(Path, Ext);
  1876. ***** ^ not supported yet
  1877. ***** ^ not supported yet
  1878. ***** ^ not supported yet
  1879. ***** ^ not supported yet
  1880. 1081 END;
  1881. 1082 RETURN;
  1882. 1083 END MakeAllPath;
  1883. ***** ^ not supported yet
  1884. 1084
  1885. 1085 PROCEDURE SplitAllPath(Path: ARRAY OF CHAR; VAR Drive: ARRAY OF CHAR;
  1886. ***** ^ not supported yet
  1887. ***** ^ not supported yet
  1888. 1086 VAR Dir: ARRAY OF CHAR; VAR Name: ARRAY OF CHAR; VAR Ext: ARRAY OF CHAR);
  1889. ***** ^ not supported yet
  1890. ***** ^ not supported yet
  1891. ***** ^ not supported yet
  1892. 1087
  1893. 1088 VAR
  1894. 1089 n, p: CARDINAL;
  1895. 1090 Dir_start, Name_start, Ext_start, Path_end: CARDINAL;
  1896. 1091 c: CHAR;
  1897. 1092 BEGIN
  1898. 1093 n := 0;
  1899. 1094 IF (Path[0] # 0C) AND ((Path[1] = ':') OR (Path[2] = ':')) THEN
  1900. ***** ^ not supported yet
  1901. ***** ^ not supported yet
  1902. ***** ^ not supported yet
  1903. ***** ^ not supported yet
  1904. ***** ^ not supported yet
  1905. ***** ^ not supported yet
  1906. 1095 REPEAT
  1907. 1096 c := Path[n];
  1908. ***** ^ not supported yet
  1909. ***** ^ not supported yet
  1910. 1097 Drive[n] := c;
  1911. ***** ^ not supported yet
  1912. ***** ^ not supported yet
  1913. 1098 INC(n);
  1914. ***** ^ undeclared identifier
  1915. ***** ^ not supported yet
  1916. 1099 UNTIL ((c = ':') OR (n > HIGH(Drive)));
  1917. ***** ^ undeclared identifier
  1918. ***** ^ not supported yet
  1919. 1100 END;
  1920. 1101 IF n <= HIGH(Drive) THEN
  1921. ***** ^ undeclared identifier
  1922. ***** ^ not supported yet
  1923. 1102 Drive[n] := 0C;
  1924. ***** ^ not supported yet
  1925. ***** ^ not supported yet
  1926. 1103 END;
  1927. 1104 Dir_start := n;
  1928. 1105 Name_start := n;
  1929. 1106 Ext_start := MAX(CARDINAL);
  1930. ***** ^ undeclared identifier
  1931. ***** ^ not supported yet
  1932. 1107 LOOP
  1933. 1108 c := Path[n];
  1934. ***** ^ not supported yet
  1935. ***** ^ not supported yet
  1936. 1109 IF c = 0C THEN EXIT END;
  1937. 1110 CASE c OF
  1938. 1111 | '.' :
  1939. 1112 IF(NOT((Path[n+1] = '.') OR (Path[n+1] = '\') OR (Path[n+1] = '/'))) THEN
  1940. ***** ^ not supported yet
  1941. ***** ^ not supported yet
  1942. ***** ^ not supported yet
  1943. ***** ^ not supported yet
  1944. ***** ^ not supported yet
  1945. ***** ^ not supported yet
  1946. 1113 Ext_start := n;
  1947. 1114 END;
  1948. 1115 INC(n);
  1949. ***** ^ undeclared identifier
  1950. ***** ^ not supported yet
  1951. 1116 | '/', '\' :
  1952. 1117 INC(n);
  1953. ***** ^ undeclared identifier
  1954. ***** ^ not supported yet
  1955. 1118 Name_start := n;
  1956. 1119 ELSE
  1957. 1120 INC(n);
  1958. ***** ^ undeclared identifier
  1959. ***** ^ not supported yet
  1960. 1121 END;
  1961. 1122 END;
  1962. 1123 Path_end := n;
  1963. 1124 IF Ext_start = MAX(CARDINAL) THEN
  1964. ***** ^ undeclared identifier
  1965. ***** ^ not supported yet
  1966. 1125 Ext_start := n;
  1967. 1126 END;
  1968. 1127 n:= Dir_start;
  1969. 1128 p := 0;
  1970. 1129 WHILE ((n < Name_start) AND (p <= HIGH(Dir)) AND (n<Ext_start)) DO
  1971. ***** ^ undeclared identifier
  1972. ***** ^ not supported yet
  1973. 1130 Dir[p] := Path[n];
  1974. ***** ^ not supported yet
  1975. ***** ^ not supported yet
  1976. ***** ^ not supported yet
  1977. ***** ^ not supported yet
  1978. 1131 INC(p);
  1979. ***** ^ undeclared identifier
  1980. ***** ^ not supported yet
  1981. 1132 INC(n);
  1982. ***** ^ undeclared identifier
  1983. ***** ^ not supported yet
  1984. 1133 END;
  1985. 1134 IF p <= HIGH(Dir) THEN
  1986. ***** ^ undeclared identifier
  1987. ***** ^ not supported yet
  1988. 1135 Dir[p] := 0C;
  1989. ***** ^ not supported yet
  1990. ***** ^ not supported yet
  1991. 1136 END;
  1992. 1137 n := Name_start;
  1993. 1138 p := 0;
  1994. 1139 WHILE (n < Ext_start) AND (p <= HIGH(Name)) DO
  1995. ***** ^ undeclared identifier
  1996. ***** ^ not supported yet
  1997. 1140 Name[p] := Path[n];
  1998. ***** ^ not supported yet
  1999. ***** ^ not supported yet
  2000. ***** ^ not supported yet
  2001. ***** ^ not supported yet
  2002. 1141 INC(n);
  2003. ***** ^ undeclared identifier
  2004. ***** ^ not supported yet
  2005. 1142 INC(p);
  2006. ***** ^ undeclared identifier
  2007. ***** ^ not supported yet
  2008. 1143 END;
  2009. 1144 IF p <= HIGH(Name) THEN
  2010. ***** ^ undeclared identifier
  2011. ***** ^ not supported yet
  2012. 1145 Name[p] := 0C;
  2013. ***** ^ not supported yet
  2014. ***** ^ not supported yet
  2015. 1146 END;
  2016. 1147 p := 0;
  2017. 1148 IF(Ext_start >= Name_start) THEN
  2018. 1149 n := Ext_start;
  2019. 1150 WHILE (n < Path_end) AND (p <= HIGH(Ext)) DO
  2020. ***** ^ undeclared identifier
  2021. ***** ^ not supported yet
  2022. 1151 Ext[p] := Path[n];
  2023. ***** ^ not supported yet
  2024. ***** ^ not supported yet
  2025. ***** ^ not supported yet
  2026. ***** ^ not supported yet
  2027. 1152 INC(n);
  2028. ***** ^ undeclared identifier
  2029. ***** ^ not supported yet
  2030. 1153 INC(p);
  2031. ***** ^ undeclared identifier
  2032. ***** ^ not supported yet
  2033. 1154 END;
  2034. 1155 END;
  2035. 1156 IF p <= HIGH(Ext) THEN
  2036. ***** ^ undeclared identifier
  2037. ***** ^ not supported yet
  2038. 1157 Ext[p] := 0C;
  2039. ***** ^ not supported yet
  2040. ***** ^ not supported yet
  2041. 1158 END;
  2042. 1159 END SplitAllPath;
  2043. ***** ^ not supported yet
  2044. 1160
  2045. 1161 (*%F _OS2 *)
  2046. 1162 TYPE
  2047. 1163 (*# save,data(near_ptr=>off) *)
  2048. 1164 FarCharPtr = POINTER TO CHAR;
  2049. 1165 (*# restore *)
  2050. 1166 VAR
  2051. 1167 n: CARDINAL;
  2052. 1168 BEGIN
  2053. 1169 HistoryPtr := 0;
  2054. 1170 LowerPtr := 0;
  2055. 1171 ExecSearchPath := TRUE;
  2056. 1172 NilStr[0] := 0C;
  2057. 1173 (*%F _WINDLL *)
  2058. 1174 PSP := CoreMain._psp;
  2059. 1175 [PSP: 81H+CARDINAL([PSP:80H FarCharPtr]^) FarCharPtr]^ := 0C;
  2060. 1176 CommandLine := [PSP: 81H CommandType];
  2061. 1177 n := 0;
  2062. 1178 WHILE CommandLine^[n] = ' ' DO
  2063. 1179 INC(n);
  2064. 1180 END;
  2065. 1181 INC(CARDINAL(CommandLine),n);
  2066. 1182 (*%E *)
  2067. 1183 RunTimeError := RunTimeErrorHandler;
  2068. 1184 (*%E *)
  2069. 1185
  2070. 1186 (*%T _OS2 *)
  2071. 1187 (*# save *)
  2072. 1188 (*# data(near_ptr=>off) *)
  2073. 1189 TYPE bp=POINTER TO SHORTCARD;
  2074. ***** ^ not supported yet
  2075. 1190 wp=POINTER TO CARDINAL;
  2076. ***** ^ not supported yet
  2077. 1191 (*# restore *)
  2078. 1192
  2079. 1193 VAR
  2080. 1194 seg, ofs, lim, n : CARDINAL;
  2081. 1195
  2082. 1196 BEGIN
  2083. 1197 HistoryPtr := 0;
  2084. 1198 LowerPtr := 0;
  2085. 1199 ExecSearchPath := TRUE;
  2086. ***** ^ undeclared identifier
  2087. 1200 NilStr[0] := 0C;
  2088. ***** ^ undeclared identifier
  2089. ***** ^ not supported yet
  2090. 1201 IF (GetEnv(seg,ofs)=0) THEN END;
  2091. ***** ^ not supported yet
  2092. ***** ^ not supported yet
  2093. 1202 (*%F _XTD *)
  2094. 1203 lim := SelectorLimit(seg);
  2095. 1204 LOOP
  2096. 1205 INC(ofs);
  2097. 1206 IF ofs>lim THEN (* bug in 1.0/Codeview *)
  2098. 1207 ofs := 1;
  2099. 1208 [seg:0 wp]^ := 0;
  2100. 1209 [seg:2 wp]^ := 0;
  2101. 1210 EXIT;
  2102. 1211 END;
  2103. 1212 IF [seg:ofs-1 bp]^ = 0 THEN EXIT END;
  2104. 1213 END;
  2105. 1214 CommandLine := [seg:ofs];
  2106. 1215 IF CommandLine # FarNIL THEN
  2107. 1216 n := 0;
  2108. 1217 WHILE CommandLine^[n] = ' ' DO
  2109. 1218 INC(n);
  2110. 1219 END;
  2111. 1220 INC(CARDINAL(CommandLine), n);
  2112. 1221 END;
  2113. 1222 (*%E *)
  2114. 1223 (*%T _XTD*)
  2115. 1224 WHILE [seg:ofs bp]^ # 0 DO
  2116. ***** ^ not supported yet
  2117. ***** ^ not supported yet
  2118. 1225 INC(ofs);
  2119. ***** ^ undeclared identifier
  2120. ***** ^ not supported yet
  2121. 1226 END; (*WHILE*)
  2122. 1227 REPEAT
  2123. 1228 INC(ofs);
  2124. ***** ^ undeclared identifier
  2125. ***** ^ not supported yet
  2126. 1229 UNTIL [seg:ofs bp]^ # 20H;
  2127. ***** ^ not supported yet
  2128. ***** ^ not supported yet
  2129. 1230 CommandLine := [seg:ofs];
  2130. ***** ^ undeclared identifier
  2131. ***** ^ not supported yet
  2132. 1231 PSP := CoreMain._psp;
  2133. ***** ^ undeclared identifier
  2134. ***** ^ not supported yet
  2135. ***** ^ not supported yet
  2136. 1232 (*%E*)
  2137. 1233 RunTimeError:=RunTimeErrorHandler;
  2138. ***** ^ undeclared identifier
  2139. ***** ^ not supported yet
  2140. 1234 (*%E *)
  2141. 1235 END Lib.
  2142. ***** ^ not supported yet
  2143. 906 errors