From 5d1eed31e43fc3a96f72d33db14967f8af7c79e7 Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Thu, 12 Feb 2015 20:21:39 +0400 Subject: [PATCH] ported ethDates, ethReals, ethStrings. -- noch Former-commit-id: 63dc2c5c313f4bee970e94131a1f6ab0bb64c69b --- makefile | 5 +- makefile.darwin.clang.x86_64 | 5 +- makefile.freebsd.clang.x86_64 | 5 +- makefile.linux.clang.powerpc | 5 +- makefile.linux.clang.x86_64 | 5 +- makefile.linux.gcc.armv6j_hardfp | 5 +- makefile.linux.gcc.powerpc | 5 +- makefile.linux.gcc.x86 | 5 +- makefile.linux.gcc.x86_64 | 5 +- src/lib/s3/armv6j_hardfp/ethReals.Mod | 305 ++++++++ src/lib/s3/ethDates.Mod | 213 ++++++ src/lib/s3/ethStrings.Mod | 955 ++++++++++++++++++++++++++ src/lib/s3/powerpc/ethReals.Mod | 305 ++++++++ src/lib/s3/x86/ethReals.Mod | 305 ++++++++ src/lib/s3/x86_64/ethReals.Mod | 305 ++++++++ src/lib/v4/armv6j/Reals.Mod | 109 --- src/lib/v4/armv7a_hardfp/Reals.Mod | 109 --- 17 files changed, 2424 insertions(+), 227 deletions(-) create mode 100644 src/lib/s3/armv6j_hardfp/ethReals.Mod create mode 100644 src/lib/s3/ethDates.Mod create mode 100644 src/lib/s3/ethStrings.Mod create mode 100644 src/lib/s3/powerpc/ethReals.Mod create mode 100644 src/lib/s3/x86/ethReals.Mod create mode 100644 src/lib/s3/x86_64/ethReals.Mod delete mode 100644 src/lib/v4/armv6j/Reals.Mod delete mode 100644 src/lib/v4/armv7a_hardfp/Reals.Mod diff --git a/makefile b/makefile index 68c343ba..55c1bd24 100644 --- a/makefile +++ b/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 diff --git a/makefile.darwin.clang.x86_64 b/makefile.darwin.clang.x86_64 index b90d3d03..2d18232c 100644 --- a/makefile.darwin.clang.x86_64 +++ b/makefile.darwin.clang.x86_64 @@ -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 diff --git a/makefile.freebsd.clang.x86_64 b/makefile.freebsd.clang.x86_64 index 99858160..879f1c11 100644 --- a/makefile.freebsd.clang.x86_64 +++ b/makefile.freebsd.clang.x86_64 @@ -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 diff --git a/makefile.linux.clang.powerpc b/makefile.linux.clang.powerpc index ed129659..9c82fac1 100644 --- a/makefile.linux.clang.powerpc +++ b/makefile.linux.clang.powerpc @@ -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 diff --git a/makefile.linux.clang.x86_64 b/makefile.linux.clang.x86_64 index 3f1bdc6e..8994e028 100644 --- a/makefile.linux.clang.x86_64 +++ b/makefile.linux.clang.x86_64 @@ -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 diff --git a/makefile.linux.gcc.armv6j_hardfp b/makefile.linux.gcc.armv6j_hardfp index 15b7ef02..7fde34c4 100644 --- a/makefile.linux.gcc.armv6j_hardfp +++ b/makefile.linux.gcc.armv6j_hardfp @@ -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 diff --git a/makefile.linux.gcc.powerpc b/makefile.linux.gcc.powerpc index 6f8c1748..bb7f3cd6 100644 --- a/makefile.linux.gcc.powerpc +++ b/makefile.linux.gcc.powerpc @@ -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 diff --git a/makefile.linux.gcc.x86 b/makefile.linux.gcc.x86 index 9e0c8e8b..5da96ef7 100644 --- a/makefile.linux.gcc.x86 +++ b/makefile.linux.gcc.x86 @@ -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 diff --git a/makefile.linux.gcc.x86_64 b/makefile.linux.gcc.x86_64 index 68c343ba..55c1bd24 100644 --- a/makefile.linux.gcc.x86_64 +++ b/makefile.linux.gcc.x86_64 @@ -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 diff --git a/src/lib/s3/armv6j_hardfp/ethReals.Mod b/src/lib/s3/armv6j_hardfp/ethReals.Mod new file mode 100644 index 00000000..a7189089 --- /dev/null +++ b/src/lib/s3/armv6j_hardfp/ethReals.Mod @@ -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. diff --git a/src/lib/s3/ethDates.Mod b/src/lib/s3/ethDates.Mod new file mode 100644 index 00000000..c8bbfde5 --- /dev/null +++ b/src/lib/s3/ethDates.Mod @@ -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. diff --git a/src/lib/s3/ethStrings.Mod b/src/lib/s3/ethStrings.Mod new file mode 100644 index 00000000..07423e61 --- /dev/null +++ b/src/lib/s3/ethStrings.Mod @@ -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 := "ƒ" + |"": 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 := "" + |"…": ch := "‚" + |"†": ch := "A" + |"‡": ch := "E" + |"ˆ": ch := "I" + |"‰": ch := "O" + |"Š": ch := "U" + |"‹": ch := "A" + |"Œ": ch := "E" + |"": ch := "I" + |"Ž": ch := "O" + |"": ch := "U" + |"": 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("")] := 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("")] := 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; + 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. diff --git a/src/lib/s3/powerpc/ethReals.Mod b/src/lib/s3/powerpc/ethReals.Mod new file mode 100644 index 00000000..e11e160e --- /dev/null +++ b/src/lib/s3/powerpc/ethReals.Mod @@ -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. diff --git a/src/lib/s3/x86/ethReals.Mod b/src/lib/s3/x86/ethReals.Mod new file mode 100644 index 00000000..a7189089 --- /dev/null +++ b/src/lib/s3/x86/ethReals.Mod @@ -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. diff --git a/src/lib/s3/x86_64/ethReals.Mod b/src/lib/s3/x86_64/ethReals.Mod new file mode 100644 index 00000000..a7189089 --- /dev/null +++ b/src/lib/s3/x86_64/ethReals.Mod @@ -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. diff --git a/src/lib/v4/armv6j/Reals.Mod b/src/lib/v4/armv6j/Reals.Mod deleted file mode 100644 index 087767c1..00000000 --- a/src/lib/v4/armv6j/Reals.Mod +++ /dev/null @@ -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. diff --git a/src/lib/v4/armv7a_hardfp/Reals.Mod b/src/lib/v4/armv7a_hardfp/Reals.Mod deleted file mode 100644 index 087767c1..00000000 --- a/src/lib/v4/armv7a_hardfp/Reals.Mod +++ /dev/null @@ -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.