Listing: 1 (* Release 3.10 *) 2 (*-------------------------------------------------------------------------* 3 * * 4 * LIB.MOD - General library functions * 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 (*# module(implementation=>off) *) 16 (*# call(o_a_copy => off) *) 17 (*# check(stack=>off, 18 index=>off, 19 range=>off, 20 overflow=>off, 21 nil_ptr=>off) *) 22 23 IMPLEMENTATION MODULE Lib; 24 25 IMPORT SYSTEM,Str,SPAWN,CoreMain,CoreSig,CoreMath; 26 (*%F _OS2 *) 27 (*%T _WINDOWS*) 28 IMPORT Windows; 29 (*%E *) 30 (*%E *) 31 (*%T _OS2 *) 32 FROM Dos IMPORT DATETIME,GetDateTime,SIGHANDLER,SetSigHandler,Sleep, 33 SIG_CTRLC,SIG_CTRLBREAK,Beep,RESULTCODES,ExecPgm, 34 SearchPath,GetMessage,GetEnv,EXEC_SYNC, SetDateTime, Write; 35 (*%E *) 36 37 CONST 38 _DLLOVL = (_DLL OR _OVL) AND NOT _OS2; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 39 _NOTDLLORENV = (NOT _DLLOVL) OR _ENV; ***** ^ not supported yet ***** ^ undeclared identifier 40 41 (* Implemented In AsmLib *) 42 (*# save *) 43 (*%T _DLL *) 44 (*# call(seg_name=>LibDLL) *) 45 (*%E *) 46 PROCEDURE AddFarAddr(A: FarADDRESS; increment: CARDINAL) : FarADDRESS; IN AsmLib; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 47 PROCEDURE SubFarAddr(A: FarADDRESS; decrement: CARDINAL) : FarADDRESS; IN AsmLib; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 48 PROCEDURE IncFarAddr(VAR A: FarADDRESS; increment: CARDINAL); IN AsmLib; ***** ^ undeclared identifier ***** ^ not supported yet 49 PROCEDURE DecFarAddr(VAR A: FarADDRESS; decrement: CARDINAL); IN AsmLib; ***** ^ undeclared identifier ***** ^ not supported yet 50 51 (*%F _fdata *) 52 PROCEDURE NearMove (Source,Dest:NearADDRESS;Count:CARDINAL); IN AsmLib; 53 PROCEDURE NearFastMove(Source,Dest:NearADDRESS;Count:CARDINAL); IN AsmLib; 54 PROCEDURE NearWordMove(Source,Dest:NearADDRESS;WordCount:CARDINAL); IN AsmLib; 55 (*%E *) 56 PROCEDURE Move (Source,Dest:ADDRESS;Count:CARDINAL); IN AsmLib; ***** ^ undeclared identifier ***** ^ not supported yet 57 PROCEDURE FastMove(Source,Dest:ADDRESS;Count:CARDINAL); IN AsmLib; ***** ^ undeclared identifier ***** ^ not supported yet 58 PROCEDURE WordMove(Source,Dest:ADDRESS;WordCount:CARDINAL); IN AsmLib; ***** ^ undeclared identifier ***** ^ not supported yet 59 60 PROCEDURE FarMove (Source,Dest:FarADDRESS;Count:CARDINAL); IN AsmLib; ***** ^ undeclared identifier ***** ^ not supported yet 61 PROCEDURE FarFastMove(Source,Dest:FarADDRESS;Count:CARDINAL); IN AsmLib; ***** ^ undeclared identifier ***** ^ not supported yet 62 PROCEDURE FarWordMove(Source,Dest:FarADDRESS;WordCount:CARDINAL); IN AsmLib; ***** ^ undeclared identifier ***** ^ not supported yet 63 64 PROCEDURE Fill(Dest: ADDRESS; Count: CARDINAL; Value: BYTE); IN AsmLib; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 65 PROCEDURE FarFill(Dest: FarADDRESS; Count: CARDINAL; Value: BYTE); IN AsmLib; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 66 67 PROCEDURE WordFill(Dest: ADDRESS; WordCount: CARDINAL; Value: WORD); IN AsmLib; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 68 PROCEDURE FarWordFill(Dest: FarADDRESS; WordCount: CARDINAL; Value: WORD); IN AsmLib; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 69 70 PROCEDURE HashString(S: ARRAY OF CHAR; Range: CARDINAL) : CARDINAL; IN AsmLib; ***** ^ not supported yet ***** ^ not supported yet 71 PROCEDURE Terminate(P : PROC; VAR C: PROC); IN AsmLib; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 72 PROCEDURE SetReturnCode(code: SHORTCARD); IN AsmLib; ***** ^ not supported yet 73 PROCEDURE SetInProgramFlag(State: BOOLEAN); IN AsmLib; ***** ^ not supported yet 74 PROCEDURE GetInProgramFlag(): BOOLEAN; IN AsmLib; ***** ^ not supported yet 75 76 PROCEDURE CpuId ( VAR r : CpuRec ); IN AsmLib; ***** ^ undeclared identifier ***** ^ not supported yet 77 78 PROCEDURE ScanR (Dest: ADDRESS; Count: CARDINAL; Value: BYTE) : CARDINAL; IN AsmLib; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 79 PROCEDURE ScanL (Dest: ADDRESS; Count: CARDINAL; Value: BYTE) : CARDINAL; IN AsmLib; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 80 PROCEDURE ScanNeR(Dest: ADDRESS; Count: CARDINAL; Value: BYTE) : CARDINAL; IN AsmLib; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 81 PROCEDURE ScanNeL(Dest: ADDRESS; Count: CARDINAL; Value: BYTE) : CARDINAL; IN AsmLib; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 82 PROCEDURE Compare(Source,Dest: ADDRESS; Len: CARDINAL) : CARDINAL; IN AsmLib; ***** ^ undeclared identifier ***** ^ not supported yet 83 84 PROCEDURE UserBreak; IN AsmLib; ***** ^ not supported yet 85 PROCEDURE Sound(FreqHz: CARDINAL); IN AsmLib; ***** ^ not supported yet 86 PROCEDURE NoSound; IN AsmLib; ***** ^ not supported yet 87 PROCEDURE Dos(VAR R: SYSTEM.Registers); (* INT 21H Function Call *) IN AsmLib; ***** ^ duplicate identifier ***** ^ not supported yet ***** ^ not supported yet 88 PROCEDURE Intr(VAR R: SYSTEM.Registers; I: CARDINAL); IN AsmLib; ***** ^ not supported yet ***** ^ not supported yet 89 90 PROCEDURE AddressOK ( A : ADDRESS ) : BOOLEAN; IN AsmLib; ***** ^ undeclared identifier ***** ^ not supported yet 91 PROCEDURE SelectorLimit ( S : CARDINAL ) : CARDINAL; IN AsmLib; ***** ^ not supported yet 92 PROCEDURE ProtectedMode () : BOOLEAN; IN AsmLib; ***** ^ not supported yet 93 94 PROCEDURE SetJmp (VAR Lbl: LongLabel) : CARDINAL; IN AsmLib; ***** ^ undeclared identifier ***** ^ not supported yet 95 PROCEDURE LongJmp(VAR Lbl: LongLabel; result: CARDINAL); IN AsmLib; ***** ^ undeclared identifier ***** ^ not supported yet 96 97 (*%F _OS2 *) 98 (*# save *) 99 (*# call(near_call=>off, reg_param=>()) *) 100 PROCEDURE DosExec(name: ARRAY OF CHAR; paramblock: FarADDRESS) : CARDINAL; IN AsmLib; 101 (*# restore *) 102 PROCEDURE InternalEnableBreakCheck; IN AsmLib; 103 PROCEDURE InternalDisableBreakCheck; IN AsmLib; 104 PROCEDURE InternalDelay(Time: CARDINAL); IN AsmLib; 105 PROCEDURE InternalSound(Freq: CARDINAL); IN AsmLib; 106 PROCEDURE InternalNoSound(); IN AsmLib; 107 (*%E *) 108 (*# restore *) 109 110 PROCEDURE IsOfClass(Child, Parent: MTablePtr): BOOLEAN; ***** ^ undeclared identifier 111 112 VAR 113 ThisObject: MTablePtr; ***** ^ undeclared identifier 114 115 BEGIN 116 ThisObject:= Child; ***** ^ not supported yet ***** ^ not supported yet 117 IF ThisObject = Parent THEN RETURN TRUE END; ***** ^ not supported yet ***** ^ not supported yet 118 (*%T _fdata *) 119 WHILE ThisObject^.Parent # FarNIL DO ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 120 (*%E *) 121 (*%F _fdata *) 122 WHILE ThisObject^.Parent # NearNIL DO 123 (*%E *) 124 IF ThisObject^.Parent = Parent THEN RETURN TRUE END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 125 ThisObject := ThisObject^.Parent; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 126 END; 127 RETURN FALSE; 128 END IsOfClass; ***** ^ not supported yet 129 130 131 132 PROCEDURE HSort(N: CARDINAL; Less: CompareProc; Swap: SwapProc); ***** ^ undeclared identifier ***** ^ undeclared identifier 133 VAR 134 i,j,k : CARDINAL; 135 BEGIN 136 IF N > 1 THEN 137 i := N DIV 2; 138 REPEAT 139 j := i; 140 LOOP (* Note that total repeats <= N/4 * 1 + N/8 * 2 + N/16 * 3 + .... *) 141 k := j * 2; 142 IF k > N THEN EXIT END; 143 IF (k < N) AND Less(k,k+1) THEN INC(k) END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 144 IF Less(j,k) THEN Swap(j,k) ELSE EXIT END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 145 j := k; 146 END; 147 DEC(i); ***** ^ undeclared identifier ***** ^ not supported yet 148 UNTIL i = 0; 149 150 i := N; 151 REPEAT 152 j := 1; 153 Swap(j,i); ***** ^ not supported yet ***** ^ not supported yet 154 DEC(i); ***** ^ undeclared identifier ***** ^ not supported yet 155 LOOP 156 k := j * 2; 157 IF k > i THEN EXIT END; 158 IF ( k < i ) AND Less(k,k+1) THEN INC(k) END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 159 Swap(j,k); ***** ^ not supported yet ***** ^ not supported yet 160 j := k; 161 END; 162 LOOP 163 k := j DIV 2; 164 IF (k > 0) AND Less(k,j) THEN Swap(j,k); j := k ELSE EXIT END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 165 END; 166 UNTIL i = 0; 167 END; 168 END HSort; ***** ^ not supported yet 169 170 171 PROCEDURE QSort(N: CARDINAL; Less: CompareProc; Swap: SwapProc); ***** ^ undeclared identifier ***** ^ undeclared identifier 172 173 PROCEDURE Sort(l,r: CARDINAL); 174 VAR 175 i,j:CARDINAL; 176 BEGIN 177 WHILE r > l DO 178 i := l+1; 179 j := r; 180 WHILE i <= j DO 181 WHILE (i <= j) AND NOT Less(l,i) DO INC(i) END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 182 WHILE (i <= j) AND Less(l,j) DO DEC(j) END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 183 IF i <= j THEN Swap(i,j); INC(i); DEC(j) END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 184 END; 185 IF j # l THEN Swap(j,l) END; ***** ^ not supported yet ***** ^ not supported yet 186 IF j+j > r+l THEN (* small one recursively *) 187 Sort(j+1,r); ***** ^ not supported yet ***** ^ not supported yet 188 r := j-1; 189 ELSE 190 Sort(l,j-1); ***** ^ not supported yet ***** ^ not supported yet 191 l := j+1; 192 END; 193 END; 194 END Sort; ***** ^ not supported yet 195 196 BEGIN 197 Sort(1,N); ***** ^ not supported yet ***** ^ not supported yet 198 END QSort; ***** ^ not supported yet 199 200 201 PROCEDURE GetVector(Int:SHORTCARD):FarADDRESS; ***** ^ undeclared identifier 202 (*%F _OS2 *) 203 VAR 204 r : SYSTEM.Registers; 205 BEGIN 206 r.AH := 35H; 207 r.AL := Int; 208 Dos(r); 209 RETURN [r.ES:r.BX]; 210 (*%E *) 211 (*%T _OS2 *) 212 BEGIN 213 RETURN FarNIL; ***** ^ undeclared identifier 214 (*%E *) 215 END GetVector; ***** ^ not supported yet 216 217 PROCEDURE SetVector(Int:SHORTCARD;Vector:FarADDRESS); ***** ^ undeclared identifier 218 (*%F _OS2 *) 219 VAR 220 r : SYSTEM.Registers; 221 BEGIN 222 r.AH := 25H; 223 r.AL := Int; 224 r.DS := Seg(Vector^); 225 r.DX := Ofs(Vector^); 226 Dos(r); 227 (*%E *) 228 END SetVector; ***** ^ not supported yet 229 230 (*%F _OS2 *) 231 PROCEDURE Execute(Name : ARRAY OF CHAR; 232 CommandLine : ARRAY OF CHAR; 233 StoreAddr : FarADDRESS; (* storage to execute in *) 234 StoreLen : CARDINAL (* length of store paragraphs *) 235 ):CARDINAL; 236 CONST 237 MinHeapNeeded = 4; 238 239 VAR 240 fullpath : ARRAY[0..80] OF CHAR; 241 cline : RECORD 242 len : SHORTCARD; 243 txt : ARRAY[0..255] OF CHAR; 244 END; (*cline*) 245 reply : CARDINAL; 246 LoadRec : RECORD 247 envseg : CARDINAL; 248 comline : FarADDRESS; 249 FCB1 : FarADDRESS; 250 FCB2 : FarADDRESS; 251 END; (*LoadRec*) 252 Progbase : CARDINAL; 253 MaxProgSize : CARDINAL; 254 residue : CARDINAL; 255 256 (*%T _NOTDLLORENV*) 257 PROCEDURE GiveBackHeap(StoreAddr:FarADDRESS; (* storage to execute in *) 258 StoreLen :CARDINAL); (* length of store paragraphs *) 259 VAR 260 R : SYSTEM.Registers; 261 temp : CARDINAL; 262 BEGIN 263 Progbase := Seg(StoreAddr^); 264 R.AH := 4AH; 265 R.ES := PSP; 266 R.BX := Seg(StoreAddr^)-PSP; 267 Lib.Dos(R); (* modify so all after seg free *) 268 R.BX := StoreLen-2; 269 R.AH := 48H; 270 Lib.Dos(R); (* allocate the seg we want *) 271 temp := R.AX; 272 R.BX := 0FFFFH; (* allocate all the rest *) 273 R.AH := 48H; 274 Lib.Dos(R); (* returns allocated in BX *) 275 R.AH := 48H; 276 Lib.Dos(R); (* do allocation *) 277 residue := R.AX; 278 R.AH := 49H; 279 R.ES := temp; 280 Lib.Dos(R); (* now free the bit we want *) 281 END GiveBackHeap; 282 283 PROCEDURE RetrieveHeap; 284 VAR 285 R : SYSTEM.Registers; 286 BEGIN 287 R.AH := 49H; 288 R.ES := residue; 289 Lib.Dos(R); (* now free the residue *) 290 R.BX := 0FFFFH; (* now modify PSP back to full size *) 291 R.AH := 4AH; 292 R.ES := PSP; 293 Lib.Dos(R); (* returns allocated in BX *) 294 R.AH := 4AH; 295 Lib.Dos(R); (* do modify *) 296 END RetrieveHeap; 297 (*%E *) 298 299 (*%F _NOTDLLORENV*) 300 PROCEDURE GiveBackHeap(StoreAddr:FarADDRESS;StoreLen:CARDINAL); 301 BEGIN 302 CoreMain._res_mem; 303 END GiveBackHeap; 304 305 PROCEDURE RetrieveHeap; 306 BEGIN 307 CoreMain._shr_mem; 308 END RetrieveHeap; 309 (*%E *) 310 311 BEGIN 312 GiveBackHeap(StoreAddr,StoreLen); 313 cline.len := SHORTCARD(Str.Length(CommandLine)); 314 Str.Concat(cline.txt,CommandLine,CHR(13)); 315 Str.Copy(fullpath,Name); 316 LoadRec.envseg := [PSP:2CH]^; 317 LoadRec.comline := FarADR(cline); 318 LoadRec.FCB1 := [PSP:5CH]; 319 LoadRec.FCB2 := [PSP:6CH]; 320 reply := DosExec(fullpath,FarADR(LoadRec)); 321 RetrieveHeap; 322 RETURN reply; 323 END Execute; 324 (*%E *) 325 326 (*%T _OS2 *) 327 PROCEDURE Environment(N: CARDINAL): CommandType; ***** ^ undeclared identifier 328 329 VAR 330 Ret: FarADDRESS; ***** ^ undeclared identifier 331 BEGIN 332 Ret := FarADR(CoreMain._env_var[N]^); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 333 IF Ret = FarNIL THEN ***** ^ not supported yet ***** ^ undeclared identifier 334 RETURN CommandType(FarADR(NilStr)); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 335 ELSE 336 RETURN CommandType(Ret); ***** ^ undeclared identifier ***** ^ not supported yet 337 END; 338 END Environment; ***** ^ not supported yet 339 (*%E *) 340 341 PROCEDURE EnvironmentFind ( name : ARRAY OF CHAR; ***** ^ not supported yet 342 VAR result : ARRAY OF CHAR ); ***** ^ not supported yet 343 (* Find a string in the DOS environment *) 344 VAR 345 n, p : CARDINAL; 346 pi : ARRAY[0..14] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 347 pp : Lib.CommandType; ***** ^ not a type name ***** ^ not supported yet 348 c: CHAR; 349 BEGIN 350 n := 0; 351 LOOP 352 pp := Lib.Environment(n); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 353 p := 0; 354 REPEAT (* Don't use Str.Copy or it will stop after 126 chars *) 355 c := pp^[p]; ***** ^ not supported yet ***** ^ not supported yet 356 result[p] := c; ***** ^ not supported yet ***** ^ not supported yet 357 INC(p); ***** ^ undeclared identifier ***** ^ not supported yet 358 UNTIL (c = 0C) OR (p > HIGH(result)); ***** ^ undeclared identifier ***** ^ not supported yet 359 IF result[0] = CHR(0) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 360 RETURN; 361 END; 362 Str.ItemS(pi,result,' =',0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 363 IF Str.Match(pi,name) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 364 n := Str.CharPos(result, '='); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 365 IF n=MAX(CARDINAL) THEN ***** ^ undeclared identifier ***** ^ not supported yet 366 n := Str.CharPos(result, ' '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 367 IF n=MAX(CARDINAL) THEN ***** ^ undeclared identifier ***** ^ not supported yet 368 result[0]:=0C; ***** ^ not supported yet ***** ^ not supported yet 369 RETURN; 370 END; 371 END; 372 Str.Delete(result, 0, n+1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 373 RETURN; 374 END; 375 INC(n); ***** ^ undeclared identifier ***** ^ not supported yet 376 END; 377 END EnvironmentFind; ***** ^ not supported yet 378 379 (*%T _OS2 *) 380 PROCEDURE Exec ( Path : ARRAY OF CHAR; Command : ARRAY OF CHAR; Env : ExecEnvPtr): CARDINAL; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 381 382 VAR 383 ParamArray: ARRAY [0..2] OF ADDRESS; ***** ^ not supported yet ***** ^ undeclared identifier 384 BEGIN 385 ParamArray[0]:=ADR(Path); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 386 ParamArray[1]:=ADR(Command); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 387 ParamArray[2]:=NIL; ***** ^ not supported yet ***** ^ not supported yet 388 RETURN SPAWN._beget(Path, ADR(ParamArray), Env, CARDINAL(ExecSearchPath)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 389 END Exec; ***** ^ not supported yet 390 (*%E *) 391 392 (*%T _OS2 *) 393 PROCEDURE ExecCmd(command:ARRAY OF CHAR):CARDINAL; ***** ^ not supported yet 394 VAR 395 Path : ARRAY [0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 396 Params : ARRAY [0..3] OF ADDRESS; ***** ^ not supported yet ***** ^ undeclared identifier 397 BEGIN 398 EnvironmentFind('COMSPEC', Path); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 399 IF Path[0] = 0C THEN ***** ^ not supported yet ***** ^ not supported yet 400 Str.Copy(Path, "\CMD.EXE"); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 401 END; (*IF*) 402 Params[0] := ADR(Path); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 403 Params[1] := ADR("/C"); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 404 Params[2] := ADR(command); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 405 Params[3] := NIL; ***** ^ not supported yet ***** ^ not supported yet 406 RETURN SPAWN._beget(Path,ADR(Params),NIL,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 407 END ExecCmd; ***** ^ not supported yet 408 (*%E *) 409 410 CONST 411 HistoryMax = 54; 412 413 VAR 414 HistoryPtr : CARDINAL; 415 LowerPtr : CARDINAL; 416 History : ARRAY [0..HistoryMax] OF CARDINAL; ***** ^ not supported yet ***** ^ not supported yet 417 418 PROCEDURE SEED(v:CARDINAL); 419 VAR 420 x : LONGCARD; ***** ^ undeclared identifier 421 i : CARDINAL; 422 BEGIN 423 HistoryPtr := HistoryMax; 424 LowerPtr := 23; 425 x := LONGCARD(v); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 426 i := 0; 427 REPEAT 428 x := (x*3141592621+17); ***** ^ not supported yet ***** ^ not supported yet 429 History[i] := CARDINAL(x DIV 10000H); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 430 INC(i); ***** ^ undeclared identifier ***** ^ not supported yet 431 UNTIL i > HistoryMax; 432 END SEED; ***** ^ not supported yet 433 434 PROCEDURE RANDOM(Range: CARDINAL) : CARDINAL; 435 VAR res:CARDINAL; 436 BEGIN 437 IF HistoryPtr = 0 THEN 438 IF LowerPtr = 0 THEN 439 SEED(12345); ***** ^ not supported yet ***** ^ not supported yet 440 ELSE 441 HistoryPtr := HistoryMax; 442 LowerPtr := LowerPtr-1; 443 END; 444 ELSE 445 HistoryPtr := HistoryPtr-1; 446 IF LowerPtr = 0 THEN 447 LowerPtr := HistoryMax; 448 ELSE 449 LowerPtr := LowerPtr-1; 450 END; 451 END; 452 res := History[HistoryPtr]+History[LowerPtr]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 453 History[HistoryPtr] := res; ***** ^ not supported yet ***** ^ not supported yet 454 IF Range = 0 THEN 455 RETURN res; 456 ELSE 457 RETURN res MOD Range; 458 END; 459 END RANDOM; ***** ^ not supported yet 460 461 PROCEDURE RANDOMIZE; 462 (*%T _WINDOWS *) 463 BEGIN 464 SEED(CARDINAL(Windows.GetCurrentTime())); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 465 (*%E *) 466 467 (*%F _WINDOWS *) 468 (*%T _OS2 *) 469 VAR d : DATETIME; 470 r : CARDINAL; 471 BEGIN 472 r := GetDateTime(d); 473 SEED(CARDINAL(d.hundredths)*CARDINAL(d.seconds)); 474 (*%E *) 475 (*%F _OS2 *) 476 VAR R : SYSTEM.Registers; 477 BEGIN 478 WITH R DO 479 AH := 2CH; 480 Lib.Dos(R); 481 SEED(DX+CX); 482 END; 483 (*%E *) 484 (*%E *) 485 END RANDOMIZE; ***** ^ not supported yet 486 487 PROCEDURE RAND(): REAL; 488 VAR 489 x:RECORD low,high:CARDINAL END; ***** ^ not supported yet 490 BEGIN 491 x.low := RANDOM(0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 492 x.high := RANDOM(0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 493 RETURN REAL(LONGCARD(x))/(REAL(MAX(LONGCARD))+1.1); (* NB Temp Fix *) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 494 END RAND; ***** ^ not supported yet 495 496 497 PROCEDURE ParamStr(VAR S: ARRAY OF CHAR; N: CARDINAL); ***** ^ not supported yet 498 BEGIN 499 IF N >= CoreMain._argc THEN ***** ^ not supported yet ***** ^ not supported yet 500 S[0] := 0C; ***** ^ not supported yet ***** ^ not supported yet 501 ELSE 502 Str.Copy(S,CoreMain._argv[N]^); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 503 END; 504 END ParamStr; ***** ^ not supported yet 505 506 PROCEDURE ParamCount() : CARDINAL; 507 508 BEGIN 509 RETURN CoreMain._argc-1; ***** ^ not supported yet ***** ^ not supported yet 510 END ParamCount; ***** ^ not supported yet 511 512 (*%T _OS2 *) 513 VAR 514 nullp[0:0] : SIGHANDLER; ***** ^ not supported yet ***** ^ not supported yet 515 nullac[0:0] : CARDINAL; ***** ^ not supported yet ***** ^ not supported yet 516 517 PROCEDURE EnableBreakCheck; 518 BEGIN 519 SetSigHandler(SIGHANDLER(0),nullp,nullac,0,SIG_CTRLC); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 520 SetSigHandler(SIGHANDLER(0),nullp,nullac,0,SIG_CTRLBREAK); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 521 END EnableBreakCheck; ***** ^ not supported yet 522 523 PROCEDURE DisableBreakCheck; 524 BEGIN 525 SetSigHandler(SIGHANDLER(0),nullp,nullac,1,SIG_CTRLC); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 526 SetSigHandler(SIGHANDLER(0),nullp,nullac,1,SIG_CTRLBREAK); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 527 END DisableBreakCheck; ***** ^ not supported yet 528 529 PROCEDURE Delay(t:CARDINAL); 530 BEGIN 531 Sleep(LONGCARD(t)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 532 END Delay; ***** ^ not supported yet 533 534 PROCEDURE Speaker(FreqHz,TimeMs: CARDINAL); 535 BEGIN 536 Beep(FreqHz,TimeMs); ***** ^ not supported yet ***** ^ not supported yet 537 END Speaker; ***** ^ not supported yet 538 539 (*%E *) 540 541 CONST 542 MErr = 'Math Error : '; ***** ^ not supported yet 543 544 PROCEDURE MathError(R: LONGREAL; STR: ARRAY OF CHAR); ***** ^ not supported yet 545 VAR str : ARRAY[0..40] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 546 BEGIN 547 Str.Concat ( str,MErr,STR ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 548 RunTimeError(CoreSig._FatalErrorPos(), 0D0H, str); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 549 END MathError; ***** ^ not supported yet 550 551 PROCEDURE MathError2(R1,R2: LONGREAL; STR: ARRAY OF CHAR); ***** ^ not supported yet 552 VAR str : ARRAY[0..40] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 553 BEGIN 554 RunTimeError(CoreSig._FatalErrorPos(), 0D1H, str); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 555 END MathError2; ***** ^ not supported yet 556 557 (*%F _OS2 *) 558 PROCEDURE EnableBreakCheck; 559 BEGIN 560 InternalEnableBreakCheck; 561 END EnableBreakCheck; 562 563 564 PROCEDURE DisableBreakCheck; 565 BEGIN 566 InternalDisableBreakCheck; 567 END DisableBreakCheck; 568 569 PROCEDURE Environment(N: CARDINAL): CommandType; 570 571 TYPE 572 (*# save *) 573 (*# data(near_ptr=>off) *) 574 CardPtr = POINTER TO CARDINAL; 575 (*# restore *) 576 VAR 577 Ret: CommandType; 578 c: CHAR; 579 BEGIN 580 Ret := [[PSP: 2CH CardPtr]^: 0]; 581 WHILE N # 0 DO 582 IF Ret^[0] = 0C THEN 583 RETURN FarNIL; 584 END; 585 REPEAT 586 c := Ret^[0]; 587 INC(CARDINAL(Ret)); 588 UNTIL c = 0C; 589 DEC(N); 590 END; 591 RETURN Ret; 592 END Environment; 593 594 595 PROCEDURE Delay(Time: CARDINAL); 596 BEGIN 597 InternalDelay(Time); 598 END Delay; 599 600 PROCEDURE Speaker(FreqHz,TimeMs: CARDINAL); 601 BEGIN 602 Sound(FreqHz); 603 Delay(TimeMs); 604 NoSound; 605 END Speaker; 606 607 PROCEDURE Exec(Path:ARRAY OF CHAR;Command:ARRAY OF CHAR;Env:ExecEnvPtr):CARDINAL; 608 VAR 609 Params: ARRAY [0..2] OF ADDRESS; 610 BEGIN 611 Params[0] := ADR(Path); 612 Params[1] := ADR(Command); 613 Params[2] := NIL; 614 RETURN SPAWN._beget(Path,ADR(Params),Env,CARDINAL(ExecSearchPath)); 615 END Exec; 616 617 PROCEDURE ExecCmd(command:ARRAY OF CHAR):CARDINAL; 618 VAR 619 Path : ARRAY [0..80] OF CHAR; 620 ComLine : ARRAY [0..128] OF CHAR; 621 p, n : CARDINAL; 622 PBlock : CoreMain.ParamBlock; 623 BEGIN 624 (*%F _ENV*) 625 IF CoreMain._fmemsetup THEN 626 IF CoreMain._shr_mem() # 0 THEN 627 RunTimeError(CoreSig._FatalErrorPos(),4AH,command); 628 END; (*IF*) 629 END; (*IF*) 630 (*%E*) 631 EnvironmentFind('COMSPEC',Path); 632 IF Path[0] = 0C THEN 633 Str.Copy(Path,"\COMMAND.COM"); 634 END; (*IF*) 635 ComLine[1] := '/'; (* construct command line *) 636 ComLine[2] := 'C'; 637 ComLine[3] := ' '; 638 n := 4; 639 p := 0; 640 WHILE command[p] # 0C DO 641 ComLine[n] := command[p]; 642 IF n > 127 THEN 643 RunTimeError(CoreSig._FatalErrorPos(),4BH,command); 644 END; (*IF*) 645 INC(p); 646 INC(n); 647 END; (*WHILE*) 648 ComLine[n] := CHR(0DH); 649 ComLine[0] := CHR(n); 650 PBlock.Com := FarADR(ComLine); 651 PBlock.Env := 0; 652 IF CoreMain._exec(Path,PBlock) # 0 THEN 653 RunTimeError(CoreSig._FatalErrorPos(),4CH,command); 654 END; (*IF*) 655 IF (CoreMain._fmemsetup) THEN 656 CoreMain._res_mem(); 657 END; (*IF*) 658 RETURN CoreMain._get_retcode(); 659 END ExecCmd; 660 661 662 PROCEDURE GetTime ( VAR Hrs,Mins,Secs,Hsecs : CARDINAL ); 663 VAR 664 R : SYSTEM.Registers; 665 BEGIN 666 WITH R DO 667 AH := 2CH; 668 (*%T _WINDOWS *) 669 DS := Seg(R); 670 ES := Seg(R); 671 (*%E *) 672 Lib.Dos(R); 673 Hrs := CARDINAL(CH); 674 Mins := CARDINAL(CL); 675 Secs := CARDINAL(DH); 676 Hsecs := CARDINAL(DL); 677 END; 678 END GetTime; 679 680 PROCEDURE SetTime(Hrs,Mins,Secs,Hsecs:CARDINAL):BOOLEAN; 681 VAR 682 R : SYSTEM.Registers; 683 BEGIN 684 WITH R DO 685 AH := 2DH; 686 CH := SHORTCARD(Hrs); 687 CL := SHORTCARD(Mins); 688 DH := SHORTCARD(Secs); 689 DL := SHORTCARD(Hsecs); 690 Lib.Dos(R); 691 RETURN AX=0; 692 END; (*WITH*) 693 END SetTime; 694 695 PROCEDURE GetDate(VAR Year,Month,Day : CARDINAL; 696 VAR DayOfWeek : DayType ); 697 VAR 698 R : SYSTEM.Registers; 699 BEGIN 700 WITH R DO 701 AH := 2AH; 702 (*%T _WINDOWS *) 703 DS := Seg(R); 704 ES := Seg(R); 705 (*%E *) 706 Lib.Dos(R); 707 Year := CX; 708 Month := CARDINAL(DH); 709 Day := CARDINAL(DL); 710 DayOfWeek := DayType(AL); 711 END; 712 END GetDate; 713 714 PROCEDURE SetDate(Year,Month,Day:CARDINAL):BOOLEAN; 715 VAR 716 R : SYSTEM.Registers; 717 BEGIN 718 WITH R DO 719 AX := 2B00H; 720 CX := Year; 721 DH := SHORTCARD(Month); 722 DL := SHORTCARD(Day); 723 (*%T _WINDOWS *) 724 DS := Seg(R); 725 ES := Seg(R); 726 (*%E *) 727 Lib.Dos(R); 728 RETURN AX=0; 729 END; (*WITH*) 730 END SetDate; 731 732 TYPE 733 ErrStr = ARRAY [0..79] OF CHAR; 734 ErrStrPtr = POINTER TO ErrStr; 735 LA3 = ARRAY [0..2] OF SHORTCARD; 736 CONST 737 Ln = LA3(0DH, 0AH, 0); 738 739 740 PROCEDURE WriteErrorString(Err: ErrStrPtr); 741 742 VAR 743 R: SYSTEM.Registers; 744 BEGIN 745 R.AH := 40H; 746 R.BX := 1; 747 R.CX := Str.Length(Err^); 748 R.DX := Ofs(Err^); 749 R.DS := Seg(Err^); 750 Dos(R); 751 END WriteErrorString; 752 (*%E *) 753 754 (*%T _OS2 *) 755 VAR 756 nullstr[0:0] : ARRAY[0..3] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 757 758 PROCEDURE Execute (Name : ARRAY OF CHAR; (* full name of program *) ***** ^ not supported yet 759 CommandLine : ARRAY OF CHAR; (* command line for program *) ***** ^ not supported yet 760 StoreAddr : FarADDRESS; (* storage to execute in, MSDOS only *) ***** ^ undeclared identifier 761 StoreLen : CARDINAL (* length of store paragraphs, MSDOS only *) 762 ) : CARDINAL; (* DOS reply (0=OK) *) 763 CONST 764 max = 299; 765 VAR 766 retcode:RESULTCODES; ObjNameBuf:ARRAY [0..49] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 767 i,j:CARDINAL; 768 cline:ARRAY [0..max] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 769 Ret: CARDINAL; 770 BEGIN 771 Str.Concat(cline,Name,' '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 772 i := Str.Length(cline)-1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 773 Str.Append(cline,CommandLine); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 774 j := Str.Length(cline); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 775 IF j0) DO DEC(i); msg[i] := ' ' END; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 812 Str.Concat(S,'OS/2 ERROR ',msg); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 813 END; 814 END OSErrorMessage; ***** ^ not supported yet 815 816 PROCEDURE OSFatalError( S : ARRAY OF CHAR; ***** ^ not supported yet 817 N : CARDINAL ); 818 VAR 819 msg : ARRAY[0..255] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 820 BEGIN 821 IF N=0 THEN RETURN END; 822 OSErrorMessage(N,msg); ***** ^ not supported yet ***** ^ not supported yet 823 Str.Concat(msg,' ',msg); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 824 Str.Concat(msg,S,msg); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 825 RunTimeError(CoreSig._FatalErrorPos(), 0D2H, msg); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 826 END OSFatalError; ***** ^ not supported yet 827 828 PROCEDURE GetTime ( VAR Hrs,Mins,Secs,Hsecs : CARDINAL ); 829 830 VAR d : DATETIME; 831 r : CARDINAL; 832 BEGIN 833 r := GetDateTime(d); ***** ^ not supported yet ***** ^ not supported yet 834 Hrs := CARDINAL(d.hours); ***** ^ not supported yet ***** ^ not supported yet 835 Mins := CARDINAL(d.minutes); ***** ^ not supported yet ***** ^ not supported yet 836 Secs := CARDINAL(d.seconds); ***** ^ not supported yet ***** ^ not supported yet 837 Hsecs := CARDINAL(d.hundredths); ***** ^ not supported yet ***** ^ not supported yet 838 END GetTime; ***** ^ not supported yet 839 840 PROCEDURE SetTime (Hrs,Mins,Secs,Hsecs : CARDINAL ): BOOLEAN; 841 842 VAR d : DATETIME; 843 r : CARDINAL; 844 BEGIN 845 r := GetDateTime(d); ***** ^ not supported yet ***** ^ not supported yet 846 d.hours:=SHORTCARD(Hrs); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 847 d.minutes:=SHORTCARD(Mins); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 848 d.seconds:=SHORTCARD(Secs); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 849 d.hundredths:=SHORTCARD(Hsecs); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 850 r := SetDateTime(d); ***** ^ not supported yet ***** ^ not supported yet 851 RETURN BOOLEAN(r); ***** ^ not supported yet 852 END SetTime; ***** ^ not supported yet 853 854 PROCEDURE GetDate ( VAR Year,Month,Day : CARDINAL; 855 VAR DayOfWeek : DayType ); ***** ^ undeclared identifier 856 857 VAR d : DATETIME; 858 r : CARDINAL; 859 BEGIN 860 r := GetDateTime(d); ***** ^ not supported yet ***** ^ not supported yet 861 Year := CARDINAL(d.year); ***** ^ not supported yet ***** ^ not supported yet 862 Month := CARDINAL(d.month); ***** ^ not supported yet ***** ^ not supported yet 863 Day := CARDINAL(d.day); ***** ^ not supported yet ***** ^ not supported yet 864 DayOfWeek := DayType(d.weekday); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 865 END GetDate; ***** ^ not supported yet 866 867 PROCEDURE SetDate (Year,Month,Day : CARDINAL): BOOLEAN; 868 869 VAR d : DATETIME; 870 r : CARDINAL; 871 BEGIN 872 r := GetDateTime(d); ***** ^ not supported yet ***** ^ not supported yet 873 d.year:=CARDINAL(Year); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 874 d.month:=SHORTCARD(Month); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 875 d.day:=SHORTCARD(Day); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 876 r := SetDateTime(d); ***** ^ not supported yet ***** ^ not supported yet 877 RETURN BOOLEAN(r); ***** ^ not supported yet 878 END SetDate; ***** ^ not supported yet 879 880 881 TYPE 882 ErrStr = ARRAY [0..79] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 883 ErrStrPtr = POINTER TO ErrStr; ***** ^ not supported yet 884 LA3 = ARRAY [0..2] OF SHORTCARD; ***** ^ not supported yet ***** ^ not supported yet 885 CONST 886 Ln = LA3(0DH, 0AH, 0); ***** ^ not supported yet 887 888 PROCEDURE WriteErrorString(Err: ErrStrPtr); 889 890 VAR 891 NumWrit: CARDINAL; 892 BEGIN 893 IF Write(1, FarADR(Err^), Str.Length(Err^)+1, NumWrit) = 0 THEN END; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 894 END WriteErrorString; ***** ^ not supported yet 895 (*%E *) 896 897 PROCEDURE FatalError(S : ARRAY OF CHAR); ***** ^ not supported yet 898 899 BEGIN 900 WriteErrorString(ADR(S)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 901 WriteErrorString(ADR(Ln)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 902 HALT; ***** ^ undeclared identifier 903 END FatalError; ***** ^ not supported yet 904 905 PROCEDURE WrDosError ( ErrorNo : SHORTCARD ); 906 907 VAR 908 EStr: ErrStrPtr; ***** ^ not supported yet 909 Temp: ARRAY [0..9] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 910 OK: BOOLEAN; 911 BEGIN 912 CASE ErrorNo OF 913 0 : EStr := ADR('OK'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 914 | 1 : EStr := ADR('Invalid function number'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 915 | 2 : EStr := ADR('File not found'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 916 | 3 : EStr := ADR('Path not found'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 917 | 4 : EStr := ADR('Too many open files (no handles left)'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 918 | 5 : EStr := ADR('Access denied'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 919 | 6 : EStr := ADR('Invalid handle'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 920 | 7 : EStr := ADR('Memory control blocks destroyed'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 921 | 8 : EStr := ADR('Insufficient memory'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 922 | 9 : EStr := ADR('Invalid memory block address'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 923 | 10 : EStr := ADR('Invalid environment'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 924 | 11 : EStr := ADR('Invalid format'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 925 | 12 : EStr := ADR('Invalid access code'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 926 | 13 : EStr := ADR('Invalid data'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 927 (*14 : Reserved *) 928 | 15 : EStr := ADR('Invalid drive was specified'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 929 | 16 : EStr := ADR('Attempt to remove the current directory'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 930 | 17 : EStr := ADR('Not same device'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 931 | 18 : EStr := ADR('No more files'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 932 | 19 : EStr := ADR('Attempt to write on write-protected diskette'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 933 | 20 : EStr := ADR('Unknown unit'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 934 | 21 : EStr := ADR('Drive not ready'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 935 | 22 : EStr := ADR('Unknown command'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 936 | 23 : EStr := ADR('Data error (CRC)'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 937 | 24 : EStr := ADR('Bad request structure length'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 938 | 25 : EStr := ADR('Seek error'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 939 | 26 : EStr := ADR('Unknown media type'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 940 | 27 : EStr := ADR('Sector not found'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 941 | 28 : EStr := ADR('Printer out of paper'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 942 | 29 : EStr := ADR('Write fault'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 943 | 30 : EStr := ADR('Read fault'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 944 | 31 : EStr := ADR('General failure'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 945 | 32 : EStr := ADR('Sharing Violation'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 946 | 33 : EStr := ADR('Lock Violation'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 947 | 34 : EStr := ADR('Invalid disk change'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 948 | 35 : EStr := ADR('FCB unavailable'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 949 (*36..79 : Reserved *) 950 | 80 : EStr := ADR('File exists'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 951 (*81 : Reserved *) 952 | 82 : EStr := ADR('Cannot Make'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 953 | 83 : EStr := ADR('Fail on INT 24'); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 954 | 0F0H:EStr := ADR('Disk Full (write failed)'); (* JPI internal *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 955 ELSE 956 WriteErrorString(ADR('Unknown DOS Error : ')); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 957 Str.CardToStr(LONGCARD(ErrorNo), Temp, 4, OK); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 958 WriteErrorString(ADR(Temp)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 959 RETURN; 960 END; 961 WriteErrorString(EStr); ***** ^ not supported yet ***** ^ not supported yet 962 WriteErrorString(ADR(Ln)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 963 END WrDosError; ***** ^ not supported yet 964 965 (*%F _OS2 *) 966 PROCEDURE OSErrorMessage ( N : CARDINAL; VAR S : ARRAY OF CHAR ); 967 VAR 968 NS : ARRAY[0..5] OF CHAR; 969 i : CARDINAL; 970 EStr: POINTER TO ErrStr; 971 BEGIN 972 CASE N OF 973 0 : EStr := ADR('OK'); 974 | 1 : EStr := ADR('Invalid function number'); 975 | 2 : EStr := ADR('File not found'); 976 | 3 : EStr := ADR('Path not found'); 977 | 4 : EStr := ADR('Too many open files (no handles left)'); 978 | 5 : EStr := ADR('Access denied'); 979 | 6 : EStr := ADR('Invalid handle'); 980 | 7 : EStr := ADR('Memory control blocks destroyed'); 981 | 8 : EStr := ADR('Insufficient memory'); 982 | 9 : EStr := ADR('Invalid memory block address'); 983 | 10 : EStr := ADR('Invalid environment'); 984 | 11 : EStr := ADR('Invalid format'); 985 | 12 : EStr := ADR('Invalid access code'); 986 | 13 : EStr := ADR('Invalid data'); 987 (*14 : Reserved *) 988 | 15 : EStr := ADR('Invalid drive was specified'); 989 | 16 : EStr := ADR('Attempt to remove the current directory'); 990 | 17 : EStr := ADR('Not same device'); 991 | 18 : EStr := ADR('No more files'); 992 | 19 : EStr := ADR('Attempt to write on write-protected diskette'); 993 | 20 : EStr := ADR('Unknown unit'); 994 | 21 : EStr := ADR('Drive not ready'); 995 | 22 : EStr := ADR('Unknown command'); 996 | 23 : EStr := ADR('Data error (CRC)'); 997 | 24 : EStr := ADR('Bad request structure length'); 998 | 25 : EStr := ADR('Seek error'); 999 | 26 : EStr := ADR('Unknown media type'); 1000 | 27 : EStr := ADR('Sector not found'); 1001 | 28 : EStr := ADR('Printer out of paper'); 1002 | 29 : EStr := ADR('Write fault'); 1003 | 30 : EStr := ADR('Read fault'); 1004 | 31 : EStr := ADR('General failure'); 1005 | 32 : EStr := ADR('Sharing Violation'); 1006 | 33 : EStr := ADR('Lock Violation'); 1007 | 34 : EStr := ADR('Invalid disk change'); 1008 | 35 : EStr := ADR('FCB unavailable'); 1009 (*36..79 : Reserved *) 1010 | 80 : EStr := ADR('File exists'); 1011 (*81 : Reserved *) 1012 | 82 : EStr := ADR('Cannot Make'); 1013 | 83 : EStr := ADR('Fail on INT 24'); 1014 | 0F0H:EStr := ADR('Disk Full (write failed)'); (* JPI internal *) 1015 ELSE 1016 Str.Copy(S,'Unknown DOS Error : '); 1017 NS := ' '; 1018 i := 4; 1019 REPEAT 1020 NS[i] := CHR(48+N MOD 10); 1021 DEC(i); 1022 N := N DIV 10; 1023 UNTIL N=0; 1024 Str.Append(S,NS); 1025 RETURN; 1026 END; 1027 Str.Copy(S, EStr^); 1028 END OSErrorMessage; 1029 1030 PROCEDURE OSFatalError ( S : ARRAY OF CHAR; N : CARDINAL ); 1031 VAR 1032 S2:ARRAY[0..127] OF CHAR; 1033 BEGIN 1034 OSErrorMessage(N,S2); 1035 Str.Concat(S2,S,S2); 1036 WriteErrorString(ADR(S2)); 1037 RunTimeError(CoreSig._FatalErrorPos(), 0D2H, S); 1038 END OSFatalError; 1039 (*%E *) 1040 1041 PROCEDURE SysErrno(): CARDINAL; 1042 1043 VAR 1044 EP: CoreSig.ErrnoPtr; ***** ^ not supported yet 1045 BEGIN 1046 EP:=CoreSig._errno__(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1047 RETURN CARDINAL(EP^); ***** ^ not supported yet 1048 END SysErrno; ***** ^ not supported yet 1049 1050 PROCEDURE RunTimeErrorHandler(ErrAdd: LONGCARD; Code: CARDINAL; Msg: ARRAY OF CHAR); ***** ^ undeclared identifier ***** ^ not supported yet 1051 1052 BEGIN 1053 WriteErrorString(ADR(Msg)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1054 WriteErrorString(ADR(Ln)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1055 CoreSig._FatalError(ErrAdd, Code); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1056 END RunTimeErrorHandler; ***** ^ not supported yet 1057 1058 1059 PROCEDURE MakeAllPath(VAR Path: ARRAY OF CHAR; Drive, Dir, Name, Ext: ARRAY OF CHAR); ***** ^ not supported yet ***** ^ not supported yet 1060 1061 VAR 1062 Pos: CARDINAL; 1063 BEGIN 1064 Str.Copy(Path, Drive); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1065 IF Dir[0] # CHAR(0) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1066 Str.Append(Path, Dir); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1067 Pos:=Str.Length(Path)-1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1068 IF NOT((Path[Pos] = '\') OR (Path[Pos] = '/')) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1069 Path[Pos+1]:='\'; ***** ^ not supported yet ***** ^ not supported yet 1070 Path[Pos+2]:=CHAR(0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1071 END; 1072 END; 1073 Str.Append(Path, Name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1074 IF Ext[0] # CHAR(0) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1075 IF Ext[0] # '.'THEN ***** ^ not supported yet ***** ^ not supported yet 1076 Pos:=Str.Length(Path); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1077 Path[Pos]:='.'; ***** ^ not supported yet ***** ^ not supported yet 1078 Path[Pos+1]:=CHAR(0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1079 END; 1080 Str.Append(Path, Ext); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1081 END; 1082 RETURN; 1083 END MakeAllPath; ***** ^ not supported yet 1084 1085 PROCEDURE SplitAllPath(Path: ARRAY OF CHAR; VAR Drive: ARRAY OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 1086 VAR Dir: ARRAY OF CHAR; VAR Name: ARRAY OF CHAR; VAR Ext: ARRAY OF CHAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1087 1088 VAR 1089 n, p: CARDINAL; 1090 Dir_start, Name_start, Ext_start, Path_end: CARDINAL; 1091 c: CHAR; 1092 BEGIN 1093 n := 0; 1094 IF (Path[0] # 0C) AND ((Path[1] = ':') OR (Path[2] = ':')) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1095 REPEAT 1096 c := Path[n]; ***** ^ not supported yet ***** ^ not supported yet 1097 Drive[n] := c; ***** ^ not supported yet ***** ^ not supported yet 1098 INC(n); ***** ^ undeclared identifier ***** ^ not supported yet 1099 UNTIL ((c = ':') OR (n > HIGH(Drive))); ***** ^ undeclared identifier ***** ^ not supported yet 1100 END; 1101 IF n <= HIGH(Drive) THEN ***** ^ undeclared identifier ***** ^ not supported yet 1102 Drive[n] := 0C; ***** ^ not supported yet ***** ^ not supported yet 1103 END; 1104 Dir_start := n; 1105 Name_start := n; 1106 Ext_start := MAX(CARDINAL); ***** ^ undeclared identifier ***** ^ not supported yet 1107 LOOP 1108 c := Path[n]; ***** ^ not supported yet ***** ^ not supported yet 1109 IF c = 0C THEN EXIT END; 1110 CASE c OF 1111 | '.' : 1112 IF(NOT((Path[n+1] = '.') OR (Path[n+1] = '\') OR (Path[n+1] = '/'))) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1113 Ext_start := n; 1114 END; 1115 INC(n); ***** ^ undeclared identifier ***** ^ not supported yet 1116 | '/', '\' : 1117 INC(n); ***** ^ undeclared identifier ***** ^ not supported yet 1118 Name_start := n; 1119 ELSE 1120 INC(n); ***** ^ undeclared identifier ***** ^ not supported yet 1121 END; 1122 END; 1123 Path_end := n; 1124 IF Ext_start = MAX(CARDINAL) THEN ***** ^ undeclared identifier ***** ^ not supported yet 1125 Ext_start := n; 1126 END; 1127 n:= Dir_start; 1128 p := 0; 1129 WHILE ((n < Name_start) AND (p <= HIGH(Dir)) AND (n= Name_start) THEN 1149 n := Ext_start; 1150 WHILE (n < Path_end) AND (p <= HIGH(Ext)) DO ***** ^ undeclared identifier ***** ^ not supported yet 1151 Ext[p] := Path[n]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1152 INC(n); ***** ^ undeclared identifier ***** ^ not supported yet 1153 INC(p); ***** ^ undeclared identifier ***** ^ not supported yet 1154 END; 1155 END; 1156 IF p <= HIGH(Ext) THEN ***** ^ undeclared identifier ***** ^ not supported yet 1157 Ext[p] := 0C; ***** ^ not supported yet ***** ^ not supported yet 1158 END; 1159 END SplitAllPath; ***** ^ not supported yet 1160 1161 (*%F _OS2 *) 1162 TYPE 1163 (*# save,data(near_ptr=>off) *) 1164 FarCharPtr = POINTER TO CHAR; 1165 (*# restore *) 1166 VAR 1167 n: CARDINAL; 1168 BEGIN 1169 HistoryPtr := 0; 1170 LowerPtr := 0; 1171 ExecSearchPath := TRUE; 1172 NilStr[0] := 0C; 1173 (*%F _WINDLL *) 1174 PSP := CoreMain._psp; 1175 [PSP: 81H+CARDINAL([PSP:80H FarCharPtr]^) FarCharPtr]^ := 0C; 1176 CommandLine := [PSP: 81H CommandType]; 1177 n := 0; 1178 WHILE CommandLine^[n] = ' ' DO 1179 INC(n); 1180 END; 1181 INC(CARDINAL(CommandLine),n); 1182 (*%E *) 1183 RunTimeError := RunTimeErrorHandler; 1184 (*%E *) 1185 1186 (*%T _OS2 *) 1187 (*# save *) 1188 (*# data(near_ptr=>off) *) 1189 TYPE bp=POINTER TO SHORTCARD; ***** ^ not supported yet 1190 wp=POINTER TO CARDINAL; ***** ^ not supported yet 1191 (*# restore *) 1192 1193 VAR 1194 seg, ofs, lim, n : CARDINAL; 1195 1196 BEGIN 1197 HistoryPtr := 0; 1198 LowerPtr := 0; 1199 ExecSearchPath := TRUE; ***** ^ undeclared identifier 1200 NilStr[0] := 0C; ***** ^ undeclared identifier ***** ^ not supported yet 1201 IF (GetEnv(seg,ofs)=0) THEN END; ***** ^ not supported yet ***** ^ not supported yet 1202 (*%F _XTD *) 1203 lim := SelectorLimit(seg); 1204 LOOP 1205 INC(ofs); 1206 IF ofs>lim THEN (* bug in 1.0/Codeview *) 1207 ofs := 1; 1208 [seg:0 wp]^ := 0; 1209 [seg:2 wp]^ := 0; 1210 EXIT; 1211 END; 1212 IF [seg:ofs-1 bp]^ = 0 THEN EXIT END; 1213 END; 1214 CommandLine := [seg:ofs]; 1215 IF CommandLine # FarNIL THEN 1216 n := 0; 1217 WHILE CommandLine^[n] = ' ' DO 1218 INC(n); 1219 END; 1220 INC(CARDINAL(CommandLine), n); 1221 END; 1222 (*%E *) 1223 (*%T _XTD*) 1224 WHILE [seg:ofs bp]^ # 0 DO ***** ^ not supported yet ***** ^ not supported yet 1225 INC(ofs); ***** ^ undeclared identifier ***** ^ not supported yet 1226 END; (*WHILE*) 1227 REPEAT 1228 INC(ofs); ***** ^ undeclared identifier ***** ^ not supported yet 1229 UNTIL [seg:ofs bp]^ # 20H; ***** ^ not supported yet ***** ^ not supported yet 1230 CommandLine := [seg:ofs]; ***** ^ undeclared identifier ***** ^ not supported yet 1231 PSP := CoreMain._psp; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 1232 (*%E*) 1233 RunTimeError:=RunTimeErrorHandler; ***** ^ undeclared identifier ***** ^ not supported yet 1234 (*%E *) 1235 END Lib. ***** ^ not supported yet 906 errors