2 /** This is part of the body of the GPCP runtime support.
3 *
4 * Written November 1998, John Gough.
5 *
6 * CP*rts contains the runtime helpers, this class has
7 * adapters for hooking into the various Native libraries.
8 * These are the user accessible parts of the runtime. The
9 * facilities in CP*rts are known to each code-emitter, but
10 * have no CP-accessible functions. The interface to the
11 * user-accessible functions are defined in RTS.cp, and the
12 * code is defined in this file.
13 *
14 * Version of 29 March 2000 (kjg) --
15 * There is a swindle involved here, for the bootstrap version
16 * of the compiler: any functions with OUT scalars will have
17 * a different signature in the old and new versions. This
18 * module implements both, by overloading the methods.
19 *
20 * Version of October 2011 -- JVM version brought into line
21 * with the CP definition used by the current .NET version.
22 * Only the required methods are defined, the bootstrap
23 * versions have been removed.
24 */
33 /* ------------------------------------------------------------ */
34 /* Support for RTS.cp */
35 /* ------------------------------------------------------------ */
36 /* The text of RTS.cp is interleaved here to associate the */
37 /* java with the promises of the Component Pascal source. */
38 /* ------------------------------------------------------------ */
39 //
40 // SYSTEM MODULE RTS;
42 public final class RTS
43 {
44 /* Some Initializations ... */
47 //
48 // VAR defaultTarget- : ARRAY 4 OF CHAR;
49 // fltNegInfinity- : SHORTREAL;
50 // fltPosInfinity- : SHORTREAL;
51 // dblNegInfinity- : REAL;
52 // dblPosInfinity- : REAL;
59 //
60 // TYPE CharOpen* = POINTER TO ARRAY OF CHAR;
61 //
62 // TYPE NativeType* = POINTER TO ABSTRACT RECORD END;
63 // NativeObject* = POINTER TO ABSTRACT RECORD END;
64 // NativeString* = POINTER TO RECORD END;
65 // NativeException*= POINTER TO EXTENSIBLE RECORD END;
66 //
67 // VAR eol- : POINTER TO ARRAY OF CHAR; (* OS-specific end of line string *)
68 //
70 //
71 // (* ========================================================== *)
72 // (* ============= Support for native exceptions ============== *)
73 // (* ========================================================== *)
74 // PROCEDURE getStr*(x : NativeException) : CharOpen;
79 }
81 //
82 // --------------------------------------------------------------
83 // PROCEDURE Throw*(IN s : ARRAY OF CHAR);
84 // (** Abort execution with an error *)
88 }
90 /* ------------------------------------------------------------ */
91 // PROCEDURE TypeName*(str : NativeType) : CharOpen;
92 // (* Get the character at zero-based index idx *)
93 //
96 }
98 /* ------------------------------------------------------------ */
99 // PROCEDURE CharAtIndex*(str : NativeString; idx : INTEGER) : CHAR;
100 // (* Get the character at zero-based index idx *)
101 //
104 /* ------------------------------------------------------------ */
105 // PROCEDURE Length*(str : NativeString) : INTEGER;
106 // (* Get the length of the native string *)
107 //
112 //
113 // (* ========================================================== *)
114 // (* ============= Conversions FROM array of char ============= *)
115 // (* ========================================================== *)
116 // PROCEDURE StrToBool*(IN s : ARRAY OF CHAR; OUT b : BOOLEAN; OUT ok : BOOLEAN);
117 // (** Parse array into a BOOLEAN TRUE/FALSE *)
118 //
121 {
128 }
129 }
130 //
131 // --------------------------------------------------------------
132 // PROCEDURE StrToByte*(IN s : ARRAY OF CHAR; OUT b : BYTE; OUT ok : BOOLEAN);
133 // (** Parse array into a BYTE integer (unsigned byte in CP *)
134 //
137 {
144 }
147 }
148 //
149 // --------------------------------------------------------------
150 // PROCEDURE StrToUByte*(IN s : ARRAY OF CHAR; OUT b : BYTE; OUT ok : BOOLEAN);
151 // (** Parse array into a BYTE integer *)
152 //
155 {
162 }
165 }
166 //
167 // --------------------------------------------------------------
168 // PROCEDURE StrToShort*(IN s : ARRAY OF CHAR; OUT si : SHORTINT; OUT ok : BOOLEAN);
169 // (** Parse an array into a CP SHORTINT *)
170 //
173 {
180 }
183 }
184 //
185 // --------------------------------------------------------------
186 // PROCEDURE StrToUShort*(IN s:ARRAY OF CHAR; OUT si:SHORTINT; OUT ok:BOOLEAN);
187 // (** Parse an array into a CP Unsigned SHORTINT *)
188 //
191 {
198 }
201 }
202 //
203 // --------------------------------------------------------------
204 // PROCEDURE StrToInt*(IN s:ARRAY OF CHAR; OUT i:INTEGER; OUT ok:BOOLEAN);
205 // (** Parse an array into a CP INTEGER *)
206 // (* Note that first OUT or VAR scalar becomes return value if a pure procedure *)
207 //
210 {
217 }
218 }
219 //
220 // --------------------------------------------------------------
221 // PROCEDURE StrToUInt*(IN s:ARRAY OF CHAR; OUT i:INTEGER; OUT ok:BOOLEAN);
222 // (** Parse an array into a CP INTEGER *)
223 //
226 {
233 }
236 }
237 //
238 // --------------------------------------------------------------
239 // PROCEDURE StrToLong*(IN s:ARRAY OF CHAR; OUT i:LONGINT; OUT ok:BOOLEAN);
240 // (** Parse an array into a CP LONGINT *)
241 //
244 {
251 }
252 }
253 //
254 // --------------------------------------------------------------
255 // PROCEDURE StrToULong*(IN s:ARRAY OF CHAR; OUT i:LONGINT; OUT ok:BOOLEAN);
256 // (** Parse an array into a CP LONGINT *)
257 //
258 // Throw method not found exception.
259 //
260 // --------------------------------------------------------------
261 // PROCEDURE HexStrToUByte*(IN s:ARRAY OF CHAR; OUT b:BYTE; OUT ok:BOOLEAN);
262 // (** Parse hexadecimal array into a BYTE integer *)
263 //
266 {
273 }
274 }
275 //
276 // (* ------------------- Low-level String Conversions -------------------- *)
277 // (* Three versions for different cultures. *Invar uses invariant culture *)
278 // (* *Local uses current locale *)
279 // (* StrToReal & RealToStr do not behave the same on JVM and CLR. *)
280 // (* They is provided for compatability with versions < 1.3.1 *)
281 // (* ------------------- Low-level String Conversions -------------------- *)
282 //
283 // PROCEDURE StrToReal*(IN s : ARRAY OF CHAR;
284 // OUT r : REAL;
285 // OUT ok : BOOLEAN);
286 // (** Parse array into an ieee double REAL *)
287 //
290 {
297 }
298 }
299 //
300 // --------------------------------------------------------------
301 // PROCEDURE StrToRealInvar*(IN s : ARRAY OF CHAR;
302 // OUT r : REAL;
303 // OUT ok : BOOLEAN);
304 // (** Parse array using invariant culture, into an ieee double REAL *)
305 //
308 {
315 }
316 }
317 //
318 // --------------------------------------------------------------
319 // PROCEDURE StrToRealLocal*(IN s : ARRAY OF CHAR;
320 // OUT r : REAL;
321 // OUT ok : BOOLEAN);
322 // (** Parse array using current locale, into an ieee double REAL *)
323 //
326 {
333 }
334 }
335 //
336 // --------------------------------------------------------------
337 // PROCEDURE StrToSReal*(IN s : ARRAY OF CHAR;
338 // OUT r : SHORTREAL;
339 // OUT ok : BOOLEAN);
340 //
343 {
350 }
351 }
352 //
353 // --------------------------------------------------------------
354 // PROCEDURE StrToSRealInvar*(IN s : ARRAY OF CHAR;
355 // OUT r : SHORTREAL;
356 // OUT ok : BOOLEAN);
357 //
360 {
367 }
368 }
369 //
370 // --------------------------------------------------------------
371 // PROCEDURE StrToSRealLocal*(IN s : ARRAY OF CHAR;
372 // OUT r : SHORTREAL;
373 // OUT ok : BOOLEAN);
374 // (** Parse array into a short REAL *)
375 //
378 {
385 }
386 }
387 //
388 // (* ========================================================== *)
389 // (* ============== Conversions TO array of char ============== *)
390 // (* ========================================================== *)
391 // PROCEDURE RealToStr*(r : REAL; OUT s : ARRAY OF CHAR);
392 // (** Decode a CP REAL into an array *)
393 //
396 {
403 }
404 //
405 // --------------------------------------------------------------
406 // PROCEDURE RealToStrInvar*(r : REAL; OUT s : ARRAY OF CHAR);
407 // (** Decode a CP REAL into an array in invariant culture *)
408 //
411 {
418 }
419 //
420 // --------------------------------------------------------------
421 // PROCEDURE RealToStrLocal*(r : REAL; OUT s : ARRAY OF CHAR);
422 // (** Decode a CP REAL into an array in the current locale *)
423 //
426 {
433 }
434 //
435 // --------------------------------------------------------------
436 // PROCEDURE SRealToStr*(r : SHORTREAL; OUT s : ARRAY OF CHAR);
437 //
440 {
447 }
448 //
449 // --------------------------------------------------------------
450 // PROCEDURE SRealToStrInvar*(r : SHORTREAL; OUT s : ARRAY OF CHAR);
451 //
454 {
461 }
462 //
463 // --------------------------------------------------------------
464 // PROCEDURE SRealToStrLocal*(r : SHORTREAL; OUT s : ARRAY OF CHAR);
465 // (** Decode a CP SHORTREAL into an array *)
466 //
469 {
476 }
477 //
478 // --------------------------------------------------------------
479 // PROCEDURE IntToStr*(i : INTEGER; OUT s : ARRAY OF CHAR);
480 // (** Decode a CP INTEGER into an array *)
481 //
484 {
491 }
492 //
493 // --------------------------------------------------------------
494 // PROCEDURE ObjToStr*(obj : ANYPTR; OUT s : ARRAY OF CHAR);
495 // (** Decode a CP INTEGER into an array *)
496 //
499 }
500 //
501 // --------------------------------------------------------------
502 // PROCEDURE LongToStr*(i : LONGINT; OUT s : ARRAY OF CHAR);
503 // (** Decode a CP INTEGER into an array *)
504 //
507 {
514 }
515 //
516 // (* ========================================================== *)
517 // (* ========== Casts with no representation change =========== *)
518 // (* ========================================================== *)
519 // PROCEDURE realToLongBits*(r : REAL) : LONGINT;
520 // (** Convert an ieee double into a longint with same bit pattern *)
521 //
524 }
525 //
526 // --------------------------------------------------------------
527 // PROCEDURE longBitsToReal*(l : LONGINT) : REAL;
528 // (** Convert an ieee double into a longint with same bit pattern *)
529 //
532 }
533 //
534 // --------------------------------------------------------------
535 // PROCEDURE shortRealToIntBits*(r : SHORTREAL) : INTEGER;
536 // (** Convert an ieee float into an int with same bit pattern *)
537 //
540 }
541 //
542 // --------------------------------------------------------------
543 // PROCEDURE intBitsToShortReal*(i : INTEGER) : SHORTREAL;
544 // (** Convert an int into an ieee float with same bit pattern *)
545 //
548 }
549 //
550 // --------------------------------------------------------------
551 // PROCEDURE hiByte*(i : SHORTINT) : BYTE;
552 // (** Get hi-significant word of short *)
553 //
556 }
557 //
558 // --------------------------------------------------------------
559 // PROCEDURE loByte*(i : SHORTINT) : BYTE;
560 // (** Get lo-significant word of short *)
561 //
564 }
565 //
566 // --------------------------------------------------------------
567 // PROCEDURE hiShort*(i : INTEGER) : SHORTINT;
568 // (** Get hi-significant word of integer *)
569 //
572 }
573 //
574 // --------------------------------------------------------------
575 // PROCEDURE loShort*(i : INTEGER) : SHORTINT;
576 // (** Get lo-significant word of integer *)
577 //
580 }
581 //
582 // --------------------------------------------------------------
583 // PROCEDURE hiInt*(l : LONGINT) : INTEGER;
584 // (** Get hi-significant word of long integer *)
585 //
588 }
589 //
590 // --------------------------------------------------------------
591 // PROCEDURE loInt*(l : LONGINT) : INTEGER;
592 // (** Get lo-significant word of long integer *)
593 //
596 }
597 //
598 // (* ========================================================== *)
599 // (* ============= Various utility procedures ================= *)
600 // (* ========================================================== *)
601 //
602 // PROCEDURE GetMillis*() : LONGINT;
603 // (** Get time in milliseconds *)
607 }
608 //
609 // --------------------------------------------------------------
610 // PROCEDURE GetDateString*(OUT str : ARRAY OF CHAR);
611 // (** Get a date string in some native format *)
612 //
618 }
619 //
620 // --------------------------------------------------------------
621 // PROCEDURE ClassMarker*(o : ANYPTR);
622 // (** Write class name to standard output *)
623 //
626 }
627 //
628 // END RTS.
629 /* ------------------------------------------------------------ */
630 /* ------------------------------------------------------------ */
631 /* ------------------------------------------------------------ */
632 }