mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-05 22:12:24 +00:00
ported ethDates, ethReals, ethStrings. -- noch
This commit is contained in:
Norayr Chilingarian
parent
74a518efe9
commit
63dc2c5c31
17 changed files with 2424 additions and 227 deletions
5
makefile
5
makefile
|
|
@ -9,7 +9,7 @@ RELEASE = 1.1
|
|||
|
||||
INCLUDEPATH = -Isrc/lib/system/$(TOS)/$(CCOMP)/$(TARCH)
|
||||
|
||||
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/v4/$(TARCH):src/lib/system/$(TOS)/$(CCOMP):src/lib/system/$(TOS)/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(TOS)/$(CCOMP):src/lib/ooc:src/lib/ooc/$(TOS)/$(CCOMP)/$(TARCH):src/lib/pow:src/lib/misc:src/lib/s3:src/voc:src/voc/$(TOS)/$(CCOMP):src/voc/$(TOS)/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/vmake:src/tools/coco:src/test
|
||||
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/v4/$(TARCH):src/lib/system/$(TOS)/$(CCOMP):src/lib/system/$(TOS)/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(TOS)/$(CCOMP):src/lib/ooc:src/lib/ooc/$(TOS)/$(CCOMP)/$(TARCH):src/lib/pow:src/lib/misc:src/lib/s3:src/lib/s3/$(TARCH):src/voc:src/voc/$(TOS)/$(CCOMP):src/voc/$(TOS)/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/vmake:src/tools/coco:src/test
|
||||
|
||||
VOC = voc
|
||||
VERSION = $(TOS).$(CCOMP).$(TARCH)
|
||||
|
|
@ -247,6 +247,9 @@ stage6:
|
|||
$(VOCSTATIC) -sPF ethGZReaders.Mod
|
||||
$(VOCSTATIC) -sPF ethGZWriters.Mod
|
||||
$(VOCSTATIC) -sPF ethUnicode.Mod
|
||||
$(VOCSTATIC) -sPF ethDates.Mod
|
||||
$(VOCSTATIC) -sPF ethReals.Mod
|
||||
$(VOCSTATIC) -sPF ethStrings.Mod
|
||||
|
||||
# build remaining tools
|
||||
# $(VOCSTATIC0) -sPFS compatIn.Mod
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ RELEASE = 1.1
|
|||
|
||||
INCLUDEPATH = -Isrc/lib/system/$(TOS)/$(CCOMP)/$(TARCH)
|
||||
|
||||
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/v4/$(TARCH):src/lib/system/$(TOS)/$(CCOMP):src/lib/system/$(TOS)/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(TOS)/$(CCOMP):src/lib/ooc:src/lib/ooc/$(TOS)/$(CCOMP)/$(TARCH):src/lib/pow:src/lib/misc:src/lib/s3:src/voc:src/voc/$(TOS)/$(CCOMP):src/voc/$(TOS)/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/vmake:src/tools/coco:src/test
|
||||
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/v4/$(TARCH):src/lib/system/$(TOS)/$(CCOMP):src/lib/system/$(TOS)/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(TOS)/$(CCOMP):src/lib/ooc:src/lib/ooc/$(TOS)/$(CCOMP)/$(TARCH):src/lib/pow:src/lib/misc:src/lib/s3:src/lib/s3/$(TARCH):src/voc:src/voc/$(TOS)/$(CCOMP):src/voc/$(TOS)/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/vmake:src/tools/coco:src/test
|
||||
|
||||
VOC = voc
|
||||
VERSION = $(TOS).$(CCOMP).$(TARCH)
|
||||
|
|
@ -248,6 +248,9 @@ stage6:
|
|||
$(VOCSTATIC) -sP ethGZReaders.Mod
|
||||
$(VOCSTATIC) -sP ethGZWriters.Mod
|
||||
$(VOCSTATIC) -sP ethUnicode.Mod
|
||||
$(VOCSTATIC) -sP ethDates.Mod
|
||||
$(VOCSTATIC) -sP ethReals.Mod
|
||||
$(VOCSTATIC) -sP ethStrings.Mod
|
||||
|
||||
# build remaining tools
|
||||
# $(VOCSTATIC0) -sPS compatIn.Mod
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ RELEASE = 1.1
|
|||
|
||||
INCLUDEPATH = -Isrc/lib/system/$(TOS)/$(CCOMP)/$(TARCH)
|
||||
|
||||
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/v4/$(TARCH):src/lib/system/$(TOS)/$(CCOMP):src/lib/system/$(TOS)/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(TOS)/$(CCOMP):src/lib/ooc:src/lib/ooc/$(TOS)/$(CCOMP)/$(TARCH):src/lib/pow:src/lib/misc:src/lib/s3:src/voc:src/voc/$(TOS)/$(CCOMP):src/voc/$(TOS)/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/vmake:src/tools/coco:src/test
|
||||
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/v4/$(TARCH):src/lib/system/$(TOS)/$(CCOMP):src/lib/system/$(TOS)/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(TOS)/$(CCOMP):src/lib/ooc:src/lib/ooc/$(TOS)/$(CCOMP)/$(TARCH):src/lib/pow:src/lib/misc:src/lib/s3:src/lib/s3/$(TARCH):src/voc:src/voc/$(TOS)/$(CCOMP):src/voc/$(TOS)/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/vmake:src/tools/coco:src/test
|
||||
|
||||
VOC = voc
|
||||
VERSION = $(TOS).$(CCOMP).$(TARCH)
|
||||
|
|
@ -247,6 +247,9 @@ stage6:
|
|||
$(VOCSTATIC) -sP ethGZReaders.Mod
|
||||
$(VOCSTATIC) -sP ethGZWriters.Mod
|
||||
$(VOCSTATIC) -sP ethUnicode.Mod
|
||||
$(VOCSTATIC) -sP ethDates.Mod
|
||||
$(VOCSTATIC) -sP ethReals.Mod
|
||||
$(VOCSTATIC) -sP ethStrings.Mod
|
||||
|
||||
# build remaining tools
|
||||
# $(VOCSTATIC0) -sPS compatIn.Mod
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ RELEASE = 1.1
|
|||
|
||||
INCLUDEPATH = -Isrc/lib/system/$(TOS)/$(CCOMP)/$(TARCH)
|
||||
|
||||
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/v4/$(TARCH):src/lib/system/$(TOS)/$(CCOMP):src/lib/system/$(TOS)/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(TOS)/$(CCOMP):src/lib/ooc:src/lib/ooc/$(TOS)/$(CCOMP)/$(TARCH):src/lib/pow:src/lib/misc:src/lib/s3:src/voc:src/voc/$(TOS)/$(CCOMP):src/voc/$(TOS)/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/vmake:src/tools/coco:src/test
|
||||
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/v4/$(TARCH):src/lib/system/$(TOS)/$(CCOMP):src/lib/system/$(TOS)/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(TOS)/$(CCOMP):src/lib/ooc:src/lib/ooc/$(TOS)/$(CCOMP)/$(TARCH):src/lib/pow:src/lib/misc:src/lib/s3:src/lib/s3/$(TARCH):src/voc:src/voc/$(TOS)/$(CCOMP):src/voc/$(TOS)/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/vmake:src/tools/coco:src/test
|
||||
|
||||
VOC = voc
|
||||
VERSION = $(TOS).$(CCOMP).$(TARCH)
|
||||
|
|
@ -247,6 +247,9 @@ stage6:
|
|||
$(VOCSTATIC) -sPF ethGZReaders.Mod
|
||||
$(VOCSTATIC) -sPF ethGZWriters.Mod
|
||||
$(VOCSTATIC) -sPF ethUnicode.Mod
|
||||
$(VOCSTATIC) -sPF ethDates.Mod
|
||||
$(VOCSTATIC) -sPF ethReals.Mod
|
||||
$(VOCSTATIC) -sPF ethStrings.Mod
|
||||
|
||||
# build remaining tools
|
||||
# $(VOCSTATIC0) -sPFS compatIn.Mod
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ RELEASE = 1.1
|
|||
|
||||
INCLUDEPATH = -Isrc/lib/system/$(TOS)/$(CCOMP)/$(TARCH)
|
||||
|
||||
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/v4/$(TARCH):src/lib/system/$(TOS)/$(CCOMP):src/lib/system/$(TOS)/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(TOS)/$(CCOMP):src/lib/ooc:src/lib/ooc/$(TOS)/$(CCOMP)/$(TARCH):src/lib/pow:src/lib/misc:src/lib/s3:src/voc:src/voc/$(TOS)/$(CCOMP):src/voc/$(TOS)/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/vmake:src/tools/coco:src/test
|
||||
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/v4/$(TARCH):src/lib/system/$(TOS)/$(CCOMP):src/lib/system/$(TOS)/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(TOS)/$(CCOMP):src/lib/ooc:src/lib/ooc/$(TOS)/$(CCOMP)/$(TARCH):src/lib/pow:src/lib/misc:src/lib/s3:src/lib/s3/$(TARCH):src/voc:src/voc/$(TOS)/$(CCOMP):src/voc/$(TOS)/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/vmake:src/tools/coco:src/test
|
||||
|
||||
VOC = voc
|
||||
VERSION = $(TOS).$(CCOMP).$(TARCH)
|
||||
|
|
@ -247,6 +247,9 @@ stage6:
|
|||
$(VOCSTATIC) -sP ethGZReaders.Mod
|
||||
$(VOCSTATIC) -sP ethGZWriters.Mod
|
||||
$(VOCSTATIC) -sP ethUnicode.Mod
|
||||
$(VOCSTATIC) -sP ethDates.Mod
|
||||
$(VOCSTATIC) -sP ethReals.Mod
|
||||
$(VOCSTATIC) -sP ethStrings.Mod
|
||||
|
||||
# build remaining tools
|
||||
# $(VOCSTATIC0) -sPS compatIn.Mod
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ RELEASE = 1.1
|
|||
|
||||
INCLUDEPATH = -Isrc/lib/system/$(TOS)/$(CCOMP)/$(TARCH)
|
||||
|
||||
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/v4/$(TARCH):src/lib/system/$(TOS)/$(CCOMP):src/lib/system/$(TOS)/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(TOS)/$(CCOMP):src/lib/ooc:src/lib/ooc/$(TOS)/$(CCOMP)/$(TARCH):src/lib/pow:src/lib/misc:src/lib/s3:src/voc:src/voc/$(TOS)/$(CCOMP):src/voc/$(TOS)/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/vmake:src/tools/coco:src/test
|
||||
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/v4/$(TARCH):src/lib/system/$(TOS)/$(CCOMP):src/lib/system/$(TOS)/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(TOS)/$(CCOMP):src/lib/ooc:src/lib/ooc/$(TOS)/$(CCOMP)/$(TARCH):src/lib/pow:src/lib/misc:src/lib/s3:src/lib/s3/$(TARCH):src/voc:src/voc/$(TOS)/$(CCOMP):src/voc/$(TOS)/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/vmake:src/tools/coco:src/test
|
||||
|
||||
VOC = voc
|
||||
VERSION = $(TOS).$(CCOMP).$(TARCH)
|
||||
|
|
@ -247,6 +247,9 @@ stage6:
|
|||
$(VOCSTATIC) -sPF ethGZReaders.Mod
|
||||
$(VOCSTATIC) -sPF ethGZWriters.Mod
|
||||
$(VOCSTATIC) -sPF ethUnicode.Mod
|
||||
$(VOCSTATIC) -sPF ethDates.Mod
|
||||
$(VOCSTATIC) -sPF ethReals.Mod
|
||||
$(VOCSTATIC) -sPF ethStrings.Mod
|
||||
|
||||
# build remaining tools
|
||||
# $(VOCSTATIC0) -sPFS compatIn.Mod
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ RELEASE = 1.1
|
|||
|
||||
INCLUDEPATH = -Isrc/lib/system/$(TOS)/$(CCOMP)/$(TARCH)
|
||||
|
||||
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/v4/$(TARCH):src/lib/system/$(TOS)/$(CCOMP):src/lib/system/$(TOS)/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(TOS)/$(CCOMP):src/lib/ooc:src/lib/ooc/$(TOS)/$(CCOMP)/$(TARCH):src/lib/pow:src/lib/misc:src/lib/s3:src/voc:src/voc/$(TOS)/$(CCOMP):src/voc/$(TOS)/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/vmake:src/tools/coco:src/test
|
||||
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/v4/$(TARCH):src/lib/system/$(TOS)/$(CCOMP):src/lib/system/$(TOS)/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(TOS)/$(CCOMP):src/lib/ooc:src/lib/ooc/$(TOS)/$(CCOMP)/$(TARCH):src/lib/pow:src/lib/misc:src/lib/s3:src/lib/s3/$(TARCH):src/voc:src/voc/$(TOS)/$(CCOMP):src/voc/$(TOS)/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/vmake:src/tools/coco:src/test
|
||||
|
||||
VOC = voc
|
||||
VERSION = $(TOS).$(CCOMP).$(TARCH)
|
||||
|
|
@ -247,6 +247,9 @@ stage6:
|
|||
$(VOCSTATIC) -sPF ethGZReaders.Mod
|
||||
$(VOCSTATIC) -sPF ethGZWriters.Mod
|
||||
$(VOCSTATIC) -sPF ethUnicode.Mod
|
||||
$(VOCSTATIC) -sPF ethDates.Mod
|
||||
$(VOCSTATIC) -sPF ethReals.Mod
|
||||
$(VOCSTATIC) -sPF ethStrings.Mod
|
||||
|
||||
# build remaining tools
|
||||
# $(VOCSTATIC0) -sPFS compatIn.Mod
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ RELEASE = 1.1
|
|||
|
||||
INCLUDEPATH = -Isrc/lib/system/$(TOS)/$(CCOMP)/$(TARCH)
|
||||
|
||||
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/v4/$(TARCH):src/lib/system/$(TOS)/$(CCOMP):src/lib/system/$(TOS)/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(TOS)/$(CCOMP):src/lib/ooc:src/lib/ooc/$(TOS)/$(CCOMP)/$(TARCH):src/lib/pow:src/lib/misc:src/lib/s3:src/voc:src/voc/$(TOS)/$(CCOMP):src/voc/$(TOS)/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/vmake:src/tools/coco:src/test
|
||||
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/v4/$(TARCH):src/lib/system/$(TOS)/$(CCOMP):src/lib/system/$(TOS)/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(TOS)/$(CCOMP):src/lib/ooc:src/lib/ooc/$(TOS)/$(CCOMP)/$(TARCH):src/lib/pow:src/lib/misc:src/lib/s3:src/lib/s3/$(TARCH):src/voc:src/voc/$(TOS)/$(CCOMP):src/voc/$(TOS)/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/vmake:src/tools/coco:src/test
|
||||
|
||||
VOC = voc
|
||||
VERSION = $(TOS).$(CCOMP).$(TARCH)
|
||||
|
|
@ -247,6 +247,9 @@ stage6:
|
|||
$(VOCSTATIC) -sPF ethGZReaders.Mod
|
||||
$(VOCSTATIC) -sPF ethGZWriters.Mod
|
||||
$(VOCSTATIC) -sPF ethUnicode.Mod
|
||||
$(VOCSTATIC) -sPF ethDates.Mod
|
||||
$(VOCSTATIC) -sPF ethReals.Mod
|
||||
$(VOCSTATIC) -sPF ethStrings.Mod
|
||||
|
||||
# build remaining tools
|
||||
# $(VOCSTATIC0) -sPFS compatIn.Mod
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ RELEASE = 1.1
|
|||
|
||||
INCLUDEPATH = -Isrc/lib/system/$(TOS)/$(CCOMP)/$(TARCH)
|
||||
|
||||
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/v4/$(TARCH):src/lib/system/$(TOS)/$(CCOMP):src/lib/system/$(TOS)/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(TOS)/$(CCOMP):src/lib/ooc:src/lib/ooc/$(TOS)/$(CCOMP)/$(TARCH):src/lib/pow:src/lib/misc:src/lib/s3:src/voc:src/voc/$(TOS)/$(CCOMP):src/voc/$(TOS)/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/vmake:src/tools/coco:src/test
|
||||
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/v4/$(TARCH):src/lib/system/$(TOS)/$(CCOMP):src/lib/system/$(TOS)/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(TOS)/$(CCOMP):src/lib/ooc:src/lib/ooc/$(TOS)/$(CCOMP)/$(TARCH):src/lib/pow:src/lib/misc:src/lib/s3:src/lib/s3/$(TARCH):src/voc:src/voc/$(TOS)/$(CCOMP):src/voc/$(TOS)/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/vmake:src/tools/coco:src/test
|
||||
|
||||
VOC = voc
|
||||
VERSION = $(TOS).$(CCOMP).$(TARCH)
|
||||
|
|
@ -247,6 +247,9 @@ stage6:
|
|||
$(VOCSTATIC) -sPF ethGZReaders.Mod
|
||||
$(VOCSTATIC) -sPF ethGZWriters.Mod
|
||||
$(VOCSTATIC) -sPF ethUnicode.Mod
|
||||
$(VOCSTATIC) -sPF ethDates.Mod
|
||||
$(VOCSTATIC) -sPF ethReals.Mod
|
||||
$(VOCSTATIC) -sPF ethStrings.Mod
|
||||
|
||||
# build remaining tools
|
||||
# $(VOCSTATIC0) -sPFS compatIn.Mod
|
||||
|
|
|
|||
305
src/lib/s3/armv6j_hardfp/ethReals.Mod
Normal file
305
src/lib/s3/armv6j_hardfp/ethReals.Mod
Normal file
|
|
@ -0,0 +1,305 @@
|
|||
(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
|
||||
Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
|
||||
|
||||
MODULE ethReals; (** portable *)
|
||||
|
||||
(** Implementation of the non-portable components of IEEE REAL and
|
||||
LONGREAL manipulation. The routines here are required to do conversion
|
||||
of reals to strings and back.
|
||||
Implemented by Bernd Moesli, Seminar for Applied Mathematics,
|
||||
Swiss Federal Institute of Technology Z…rich.
|
||||
*)
|
||||
|
||||
IMPORT SYSTEM;
|
||||
|
||||
(* Bernd Moesli
|
||||
Seminar for Applied Mathematics
|
||||
Swiss Federal Institute of Technology Zurich
|
||||
Copyright 1993
|
||||
|
||||
Support module for IEEE floating-point numbers
|
||||
|
||||
Please change constant definitions of H, L depending on byte ordering
|
||||
Use bm.TestReals.Do for testing the implementation.
|
||||
|
||||
Expo, ExpoL return the shifted binary exponent (0 <= e < 256 (2048 resp.))
|
||||
SetExpo, SetExpoL set the shifted binary exponent
|
||||
Real, RealL convert hexadecimals to reals
|
||||
Int, IntL convert reals to hexadecimals
|
||||
Ten returns 10^e (e <= 308, 308 < e delivers NaN)
|
||||
|
||||
1993.4.22 IEEE format only, 32-bits LONGINTs only
|
||||
30.8.1993 mh: changed RealX to avoid compiler warnings;
|
||||
7.11.1995 jt: dynamic endianess test
|
||||
22.01.97 pjm: NaN stuff (using quiet NaNs only to avoid traps)
|
||||
05.01.98 prk: NaN with INF support
|
||||
*)
|
||||
|
||||
VAR
|
||||
DefaultFCR*: SET;
|
||||
tene: ARRAY 23 OF LONGREAL; (* e = 0..22: exact values of 10^e *)
|
||||
ten: ARRAY 27 OF LONGREAL;
|
||||
eq, gr: ARRAY 20 OF SET;
|
||||
H, L: INTEGER;
|
||||
|
||||
(** Returns the shifted binary exponent (0 <= e < 256). *)
|
||||
PROCEDURE Expo* (x: REAL): LONGINT;
|
||||
BEGIN
|
||||
RETURN ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256
|
||||
END Expo;
|
||||
|
||||
(** Returns the shifted binary exponent (0 <= e < 2048). *)
|
||||
PROCEDURE ExpoL* (x: LONGREAL): LONGINT;
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, i); RETURN ASH(i, -20) MOD 2048
|
||||
END ExpoL;
|
||||
|
||||
(** Sets the shifted binary exponent. *)
|
||||
PROCEDURE SetExpo* (e: LONGINT; VAR x: REAL);
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x), i);
|
||||
i:= ASH(ASH(ASH(i, -31), 8) + e MOD 256, 23) + i MOD ASH(1, 23);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x), i)
|
||||
END SetExpo;
|
||||
|
||||
(** Sets the shifted binary exponent. *)
|
||||
PROCEDURE SetExpoL* (e: LONGINT; VAR x: LONGREAL);
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, i);
|
||||
i:= ASH(ASH(ASH(i, -31), 11) + e MOD 2048, 20) + i MOD ASH(1, 20);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + H, i)
|
||||
END SetExpoL;
|
||||
|
||||
(** Convert hexadecimal to REAL. *)
|
||||
PROCEDURE Real* (h: LONGINT): REAL;
|
||||
VAR x: REAL;
|
||||
BEGIN SYSTEM.PUT(SYSTEM.ADR(x), h); RETURN x
|
||||
END Real;
|
||||
|
||||
(** Convert hexadecimal to LONGREAL. h and l are the high and low parts.*)
|
||||
PROCEDURE RealL* (h, l: LONGINT): LONGREAL;
|
||||
VAR x: LONGREAL;
|
||||
BEGIN SYSTEM.PUT(SYSTEM.ADR(x) + H, h); SYSTEM.PUT(SYSTEM.ADR(x) + L, l); RETURN x
|
||||
END RealL;
|
||||
|
||||
(** Convert REAL to hexadecimal. *)
|
||||
PROCEDURE Int* (x: REAL): LONGINT;
|
||||
VAR i: LONGINT;
|
||||
BEGIN SYSTEM.PUT(SYSTEM.ADR(i), x); RETURN i
|
||||
END Int;
|
||||
|
||||
(** Convert LONGREAL to hexadecimal. h and l are the high and low parts. *)
|
||||
PROCEDURE IntL* (x: LONGREAL; VAR h, l: LONGINT);
|
||||
BEGIN SYSTEM.GET(SYSTEM.ADR(x) + H, h); SYSTEM.GET(SYSTEM.ADR(x) + L, l)
|
||||
END IntL;
|
||||
|
||||
(** Returns 10^e (e <= 308, 308 < e delivers IEEE-code +INF). *)
|
||||
PROCEDURE Ten* (e: LONGINT): LONGREAL;
|
||||
VAR E: LONGINT; r: LONGREAL;
|
||||
BEGIN
|
||||
IF e < -307 THEN RETURN 0 ELSIF 308 < e THEN RETURN RealL(2146435072, 0) END;
|
||||
INC(e, 307); r:= ten[e DIV 23] * tene[e MOD 23];
|
||||
IF e MOD 32 IN eq[e DIV 32] THEN RETURN r
|
||||
ELSE
|
||||
E:= ExpoL(r); SetExpoL(1023+52, r);
|
||||
IF e MOD 32 IN gr[e DIV 32] THEN r:= r-1 ELSE r:= r+1 END;
|
||||
SetExpoL(E, r); RETURN r
|
||||
END
|
||||
END Ten;
|
||||
|
||||
(** Returns the NaN code (0 <= c < 8399608) or -1 if not NaN/Infinite. *)
|
||||
PROCEDURE NaNCode* (x: REAL): LONGINT;
|
||||
BEGIN
|
||||
IF ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256 = 255 THEN (* Infinite or NaN *)
|
||||
RETURN SYSTEM.VAL(LONGINT, x) MOD 800000H (* lowest 23 bits *)
|
||||
ELSE
|
||||
RETURN -1
|
||||
END
|
||||
END NaNCode;
|
||||
|
||||
(** Returns the NaN code (0 <= h < 1048576, MIN(LONGINT) <= l <= MAX(LONGINT)) or (-1,-1) if not NaN/Infinite. *)
|
||||
PROCEDURE NaNCodeL* (x: LONGREAL; VAR h, l: LONGINT);
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, h); SYSTEM.GET(SYSTEM.ADR(x) + L, l);
|
||||
IF ASH(h, -20) MOD 2048 = 2047 THEN (* Infinite or NaN *)
|
||||
h := h MOD 100000H (* lowest 20 bits *)
|
||||
ELSE
|
||||
h := -1; l := -1
|
||||
END
|
||||
END NaNCodeL;
|
||||
|
||||
(** Returns TRUE iff x is NaN/Infinite. *)
|
||||
PROCEDURE IsNaN* (x: REAL): BOOLEAN;
|
||||
BEGIN
|
||||
RETURN ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256 = 255
|
||||
END IsNaN;
|
||||
|
||||
(** Returns TRUE iff x is NaN/Infinite. *)
|
||||
PROCEDURE IsNaNL* (x: LONGREAL): BOOLEAN;
|
||||
VAR h: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, h);
|
||||
RETURN ASH(h, -20) MOD 2048 = 2047
|
||||
END IsNaNL;
|
||||
|
||||
(** Returns NaN with specified code (0 <= l < 8399608). *)
|
||||
PROCEDURE NaN* (l: LONGINT): REAL;
|
||||
VAR x: REAL;
|
||||
BEGIN
|
||||
SYSTEM.PUT(SYSTEM.ADR(x), (l MOD 800000H) + 7F800000H);
|
||||
RETURN x
|
||||
END NaN;
|
||||
|
||||
(** Returns NaN with specified code (0 <= h < 1048576, MIN(LONGINT) <= l <= MAX(LONGINT)). *)
|
||||
PROCEDURE NaNL* (h, l: LONGINT): LONGREAL;
|
||||
VAR x: LONGREAL;
|
||||
BEGIN
|
||||
h := (h MOD 100000H) + 7FF00000H;
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + H, h);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + L, l);
|
||||
RETURN x
|
||||
END NaNL;
|
||||
(*
|
||||
PROCEDURE fcr(): SET;
|
||||
CODE {SYSTEM.i386, SYSTEM.FPU}
|
||||
PUSH 0
|
||||
FSTCW [ESP]
|
||||
FWAIT
|
||||
POP EAX
|
||||
END fcr;
|
||||
*) (* commented out -- noch *)
|
||||
(** Return state of the floating-point control register. *)
|
||||
(*PROCEDURE FCR*(): SET;
|
||||
BEGIN
|
||||
IF Kernel.copro THEN
|
||||
RETURN fcr()
|
||||
ELSE
|
||||
RETURN DefaultFCR
|
||||
END
|
||||
END FCR;
|
||||
*)
|
||||
(*PROCEDURE setfcr(s: SET);
|
||||
CODE {SYSTEM.i386, SYSTEM.FPU}
|
||||
FLDCW s[EBP]
|
||||
END setfcr;
|
||||
*)
|
||||
(** Set state of floating-point control register. Traps reset this to the default & ENTIER resets the rounding mode. *)
|
||||
(*PROCEDURE SetFCR*(s: SET);
|
||||
BEGIN
|
||||
IF Kernel.copro THEN setfcr(s) END
|
||||
END SetFCR;
|
||||
*)
|
||||
PROCEDURE RealX (h, l: LONGINT; adr: LONGINT);
|
||||
BEGIN SYSTEM.PUT(adr + H, h); SYSTEM.PUT(adr + L, l);
|
||||
END RealX;
|
||||
|
||||
PROCEDURE InitHL;
|
||||
VAR (*i: LONGINT; dmy: INTEGER;*) littleEndian: BOOLEAN;
|
||||
BEGIN
|
||||
(*DefaultFCR := (FCR() - {0,2,3,10,11}) + {0..5,8,9};
|
||||
SetFCR(DefaultFCR);
|
||||
|
||||
dmy := 1; i := SYSTEM.ADR(dmy);
|
||||
SYSTEM.GET(i, littleEndian); (* indirection via i avoids warning on SUN cc -O *)*)
|
||||
littleEndian := TRUE; (* endianness will be set for each architecture -- noch *)
|
||||
IF littleEndian THEN H := 4; L := 0 ELSE H := 0; L := 4 END
|
||||
END InitHL;
|
||||
|
||||
BEGIN InitHL;
|
||||
RealX(03FF00000H, 0, SYSTEM.ADR(tene[0]));
|
||||
RealX(040240000H, 0, SYSTEM.ADR(tene[1])); (* 1 *)
|
||||
RealX(040590000H, 0, SYSTEM.ADR(tene[2])); (* 2 *)
|
||||
RealX(0408F4000H, 0, SYSTEM.ADR(tene[3])); (* 3 *)
|
||||
RealX(040C38800H, 0, SYSTEM.ADR(tene[4])); (* 4 *)
|
||||
RealX(040F86A00H, 0, SYSTEM.ADR(tene[5])); (* 5 *)
|
||||
RealX(0412E8480H, 0, SYSTEM.ADR(tene[6])); (* 6 *)
|
||||
RealX(0416312D0H, 0, SYSTEM.ADR(tene[7])); (* 7 *)
|
||||
RealX(04197D784H, 0, SYSTEM.ADR(tene[8])); (* 8 *)
|
||||
RealX(041CDCD65H, 0, SYSTEM.ADR(tene[9])); (* 9 *)
|
||||
RealX(04202A05FH, 020000000H, SYSTEM.ADR(tene[10])); (* 10 *)
|
||||
RealX(042374876H, 0E8000000H, SYSTEM.ADR(tene[11])); (* 11 *)
|
||||
RealX(0426D1A94H, 0A2000000H, SYSTEM.ADR(tene[12])); (* 12 *)
|
||||
RealX(042A2309CH, 0E5400000H, SYSTEM.ADR(tene[13])); (* 13 *)
|
||||
RealX(042D6BCC4H, 01E900000H, SYSTEM.ADR(tene[14])); (* 14 *)
|
||||
RealX(0430C6BF5H, 026340000H, SYSTEM.ADR(tene[15])); (* 15 *)
|
||||
RealX(04341C379H, 037E08000H, SYSTEM.ADR(tene[16])); (* 16 *)
|
||||
RealX(043763457H, 085D8A000H, SYSTEM.ADR(tene[17])); (* 17 *)
|
||||
RealX(043ABC16DH, 0674EC800H, SYSTEM.ADR(tene[18])); (* 18 *)
|
||||
RealX(043E158E4H, 060913D00H, SYSTEM.ADR(tene[19])); (* 19 *)
|
||||
RealX(04415AF1DH, 078B58C40H, SYSTEM.ADR(tene[20])); (* 20 *)
|
||||
RealX(0444B1AE4H, 0D6E2EF50H, SYSTEM.ADR(tene[21])); (* 21 *)
|
||||
RealX(04480F0CFH, 064DD592H, SYSTEM.ADR(tene[22])); (* 22 *)
|
||||
|
||||
RealX(031FA18H, 02C40C60DH, SYSTEM.ADR(ten[0])); (* -307 *)
|
||||
RealX(04F7CAD2H, 03DE82D7BH, SYSTEM.ADR(ten[1])); (* -284 *)
|
||||
RealX(09BF7D22H, 08322BAF5H, SYSTEM.ADR(ten[2])); (* -261 *)
|
||||
RealX(0E84D669H, 05B193BF8H, SYSTEM.ADR(ten[3])); (* -238 *)
|
||||
RealX(0134B9408H, 0EEFEA839H, SYSTEM.ADR(ten[4])); (* -215 *)
|
||||
RealX(018123FF0H, 06EEA847AH, SYSTEM.ADR(ten[5])); (* -192 *)
|
||||
RealX(01CD82742H, 091C6065BH, SYSTEM.ADR(ten[6])); (* -169 *)
|
||||
RealX(0219FF779H, 0FD329CB9H, SYSTEM.ADR(ten[7])); (* -146 *)
|
||||
RealX(02665275EH, 0D8D8F36CH, SYSTEM.ADR(ten[8])); (* -123 *)
|
||||
RealX(02B2BFF2EH, 0E48E0530H, SYSTEM.ADR(ten[9])); (* -100 *)
|
||||
RealX(02FF286D8H, 0EC190DCH, SYSTEM.ADR(ten[10])); (* -77 *)
|
||||
RealX(034B8851AH, 0B548EA4H, SYSTEM.ADR(ten[11])); (* -54 *)
|
||||
RealX(0398039D6H, 065896880H, SYSTEM.ADR(ten[12])); (* -31 *)
|
||||
RealX(03E45798EH, 0E2308C3AH, SYSTEM.ADR(ten[13])); (* -8 *)
|
||||
RealX(0430C6BF5H, 026340000H, SYSTEM.ADR(ten[14])); (* 15 *)
|
||||
RealX(047D2CED3H, 02A16A1B1H, SYSTEM.ADR(ten[15])); (* 38 *)
|
||||
RealX(04C98E45EH, 01DF3B015H, SYSTEM.ADR(ten[16])); (* 61 *)
|
||||
RealX(0516078E1H, 011C3556DH, SYSTEM.ADR(ten[17])); (* 84 *)
|
||||
RealX(05625CCFEH, 03D35D80EH, SYSTEM.ADR(ten[18])); (* 107 *)
|
||||
RealX(05AECDA62H, 055B2D9EH, SYSTEM.ADR(ten[19])); (* 130 *)
|
||||
RealX(05FB317E5H, 0EF3AB327H, SYSTEM.ADR(ten[20])); (* 153 *)
|
||||
RealX(064794514H, 05230B378H, SYSTEM.ADR(ten[21])); (* 176 *)
|
||||
RealX(06940B8E0H, 0ACAC4EAFH, SYSTEM.ADR(ten[22])); (* 199 *)
|
||||
RealX(06E0621B1H, 0C28AC20CH, SYSTEM.ADR(ten[23])); (* 222 *)
|
||||
RealX(072CD4A7BH, 0EBFA31ABH, SYSTEM.ADR(ten[24])); (* 245 *)
|
||||
RealX(077936214H, 09CBD3226H, SYSTEM.ADR(ten[25])); (* 268 *)
|
||||
RealX(07C59A742H, 0461887F6H, SYSTEM.ADR(ten[26])); (* 291 *)
|
||||
|
||||
eq[0]:= {0, 3, 4, 5, 9, 16, 23, 25, 26, 28, 31};
|
||||
eq[1]:= {2, 5, 6, 8, 9, 10, 11, 12, 13, 14, 15, 17, 18, 19, 20, 21, 23, 24, 25, 27, 28, 29, 30, 31};
|
||||
eq[2]:= {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28};
|
||||
eq[3]:= {0, 1, 2, 3, 5, 6, 7, 8, 9, 11, 14, 15, 16, 17, 18, 19, 20, 22, 27, 28, 29, 30, 31};
|
||||
eq[4]:= {0, 6, 7, 10, 11, 12, 13, 14, 15, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[5]:= {0, 1, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[6]:= {0, 1, 4, 5, 7, 8, 10, 14, 15, 16, 18, 20, 21, 23, 24, 25, 26, 28, 29, 30, 31};
|
||||
eq[7]:= {0, 1, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 18, 19, 23, 24, 26, 28, 29, 30, 31};
|
||||
eq[8]:= {0, 1, 2, 3, 4, 5, 6, 8, 9, 10, 11, 14, 16, 17, 18, 19, 20, 21, 24, 25, 26, 29};
|
||||
eq[9]:= {1, 2, 4, 6, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[10]:= {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30};
|
||||
eq[11]:= {0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 13, 14, 15, 16, 19, 20, 21, 22, 23, 27, 28, 29, 30};
|
||||
eq[12]:= {0, 1, 2, 3, 4, 5, 7, 8, 9, 10, 12, 14, 15, 16, 17, 18, 19, 20, 21, 23, 26, 27, 29, 30, 31};
|
||||
eq[13]:= {0, 1, 2, 3, 4, 5, 6, 7, 9, 10, 11, 13, 14, 15, 16, 17, 18, 20, 21, 23, 24, 27, 28, 29, 30, 31};
|
||||
eq[14]:= {0, 1, 2, 3, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[15]:= {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 11, 12, 13, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 28};
|
||||
eq[16]:= {1, 2, 4, 11, 13, 16, 17, 18, 19, 22, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[17]:= {1, 2, 3, 4, 5, 6, 7, 8, 9, 11, 14, 15, 18, 19, 20, 21, 23, 25, 26, 27, 28, 29, 31};
|
||||
eq[18]:= {0, 2, 4, 5, 6, 8, 9, 11, 12, 13, 14, 16, 17, 19, 20, 22, 23, 24, 26, 27, 28, 29};
|
||||
eq[19]:= {2, 3, 4, 5, 6, 7};
|
||||
|
||||
gr[0]:= {24, 27, 29, 30};
|
||||
gr[1]:= {0, 1, 3, 4, 7};
|
||||
gr[2]:= {29, 30, 31};
|
||||
gr[3]:= {4, 10, 12, 13, 21, 23, 24, 25, 26};
|
||||
gr[4]:= {1, 2, 3, 4, 5, 8, 9, 16, 17};
|
||||
gr[5]:= {2, 3, 4, 18};
|
||||
gr[6]:= {2, 3, 6, 9, 11, 12, 13, 17, 19, 22, 27};
|
||||
gr[7]:= {2};
|
||||
gr[8]:= {7, 12, 13, 15, 22, 23, 27, 28, 30, 31};
|
||||
gr[9]:= {0, 3, 5, 7, 8};
|
||||
gr[10]:= {};
|
||||
gr[11]:= {};
|
||||
gr[12]:= {11, 13, 22, 24, 25, 28};
|
||||
gr[13]:= {22, 25, 26};
|
||||
gr[14]:= {4, 5};
|
||||
gr[15]:= {10, 14, 27, 29, 30, 31};
|
||||
gr[16]:= {0, 3, 5, 6, 7, 8, 9, 10, 12, 14, 15, 20, 21, 23};
|
||||
gr[17]:= {0, 10, 12, 13, 16, 17, 22, 24, 30};
|
||||
gr[18]:= {};
|
||||
gr[19]:= {}
|
||||
END ethReals.
|
||||
213
src/lib/s3/ethDates.Mod
Normal file
213
src/lib/s3/ethDates.Mod
Normal file
|
|
@ -0,0 +1,213 @@
|
|||
(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
|
||||
Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
|
||||
|
||||
MODULE ethDates; (** portable *) (* PS *)
|
||||
|
||||
IMPORT Texts;
|
||||
|
||||
CONST
|
||||
minute* = 60; hour* = 60*minute; day* = 24*hour; week*= 7* day;
|
||||
zeroY = 1900;
|
||||
firstY* = 1901;
|
||||
|
||||
VAR
|
||||
TimeDiff*: LONGINT; (** local difference to universal time in minutes *)
|
||||
A : ARRAY 13 OF INTEGER;
|
||||
T : ARRAY 365 OF SHORTINT;
|
||||
|
||||
(** Returns TRUE if year is a leap year *)
|
||||
PROCEDURE IsLeapYear* (year: INTEGER): BOOLEAN;
|
||||
BEGIN RETURN (year MOD 4 = 0) & (~(year MOD 100 = 0) OR (year MOD 400 = 0))
|
||||
END IsLeapYear;
|
||||
|
||||
PROCEDURE LastDay (year, month: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
IF (month < 8) & ODD(month) OR (month > 7) & ~ODD(month) THEN RETURN 31
|
||||
ELSIF month = 2 THEN
|
||||
IF IsLeapYear(year) THEN RETURN 29 ELSE RETURN 28 END
|
||||
ELSE RETURN 30
|
||||
END
|
||||
END LastDay;
|
||||
|
||||
(** Returns the number of days since 1.1.[firstY] *)
|
||||
PROCEDURE NumberOfDays* (date: LONGINT): LONGINT;
|
||||
VAR num: LONGINT; y, m: INTEGER;
|
||||
BEGIN
|
||||
y := SHORT(date DIV 512) + zeroY - firstY;
|
||||
m := SHORT(date DIV 32) MOD 16;
|
||||
num := LONG(y) * 365 + y DIV 4 + A[(m - 1) MOD 12] + (date MOD 32) - 1;
|
||||
IF IsLeapYear(firstY + y) & (m > 2) THEN INC(num) END;
|
||||
RETURN num
|
||||
END NumberOfDays;
|
||||
|
||||
(** Returns the date 1.1.[firstY] + days *)
|
||||
PROCEDURE NumberOfDaysToDate* (days: LONGINT): LONGINT;
|
||||
VAR M, m, y, d: LONGINT;
|
||||
BEGIN
|
||||
IF (days + 307) MOD 1461 = 0 THEN d := 2 ELSE d := 1 END;
|
||||
days := days - (days + 307) DIV 1461; y := firstY + days DIV 365;
|
||||
IF firstY > y THEN y := zeroY; m := 1; d := 1
|
||||
ELSE M := days MOD 365; m := T[M]; d := M - A[m - 1] + d
|
||||
END;
|
||||
RETURN ASH(ASH(y-zeroY, 4) + m, 5) + d
|
||||
END NumberOfDaysToDate;
|
||||
|
||||
|
||||
(** Converts year, month and day into an Oberon date *)
|
||||
PROCEDURE ToDate* (year, month, day: INTEGER): LONGINT;
|
||||
VAR d: INTEGER;
|
||||
BEGIN
|
||||
month := 1 + (month - 1) MOD 12;
|
||||
d := LastDay(year, month); day := 1 + (day - 1) MOD d;
|
||||
RETURN ASH(ASH(year-zeroY, 4) + month, 5) + day
|
||||
END ToDate;
|
||||
|
||||
(** Converts hour, min and sec into an Oberon time *)
|
||||
PROCEDURE ToTime* (hour, min, sec: INTEGER): LONGINT;
|
||||
BEGIN RETURN ((LONG(hour) MOD 24)*64 + (min MOD 60))*64 + (sec MOD 60)
|
||||
END ToTime;
|
||||
|
||||
|
||||
(** Extracts year, month and day of an Oberon date *)
|
||||
PROCEDURE ToYMD* (date: LONGINT; VAR year, month, day: INTEGER);
|
||||
BEGIN
|
||||
year := SHORT(date DIV 512) + zeroY;
|
||||
month := SHORT((date DIV 32) MOD 16); day := SHORT(date MOD 32)
|
||||
END ToYMD;
|
||||
|
||||
(** Extracts hour, min and sec of an Oberon time *)
|
||||
PROCEDURE ToHMS* (time: LONGINT; VAR hour, min, sec: INTEGER);
|
||||
BEGIN
|
||||
hour := SHORT(time DIV 4096); min := SHORT((time DIV 64) MOD 64); sec := SHORT(time MOD 64)
|
||||
END ToHMS;
|
||||
|
||||
(** Returns weekday from date, where 0 is monday *)
|
||||
PROCEDURE DayOfWeek* (date: LONGINT): INTEGER;
|
||||
VAR num: LONGINT;
|
||||
BEGIN
|
||||
num := NumberOfDays(date);
|
||||
RETURN SHORT((num+1) MOD 7)
|
||||
END DayOfWeek;
|
||||
|
||||
(** Returns number of days in a month *)
|
||||
PROCEDURE DaysOfMonth* (date: LONGINT): INTEGER; (* returns last day in month *)
|
||||
VAR year, month: LONGINT;
|
||||
BEGIN
|
||||
month := (date DIV 32) MOD 16; year := (date DIV 512) + zeroY;
|
||||
RETURN LastDay(SHORT(year), SHORT(month))
|
||||
END DaysOfMonth;
|
||||
|
||||
|
||||
(** Following three procedures are used to add/subtract a certain amount of days/month/years. *)
|
||||
PROCEDURE AddYear* (date: LONGINT; years: INTEGER): LONGINT;
|
||||
VAR y, m, d: INTEGER;
|
||||
BEGIN
|
||||
ToYMD(date, y, m, d);
|
||||
IF firstY <= y + years THEN
|
||||
IF IsLeapYear(y) & (m = 2) & (d = 29) & ~IsLeapYear(y + years) THEN d := 28 END;
|
||||
date := ToDate(y + years, m, d)
|
||||
END;
|
||||
RETURN date
|
||||
END AddYear;
|
||||
|
||||
PROCEDURE AddMonth* (date: LONGINT; months: INTEGER): LONGINT;
|
||||
VAR y, m, d: INTEGER;
|
||||
BEGIN
|
||||
ToYMD(date, y, m, d); INC(m, months - 1);
|
||||
y := y + m DIV 12;
|
||||
IF firstY <= y THEN
|
||||
m := m MOD 12 + 1;
|
||||
IF m =2 THEN
|
||||
IF (d > 29) & IsLeapYear(y) THEN d := 29
|
||||
ELSIF (d > 28) & ~ IsLeapYear(y) THEN d := 28
|
||||
END
|
||||
ELSIF (d > 30) & ((m < 8) & ~ODD(m) OR (m > 7) & ODD(m)) THEN d := 30
|
||||
END;
|
||||
date := ToDate(y, m, d)
|
||||
END;
|
||||
RETURN date
|
||||
END AddMonth;
|
||||
|
||||
PROCEDURE AddDay* (date: LONGINT; days: INTEGER): LONGINT;
|
||||
VAR num: LONGINT;
|
||||
BEGIN num := NumberOfDays(date); num := num + days; RETURN NumberOfDaysToDate(num)
|
||||
END AddDay;
|
||||
|
||||
|
||||
(** Following three procedures are used to add/subtract a certain amount of time. *)
|
||||
PROCEDURE AddHour* (time: LONGINT; hour: INTEGER): LONGINT;
|
||||
VAR s, m, h: INTEGER;
|
||||
BEGIN ToHMS(time, h, m, s); RETURN ToTime((h + hour) MOD 24, m, s)
|
||||
END AddHour;
|
||||
|
||||
PROCEDURE AddMinute* (time: LONGINT; min: INTEGER): LONGINT;
|
||||
VAR s, m, h: INTEGER;
|
||||
BEGIN
|
||||
ToHMS(time, h, m, s); INC(m, min);
|
||||
IF (m < 0) OR (m >= 60) THEN h := (h + m DIV 60) MOD 24; m := m MOD 60 END;
|
||||
RETURN ToTime(h, m, s)
|
||||
END AddMinute;
|
||||
|
||||
PROCEDURE AddSecond* (time: LONGINT; sec: INTEGER): LONGINT;
|
||||
VAR s, m, h: INTEGER;
|
||||
BEGIN
|
||||
ToHMS(time, h, m, s); INC(s, sec);
|
||||
IF (s < 0) OR (s >= 60) THEN
|
||||
INC(m, s DIV 60); s := s MOD 60;
|
||||
IF (m < 0) OR (m >= 60) THEN h := (h + m DIV 60) MOD 24; m := m MOD 60 END
|
||||
END;
|
||||
RETURN ToTime(h, m, s)
|
||||
END AddSecond;
|
||||
|
||||
(** Following procedure adds/subtracts a certain amount seconds to time/date. *)
|
||||
PROCEDURE AddTime* (VAR time, date: LONGINT; sec: LONGINT);
|
||||
VAR h, m, s: LONGINT; ss, mm, hh: INTEGER;
|
||||
BEGIN
|
||||
ToHMS(time, hh, mm, ss); s := sec + ss; h := hh; m := mm;
|
||||
IF (s < 0) OR (s >= 60) THEN
|
||||
m := s DIV 60 + mm; s := s MOD 60;
|
||||
IF (m < 0) OR (m >= 60) THEN
|
||||
h := m DIV 60 + hh; m := m MOD 60;
|
||||
IF (h < 0) OR (h >= 24) THEN
|
||||
date := AddDay(date, SHORT(h DIV 24)); h := h MOD 24
|
||||
END
|
||||
END
|
||||
END;
|
||||
time := ToTime(SHORT(h), SHORT(m), SHORT(s))
|
||||
END AddTime;
|
||||
|
||||
PROCEDURE Init();
|
||||
VAR
|
||||
diff: ARRAY 8 OF CHAR;
|
||||
S: Texts.Scanner;
|
||||
Txt : Texts.Text; (* noch *)
|
||||
i, j: LONGINT;
|
||||
BEGIN
|
||||
A[0] := 0; A[1] := 31; A[2] := 59; A[3] := 90; A[4] := 120; A[5] := 151; A[6] := 181;
|
||||
A[7] := 212; A[8] := 243; A[9] := 273; A[10] := 304; A[11] := 334; A[12] := 365;
|
||||
i := 0; j := 0;
|
||||
WHILE i < 12 DO WHILE j < A[i+1] DO T[j] := SHORT(SHORT(i + 1)); INC(j) END; INC(i) END;
|
||||
(*Oberon.OpenScanner(S, "System.TimeDiff");*)
|
||||
Texts.Open(Txt, "System.TimeDiff");
|
||||
Texts.OpenScanner(S, Txt, 0);
|
||||
TimeDiff := 0;
|
||||
IF S.class = Texts.String THEN
|
||||
COPY(S.s, diff);
|
||||
i := 0; j := 1;
|
||||
IF diff[i] = "+" THEN
|
||||
INC(i)
|
||||
ELSIF diff[i] = "-" THEN
|
||||
INC(i); j := -1
|
||||
END;
|
||||
WHILE (diff[i] >= "0") & (diff[i] <= "9") DO
|
||||
TimeDiff := 10*TimeDiff+ORD(diff[i])-ORD("0");
|
||||
INC(i)
|
||||
END;
|
||||
TimeDiff := (TimeDiff DIV 100)*60 + (TimeDiff MOD 100);
|
||||
TimeDiff := j*TimeDiff
|
||||
END
|
||||
END Init;
|
||||
|
||||
BEGIN
|
||||
Init()
|
||||
END ethDates.
|
||||
955
src/lib/s3/ethStrings.Mod
Normal file
955
src/lib/s3/ethStrings.Mod
Normal file
|
|
@ -0,0 +1,955 @@
|
|||
(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
|
||||
Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
|
||||
|
||||
MODULE ethStrings; (** portable *) (* ejz, *)
|
||||
|
||||
(** Strings is a utility module that provides procedures to manipulate strings.
|
||||
Note: All strings MUST be 0X terminated. *)
|
||||
|
||||
IMPORT Oberon, Texts, Dates := ethDates, Reals := ethReals;
|
||||
|
||||
CONST
|
||||
CR* = 0DX; (** the Oberon end of line character *)
|
||||
Tab* = 09X; (** the horizontal tab character *)
|
||||
LF* = 0AX; (** the UNIX end of line character *)
|
||||
|
||||
VAR
|
||||
isAlpha*: ARRAY 256 OF BOOLEAN; (** all letters in the oberon charset *)
|
||||
ISOToOberon*, OberonToISO*: ARRAY 256 OF CHAR; (** Translation tables for iso-8859-1 to oberon ascii code. *)
|
||||
CRLF*: ARRAY 4 OF CHAR; (** end of line "string" used by MS-DOS and most TCP protocols *)
|
||||
sDayName: ARRAY 7, 4 OF CHAR;
|
||||
lDayName: ARRAY 7, 12 OF CHAR;
|
||||
sMonthName: ARRAY 12, 4 OF CHAR;
|
||||
lMonthName: ARRAY 12, 12 OF CHAR;
|
||||
dateform, timeform: ARRAY 32 OF CHAR;
|
||||
|
||||
(** Length of str. *)
|
||||
PROCEDURE Length*(VAR str(** in *): ARRAY OF CHAR): LONGINT;
|
||||
VAR i, l: LONGINT;
|
||||
BEGIN
|
||||
l := LEN(str); i := 0;
|
||||
WHILE (i < l) & (str[i] # 0X) DO
|
||||
INC(i)
|
||||
END;
|
||||
RETURN i
|
||||
END Length;
|
||||
|
||||
(** Append this to to. *)
|
||||
PROCEDURE Append*(VAR to(** in/out *): ARRAY OF CHAR; this: ARRAY OF CHAR);
|
||||
VAR i, j, l: LONGINT;
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE to[i] # 0X DO
|
||||
INC(i)
|
||||
END;
|
||||
l := LEN(to)-1; j := 0;
|
||||
WHILE (i < l) & (this[j] # 0X) DO
|
||||
to[i] := this[j]; INC(i); INC(j)
|
||||
END;
|
||||
to[i] := 0X
|
||||
END Append;
|
||||
|
||||
(** Append this to to. *)
|
||||
PROCEDURE AppendCh*(VAR to(** in/out *): ARRAY OF CHAR; this: CHAR);
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE to[i] # 0X DO
|
||||
INC(i)
|
||||
END;
|
||||
IF i < (LEN(to)-1) THEN
|
||||
to[i] := this; to[i+1] := 0X
|
||||
END
|
||||
END AppendCh;
|
||||
|
||||
(** TRUE if ch is a hexadecimal digit. *)
|
||||
PROCEDURE IsHexDigit*(ch: CHAR): BOOLEAN;
|
||||
BEGIN
|
||||
RETURN ((ch >= "0") & (ch <= "9")) OR ((CAP(ch) >= "A") & (CAP(ch) <= "F"))
|
||||
END IsHexDigit;
|
||||
|
||||
(** TRUE if ch is a decimal digit. *)
|
||||
PROCEDURE IsDigit*(ch: CHAR): BOOLEAN;
|
||||
BEGIN
|
||||
RETURN (ch >= "0") & (ch <= "9")
|
||||
END IsDigit;
|
||||
|
||||
(** TRUE if ch is a letter. *)
|
||||
PROCEDURE IsAlpha*(ch: CHAR): BOOLEAN;
|
||||
BEGIN
|
||||
RETURN isAlpha[ORD(ch)]
|
||||
END IsAlpha;
|
||||
|
||||
(** If ch is an upper-case letter return the corresponding lower-case letter. *)
|
||||
PROCEDURE LowerCh*(ch: CHAR): CHAR;
|
||||
BEGIN
|
||||
CASE ch OF
|
||||
"A" .. "Z": ch := CHR(ORD(ch)-ORD("A")+ORD("a"))
|
||||
|"€": ch := "ƒ"
|
||||
|"<22>": ch := "„"
|
||||
|"‚": ch := "…"
|
||||
ELSE
|
||||
END;
|
||||
RETURN ch
|
||||
END LowerCh;
|
||||
|
||||
(** If ch is an lower-case letter return the corresponding upper-case letter. *)
|
||||
PROCEDURE UpperCh*(ch: CHAR): CHAR;
|
||||
BEGIN
|
||||
CASE ch OF
|
||||
"a" .. "z": ch := CAP(ch)
|
||||
|"ƒ": ch := "€"
|
||||
|"„": ch := "<22>"
|
||||
|"…": ch := "‚"
|
||||
|"†": ch := "A"
|
||||
|"‡": ch := "E"
|
||||
|"ˆ": ch := "I"
|
||||
|"‰": ch := "O"
|
||||
|"Š": ch := "U"
|
||||
|"‹": ch := "A"
|
||||
|"Œ": ch := "E"
|
||||
|"<22>": ch := "I"
|
||||
|"Ž": ch := "O"
|
||||
|"<22>": ch := "U"
|
||||
|"<22>": ch := "E"
|
||||
|"‘": ch := "E"
|
||||
|"’": ch := "I"
|
||||
|"“": ch := "C"
|
||||
|"”": ch := "A"
|
||||
|"•": ch := "N"
|
||||
|"–": ch := "S"
|
||||
ELSE
|
||||
END;
|
||||
RETURN ch
|
||||
END UpperCh;
|
||||
|
||||
(** Convert str to all lower-case letters. *)
|
||||
PROCEDURE Lower*(VAR str(** in *), lstr(** out *): ARRAY OF CHAR);
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE str[i] # 0X DO
|
||||
lstr[i] := LowerCh(str[i]); INC(i)
|
||||
END;
|
||||
lstr[i] := 0X
|
||||
END Lower;
|
||||
|
||||
(** Convert str to all upper-case letters. *)
|
||||
PROCEDURE Upper*(VAR str(** in *), ustr(** out *): ARRAY OF CHAR);
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE str[i] # 0X DO
|
||||
ustr[i] := UpperCh(str[i]); INC(i)
|
||||
END;
|
||||
ustr[i] := 0X
|
||||
END Upper;
|
||||
|
||||
(** Is str prefixed by pre? *)
|
||||
PROCEDURE Prefix*(pre: ARRAY OF CHAR; VAR str(** in *): ARRAY OF CHAR): BOOLEAN;
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE (pre[i] # 0X) & (pre[i] = str[i]) DO
|
||||
INC(i)
|
||||
END;
|
||||
RETURN pre[i] = 0X
|
||||
END Prefix;
|
||||
|
||||
(** Checks if str is prefixed by pre. The case is ignored. *)
|
||||
PROCEDURE CAPPrefix*(pre: ARRAY OF CHAR; VAR str(** in *): ARRAY OF CHAR): BOOLEAN;
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE (pre[i] # 0X) & (CAP(pre[i]) = CAP(str[i])) DO
|
||||
INC(i)
|
||||
END;
|
||||
RETURN pre[i] = 0X
|
||||
END CAPPrefix;
|
||||
|
||||
(** Compare str1 to str2. The case is ignored. *)
|
||||
PROCEDURE CAPCompare*(VAR str1(** in *), str2(** in *): ARRAY OF CHAR): BOOLEAN;
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE (str1[i] # 0X) & (str2[i] # 0X) & (CAP(str1[i]) = CAP(str2[i])) DO
|
||||
INC(i)
|
||||
END;
|
||||
RETURN str1[i] = str2[i]
|
||||
END CAPCompare;
|
||||
|
||||
(** Get the parameter-value on line. The parameter value is started behind the first colon character. *)
|
||||
PROCEDURE GetPar*(VAR line(** in *), par(** out *): ARRAY OF CHAR);
|
||||
VAR i, j, l: LONGINT;
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE (line[i] # 0X) & (line[i] # ":") DO
|
||||
INC(i)
|
||||
END;
|
||||
IF line[i] = ":" THEN
|
||||
INC(i)
|
||||
END;
|
||||
WHILE (line[i] # 0X) & (line[i] <= " ") DO
|
||||
INC(i)
|
||||
END;
|
||||
l := LEN(par)-1; j := 0;
|
||||
WHILE (j < l) & (line[i] # 0X) DO
|
||||
par[j] := line[i]; INC(j); INC(i)
|
||||
END;
|
||||
par[j] := 0X
|
||||
END GetPar;
|
||||
|
||||
(** Get the suffix of str. The suffix is started by the last dot in str. *)
|
||||
PROCEDURE GetSuffix*(VAR str(** in *), suf(** out *): ARRAY OF CHAR);
|
||||
VAR i, j, l, dot: LONGINT;
|
||||
BEGIN
|
||||
dot := -1; i := 0;
|
||||
WHILE str[i] # 0X DO
|
||||
IF str[i] = "." THEN
|
||||
dot := i
|
||||
ELSIF str[i] = "/" THEN
|
||||
dot := -1
|
||||
END;
|
||||
INC(i)
|
||||
END;
|
||||
j := 0;
|
||||
IF dot > 0 THEN
|
||||
l := LEN(suf)-1; i := dot+1;
|
||||
WHILE (j < l) & (str[i] # 0X) DO
|
||||
suf[j] := str[i]; INC(j); INC(i)
|
||||
END
|
||||
END;
|
||||
suf[j] := 0X
|
||||
END GetSuffix;
|
||||
|
||||
(** Change the suffix of str to suf. *)
|
||||
PROCEDURE ChangeSuffix*(VAR str(** in/out *): ARRAY OF CHAR; suf: ARRAY OF CHAR);
|
||||
VAR i, j, l, dot: LONGINT;
|
||||
BEGIN
|
||||
dot := -1; i := 0;
|
||||
WHILE str[i] # 0X DO
|
||||
IF str[i] = "." THEN
|
||||
dot := i
|
||||
ELSIF str[i] = "/" THEN
|
||||
dot := -1
|
||||
END;
|
||||
INC(i)
|
||||
END;
|
||||
IF dot > 0 THEN
|
||||
l := LEN(str)-1; i := dot+1; j := 0;
|
||||
WHILE (i < l) & (suf[j] # 0X) DO
|
||||
str[i] := suf[j]; INC(i); INC(j)
|
||||
END;
|
||||
str[i] := 0X
|
||||
END
|
||||
END ChangeSuffix;
|
||||
|
||||
(** Search in src starting at pos for the next occurrence of pat. Returns pos=-1 if not found. *)
|
||||
PROCEDURE Search*(pat: ARRAY OF CHAR; VAR src(** in *): ARRAY OF CHAR; VAR pos(** in/out *): LONGINT);
|
||||
CONST MaxPat = 128;
|
||||
VAR
|
||||
buf: ARRAY MaxPat OF CHAR;
|
||||
len, i, srclen: LONGINT;
|
||||
PROCEDURE Find(beg: LONGINT);
|
||||
VAR
|
||||
i, j, b, e: LONGINT;
|
||||
ch: CHAR;
|
||||
ref: ARRAY MaxPat OF CHAR;
|
||||
BEGIN
|
||||
ch := src[pos]; INC(pos);
|
||||
ref[0] := ch;
|
||||
i := 0; j := 0; b := 0; e := 1;
|
||||
WHILE (pos <= srclen) & (i < len) DO
|
||||
IF buf[i] = ch THEN
|
||||
INC(i); j := (j + 1) MOD MaxPat
|
||||
ELSE
|
||||
i := 0; b := (b + 1) MOD MaxPat; j := b
|
||||
END;
|
||||
IF j # e THEN
|
||||
ch := ref[j]
|
||||
ELSE
|
||||
IF pos >= srclen THEN
|
||||
ch := 0X
|
||||
ELSE
|
||||
ch := src[pos]
|
||||
END;
|
||||
INC(pos); ref[j] := ch; e := (e + 1) MOD MaxPat; INC(beg);
|
||||
END
|
||||
END;
|
||||
IF i = len THEN
|
||||
pos := beg-len
|
||||
ELSE
|
||||
pos := -1
|
||||
END
|
||||
END Find;
|
||||
BEGIN
|
||||
len := Length(pat);
|
||||
IF MaxPat < len THEN
|
||||
len := MaxPat
|
||||
END;
|
||||
IF len <= 0 THEN
|
||||
pos := -1;
|
||||
RETURN
|
||||
END;
|
||||
i := 0;
|
||||
REPEAT
|
||||
buf[i] := pat[i]; INC(i)
|
||||
UNTIL i >= len;
|
||||
srclen := Length(src);
|
||||
IF pos < 0 THEN
|
||||
pos := 0
|
||||
ELSIF pos >= srclen THEN
|
||||
pos := -1;
|
||||
RETURN
|
||||
END;
|
||||
Find(pos)
|
||||
END Search;
|
||||
|
||||
(** Search in src starting at pos for the next occurrence of pat. *)
|
||||
PROCEDURE CAPSearch*(pat: ARRAY OF CHAR; VAR src(** in *): ARRAY OF CHAR; VAR pos(** in/out *): LONGINT);
|
||||
CONST MaxPat = 128;
|
||||
VAR
|
||||
buf: ARRAY MaxPat OF CHAR;
|
||||
len, i, srclen: LONGINT;
|
||||
PROCEDURE Find(beg: LONGINT);
|
||||
VAR
|
||||
i, j, b, e: LONGINT;
|
||||
ch: CHAR;
|
||||
ref: ARRAY MaxPat OF CHAR;
|
||||
BEGIN
|
||||
ch := UpperCh(src[pos]); INC(pos);
|
||||
ref[0] := ch;
|
||||
i := 0; j := 0; b := 0; e := 1;
|
||||
WHILE (pos <= srclen) & (i < len) DO
|
||||
IF buf[i] = ch THEN
|
||||
INC(i); j := (j + 1) MOD MaxPat
|
||||
ELSE
|
||||
i := 0; b := (b + 1) MOD MaxPat; j := b
|
||||
END;
|
||||
IF j # e THEN
|
||||
ch := ref[j]
|
||||
ELSE
|
||||
IF pos >= srclen THEN
|
||||
ch := 0X
|
||||
ELSE
|
||||
ch := UpperCh(src[pos])
|
||||
END;
|
||||
INC(pos); ref[j] := ch; e := (e + 1) MOD MaxPat; INC(beg);
|
||||
END
|
||||
END;
|
||||
IF i = len THEN
|
||||
pos := beg-len
|
||||
ELSE
|
||||
pos := -1
|
||||
END
|
||||
END Find;
|
||||
BEGIN
|
||||
len := Length(pat);
|
||||
IF MaxPat < len THEN
|
||||
len := MaxPat
|
||||
END;
|
||||
IF len <= 0 THEN
|
||||
pos := -1;
|
||||
RETURN
|
||||
END;
|
||||
i := 0;
|
||||
REPEAT
|
||||
buf[i] := UpperCh(pat[i]); INC(i)
|
||||
UNTIL i >= len;
|
||||
srclen := Length(src);
|
||||
IF pos < 0 THEN
|
||||
pos := 0
|
||||
ELSIF pos >= srclen THEN
|
||||
pos := -1;
|
||||
RETURN
|
||||
END;
|
||||
Find(pos)
|
||||
END CAPSearch;
|
||||
|
||||
(** Convert a string into an integer. Leading white space characters are ignored. *)
|
||||
PROCEDURE StrToInt*(VAR str: ARRAY OF CHAR; VAR val: LONGINT);
|
||||
VAR i, d: LONGINT; ch: CHAR; neg: BOOLEAN;
|
||||
BEGIN
|
||||
i := 0; ch := str[0];
|
||||
WHILE (ch # 0X) & (ch <= " ") DO
|
||||
INC(i); ch := str[i]
|
||||
END;
|
||||
neg := FALSE; IF ch = "+" THEN INC(i); ch := str[i] END;
|
||||
IF ch = "-" THEN neg := TRUE; INC(i); ch := str[i] END;
|
||||
WHILE (ch # 0X) & (ch <= " ") DO
|
||||
INC(i); ch := str[i]
|
||||
END;
|
||||
val := 0;
|
||||
WHILE (ch >= "0") & (ch <= "9") DO
|
||||
d := ORD(ch)-ORD("0");
|
||||
INC(i); ch := str[i];
|
||||
IF val <= ((MAX(LONGINT)-d) DIV 10) THEN
|
||||
val := 10*val+d
|
||||
ELSIF neg & (val = 214748364) & (d = 8) & ((ch < "0") OR (ch > "9")) THEN
|
||||
val := MIN(LONGINT); neg := FALSE
|
||||
ELSE
|
||||
HALT(99)
|
||||
END
|
||||
END;
|
||||
IF neg THEN val := -val END
|
||||
END StrToInt;
|
||||
|
||||
(** Convert the substring beginning at position i in str into an integer. Any leading whitespace characters are ignored.
|
||||
After the conversion i pointes to the first character after the integer. *)
|
||||
PROCEDURE StrToIntPos*(VAR str: ARRAY OF CHAR; VAR val: LONGINT; VAR i: INTEGER);
|
||||
VAR noStr: ARRAY 16 OF CHAR;
|
||||
BEGIN
|
||||
WHILE (str[i] # 0X) & (str[i] <= " ") DO
|
||||
INC(i)
|
||||
END;
|
||||
val := 0;
|
||||
IF str[i] = "-" THEN
|
||||
noStr[val] := str[i]; INC(val); INC(i);
|
||||
WHILE (str[i] # 0X) & (str[i] <= " ") DO
|
||||
INC(i)
|
||||
END
|
||||
END;
|
||||
WHILE (str[i] >= "0") & (str[i] <= "9") DO
|
||||
noStr[val] := str[i]; INC(val); INC(i)
|
||||
END;
|
||||
noStr[val] := 0X;
|
||||
StrToInt(noStr, val)
|
||||
END StrToIntPos;
|
||||
|
||||
(** Convert an integer into a string. *)
|
||||
PROCEDURE IntToStr*(val: LONGINT; VAR str: ARRAY OF CHAR);
|
||||
VAR
|
||||
i, j: LONGINT;
|
||||
digits: ARRAY 16 OF LONGINT;
|
||||
BEGIN
|
||||
IF val = MIN(LONGINT) THEN
|
||||
COPY("-2147483648", str);
|
||||
RETURN
|
||||
END;
|
||||
IF val < 0 THEN
|
||||
val := -val; str[0] := "-"; j := 1
|
||||
ELSE
|
||||
j := 0
|
||||
END;
|
||||
i := 0;
|
||||
REPEAT
|
||||
digits[i] := val MOD 10; INC(i); val := val DIV 10
|
||||
UNTIL val = 0;
|
||||
DEC(i);
|
||||
WHILE i >= 0 DO
|
||||
str[j] := CHR(digits[i]+ORD("0")); INC(j); DEC(i)
|
||||
END;
|
||||
str[j] := 0X
|
||||
END IntToStr;
|
||||
|
||||
(** Converts a real to a string. *)
|
||||
PROCEDURE RealToStr*(x: LONGREAL; VAR s: ARRAY OF CHAR);
|
||||
VAR e, h, l, n, len: LONGINT; i, j, pos: INTEGER; z: LONGREAL; d: ARRAY 16 OF CHAR;
|
||||
|
||||
PROCEDURE Wr(ch: CHAR);
|
||||
BEGIN
|
||||
IF ch = 0X THEN HALT(42) END;
|
||||
IF pos < len THEN s[pos] := ch; INC(pos) END;
|
||||
END Wr;
|
||||
|
||||
BEGIN
|
||||
len := LEN(s)-1; pos := 0;
|
||||
e:= Reals.ExpoL(x);
|
||||
IF e = 2047 THEN
|
||||
Wr("N"); Wr("a"); Wr("N")
|
||||
ELSE
|
||||
n := 14;
|
||||
IF (x < 0) & (e # 0) THEN Wr("-"); x:= - x END;
|
||||
IF e = 0 THEN h:= 0; l:= 0 (* no denormals *)
|
||||
ELSE e:= (e - 1023) * 301029 DIV 1000000; (* ln(2)/ln(10) = 0.301029996 *)
|
||||
z:= Reals.Ten(e+1);
|
||||
IF x >= z THEN x:= x/z; INC(e) ELSE x:= x * Reals.Ten(-e) END;
|
||||
IF x >= 10 THEN x:= x * Reals.Ten(-1) + 0.5D0 / Reals.Ten(n); INC(e)
|
||||
ELSE x:= x + 0.5D0 / Reals.Ten(n);
|
||||
IF x >= 10 THEN x:= x * Reals.Ten(-1); INC(e) END
|
||||
END;
|
||||
x:= x * Reals.Ten(7); h:= ENTIER(x); x:= (x-h) * Reals.Ten(8); l:= ENTIER(x)
|
||||
END;
|
||||
i := 15; WHILE i > 7 DO d[i]:= CHR(l MOD 10 + ORD("0")); l:= l DIV 10; DEC(i) END;
|
||||
WHILE i >= 0 DO d[i]:= CHR(h MOD 10 + ORD("0")); h:= h DIV 10; DEC(i) END;
|
||||
IF ABS(e) > 8 THEN (* scientific notation *)
|
||||
j := 15; WHILE (j > 0) & (d[j] = "0") DO DEC(j) END;
|
||||
Wr(d[0]); IF j # 0 THEN Wr(".") END; i := 1; WHILE i <= j DO Wr(d[i]); INC(i) END;
|
||||
IF e < 0 THEN Wr("D"); Wr("-"); e:= - e ELSE Wr("D"); Wr("+") END;
|
||||
Wr(CHR(e DIV 100 + ORD("0"))); e:= e MOD 100;
|
||||
Wr(CHR(e DIV 10 + ORD("0"))); Wr(CHR(e MOD 10 + ORD("0")))
|
||||
ELSE
|
||||
IF e < 0 THEN (* leading zeros *)
|
||||
j := (* !15*) 14; WHILE (j > 0) & (d[j] = "0") DO DEC(j) END;
|
||||
Wr("0"); Wr("."); INC(e);
|
||||
WHILE e < 0 DO Wr("0"); INC(e) END;
|
||||
i := 0; WHILE i <= j DO Wr(d[i]); INC(i) END
|
||||
ELSE
|
||||
i := 0; WHILE (e >= 0) & (i < 16 ) DO Wr(d[i]); INC(i); DEC(e) END;
|
||||
IF i < 16 THEN
|
||||
Wr(".");
|
||||
WHILE i < (*16*) 15 DO Wr(d[i]); INC(i); END;
|
||||
WHILE s[pos - 1] = "0" DO DEC(pos) END;
|
||||
IF s[pos - 1] = "." THEN DEC(pos) END;
|
||||
END
|
||||
END
|
||||
END
|
||||
END;
|
||||
s[pos] := 0X
|
||||
END RealToStr;
|
||||
|
||||
PROCEDURE RealToFixStr*(x: LONGREAL; VAR str: ARRAY OF CHAR; n, f, D: LONGINT);
|
||||
VAR pos, len, e, i, h, l: LONGINT; r, z: LONGREAL; d: ARRAY 16 OF CHAR; s: CHAR;
|
||||
PROCEDURE Wr(ch: CHAR);
|
||||
BEGIN
|
||||
IF ch = 0X THEN HALT(42) END;
|
||||
IF pos < len THEN str[pos] := ch; INC(pos) END;
|
||||
END Wr;
|
||||
BEGIN
|
||||
len := LEN(str)-1; pos := 0;
|
||||
e := Reals.ExpoL(x);
|
||||
IF (e = 2047) OR (ABS(D) > 308) THEN
|
||||
Wr("N"); Wr("a"); Wr("N")
|
||||
ELSE
|
||||
IF D = 0 THEN DEC(n, 2) ELSE DEC(n, 7) END;
|
||||
IF n < 2 THEN n := 2 END;
|
||||
IF f < 0 THEN f := 0 END;
|
||||
IF n < f + 2 THEN n := f + 2 END;
|
||||
DEC(n, f);
|
||||
IF (e # 0) & (x < 0) THEN s := "-"; x := - x ELSE s := " " END;
|
||||
IF e = 0 THEN
|
||||
h := 0; l := 0; DEC(e, D-1) (* no denormals *)
|
||||
ELSE
|
||||
e := (e - 1023) * 301029 DIV 1000000; (* ln(2)/ln(10) = 0.301029996 *)
|
||||
z := Reals.Ten(e+1);
|
||||
IF x >= z THEN x := x/z; INC(e) ELSE x:= x * Reals.Ten(-e) END;
|
||||
DEC(e, D-1); i := -(e+f);
|
||||
IF i <= 0 THEN r := 5 * Reals.Ten(i) ELSE r := 0 END;
|
||||
IF x >= 10 THEN
|
||||
x := x * Reals.Ten(-1) + r; INC(e)
|
||||
ELSE
|
||||
x := x + r;
|
||||
IF x >= 10 THEN x := x * Reals.Ten(-1); INC(e) END
|
||||
END;
|
||||
x := x * Reals.Ten(7); h:= ENTIER(x); x := (x-h) * Reals.Ten(8); l := ENTIER(x)
|
||||
END;
|
||||
i := 15;
|
||||
WHILE i > 7 DO d[i] := CHR(l MOD 10 + ORD("0")); l := l DIV 10; DEC(i) END;
|
||||
WHILE i >= 0 DO d[i] := CHR(h MOD 10 + ORD("0")); h := h DIV 10; DEC(i) END;
|
||||
IF n <= e THEN n := e + 1 END;
|
||||
IF e > 0 THEN
|
||||
WHILE n > e DO Wr(" "); DEC(n) END;
|
||||
Wr(s); e:= 0;
|
||||
WHILE n > 0 DO
|
||||
DEC(n);
|
||||
IF e < 16 THEN Wr(d[e]); INC(e) ELSE Wr("0") END
|
||||
END;
|
||||
Wr(".")
|
||||
ELSE
|
||||
WHILE n > 1 DO Wr(" "); DEC(n) END;
|
||||
Wr(s); Wr("0"); Wr(".");
|
||||
WHILE (0 < f) & (e < 0) DO Wr("0"); DEC(f); INC(e) END
|
||||
END;
|
||||
WHILE f > 0 DO
|
||||
DEC(f);
|
||||
IF e < 16 THEN Wr(d[e]); INC(e) ELSE Wr("0") END
|
||||
END;
|
||||
IF D # 0 THEN
|
||||
IF D < 0 THEN Wr("D"); Wr("-"); D := - D
|
||||
ELSE Wr("D"); Wr("+")
|
||||
END;
|
||||
Wr(CHR(D DIV 100 + ORD("0"))); D := D MOD 100;
|
||||
Wr(CHR(D DIV 10 + ORD("0"))); Wr(CHR(D MOD 10 + ORD("0")))
|
||||
END
|
||||
END;
|
||||
str[pos] := 0X
|
||||
END RealToFixStr;
|
||||
|
||||
(** Convert a string into a real. Precondition: s has a well defined real syntax. Scientific notation with D and E to indicate exponents is allowed. *)
|
||||
PROCEDURE StrToReal*(s: ARRAY OF CHAR; VAR r: LONGREAL);
|
||||
VAR p, e: INTEGER; y, g: LONGREAL; neg, negE: BOOLEAN;
|
||||
BEGIN
|
||||
p := 0;
|
||||
WHILE (s[p] = " ") OR (s[p] = "0") DO INC(p) END;
|
||||
IF s[p] = "-" THEN neg := TRUE; INC(p) ELSE neg := FALSE END;
|
||||
WHILE (s[p] = " ") OR (s[p] = "0") DO INC(p) END;
|
||||
|
||||
y := 0;
|
||||
WHILE ("0" <= s[p]) & (s[p] <= "9") DO
|
||||
y := y * 10 + (ORD(s[p]) - 30H);
|
||||
INC(p);
|
||||
END;
|
||||
IF s[p] = "." THEN
|
||||
INC(p); g := 1;
|
||||
WHILE ("0" <= s[p]) & (s[p] <= "9") DO
|
||||
g := g / 10; y := y + g * (ORD(s[p]) - 30H);
|
||||
INC(p);
|
||||
END;
|
||||
END;
|
||||
IF (s[p] = "D") OR (s[p] = "E") THEN
|
||||
INC(p); e := 0;
|
||||
IF s[p] = "-" THEN negE := TRUE; INC(p) ELSE negE := FALSE END;
|
||||
WHILE (s[p] = "0") DO INC(p) END;
|
||||
WHILE ("0" <= s[p]) & (s[p] <= "9") DO
|
||||
e := e * 10 + (ORD(s[p]) - 30H);
|
||||
INC(p);
|
||||
END;
|
||||
IF negE THEN y := y / Reals.Ten(e)
|
||||
ELSE y := y * Reals.Ten(e) END;
|
||||
END;
|
||||
IF neg THEN y := -y END;
|
||||
r := y;
|
||||
END StrToReal;
|
||||
|
||||
(** Convert a string into a boolean. "Yes", "True" and "On" are TRUE all other strings are FALSE.
|
||||
Leading white space characters are ignored. *)
|
||||
PROCEDURE StrToBool*(VAR str: ARRAY OF CHAR; VAR b: BOOLEAN);
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE (str[i] # 0X) & (str[i] <= " ") DO
|
||||
INC(i)
|
||||
END;
|
||||
CASE CAP(str[i]) OF
|
||||
"Y", "T": b := TRUE
|
||||
|"O": b := CAP(str[i+1]) = "N"
|
||||
ELSE
|
||||
b := FALSE
|
||||
END
|
||||
END StrToBool;
|
||||
|
||||
(** Convert a boolean into "Yes" or "No". *)
|
||||
PROCEDURE BoolToStr*(b: BOOLEAN; VAR str: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
IF b THEN
|
||||
COPY("Yes", str)
|
||||
ELSE
|
||||
COPY("No", str)
|
||||
END
|
||||
END BoolToStr;
|
||||
|
||||
(** Convert a string to a set *)
|
||||
PROCEDURE StrToSet* (str: ARRAY OF CHAR; VAR set: SET);
|
||||
VAR i, d, d1: INTEGER; ch: CHAR; dot: BOOLEAN;
|
||||
BEGIN
|
||||
set := {}; dot := FALSE;
|
||||
i := 0; ch := str[i];
|
||||
WHILE (ch # 0X) & (ch # "}") DO
|
||||
WHILE (ch # 0X) & ((ch < "0") OR (ch > "9")) DO INC(i); ch := str[i] END;
|
||||
d := 0; WHILE (ch >= "0") & (ch <= "9") DO d := d*10 + ORD(ch) - 30H; INC(i); ch := str[i] END;
|
||||
IF d <= MAX(SET) THEN INCL(set, d) END;
|
||||
IF dot THEN
|
||||
d1 := 0;
|
||||
WHILE (d1 <= MAX(SET)) & (d1 < d) DO INCL(set, d1); INC(d1) END;
|
||||
dot := FALSE
|
||||
END;
|
||||
WHILE ch = " " DO INC(i); ch := str[i] END;
|
||||
IF ch = "." THEN d1 := d + 1; dot := TRUE END
|
||||
END
|
||||
END StrToSet;
|
||||
|
||||
(** Convert a set to a string *)
|
||||
PROCEDURE SetToStr* (set: SET; VAR str: ARRAY OF CHAR);
|
||||
VAR i, j, k: INTEGER; noFirst: BOOLEAN;
|
||||
BEGIN
|
||||
str[0] := "{"; i := 0; k := 1; noFirst := FALSE;
|
||||
WHILE i <= MAX(SET) DO
|
||||
IF i IN set THEN
|
||||
IF noFirst THEN str[k] := ","; INC(k) ELSE noFirst := TRUE END;
|
||||
IF i >= 10 THEN str[k] := CHR(i DIV 10 + 30H); INC(k) END;
|
||||
str[k] := CHR(i MOD 10 + 30H); INC(k);
|
||||
j := i; INC(i);
|
||||
WHILE (i <= MAX(SET)) & (i IN set) DO INC(i) END;
|
||||
IF i-2 > j THEN
|
||||
str[k] := "."; str[k+1] := "."; INC(k, 2); j := i - 1;
|
||||
IF j >= 10 THEN str[k] := CHR(j DIV 10 + 30H); INC(k) END;
|
||||
str[k] := CHR(j MOD 10 + 30H); INC(k)
|
||||
ELSE i := j
|
||||
END
|
||||
END;
|
||||
INC(i)
|
||||
END;
|
||||
str[k] := "}"; str[k+1] := 0X
|
||||
END SetToStr;
|
||||
|
||||
(** Convert date (Oberon.GetClock) into specified format. *)
|
||||
PROCEDURE DateToStr*(date: LONGINT; VAR str: ARRAY OF CHAR);
|
||||
VAR i, j, k, x: LONGINT; form, name: ARRAY 32 OF CHAR;
|
||||
BEGIN
|
||||
COPY(dateform, form);
|
||||
IF form = "" THEN form := "DD.MM.YY" END;
|
||||
i := 0; j := 0;
|
||||
WHILE form[j] # 0X DO
|
||||
IF CAP(form[j]) = "D" THEN (* Day *)
|
||||
INC(j); x := date MOD 32;
|
||||
IF CAP(form[j]) = "D" THEN
|
||||
INC(j);
|
||||
IF CAP(form[j]) = "D" THEN
|
||||
INC(j); x := Dates.DayOfWeek(date);
|
||||
IF CAP(form[j]) = "D" THEN INC(j); COPY(lDayName[x], name)
|
||||
ELSE COPY(sDayName[x], name)
|
||||
END;
|
||||
k := 0; WHILE name[k] # 0X DO str[i] := name[k]; INC(i); INC(k) END
|
||||
ELSE (* day with leading zero *)
|
||||
str[i] := CHR(x DIV 10 + ORD("0"));
|
||||
str[i + 1] := CHR(x MOD 10 + ORD("0"));
|
||||
INC(i, 2)
|
||||
END
|
||||
ELSE (* no leading zero *)
|
||||
IF x > 9 THEN str[i] := CHR(x DIV 10 + ORD("0")); INC(i) END;
|
||||
str[i] := CHR(x MOD 10 + ORD("0")); INC(i)
|
||||
END
|
||||
ELSIF CAP(form[j]) = "M" THEN (* Month *)
|
||||
INC(j); x := date DIV 32 MOD 16;
|
||||
IF CAP(form[j]) = "M" THEN
|
||||
INC(j);
|
||||
IF CAP(form[j]) = "M" THEN
|
||||
INC(j);
|
||||
IF CAP(form[j]) = "M" THEN INC(j); COPY(lMonthName[x-1], name)
|
||||
ELSE COPY(sMonthName[x-1], name)
|
||||
END;
|
||||
k := 0; WHILE name[k] # 0X DO str[i] := name[k]; INC(i); INC(k) END
|
||||
ELSE
|
||||
str[i] := CHR(x DIV 10 + ORD("0"));
|
||||
str[i + 1] := CHR(x MOD 10 + ORD("0"));
|
||||
INC(i, 2)
|
||||
END
|
||||
ELSE
|
||||
IF x > 9 THEN str[i] := CHR(x DIV 10 + ORD("0")); INC(i) END;
|
||||
str[i] := CHR(x MOD 10 + ORD("0")); INC(i)
|
||||
END
|
||||
ELSIF CAP(form[j]) = "Y" THEN (* Year *)
|
||||
INC(j,2); x := date DIV 512;
|
||||
IF CAP(form[j]) = "Y" THEN
|
||||
INC(j, 2); INC(x, 1900);
|
||||
str[i] := CHR(x DIV 1000 + ORD("0")); str[i + 1] := CHR(x DIV 100 MOD 10 + ORD("0"));
|
||||
str[i + 2] := CHR(x DIV 10 MOD 10 + ORD("0")); str[i + 3] := CHR(x MOD 10 + ORD("0"));
|
||||
INC(i, 4)
|
||||
ELSE
|
||||
str[i] := CHR(x DIV 10 MOD 10 + ORD("0")); str[i + 1] := CHR(x MOD 10 + ORD("0"));
|
||||
INC(i, 2)
|
||||
END
|
||||
ELSE str[i] := form[j]; INC(i); INC(j)
|
||||
END
|
||||
END;
|
||||
str[i] := 0X
|
||||
END DateToStr;
|
||||
|
||||
(** Returns a month's name (set short to get the abbreviation) *)
|
||||
PROCEDURE MonthToStr* (month: INTEGER; VAR str: ARRAY OF CHAR; short: BOOLEAN);
|
||||
BEGIN
|
||||
month := (month - 1) MOD 12;
|
||||
IF short THEN COPY(sMonthName[month], str) ELSE COPY(lMonthName[month], str) END
|
||||
END MonthToStr;
|
||||
|
||||
(** Returns a day's name (set short to get the abbreviation) *)
|
||||
PROCEDURE DayToStr* (day: INTEGER; VAR str: ARRAY OF CHAR; short: BOOLEAN);
|
||||
BEGIN
|
||||
IF short THEN COPY(sDayName[day MOD 7], str) ELSE COPY(lDayName[day MOD 7], str) END
|
||||
END DayToStr;
|
||||
|
||||
(** Convert time (Oberon.GetClock) into specified format. *)
|
||||
PROCEDURE TimeToStr*(time: LONGINT; VAR str: ARRAY OF CHAR);
|
||||
VAR i, j, x, h, hPos: LONGINT; form: ARRAY 32 OF CHAR; shortH, leadingH: BOOLEAN;
|
||||
BEGIN
|
||||
COPY(timeform, form);
|
||||
IF form = "" THEN form := "HH:MM:SS" END;
|
||||
i := 0; j := 0; h:= time DIV 4096 MOD 32; shortH := FALSE;
|
||||
WHILE form[j] # 0X DO
|
||||
IF ((CAP(form[j]) = "A") OR (CAP(form[j]) = "P")) & (CAP(form[j+1]) = "M") THEN
|
||||
shortH := TRUE;
|
||||
IF CAP(form[j]) = form[j] THEN x := 0 ELSE x := 32 END;
|
||||
IF (h < 1) OR (h > 12) THEN str[i] := CHR(ORD("P") + x) ELSE str[i] := CHR(ORD("A") + x) END;
|
||||
h := h MOD 12; IF h = 0 THEN h := 12 END;
|
||||
str[i + 1] := CHR(ORD("M") + x);
|
||||
INC(i, 2);
|
||||
WHILE (CAP(form[j]) = "A") OR (CAP(form[j]) = "P") OR (CAP(form[j]) = "M") DO INC(j) END
|
||||
ELSIF form[j] = "H" THEN
|
||||
hPos := i; INC(i, 2); INC(j); leadingH := (form[j] = "H");
|
||||
IF leadingH THEN INC(j) END
|
||||
ELSIF form[j] = "M" THEN
|
||||
INC(j); x := time DIV 64 MOD 64;
|
||||
IF form[j] = "M" THEN str[i] := CHR(x DIV 10 + ORD("0")); INC(i); INC(j)
|
||||
ELSIF x > 9 THEN str[i] := CHR(x DIV 10 + ORD("0")); INC(i)
|
||||
END;
|
||||
str[i] := CHR(x MOD 10 + ORD("0")); INC(i)
|
||||
ELSIF form[j] = "S" THEN
|
||||
INC(j); x := time MOD 64;
|
||||
IF form[j] = "S" THEN str[i] := CHR(x DIV 10 + ORD("0")); INC(i); INC(j)
|
||||
ELSIF x > 9 THEN str[i] := CHR(x DIV 10 + ORD("0")); INC(i)
|
||||
END;
|
||||
str[i] := CHR(x MOD 10 + ORD("0")); INC(i)
|
||||
ELSE str[i] := form[j]; INC(i); INC(j)
|
||||
END
|
||||
END;
|
||||
str[i] := 0X;
|
||||
IF ~leadingH THEN
|
||||
IF h > 9 THEN str[hPos] := CHR(h DIV 10 + ORD("0")); INC(hPos)
|
||||
ELSE i := hPos + 1; WHILE str[i] # 0X DO str[i] := str[i + 1]; INC(i) END
|
||||
END;
|
||||
str[hPos] := CHR(h MOD 10 + ORD("0"))
|
||||
ELSE
|
||||
str[hPos] := CHR(h DIV 10 + ORD("0"));
|
||||
str[hPos + 1] := CHR(h MOD 10 + ORD("0"))
|
||||
END
|
||||
END TimeToStr;
|
||||
|
||||
(** Convert a string into an time value. Leading white space characters are ignored. *)
|
||||
PROCEDURE StrToTime*(str: ARRAY OF CHAR; VAR time: LONGINT);
|
||||
VAR
|
||||
h, m, s: LONGINT;
|
||||
i: INTEGER;
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE (str[i] # 0X) & ((str[i] < "0") OR (str[i] > "9")) DO INC(i) END;
|
||||
StrToIntPos(str, h, i);
|
||||
WHILE (str[i] # 0X) & ((str[i] < "0") OR (str[i] > "9")) DO INC(i) END;
|
||||
StrToIntPos(str, m, i);
|
||||
WHILE (str[i] # 0X) & ((str[i] < "0") OR (str[i] > "9")) DO INC(i) END;
|
||||
StrToIntPos(str, s, i);
|
||||
time := (h*64 + m)*64 + s
|
||||
END StrToTime;
|
||||
|
||||
(** Convert a string into an date value. Leading white space characters are ignored. *)
|
||||
PROCEDURE StrToDate*(str: ARRAY OF CHAR; VAR date: LONGINT);
|
||||
VAR
|
||||
d, m, y: LONGINT;
|
||||
i: INTEGER;
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE (str[i] # 0X) & ((str[i] < "0") OR (str[i] > "9")) DO INC(i) END;
|
||||
StrToIntPos(str, d, i);
|
||||
WHILE (str[i] # 0X) & ((str[i] < "0") OR (str[i] > "9")) DO INC(i) END;
|
||||
StrToIntPos(str, m, i);
|
||||
WHILE (str[i] # 0X) & ((str[i] < "0") OR (str[i] > "9")) DO INC(i) END;
|
||||
StrToIntPos(str, y, i); y := y-1900;
|
||||
date := (y*16 + m)*32 + d
|
||||
END StrToDate;
|
||||
|
||||
PROCEDURE Init();
|
||||
VAR i: LONGINT; s: Texts.Scanner; txt : Texts.Text; (* noch *)
|
||||
BEGIN
|
||||
Texts.Open(txt, "System.DateFormat"); (* got rid of Oberon.OpenScanner -- noch *)
|
||||
Texts.OpenScanner(s, txt, 0);
|
||||
IF s.class = Texts.String THEN COPY(s.s, dateform) ELSE dateform := "" END;
|
||||
Texts.Open(txt, "System.TimeFormat");
|
||||
Texts.OpenScanner(s, txt, 0);
|
||||
IF s.class = Texts.String THEN COPY(s.s, timeform) ELSE timeform := "" END;
|
||||
sDayName[0] := "Mon"; sDayName[1] := "Tue"; sDayName[2] := "Wed"; sDayName[3] := "Thu";
|
||||
sDayName[4] := "Fri"; sDayName[5] := "Sat"; sDayName[6] := "Sun";
|
||||
|
||||
lDayName[0] := "Monday"; lDayName[1] := "Tuesday"; lDayName[2] := "Wednesday"; lDayName[3] := "Thursday";
|
||||
lDayName[4] := "Friday"; lDayName[5] := "Saturday"; lDayName[6] := "Sunday";
|
||||
|
||||
sMonthName[0] := "Jan"; sMonthName[1] := "Feb"; sMonthName[2] := "Mar"; sMonthName[3] := "Apr";
|
||||
sMonthName[4] := "May"; sMonthName[5] := "Jun"; sMonthName[6] := "Jul"; sMonthName[7] := "Aug";
|
||||
sMonthName[8] := "Sep"; sMonthName[9] := "Oct"; sMonthName[10] := "Nov"; sMonthName[11] := "Dec";
|
||||
|
||||
lMonthName[0] := "January"; lMonthName[1] := "February"; lMonthName[2] := "March"; lMonthName[3] := "April";
|
||||
lMonthName[4] := "May"; lMonthName[5] := "June"; lMonthName[6] := "July"; lMonthName[7] := "August";
|
||||
lMonthName[8] := "September"; lMonthName[9] := "October"; lMonthName[10] := "November";
|
||||
lMonthName[11] := "December";
|
||||
|
||||
FOR i := 0 TO 255 DO
|
||||
isAlpha[i] := ((i >= ORD("A")) & (i <= ORD("Z"))) OR ((i >= ORD("a")) & (i <= ORD("z")))
|
||||
END;
|
||||
isAlpha[ORD("€")] := TRUE; isAlpha[ORD("<22>")] := TRUE; isAlpha[ORD("‚")] := TRUE;
|
||||
isAlpha[ORD("ƒ")] := TRUE; isAlpha[ORD("„")] := TRUE; isAlpha[ORD("…")] := TRUE;
|
||||
isAlpha[ORD("†")] := TRUE; isAlpha[ORD("‡")] := TRUE; isAlpha[ORD("ˆ")] := TRUE;
|
||||
isAlpha[ORD("‰")] := TRUE; isAlpha[ORD("Š")] := TRUE; isAlpha[ORD("‹")] := TRUE;
|
||||
isAlpha[ORD("Œ")] := TRUE; isAlpha[ORD("<22>")] := TRUE; isAlpha[ORD("Ž")] := TRUE;
|
||||
isAlpha[ORD("<22>")] := TRUE; isAlpha[ORD("<22>")] := TRUE; isAlpha[ORD("‘")] := TRUE;
|
||||
isAlpha[ORD("’")] := TRUE; isAlpha[ORD("“")] := TRUE; isAlpha[ORD("”")] := TRUE;
|
||||
isAlpha[ORD("•")] := TRUE; isAlpha[ORD("–")] := TRUE;
|
||||
FOR i := 0 TO 255 DO
|
||||
ISOToOberon[i] := CHR(i); OberonToISO[i] := CHR(i)
|
||||
END;
|
||||
ISOToOberon[8] := CHR(127);
|
||||
ISOToOberon[146] := CHR(39);
|
||||
ISOToOberon[160] := CHR(32);
|
||||
ISOToOberon[162] := CHR(99);
|
||||
ISOToOberon[166] := CHR(124);
|
||||
ISOToOberon[168] := CHR(34);
|
||||
ISOToOberon[169] := CHR(99);
|
||||
ISOToOberon[170] := CHR(97);
|
||||
ISOToOberon[171] := CHR(60);
|
||||
ISOToOberon[173] := CHR(45);
|
||||
ISOToOberon[174] := CHR(114);
|
||||
ISOToOberon[175] := CHR(45);
|
||||
ISOToOberon[176] := CHR(111);
|
||||
ISOToOberon[178] := CHR(50);
|
||||
ISOToOberon[179] := CHR(51);
|
||||
ISOToOberon[180] := CHR(39);
|
||||
ISOToOberon[183] := CHR(46);
|
||||
ISOToOberon[185] := CHR(49);
|
||||
ISOToOberon[186] := CHR(48);
|
||||
ISOToOberon[187] := CHR(62);
|
||||
ISOToOberon[192] := CHR(65);
|
||||
ISOToOberon[193] := CHR(65);
|
||||
ISOToOberon[194] := CHR(65);
|
||||
ISOToOberon[195] := CHR(65);
|
||||
ISOToOberon[196] := CHR(128); OberonToISO[128] := CHR(196);
|
||||
ISOToOberon[197] := CHR(65);
|
||||
ISOToOberon[198] := CHR(65);
|
||||
ISOToOberon[199] := CHR(67);
|
||||
ISOToOberon[200] := CHR(69);
|
||||
ISOToOberon[201] := CHR(69);
|
||||
ISOToOberon[202] := CHR(69);
|
||||
ISOToOberon[203] := CHR(69);
|
||||
ISOToOberon[204] := CHR(73);
|
||||
ISOToOberon[205] := CHR(73);
|
||||
ISOToOberon[206] := CHR(73);
|
||||
ISOToOberon[207] := CHR(73);
|
||||
ISOToOberon[208] := CHR(68);
|
||||
ISOToOberon[209] := CHR(78);
|
||||
ISOToOberon[210] := CHR(79);
|
||||
ISOToOberon[211] := CHR(79);
|
||||
ISOToOberon[212] := CHR(79);
|
||||
ISOToOberon[213] := CHR(79);
|
||||
ISOToOberon[214] := CHR(129); OberonToISO[129] := CHR(214);
|
||||
ISOToOberon[215] := CHR(42);
|
||||
ISOToOberon[216] := CHR(79);
|
||||
ISOToOberon[217] := CHR(85);
|
||||
ISOToOberon[218] := CHR(85);
|
||||
ISOToOberon[219] := CHR(85);
|
||||
ISOToOberon[220] := CHR(130); OberonToISO[130] := CHR(220);
|
||||
ISOToOberon[221] := CHR(89);
|
||||
ISOToOberon[222] := CHR(80);
|
||||
ISOToOberon[223] := CHR(150); OberonToISO[150] := CHR(223);
|
||||
ISOToOberon[224] := CHR(139); OberonToISO[139] := CHR(224);
|
||||
ISOToOberon[225] := CHR(148); OberonToISO[148] := CHR(225);
|
||||
ISOToOberon[226] := CHR(134); OberonToISO[134] := CHR(226);
|
||||
ISOToOberon[227] := CHR(97);
|
||||
ISOToOberon[228] := CHR(131); OberonToISO[131] := CHR(228);
|
||||
ISOToOberon[229] := CHR(97);
|
||||
ISOToOberon[230] := CHR(97);
|
||||
ISOToOberon[231] := CHR(147); OberonToISO[147] := CHR(231);
|
||||
ISOToOberon[232] := CHR(140); OberonToISO[140] := CHR(232);
|
||||
ISOToOberon[233] := CHR(144); OberonToISO[144] := CHR(233);
|
||||
ISOToOberon[234] := CHR(135); OberonToISO[135] := CHR(234);
|
||||
ISOToOberon[235] := CHR(145); OberonToISO[145] := CHR(235);
|
||||
ISOToOberon[236] := CHR(141); OberonToISO[141] := CHR(236);
|
||||
ISOToOberon[237] := CHR(105);
|
||||
ISOToOberon[238] := CHR(136); OberonToISO[136] := CHR(238);
|
||||
ISOToOberon[239] := CHR(146); OberonToISO[146] := CHR(239);
|
||||
ISOToOberon[240] := CHR(100);
|
||||
ISOToOberon[241] := CHR(149); OberonToISO[149] := CHR(241);
|
||||
ISOToOberon[242] := CHR(142); OberonToISO[142] := CHR(242);
|
||||
ISOToOberon[243] := CHR(111);
|
||||
ISOToOberon[244] := CHR(137); OberonToISO[137] := CHR(244);
|
||||
ISOToOberon[245] := CHR(111);
|
||||
ISOToOberon[246] := CHR(132); OberonToISO[132] := CHR(246);
|
||||
ISOToOberon[248] := CHR(111);
|
||||
ISOToOberon[249] := CHR(143); OberonToISO[143] := CHR(249);
|
||||
ISOToOberon[250] := CHR(117);
|
||||
ISOToOberon[251] := CHR(138); OberonToISO[138] := CHR(251);
|
||||
ISOToOberon[252] := CHR(133); OberonToISO[133] := CHR(252);
|
||||
ISOToOberon[253] := CHR(121);
|
||||
ISOToOberon[254] := CHR(112);
|
||||
ISOToOberon[255] := CHR(121);
|
||||
CRLF[0] := CR; CRLF[1] := LF; CRLF[2] := 0X; CRLF[3] := 0X
|
||||
END Init;
|
||||
|
||||
BEGIN
|
||||
Init()
|
||||
END ethStrings.
|
||||
305
src/lib/s3/powerpc/ethReals.Mod
Normal file
305
src/lib/s3/powerpc/ethReals.Mod
Normal file
|
|
@ -0,0 +1,305 @@
|
|||
(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
|
||||
Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
|
||||
|
||||
MODULE ethReals; (** portable *)
|
||||
|
||||
(** Implementation of the non-portable components of IEEE REAL and
|
||||
LONGREAL manipulation. The routines here are required to do conversion
|
||||
of reals to strings and back.
|
||||
Implemented by Bernd Moesli, Seminar for Applied Mathematics,
|
||||
Swiss Federal Institute of Technology Z…rich.
|
||||
*)
|
||||
|
||||
IMPORT SYSTEM;
|
||||
|
||||
(* Bernd Moesli
|
||||
Seminar for Applied Mathematics
|
||||
Swiss Federal Institute of Technology Zurich
|
||||
Copyright 1993
|
||||
|
||||
Support module for IEEE floating-point numbers
|
||||
|
||||
Please change constant definitions of H, L depending on byte ordering
|
||||
Use bm.TestReals.Do for testing the implementation.
|
||||
|
||||
Expo, ExpoL return the shifted binary exponent (0 <= e < 256 (2048 resp.))
|
||||
SetExpo, SetExpoL set the shifted binary exponent
|
||||
Real, RealL convert hexadecimals to reals
|
||||
Int, IntL convert reals to hexadecimals
|
||||
Ten returns 10^e (e <= 308, 308 < e delivers NaN)
|
||||
|
||||
1993.4.22 IEEE format only, 32-bits LONGINTs only
|
||||
30.8.1993 mh: changed RealX to avoid compiler warnings;
|
||||
7.11.1995 jt: dynamic endianess test
|
||||
22.01.97 pjm: NaN stuff (using quiet NaNs only to avoid traps)
|
||||
05.01.98 prk: NaN with INF support
|
||||
*)
|
||||
|
||||
VAR
|
||||
DefaultFCR*: SET;
|
||||
tene: ARRAY 23 OF LONGREAL; (* e = 0..22: exact values of 10^e *)
|
||||
ten: ARRAY 27 OF LONGREAL;
|
||||
eq, gr: ARRAY 20 OF SET;
|
||||
H, L: INTEGER;
|
||||
|
||||
(** Returns the shifted binary exponent (0 <= e < 256). *)
|
||||
PROCEDURE Expo* (x: REAL): LONGINT;
|
||||
BEGIN
|
||||
RETURN ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256
|
||||
END Expo;
|
||||
|
||||
(** Returns the shifted binary exponent (0 <= e < 2048). *)
|
||||
PROCEDURE ExpoL* (x: LONGREAL): LONGINT;
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, i); RETURN ASH(i, -20) MOD 2048
|
||||
END ExpoL;
|
||||
|
||||
(** Sets the shifted binary exponent. *)
|
||||
PROCEDURE SetExpo* (e: LONGINT; VAR x: REAL);
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x), i);
|
||||
i:= ASH(ASH(ASH(i, -31), 8) + e MOD 256, 23) + i MOD ASH(1, 23);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x), i)
|
||||
END SetExpo;
|
||||
|
||||
(** Sets the shifted binary exponent. *)
|
||||
PROCEDURE SetExpoL* (e: LONGINT; VAR x: LONGREAL);
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, i);
|
||||
i:= ASH(ASH(ASH(i, -31), 11) + e MOD 2048, 20) + i MOD ASH(1, 20);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + H, i)
|
||||
END SetExpoL;
|
||||
|
||||
(** Convert hexadecimal to REAL. *)
|
||||
PROCEDURE Real* (h: LONGINT): REAL;
|
||||
VAR x: REAL;
|
||||
BEGIN SYSTEM.PUT(SYSTEM.ADR(x), h); RETURN x
|
||||
END Real;
|
||||
|
||||
(** Convert hexadecimal to LONGREAL. h and l are the high and low parts.*)
|
||||
PROCEDURE RealL* (h, l: LONGINT): LONGREAL;
|
||||
VAR x: LONGREAL;
|
||||
BEGIN SYSTEM.PUT(SYSTEM.ADR(x) + H, h); SYSTEM.PUT(SYSTEM.ADR(x) + L, l); RETURN x
|
||||
END RealL;
|
||||
|
||||
(** Convert REAL to hexadecimal. *)
|
||||
PROCEDURE Int* (x: REAL): LONGINT;
|
||||
VAR i: LONGINT;
|
||||
BEGIN SYSTEM.PUT(SYSTEM.ADR(i), x); RETURN i
|
||||
END Int;
|
||||
|
||||
(** Convert LONGREAL to hexadecimal. h and l are the high and low parts. *)
|
||||
PROCEDURE IntL* (x: LONGREAL; VAR h, l: LONGINT);
|
||||
BEGIN SYSTEM.GET(SYSTEM.ADR(x) + H, h); SYSTEM.GET(SYSTEM.ADR(x) + L, l)
|
||||
END IntL;
|
||||
|
||||
(** Returns 10^e (e <= 308, 308 < e delivers IEEE-code +INF). *)
|
||||
PROCEDURE Ten* (e: LONGINT): LONGREAL;
|
||||
VAR E: LONGINT; r: LONGREAL;
|
||||
BEGIN
|
||||
IF e < -307 THEN RETURN 0 ELSIF 308 < e THEN RETURN RealL(2146435072, 0) END;
|
||||
INC(e, 307); r:= ten[e DIV 23] * tene[e MOD 23];
|
||||
IF e MOD 32 IN eq[e DIV 32] THEN RETURN r
|
||||
ELSE
|
||||
E:= ExpoL(r); SetExpoL(1023+52, r);
|
||||
IF e MOD 32 IN gr[e DIV 32] THEN r:= r-1 ELSE r:= r+1 END;
|
||||
SetExpoL(E, r); RETURN r
|
||||
END
|
||||
END Ten;
|
||||
|
||||
(** Returns the NaN code (0 <= c < 8399608) or -1 if not NaN/Infinite. *)
|
||||
PROCEDURE NaNCode* (x: REAL): LONGINT;
|
||||
BEGIN
|
||||
IF ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256 = 255 THEN (* Infinite or NaN *)
|
||||
RETURN SYSTEM.VAL(LONGINT, x) MOD 800000H (* lowest 23 bits *)
|
||||
ELSE
|
||||
RETURN -1
|
||||
END
|
||||
END NaNCode;
|
||||
|
||||
(** Returns the NaN code (0 <= h < 1048576, MIN(LONGINT) <= l <= MAX(LONGINT)) or (-1,-1) if not NaN/Infinite. *)
|
||||
PROCEDURE NaNCodeL* (x: LONGREAL; VAR h, l: LONGINT);
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, h); SYSTEM.GET(SYSTEM.ADR(x) + L, l);
|
||||
IF ASH(h, -20) MOD 2048 = 2047 THEN (* Infinite or NaN *)
|
||||
h := h MOD 100000H (* lowest 20 bits *)
|
||||
ELSE
|
||||
h := -1; l := -1
|
||||
END
|
||||
END NaNCodeL;
|
||||
|
||||
(** Returns TRUE iff x is NaN/Infinite. *)
|
||||
PROCEDURE IsNaN* (x: REAL): BOOLEAN;
|
||||
BEGIN
|
||||
RETURN ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256 = 255
|
||||
END IsNaN;
|
||||
|
||||
(** Returns TRUE iff x is NaN/Infinite. *)
|
||||
PROCEDURE IsNaNL* (x: LONGREAL): BOOLEAN;
|
||||
VAR h: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, h);
|
||||
RETURN ASH(h, -20) MOD 2048 = 2047
|
||||
END IsNaNL;
|
||||
|
||||
(** Returns NaN with specified code (0 <= l < 8399608). *)
|
||||
PROCEDURE NaN* (l: LONGINT): REAL;
|
||||
VAR x: REAL;
|
||||
BEGIN
|
||||
SYSTEM.PUT(SYSTEM.ADR(x), (l MOD 800000H) + 7F800000H);
|
||||
RETURN x
|
||||
END NaN;
|
||||
|
||||
(** Returns NaN with specified code (0 <= h < 1048576, MIN(LONGINT) <= l <= MAX(LONGINT)). *)
|
||||
PROCEDURE NaNL* (h, l: LONGINT): LONGREAL;
|
||||
VAR x: LONGREAL;
|
||||
BEGIN
|
||||
h := (h MOD 100000H) + 7FF00000H;
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + H, h);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + L, l);
|
||||
RETURN x
|
||||
END NaNL;
|
||||
(*
|
||||
PROCEDURE fcr(): SET;
|
||||
CODE {SYSTEM.i386, SYSTEM.FPU}
|
||||
PUSH 0
|
||||
FSTCW [ESP]
|
||||
FWAIT
|
||||
POP EAX
|
||||
END fcr;
|
||||
*) (* commented out -- noch *)
|
||||
(** Return state of the floating-point control register. *)
|
||||
(*PROCEDURE FCR*(): SET;
|
||||
BEGIN
|
||||
IF Kernel.copro THEN
|
||||
RETURN fcr()
|
||||
ELSE
|
||||
RETURN DefaultFCR
|
||||
END
|
||||
END FCR;
|
||||
*)
|
||||
(*PROCEDURE setfcr(s: SET);
|
||||
CODE {SYSTEM.i386, SYSTEM.FPU}
|
||||
FLDCW s[EBP]
|
||||
END setfcr;
|
||||
*)
|
||||
(** Set state of floating-point control register. Traps reset this to the default & ENTIER resets the rounding mode. *)
|
||||
(*PROCEDURE SetFCR*(s: SET);
|
||||
BEGIN
|
||||
IF Kernel.copro THEN setfcr(s) END
|
||||
END SetFCR;
|
||||
*)
|
||||
PROCEDURE RealX (h, l: LONGINT; adr: LONGINT);
|
||||
BEGIN SYSTEM.PUT(adr + H, h); SYSTEM.PUT(adr + L, l);
|
||||
END RealX;
|
||||
|
||||
PROCEDURE InitHL;
|
||||
VAR (*i: LONGINT; dmy: INTEGER;*) littleEndian: BOOLEAN;
|
||||
BEGIN
|
||||
(*DefaultFCR := (FCR() - {0,2,3,10,11}) + {0..5,8,9};
|
||||
SetFCR(DefaultFCR);
|
||||
|
||||
dmy := 1; i := SYSTEM.ADR(dmy);
|
||||
SYSTEM.GET(i, littleEndian); (* indirection via i avoids warning on SUN cc -O *)*)
|
||||
littleEndian := FALSE; (* endianness will be set for each architecture -- noch *)
|
||||
IF littleEndian THEN H := 4; L := 0 ELSE H := 0; L := 4 END
|
||||
END InitHL;
|
||||
|
||||
BEGIN InitHL;
|
||||
RealX(03FF00000H, 0, SYSTEM.ADR(tene[0]));
|
||||
RealX(040240000H, 0, SYSTEM.ADR(tene[1])); (* 1 *)
|
||||
RealX(040590000H, 0, SYSTEM.ADR(tene[2])); (* 2 *)
|
||||
RealX(0408F4000H, 0, SYSTEM.ADR(tene[3])); (* 3 *)
|
||||
RealX(040C38800H, 0, SYSTEM.ADR(tene[4])); (* 4 *)
|
||||
RealX(040F86A00H, 0, SYSTEM.ADR(tene[5])); (* 5 *)
|
||||
RealX(0412E8480H, 0, SYSTEM.ADR(tene[6])); (* 6 *)
|
||||
RealX(0416312D0H, 0, SYSTEM.ADR(tene[7])); (* 7 *)
|
||||
RealX(04197D784H, 0, SYSTEM.ADR(tene[8])); (* 8 *)
|
||||
RealX(041CDCD65H, 0, SYSTEM.ADR(tene[9])); (* 9 *)
|
||||
RealX(04202A05FH, 020000000H, SYSTEM.ADR(tene[10])); (* 10 *)
|
||||
RealX(042374876H, 0E8000000H, SYSTEM.ADR(tene[11])); (* 11 *)
|
||||
RealX(0426D1A94H, 0A2000000H, SYSTEM.ADR(tene[12])); (* 12 *)
|
||||
RealX(042A2309CH, 0E5400000H, SYSTEM.ADR(tene[13])); (* 13 *)
|
||||
RealX(042D6BCC4H, 01E900000H, SYSTEM.ADR(tene[14])); (* 14 *)
|
||||
RealX(0430C6BF5H, 026340000H, SYSTEM.ADR(tene[15])); (* 15 *)
|
||||
RealX(04341C379H, 037E08000H, SYSTEM.ADR(tene[16])); (* 16 *)
|
||||
RealX(043763457H, 085D8A000H, SYSTEM.ADR(tene[17])); (* 17 *)
|
||||
RealX(043ABC16DH, 0674EC800H, SYSTEM.ADR(tene[18])); (* 18 *)
|
||||
RealX(043E158E4H, 060913D00H, SYSTEM.ADR(tene[19])); (* 19 *)
|
||||
RealX(04415AF1DH, 078B58C40H, SYSTEM.ADR(tene[20])); (* 20 *)
|
||||
RealX(0444B1AE4H, 0D6E2EF50H, SYSTEM.ADR(tene[21])); (* 21 *)
|
||||
RealX(04480F0CFH, 064DD592H, SYSTEM.ADR(tene[22])); (* 22 *)
|
||||
|
||||
RealX(031FA18H, 02C40C60DH, SYSTEM.ADR(ten[0])); (* -307 *)
|
||||
RealX(04F7CAD2H, 03DE82D7BH, SYSTEM.ADR(ten[1])); (* -284 *)
|
||||
RealX(09BF7D22H, 08322BAF5H, SYSTEM.ADR(ten[2])); (* -261 *)
|
||||
RealX(0E84D669H, 05B193BF8H, SYSTEM.ADR(ten[3])); (* -238 *)
|
||||
RealX(0134B9408H, 0EEFEA839H, SYSTEM.ADR(ten[4])); (* -215 *)
|
||||
RealX(018123FF0H, 06EEA847AH, SYSTEM.ADR(ten[5])); (* -192 *)
|
||||
RealX(01CD82742H, 091C6065BH, SYSTEM.ADR(ten[6])); (* -169 *)
|
||||
RealX(0219FF779H, 0FD329CB9H, SYSTEM.ADR(ten[7])); (* -146 *)
|
||||
RealX(02665275EH, 0D8D8F36CH, SYSTEM.ADR(ten[8])); (* -123 *)
|
||||
RealX(02B2BFF2EH, 0E48E0530H, SYSTEM.ADR(ten[9])); (* -100 *)
|
||||
RealX(02FF286D8H, 0EC190DCH, SYSTEM.ADR(ten[10])); (* -77 *)
|
||||
RealX(034B8851AH, 0B548EA4H, SYSTEM.ADR(ten[11])); (* -54 *)
|
||||
RealX(0398039D6H, 065896880H, SYSTEM.ADR(ten[12])); (* -31 *)
|
||||
RealX(03E45798EH, 0E2308C3AH, SYSTEM.ADR(ten[13])); (* -8 *)
|
||||
RealX(0430C6BF5H, 026340000H, SYSTEM.ADR(ten[14])); (* 15 *)
|
||||
RealX(047D2CED3H, 02A16A1B1H, SYSTEM.ADR(ten[15])); (* 38 *)
|
||||
RealX(04C98E45EH, 01DF3B015H, SYSTEM.ADR(ten[16])); (* 61 *)
|
||||
RealX(0516078E1H, 011C3556DH, SYSTEM.ADR(ten[17])); (* 84 *)
|
||||
RealX(05625CCFEH, 03D35D80EH, SYSTEM.ADR(ten[18])); (* 107 *)
|
||||
RealX(05AECDA62H, 055B2D9EH, SYSTEM.ADR(ten[19])); (* 130 *)
|
||||
RealX(05FB317E5H, 0EF3AB327H, SYSTEM.ADR(ten[20])); (* 153 *)
|
||||
RealX(064794514H, 05230B378H, SYSTEM.ADR(ten[21])); (* 176 *)
|
||||
RealX(06940B8E0H, 0ACAC4EAFH, SYSTEM.ADR(ten[22])); (* 199 *)
|
||||
RealX(06E0621B1H, 0C28AC20CH, SYSTEM.ADR(ten[23])); (* 222 *)
|
||||
RealX(072CD4A7BH, 0EBFA31ABH, SYSTEM.ADR(ten[24])); (* 245 *)
|
||||
RealX(077936214H, 09CBD3226H, SYSTEM.ADR(ten[25])); (* 268 *)
|
||||
RealX(07C59A742H, 0461887F6H, SYSTEM.ADR(ten[26])); (* 291 *)
|
||||
|
||||
eq[0]:= {0, 3, 4, 5, 9, 16, 23, 25, 26, 28, 31};
|
||||
eq[1]:= {2, 5, 6, 8, 9, 10, 11, 12, 13, 14, 15, 17, 18, 19, 20, 21, 23, 24, 25, 27, 28, 29, 30, 31};
|
||||
eq[2]:= {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28};
|
||||
eq[3]:= {0, 1, 2, 3, 5, 6, 7, 8, 9, 11, 14, 15, 16, 17, 18, 19, 20, 22, 27, 28, 29, 30, 31};
|
||||
eq[4]:= {0, 6, 7, 10, 11, 12, 13, 14, 15, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[5]:= {0, 1, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[6]:= {0, 1, 4, 5, 7, 8, 10, 14, 15, 16, 18, 20, 21, 23, 24, 25, 26, 28, 29, 30, 31};
|
||||
eq[7]:= {0, 1, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 18, 19, 23, 24, 26, 28, 29, 30, 31};
|
||||
eq[8]:= {0, 1, 2, 3, 4, 5, 6, 8, 9, 10, 11, 14, 16, 17, 18, 19, 20, 21, 24, 25, 26, 29};
|
||||
eq[9]:= {1, 2, 4, 6, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[10]:= {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30};
|
||||
eq[11]:= {0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 13, 14, 15, 16, 19, 20, 21, 22, 23, 27, 28, 29, 30};
|
||||
eq[12]:= {0, 1, 2, 3, 4, 5, 7, 8, 9, 10, 12, 14, 15, 16, 17, 18, 19, 20, 21, 23, 26, 27, 29, 30, 31};
|
||||
eq[13]:= {0, 1, 2, 3, 4, 5, 6, 7, 9, 10, 11, 13, 14, 15, 16, 17, 18, 20, 21, 23, 24, 27, 28, 29, 30, 31};
|
||||
eq[14]:= {0, 1, 2, 3, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[15]:= {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 11, 12, 13, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 28};
|
||||
eq[16]:= {1, 2, 4, 11, 13, 16, 17, 18, 19, 22, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[17]:= {1, 2, 3, 4, 5, 6, 7, 8, 9, 11, 14, 15, 18, 19, 20, 21, 23, 25, 26, 27, 28, 29, 31};
|
||||
eq[18]:= {0, 2, 4, 5, 6, 8, 9, 11, 12, 13, 14, 16, 17, 19, 20, 22, 23, 24, 26, 27, 28, 29};
|
||||
eq[19]:= {2, 3, 4, 5, 6, 7};
|
||||
|
||||
gr[0]:= {24, 27, 29, 30};
|
||||
gr[1]:= {0, 1, 3, 4, 7};
|
||||
gr[2]:= {29, 30, 31};
|
||||
gr[3]:= {4, 10, 12, 13, 21, 23, 24, 25, 26};
|
||||
gr[4]:= {1, 2, 3, 4, 5, 8, 9, 16, 17};
|
||||
gr[5]:= {2, 3, 4, 18};
|
||||
gr[6]:= {2, 3, 6, 9, 11, 12, 13, 17, 19, 22, 27};
|
||||
gr[7]:= {2};
|
||||
gr[8]:= {7, 12, 13, 15, 22, 23, 27, 28, 30, 31};
|
||||
gr[9]:= {0, 3, 5, 7, 8};
|
||||
gr[10]:= {};
|
||||
gr[11]:= {};
|
||||
gr[12]:= {11, 13, 22, 24, 25, 28};
|
||||
gr[13]:= {22, 25, 26};
|
||||
gr[14]:= {4, 5};
|
||||
gr[15]:= {10, 14, 27, 29, 30, 31};
|
||||
gr[16]:= {0, 3, 5, 6, 7, 8, 9, 10, 12, 14, 15, 20, 21, 23};
|
||||
gr[17]:= {0, 10, 12, 13, 16, 17, 22, 24, 30};
|
||||
gr[18]:= {};
|
||||
gr[19]:= {}
|
||||
END ethReals.
|
||||
305
src/lib/s3/x86/ethReals.Mod
Normal file
305
src/lib/s3/x86/ethReals.Mod
Normal file
|
|
@ -0,0 +1,305 @@
|
|||
(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
|
||||
Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
|
||||
|
||||
MODULE ethReals; (** portable *)
|
||||
|
||||
(** Implementation of the non-portable components of IEEE REAL and
|
||||
LONGREAL manipulation. The routines here are required to do conversion
|
||||
of reals to strings and back.
|
||||
Implemented by Bernd Moesli, Seminar for Applied Mathematics,
|
||||
Swiss Federal Institute of Technology Z…rich.
|
||||
*)
|
||||
|
||||
IMPORT SYSTEM;
|
||||
|
||||
(* Bernd Moesli
|
||||
Seminar for Applied Mathematics
|
||||
Swiss Federal Institute of Technology Zurich
|
||||
Copyright 1993
|
||||
|
||||
Support module for IEEE floating-point numbers
|
||||
|
||||
Please change constant definitions of H, L depending on byte ordering
|
||||
Use bm.TestReals.Do for testing the implementation.
|
||||
|
||||
Expo, ExpoL return the shifted binary exponent (0 <= e < 256 (2048 resp.))
|
||||
SetExpo, SetExpoL set the shifted binary exponent
|
||||
Real, RealL convert hexadecimals to reals
|
||||
Int, IntL convert reals to hexadecimals
|
||||
Ten returns 10^e (e <= 308, 308 < e delivers NaN)
|
||||
|
||||
1993.4.22 IEEE format only, 32-bits LONGINTs only
|
||||
30.8.1993 mh: changed RealX to avoid compiler warnings;
|
||||
7.11.1995 jt: dynamic endianess test
|
||||
22.01.97 pjm: NaN stuff (using quiet NaNs only to avoid traps)
|
||||
05.01.98 prk: NaN with INF support
|
||||
*)
|
||||
|
||||
VAR
|
||||
DefaultFCR*: SET;
|
||||
tene: ARRAY 23 OF LONGREAL; (* e = 0..22: exact values of 10^e *)
|
||||
ten: ARRAY 27 OF LONGREAL;
|
||||
eq, gr: ARRAY 20 OF SET;
|
||||
H, L: INTEGER;
|
||||
|
||||
(** Returns the shifted binary exponent (0 <= e < 256). *)
|
||||
PROCEDURE Expo* (x: REAL): LONGINT;
|
||||
BEGIN
|
||||
RETURN ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256
|
||||
END Expo;
|
||||
|
||||
(** Returns the shifted binary exponent (0 <= e < 2048). *)
|
||||
PROCEDURE ExpoL* (x: LONGREAL): LONGINT;
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, i); RETURN ASH(i, -20) MOD 2048
|
||||
END ExpoL;
|
||||
|
||||
(** Sets the shifted binary exponent. *)
|
||||
PROCEDURE SetExpo* (e: LONGINT; VAR x: REAL);
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x), i);
|
||||
i:= ASH(ASH(ASH(i, -31), 8) + e MOD 256, 23) + i MOD ASH(1, 23);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x), i)
|
||||
END SetExpo;
|
||||
|
||||
(** Sets the shifted binary exponent. *)
|
||||
PROCEDURE SetExpoL* (e: LONGINT; VAR x: LONGREAL);
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, i);
|
||||
i:= ASH(ASH(ASH(i, -31), 11) + e MOD 2048, 20) + i MOD ASH(1, 20);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + H, i)
|
||||
END SetExpoL;
|
||||
|
||||
(** Convert hexadecimal to REAL. *)
|
||||
PROCEDURE Real* (h: LONGINT): REAL;
|
||||
VAR x: REAL;
|
||||
BEGIN SYSTEM.PUT(SYSTEM.ADR(x), h); RETURN x
|
||||
END Real;
|
||||
|
||||
(** Convert hexadecimal to LONGREAL. h and l are the high and low parts.*)
|
||||
PROCEDURE RealL* (h, l: LONGINT): LONGREAL;
|
||||
VAR x: LONGREAL;
|
||||
BEGIN SYSTEM.PUT(SYSTEM.ADR(x) + H, h); SYSTEM.PUT(SYSTEM.ADR(x) + L, l); RETURN x
|
||||
END RealL;
|
||||
|
||||
(** Convert REAL to hexadecimal. *)
|
||||
PROCEDURE Int* (x: REAL): LONGINT;
|
||||
VAR i: LONGINT;
|
||||
BEGIN SYSTEM.PUT(SYSTEM.ADR(i), x); RETURN i
|
||||
END Int;
|
||||
|
||||
(** Convert LONGREAL to hexadecimal. h and l are the high and low parts. *)
|
||||
PROCEDURE IntL* (x: LONGREAL; VAR h, l: LONGINT);
|
||||
BEGIN SYSTEM.GET(SYSTEM.ADR(x) + H, h); SYSTEM.GET(SYSTEM.ADR(x) + L, l)
|
||||
END IntL;
|
||||
|
||||
(** Returns 10^e (e <= 308, 308 < e delivers IEEE-code +INF). *)
|
||||
PROCEDURE Ten* (e: LONGINT): LONGREAL;
|
||||
VAR E: LONGINT; r: LONGREAL;
|
||||
BEGIN
|
||||
IF e < -307 THEN RETURN 0 ELSIF 308 < e THEN RETURN RealL(2146435072, 0) END;
|
||||
INC(e, 307); r:= ten[e DIV 23] * tene[e MOD 23];
|
||||
IF e MOD 32 IN eq[e DIV 32] THEN RETURN r
|
||||
ELSE
|
||||
E:= ExpoL(r); SetExpoL(1023+52, r);
|
||||
IF e MOD 32 IN gr[e DIV 32] THEN r:= r-1 ELSE r:= r+1 END;
|
||||
SetExpoL(E, r); RETURN r
|
||||
END
|
||||
END Ten;
|
||||
|
||||
(** Returns the NaN code (0 <= c < 8399608) or -1 if not NaN/Infinite. *)
|
||||
PROCEDURE NaNCode* (x: REAL): LONGINT;
|
||||
BEGIN
|
||||
IF ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256 = 255 THEN (* Infinite or NaN *)
|
||||
RETURN SYSTEM.VAL(LONGINT, x) MOD 800000H (* lowest 23 bits *)
|
||||
ELSE
|
||||
RETURN -1
|
||||
END
|
||||
END NaNCode;
|
||||
|
||||
(** Returns the NaN code (0 <= h < 1048576, MIN(LONGINT) <= l <= MAX(LONGINT)) or (-1,-1) if not NaN/Infinite. *)
|
||||
PROCEDURE NaNCodeL* (x: LONGREAL; VAR h, l: LONGINT);
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, h); SYSTEM.GET(SYSTEM.ADR(x) + L, l);
|
||||
IF ASH(h, -20) MOD 2048 = 2047 THEN (* Infinite or NaN *)
|
||||
h := h MOD 100000H (* lowest 20 bits *)
|
||||
ELSE
|
||||
h := -1; l := -1
|
||||
END
|
||||
END NaNCodeL;
|
||||
|
||||
(** Returns TRUE iff x is NaN/Infinite. *)
|
||||
PROCEDURE IsNaN* (x: REAL): BOOLEAN;
|
||||
BEGIN
|
||||
RETURN ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256 = 255
|
||||
END IsNaN;
|
||||
|
||||
(** Returns TRUE iff x is NaN/Infinite. *)
|
||||
PROCEDURE IsNaNL* (x: LONGREAL): BOOLEAN;
|
||||
VAR h: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, h);
|
||||
RETURN ASH(h, -20) MOD 2048 = 2047
|
||||
END IsNaNL;
|
||||
|
||||
(** Returns NaN with specified code (0 <= l < 8399608). *)
|
||||
PROCEDURE NaN* (l: LONGINT): REAL;
|
||||
VAR x: REAL;
|
||||
BEGIN
|
||||
SYSTEM.PUT(SYSTEM.ADR(x), (l MOD 800000H) + 7F800000H);
|
||||
RETURN x
|
||||
END NaN;
|
||||
|
||||
(** Returns NaN with specified code (0 <= h < 1048576, MIN(LONGINT) <= l <= MAX(LONGINT)). *)
|
||||
PROCEDURE NaNL* (h, l: LONGINT): LONGREAL;
|
||||
VAR x: LONGREAL;
|
||||
BEGIN
|
||||
h := (h MOD 100000H) + 7FF00000H;
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + H, h);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + L, l);
|
||||
RETURN x
|
||||
END NaNL;
|
||||
(*
|
||||
PROCEDURE fcr(): SET;
|
||||
CODE {SYSTEM.i386, SYSTEM.FPU}
|
||||
PUSH 0
|
||||
FSTCW [ESP]
|
||||
FWAIT
|
||||
POP EAX
|
||||
END fcr;
|
||||
*) (* commented out -- noch *)
|
||||
(** Return state of the floating-point control register. *)
|
||||
(*PROCEDURE FCR*(): SET;
|
||||
BEGIN
|
||||
IF Kernel.copro THEN
|
||||
RETURN fcr()
|
||||
ELSE
|
||||
RETURN DefaultFCR
|
||||
END
|
||||
END FCR;
|
||||
*)
|
||||
(*PROCEDURE setfcr(s: SET);
|
||||
CODE {SYSTEM.i386, SYSTEM.FPU}
|
||||
FLDCW s[EBP]
|
||||
END setfcr;
|
||||
*)
|
||||
(** Set state of floating-point control register. Traps reset this to the default & ENTIER resets the rounding mode. *)
|
||||
(*PROCEDURE SetFCR*(s: SET);
|
||||
BEGIN
|
||||
IF Kernel.copro THEN setfcr(s) END
|
||||
END SetFCR;
|
||||
*)
|
||||
PROCEDURE RealX (h, l: LONGINT; adr: LONGINT);
|
||||
BEGIN SYSTEM.PUT(adr + H, h); SYSTEM.PUT(adr + L, l);
|
||||
END RealX;
|
||||
|
||||
PROCEDURE InitHL;
|
||||
VAR (*i: LONGINT; dmy: INTEGER;*) littleEndian: BOOLEAN;
|
||||
BEGIN
|
||||
(*DefaultFCR := (FCR() - {0,2,3,10,11}) + {0..5,8,9};
|
||||
SetFCR(DefaultFCR);
|
||||
|
||||
dmy := 1; i := SYSTEM.ADR(dmy);
|
||||
SYSTEM.GET(i, littleEndian); (* indirection via i avoids warning on SUN cc -O *)*)
|
||||
littleEndian := TRUE; (* endianness will be set for each architecture -- noch *)
|
||||
IF littleEndian THEN H := 4; L := 0 ELSE H := 0; L := 4 END
|
||||
END InitHL;
|
||||
|
||||
BEGIN InitHL;
|
||||
RealX(03FF00000H, 0, SYSTEM.ADR(tene[0]));
|
||||
RealX(040240000H, 0, SYSTEM.ADR(tene[1])); (* 1 *)
|
||||
RealX(040590000H, 0, SYSTEM.ADR(tene[2])); (* 2 *)
|
||||
RealX(0408F4000H, 0, SYSTEM.ADR(tene[3])); (* 3 *)
|
||||
RealX(040C38800H, 0, SYSTEM.ADR(tene[4])); (* 4 *)
|
||||
RealX(040F86A00H, 0, SYSTEM.ADR(tene[5])); (* 5 *)
|
||||
RealX(0412E8480H, 0, SYSTEM.ADR(tene[6])); (* 6 *)
|
||||
RealX(0416312D0H, 0, SYSTEM.ADR(tene[7])); (* 7 *)
|
||||
RealX(04197D784H, 0, SYSTEM.ADR(tene[8])); (* 8 *)
|
||||
RealX(041CDCD65H, 0, SYSTEM.ADR(tene[9])); (* 9 *)
|
||||
RealX(04202A05FH, 020000000H, SYSTEM.ADR(tene[10])); (* 10 *)
|
||||
RealX(042374876H, 0E8000000H, SYSTEM.ADR(tene[11])); (* 11 *)
|
||||
RealX(0426D1A94H, 0A2000000H, SYSTEM.ADR(tene[12])); (* 12 *)
|
||||
RealX(042A2309CH, 0E5400000H, SYSTEM.ADR(tene[13])); (* 13 *)
|
||||
RealX(042D6BCC4H, 01E900000H, SYSTEM.ADR(tene[14])); (* 14 *)
|
||||
RealX(0430C6BF5H, 026340000H, SYSTEM.ADR(tene[15])); (* 15 *)
|
||||
RealX(04341C379H, 037E08000H, SYSTEM.ADR(tene[16])); (* 16 *)
|
||||
RealX(043763457H, 085D8A000H, SYSTEM.ADR(tene[17])); (* 17 *)
|
||||
RealX(043ABC16DH, 0674EC800H, SYSTEM.ADR(tene[18])); (* 18 *)
|
||||
RealX(043E158E4H, 060913D00H, SYSTEM.ADR(tene[19])); (* 19 *)
|
||||
RealX(04415AF1DH, 078B58C40H, SYSTEM.ADR(tene[20])); (* 20 *)
|
||||
RealX(0444B1AE4H, 0D6E2EF50H, SYSTEM.ADR(tene[21])); (* 21 *)
|
||||
RealX(04480F0CFH, 064DD592H, SYSTEM.ADR(tene[22])); (* 22 *)
|
||||
|
||||
RealX(031FA18H, 02C40C60DH, SYSTEM.ADR(ten[0])); (* -307 *)
|
||||
RealX(04F7CAD2H, 03DE82D7BH, SYSTEM.ADR(ten[1])); (* -284 *)
|
||||
RealX(09BF7D22H, 08322BAF5H, SYSTEM.ADR(ten[2])); (* -261 *)
|
||||
RealX(0E84D669H, 05B193BF8H, SYSTEM.ADR(ten[3])); (* -238 *)
|
||||
RealX(0134B9408H, 0EEFEA839H, SYSTEM.ADR(ten[4])); (* -215 *)
|
||||
RealX(018123FF0H, 06EEA847AH, SYSTEM.ADR(ten[5])); (* -192 *)
|
||||
RealX(01CD82742H, 091C6065BH, SYSTEM.ADR(ten[6])); (* -169 *)
|
||||
RealX(0219FF779H, 0FD329CB9H, SYSTEM.ADR(ten[7])); (* -146 *)
|
||||
RealX(02665275EH, 0D8D8F36CH, SYSTEM.ADR(ten[8])); (* -123 *)
|
||||
RealX(02B2BFF2EH, 0E48E0530H, SYSTEM.ADR(ten[9])); (* -100 *)
|
||||
RealX(02FF286D8H, 0EC190DCH, SYSTEM.ADR(ten[10])); (* -77 *)
|
||||
RealX(034B8851AH, 0B548EA4H, SYSTEM.ADR(ten[11])); (* -54 *)
|
||||
RealX(0398039D6H, 065896880H, SYSTEM.ADR(ten[12])); (* -31 *)
|
||||
RealX(03E45798EH, 0E2308C3AH, SYSTEM.ADR(ten[13])); (* -8 *)
|
||||
RealX(0430C6BF5H, 026340000H, SYSTEM.ADR(ten[14])); (* 15 *)
|
||||
RealX(047D2CED3H, 02A16A1B1H, SYSTEM.ADR(ten[15])); (* 38 *)
|
||||
RealX(04C98E45EH, 01DF3B015H, SYSTEM.ADR(ten[16])); (* 61 *)
|
||||
RealX(0516078E1H, 011C3556DH, SYSTEM.ADR(ten[17])); (* 84 *)
|
||||
RealX(05625CCFEH, 03D35D80EH, SYSTEM.ADR(ten[18])); (* 107 *)
|
||||
RealX(05AECDA62H, 055B2D9EH, SYSTEM.ADR(ten[19])); (* 130 *)
|
||||
RealX(05FB317E5H, 0EF3AB327H, SYSTEM.ADR(ten[20])); (* 153 *)
|
||||
RealX(064794514H, 05230B378H, SYSTEM.ADR(ten[21])); (* 176 *)
|
||||
RealX(06940B8E0H, 0ACAC4EAFH, SYSTEM.ADR(ten[22])); (* 199 *)
|
||||
RealX(06E0621B1H, 0C28AC20CH, SYSTEM.ADR(ten[23])); (* 222 *)
|
||||
RealX(072CD4A7BH, 0EBFA31ABH, SYSTEM.ADR(ten[24])); (* 245 *)
|
||||
RealX(077936214H, 09CBD3226H, SYSTEM.ADR(ten[25])); (* 268 *)
|
||||
RealX(07C59A742H, 0461887F6H, SYSTEM.ADR(ten[26])); (* 291 *)
|
||||
|
||||
eq[0]:= {0, 3, 4, 5, 9, 16, 23, 25, 26, 28, 31};
|
||||
eq[1]:= {2, 5, 6, 8, 9, 10, 11, 12, 13, 14, 15, 17, 18, 19, 20, 21, 23, 24, 25, 27, 28, 29, 30, 31};
|
||||
eq[2]:= {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28};
|
||||
eq[3]:= {0, 1, 2, 3, 5, 6, 7, 8, 9, 11, 14, 15, 16, 17, 18, 19, 20, 22, 27, 28, 29, 30, 31};
|
||||
eq[4]:= {0, 6, 7, 10, 11, 12, 13, 14, 15, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[5]:= {0, 1, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[6]:= {0, 1, 4, 5, 7, 8, 10, 14, 15, 16, 18, 20, 21, 23, 24, 25, 26, 28, 29, 30, 31};
|
||||
eq[7]:= {0, 1, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 18, 19, 23, 24, 26, 28, 29, 30, 31};
|
||||
eq[8]:= {0, 1, 2, 3, 4, 5, 6, 8, 9, 10, 11, 14, 16, 17, 18, 19, 20, 21, 24, 25, 26, 29};
|
||||
eq[9]:= {1, 2, 4, 6, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[10]:= {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30};
|
||||
eq[11]:= {0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 13, 14, 15, 16, 19, 20, 21, 22, 23, 27, 28, 29, 30};
|
||||
eq[12]:= {0, 1, 2, 3, 4, 5, 7, 8, 9, 10, 12, 14, 15, 16, 17, 18, 19, 20, 21, 23, 26, 27, 29, 30, 31};
|
||||
eq[13]:= {0, 1, 2, 3, 4, 5, 6, 7, 9, 10, 11, 13, 14, 15, 16, 17, 18, 20, 21, 23, 24, 27, 28, 29, 30, 31};
|
||||
eq[14]:= {0, 1, 2, 3, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[15]:= {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 11, 12, 13, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 28};
|
||||
eq[16]:= {1, 2, 4, 11, 13, 16, 17, 18, 19, 22, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[17]:= {1, 2, 3, 4, 5, 6, 7, 8, 9, 11, 14, 15, 18, 19, 20, 21, 23, 25, 26, 27, 28, 29, 31};
|
||||
eq[18]:= {0, 2, 4, 5, 6, 8, 9, 11, 12, 13, 14, 16, 17, 19, 20, 22, 23, 24, 26, 27, 28, 29};
|
||||
eq[19]:= {2, 3, 4, 5, 6, 7};
|
||||
|
||||
gr[0]:= {24, 27, 29, 30};
|
||||
gr[1]:= {0, 1, 3, 4, 7};
|
||||
gr[2]:= {29, 30, 31};
|
||||
gr[3]:= {4, 10, 12, 13, 21, 23, 24, 25, 26};
|
||||
gr[4]:= {1, 2, 3, 4, 5, 8, 9, 16, 17};
|
||||
gr[5]:= {2, 3, 4, 18};
|
||||
gr[6]:= {2, 3, 6, 9, 11, 12, 13, 17, 19, 22, 27};
|
||||
gr[7]:= {2};
|
||||
gr[8]:= {7, 12, 13, 15, 22, 23, 27, 28, 30, 31};
|
||||
gr[9]:= {0, 3, 5, 7, 8};
|
||||
gr[10]:= {};
|
||||
gr[11]:= {};
|
||||
gr[12]:= {11, 13, 22, 24, 25, 28};
|
||||
gr[13]:= {22, 25, 26};
|
||||
gr[14]:= {4, 5};
|
||||
gr[15]:= {10, 14, 27, 29, 30, 31};
|
||||
gr[16]:= {0, 3, 5, 6, 7, 8, 9, 10, 12, 14, 15, 20, 21, 23};
|
||||
gr[17]:= {0, 10, 12, 13, 16, 17, 22, 24, 30};
|
||||
gr[18]:= {};
|
||||
gr[19]:= {}
|
||||
END ethReals.
|
||||
305
src/lib/s3/x86_64/ethReals.Mod
Normal file
305
src/lib/s3/x86_64/ethReals.Mod
Normal file
|
|
@ -0,0 +1,305 @@
|
|||
(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
|
||||
Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
|
||||
|
||||
MODULE ethReals; (** portable *)
|
||||
|
||||
(** Implementation of the non-portable components of IEEE REAL and
|
||||
LONGREAL manipulation. The routines here are required to do conversion
|
||||
of reals to strings and back.
|
||||
Implemented by Bernd Moesli, Seminar for Applied Mathematics,
|
||||
Swiss Federal Institute of Technology Z…rich.
|
||||
*)
|
||||
|
||||
IMPORT SYSTEM;
|
||||
|
||||
(* Bernd Moesli
|
||||
Seminar for Applied Mathematics
|
||||
Swiss Federal Institute of Technology Zurich
|
||||
Copyright 1993
|
||||
|
||||
Support module for IEEE floating-point numbers
|
||||
|
||||
Please change constant definitions of H, L depending on byte ordering
|
||||
Use bm.TestReals.Do for testing the implementation.
|
||||
|
||||
Expo, ExpoL return the shifted binary exponent (0 <= e < 256 (2048 resp.))
|
||||
SetExpo, SetExpoL set the shifted binary exponent
|
||||
Real, RealL convert hexadecimals to reals
|
||||
Int, IntL convert reals to hexadecimals
|
||||
Ten returns 10^e (e <= 308, 308 < e delivers NaN)
|
||||
|
||||
1993.4.22 IEEE format only, 32-bits LONGINTs only
|
||||
30.8.1993 mh: changed RealX to avoid compiler warnings;
|
||||
7.11.1995 jt: dynamic endianess test
|
||||
22.01.97 pjm: NaN stuff (using quiet NaNs only to avoid traps)
|
||||
05.01.98 prk: NaN with INF support
|
||||
*)
|
||||
|
||||
VAR
|
||||
DefaultFCR*: SET;
|
||||
tene: ARRAY 23 OF LONGREAL; (* e = 0..22: exact values of 10^e *)
|
||||
ten: ARRAY 27 OF LONGREAL;
|
||||
eq, gr: ARRAY 20 OF SET;
|
||||
H, L: INTEGER;
|
||||
|
||||
(** Returns the shifted binary exponent (0 <= e < 256). *)
|
||||
PROCEDURE Expo* (x: REAL): LONGINT;
|
||||
BEGIN
|
||||
RETURN ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256
|
||||
END Expo;
|
||||
|
||||
(** Returns the shifted binary exponent (0 <= e < 2048). *)
|
||||
PROCEDURE ExpoL* (x: LONGREAL): LONGINT;
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, i); RETURN ASH(i, -20) MOD 2048
|
||||
END ExpoL;
|
||||
|
||||
(** Sets the shifted binary exponent. *)
|
||||
PROCEDURE SetExpo* (e: LONGINT; VAR x: REAL);
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x), i);
|
||||
i:= ASH(ASH(ASH(i, -31), 8) + e MOD 256, 23) + i MOD ASH(1, 23);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x), i)
|
||||
END SetExpo;
|
||||
|
||||
(** Sets the shifted binary exponent. *)
|
||||
PROCEDURE SetExpoL* (e: LONGINT; VAR x: LONGREAL);
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, i);
|
||||
i:= ASH(ASH(ASH(i, -31), 11) + e MOD 2048, 20) + i MOD ASH(1, 20);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + H, i)
|
||||
END SetExpoL;
|
||||
|
||||
(** Convert hexadecimal to REAL. *)
|
||||
PROCEDURE Real* (h: LONGINT): REAL;
|
||||
VAR x: REAL;
|
||||
BEGIN SYSTEM.PUT(SYSTEM.ADR(x), h); RETURN x
|
||||
END Real;
|
||||
|
||||
(** Convert hexadecimal to LONGREAL. h and l are the high and low parts.*)
|
||||
PROCEDURE RealL* (h, l: LONGINT): LONGREAL;
|
||||
VAR x: LONGREAL;
|
||||
BEGIN SYSTEM.PUT(SYSTEM.ADR(x) + H, h); SYSTEM.PUT(SYSTEM.ADR(x) + L, l); RETURN x
|
||||
END RealL;
|
||||
|
||||
(** Convert REAL to hexadecimal. *)
|
||||
PROCEDURE Int* (x: REAL): LONGINT;
|
||||
VAR i: LONGINT;
|
||||
BEGIN SYSTEM.PUT(SYSTEM.ADR(i), x); RETURN i
|
||||
END Int;
|
||||
|
||||
(** Convert LONGREAL to hexadecimal. h and l are the high and low parts. *)
|
||||
PROCEDURE IntL* (x: LONGREAL; VAR h, l: LONGINT);
|
||||
BEGIN SYSTEM.GET(SYSTEM.ADR(x) + H, h); SYSTEM.GET(SYSTEM.ADR(x) + L, l)
|
||||
END IntL;
|
||||
|
||||
(** Returns 10^e (e <= 308, 308 < e delivers IEEE-code +INF). *)
|
||||
PROCEDURE Ten* (e: LONGINT): LONGREAL;
|
||||
VAR E: LONGINT; r: LONGREAL;
|
||||
BEGIN
|
||||
IF e < -307 THEN RETURN 0 ELSIF 308 < e THEN RETURN RealL(2146435072, 0) END;
|
||||
INC(e, 307); r:= ten[e DIV 23] * tene[e MOD 23];
|
||||
IF e MOD 32 IN eq[e DIV 32] THEN RETURN r
|
||||
ELSE
|
||||
E:= ExpoL(r); SetExpoL(1023+52, r);
|
||||
IF e MOD 32 IN gr[e DIV 32] THEN r:= r-1 ELSE r:= r+1 END;
|
||||
SetExpoL(E, r); RETURN r
|
||||
END
|
||||
END Ten;
|
||||
|
||||
(** Returns the NaN code (0 <= c < 8399608) or -1 if not NaN/Infinite. *)
|
||||
PROCEDURE NaNCode* (x: REAL): LONGINT;
|
||||
BEGIN
|
||||
IF ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256 = 255 THEN (* Infinite or NaN *)
|
||||
RETURN SYSTEM.VAL(LONGINT, x) MOD 800000H (* lowest 23 bits *)
|
||||
ELSE
|
||||
RETURN -1
|
||||
END
|
||||
END NaNCode;
|
||||
|
||||
(** Returns the NaN code (0 <= h < 1048576, MIN(LONGINT) <= l <= MAX(LONGINT)) or (-1,-1) if not NaN/Infinite. *)
|
||||
PROCEDURE NaNCodeL* (x: LONGREAL; VAR h, l: LONGINT);
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, h); SYSTEM.GET(SYSTEM.ADR(x) + L, l);
|
||||
IF ASH(h, -20) MOD 2048 = 2047 THEN (* Infinite or NaN *)
|
||||
h := h MOD 100000H (* lowest 20 bits *)
|
||||
ELSE
|
||||
h := -1; l := -1
|
||||
END
|
||||
END NaNCodeL;
|
||||
|
||||
(** Returns TRUE iff x is NaN/Infinite. *)
|
||||
PROCEDURE IsNaN* (x: REAL): BOOLEAN;
|
||||
BEGIN
|
||||
RETURN ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256 = 255
|
||||
END IsNaN;
|
||||
|
||||
(** Returns TRUE iff x is NaN/Infinite. *)
|
||||
PROCEDURE IsNaNL* (x: LONGREAL): BOOLEAN;
|
||||
VAR h: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, h);
|
||||
RETURN ASH(h, -20) MOD 2048 = 2047
|
||||
END IsNaNL;
|
||||
|
||||
(** Returns NaN with specified code (0 <= l < 8399608). *)
|
||||
PROCEDURE NaN* (l: LONGINT): REAL;
|
||||
VAR x: REAL;
|
||||
BEGIN
|
||||
SYSTEM.PUT(SYSTEM.ADR(x), (l MOD 800000H) + 7F800000H);
|
||||
RETURN x
|
||||
END NaN;
|
||||
|
||||
(** Returns NaN with specified code (0 <= h < 1048576, MIN(LONGINT) <= l <= MAX(LONGINT)). *)
|
||||
PROCEDURE NaNL* (h, l: LONGINT): LONGREAL;
|
||||
VAR x: LONGREAL;
|
||||
BEGIN
|
||||
h := (h MOD 100000H) + 7FF00000H;
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + H, h);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + L, l);
|
||||
RETURN x
|
||||
END NaNL;
|
||||
(*
|
||||
PROCEDURE fcr(): SET;
|
||||
CODE {SYSTEM.i386, SYSTEM.FPU}
|
||||
PUSH 0
|
||||
FSTCW [ESP]
|
||||
FWAIT
|
||||
POP EAX
|
||||
END fcr;
|
||||
*) (* commented out -- noch *)
|
||||
(** Return state of the floating-point control register. *)
|
||||
(*PROCEDURE FCR*(): SET;
|
||||
BEGIN
|
||||
IF Kernel.copro THEN
|
||||
RETURN fcr()
|
||||
ELSE
|
||||
RETURN DefaultFCR
|
||||
END
|
||||
END FCR;
|
||||
*)
|
||||
(*PROCEDURE setfcr(s: SET);
|
||||
CODE {SYSTEM.i386, SYSTEM.FPU}
|
||||
FLDCW s[EBP]
|
||||
END setfcr;
|
||||
*)
|
||||
(** Set state of floating-point control register. Traps reset this to the default & ENTIER resets the rounding mode. *)
|
||||
(*PROCEDURE SetFCR*(s: SET);
|
||||
BEGIN
|
||||
IF Kernel.copro THEN setfcr(s) END
|
||||
END SetFCR;
|
||||
*)
|
||||
PROCEDURE RealX (h, l: LONGINT; adr: LONGINT);
|
||||
BEGIN SYSTEM.PUT(adr + H, h); SYSTEM.PUT(adr + L, l);
|
||||
END RealX;
|
||||
|
||||
PROCEDURE InitHL;
|
||||
VAR (*i: LONGINT; dmy: INTEGER;*) littleEndian: BOOLEAN;
|
||||
BEGIN
|
||||
(*DefaultFCR := (FCR() - {0,2,3,10,11}) + {0..5,8,9};
|
||||
SetFCR(DefaultFCR);
|
||||
|
||||
dmy := 1; i := SYSTEM.ADR(dmy);
|
||||
SYSTEM.GET(i, littleEndian); (* indirection via i avoids warning on SUN cc -O *)*)
|
||||
littleEndian := TRUE; (* endianness will be set for each architecture -- noch *)
|
||||
IF littleEndian THEN H := 4; L := 0 ELSE H := 0; L := 4 END
|
||||
END InitHL;
|
||||
|
||||
BEGIN InitHL;
|
||||
RealX(03FF00000H, 0, SYSTEM.ADR(tene[0]));
|
||||
RealX(040240000H, 0, SYSTEM.ADR(tene[1])); (* 1 *)
|
||||
RealX(040590000H, 0, SYSTEM.ADR(tene[2])); (* 2 *)
|
||||
RealX(0408F4000H, 0, SYSTEM.ADR(tene[3])); (* 3 *)
|
||||
RealX(040C38800H, 0, SYSTEM.ADR(tene[4])); (* 4 *)
|
||||
RealX(040F86A00H, 0, SYSTEM.ADR(tene[5])); (* 5 *)
|
||||
RealX(0412E8480H, 0, SYSTEM.ADR(tene[6])); (* 6 *)
|
||||
RealX(0416312D0H, 0, SYSTEM.ADR(tene[7])); (* 7 *)
|
||||
RealX(04197D784H, 0, SYSTEM.ADR(tene[8])); (* 8 *)
|
||||
RealX(041CDCD65H, 0, SYSTEM.ADR(tene[9])); (* 9 *)
|
||||
RealX(04202A05FH, 020000000H, SYSTEM.ADR(tene[10])); (* 10 *)
|
||||
RealX(042374876H, 0E8000000H, SYSTEM.ADR(tene[11])); (* 11 *)
|
||||
RealX(0426D1A94H, 0A2000000H, SYSTEM.ADR(tene[12])); (* 12 *)
|
||||
RealX(042A2309CH, 0E5400000H, SYSTEM.ADR(tene[13])); (* 13 *)
|
||||
RealX(042D6BCC4H, 01E900000H, SYSTEM.ADR(tene[14])); (* 14 *)
|
||||
RealX(0430C6BF5H, 026340000H, SYSTEM.ADR(tene[15])); (* 15 *)
|
||||
RealX(04341C379H, 037E08000H, SYSTEM.ADR(tene[16])); (* 16 *)
|
||||
RealX(043763457H, 085D8A000H, SYSTEM.ADR(tene[17])); (* 17 *)
|
||||
RealX(043ABC16DH, 0674EC800H, SYSTEM.ADR(tene[18])); (* 18 *)
|
||||
RealX(043E158E4H, 060913D00H, SYSTEM.ADR(tene[19])); (* 19 *)
|
||||
RealX(04415AF1DH, 078B58C40H, SYSTEM.ADR(tene[20])); (* 20 *)
|
||||
RealX(0444B1AE4H, 0D6E2EF50H, SYSTEM.ADR(tene[21])); (* 21 *)
|
||||
RealX(04480F0CFH, 064DD592H, SYSTEM.ADR(tene[22])); (* 22 *)
|
||||
|
||||
RealX(031FA18H, 02C40C60DH, SYSTEM.ADR(ten[0])); (* -307 *)
|
||||
RealX(04F7CAD2H, 03DE82D7BH, SYSTEM.ADR(ten[1])); (* -284 *)
|
||||
RealX(09BF7D22H, 08322BAF5H, SYSTEM.ADR(ten[2])); (* -261 *)
|
||||
RealX(0E84D669H, 05B193BF8H, SYSTEM.ADR(ten[3])); (* -238 *)
|
||||
RealX(0134B9408H, 0EEFEA839H, SYSTEM.ADR(ten[4])); (* -215 *)
|
||||
RealX(018123FF0H, 06EEA847AH, SYSTEM.ADR(ten[5])); (* -192 *)
|
||||
RealX(01CD82742H, 091C6065BH, SYSTEM.ADR(ten[6])); (* -169 *)
|
||||
RealX(0219FF779H, 0FD329CB9H, SYSTEM.ADR(ten[7])); (* -146 *)
|
||||
RealX(02665275EH, 0D8D8F36CH, SYSTEM.ADR(ten[8])); (* -123 *)
|
||||
RealX(02B2BFF2EH, 0E48E0530H, SYSTEM.ADR(ten[9])); (* -100 *)
|
||||
RealX(02FF286D8H, 0EC190DCH, SYSTEM.ADR(ten[10])); (* -77 *)
|
||||
RealX(034B8851AH, 0B548EA4H, SYSTEM.ADR(ten[11])); (* -54 *)
|
||||
RealX(0398039D6H, 065896880H, SYSTEM.ADR(ten[12])); (* -31 *)
|
||||
RealX(03E45798EH, 0E2308C3AH, SYSTEM.ADR(ten[13])); (* -8 *)
|
||||
RealX(0430C6BF5H, 026340000H, SYSTEM.ADR(ten[14])); (* 15 *)
|
||||
RealX(047D2CED3H, 02A16A1B1H, SYSTEM.ADR(ten[15])); (* 38 *)
|
||||
RealX(04C98E45EH, 01DF3B015H, SYSTEM.ADR(ten[16])); (* 61 *)
|
||||
RealX(0516078E1H, 011C3556DH, SYSTEM.ADR(ten[17])); (* 84 *)
|
||||
RealX(05625CCFEH, 03D35D80EH, SYSTEM.ADR(ten[18])); (* 107 *)
|
||||
RealX(05AECDA62H, 055B2D9EH, SYSTEM.ADR(ten[19])); (* 130 *)
|
||||
RealX(05FB317E5H, 0EF3AB327H, SYSTEM.ADR(ten[20])); (* 153 *)
|
||||
RealX(064794514H, 05230B378H, SYSTEM.ADR(ten[21])); (* 176 *)
|
||||
RealX(06940B8E0H, 0ACAC4EAFH, SYSTEM.ADR(ten[22])); (* 199 *)
|
||||
RealX(06E0621B1H, 0C28AC20CH, SYSTEM.ADR(ten[23])); (* 222 *)
|
||||
RealX(072CD4A7BH, 0EBFA31ABH, SYSTEM.ADR(ten[24])); (* 245 *)
|
||||
RealX(077936214H, 09CBD3226H, SYSTEM.ADR(ten[25])); (* 268 *)
|
||||
RealX(07C59A742H, 0461887F6H, SYSTEM.ADR(ten[26])); (* 291 *)
|
||||
|
||||
eq[0]:= {0, 3, 4, 5, 9, 16, 23, 25, 26, 28, 31};
|
||||
eq[1]:= {2, 5, 6, 8, 9, 10, 11, 12, 13, 14, 15, 17, 18, 19, 20, 21, 23, 24, 25, 27, 28, 29, 30, 31};
|
||||
eq[2]:= {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28};
|
||||
eq[3]:= {0, 1, 2, 3, 5, 6, 7, 8, 9, 11, 14, 15, 16, 17, 18, 19, 20, 22, 27, 28, 29, 30, 31};
|
||||
eq[4]:= {0, 6, 7, 10, 11, 12, 13, 14, 15, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[5]:= {0, 1, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[6]:= {0, 1, 4, 5, 7, 8, 10, 14, 15, 16, 18, 20, 21, 23, 24, 25, 26, 28, 29, 30, 31};
|
||||
eq[7]:= {0, 1, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 18, 19, 23, 24, 26, 28, 29, 30, 31};
|
||||
eq[8]:= {0, 1, 2, 3, 4, 5, 6, 8, 9, 10, 11, 14, 16, 17, 18, 19, 20, 21, 24, 25, 26, 29};
|
||||
eq[9]:= {1, 2, 4, 6, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[10]:= {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30};
|
||||
eq[11]:= {0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 13, 14, 15, 16, 19, 20, 21, 22, 23, 27, 28, 29, 30};
|
||||
eq[12]:= {0, 1, 2, 3, 4, 5, 7, 8, 9, 10, 12, 14, 15, 16, 17, 18, 19, 20, 21, 23, 26, 27, 29, 30, 31};
|
||||
eq[13]:= {0, 1, 2, 3, 4, 5, 6, 7, 9, 10, 11, 13, 14, 15, 16, 17, 18, 20, 21, 23, 24, 27, 28, 29, 30, 31};
|
||||
eq[14]:= {0, 1, 2, 3, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[15]:= {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 11, 12, 13, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 28};
|
||||
eq[16]:= {1, 2, 4, 11, 13, 16, 17, 18, 19, 22, 24, 25, 26, 27, 28, 29, 30, 31};
|
||||
eq[17]:= {1, 2, 3, 4, 5, 6, 7, 8, 9, 11, 14, 15, 18, 19, 20, 21, 23, 25, 26, 27, 28, 29, 31};
|
||||
eq[18]:= {0, 2, 4, 5, 6, 8, 9, 11, 12, 13, 14, 16, 17, 19, 20, 22, 23, 24, 26, 27, 28, 29};
|
||||
eq[19]:= {2, 3, 4, 5, 6, 7};
|
||||
|
||||
gr[0]:= {24, 27, 29, 30};
|
||||
gr[1]:= {0, 1, 3, 4, 7};
|
||||
gr[2]:= {29, 30, 31};
|
||||
gr[3]:= {4, 10, 12, 13, 21, 23, 24, 25, 26};
|
||||
gr[4]:= {1, 2, 3, 4, 5, 8, 9, 16, 17};
|
||||
gr[5]:= {2, 3, 4, 18};
|
||||
gr[6]:= {2, 3, 6, 9, 11, 12, 13, 17, 19, 22, 27};
|
||||
gr[7]:= {2};
|
||||
gr[8]:= {7, 12, 13, 15, 22, 23, 27, 28, 30, 31};
|
||||
gr[9]:= {0, 3, 5, 7, 8};
|
||||
gr[10]:= {};
|
||||
gr[11]:= {};
|
||||
gr[12]:= {11, 13, 22, 24, 25, 28};
|
||||
gr[13]:= {22, 25, 26};
|
||||
gr[14]:= {4, 5};
|
||||
gr[15]:= {10, 14, 27, 29, 30, 31};
|
||||
gr[16]:= {0, 3, 5, 6, 7, 8, 9, 10, 12, 14, 15, 20, 21, 23};
|
||||
gr[17]:= {0, 10, 12, 13, 16, 17, 22, 24, 30};
|
||||
gr[18]:= {};
|
||||
gr[19]:= {}
|
||||
END ethReals.
|
||||
|
|
@ -1,109 +0,0 @@
|
|||
MODULE Reals;
|
||||
(* JT, 5.2.90 / RC 9.12.91 conversion between reals and strings for HP-700, MB 9.12.91, JT for Ofront, 16.3. 95*)
|
||||
|
||||
IMPORT S := SYSTEM;
|
||||
|
||||
|
||||
PROCEDURE -ecvt (x: LONGREAL; ndigit, decpt, sign: LONGINT): LONGINT
|
||||
"(LONGINT)ecvt (x, ndigit, decpt, sign)";
|
||||
|
||||
PROCEDURE Ten*(e: INTEGER): REAL;
|
||||
VAR r, power: LONGREAL;
|
||||
BEGIN r := 1.0;
|
||||
power := 10.0;
|
||||
WHILE e > 0 DO
|
||||
IF ODD(e) THEN r := r * power END ;
|
||||
power := power * power; e := e DIV 2
|
||||
END ;
|
||||
RETURN SHORT(r)
|
||||
END Ten;
|
||||
|
||||
PROCEDURE TenL*(e: INTEGER): LONGREAL;
|
||||
VAR r, power: LONGREAL;
|
||||
BEGIN r := 1.0;
|
||||
power := 10.0;
|
||||
LOOP
|
||||
IF ODD(e) THEN r := r * power END ;
|
||||
e := e DIV 2;
|
||||
IF e <= 0 THEN RETURN r END ;
|
||||
power := power * power
|
||||
END
|
||||
END TenL;
|
||||
|
||||
PROCEDURE Expo*(x: REAL): INTEGER;
|
||||
BEGIN
|
||||
RETURN SHORT(ASH(S.VAL(LONGINT, x), -23) MOD 256)
|
||||
END Expo;
|
||||
|
||||
PROCEDURE ExpoL*(x: LONGREAL): INTEGER;
|
||||
VAR h: LONGINT;
|
||||
BEGIN
|
||||
S.GET(S.ADR(x)+4, h);
|
||||
RETURN SHORT(ASH(h, -20) MOD 2048)
|
||||
END ExpoL;
|
||||
|
||||
PROCEDURE SetExpo*(e: INTEGER; VAR x: REAL);
|
||||
CONST expo = {1..8};
|
||||
BEGIN
|
||||
x := S.VAL(REAL, S.VAL(SET, x) - expo + S.VAL(SET, ASH(LONG(e), 23)))
|
||||
END SetExpo;
|
||||
|
||||
PROCEDURE SetExpoL*(e: INTEGER; VAR x: LONGREAL);
|
||||
CONST expo = {1..11};
|
||||
VAR h: SET;
|
||||
BEGIN
|
||||
S.GET(S.ADR(x)+4, h);
|
||||
h := h - expo + S.VAL(SET, ASH(LONG(e), 20));
|
||||
S.PUT(S.ADR(x)+4, h)
|
||||
END SetExpoL;
|
||||
|
||||
PROCEDURE Convert*(x: REAL; n: INTEGER; VAR d: ARRAY OF CHAR);
|
||||
VAR i, k: LONGINT;
|
||||
BEGIN
|
||||
i := ENTIER(x); k := 0;
|
||||
WHILE k < n DO
|
||||
d[k] := CHR(i MOD 10 + 48); i := i DIV 10; INC(k)
|
||||
END
|
||||
END Convert;
|
||||
(*
|
||||
PROCEDURE ConvertL*(x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR);
|
||||
VAR i, k: LONGINT;
|
||||
BEGIN
|
||||
i := ENTIER(x); k := 0;
|
||||
WHILE k < n DO
|
||||
d[k] := CHR(i MOD 10 + 48); i := i DIV 10; INC(k)
|
||||
END
|
||||
END ConvertL;
|
||||
*)
|
||||
PROCEDURE ConvertL*(x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR);
|
||||
VAR decpt, sign, i: LONGINT; buf: LONGINT;
|
||||
BEGIN
|
||||
(*x := x - 0.5; already rounded in ecvt*)
|
||||
buf := ecvt(x, n+2, S.ADR(decpt), S.ADR(sign));
|
||||
i := 0;
|
||||
WHILE i < decpt DO S.GET(buf + i, d[n - i -1]); INC(i) END ; (* showdef was crashing here on oocLowLReal.sym because of ecvt *)
|
||||
i := n - i - 1;
|
||||
WHILE i >= 0 DO d[i] := "0"; DEC(i) END ;
|
||||
END ConvertL;
|
||||
|
||||
PROCEDURE Unpack(VAR b, d: ARRAY OF S.BYTE);
|
||||
VAR i, k: SHORTINT; len: LONGINT;
|
||||
BEGIN i := 0; len := LEN(b);
|
||||
WHILE i < len DO
|
||||
k := SHORT(ORD(S.VAL(CHAR, b[i])) DIV 16);
|
||||
IF k > 9 THEN d[i*2] := k + 55 ELSE d[i*2] := k + 48 END ;
|
||||
k := SHORT(ORD(S.VAL(CHAR, b[i])) MOD 16);
|
||||
IF k > 9 THEN d[i*2+1] := k + 55 ELSE d[i*2+1] := k + 48 END ;
|
||||
INC(i)
|
||||
END
|
||||
END Unpack;
|
||||
|
||||
PROCEDURE ConvertH* (y: REAL; VAR d: ARRAY OF CHAR);
|
||||
BEGIN Unpack(y, d)
|
||||
END ConvertH;
|
||||
|
||||
PROCEDURE ConvertHL* (x: LONGREAL; VAR d: ARRAY OF CHAR);
|
||||
BEGIN Unpack(x, d)
|
||||
END ConvertHL;
|
||||
|
||||
END Reals.
|
||||
|
|
@ -1,109 +0,0 @@
|
|||
MODULE Reals;
|
||||
(* JT, 5.2.90 / RC 9.12.91 conversion between reals and strings for HP-700, MB 9.12.91, JT for Ofront, 16.3. 95*)
|
||||
|
||||
IMPORT S := SYSTEM;
|
||||
|
||||
|
||||
PROCEDURE -ecvt (x: LONGREAL; ndigit, decpt, sign: LONGINT): LONGINT
|
||||
"(LONGINT)ecvt (x, ndigit, decpt, sign)";
|
||||
|
||||
PROCEDURE Ten*(e: INTEGER): REAL;
|
||||
VAR r, power: LONGREAL;
|
||||
BEGIN r := 1.0;
|
||||
power := 10.0;
|
||||
WHILE e > 0 DO
|
||||
IF ODD(e) THEN r := r * power END ;
|
||||
power := power * power; e := e DIV 2
|
||||
END ;
|
||||
RETURN SHORT(r)
|
||||
END Ten;
|
||||
|
||||
PROCEDURE TenL*(e: INTEGER): LONGREAL;
|
||||
VAR r, power: LONGREAL;
|
||||
BEGIN r := 1.0;
|
||||
power := 10.0;
|
||||
LOOP
|
||||
IF ODD(e) THEN r := r * power END ;
|
||||
e := e DIV 2;
|
||||
IF e <= 0 THEN RETURN r END ;
|
||||
power := power * power
|
||||
END
|
||||
END TenL;
|
||||
|
||||
PROCEDURE Expo*(x: REAL): INTEGER;
|
||||
BEGIN
|
||||
RETURN SHORT(ASH(S.VAL(LONGINT, x), -23) MOD 256)
|
||||
END Expo;
|
||||
|
||||
PROCEDURE ExpoL*(x: LONGREAL): INTEGER;
|
||||
VAR h: LONGINT;
|
||||
BEGIN
|
||||
S.GET(S.ADR(x)+4, h);
|
||||
RETURN SHORT(ASH(h, -20) MOD 2048)
|
||||
END ExpoL;
|
||||
|
||||
PROCEDURE SetExpo*(e: INTEGER; VAR x: REAL);
|
||||
CONST expo = {1..8};
|
||||
BEGIN
|
||||
x := S.VAL(REAL, S.VAL(SET, x) - expo + S.VAL(SET, ASH(LONG(e), 23)))
|
||||
END SetExpo;
|
||||
|
||||
PROCEDURE SetExpoL*(e: INTEGER; VAR x: LONGREAL);
|
||||
CONST expo = {1..11};
|
||||
VAR h: SET;
|
||||
BEGIN
|
||||
S.GET(S.ADR(x)+4, h);
|
||||
h := h - expo + S.VAL(SET, ASH(LONG(e), 20));
|
||||
S.PUT(S.ADR(x)+4, h)
|
||||
END SetExpoL;
|
||||
|
||||
PROCEDURE Convert*(x: REAL; n: INTEGER; VAR d: ARRAY OF CHAR);
|
||||
VAR i, k: LONGINT;
|
||||
BEGIN
|
||||
i := ENTIER(x); k := 0;
|
||||
WHILE k < n DO
|
||||
d[k] := CHR(i MOD 10 + 48); i := i DIV 10; INC(k)
|
||||
END
|
||||
END Convert;
|
||||
(*
|
||||
PROCEDURE ConvertL*(x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR);
|
||||
VAR i, k: LONGINT;
|
||||
BEGIN
|
||||
i := ENTIER(x); k := 0;
|
||||
WHILE k < n DO
|
||||
d[k] := CHR(i MOD 10 + 48); i := i DIV 10; INC(k)
|
||||
END
|
||||
END ConvertL;
|
||||
*)
|
||||
PROCEDURE ConvertL*(x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR);
|
||||
VAR decpt, sign, i: LONGINT; buf: LONGINT;
|
||||
BEGIN
|
||||
(*x := x - 0.5; already rounded in ecvt*)
|
||||
buf := ecvt(x, n+2, S.ADR(decpt), S.ADR(sign));
|
||||
i := 0;
|
||||
WHILE i < decpt DO S.GET(buf + i, d[n - i -1]); INC(i) END ; (* showdef was crashing here on oocLowLReal.sym because of ecvt *)
|
||||
i := n - i - 1;
|
||||
WHILE i >= 0 DO d[i] := "0"; DEC(i) END ;
|
||||
END ConvertL;
|
||||
|
||||
PROCEDURE Unpack(VAR b, d: ARRAY OF S.BYTE);
|
||||
VAR i, k: SHORTINT; len: LONGINT;
|
||||
BEGIN i := 0; len := LEN(b);
|
||||
WHILE i < len DO
|
||||
k := SHORT(ORD(S.VAL(CHAR, b[i])) DIV 16);
|
||||
IF k > 9 THEN d[i*2] := k + 55 ELSE d[i*2] := k + 48 END ;
|
||||
k := SHORT(ORD(S.VAL(CHAR, b[i])) MOD 16);
|
||||
IF k > 9 THEN d[i*2+1] := k + 55 ELSE d[i*2+1] := k + 48 END ;
|
||||
INC(i)
|
||||
END
|
||||
END Unpack;
|
||||
|
||||
PROCEDURE ConvertH* (y: REAL; VAR d: ARRAY OF CHAR);
|
||||
BEGIN Unpack(y, d)
|
||||
END ConvertH;
|
||||
|
||||
PROCEDURE ConvertHL* (x: LONGREAL; VAR d: ARRAY OF CHAR);
|
||||
BEGIN Unpack(x, d)
|
||||
END ConvertHL;
|
||||
|
||||
END Reals.
|
||||
Loading…
Add table
Add a link
Reference in a new issue