hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

added some file io routines

Browse Source
This commit is contained in:
hyung-hwan
2014-06-04 17:15:52 +00:00
parent 9c971cd841
commit 744915575f
23 changed files with 5785 additions and 328 deletions
Download Patch File Download Diff File Expand all files Collapse all files

51
lib/Makefile.am Normal file
View File

@ -0,0 +1,51 @@
AUTOMAKE_OPTIONS = nostdinc
EXTRA_DIST = \
h2.ads \
h2-pool.ads \
h2-pool.adb \
h2-ascii.ads \
h2-utf8.ads \
h2-utf8.adb \
h2-sysapi.ads \
h2-sysapi.adb \
posix/h2-sysapi-file.adb \
h2-io.ads \
h2-io.adb \
h2-io-file.adb \
h2-scheme.ads \
h2-scheme.adb \
h2-scheme-bigint.adb \
h2-scheme-token.adb \
h2-scheme-execute.adb \
h2-scheme-execute-apply.adb \
h2-scheme-execute-evaluate.adb \
h2-slim.ads \
h2-wide.ads \
h2-wide_wide.ads
noinst_PROGRAMS = sysdef
sysdef_SOURCES = posix/sysdef.c
sysdef_CPPFLAGS =
sysdef_LDFLAGS =
sysdef_LDADD =
all-local: libh2.so
libh2.so: @abs_builddir@/@ADA_OBJDIR@ @abs_builddir@/posix/h2-sysdef.ads
gprbuild @abs_builddir@/lib.gpr
@abs_builddir@/@ADA_OBJDIR@:
mkdir -p @abs_builddir@/@ADA_OBJDIR@
# cross-compiling will fail for this.
@abs_builddir@/posix/h2-sysdef.ads: @abs_builddir@/sysdef
mkdir -p @abs_builddir@/posix
@abs_builddir@/sysdef H2.Sysdef > @abs_builddir@/posix/h2-sysdef.ads
clean-local:
gprclean -P@abs_builddir@/lib.gpr
rm -f @abs_builddir@/posix/h2-sysdef.ads

589
lib/Makefile.in
View File

