reorganized h2
This commit is contained in:
		
							
								
								
									
										22
									
								
								bin/Makefile.am
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										22
									
								
								bin/Makefile.am
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,22 @@
 | 
			
		||||
AUTOMAKE_OPTIONS = nostdinc
 | 
			
		||||
 | 
			
		||||
EXTRA_DIST = \
 | 
			
		||||
	slim_stream.ads storage.ads  wide_stream.ads \
 | 
			
		||||
	slim_stream.adb storage.adb  wide_stream.adb \
 | 
			
		||||
	scheme.adb
 | 
			
		||||
 | 
			
		||||
#bin_PROGRAMS = h2scm
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
all-local: h2scm$(EXEEXT)
 | 
			
		||||
 | 
			
		||||
h2scm$(EXEEXT): @abs_builddir@/@ADA_OBJDIR@ @abs_builddir@/../lib/libh2.so @abs_srcdir@/scheme.adb 	
 | 
			
		||||
	gprbuild @abs_builddir@/scheme.gpr
 | 
			
		||||
	
 | 
			
		||||
 | 
			
		||||
@abs_builddir@/@ADA_OBJDIR@:
 | 
			
		||||
	mkdir -p @abs_builddir@/@ADA_OBJDIR@
 | 
			
		||||
 | 
			
		||||
clean-local:
 | 
			
		||||
	gprclean -P@abs_builddir@/scheme.gpr
 | 
			
		||||
 | 
			
		||||
							
								
								
									
										505
									
								
								bin/Makefile.in
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										505
									
								
								bin/Makefile.in
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,505 @@
 | 
			
		||||
# Makefile.in generated by automake 1.16.2 from Makefile.am.
 | 
			
		||||
# @configure_input@
 | 
			
		||||
 | 
			
		||||
# Copyright (C) 1994-2020 Free Software Foundation, Inc.
 | 
			
		||||
 | 
			
		||||
# This Makefile.in is free software; the Free Software Foundation
 | 
			
		||||
# gives unlimited permission to copy and/or distribute it,
 | 
			
		||||
# with or without modifications, as long as this notice is preserved.
 | 
			
		||||
 | 
			
		||||
# This program is distributed in the hope that it will be useful,
 | 
			
		||||
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
 | 
			
		||||
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
 | 
			
		||||
# PARTICULAR PURPOSE.
 | 
			
		||||
 | 
			
		||||
@SET_MAKE@
 | 
			
		||||
VPATH = @srcdir@
 | 
			
		||||
am__is_gnu_make = { \
 | 
			
		||||
  if test -z '$(MAKELEVEL)'; then \
 | 
			
		||||
    false; \
 | 
			
		||||
  elif test -n '$(MAKE_HOST)'; then \
 | 
			
		||||
    true; \
 | 
			
		||||
  elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \
 | 
			
		||||
    true; \
 | 
			
		||||
  else \
 | 
			
		||||
    false; \
 | 
			
		||||
  fi; \
 | 
			
		||||
}
 | 
			
		||||