@ -1,83 +1,520 @@
all: @abs_builddir@/@ADA_OBJDIR@
#gnatmake -x -aP@abs_builddir@ -Plib
# Makefile.in generated by automake 1.11.6 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
# 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 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__make_dryrun = \
{ \
am__dry=no; \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
echo 'am--echo: ; @echo "AM" OK' | $(MAKE) -f - 2>/dev/null \
| grep '^AM OK$$' >/dev/null || am__dry=yes;; \
*) \
for am__flg in $$MAKEFLAGS; do \
case $$am__flg in \
*=*|--*) ;; \
*n*) am__dry=yes; break;; \
esac; \
done;; \
esac; \
test $$am__dry = yes; \
}
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 = :
noinst_PROGRAMS = sysdef$(EXEEXT)
subdir = lib
DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in \
$(srcdir)/config.h.in $(srcdir)/lib.gpr.in \
$(srcdir)/libh2.gpr.in
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_HEADER = config.h
CONFIG_CLEAN_FILES = lib.gpr libh2.gpr
CONFIG_CLEAN_VPATH_FILES =
PROGRAMS = $(noinst_PROGRAMS)
am_sysdef_OBJECTS = sysdef-sysdef.$(OBJEXT)
sysdef_OBJECTS = $(am_sysdef_OBJECTS)
sysdef_DEPENDENCIES =
sysdef_LINK = $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(sysdef_LDFLAGS) \
$(LDFLAGS) -o $@
DEFAULT_INCLUDES =
depcomp = $(SHELL) $(top_srcdir)/ac/depcomp
am__depfiles_maybe = depfiles
am__mv = mv -f
COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
CCLD = $(CC)
LINK = $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
SOURCES = $(sysdef_SOURCES)
DIST_SOURCES = $(sysdef_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
ETAGS = etags
CTAGS = ctags
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
ADA_OBJDIR = @ADA_OBJDIR@
AMTAR = @AMTAR@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EXEEXT = @EXEEXT@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LTLIBOBJS = @LTLIBOBJS@
MAKEINFO = @MAKEINFO@
MKDIR_P = @MKDIR_P@
OBJEXT = @OBJEXT@
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@
PATH_SEPARATOR = @PATH_SEPARATOR@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_CC = @ac_ct_CC@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build_alias = @build_alias@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host_alias = @host_alias@
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 = \
h2.ads \
h2-pool.ads \
h2-pool.adb \
h2-ascii.ads \
h2-utf8.ads \
h2-utf8.adb \
h2-sysapi.ads \
h2-sysapi.adb \
posix/h2-sysapi-file.adb \
h2-io.ads \
h2-io.adb \
h2-io-file.adb \
h2-scheme.ads \
h2-scheme.adb \
h2-scheme-bigint.adb \
h2-scheme-token.adb \
h2-scheme-execute.adb \
h2-scheme-execute-apply.adb \
h2-scheme-execute-evaluate.adb \
h2-slim.ads \
h2-wide.ads \
h2-wide_wide.ads
sysdef_SOURCES = posix/sysdef.c
sysdef_CPPFLAGS =
sysdef_LDFLAGS =
sysdef_LDADD =
all: config.h
$(MAKE) $(AM_MAKEFLAGS) all-am
.SUFFIXES:
.SUFFIXES: .c .o .obj
$(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 lib/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign lib/Makefile
.PRECIOUS: 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__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
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):
config.h: stamp-h1
@if test ! -f $@; then rm -f stamp-h1; else :; fi
@if test ! -f $@; then $(MAKE) $(AM_MAKEFLAGS) stamp-h1; else :; fi
stamp-h1: $(srcdir)/config.h.in $(top_builddir)/config.status
@rm -f stamp-h1
cd $(top_builddir) && $(SHELL) ./config.status lib/config.h
$(srcdir)/config.h.in: $(am__configure_deps)
($(am__cd) $(top_srcdir) && $(AUTOHEADER))
rm -f stamp-h1
touch $@
distclean-hdr:
-rm -f config.h stamp-h1
lib.gpr: $(top_builddir)/config.status $(srcdir)/lib.gpr.in
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@
libh2.gpr: $(top_builddir)/config.status $(srcdir)/libh2.gpr.in
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@
clean-noinstPROGRAMS:
-test -z "$(noinst_PROGRAMS)" || rm -f $(noinst_PROGRAMS)
sysdef$(EXEEXT): $(sysdef_OBJECTS) $(sysdef_DEPENDENCIES) $(EXTRA_sysdef_DEPENDENCIES)
@rm -f sysdef$(EXEEXT)
$(sysdef_LINK) $(sysdef_OBJECTS) $(sysdef_LDADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sysdef-sysdef.Po@am__quote@
.c.o:
@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(COMPILE) -c $<
.c.obj:
@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'`
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(COMPILE) -c `$(CYGPATH_W) '$<'`
sysdef-sysdef.o: posix/sysdef.c
@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(sysdef_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT sysdef-sysdef.o -MD -MP -MF $(DEPDIR)/sysdef-sysdef.Tpo -c -o sysdef-sysdef.o `test -f 'posix/sysdef.c' || echo '$(srcdir)/'`posix/sysdef.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/sysdef-sysdef.Tpo $(DEPDIR)/sysdef-sysdef.Po
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='posix/sysdef.c' object='sysdef-sysdef.o' libtool=no @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(sysdef_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sysdef-sysdef.o `test -f 'posix/sysdef.c' || echo '$(srcdir)/'`posix/sysdef.c
sysdef-sysdef.obj: posix/sysdef.c
@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(sysdef_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT sysdef-sysdef.obj -MD -MP -MF $(DEPDIR)/sysdef-sysdef.Tpo -c -o sysdef-sysdef.obj `if test -f 'posix/sysdef.c'; then $(CYGPATH_W) 'posix/sysdef.c'; else $(CYGPATH_W) '$(srcdir)/posix/sysdef.c'; fi`
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/sysdef-sysdef.Tpo $(DEPDIR)/sysdef-sysdef.Po
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='posix/sysdef.c' object='sysdef-sysdef.obj' libtool=no @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(sysdef_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sysdef-sysdef.obj `if test -f 'posix/sysdef.c'; then $(CYGPATH_W) 'posix/sysdef.c'; else $(CYGPATH_W) '$(srcdir)/posix/sysdef.c'; fi`
ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | \
$(AWK) '{ files[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in files) print i; }; }'`; \
mkid -fID $$unique
tags: TAGS
TAGS: $(HEADERS) $(SOURCES) config.h.in $(TAGS_DEPENDENCIES) \
$(TAGS_FILES) $(LISP)
set x; \
here=`pwd`; \
list='$(SOURCES) $(HEADERS) config.h.in $(LISP) $(TAGS_FILES)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | \
$(AWK) '{ files[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in files) print i; }; }'`; \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: CTAGS
CTAGS: $(HEADERS) $(SOURCES) config.h.in $(TAGS_DEPENDENCIES) \
$(TAGS_FILES) $(LISP)
list='$(SOURCES) $(HEADERS) config.h.in $(LISP) $(TAGS_FILES)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | \
$(AWK) '{ files[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in files) print i; }; }'`; \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
distdir: $(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 $(PROGRAMS) config.h 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-local clean-noinstPROGRAMS \
mostlyclean-am
distclean: distclean-am
-rm -rf ./$(DEPDIR)
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-hdr distclean-tags
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 -rf ./$(DEPDIR)
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: all install-am install-strip
.PHONY: CTAGS GTAGS all all-am all-local check check-am clean \
clean-generic clean-local clean-noinstPROGRAMS ctags distclean \
distclean-compile distclean-generic distclean-hdr \
distclean-tags 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-compile mostlyclean-generic pdf pdf-am ps ps-am \
tags uninstall uninstall-am
all-local: libh2.so
libh2.so: @abs_builddir@/@ADA_OBJDIR@ @abs_builddir@/posix/h2-sysdef.ads
gprbuild @abs_builddir@/lib.gpr
install: install-exec install-data
install-data:
install-exec:
uninstall:
@abs_builddir@/@ADA_OBJDIR@:
mkdir -p @abs_builddir@/@ADA_OBJDIR@
clean:
rm -rf @abs_builddir@/@ADA_OBJDIR@
rm -f @abs_builddir@/*.ali
rm -f @abs_builddir@/*.so
rm -f @abs_builddir@/*.a
rm -f @abs_builddir@/*.cgpr
# cross-compiling will fail for this.
@abs_builddir@/posix/h2-sysdef.ads: @abs_builddir@/sysdef
mkdir -p @abs_builddir@/posix
@abs_builddir@/sysdef H2.Sysdef > @abs_builddir@/posix/h2-sysdef.ads
distclean: clean
ADAC := $(CC)
ADAFLAGS := -x ada -gnatA -fPIC -gnata -gnato -gnatN -gnatwl -lgnat95 -gnatW8 -g
BINDFLAGS := -x -shared -n -Lh2
SRCS := h2.ads h2-ascii.ads h2-pool.adb h2-scheme.adb h2-utf8.adb h2-wide.ads
ALIS := $(patsubst %.ads,%.ali,$(patsubst %.adb,%.ali,$(SRCS)))
OBJS := $(ALIS:.ali=.o)
BINDALI := b~h2.adb
libh2: $(ALIS) $(BINDALI)
gnatbind ${BINDFLAGS} -o b~h2.adb $(ALIS)
$(ADAC) ${ADAFLAGS} -c b~h2.adb
$(LD) -shared -o libh2.so $(OBJS) b~h2.o -L. -lgnat
# gcc -c -x ada ${ADAFLAGS} ../../lib/h2.ads
# gcc -c -x ada ${ADAFLAGS} ../../lib/h2-ascii.ads
# gcc -c -x ada ${ADAFLAGS} ../../lib/h2-pool.adb
# gcc -c -x ada ${ADAFLAGS} ../../lib/h2-scheme.adb
# gcc -c -x ada ${ADAFLAGS} ../../lib/h2-utf8.adb
# gcc -c -x ada ${ADAFLAGS} ../../lib/h2-wide.ads
# gnatbind ${BINDFLAGS} -o b~h2.adb -n -Lh2 h2.ali h2-ascii.ali h2-pool.ali h2-scheme.ali h2-utf8.ali h2-wide.ali
# #gnatbind ${BINDFLAGS} -C -o b~h2.c -n -Lh2 h2.ali h2-scheme.ali h2-pool.ali #for a show
# gcc -c -x ada ${ADAFLAGS} b~h2.adb
# gcc -shared -o libh2.so h2.o h2-ascii.o h2-pool.o h2-scheme.o h2-utf8.o h2-wide.o b~h2.o -L. -lgnat
# #gnatlink -v -v -olibh2.so h2
#h2cmd:
# gcc -c -x ada ${ADAFLAGS} -I../../lib ../../cmd/storage.adb
# gcc -c -x ada ${ADAFLAGS} -I../../lib ../../cmd/stream.adb
# gcc -c -x ada ${ADAFLAGS} -I../../lib ../../cmd/scheme.adb
# gnatbind ${BINDFLAGS} -o b~scheme.adb scheme.ali storage.ali #-I- -I. -O
# gcc -c -x ada ${ADAFLAGS} b~scheme.adb
# gcc -oh2scm b~scheme.o storage.o stream.o scheme.o -L. -lh2 -Wl,-rpath=. #-lgnat-4.1
# #gnatlink -v -v -o h2scm scheme
# #/usr/bin/gnatbind -x -shared -o b__scheme.adb ./scheme.ali ./storage.ali -I- -I. -I../lib/objdir -O
# #gcc -c -x ada -gnatA -gnata -gnato -gnatN -gnatwl -c -gnatA -gnatWb -gnatiw -gnatws b__scheme.adb -o b__scheme.o
# #gcc -oh2scm scheme.o b__scheme.o storage.o -shared-libgcc -L../lib -lh2 -Wl,-rpath=../lib -L -lgna
#.SUFFIXES: .ads .adb .ali
#.ads.ali:
# gcc -c -x ada ${ADAFLAGS} @abs_srcdir@/$<
#
#.adb.ali:
# gcc -c -x ada ${ADAFLAGS} @abs_srcdir@/$<
$(BINDALI):
%.ali: @abs_srcdir@/%.adb
$(ADAC) ${ADAFLAGS} -c $<
%.ali: @abs_srcdir@/%.ads
$(ADAC) ${ADAFLAGS} -c $<
clean-local:
gprclean -P@abs_builddir@/lib.gpr
rm -f @abs_builddir@/posix/h2-sysdef.ads
# 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:

62
lib/h2-io-file.adb Normal file
View File

@ -0,0 +1,62 @@
separate (H2.IO)
package body File is
procedure Open (File: in out File_Record;
Name: in Slim_String;
Flag: in Flag_Record;
Pool: in Storage_Pool_Pointer := null) is
begin
Sysapi.File.Open (File.File, Name, flag, Pool => Pool);
end Open;
procedure Open (File: in out File_Record;
Name: in Wide_String;
Flag: in Flag_Record;
Pool: in Storage_Pool_Pointer := null) is
begin
Sysapi.File.Open (File.File, Name, flag, Pool => Pool);
end Open;
procedure Close (File: in out File_Record) is
begin
Sysapi.File.Close (File.File);
File.File := null;
File.Last := System_Length'First;
end Close;
procedure Read (File: in out File_Record;
Buffer: in out Slim_String;
Last: out System_Length) is
begin
null;
end Read;
procedure Read (File: in out File_Record;
Buffer: in out Wide_String;
Last: out System_Length) is
begin
null;
end Read;
procedure Write (File: in out File_Record;
Buffer: in Slim_String;
Last: out System_Length) is
begin
null;
end Write;
procedure Write (File: in out File_Record;
Buffer: in Wide_String;
Last: out System_Length) is
begin
null;
end Write;
procedure Flush (File: in out File_Record) is
begin
null;
end Flush;
end File;

5
lib/h2-io.adb Normal file
View File

@ -0,0 +1,5 @@
package body H2.IO is
package body File is separate;
end H2.IO;

68
lib/h2-io.ads Normal file
View File

@ -0,0 +1,68 @@
with H2.Sysapi;
generic
type Slim_Character is (<>);
type Wide_Character is (<>);
type Slim_String is array(System_Index range<>) of Slim_Character;
type Wide_String is array(System_Index range<>) of Wide_Character;
with function Slim_To_Wide (Slim: in Slim_String) return Wide_String;
with function Wide_To_Slim (Wide: in Wide_String) return Slim_String;
package H2.IO is
package Sysapi is new H2.Sysapi (Slim_Character, Wide_Character, Slim_String, Wide_String, Slim_To_Wide, Wide_To_Slim);
package File is
subtype Flag_Record is Sysapi.File.Flag_Record;
FLAG_READ: constant := Sysapi.File.FLAG_READ;
FLAG_WRITE: constant := Sysapi.File.FLAG_WRITE;
FLAG_CREATE: constant := Sysapi.File.FLAG_CREATE;
FLAG_EXCLUSIVE: constant := Sysapi.File.FLAG_EXCLUSIVE;
FLAG_TRUNCATE: constant := Sysapi.File.FLAG_TRUNCATE;
FLAG_APPEND: constant := Sysapi.File.FLAG_APPEND;
FLAG_NONBLOCK: constant := Sysapi.File.FLAG_NONBLOCK;
FLAG_SYNC: constant := Sysapi.File.FLAG_SYNC;
FLAG_NOFOLLOW: constant := Sysapi.File.FLAG_NOFOLLOW;
type File_Record is limited record
File: Sysapi.File.File_Pointer := null;
Buffer: System_Byte_Array (1 .. 2048);
Last: System_Length := System_Length'First;
end record;
procedure Open (File: in out File_Record;
Name: in Slim_String;
Flag: in Flag_Record;
Pool: in Storage_Pool_Pointer := null);
procedure Open (File: in out File_Record;
Name: in Wide_String;
Flag: in Flag_Record;
Pool: in Storage_Pool_Pointer := null);
procedure Close (File: in out File_Record);
procedure Read (File: in out File_Record;
Buffer: in out Slim_String;
Last: out System_Length);
procedure Read (File: in out File_Record;
Buffer: in out Wide_String;
Last: out System_Length);
procedure Write (File: in out File_Record;
Buffer: in Slim_String;
Last: out System_Length);
procedure Write (File: in out File_Record;
Buffer: in Wide_String;
Last: out System_Length);
procedure Flush (File: in out File_Record);
end File;
end H2.IO;

4
lib/h2-sysapi.adb
View File

@ -2,12 +2,12 @@ package body H2.Sysapi is
package body File is separate;
procedure Set_File_Flag_Bits (Flag: in out File_Flag; Bits: in File_Flag_Bits) is
procedure Set_File_Flag_Bits (Flag: in out File_Flag_Record; Bits: in File_Flag_Bits) is
begin
Flag.Bits := Flag.Bits or Bits;
end Set_File_Flag_Bits;
procedure Clear_File_Flag_Bits (Flag: in out File_Flag; Bits: in File_Flag_Bits) is
procedure Clear_File_Flag_Bits (Flag: in out File_Flag_Record; Bits: in File_Flag_Bits) is
begin
Flag.Bits := Flag.Bits and not Bits;
end Clear_File_Flag_Bits;

99
lib/h2-sysapi.ads
View File

@ -9,65 +9,90 @@ generic
package H2.Sysapi is
type File_Record is tagged null record;
type File_Pointer is access all File_Record'Class;
type File_Flag_Bits is new System_Word;
type File_Flag is record
type File_Flag_Record is record
Bits: File_Flag_Bits := 0;
end record;
type File_Mode_Bits is new System_Word;
type File_Mode is record
type File_Mode_Record is record
Bits: File_Mode_Bits := 0;
end record;
FILE_FLAG_READ: constant File_Flag_Bits := 2#0000_0000_0000_0001#;
FILE_FLAG_WRITE: constant File_Flag_Bits := 2#0000_0000_0000_0010#;
FILE_FLAG_CREATE: constant File_Flag_Bits := 2#0000_0000_0000_0100#;
FILE_FLAG_EXCLUSIVE: constant File_Flag_Bits := 2#0000_0000_0000_1000#;
FILE_FLAG_TRUNCATE: constant File_Flag_Bits := 2#0000_0000_0001_0000#;
FILE_FLAG_APPEND: constant File_Flag_Bits := 2#0000_0000_0010_0000#;
FILE_FLAG_NONBLOCK: constant File_Flag_Bits := 2#0000_0000_0100_0000#;
FILE_FLAG_SYNC: constant File_Flag_Bits := 2#0000_0000_1000_0000#;
FILE_FLAG_NOFOLLOW: constant File_Flag_Bits := 2#0000_0001_0000_0000#;
-- FILE_FLAG_NOSHREAD: constant File_Flag_Bits := 2#0010_0000_0000_0000#;
-- FILE_FLAG_NOSHWRITE: constant File_Flag_Bits := 2#0100_0000_0000_0000#;
-- FILE_FLAG_NOSHDELETE: constant File_Flag_Bits := 2#1000_0000_0000_0000#;
FILE_MODE_OWNER_READ: constant File_Mode_Bits := 2#100_000_000#;
FILE_MODE_OWNER_WRITE: constant File_Mode_Bits := 2#010_000_000#;
FILE_MODE_OWNER_EXEC: constant File_Mode_Bits := 2#001_000_000#;
FILE_MODE_GROUP_READ: constant File_Mode_Bits := 2#000_100_000#;
FILE_MODE_GROUP_WRITE: constant File_Mode_Bits := 2#000_010_000#;
FILE_MODE_GROUP_EXEC: constant File_Mode_Bits := 2#000_001_000#;
FILE_MODE_OTHER_READ: constant File_Mode_Bits := 2#000_000_100#;
FILE_MODE_OTHER_WRITE: constant File_Mode_Bits := 2#000_000_010#;
FILE_MODE_OTHER_EXEC: constant File_Mode_Bits := 2#000_000_001#;
DEFAULT_FILE_MODE: constant File_Mode := ( Bits => 2#110_100_100# );
procedure Set_File_Flag_Bits (Flag: in out File_Flag; Bits: in File_Flag_Bits);
procedure Clear_File_Flag_Bits (Flag: in out File_Flag; Bits: in File_Flag_Bits);
procedure Set_File_Flag_Bits (Flag: in out File_Flag_Record; Bits: in File_Flag_Bits);
procedure Clear_File_Flag_Bits (Flag: in out File_Flag_Record; Bits: in File_Flag_Bits);
package File is
--type Handle_Record is tagged null record;
--type Handle_Pointer is access all Handle_Record'Class;
type File_Record is tagged null record;
type File_Pointer is access all File_Record'Class;
subtype Flag_Bits is Sysapi.File_Flag_Bits;
subtype Mode_Bits is Sysapi.File_Mode_Bits;
subtype Flag_Record is Sysapi.File_Flag_Record;
subtype Mode_Record is Sysapi.File_Mode_Record;
FLAG_READ: constant Flag_Bits := 2#0000_0000_0000_0001#;
FLAG_WRITE: constant Flag_Bits := 2#0000_0000_0000_0010#;
FLAG_CREATE: constant Flag_Bits := 2#0000_0000_0000_0100#;
FLAG_EXCLUSIVE: constant Flag_Bits := 2#0000_0000_0000_1000#;
FLAG_TRUNCATE: constant Flag_Bits := 2#0000_0000_0001_0000#;
FLAG_APPEND: constant Flag_Bits := 2#0000_0000_0010_0000#;
FLAG_NONBLOCK: constant Flag_Bits := 2#0000_0000_0100_0000#;
FLAG_SYNC: constant Flag_Bits := 2#0000_0000_1000_0000#;
FLAG_NOFOLLOW: constant Flag_Bits := 2#0000_0001_0000_0000#;
-- FLAG_NOSHREAD: constant Flag_Bits := 2#0010_0000_0000_0000#;
-- FLAG_NOSHWRITE: constant Flag_Bits := 2#0100_0000_0000_0000#;
-- FLAG_NOSHDELETE: constant Flag_Bits := 2#1000_0000_0000_0000#;
MODE_OWNER_READ: constant Mode_Bits := 2#100_000_000#;
MODE_OWNER_WRITE: constant Mode_Bits := 2#010_000_000#;
MODE_OWNER_EXEC: constant Mode_Bits := 2#001_000_000#;
MODE_GROUP_READ: constant Mode_Bits := 2#000_100_000#;
MODE_GROUP_WRITE: constant Mode_Bits := 2#000_010_000#;
MODE_GROUP_EXEC: constant Mode_Bits := 2#000_001_000#;
MODE_OTHER_READ: constant Mode_Bits := 2#000_000_100#;
MODE_OTHER_WRITE: constant Mode_Bits := 2#000_000_010#;
MODE_OTHER_EXEC: constant Mode_Bits := 2#000_000_001#;
DEFAULT_MODE: constant Mode_Record := ( Bits => 2#110_100_100# );
procedure Set_Flag_Bits (Flag: in out Flag_Record;
Bits: in Flag_Bits) renames Sysapi.Set_File_Flag_Bits;
procedure Clear_Flag_Bits (Flag: in out Flag_Record;
Bits: in Flag_Bits) renames Sysapi.Clear_File_Flag_Bits;
function Get_Stdin return File_Pointer;
function Get_Stdout return File_Pointer;
function Get_Stderr return File_Pointer;
procedure Open (File: out File_Pointer;
Name: in Slim_String;
Flag: in File_Flag;
Mode: in File_Mode := DEFAULT_FILE_MODE;
Flag: in Flag_Record;
Mode: in Mode_Record := DEFAULT_MODE;
Pool: in Storage_Pool_Pointer := null);
procedure Open (File: out File_Pointer;
Name: in Wide_String;
Flag: in File_Flag;
Mode: in File_Mode := DEFAULT_FILE_MODE;
Flag: in Flag_Record;
Mode: in Mode_Record := DEFAULT_MODE;
Pool: in Storage_Pool_Pointer := null);
procedure Close (File: in out File_Pointer);
procedure Read (File: in File_Pointer;
Buffer: in out System_Byte_Array;
Last: out System_Length);
procedure Write (File: in File_Pointer;
Buffer: in System_Byte_Array;
Last: out System_Length);
pragma Inline (Get_Stdin);
pragma Inline (Get_Stdout);
pragma Inline (Get_Stderr);
end File;
--procedure Open_File (File: out File_Pointer;

16
lib/h2.ads
View File

@ -7,8 +7,8 @@ package H2 is
System_Word_Bits: constant := System.Word_Size;
System_Word_Bytes: constant := System_Word_Bits / System.Storage_Unit;
--type System_Byte is mod 2 ** System.Storage_Unit;
--for System_Byte'Size use System.Storage_Unit;
type System_Byte is mod 2 ** System.Storage_Unit;
for System_Byte'Size use System.Storage_Unit;
type System_Word is mod 2 ** System_Word_Bits;
--for System_Word'Size use System_Word_Bits;
@ -25,15 +25,7 @@ package H2 is
access all System.Storage_Pools.Root_Storage_Pool'Class;
-- TODO: move this to H2.XXXX???
type File_Record is tagged null record;
type File_Pointer is access all File_Record'Class;
type Flag_Record is record
x: integer;
end record;
type Mode_Record is record
x: integer;
end record;
type System_Byte_Array is array(System_Index range<>) of System_Byte;
end H2;

9
lib/lib.gpr.in
View File

@ -2,7 +2,8 @@ project Lib is
for Source_Dirs use (
"@abs_srcdir@",
"@abs_srcdir@/posix"
"@abs_srcdir@/posix",
"@abs_builddir@/posix"
);
for Library_Name use "h2";
for Library_Kind use "dynamic";
@ -12,9 +13,13 @@ project Lib is
for Source_Files use (
"h2.ads",
"h2-sysdef.ads",
"h2-ascii.ads",
"h2-pool.adb",
"h2-pool.ads",
"h2-io.ads",
"h2-io.adb",
"h2-io-file.adb",
"h2-scheme.adb",
"h2-scheme.ads",
"h2-scheme-bigint.adb",
@ -34,10 +39,12 @@ project Lib is
for Library_Interface use (
"h2",
"h2.ascii",
"h2.io",
"h2.pool",
"h2.scheme",
"h2.slim",
"h2.sysapi",
"h2.sysdef",
"h2.utf8",
"h2.wide",
"h2.wide_wide"

146
lib/posix/h2-sysapi-file.adb
View File

@ -1,45 +1,89 @@
with Interfaces.C;
with H2.Pool;
with H2.Sysdef;
separate (H2.Sysapi)
package body File is
package C renames Interfaces.C;
use type C.int;
-- External functions and procedures
function Sys_Open (path: Slim_String; flags: Sysdef.int_t; mode: Sysdef.int_t) return Sysdef.int_t;
pragma Import (C, Sys_Open, "open");
--function sys_open (path: ; flags: C.int; mode: C.int) return C.int;
function sys_open (path: Slim_String; flags: C.int; mode: C.int) return C.int;
pragma Import (C, sys_open, "open");
procedure sys_close (fd: C.int);
procedure Sys_Close (fd: Sysdef.int_t);
pragma Import (C, sys_close, "close");
INVALID_HANDLE: constant C.int := -1;
function Sys_Read (fd: Sysdef.int_t; buf: in System.Address; count: in Sysdef.size_t) return Sysdef.ssize_t;
pragma Import (C, Sys_Read, "read");
function Sys_Write (fd: Sysdef.int_t; buf: in System.Address; count: in Sysdef.size_t) return Sysdef.ssize_t;
pragma Import (C, Sys_Write, "write");
-- Common constants
INVALID_HANDLE: constant := -1;
ERROR_RETURN: constant := -1;
-- File record
type Posix_File_Record is new File_Record with record
Pool: Storage_Pool_Pointer := null;
Handle: C.int := INVALID_HANDLE;
Handle: Sysdef.int_t := INVALID_HANDLE;
end record;
type Posix_File_Pointer is access all Posix_File_Record;
function Flag_To_System (Bits: in File_Flag_Bits) return C.int is
V: C.int := 0;
-- Standard Files
Stdin: aliased Posix_File_Record := (null, 0);
Stdout: aliased Posix_File_Record := (null, 1);
Stderr: aliased Posix_File_Record := (null, 2);
function Flag_To_System (Bits: in Flag_Bits) return System_Word is
V: System_Word := 0;
begin
-- if Bits and File_Flag_Read /= 0 then
-- V := V or 0;
-- end if;
-- if Bits and File_Flag_Write /= 0 then
-- V := V or 1;
-- end if;
if ((Bits and FLAG_READ) /= 0) and then
((Bits and FLAG_WRITE) /= 0) then
V := V or Sysdef.O_RDWR;
elsif ((Bits and FLAG_WRITE) /= 0) then
V := V or Sysdef.O_WRONLY;
else
V := V or Sysdef.O_RDONLY;
end if;
if ((Bits and FLAG_CREATE) /= 0) then
V := V or Sysdef.O_CREAT;
end if;
if ((Bits and FLAG_TRUNCATE) /= 0) then
V := V or Sysdef.O_TRUNC;
end if;
if ((Bits and FLAG_SYNC) /= 0) then
V := V or Sysdef.O_SYNC;
end if;
return V;
end Flag_To_System;
function Get_Stdin return File_Pointer is
begin
--return File_Pointer'(Stdin'Access);
return File_Record(Stdin)'Access;
end Get_Stdin;
function Get_Stdout return File_Pointer is
begin
--return File_Pointer'(Stdout'Access);
return File_Record(Stdout)'Access;
end Get_Stdout;
function Get_Stderr return File_Pointer is
begin
--return File_Pointer'(Stderr'Access);
return File_Record(Stdout)'Access;
end Get_Stderr;
procedure Open (File: out File_Pointer;
Name: in Slim_String;
Flag: in File_Flag;
Mode: in File_Mode := DEFAULT_FILE_MODE;
Flag: in Flag_Record;
Mode: in Mode_Record := DEFAULT_MODE;
Pool: in Storage_Pool_Pointer := null) is
package P is new H2.Pool (Posix_File_Record, Posix_File_Pointer, Pool);
@ -49,9 +93,10 @@ package body File is
F := P.Allocate;
F.Pool := Pool;
--F.Handle := sys_open (Interfaces.C.char_array(Name & Slim.Character'Val(0)), 0, 0);
F.Handle := sys_open (Name, Flag_To_System(Flag.Bits), C.int(Mode.Bits));
if F.Handle <= -1 then
F.Handle := Sys_Open (Name & Slim_Character'Val(0),
Sysdef.int_t(Flag_To_System(Flag.Bits)),
Sysdef.int_t(Mode.Bits));
if Sysdef."<=" (F.Handle, INVALID_HANDLE) then
raise Constraint_Error; -- TODO: raise a proper exception.
end if;
@ -60,27 +105,58 @@ package body File is
procedure Open (File: out File_Pointer;
Name: in Wide_String;
Flag: in File_Flag;
Mode: in File_Mode := DEFAULT_FILE_MODE;
Flag: in Flag_Record;
Mode: in Mode_Record := DEFAULT_MODE;
Pool: in Storage_Pool_Pointer := null) is
begin
Open (File, Wide_To_Slim(Name), Flag, Mode, Pool);
end Open;
procedure Close (File: in out File_Pointer) is
F: Posix_File_Pointer;
F: Posix_File_Pointer := Posix_File_Pointer(File);
begin
F := Posix_File_Pointer(File);
sys_close (F.Handle);
F.Handle := Interfaces.C."-"(1);
if F /= Stdin'Access and then F /= Stdout'Access and then F /= Stderr'Access then
-- Don't close standard files.
declare
package P is new H2.Pool (Posix_File_Record, Posix_File_Pointer, F.Pool);
begin
P.Deallocate (F);
end;
Sys_Close (F.Handle);
F.Handle := INVALID_HANDLE;
File := null;
declare
package P is new H2.Pool (Posix_File_Record, Posix_File_Pointer, F.Pool);
begin
P.Deallocate (F);
end;
File := null;
end if;
end Close;
procedure Read (File: in File_Pointer; Buffer: in out System_Byte_Array; Last: out System_Length) is
F: Posix_File_Pointer := Posix_File_Pointer(File);
N: Sysdef.ssize_t;
begin
N := Sys_Read (F.Handle, Buffer'Address, Buffer'Length);
if Sysdef."<=" (N, ERROR_RETURN) then
raise Constraint_Error; -- TODO rename exception
elsif Sysdef."=" (N, 0) then
Last := Buffer'First - 1;
else
Last := Buffer'First + System_Length(N) - 1;
end if;
end Read;
procedure Write (File: in File_Pointer; Buffer: in System_Byte_Array; Last: out System_Length) is
F: Posix_File_Pointer := Posix_File_Pointer(File);
N: Sysdef.ssize_t;
begin
N := Sys_Write (F.Handle, Buffer'Address, Buffer'Length);
if Sysdef."<=" (N, ERROR_RETURN) then
raise Constraint_Error; -- TODO rename exception
elsif Sysdef."=" (N, 0) then
Last := Buffer'First - 1;
else
Last := Buffer'First + System_Length(N) - 1;
end if;
end Write;
end File;

46
lib/posix/sysdef.c Normal file
View File

@ -0,0 +1,46 @@
#include <sys/types.h>
#include <fcntl.h>
#include <stdio.h>
#include <limits.h>
int main (int argc, char* argv[])
{
if (argc != 2)
{
fprintf (stderr, "Usage: %s package-name\n", argv[0]);
return -1;
}
printf ("package %s is\n", argv[1]);
printf ("\n");
printf ("\ttype size_t is mod 2 ** %d;\n", (int)(sizeof(size_t) * 8));
printf ("\ttype ssize_t is range -(2 ** (%d - 1)) .. +(2 ** (%d - 1)) - 1;\n", (int)(sizeof(size_t) * 8), (int)(sizeof(size_t) * 8));
printf ("\ttype ushort_t is mod 2 ** %u;\n", (int)(sizeof(unsigned short) * 8));
printf ("\ttype uint_t is mod 2 ** %u;\n", (int)(sizeof(int) * 8));
printf ("\ttype ulong_t is mod 2 ** %u;\n", (int)(sizeof(unsigned long) * 8));
printf ("\ttype short_t is range %d .. %d;\n", SHRT_MIN, SHRT_MAX);
printf ("\ttype int_t is range %d .. %d;\n", INT_MIN, INT_MAX);
printf ("\ttype long_t is range %ld .. %ld;\n", LONG_MIN, LONG_MAX);
printf ("\n");
printf ("\tO_RDONLY: constant := %d;\n", O_RDONLY);
printf ("\tO_WRONLY: constant := %d;\n", O_WRONLY);
printf ("\tO_RDWR: constant := %d;\n", O_RDWR);
printf ("\tO_CREAT: constant := %d;\n", O_CREAT);
printf ("\tO_EXCL: constant := %d;\n", O_EXCL);
printf ("\tO_TRUNC: constant := %d;\n", O_TRUNC);
#if !defined(O_SYNC)
# define O_SYNC 0
#endif
printf ("\tO_SYNC: constant := %d;\n", O_SYNC);
printf ("\n");
printf ("end %s;\n", argv[1]);
return 0;
}