am__make_running_with_option = \
 | 
			
		||||
  case $${target_option-} in \
 | 
			
		||||
      ?) ;; \
 | 
			
		||||
      *) echo "am__make_running_with_option: internal error: invalid" \
 | 
			
		||||
              "target option '$${target_option-}' specified" >&2; \
 | 
			
		||||
         exit 1;; \
 | 
			
		||||
  esac; \
 | 
			
		||||
  has_opt=no; \
 | 
			
		||||
  sane_makeflags=$$MAKEFLAGS; \
 | 
			
		||||
  if $(am__is_gnu_make); then \
 | 
			
		||||
    sane_makeflags=$$MFLAGS; \
 | 
			
		||||
  else \
 | 
			
		||||
    case $$MAKEFLAGS in \
 | 
			
		||||
      *\\[\ \	]*) \
 | 
			
		||||
        bs=\\; \
 | 
			
		||||
        sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
 | 
			
		||||
          | sed "s/$$bs$$bs[$$bs $$bs	]*//g"`;; \
 | 
			
		||||
    esac; \
 | 
			
		||||
  fi; \
 | 
			
		||||
  skip_next=no; \
 | 
			
		||||
  strip_trailopt () \
 | 
			
		||||
  { \
 | 
			
		||||
    flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
 | 
			
		||||
  }; \
 | 
			
		||||
  for flg in $$sane_makeflags; do \
 | 
			
		||||
    test $$skip_next = yes && { skip_next=no; continue; }; \
 | 
			
		||||
    case $$flg in \
 | 
			
		||||
      *=*|--*) continue;; \
 | 
			
		||||
        -*I) strip_trailopt 'I'; skip_next=yes;; \
 | 
			
		||||
      -*I?*) strip_trailopt 'I';; \
 | 
			
		||||
        -*O) strip_trailopt 'O'; skip_next=yes;; \
 | 
			
		||||
      -*O?*) strip_trailopt 'O';; \
 | 
			
		||||
        -*l) strip_trailopt 'l'; skip_next=yes;; \
 | 
			
		||||
      -*l?*) strip_trailopt 'l';; \
 | 
			
		||||
      -[dEDm]) skip_next=yes;; \
 | 
			
		||||
      -[JT]) skip_next=yes;; \
 | 
			
		||||
    esac; \
 | 
			
		||||
    case $$flg in \
 | 
			
		||||
      *$$target_option*) has_opt=yes; break;; \
 | 
			
		||||
    esac; \
 | 
			
		||||
  done; \
 | 
			
		||||
  test $$has_opt = yes
 | 
			
		||||
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
 | 
			
		||||
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
 | 
			
		||||
pkgdatadir = $(datadir)/@PACKAGE@
 | 
			
		||||
pkgincludedir = $(includedir)/@PACKAGE@
 | 
			
		||||
pkglibdir = $(libdir)/@PACKAGE@
 | 
			
		||||
pkglibexecdir = $(libexecdir)/@PACKAGE@
 | 
			
		||||
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
 | 
			
		||||
install_sh_DATA = $(install_sh) -c -m 644
 | 
			
		||||
install_sh_PROGRAM = $(install_sh) -c
 | 
			
		||||
install_sh_SCRIPT = $(install_sh) -c
 | 
			
		||||
INSTALL_HEADER = $(INSTALL_DATA)
 | 
			
		||||
transform = $(program_transform_name)
 | 
			
		||||
NORMAL_INSTALL = :
 | 
			
		||||
PRE_INSTALL = :
 | 
			
		||||
POST_INSTALL = :
 | 
			
		||||
NORMAL_UNINSTALL = :
 | 
			
		||||
PRE_UNINSTALL = :
 | 
			
		||||
POST_UNINSTALL = :
 | 
			
		||||
build_triplet = @build@
 | 
			
		||||
host_triplet = @host@
 | 
			
		||||
subdir = bin
 | 
			
		||||
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
 | 
			
		||||
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_cxx_namespace.m4 \
 | 
			
		||||
	$(top_srcdir)/m4/ax_numval.m4 $(top_srcdir)/m4/ax_pthread.m4 \
 | 
			
		||||
	$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
 | 
			
		||||
	$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
 | 
			
		||||
	$(top_srcdir)/m4/lt~obsolete.m4 \
 | 
			
		||||
	$(top_srcdir)/m4/lx_find_mpi.m4 $(top_srcdir)/configure.ac
 | 
			
		||||
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
 | 
			
		||||
	$(ACLOCAL_M4)
 | 
			
		||||
DIST_COMMON = $(srcdir)/Makefile.am $(am__DIST_COMMON)
 | 
			
		||||
mkinstalldirs = $(install_sh) -d
 | 
			
		||||
CONFIG_HEADER = $(top_builddir)/include/h2/config.h
 | 
			
		||||
CONFIG_CLEAN_FILES = scheme.gpr
 | 
			
		||||
CONFIG_CLEAN_VPATH_FILES =
 | 
			
		||||
AM_V_P = $(am__v_P_@AM_V@)
 | 
			
		||||
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
 | 
			
		||||
am__v_P_0 = false
 | 
			
		||||
am__v_P_1 = :
 | 
			
		||||
AM_V_GEN = $(am__v_GEN_@AM_V@)
 | 
			
		||||
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
 | 
			
		||||
am__v_GEN_0 = @echo "  GEN     " $@;
 | 
			
		||||
am__v_GEN_1 = 
 | 
			
		||||
AM_V_at = $(am__v_at_@AM_V@)
 | 
			
		||||
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
 | 
			
		||||
am__v_at_0 = @
 | 
			
		||||
am__v_at_1 = 
 | 
			
		||||
SOURCES =
 | 
			
		||||
DIST_SOURCES =
 | 
			
		||||
am__can_run_installinfo = \
 | 
			
		||||
  case $$AM_UPDATE_INFO_DIR in \
 | 
			
		||||
    n|no|NO) false;; \
 | 
			
		||||
    *) (install-info --version) >/dev/null 2>&1;; \
 | 
			
		||||
  esac
 | 
			
		||||
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
 | 
			
		||||
am__DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/scheme.gpr.in
 | 
			
		||||
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
 | 
			
		||||
ACLOCAL = @ACLOCAL@
 | 
			
		||||
ADA_OBJDIR = @ADA_OBJDIR@
 | 
			
		||||
AMTAR = @AMTAR@
 | 
			
		||||
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
 | 
			
		||||
AR = @AR@
 | 
			
		||||
AUTOCONF = @AUTOCONF@
 | 
			
		||||
AUTOHEADER = @AUTOHEADER@
 | 
			
		||||
AUTOMAKE = @AUTOMAKE@
 | 
			
		||||
AWK = @AWK@
 | 
			
		||||
BUILD_MODE = @BUILD_MODE@
 | 
			
		||||
CC = @CC@
 | 
			
		||||
CCDEPMODE = @CCDEPMODE@
 | 
			
		||||
CFLAGS = @CFLAGS@
 | 
			
		||||
CHAR_TYPE = @CHAR_TYPE@
 | 
			
		||||
CPP = @CPP@
 | 
			
		||||
CPPFLAGS = @CPPFLAGS@
 | 
			
		||||
CXX = @CXX@
 | 
			
		||||
CXXCPP = @CXXCPP@
 | 
			
		||||
CXXDEPMODE = @CXXDEPMODE@
 | 
			
		||||
CXXFLAGS = @CXXFLAGS@
 | 
			
		||||
CYGPATH_W = @CYGPATH_W@
 | 
			
		||||
DEFS = @DEFS@
 | 
			
		||||
DEPDIR = @DEPDIR@
 | 
			
		||||
DLLTOOL = @DLLTOOL@
 | 
			
		||||
DSYMUTIL = @DSYMUTIL@
 | 
			
		||||
DUMPBIN = @DUMPBIN@
 | 
			
		||||
ECHO = @ECHO@
 | 
			
		||||
ECHO_C = @ECHO_C@
 | 
			
		||||
ECHO_N = @ECHO_N@
 | 
			
		||||
ECHO_T = @ECHO_T@
 | 
			
		||||
EGREP = @EGREP@
 | 
			
		||||
EXEEXT = @EXEEXT@
 | 
			
		||||
FGREP = @FGREP@
 | 
			
		||||
GREP = @GREP@
 | 
			
		||||
H2_PROJECT_AUTHOR = @H2_PROJECT_AUTHOR@
 | 
			
		||||
H2_PROJECT_URL = @H2_PROJECT_URL@
 | 
			
		||||
H2_SIZEOF_CHAR = @H2_SIZEOF_CHAR@
 | 
			
		||||
H2_SIZEOF_DOUBLE = @H2_SIZEOF_DOUBLE@
 | 
			
		||||
H2_SIZEOF_FLOAT = @H2_SIZEOF_FLOAT@
 | 
			
		||||
H2_SIZEOF_INT = @H2_SIZEOF_INT@
 | 
			
		||||
H2_SIZEOF_LONG = @H2_SIZEOF_LONG@
 | 
			
		||||
H2_SIZEOF_LONG_DOUBLE = @H2_SIZEOF_LONG_DOUBLE@
 | 
			
		||||
H2_SIZEOF_LONG_LONG = @H2_SIZEOF_LONG_LONG@
 | 
			
		||||
H2_SIZEOF_OFF64_T = @H2_SIZEOF_OFF64_T@
 | 
			
		||||
H2_SIZEOF_OFF_T = @H2_SIZEOF_OFF_T@
 | 
			
		||||
H2_SIZEOF_SHORT = @H2_SIZEOF_SHORT@
 | 
			
		||||
H2_SIZEOF_VOID_P = @H2_SIZEOF_VOID_P@
 | 
			
		||||
HAVE_CXX = @HAVE_CXX@
 | 
			
		||||
INSTALL = @INSTALL@
 | 
			
		||||
INSTALL_DATA = @INSTALL_DATA@
 | 
			
		||||
INSTALL_PROGRAM = @INSTALL_PROGRAM@
 | 
			
		||||
INSTALL_SCRIPT = @INSTALL_SCRIPT@
 | 
			
		||||
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
 | 
			
		||||
LD = @LD@
 | 
			
		||||
LDFLAGS = @LDFLAGS@
 | 
			
		||||
LIBM = @LIBM@
 | 
			
		||||
LIBOBJS = @LIBOBJS@
 | 
			
		||||
LIBS = @LIBS@
 | 
			
		||||
LIBTOOL = @LIBTOOL@
 | 
			
		||||
LIBTOOL_DEPS = @LIBTOOL_DEPS@
 | 
			
		||||
LIPO = @LIPO@
 | 
			
		||||
LN_S = @LN_S@
 | 
			
		||||
LTLIBOBJS = @LTLIBOBJS@
 | 
			
		||||
LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@
 | 
			
		||||
MAKEINFO = @MAKEINFO@
 | 
			
		||||
MANIFEST_TOOL = @MANIFEST_TOOL@
 | 
			
		||||
MKDIR_P = @MKDIR_P@
 | 
			
		||||
MPICC = @MPICC@
 | 
			
		||||
MPI_CFLAGS = @MPI_CFLAGS@
 | 
			
		||||
MPI_CLDFLAGS = @MPI_CLDFLAGS@
 | 
			
		||||
NM = @NM@
 | 
			
		||||
NMEDIT = @NMEDIT@
 | 
			
		||||
OBJDUMP = @OBJDUMP@
 | 
			
		||||
OBJEXT = @OBJEXT@
 | 
			
		||||
OTOOL = @OTOOL@
 | 
			
		||||
OTOOL64 = @OTOOL64@
 | 
			
		||||
PACKAGE = @PACKAGE@
 | 
			
		||||
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
 | 
			
		||||
PACKAGE_NAME = @PACKAGE_NAME@
 | 
			
		||||
PACKAGE_STRING = @PACKAGE_STRING@
 | 
			
		||||
PACKAGE_TARNAME = @PACKAGE_TARNAME@
 | 
			
		||||
PACKAGE_URL = @PACKAGE_URL@
 | 
			
		||||
PACKAGE_VERSION = @PACKAGE_VERSION@
 | 
			
		||||
PACKAGE_VERSION_MAJOR = @PACKAGE_VERSION_MAJOR@
 | 
			
		||||
PACKAGE_VERSION_MINOR = @PACKAGE_VERSION_MINOR@
 | 
			
		||||
PACKAGE_VERSION_PATCH = @PACKAGE_VERSION_PATCH@
 | 
			
		||||
PATH_SEPARATOR = @PATH_SEPARATOR@
 | 
			
		||||
PTHREAD_CC = @PTHREAD_CC@
 | 
			
		||||
PTHREAD_CFLAGS = @PTHREAD_CFLAGS@
 | 
			
		||||
PTHREAD_LIBS = @PTHREAD_LIBS@
 | 
			
		||||
QUADMATH_LIBS = @QUADMATH_LIBS@
 | 
			
		||||
RANLIB = @RANLIB@
 | 
			
		||||
RM = @RM@
 | 
			
		||||
RMDIR = @RMDIR@
 | 
			
		||||
SED = @SED@
 | 
			
		||||
SENDFILE_LIBS = @SENDFILE_LIBS@
 | 
			
		||||
SET_MAKE = @SET_MAKE@
 | 
			
		||||
SHELL = @SHELL@
 | 
			
		||||
SOCKET_LIBS = @SOCKET_LIBS@
 | 
			
		||||
SSL_LIBS = @SSL_LIBS@
 | 
			
		||||
STRIP = @STRIP@
 | 
			
		||||
TRUE = @TRUE@
 | 
			
		||||
UCI_LIBS = @UCI_LIBS@
 | 
			
		||||
UNICOWS_LIBS = @UNICOWS_LIBS@
 | 
			
		||||
VERSION = @VERSION@
 | 
			
		||||
abs_builddir = @abs_builddir@
 | 
			
		||||
abs_srcdir = @abs_srcdir@
 | 
			
		||||
abs_top_builddir = @abs_top_builddir@
 | 
			
		||||
abs_top_srcdir = @abs_top_srcdir@
 | 
			
		||||
ac_ct_AR = @ac_ct_AR@
 | 
			
		||||
ac_ct_CC = @ac_ct_CC@
 | 
			
		||||
ac_ct_CXX = @ac_ct_CXX@
 | 
			
		||||
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
 | 
			
		||||
am__include = @am__include@
 | 
			
		||||
am__leading_dot = @am__leading_dot@
 | 
			
		||||
am__quote = @am__quote@
 | 
			
		||||
am__tar = @am__tar@
 | 
			
		||||
am__untar = @am__untar@
 | 
			
		||||
ax_pthread_config = @ax_pthread_config@
 | 
			
		||||
bindir = @bindir@
 | 
			
		||||
build = @build@
 | 
			
		||||
build_alias = @build_alias@
 | 
			
		||||
build_cpu = @build_cpu@
 | 
			
		||||
build_os = @build_os@
 | 
			
		||||
build_vendor = @build_vendor@
 | 
			
		||||
builddir = @builddir@
 | 
			
		||||
datadir = @datadir@
 | 
			
		||||
datarootdir = @datarootdir@
 | 
			
		||||
docdir = @docdir@
 | 
			
		||||
dvidir = @dvidir@
 | 
			
		||||
exec_prefix = @exec_prefix@
 | 
			
		||||
host = @host@
 | 
			
		||||
host_alias = @host_alias@
 | 
			
		||||
host_cpu = @host_cpu@
 | 
			
		||||
host_os = @host_os@
 | 
			
		||||
host_vendor = @host_vendor@
 | 
			
		||||
htmldir = @htmldir@
 | 
			
		||||
includedir = @includedir@
 | 
			
		||||
infodir = @infodir@
 | 
			
		||||
install_sh = @install_sh@
 | 
			
		||||
libdir = @libdir@
 | 
			
		||||
libexecdir = @libexecdir@
 | 
			
		||||
localedir = @localedir@
 | 
			
		||||
localstatedir = @localstatedir@
 | 
			
		||||
mandir = @mandir@
 | 
			
		||||
mkdir_p = @mkdir_p@
 | 
			
		||||
oldincludedir = @oldincludedir@
 | 
			
		||||
pdfdir = @pdfdir@
 | 
			
		||||
prefix = @prefix@
 | 
			
		||||
program_transform_name = @program_transform_name@
 | 
			
		||||
psdir = @psdir@
 | 
			
		||||
sbindir = @sbindir@
 | 
			
		||||
sharedstatedir = @sharedstatedir@
 | 
			
		||||
srcdir = @srcdir@
 | 
			
		||||
sysconfdir = @sysconfdir@
 | 
			
		||||
target_alias = @target_alias@
 | 
			
		||||
top_build_prefix = @top_build_prefix@
 | 
			
		||||
top_builddir = @top_builddir@
 | 
			
		||||
top_srcdir = @top_srcdir@
 | 
			
		||||
AUTOMAKE_OPTIONS = nostdinc
 | 
			
		||||
EXTRA_DIST = \
 | 
			
		||||
	slim_stream.ads storage.ads  wide_stream.ads \
 | 
			
		||||
	slim_stream.adb storage.adb  wide_stream.adb \
 | 
			
		||||
	scheme.adb
 | 
			
		||||
 | 
			
		||||
all: all-am
 | 
			
		||||
 | 
			
		||||
.SUFFIXES:
 | 
			
		||||
$(srcdir)/Makefile.in:  $(srcdir)/Makefile.am  $(am__configure_deps)
 | 
			
		||||
	@for dep in $?; do \
 | 
			
		||||
	  case '$(am__configure_deps)' in \
 | 
			
		||||
	    *$$dep*) \
 | 
			
		||||
	      ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
 | 
			
		||||
	        && { if test -f $@; then exit 0; else break; fi; }; \
 | 
			
		||||
	      exit 1;; \
 | 
			
		||||
	  esac; \
 | 
			
		||||
	done; \
 | 
			
		||||
	echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign bin/Makefile'; \
 | 
			
		||||
	$(am__cd) $(top_srcdir) && \
 | 
			
		||||
	  $(AUTOMAKE) --foreign bin/Makefile
 | 
			
		||||
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
 | 
			
		||||
	@case '$?' in \
 | 
			
		||||
	  *config.status*) \
 | 
			
		||||
	    cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
 | 
			
		||||
	  *) \
 | 
			
		||||
	    echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__maybe_remake_depfiles)'; \
 | 
			
		||||
	    cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__maybe_remake_depfiles);; \
 | 
			
		||||
	esac;
 | 
			
		||||
 | 
			
		||||
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
 | 
			
		||||
	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
 | 
			
		||||
 | 
			
		||||
$(top_srcdir)/configure:  $(am__configure_deps)
 | 
			
		||||
	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
 | 
			
		||||
$(ACLOCAL_M4):  $(am__aclocal_m4_deps)
 | 
			
		||||
	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
 | 
			
		||||
$(am__aclocal_m4_deps):
 | 
			
		||||
scheme.gpr: $(top_builddir)/config.status $(srcdir)/scheme.gpr.in
 | 
			
		||||
	cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@
 | 
			
		||||
 | 
			
		||||
mostlyclean-libtool:
 | 
			
		||||
	-rm -f *.lo
 | 
			
		||||
 | 
			
		||||
clean-libtool:
 | 
			
		||||
	-rm -rf .libs _libs
 | 
			
		||||
tags TAGS:
 | 
			
		||||
 | 
			
		||||
ctags CTAGS:
 | 
			
		||||
 | 
			
		||||
cscope cscopelist:
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
distdir: $(BUILT_SOURCES)
 | 
			
		||||
	$(MAKE) $(AM_MAKEFLAGS) distdir-am
 | 
			
		||||
 | 
			
		||||
distdir-am: $(DISTFILES)
 | 
			
		||||
	@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
 | 
			
		||||
	topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
 | 
			
		||||
	list='$(DISTFILES)'; \
 | 
			
		||||
	  dist_files=`for file in $$list; do echo $$file; done | \
 | 
			
		||||
	  sed -e "s|^$$srcdirstrip/||;t" \
 | 
			
		||||
	      -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
 | 
			
		||||
	case $$dist_files in \
 | 
			
		||||
	  */*) $(MKDIR_P) `echo "$$dist_files" | \
 | 
			
		||||
			   sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
 | 
			
		||||
			   sort -u` ;; \
 | 
			
		||||
	esac; \
 | 
			
		||||
	for file in $$dist_files; do \
 | 
			
		||||
	  if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
 | 
			
		||||
	  if test -d $$d/$$file; then \
 | 
			
		||||
	    dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
 | 
			
		||||
	    if test -d "$(distdir)/$$file"; then \
 | 
			
		||||
	      find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
 | 
			
		||||
	    fi; \
 | 
			
		||||
	    if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
 | 
			
		||||
	      cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
 | 
			
		||||
	      find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
 | 
			
		||||
	    fi; \
 | 
			
		||||
	    cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
 | 
			
		||||
	  else \
 | 
			
		||||
	    test -f "$(distdir)/$$file" \
 | 
			
		||||
	    || cp -p $$d/$$file "$(distdir)/$$file" \
 | 
			
		||||
	    || exit 1; \
 | 
			
		||||
	  fi; \
 | 
			
		||||
	done
 | 
			
		||||
check-am: all-am
 | 
			
		||||
check: check-am
 | 
			
		||||
all-am: Makefile all-local
 | 
			
		||||
installdirs:
 | 
			
		||||
install: install-am
 | 
			
		||||
install-exec: install-exec-am
 | 
			
		||||
install-data: install-data-am
 | 
			
		||||
uninstall: uninstall-am
 | 
			
		||||
 | 
			
		||||
install-am: all-am
 | 
			
		||||
	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
 | 
			
		||||
 | 
			
		||||
installcheck: installcheck-am
 | 
			
		||||
install-strip:
 | 
			
		||||
	if test -z '$(STRIP)'; then \
 | 
			
		||||
	  $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
 | 
			
		||||
	    install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
 | 
			
		||||
	      install; \
 | 
			
		||||
	else \
 | 
			
		||||
	  $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
 | 
			
		||||
	    install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
 | 
			
		||||
	    "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
 | 
			
		||||
	fi
 | 
			
		||||
mostlyclean-generic:
 | 
			
		||||
 | 
			
		||||
clean-generic:
 | 
			
		||||
 | 
			
		||||
distclean-generic:
 | 
			
		||||
	-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
 | 
			
		||||
	-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
 | 
			
		||||
 | 
			
		||||
maintainer-clean-generic:
 | 
			
		||||
	@echo "This command is intended for maintainers to use"
 | 
			
		||||
	@echo "it deletes files that may require special tools to rebuild."
 | 
			
		||||
clean: clean-am
 | 
			
		||||
 | 
			
		||||
clean-am: clean-generic clean-libtool clean-local mostlyclean-am
 | 
			
		||||
 | 
			
		||||
distclean: distclean-am
 | 
			
		||||
	-rm -f Makefile
 | 
			
		||||
distclean-am: clean-am distclean-generic
 | 
			
		||||
 | 
			
		||||
dvi: dvi-am
 | 
			
		||||
 | 
			
		||||
dvi-am:
 | 
			
		||||
 | 
			
		||||
html: html-am
 | 
			
		||||
 | 
			
		||||
html-am:
 | 
			
		||||
 | 
			
		||||
info: info-am
 | 
			
		||||
 | 
			
		||||
info-am:
 | 
			
		||||
 | 
			
		||||
install-data-am:
 | 
			
		||||
 | 
			
		||||
install-dvi: install-dvi-am
 | 
			
		||||
 | 
			
		||||
install-dvi-am:
 | 
			
		||||
 | 
			
		||||
install-exec-am:
 | 
			
		||||
 | 
			
		||||
install-html: install-html-am
 | 
			
		||||
 | 
			
		||||
install-html-am:
 | 
			
		||||
 | 
			
		||||
install-info: install-info-am
 | 
			
		||||
 | 
			
		||||
install-info-am:
 | 
			
		||||
 | 
			
		||||
install-man:
 | 
			
		||||
 | 
			
		||||
install-pdf: install-pdf-am
 | 
			
		||||
 | 
			
		||||
install-pdf-am:
 | 
			
		||||
 | 
			
		||||
install-ps: install-ps-am
 | 
			
		||||
 | 
			
		||||
install-ps-am:
 | 
			
		||||
 | 
			
		||||
installcheck-am:
 | 
			
		||||
 | 
			
		||||
maintainer-clean: maintainer-clean-am
 | 
			
		||||
	-rm -f Makefile
 | 
			
		||||
maintainer-clean-am: distclean-am maintainer-clean-generic
 | 
			
		||||
 | 
			
		||||
mostlyclean: mostlyclean-am
 | 
			
		||||
 | 
			
		||||
mostlyclean-am: mostlyclean-generic mostlyclean-libtool
 | 
			
		||||
 | 
			
		||||
pdf: pdf-am
 | 
			
		||||
 | 
			
		||||
pdf-am:
 | 
			
		||||
 | 
			
		||||
ps: ps-am
 | 
			
		||||
 | 
			
		||||
ps-am:
 | 
			
		||||
 | 
			
		||||
uninstall-am:
 | 
			
		||||
 | 
			
		||||
.MAKE: install-am install-strip
 | 
			
		||||
 | 
			
		||||
.PHONY: all all-am all-local check check-am clean clean-generic \
 | 
			
		||||
	clean-libtool clean-local cscopelist-am ctags-am distclean \
 | 
			
		||||
	distclean-generic distclean-libtool distdir dvi dvi-am html \
 | 
			
		||||
	html-am info info-am install install-am install-data \
 | 
			
		||||
	install-data-am install-dvi install-dvi-am install-exec \
 | 
			
		||||
	install-exec-am install-html install-html-am install-info \
 | 
			
		||||
	install-info-am install-man install-pdf install-pdf-am \
 | 
			
		||||
	install-ps install-ps-am install-strip installcheck \
 | 
			
		||||
	installcheck-am installdirs maintainer-clean \
 | 
			
		||||
	maintainer-clean-generic mostlyclean mostlyclean-generic \
 | 
			
		||||
	mostlyclean-libtool pdf pdf-am ps ps-am tags-am uninstall \
 | 
			
		||||
	uninstall-am
 | 
			
		||||
 | 
			
		||||
.PRECIOUS: Makefile
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
#bin_PROGRAMS = h2scm
 | 
			
		||||
 | 
			
		||||
all-local: h2scm$(EXEEXT)
 | 
			
		||||
 | 
			
		||||
h2scm$(EXEEXT): @abs_builddir@/@ADA_OBJDIR@ @abs_builddir@/../lib/libh2.so @abs_srcdir@/scheme.adb 	
 | 
			
		||||
	gprbuild @abs_builddir@/scheme.gpr
 | 
			
		||||
 | 
			
		||||
@abs_builddir@/@ADA_OBJDIR@:
 | 
			
		||||
	mkdir -p @abs_builddir@/@ADA_OBJDIR@
 | 
			
		||||
 | 
			
		||||
clean-local:
 | 
			
		||||
	gprclean -P@abs_builddir@/scheme.gpr
 | 
			
		||||
 | 
			
		||||
# Tell versions [3.59,3.63) of GNU make to not export all variables.
 | 
			
		||||
# Otherwise a system limit (for SysV at least) may be exceeded.
 | 
			
		||||
.NOEXPORT:
 | 
			
		||||
							
								
								
									
										229
									
								
								bin/scheme.adb
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										229
									
								
								bin/scheme.adb
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,229 @@
 | 
			
		||||
 | 
			
		||||
with H2.Wide;
 | 
			
		||||
with H2.Slim;
 | 
			
		||||
with H2.Pool;
 | 
			
		||||
with Storage;
 | 
			
		||||
with Slim_Stream;
 | 
			
		||||
with Wide_Stream;
 | 
			
		||||
with Ada.Text_IO;
 | 
			
		||||
with Ada.Wide_Text_IO;
 | 
			
		||||
with Ada.Unchecked_Deallocation;
 | 
			
		||||
with Ada.Exceptions;
 | 
			
		||||
 | 
			
		||||
with H2.OS;
 | 
			
		||||
with H2.IO;
 | 
			
		||||
use type H2.System_Length;
 | 
			
		||||
 | 
			
		||||
with Interfaces.C;
 | 
			
		||||
 | 
			
		||||
procedure scheme is
 | 
			
		||||
	package Stream renames Wide_Stream;
 | 
			
		||||
	package Scheme renames H2.Wide.Scheme;
 | 
			
		||||
	--package Stream renames Slim_Stream;
 | 
			
		||||
	--package Scheme renames H2.Slim.Scheme;
 | 
			
		||||
 | 
			
		||||
	Pool: aliased Storage.Global_Pool;
 | 
			
		||||
	SI: Scheme.Interpreter_Record;
 | 
			
		||||
 | 
			
		||||
	I: Scheme.Object_Pointer;
 | 
			
		||||
	O: Scheme.Object_Pointer;
 | 
			
		||||
 | 
			
		||||
	--String: aliased S.Object_String := "(car '(1 2 3))";
 | 
			
		||||
	String: aliased constant Scheme.Object_Character_Array := "((lambda (x y) (+ x y))  9  7)";
 | 
			
		||||
	String_Stream: Stream.String_Input_Stream_Record (String'Unchecked_Access);
 | 
			
		||||
	--String_Stream: Stream.String_Input_Stream_Record := (Len => String'Length, Str => String, Pos => 0);
 | 
			
		||||
 | 
			
		||||
	File_Name: aliased Scheme.Object_Character_Array := "test.adb";
 | 
			
		||||
	--File_Name: aliased constant Scheme.Object_Character_Array := "시험.scm";
 | 
			
		||||
	--File_Stream: Stream.File_Stream_Record (File_Name'Unchecked_Access);
 | 
			
		||||
	--File_Stream: Stream.File_Stream_Record := (Name => File_Name'Unchecked_Access);
 | 
			
		||||
	File_Stream: Stream.File_Stream_Record;
 | 
			
		||||
 | 
			
		||||
   --procedure h2init;
 | 
			
		||||
   --pragma Import (C, h2init, "h2init");
 | 
			
		||||
 | 
			
		||||
begin
 | 
			
		||||
	--h2init;
 | 
			
		||||
ada.text_io.put ("Object_Size'Last: ");
 | 
			
		||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Object_Size'Last));
 | 
			
		||||
 | 
			
		||||
ada.text_io.put ("Object_Byte'Size: ");
 | 
			
		||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Object_Byte'Size));
 | 
			
		||||
ada.text_io.put ("Object_Word'Size: ");
 | 
			
		||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Object_Word'Size));
 | 
			
		||||
ada.text_io.put ("Object_Pointer'Size: ");
 | 
			
		||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Object_Pointer'Size));
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
ada.text_io.put ("Object_Pointer_Bits: ");
 | 
			
		||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Object_Pointer_Bits));
 | 
			
		||||
ada.text_io.put ("Object_Pointer_Bytes: ");
 | 
			
		||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Object_Pointer_Bytes));
 | 
			
		||||
ada.text_io.put ("Object_Header_Bytes: ");
 | 
			
		||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Object_Header_Bytes));
 | 
			
		||||
ada.text_io.put ("Object_Payload_Max_Bytes: ");
 | 
			
		||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Object_Payload_Max_Bytes));
 | 
			
		||||
 | 
			
		||||
ada.text_io.put ("Byte_Object_Size_last: ");
 | 
			
		||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Byte_Object_Size_Last));
 | 
			
		||||
ada.text_io.put ("Pointer_Object_Size_last: ");
 | 
			
		||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Pointer_Object_Size_Last));
 | 
			
		||||
 | 
			
		||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Empty_Object_Record'Size));
 | 
			
		||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Empty_Object_Record'Max_Size_In_Storage_Elements));
 | 
			
		||||
 | 
			
		||||
declare
 | 
			
		||||
	package OS is new H2.OS (
 | 
			
		||||
		H2.Slim.Character,
 | 
			
		||||
		H2.Wide.Character,
 | 
			
		||||
		H2.Slim.String,
 | 
			
		||||
		H2.Wide.String,
 | 
			
		||||
		H2.Wide.Utf8.To_Unicode_String,
 | 
			
		||||
		H2.Wide.Utf8.From_Unicode_String);
 | 
			
		||||
	package File renames OS.File;
 | 
			
		||||
 | 
			
		||||
	F: File.File_Pointer;
 | 
			
		||||
	FL: File.Flag_Record;
 | 
			
		||||
	Length: H2.System_Length;
 | 
			
		||||
	Buffer: H2.System_Byte_Array (50 .. 100);
 | 
			
		||||
begin
 | 
			
		||||
	--OS.File.Set_Flag_Bits (FL, OS.File.FLAG_WRITE); 
 | 
			
		||||
	File.Set_Flag_Bits (FL, File.FLAG_READ);
 | 
			
		||||
	File.Open (F, H2.Wide.String'("/etc/passwd"), FL);
 | 
			
		||||
	File.Read (F, Buffer, Length);
 | 
			
		||||
	File.Close (F);
 | 
			
		||||
 | 
			
		||||
	File.Write (OS.File.Get_Stdout, Buffer(Buffer'First .. Buffer'First + Length - 1), Length);
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
declare
 | 
			
		||||
	package IO is new H2.IO (
 | 
			
		||||
		H2.Slim.Character,
 | 
			
		||||
		H2.Wide.Character,
 | 
			
		||||
		H2.Slim.String,
 | 
			
		||||
		H2.Wide.String,
 | 
			
		||||
		H2.Wide.Utf8.To_Unicode_String,
 | 
			
		||||
		H2.Wide.Utf8.From_Unicode_String,
 | 
			
		||||
		H2.Wide.Utf8.Sequence_Length);
 | 
			
		||||
 | 
			
		||||
	package File renames IO.File;
 | 
			
		||||
 | 
			
		||||
	F, F2: File.File_Record;
 | 
			
		||||
	FL: File.Flag_Record;
 | 
			
		||||
	Buffer: H2.Slim.String (1 .. 200);
 | 
			
		||||
	BufferW: H2.Wide.String (1 .. 27);
 | 
			
		||||
	IL, OL: H2.System_Length;
 | 
			
		||||
	Option: File.Option_Record;
 | 
			
		||||
begin
 | 
			
		||||
	--File.Open (F, H2.Slim.String'("/etc/passwd"), FL);
 | 
			
		||||
	--File.Read (F, Buffer, Length);
 | 
			
		||||
	--Ada.Text_IO.PUt_Line (Standard.String(Buffer(Buffer'First .. Buffer'First + Length - 1)));
 | 
			
		||||
 | 
			
		||||
	--File.Read (F, Buffer, Length);
 | 
			
		||||
	--Ada.Text_IO.PUt (Standard.String(Buffer(Buffer'First .. Buffer'First + Length - 1)));
 | 
			
		||||
	--File.Close (F);
 | 
			
		||||
 | 
			
		||||
ada.text_io.put_line ("------------------");
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
	--Stdout.Get_Line (..
 | 
			
		||||
	--Stdout.Print ("-----------------");
 | 
			
		||||
	--Stdout.Print_Line ("-------------------");
 | 
			
		||||
 | 
			
		||||
	File.Set_Flag_Bits (FL, File.FLAG_READ);
 | 
			
		||||
	File.Set_Flag_Bits (FL, File.FLAG_NONBLOCK);
 | 
			
		||||
	File.Open (F, H2.Slim.String'("/tmp/xxx"), FL);
 | 
			
		||||
 | 
			
		||||
	--Option := File.Get_Option(F2);
 | 
			
		||||
	File.Clear_Flag_Bits (FL, FL.Bits);
 | 
			
		||||
	File.Set_Flag_Bits (FL, File.FLAG_WRITE);
 | 
			
		||||
	File.Set_Flag_Bits (FL, File.FLAG_CREATE);
 | 
			
		||||
	File.Set_Flag_Bits (FL, File.FLAG_TRUNCATE);
 | 
			
		||||
	File.Open (F2, H2.Wide.String'("/tmp/yyy"), FL);
 | 
			
		||||
 | 
			
		||||
	File.Set_Option_Bits (Option, File.Option_CRLF_IN);
 | 
			
		||||
	--File.Set_Option_Bits (Option, File.Option_CRLF_OUT);
 | 
			
		||||
	--Option.LF := IO.Ascii.Code.Colon;
 | 
			
		||||
	File.Set_Option (F2, Option);
 | 
			
		||||
	File.Set_Option (F, Option);
 | 
			
		||||
 | 
			
		||||
	loop
 | 
			
		||||
 | 
			
		||||
		--File.Get_Line (F, Buffer, IL);
 | 
			
		||||
		File.Get_Line (F, BufferW, IL);
 | 
			
		||||
 | 
			
		||||
--ada.text_io.put_line (standard.string(buffer(1..il)));
 | 
			
		||||
--ada.wide_text_io.put_line (standard.wide_string(bufferw(1..il)));
 | 
			
		||||
		--File.Read (F, BufferW, IL);
 | 
			
		||||
		exit when IL <= 0;
 | 
			
		||||
 | 
			
		||||
		--File.Put_Line (F2, Buffer(Buffer'First .. Buffer'First + IL - 1), OL);
 | 
			
		||||
		File.Put_Line (F2, BufferW(Buffer'First .. Buffer'First + IL - 1), OL);
 | 
			
		||||
		pragma Assert (IL = OL);
 | 
			
		||||
 | 
			
		||||
		--Ada.Text_IO.PUt (Standard.String(Buffer(Buffer'First .. Buffer'First + IL - 1)));
 | 
			
		||||
		--Ada.Wide_Text_IO.Put_Line (Standard.Wide_String(BufferW(BufferW'First .. BufferW'First + IL - 1)));
 | 
			
		||||
	end loop;
 | 
			
		||||
 | 
			
		||||
	--File.Write (F2, H2.Wide.String'("나는 피리부는 사나이 정말로 멋있는 사나이"), OL);
 | 
			
		||||
	--File.Write_Line (F2, H2.Wide.String'("이세상에 문디없어면 무슨재미로 너도 나도 만세."), OL);
 | 
			
		||||
	--File.Write_Line (F2, H2.Wide.String'("이세상에 for the first time 우하."), OL);
 | 
			
		||||
	--File.Write_Line (F2, H2.Wide.String'(""), OL);
 | 
			
		||||
	File.Close (F2);
 | 
			
		||||
	File.Close (F);
 | 
			
		||||
 | 
			
		||||
exception
 | 
			
		||||
	when Error: others =>
 | 
			
		||||
		Ada.Text_IO.Put_Line ("~~~~~~~~~~ EXCEPTION ~~~~~~~~~~" & Ada.Exceptions.Exception_Information(Error));
 | 
			
		||||
 | 
			
		||||
		if File.Is_Open(F2) then
 | 
			
		||||
			File.Close (F2);
 | 
			
		||||
		end if;
 | 
			
		||||
		if File.Is_Open(F) then
 | 
			
		||||
			File.Close (F);
 | 
			
		||||
		end if;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
declare
 | 
			
		||||
 | 
			
		||||
	LC_ALL : constant Interfaces.C.int := 0;
 | 
			
		||||
	procedure setlocale (
 | 
			
		||||
		category : Interfaces.C.int;
 | 
			
		||||
		locale : Interfaces.C.char_array);
 | 
			
		||||
	pragma Import (C, setlocale);
 | 
			
		||||
	Empty : aliased Interfaces.C.char_array := (0 => Interfaces.C.nul);
 | 
			
		||||
 | 
			
		||||
begin
 | 
			
		||||
	setlocale (LC_ALL, Empty);
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
	Scheme.Open (SI, 2_000_000, Pool'Unchecked_Access);
 | 
			
		||||
	--Scheme.Open (SI, null);
 | 
			
		||||
 | 
			
		||||
	-- Specify the named stream handler
 | 
			
		||||
	Scheme.Set_Option (SI, (Scheme.Stream_Option,
 | 
			
		||||
	                        Stream.Allocate_Stream'Access,
 | 
			
		||||
	                        Stream.Deallocate_Stream'Access)
 | 
			
		||||
	);
 | 
			
		||||
 | 
			
		||||
Scheme.Set_Option (SI, (Scheme.Trait_Option, Scheme.No_Optimization));
 | 
			
		||||
 | 
			
		||||
	File_Stream.Name := File_Name'Unchecked_Access;
 | 
			
		||||
	begin
 | 
			
		||||
		Scheme.Set_Input_Stream (SI, File_Stream); -- specify main input stream
 | 
			
		||||
		--Schee.Set_Input_Stream (SI, String_Stream);
 | 
			
		||||
	exception
 | 
			
		||||
		when others =>
 | 
			
		||||
			Ada.Text_IO.Put_Line ("Cannot open Input Stream");
 | 
			
		||||
	end;
 | 
			
		||||
	--Scheme.Set_Output_Stream (SI, Stream); -- specify main output stream.
 | 
			
		||||
 | 
			
		||||
Ada.Text_IO.Put_Line ("-------------------------------------------");
 | 
			
		||||
Scheme.Run_Loop (SI, I);
 | 
			
		||||
Scheme.Print (SI, I);
 | 
			
		||||
	Scheme.Close (SI);
 | 
			
		||||
 | 
			
		||||
	Ada.Text_IO.Put_Line ("BYE...");
 | 
			
		||||
 | 
			
		||||
end scheme;
 | 
			
		||||
							
								
								
									
										41
									
								
								bin/scheme.gpr.in
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										41
									
								
								bin/scheme.gpr.in
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,41 @@
 | 
			
		||||
 | 
			
		||||
with "@abs_builddir@/../lib/libh2";
 | 
			
		||||
 | 
			
		||||
project Scheme is
 | 
			
		||||
 | 
			
		||||
	for Main use ("scheme");
 | 
			
		||||
 | 
			
		||||
	for Exec_Dir use ".";
 | 
			
		||||
 | 
			
		||||
	for Source_Dirs use (
 | 
			
		||||
		"@abs_builddir@/../lib",
 | 
			
		||||
		"@abs_builddir@",
 | 
			
		||||
		"@abs_srcdir@"
 | 
			
		||||
	);
 | 
			
		||||
	for Source_Files use (
 | 
			
		||||
		"storage.ads",
 | 
			
		||||
		"storage.adb",
 | 
			
		||||
		"slim_stream.ads",
 | 
			
		||||
		"slim_stream.adb",
 | 
			
		||||
		"wide_stream.ads",
 | 
			
		||||
		"wide_stream.adb",
 | 
			
		||||
		"scheme.adb"
 | 
			
		||||
	);
 | 
			
		||||
	for Object_Dir use "@ADA_OBJDIR@";
 | 
			
		||||
 | 
			
		||||
	package Compiler is
 | 
			
		||||
		for Default_Switches ("Ada") use (
 | 
			
		||||
			"-gnata", "-gnato", "-gnatN",  "-gnatwl", "-gnat95", "-gnatW8", "-g",
 | 
			
		||||
			"-I@abs_srcdir@/../lib",
 | 
			
		||||
			"-I@abs_srcdir@/../lib/posix",
 | 
			
		||||
			"-I@abs_builddir@/../lib/posix"
 | 
			
		||||
		);
 | 
			
		||||
	end Compiler;
 | 
			
		||||
 | 
			
		||||
	package Builder is
 | 
			
		||||
		for Executable ("scheme.adb") use "h2scm";
 | 
			
		||||
	end Builder;
 | 
			
		||||
 | 
			
		||||
end Scheme;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
							
								
								
									
										125
									
								
								bin/slim_stream.adb
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										125
									
								
								bin/slim_stream.adb
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,125 @@
 | 
			
		||||
with H2.Pool;
 | 
			
		||||
with Ada.Unchecked_Conversion;
 | 
			
		||||
 | 
			
		||||
package body Slim_Stream is
 | 
			
		||||
 | 
			
		||||
	use type S.Object_Size;
 | 
			
		||||
 | 
			
		||||
	------------------------------------------------------------------
 | 
			
		||||
 | 
			
		||||
	procedure Open (Stream: in out String_Input_Stream_Record) is
 | 
			
		||||
	begin
 | 
			
		||||
Ada.Text_IO.Put_Line ("****** OPEN SLIM STRING STREAM ******");
 | 
			
		||||
		Stream.Pos := 0;
 | 
			
		||||
	end Open;
 | 
			
		||||
 | 
			
		||||
	procedure Close (Stream: in out String_Input_Stream_Record) is
 | 
			
		||||
	begin
 | 
			
		||||
Ada.Text_IO.Put_Line ("****** CLOSE SLIM STRING STREAM ******");
 | 
			
		||||
		Stream.Pos := Stream.Str'Last;
 | 
			
		||||
	end Close;
 | 
			
		||||
 | 
			
		||||
	procedure Read (Stream: in out String_Input_Stream_Record;
 | 
			
		||||
	                Data:   out    S.Object_Character_Array;
 | 
			
		||||
	                Last:   out    S.Object_Size) is
 | 
			
		||||
		Avail: S.Object_Size;
 | 
			
		||||
	begin
 | 
			
		||||
		Avail := Stream.Str'Last - Stream.Pos;
 | 
			
		||||
		if Avail <= 0 then
 | 
			
		||||
			-- EOF
 | 
			
		||||
			Last := Data'First - 1;
 | 
			
		||||
		else
 | 
			
		||||
			if Avail > Data'Length then
 | 
			
		||||
				Avail := Data'Length;
 | 
			
		||||
			end if;
 | 
			
		||||
 | 
			
		||||
			Data(Data'First .. Avail) := Stream.Str(Stream.Pos + 1..Stream.Pos + Avail);
 | 
			
		||||
			Stream.Pos := Stream.Pos + Avail;
 | 
			
		||||
			Last := Data'First + Avail - 1;
 | 
			
		||||
		end if;
 | 
			
		||||
	end Read;
 | 
			
		||||
 | 
			
		||||
	procedure Write (Stream: in out String_Input_Stream_Record;
 | 
			
		||||
	                 Data:   out    S.Object_Character_Array;
 | 
			
		||||
	                 Last:   out    S.Object_Size) is
 | 
			
		||||
	begin
 | 
			
		||||
		--raise S.Stream_Error;
 | 
			
		||||
		Last := Data'First - 1;
 | 
			
		||||
	end Write;
 | 
			
		||||
 | 
			
		||||
	------------------------------------------------------------------
 | 
			
		||||
 | 
			
		||||
	procedure Open (Stream: in out File_Stream_Record) is
 | 
			
		||||
	begin
 | 
			
		||||
Ada.Text_IO.Put_Line (">>>>> OPEN SLIM FILE STREAM <<<<< " & Standard.String(Stream.Name.all));
 | 
			
		||||
		Ada.Text_IO.Open (Stream.Handle, Ada.Text_IO.In_File, Standard.String(Stream.Name.all));
 | 
			
		||||
	end Open;
 | 
			
		||||
 | 
			
		||||
	procedure Close (Stream: in out File_Stream_Record) is
 | 
			
		||||
	begin
 | 
			
		||||
Ada.Text_IO.Put_Line (">>>>> CLOSE SLIM FILE STREAM <<<<< " & Standard.String(Stream.Name.all));
 | 
			
		||||
		Ada.Text_IO.Close (Stream.Handle);
 | 
			
		||||
	end Close;
 | 
			
		||||
 | 
			
		||||
	procedure Read (Stream: in out File_Stream_Record;
 | 
			
		||||
	                Data:   out    S.Object_Character_Array;
 | 
			
		||||
	                Last:   out    S.Object_Size) is
 | 
			
		||||
	begin
 | 
			
		||||
		for I in Data'First .. Data'Last loop
 | 
			
		||||
			begin
 | 
			
		||||
				if Ada.Text_IO.End_Of_File (Stream.Handle) then
 | 
			
		||||
					Last := I - 1;
 | 
			
		||||
					return;
 | 
			
		||||
				end if;
 | 
			
		||||
 | 
			
		||||
				Ada.Text_IO.Get_Immediate (Stream.Handle, Data(I));
 | 
			
		||||
				--Ada.Text_IO.Get (Stream.Handle, Data(I));
 | 
			
		||||
 | 
			
		||||
			exception
 | 
			
		||||
				when Ada.Text_IO.End_Error =>
 | 
			
		||||
					Last := I - 1;
 | 
			
		||||
					return;
 | 
			
		||||
				-- other exceptions must be just raised to indicate errors
 | 
			
		||||
			end;
 | 
			
		||||
		end loop;
 | 
			
		||||
		Last := Data'Last;
 | 
			
		||||
	end Read;
 | 
			
		||||
 | 
			
		||||
	procedure Write (Stream: in out File_Stream_Record;
 | 
			
		||||
	                 Data:   out    S.Object_Character_Array;
 | 
			
		||||
	                 Last:   out    S.Object_Size) is
 | 
			
		||||
	begin
 | 
			
		||||
		--raise S.Stream_Error;
 | 
			
		||||
		Last := Data'First - 1;
 | 
			
		||||
	end Write;
 | 
			
		||||
 | 
			
		||||
	------------------------------------------------------------------
 | 
			
		||||
 | 
			
		||||
	procedure Allocate_Stream (Interp: in out S.Interpreter_Record;
 | 
			
		||||
	                           Name:   access S.Object_Character_Array;
 | 
			
		||||
	                           Result: out    S.Stream_Pointer) is
 | 
			
		||||
		subtype FSR is File_Stream_Record;
 | 
			
		||||
		type FSP is access all FSR;
 | 
			
		||||
		package P is new H2.Pool (FSR, FSP);
 | 
			
		||||
 | 
			
		||||
		X: FSP;
 | 
			
		||||
		for X'Address use Result'Address;
 | 
			
		||||
		pragma Import (Ada, X);
 | 
			
		||||
	begin
 | 
			
		||||
		X := P.Allocate (S.Get_Storage_Pool(Interp));
 | 
			
		||||
		X.Name := S.Constant_Object_Character_Array_Pointer(Name);
 | 
			
		||||
	end Allocate_Stream;
 | 
			
		||||
 | 
			
		||||
	procedure Deallocate_Stream (Interp: in out S.Interpreter_Record;
 | 
			
		||||
	                             Source: in out S.Stream_Pointer) is
 | 
			
		||||
		subtype FSR is File_Stream_Record;
 | 
			
		||||
		type FSP is access all FSR;
 | 
			
		||||
		package P is new H2.Pool (FSR, FSP);
 | 
			
		||||
 | 
			
		||||
		X: FSP;
 | 
			
		||||
		for X'Address use Source'Address;
 | 
			
		||||
		pragma Import (Ada, X);
 | 
			
		||||
	begin
 | 
			
		||||
		P.Deallocate (X, S.Get_Storage_Pool(Interp));
 | 
			
		||||
	end Deallocate_Stream;
 | 
			
		||||
end Slim_Stream;
 | 
			
		||||
							
								
								
									
										55
									
								
								bin/slim_stream.ads
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										55
									
								
								bin/slim_stream.ads
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,55 @@
 | 
			
		||||
with H2.Slim;
 | 
			
		||||
with Ada.Text_IO;
 | 
			
		||||
 | 
			
		||||
package Slim_Stream is
 | 
			
		||||
 | 
			
		||||
	package S renames H2.Slim.Scheme;
 | 
			
		||||
 | 
			
		||||
	------------------------------------------------------------
 | 
			
		||||
	--type Object_Character_Array_Pointer is access all S.Object_Character_Array;
 | 
			
		||||
	type Object_Character_Array_Pointer is access constant S.Object_Character_Array;
 | 
			
		||||
	type String_Input_Stream_Record(Str: Object_Character_Array_Pointer) is new S.Stream_Record with record
 | 
			
		||||
		Pos: S.Object_Size := 0;	
 | 
			
		||||
	end record;
 | 
			
		||||
 | 
			
		||||
	procedure Open (Stream: in out String_Input_Stream_Record);
 | 
			
		||||
	procedure Close (Stream: in out String_Input_Stream_Record);
 | 
			
		||||
	procedure Read (Stream: in out String_Input_Stream_Record;
 | 
			
		||||
	                Data:   out    S.Object_Character_Array;
 | 
			
		||||
	                Last:   out    S.Object_Size);
 | 
			
		||||
	procedure Write (Stream: in out String_Input_Stream_Record;
 | 
			
		||||
	                 Data:   out    S.Object_Character_Array;
 | 
			
		||||
	                 Last:   out    S.Object_Size);
 | 
			
		||||
 | 
			
		||||
	------------------------------------------------------------
 | 
			
		||||
 | 
			
		||||
	type File_Stream_Record is new S.Stream_Record with record
 | 
			
		||||
		Name:   S.Constant_Object_Character_Array_Pointer;
 | 
			
		||||
		Handle: Ada.Text_IO.File_Type;
 | 
			
		||||
	end record;
 | 
			
		||||
 | 
			
		||||
	procedure Open (Stream: in out File_Stream_Record);
 | 
			
		||||
	procedure Close (Stream: in out File_Stream_Record);
 | 
			
		||||
	procedure Read (Stream: in out File_Stream_Record;
 | 
			
		||||
	                Data:   out    S.Object_Character_Array;
 | 
			
		||||
	                Last:   out    S.Object_Size);
 | 
			
		||||
	procedure Write (Stream: in out File_Stream_Record;
 | 
			
		||||
	                 Data:   out    S.Object_Character_Array;
 | 
			
		||||
	                 Last:   out    S.Object_Size);
 | 
			
		||||
 | 
			
		||||
	------------------------------------------------------------
 | 
			
		||||
	procedure Allocate_Stream (Interp: in out S.Interpreter_Record;
 | 
			
		||||
	                           Name:   access S.Object_Character_Array;
 | 
			
		||||
	                           Result: out    S.Stream_Pointer);
 | 
			
		||||
 | 
			
		||||
	procedure Deallocate_Stream (Interp: in out S.Interpreter_Record;
 | 
			
		||||
	                             Source: in out S.Stream_Pointer);
 | 
			
		||||
 | 
			
		||||
--private
 | 
			
		||||
--	type File_Stream_Record is new S.Stream_Record with record
 | 
			
		||||
--		Name:   S.Constant_Object_Character_Array_Pointer;
 | 
			
		||||
--		Handle: Ada.Text_IO.File_Type;
 | 
			
		||||
--	end record;
 | 
			
		||||
 | 
			
		||||
end Slim_Stream;
 | 
			
		||||
 | 
			
		||||
							
								
								
									
										66
									
								
								bin/storage.adb
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										66
									
								
								bin/storage.adb
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,66 @@
 | 
			
		||||
with System;
 | 
			
		||||
--with System.Address_Image;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
with Ada.Text_IO;
 | 
			
		||||
 | 
			
		||||
package body Storage is
 | 
			
		||||
 | 
			
		||||
	type Size_T is mod 2 ** System.Word_Size;
 | 
			
		||||
 | 
			
		||||
	function Sys_Malloc (Size: Size_T) return System.Address;
 | 
			
		||||
	--pragma Import (C, Sys_Malloc, Link_Name => "malloc");
 | 
			
		||||
	pragma Import (Convention => C, Entity => Sys_Malloc, External_Name => "malloc");
 | 
			
		||||
 | 
			
		||||
	procedure Sys_Free (Ptr: System.Address);
 | 
			
		||||
	--pragma Import (C, Sys_Free, Link_Name => "free");
 | 
			
		||||
	pragma Import (Convention => C, Entity => Sys_Free, External_Name => "free");
 | 
			
		||||
 | 
			
		||||
	procedure Allocate (Pool: in out Global_Pool; Address : out System.Address; Size: in SSE.Storage_Count; Alignment: in SSE.Storage_Count) is
 | 
			
		||||
		tmp: System.Address;
 | 
			
		||||
		use type SSE.Storage_Count;
 | 
			
		||||
	begin
 | 
			
		||||
Ada.Text_IO.Put_Line ("QSE.Global_Pool Allocating " & SSE.Storage_Count'Image (Size) & " " & SSE.Storage_Count'Image (((Size + Alignment - 1) / Alignment) * Alignment));
 | 
			
		||||
		tmp := Sys_Malloc (Size_T(((Size + Alignment - 1) / Alignment) * Alignment));
 | 
			
		||||
		if System."=" (tmp, System.Null_Address) then
 | 
			
		||||
			raise Storage_Error;
 | 
			
		||||
		else
 | 
			
		||||
			Address := tmp;
 | 
			
		||||
--Ada.Text_IO.Put_Line ("QSE.Global_Pool Returning " & System.Address_Image (Address));
 | 
			
		||||
		end if;
 | 
			
		||||
	end Allocate;
 | 
			
		||||
 | 
			
		||||
	procedure Deallocate (Pool: in out Global_Pool; Address : in System.Address; Size: in SSE.Storage_Count; Alignment: in SSE.Storage_Count) is
 | 
			
		||||
	begin
 | 
			
		||||
Ada.Text_IO.Put_Line ("QSE.Global_Pool Deallocating ");
 | 
			
		||||
--Ada.Text_IO.Put_Line ("QSE.Global_Pool Deallocating " & System.Address_Image (Address));
 | 
			
		||||
		Sys_Free (Address);
 | 
			
		||||
	end Deallocate;
 | 
			
		||||
 | 
			
		||||
	function Storage_Size (Pool: in Global_Pool) return SSE.Storage_Count is
 | 
			
		||||
	begin
 | 
			
		||||
Ada.Text_IO.Put_Line ("QSE.Global_Pool Storage_Size ");
 | 
			
		||||
		return SSE.Storage_Count'Last;
 | 
			
		||||
	end Storage_Size;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
	-- TODO: find a better solution
 | 
			
		||||
	-- gnat 3.15p somehow looks for the rountines below when H2.Pool is used.
 | 
			
		||||
	-- let me put these routines here temporarily until i find a proper solution.
 | 
			
		||||
	procedure Allocate_315P (Pool: in out SSP.Root_Storage_Pool'Class; Address : out System.Address; Size: in SSE.Storage_Count; Alignment: in SSE.Storage_Count);
 | 
			
		||||
	pragma Export (Ada, Allocate_315P, "system__storage_pools__allocate");
 | 
			
		||||
	procedure Allocate_315P (Pool: in out SSP.Root_Storage_Pool'Class; Address : out System.Address; Size: in SSE.Storage_Count; Alignment: in SSE.Storage_Count) is
 | 
			
		||||
	begin
 | 
			
		||||
ada.text_io.put_line ("system__storage_pools__allocate...");
 | 
			
		||||
		SSP.Allocate (Pool, Address, Size, Alignment);
 | 
			
		||||
	end Allocate_315P;
 | 
			
		||||
 | 
			
		||||
	procedure Deallocate_315P (Pool: in out SSP.Root_Storage_Pool'Class; Address : in System.Address; Size: in SSE.Storage_Count; Alignment: in SSE.Storage_Count);
 | 
			
		||||
	pragma Export (Ada, Deallocate_315P, "system__storage_pools__deallocate");
 | 
			
		||||
	procedure Deallocate_315P (Pool: in out SSP.Root_Storage_Pool'Class; Address : in System.Address; Size: in SSE.Storage_Count; Alignment: in SSE.Storage_Count) is
 | 
			
		||||
	begin
 | 
			
		||||
ada.text_io.put_line ("system__storage_pools__deallocate...");
 | 
			
		||||
		SSP.Deallocate (Pool, Address, Size, Alignment);
 | 
			
		||||
	end Deallocate_315P;
 | 
			
		||||
end Storage;
 | 
			
		||||
 | 
			
		||||
							
								
								
									
										26
									
								
								bin/storage.ads
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										26
									
								
								bin/storage.ads
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,26 @@
 | 
			
		||||
with System.Storage_Pools;
 | 
			
		||||
with System.Storage_Elements;
 | 
			
		||||
 | 
			
		||||
package Storage is
 | 
			
		||||
 | 
			
		||||
	package SSE renames System.Storage_Elements;
 | 
			
		||||
	package SSP renames System.Storage_Pools;
 | 
			
		||||
 | 
			
		||||
	type Global_Pool is new SSP.Root_Storage_Pool with private;
 | 
			
		||||
 | 
			
		||||
	procedure Allocate (Pool:      in out Global_Pool;
 | 
			
		||||
	                    Address:   out System.Address;
 | 
			
		||||
	                    Size:      in SSE.Storage_Count;
 | 
			
		||||
	                    Alignment: in SSE.Storage_Count);
 | 
			
		||||
 | 
			
		||||
	procedure Deallocate (Pool:      in out Global_Pool;
 | 
			
		||||
	                      Address:   in System.Address;
 | 
			
		||||
	                      Size:      in SSE.Storage_Count;
 | 
			
		||||
	                      Alignment: in SSE.Storage_Count);
 | 
			
		||||
 | 
			
		||||
	function Storage_Size (Pool: in Global_Pool) return SSE.Storage_Count;
 | 
			
		||||
 | 
			
		||||
private
 | 
			
		||||
	type Global_Pool is new SSP.Root_Storage_Pool with null record;
 | 
			
		||||
 | 
			
		||||
end Storage;
 | 
			
		||||
							
								
								
									
										140
									
								
								bin/wide_stream.adb
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										140
									
								
								bin/wide_stream.adb
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,140 @@
 | 
			
		||||
with H2.Pool;
 | 
			
		||||
with Ada.Unchecked_Conversion;
 | 
			
		||||
 | 
			
		||||
with Ada.Text_IO; -- for debugging
 | 
			
		||||
with Ada.Exceptions;
 | 
			
		||||
 | 
			
		||||
package body Wide_Stream is
 | 
			
		||||
 | 
			
		||||
	package Utf8 renames H2.Wide.Utf8;
 | 
			
		||||
	use type S.Object_Size;
 | 
			
		||||
 | 
			
		||||
	------------------------------------------------------------------
 | 
			
		||||
 | 
			
		||||
	procedure Open (Stream: in out String_Input_Stream_Record) is
 | 
			
		||||
	begin
 | 
			
		||||
Ada.Text_IO.Put_Line ("****** OPEN WIDE STRING STREAM ******");
 | 
			
		||||
		Stream.Pos := 0;
 | 
			
		||||
	end Open;
 | 
			
		||||
 | 
			
		||||
	procedure Close (Stream: in out String_Input_Stream_Record) is
 | 
			
		||||
	begin
 | 
			
		||||
Ada.Text_IO.Put_Line ("****** CLOSE WIDE STRING STREAM ******");
 | 
			
		||||
		Stream.Pos := Stream.Str'Last;
 | 
			
		||||
	end Close;
 | 
			
		||||
 | 
			
		||||
	procedure Read (Stream: in out String_Input_Stream_Record;
 | 
			
		||||
	                Data:   out    S.Object_Character_Array;
 | 
			
		||||
	                Last:   out    S.Object_Size) is
 | 
			
		||||
		Avail: S.Object_Size;
 | 
			
		||||
	begin
 | 
			
		||||
		Avail := Stream.Str'Last - Stream.Pos;
 | 
			
		||||
		if Avail <= 0 then
 | 
			
		||||
			-- EOF
 | 
			
		||||
			Last := Data'First - 1;
 | 
			
		||||
		else
 | 
			
		||||
			if Avail > Data'Length then
 | 
			
		||||
				Avail := Data'Length;
 | 
			
		||||
			end if;
 | 
			
		||||
 | 
			
		||||
			Data(Data'First .. Avail) := Stream.Str(Stream.Pos + 1..Stream.Pos + Avail);
 | 
			
		||||
			Stream.Pos := Stream.Pos + Avail;
 | 
			
		||||
			Last := Data'First + Avail - 1;
 | 
			
		||||
		end if;
 | 
			
		||||
	end Read;
 | 
			
		||||
 | 
			
		||||
	procedure Write (Stream: in out String_Input_Stream_Record;
 | 
			
		||||
	                 Data:   out    S.Object_Character_Array;
 | 
			
		||||
	                 Last:   out    S.Object_Size) is
 | 
			
		||||
	begin
 | 
			
		||||
		--raise S.Stream_Error;
 | 
			
		||||
		Last := Data'First - 1;
 | 
			
		||||
	end Write;
 | 
			
		||||
 | 
			
		||||
	------------------------------------------------------------------
 | 
			
		||||
 | 
			
		||||
	procedure Open (Stream: in out File_Stream_Record) is
 | 
			
		||||
	begin
 | 
			
		||||
Ada.Text_IO.Put_Line (">>>>> OPEN WIDE FILE STREAM <<<<< " & Standard.String(Utf8.From_Unicode_String(Utf8.Unicode_String(Stream.Name.all))));
 | 
			
		||||
		--Ada.Wide_Text_IO.Open (Stream.Handle, Ada.Wide_Text_IO.In_File, Ada.Characters.Conversions.To_String(Standard.Wide_String(Stream.Name.all)));
 | 
			
		||||
		Ada.Wide_Text_IO.Open (Stream.Handle, Ada.Wide_Text_IO.In_File, Standard.String(Utf8.From_Unicode_String(Utf8.Unicode_String(Stream.Name.all))));
 | 
			
		||||
	end Open;
 | 
			
		||||
 | 
			
		||||
	procedure Close (Stream: in out File_Stream_Record) is
 | 
			
		||||
		subtype Wide_String is Standard.Wide_String(1 .. Standard.Natural(Stream.Name'Length));
 | 
			
		||||
		function To_Wide_String is new Ada.Unchecked_Conversion (S.Object_Character_Array, Wide_String);
 | 
			
		||||
	begin
 | 
			
		||||
--Ada.Wide_Text_IO.Put_Line (">>>>> CLOSE File STREAM <<<<< " & Standard.Wide_String(Stream.Name.all));
 | 
			
		||||
Ada.Text_IO.Put_Line (">>>>> CLOSE WIDE FILE STREAM <<<<< " & Standard.String(Utf8.From_Unicode_String(Utf8.Unicode_String(Stream.Name.all))));
 | 
			
		||||
begin
 | 
			
		||||
	ada.wide_text_io.put_line (">> " & Standard.Wide_String(Utf8.To_Unicode_String(Utf8.From_Unicode_String(Utf8.Unicode_String(Stream.Name.all)))));
 | 
			
		||||
exception
 | 
			
		||||
	when Ex: others =>
 | 
			
		||||
		ada.text_io.put_line ("fuck - " & Ada.Exceptions.Exception_Name(Ex) & Ada.Exceptions.Exception_Information(Ex));
 | 
			
		||||
end;
 | 
			
		||||
ada.text_io.put_line (">>");
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
		Ada.Wide_Text_IO.Close (Stream.Handle);
 | 
			
		||||
	end Close;
 | 
			
		||||
 | 
			
		||||
	procedure Read (Stream: in out File_Stream_Record;
 | 
			
		||||
	                Data:   out    S.Object_Character_Array;
 | 
			
		||||
	                Last:   out    S.Object_Size) is
 | 
			
		||||
	begin
 | 
			
		||||
		for I in Data'First .. Data'Last loop
 | 
			
		||||
			begin
 | 
			
		||||
				if Ada.Wide_Text_IO.End_Of_File (Stream.Handle) then
 | 
			
		||||
					Last := I - 1;
 | 
			
		||||
					return;
 | 
			
		||||
				end if;
 | 
			
		||||
				Ada.Wide_Text_IO.Get_Immediate (Stream.Handle, Data(I));
 | 
			
		||||
			exception
 | 
			
		||||
				when Ada.Wide_Text_IO.End_Error =>
 | 
			
		||||
					Last := I - 1;
 | 
			
		||||
					return;
 | 
			
		||||
				-- other exceptions must be just raised to indicate errors
 | 
			
		||||
			end;
 | 
			
		||||
		end loop;
 | 
			
		||||
		Last := Data'Last;
 | 
			
		||||
	end Read;
 | 
			
		||||
 | 
			
		||||
	procedure Write (Stream: in out File_Stream_Record;
 | 
			
		||||
	                 Data:   out    S.Object_Character_Array;
 | 
			
		||||
	                 Last:   out    S.Object_Size) is
 | 
			
		||||
	begin
 | 
			
		||||
		--raise S.Stream_Error;
 | 
			
		||||
		Last := Data'First - 1;
 | 
			
		||||
	end Write;
 | 
			
		||||
 | 
			
		||||
	------------------------------------------------------------------
 | 
			
		||||
 | 
			
		||||
	procedure Allocate_Stream (Interp: in out S.Interpreter_Record;
 | 
			
		||||
	                           Name:   access S.Object_Character_Array;
 | 
			
		||||
	                           Result: out    S.Stream_Pointer) is
 | 
			
		||||
		subtype FSR is File_Stream_Record;
 | 
			
		||||
		type FSP is access all FSR;
 | 
			
		||||
		package P is new H2.Pool (FSR, FSP);
 | 
			
		||||
 | 
			
		||||
		X: FSP;
 | 
			
		||||
		for X'Address use Result'Address;
 | 
			
		||||
		pragma Import (Ada, X);
 | 
			
		||||
	begin
 | 
			
		||||
		X := P.Allocate (S.Get_Storage_Pool(Interp));
 | 
			
		||||
		X.Name := S.Constant_Object_Character_Array_Pointer(Name);
 | 
			
		||||
	end Allocate_Stream;
 | 
			
		||||
 | 
			
		||||
	procedure Deallocate_Stream (Interp: in out S.Interpreter_Record;
 | 
			
		||||
	                             Source: in out S.Stream_Pointer) is
 | 
			
		||||
		subtype FSR is File_Stream_Record;
 | 
			
		||||
		type FSP is access all FSR;
 | 
			
		||||
		package P is new H2.Pool (FSR, FSP);
 | 
			
		||||
 | 
			
		||||
		X: FSP;
 | 
			
		||||
		for X'Address use Source'Address;
 | 
			
		||||
		pragma Import (Ada, X);
 | 
			
		||||
	begin
 | 
			
		||||
		P.Deallocate (X, S.Get_Storage_Pool(Interp));
 | 
			
		||||
	end Deallocate_Stream;
 | 
			
		||||
end Wide_Stream;
 | 
			
		||||
							
								
								
									
										55
									
								
								bin/wide_stream.ads
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										55
									
								
								bin/wide_stream.ads
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,55 @@
 | 
			
		||||
with H2.Wide;
 | 
			
		||||
with Ada.Wide_Text_IO;
 | 
			
		||||
 | 
			
		||||
package Wide_Stream is
 | 
			
		||||
 | 
			
		||||
	package S renames H2.Wide.Scheme;
 | 
			
		||||
 | 
			
		||||
	------------------------------------------------------------
 | 
			
		||||
	--type Object_Character_Array_Pointer is access all S.Object_Character_Array;
 | 
			
		||||
	type Object_Character_Array_Pointer is access constant S.Object_Character_Array;
 | 
			
		||||
	type String_Input_Stream_Record(Str: Object_Character_Array_Pointer) is new S.Stream_Record with record
 | 
			
		||||
		Pos: S.Object_Size := 0;	
 | 
			
		||||
	end record;
 | 
			
		||||
 | 
			
		||||
	procedure Open (Stream: in out String_Input_Stream_Record);
 | 
			
		||||
	procedure Close (Stream: in out String_Input_Stream_Record);
 | 
			
		||||
	procedure Read (Stream: in out String_Input_Stream_Record;
 | 
			
		||||
	                Data:   out    S.Object_Character_Array;
 | 
			
		||||
	                Last:   out    S.Object_Size);
 | 
			
		||||
	procedure Write (Stream: in out String_Input_Stream_Record;
 | 
			
		||||
	                 Data:   out    S.Object_Character_Array;
 | 
			
		||||
	                 Last:   out    S.Object_Size);
 | 
			
		||||
 | 
			
		||||
	------------------------------------------------------------
 | 
			
		||||
 | 
			
		||||
	type File_Stream_Record is new S.Stream_Record with record
 | 
			
		||||
		Name:   S.Constant_Object_Character_Array_Pointer;
 | 
			
		||||
		Handle: Ada.Wide_Text_IO.File_Type;
 | 
			
		||||
	end record;
 | 
			
		||||
 | 
			
		||||
	procedure Open (Stream: in out File_Stream_Record);
 | 
			
		||||
	procedure Close (Stream: in out File_Stream_Record);
 | 
			
		||||
	procedure Read (Stream: in out File_Stream_Record;
 | 
			
		||||
	                Data:   out    S.Object_Character_Array;
 | 
			
		||||
	                Last:   out    S.Object_Size);
 | 
			
		||||
	procedure Write (Stream: in out File_Stream_Record;
 | 
			
		||||
	                 Data:   out    S.Object_Character_Array;
 | 
			
		||||
	                 Last:   out    S.Object_Size);
 | 
			
		||||
 | 
			
		||||
	------------------------------------------------------------
 | 
			
		||||
	procedure Allocate_Stream (Interp: in out S.Interpreter_Record;
 | 
			
		||||
	                           Name:   access S.Object_Character_Array;
 | 
			
		||||
	                           Result: out    S.Stream_Pointer);
 | 
			
		||||
 | 
			
		||||
	procedure Deallocate_Stream (Interp: in out S.Interpreter_Record;
 | 
			
		||||
	                             Source: in out S.Stream_Pointer);
 | 
			
		||||
 | 
			
		||||
--private
 | 
			
		||||
--	type File_Stream_Record is new S.Stream_Record with record
 | 
			
		||||
--		Name:   S.Constant_Object_Character_Array_Pointer;
 | 
			
		||||
--		Handle: Ada.Wide_Text_IO.File_Type;
 | 
			
		||||
--	end record;
 | 
			
		||||
 | 
			
		||||
end Wide_Stream;
 | 
			
		||||
 | 
			
		||||
		Reference in New Issue
	
	Block a user