diff --git a/.gitignore b/.gitignore index d6fddd4..ddbfad6 100644 --- a/.gitignore +++ b/.gitignore @@ -17,7 +17,8 @@ TAGS *.o *.lo *.la -Makefile Makefile.in .deps .libs +build +build.log diff --git a/CMakeLists.txt b/CMakeLists.txt new file mode 100644 index 0000000..5400d92 --- /dev/null +++ b/CMakeLists.txt @@ -0,0 +1,23 @@ +cmake_minimum_required(VERSION 3.5) +project(cim) + +# By default, build for release with debug info. +if(NOT CMAKE_BUILD_TYPE) + set(CMAKE_BUILD_TYPE "RelWithDebInfo" CACHE STRING + "Default build type: RelWithDebInfo" FORCE) +endif() + +add_compile_options(-Werror -Wno-unsequenced) # TODO: -Wall + +# +# Create config.h. +# +configure_file(config.h.in config.h @ONLY) + +add_definitions(-DHAVE_CONFIG_H) + +# +# Build subdirectories. +# +add_subdirectory(src) +add_subdirectory(lib) diff --git a/Makefile.am b/Makefile.am deleted file mode 100644 index 8c29936..0000000 --- a/Makefile.am +++ /dev/null @@ -1,24 +0,0 @@ -## Process this file with automake to create Makefile.in -## $Id: $ - -# Copyright (C) 1997 Sverre Hvammen Johansen, -# Department of Informatics, University of Oslo. -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; version 2. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -ACLOCAL_AMFLAGS = -I m4 -SUBDIRS = doc man src lib util test -EXTRA_DIST = cim.spec - -noinst_HEADERS = limit.h diff --git a/README b/README index 6fe60d0..aa28545 100644 --- a/README +++ b/README @@ -37,23 +37,20 @@ INSTALL file. The simplest way to compile this package is: - 1. `cd' to the directory containing the package's source code and - type `./configure' (or `CFLAGS=-O2 LDFLAGS=-s ./configure', - which is recomended when using GCC) to configure the package - for your system. + 1. `cd' to the directory containing the package's source code and + type `cmake -B build' to configure the package for your system. - Running `configure' takes awhile. While running, it prints some - messages telling which features it is checking for. + 2. `cd' to the build directory. - 2. Type `make' to compile the package + 3. Type `make' to compile the package. - 3. Type `make install' to install the package + 4. Type `make install' to install the package. You may want to compile the run-time-system with CFLAGS=-O2, but -have the cim compiler compile produced C-code with CFLAGS=-O0. +have the cim compiler compile produced C-code with CFLAGS=-O0. This can most easilly be done by the following steps: - 1. `cd' to the directory containing the package's source code and + 1. `cd' to the directory containing the package's source code and type `CFLAGS=-O2 ./configure' 2. Type `make' to compile the package. @@ -63,7 +60,7 @@ This can most easilly be done by the following steps: 4. type `CFLAGS=-O0 ./configure' 5. type `cd src; make' followed by `make install' - + GCC may run out of virtual memory, and therefore you may want to use a standard C-compiler instead. You can do that by typing `CC=cc ./configure' @@ -103,8 +100,3 @@ program into separate compiled modules or use version 2 of cim instead. Sverre Hvammen Johansen - - - - - diff --git a/acinclude.m4 b/acinclude.m4 deleted file mode 100644 index d1e7802..0000000 --- a/acinclude.m4 +++ /dev/null @@ -1,262 +0,0 @@ -dnl Copyright (C) 1997 Sverre Hvammen Johansen, -dnl Department of Informatics, University of Oslo. -dnl -dnl This program is free software; you can redistribute it and/or modify -dnl it under the terms of the GNU General Public License as published by -dnl the Free Software Foundation; version 2. -dnl -dnl This program is distributed in the hope that it will be useful, -dnl but WITHOUT ANY WARRANTY; without even the implied warranty of -dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -dnl GNU General Public License for more details. -dnl -dnl You should have received a copy of the GNU General Public License -dnl along with this program; if not, write to the Free Software -dnl Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ - -AC_DEFUN([CIM_LINK_STATIC_FLAG], -[ -AC_MSG_CHECKING(grepping libtool to find link_static_flag) -AC_CACHE_VAL(cim_cv_link_static_flag,[ -eval `grep link_static_flag libtool|head -1` -cim_cv_link_static_flag=$link_static_flag -]) -AC_MSG_RESULT($cim_cv_link_static_flag) -AC_DEFINE_UNQUOTED(LINK_STATIC_FLAG,"$cim_cv_link_static_flag", "Compiler flag to prevent dynamic linking") -])dnl - -AC_DEFUN([CIM_PIC_FLAG], -[ -AC_MSG_CHECKING(grepping libtool to find pic_flag) -AC_CACHE_VAL(cim_cv_pic_flag,[ -eval `grep pic_flag libtool|head -1` -cim_cv_pic_flag=$pic_flag -]) -AC_MSG_RESULT($cim_cv_pic_flag) -AC_DEFINE_UNQUOTED(PIC_FLAG,"$cim_cv_pic_flag", "Additional compiler flags for building shared library objects") -])dnl - -AC_DEFUN([CIM_WL_FLAG], -[ -AC_MSG_CHECKING(grepping libtool to find wl_flag) -AC_CACHE_VAL(cim_cv_wl_flag,[ -eval `grep wl= libtool|head -1` -cim_cv_wl_flag=$wl -]) -AC_MSG_RESULT($cim_cv_wl_flag) -AC_DEFINE_UNQUOTED(WL_FLAG,"$cim_cv_wl_flag", "How to pass a linker flag through the compiler") -])dnl - -AC_DEFUN([CIM_TRAP], -[ - -AC_MSG_CHECKING(signal SIGFPE) -AC_CACHE_VAL(cim_cv_sigfpe, -[AC_TRY_RUN([#if HAVE_SIGNAL_H -#include -#endif -int t(){} -main() { -signal(SIGFPE,t); -exit(0); -}],cim_cv_sigfpe=yes,cim_cv_sigfpe=no,cim_cv_sigfpe=yes)]) -AC_MSG_RESULT($cim_cv_sigfpe) -if test $cim_cv_sigfpe = yes; then - AC_DEFINE_UNQUOTED(HAVE_SIGFPE, 1, "Define if we have signal sigfpe") -fi - -AC_MSG_CHECKING(signal SIGSEGV) -AC_CACHE_VAL(cim_cv_sigsegv, -[AC_TRY_RUN([#if HAVE_SIGNAL_H -#include -#endif -int t(){} -main() { -signal(SIGSEGV,t); -exit(0); -}],cim_cv_sigsegv=yes,cim_cv_sigsegv=no,cim_cv_sigsegv=yes)]) -AC_MSG_RESULT($cim_cv_sigsegv) -if test $cim_cv_sigsegv = yes; then - AC_DEFINE_UNQUOTED(HAVE_SIGSEGV, 1, "Define if we have signal sigsegv") -fi - -AC_MSG_CHECKING(signal SIGILL) -AC_CACHE_VAL(cim_cv_sigill, -[AC_TRY_RUN([#if HAVE_SIGNAL_H -#include -#endif -int t(){} -main() { -signal(SIGILL,t); -exit(0); -}],cim_cv_sigill=yes,cim_cv_sigill=no,cim_cv_sigill=yes)]) -AC_MSG_RESULT($cim_cv_sigill) -if test $cim_cv_sigill = yes; then - AC_DEFINE_UNQUOTED(HAVE_SIGILL, 1, "Define if we have signal sigill") -fi - -AC_MSG_CHECKING(signal SIGTRAP) -AC_CACHE_VAL(cim_cv_sigtrap, -[AC_TRY_RUN([#if HAVE_SIGNAL_H -#include -#endif -int t(){} -main() { -signal(SIGTRAP,t); -exit(0); -}],cim_cv_sigtrap=yes,cim_cv_sigtrap=no,cim_cv_sigtrap=yes)]) -AC_MSG_RESULT($cim_cv_sigtrap) -if test $cim_cv_sigtrap = yes; then - AC_DEFINE_UNQUOTED(HAVE_SIGTRAP, 1, "Define if we have signal sigtrap") -fi - -AC_MSG_CHECKING(signal SIGSYS) -AC_CACHE_VAL(cim_cv_sigsys, -[AC_TRY_RUN([#if HAVE_SIGNAL_H -#include -#endif -int t(){} -main() { -signal(SIGSYS,t); -exit(0); -}],cim_cv_sigsys=yes,cim_cv_sigsys=no,cim_cv_sigsys=yes)]) -AC_MSG_RESULT($cim_cv_sigsys) -if test $cim_cv_sigsys = yes; then - AC_DEFINE_UNQUOTED(HAVE_SIGSYS, 1, "Define if we have signal sigsys") -fi - -AC_MSG_CHECKING(signal SIGBUS) -AC_CACHE_VAL(cim_cv_sigbus, -[AC_TRY_RUN([#if HAVE_SIGNAL_H -#include -#endif -int t(){} -main() { -signal(SIGBUS,t); -exit(0); -}],cim_cv_sigbus=yes,cim_cv_sigbus=no,cim_cv_sigbus=yes)]) -AC_MSG_RESULT($cim_cv_sigbus) -if test $cim_cv_sigbus = yes; then - AC_DEFINE_UNQUOTED(HAVE_SIGBUS, 1, "Define if we have signal sigbus") -fi - -])dnl - -AC_DEFUN([CIM_BINARY_FILE], -[ -AC_MSG_CHECKING(whether files must be opened in binary mode) -AC_CACHE_VAL(cim_cv_binary_file, -[AC_TRY_RUN([#include -main() { -FILE *f; -f=fopen("conffile","w"); -putc('\032',f); -fclose(f); -f=fopen("conffile","r"); -if (getc(f)=='\032') return (0); else return(1); -}],cim_cv_binary_file=no,cim_cv_binary_file=yes,cim_cv_binary_file=no)]) -rm -f conffile -AC_MSG_RESULT($cim_cv_binary_file) -if test $cim_cv_binary_file = yes; then - AC_DEFINE_UNQUOTED(OPEN_FILE_IN_BINARY_MODE, 1, "Define if temporary file have to be opened in binary mode") -fi -])dnl - -AC_DEFUN([CIM_DEFAULTS], -[ -AC_MSG_CHECKING(assuming iso latin) -AC_CACHE_VAL(cim_cv_ISO_latin,[cim_cv_iso_latin=yes]) -AC_MSG_RESULT($cim_cv_iso_latin) -if test $cim_cv_iso_latin = yes; then - AC_DEFINE_UNQUOTED(ISO_LATIN, 1, "Define if ISO_LATIN is implemented") -fi - -AC_MSG_CHECKING(assuming input line length) -AC_CACHE_VAL(cim_cv_input_line_length,[cim_cv_input_line_length=80]) -AC_MSG_RESULT($cim_cv_input_line_length) -AC_DEFINE_UNQUOTED(INPUT_LINE_LENGTH,$cim_cv_input_line_length, "Define input_line_length") - -AC_MSG_CHECKING(assuming output line length) -AC_CACHE_VAL(cim_cv_output_line_length,[cim_cv_output_line_length=80]) -AC_MSG_RESULT($cim_cv_output_line_length) -AC_DEFINE_UNQUOTED(OUTPUT_LINE_LENGTH,$cim_cv_output_line_length, "Define output line length") - -AC_MSG_CHECKING(assuming lines per page) -AC_CACHE_VAL(cim_cv_lines_per_page,[cim_cv_lines_per_page=60]) -AC_MSG_RESULT($cim_cv_lines_per_page) -AC_DEFINE_UNQUOTED(LINES_PER_PAGE,$cim_cv_lines_per_page, "Define lines per page") - -AC_MSG_CHECKING(assuming the size of the heap in kB) -AC_CACHE_VAL(cim_cv_dynmemsizekb,[cim_cv_dynmemsizekb=512]) -AC_MSG_RESULT($cim_cv_dynmemsizekb) -AC_DEFINE_UNQUOTED(DYNMEMSIZEKB,$cim_cv_dynmemsizekb, "Define the size of the heap") - -AC_MSG_CHECKING(assuming that dump is implementable) -AC_ARG_ENABLE(dump, -[ --enable-dump Enable implementation of (un)dump], -[case "${enableval}" in - yes) cim_dump=yes ;; - no) cim_dump=no ;; - *) AC_MSG_ERROR(bad value ${enableval} for --enable-dump) ;; -esac],[cim_dump=no]) -AC_MSG_RESULT($cim_dump) -if test $cim_dump = yes; then - AC_DEFINE_UNQUOTED(DUMP, 1, "Define if dump is implemented") -fi - -AC_MSG_CHECKING(assuming that floatingpoint conform to IEEE-754) -case "$target" in - vax-*-*) - AC_CACHE_VAL(cim_cv_float_ieee,[cim_cv_float_ieee=no]) - ;; - *-cray-unicos*) - AC_CACHE_VAL(cim_cv_float_ieee,[cim_cv_float_ieee=no]) - ;; - *-*-*) - AC_CACHE_VAL(cim_cv_float_ieee,[cim_cv_float_ieee=yes]) - ;; -esac -AC_MSG_RESULT($cim_cv_float_ieee) -if test $cim_cv_float_ieee = yes; then - AC_DEFINE_UNQUOTED(FLOAT_IEEE, 1, "Define if the implementation conforms to IEEE-754") -fi - -AC_MSG_CHECKING(assuming that floatingpoint conform to VAX-format) -case "$target" in - vax-*-*) - AC_CACHE_VAL(cim_cv_float_vax,[cim_cv_float_vax=yes]) - ;; - *-*-*) - AC_CACHE_VAL(cim_cv_float_vax,[cim_cv_float_vax=no]) - ;; -esac -AC_MSG_RESULT($cim_cv_float_vax) -if test $cim_cv_float_vax = yes; then - AC_DEFINE_UNQUOTED(FLOAT_VAX, 1, "Define if the implementation conforms to the vax architecture") -fi - -AC_MSG_CHECKING(assuming value of max double) -if test $ac_cv_header_stdc = yes; then - AC_CACHE_VAL(cim_cv_max_double,[cim_cv_max_double=DBL_MAX]) -else - AC_CACHE_VAL(cim_cv_max_double,[cim_cv_max_double=MAXDOUBLE]) -fi -AC_MSG_RESULT($cim_cv_max_double) -AC_DEFINE_UNQUOTED(MAX_DOUBLE,$cim_cv_max_double, "Define MAX_DOUBLE") - -AC_MSG_CHECKING(assuming value of min double) -if test $ac_cv_header_stdc = yes; then - AC_CACHE_VAL(cim_cv_min_double,[cim_cv_min_double=DBL_MIN]) -else - AC_CACHE_VAL(cim_cv_min_double,[cim_cv_min_double=MINDOUBLE]) -fi -AC_MSG_RESULT($cim_cv_min_double) -AC_DEFINE_UNQUOTED(MIN_DOUBLE,$cim_cv_min_double, "Define MIN_DOUBLE") - -AC_MSG_CHECKING(assuming alignment) -AC_CACHE_VAL(cim_cv_alignment,[cim_cv_alignment=8]) -AC_MSG_RESULT($cim_cv_alignment) -AC_DEFINE_UNQUOTED(ALIGNMENT,$cim_cv_alignment, "Define alignment") - -])dnl - diff --git a/config.h.in b/config.h.in new file mode 100644 index 0000000..70e86c7 --- /dev/null +++ b/config.h.in @@ -0,0 +1,38 @@ +/* + * Short name of this project. + */ +#define PACKAGE_NAME "@CMAKE_PROJECT_NAME@" + +/* + * Version string as: tag.revcount-hash. + * For example: v2.6.123-abcdef9 + */ +//#define PACKAGE_VERSION "@GIT_TAG@.@GIT_REVCOUNT@-@GIT_HASH@" + +#define STDC_HEADERS 1 +#define HAVE_STRING_H 1 +#define HAVE_LIMITS_H 1 +#define HAVE_UNISTD_H 1 +#define HAVE_STDLIB_H 1 +#define HAVE_GETTIMEOFDAY 1 +#define TIME_WITH_SYS_TIME 1 +#define TIME_T 1 + +#define CPU_TYPE "ARM" +#define MANUFACTURER "APPLE" +#define OS_TYPE "DARWIN" +#define OS_TYPE_VERSION "DARWIN21.6.0" + +#define PACKAGE_VERSION "cim-5.1" +#define SYSTEM_TYPE "arm-apple-darwin21.6.0" + +#define SCC "gcc" +#define SCFLAGS "-g -O2" +#define SLDFLAGS "" +#define SLIBS "-lm " +#define LIBDIR "/usr/local/lib" +#define INCLUDEDIR "/usr/local/include" + +#define WL_FLAG "-Wl," +#define LINK_STATIC_FLAG "" +#define PIC_FLAG "" diff --git a/configure.ac b/configure.ac deleted file mode 100644 index 1d3b68d..0000000 --- a/configure.ac +++ /dev/null @@ -1,107 +0,0 @@ -dnl Process this file with autoconf to produce a configure script. - -dnl Copyright (C) 1994-1997 Sverre Hvammen Johansen, -dnl Department of Informatics, University of Oslo. -dnl -dnl This program is free software; you can redistribute it and/or modify -dnl it under the terms of the GNU General Public License as published by -dnl the Free Software Foundation; version 2. -dnl -dnl This program is distributed in the hope that it will be useful, -dnl but WITHOUT ANY WARRANTY; without even the implied warranty of -dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -dnl GNU General Public License for more details. -dnl -dnl You should have received a copy of the GNU General Public License -dnl along with this program; if not, write to the Free Software -dnl Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ - -AC_INIT(cim, 5.1) -AC_CONFIG_SRCDIR([src/cimcomp.c]) -AC_CONFIG_MACRO_DIR([m4]) - -AC_CANONICAL_TARGET -changequote(,) -target_os_x_version=`echo $target_os|sed -e 's/\([^0-9.]*\)[0-9.]*/\1/'` -changequote([,]) -AC_DEFINE_UNQUOTED(SYSTEM_TYPE,"$target", "Define the system type we are running") -AC_DEFINE_UNQUOTED(CPU_TYPE,"`echo $target_cpu | tr a-z A-Z`", "Define cpu type derived from system type") -AC_DEFINE_UNQUOTED(OS_TYPE_VERSION,"`echo $target_os | tr a-z A-Z`", "Define os type including version derived from system type") -AC_DEFINE_UNQUOTED(MANUFACTURER,"`echo $target_vendor | tr a-z A-Z`", "Define manufacturer derived from system type") -AC_DEFINE_UNQUOTED(OS_TYPE,"`echo $target_os_x_version | tr a-z A-Z`", "Define os type derived from system type") - -AM_INIT_AUTOMAKE -AM_CONFIG_HEADER(config.h) -AM_PROG_LIBTOOL - -dnl Library version -dnl -dnl If any routines have been removed increment CURRENT and -dnl set REVISION and AGE to 0 (C:R:A becomes C+1:0:0). -dnl -dnl Else if any routines in the library have been added increment -dnl CURRENT and AGE and set REVISION to 0 (C:R:A becomes C+1:0:A+1). -dnl -dnl Else if any changes in the library increment REVISION and -dnl leave CURRENT and AGE unchanged (C:R:A becomes C:R+1:A) -dnl -dnl Else leave CURRENT, REVISION and AGE unchanged. - -LIB_CURRENT=5 -LIB_REVISION=0 -LIB_AGE=0 -AC_SUBST(LIB_CURRENT) -AC_SUBST(LIB_REVISION) -AC_SUBST(LIB_AGE) - -PACKAGE_VERSION="$PACKAGE-$VERSION" -AC_DEFINE_UNQUOTED(PACKAGE_VERSION, "$PACKAGE_VERSION") -AC_SUBST(PACKAGE_VERSION) - -AC_PROG_CC - -dnl Checks for programs. -AC_PROG_LN_S -dnl Not needed when using libtool: AC_PROG_RANLIB -AC_PROG_YACC -AC_PATH_PROG(PERL, perl) - -dnl Checks for libraries. -AC_CHECK_LIB(m,main) -AC_CHECK_LIB(ft,main) -AC_HEADER_STDC -AC_CHECK_HEADERS(string.h memory.h malloc.h limits.h values.h fcntl.h sys/resource.h sys/types.h sys/times.h sys/time.h sys/utsname.h signal.h unistd.h) - -dnl Checks for typedefs, structures, and compiler characteristics. -AC_HEADER_TIME -AC_STRUCT_TM - -dnl Checks for library functions. -AC_CHECK_FUNCS(time times getrusage gettimeofday getdomainname uname gethostname getuid getpid getegid unlink) -AC_FUNC_ALLOCA - -AC_C_CHAR_UNSIGNED -AC_CHECK_SIZEOF(int, 4) -AC_CHECK_SIZEOF(long, 4) - -AC_C_BIGENDIAN -AC_TYPE_SIGNAL -CIM_TRAP -CIM_BINARY_FILE -CIM_DEFAULTS -CIM_WL_FLAG -CIM_LINK_STATIC_FLAG -CIM_PIC_FLAG - -AC_CONFIG_FILES([ - Makefile cim.spec - src/Makefile - lib/Makefile - test/Makefile - man/Makefile - doc/Makefile - util/Makefile - util/cim2latex - util/cim2ps - util/cimindent]) -AC_OUTPUT diff --git a/doc/Makefile.am b/doc/Makefile.am deleted file mode 100644 index 812a3e4..0000000 --- a/doc/Makefile.am +++ /dev/null @@ -1,21 +0,0 @@ -## Process this file with automake to create Makefile.in -## $Id: $ - -# Copyright (C) 1997 Sverre Hvammen Johansen, -# Department of Informatics, University of Oslo. -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; version 2. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -info_TEXINFOS = cim.texi -EXTRA_DIST = SIMULA-HISTORY texinfo.tex diff --git a/examples/.gitignore b/examples/.gitignore new file mode 100644 index 0000000..0385760 --- /dev/null +++ b/examples/.gitignore @@ -0,0 +1,19 @@ +*.atr +hello +right-text +gcd +for-loop +test-geom +test-stacks-char +test-stacks-var +sim-nested +sim-office +sim-man-machine +sim-interview +demo-simset +sim-active-customer +sim-active-server +chess-two-masters +chess-master-two-slaves +chess-with-classes +noughts-and-crosses diff --git a/examples/Makefile b/examples/Makefile new file mode 100644 index 0000000..d713821 --- /dev/null +++ b/examples/Makefile @@ -0,0 +1,36 @@ +PROG = hello \ + right-text \ + gcd \ + for-loop \ + geometry.o \ + test-geom \ + stacks.o \ + test-stacks-char \ + test-stacks-var \ + sim-nested \ + sim-office \ + sim-man-machine \ + sim-interview \ + demo-simset \ + sim-active-server \ + sim-active-customer \ + chess-two-masters \ + chess-master-two-slaves \ + chess.o \ + chess-with-classes \ + noughts-and-crosses + +all: $(PROG) + +clean: + rm -f $(PROG) *.o *.atr + +%: %.sim + gnucim $< + +%.o: %.sim + gnucim -c $< + +chess-with-classes:: chess.o +test-stacks-char:: stacks.o +test-stacks-var:: stacks.o diff --git a/examples/chess-master-two-slaves.sim b/examples/chess-master-two-slaves.sim new file mode 100644 index 0000000..436e3df --- /dev/null +++ b/examples/chess-master-two-slaves.sim @@ -0,0 +1,57 @@ +! Chess control - Master and Two Slaves approach; +Begin + Boolean Mate; + Ref(Player) White, Black, Winner; + Integer Seed; + + Class Player(PName); + Text PName; + Begin + Ref(Player) Opponent; + Integer Move; + + ! The life follows; + Detach; + OutText(PName); + OutText("'s First Move"); + OutImage; + Detach; + OutText(PName); + OutText("'s Second Move"); + OutImage; + Detach; + Move := 2; + While true do begin + Move := Move+1; + OutText(PName); + OutText("'s Move # "); + OutInt(Move, 10); + OutImage; + If Draw(0.05, Seed) then begin + Mate := true; + Winner :- This Player; + end; + Detach; + End While; + End Player; + + Begin + OutText("Creating Players, Starting the game"); + OutImage; + White :- New Player("White"); + Black :- New Player("Black"); + White.Opponent :- Black; + Black.Opponent :- White; + Seed := 11; + While not Mate do begin + Call(White); + If not Mate then + Call(Black) + End While; + OutText("Finish: "); + OutText(Winner.PName); + OutText(" won in move"); + OutInt(Winner.Move, 3); + OutImage; + End +End; diff --git a/examples/chess-two-masters.sim b/examples/chess-two-masters.sim new file mode 100644 index 0000000..09b298a --- /dev/null +++ b/examples/chess-two-masters.sim @@ -0,0 +1,53 @@ +! Chess control - Two Masters approach; +Begin + Boolean Mate; + Ref(Player) White, Black, Winner; + Integer Seed; + + Class Player(PName); + Text PName; + Begin + Ref(Player) Opponent; + Integer Move; + + ! The life follows; + Detach; + OutText(PName); + OutText("'s First Move"); + OutImage; + Resume(Opponent); + OutText(PName); + OutText("'s Second Move"); + OutImage; + Resume(Opponent); + Move := 2; + While not Mate do begin + Move := Move+1; + OutText(PName); + OutText("'s Move # "); + OutInt(Move, 10); + OutImage; + If Draw(0.3, Seed) then begin + Mate := true; + Winner :- This Player; + End If; + Resume(Opponent); + End While; + End of Player; + + Begin ! QPS head; + OutText("Creating Players, Starting the white one"); + OutImage; + White :- New Player("White"); + Black :- New Player("Black"); + White.Opponent :- Black; + Black.Opponent :- White; + Seed := 17; + Resume(White); + OutText("Finish: "); + OutText(Winner.PName); + OutText(" won in move"); + OutInt(Winner.Move, 3); + OutImage; + End of QPS +End of program; diff --git a/examples/chess-with-classes.sim b/examples/chess-with-classes.sim new file mode 100644 index 0000000..4f19c12 --- /dev/null +++ b/examples/chess-with-classes.sim @@ -0,0 +1,13 @@ +! Chess control - using the package Chess; +external class Chess; + +Chess begin + outtext("Resuming the Master"); + outimage; + Resume(Master); + outtext("Finish: "); + outtext(Winner.PName); + outtext(" won in move"); + outint(Winner.Move, 10); + outimage; +end of program; diff --git a/examples/chess.sim b/examples/chess.sim new file mode 100644 index 0000000..0ada24d --- /dev/null +++ b/examples/chess.sim @@ -0,0 +1,61 @@ +! Chess control - package implementation; +class Chess; ! Main class with local: Player, Referee; +begin + boolean Mate; + ref(Player) White, Black, Winner; + ref(Referee) Master; + integer Seed; + + class Player(PName); + text PName; + begin + ref(Player) Opponent; + integer Move; + + ! The life of Player; + Detach; + OutText(PName); + OutText("'s First Move"); + OutImage; + Detach; + OutText(PName); + OutText("'s Second Move"); + OutImage; + Detach; + Move := 2; + while true do begin + Move := Move+1; + OutText(PName); + OutText("'s Move # "); + OutInt(Move, 10); + OutImage; + if Draw(0.05,Seed) then begin + Mate := true; + Winner :- this Player; + end; + Detach; + end while; + end player; + + class Referee; + begin + Detach; + while not Mate do begin + Call(White); + if not Mate then + Call(Black) + end while + end of referee; + + begin + ! Life of Chess; + Seed := 11; + OutText("Creating the Players and the Master"); + OutImage; + White :- new Player("White"); + Black :- new Player("Black"); + White.Opponent :- Black; + Black.Opponent :- White; + Master :- new Referee; + end +end of Chess; diff --git a/examples/demo-simset.sim b/examples/demo-simset.sim new file mode 100644 index 0000000..e483b09 --- /dev/null +++ b/examples/demo-simset.sim @@ -0,0 +1,113 @@ +! Working with linked lists in the Simula language ; +! ; +! The system class SIMSET of the Simula language ; +! contains a knowledge of two way linked lists. ; +! Two main terms (classes) are introduced: ; +! - HEAD is the "owner" of the list, ; +! - LINK is the "member" of the list. ; +! These two classes are used as prefixes when decla- ; +! ring user lists (more specialized heads) and user ; +! elements (more specialized links). ; +! For both classes a set of useful actions is ; +! available. ; + +simset begin + + !Global variables: ; + + ref(head) group, gang; ! Two user lists - no more details; + ref(element1) a, b, c; + ref(element2) y, z, w; + integer j; + + link class element1(i); ! User defined list element; + integer i; + begin + outtext("Element1 created i ="); ! life; + outint(i, 4); + outimage; + end--of--element1; + + link class element2(x); real x; ! Another list element; + begin + outtext("Element2 created x ="); ! life; + outfix(x, 2, 6); + outimage; + end--of--element2; + + ! Program body: ; + + group :- new head; ! creating the two lists; + gang :- new head; + + a :- new element1(1); ! creating 3 instances (objects) of the ; + b :- new element1(2); ! "type" element1. ; + c :- new element1(3); + + a.into(group); ! storing the 3 objects to group; + b.into(group); + c.into(group); + + outtext("Numbers of items in the two lists: "); + outint(group.cardinal, 3); + outint(gang.cardinal, 3); + outimage; + + y :- new element2(5.0); ! creating 3 objects of the "type" element2; + z :- new element2(6.0); + w :- new element2(7.5); + + y.into(gang); ! storing the objects to gang; + z.into(gang); + w.into(gang); + + outtext("Numbers of items in the two lists: "); + outint(group.cardinal, 3); + outint(gang.cardinal, 3); + outimage; + + outtext("Items in group: "); + a :- group.first; ! the first element of group; + for j := 1, 2, 3 do + begin + outint(a.i, 4); + a :- a.suc ! the successor of a; + end; + outimage; + + outtext("Items in gang in reverse order: "); + y :- gang.last; ! the last element of gang; + for j := 1, 2, 3 do + begin + outfix(y.x, 1, 4); + y :- y.pred ! the predecessor of y; + end; + outimage; + + outtext("2nd in group: "); + outint(group.first.suc qua Element1.i, 3); ! the i of the 2nd of group; + outimage; + + outtext("Last but one in gang: "); + outfix(gang.last.pred qua Element2.x, 1, 4); ! the x of the last but one of gang; + outimage; + + gang.last.pred.into(group); ! the last but one of gang is; + ! moved to group as the last one; + outtext("The last but one of gang moved as the last to group: "); + outfix(group.last qua Element2.x, 1, 4); + outimage; + + group.first.suc.precede(gang.first); ! the 2nd of group is moved; + ! to gang as the 1st one; + outtext("The 2nd of group moved as the 1st to gang: "); + outint(gang.first qua Element1.i, 3); + outimage; + + group.first.follow(gang.first.suc); ! the 1st of group is moved; + ! to gang as the 3rd one; + outtext("The 1st of group moved as the 3rd to gang: "); + outint(gang.first.suc.suc qua Element1.i, 3); ! displaying the i of the; + outimage; ! 3rd element of gang; + +end**of**program; diff --git a/examples/for-loop.sim b/examples/for-loop.sim new file mode 100644 index 0000000..3d40fd3 --- /dev/null +++ b/examples/for-loop.sim @@ -0,0 +1,8 @@ +begin + integer i; + for i:= 1,13, 20 step 10 until 40, 70, i+1 while i lt 76, + 100 step 50 until 250, 1000, 1500 do + begin + outint(i, 5); + end for +end; diff --git a/examples/gcd.sim b/examples/gcd.sim new file mode 100644 index 0000000..3cb4c68 --- /dev/null +++ b/examples/gcd.sim @@ -0,0 +1,25 @@ +begin + integer procedure GCD(M, N); + integer M, N; + begin + while M<>N do begin + if M= Servers) then + Wait(Queue); ! Has to wait in Queue; + + ! Service can start: ; + BusyServers := BusyServers + 1; + + ! This is the teller service: ; + Hold(Normal(SMean, SStd, TrialSeedS)); + BusyServers := BusyServers - 1; + if not Queue.Empty then begin + Next :- Queue.First; + Next.Out; ! First from Queue served; + activate Next after Current; + end if; + + ! Statistics; + CustomersOut := CustomersOut + 1; + TotalTime := TotalTime + Time - Arrival; + end of Customer; + + ! MAIN program body: ; + TrialSeedG := 7; ! Seeds for random variables; + TrialSeedS := 23; + MinInt := 1; ! Min and Max intervals; + MaxInt := 3; + SMean := 8; ! Random normal servers; + SStd := 2; + outtext("Enter the number of Servers : "); + outrecord; + Servers := InInt; ! Initial numbers; + TrialDuration := 600; + Queue :- new Head; + activate new Generator; + Hold(TrialDuration); ! Experiment duration; + TimeSpent := TotalTime / CustomersOut; + outtext("Average time spent in the system: "); + outfix(TimeSpent, 3, 10); + outimage; +end of program; diff --git a/examples/sim-active-server.sim b/examples/sim-active-server.sim new file mode 100644 index 0000000..7d3c9a3 --- /dev/null +++ b/examples/sim-active-server.sim @@ -0,0 +1,75 @@ +! Active server approach; +Simulation begin + real TrialDuration; ! Experiment length [min]; + ref(Head) Queue; ! The queue; + integer Servers; ! Total number of servers; + integer TrialSeedG, TrialSeedS; ! Seeds of random generators; + long real TotalTime, TimeSpent; ! Variables for statistics; + integer CustomersOut; ! Number of served customers; + real MinInt, MaxInt; ! Uniform interval between arrivals; + real SMean, SStd; ! Normal service duration; + ref(Server) array ServBank(1:10); ! Max. number of servers; + integer i; + + Process class Generator; + begin + while true do begin + activate new Customer(Time); + + ! Interval between arrivals: ; + Hold(Uniform(MinInt, MaxInt, TrialSeedG)); + end while; + end of Generator; + + Process class Server; + begin + ref(Customer) ServedOne; + while true do + if not Queue.Empty then begin + ServedOne :- Queue.First; + ServedOne.Out; ! First from Queue served; + Hold(Normal(SMean, SStd, TrialSeedS)); + activate ServedOne after Current + end + else begin + passivate; + end if + end of Server; + + Process class Customer(Arrival); + real Arrival; + begin + for i:=1 step 1 until Servers do + if ServBank(i).Idle then + activate ServBank(i) after Current; + Wait(Queue); + + ! Service finished; + ! Statistics; + CustomersOut := CustomersOut + 1; + TotalTime := TotalTime + Time - Arrival; + end of Customer; + + ! MAIN program body: ; + TrialSeedG := 7; ! Seeds for random variables; + TrialSeedS := 23; + MinInt := 1; ! Min and Max intervals; + MaxInt := 3; + SMean := 8; ! Random normal servers; + SStd := 2; + outtext("Enter the number of Servers : "); + outimage; + Servers := InInt; ! Initial numbers; + TrialDuration := 600; + Queue :- new Head; + for i:=1 step 1 until Servers do begin + ServBank(i) :- new Server; + activate ServBank(i) + end for; + activate new Generator; + Hold(TrialDuration); ! Experiment duration; + TimeSpent := TotalTime / CustomersOut; + outtext("Average time spent in the system: "); + outfix(TimeSpent, 3, 10); + outimage; +end of program; diff --git a/examples/sim-interview.sim b/examples/sim-interview.sim new file mode 100644 index 0000000..e007ca2 --- /dev/null +++ b/examples/sim-interview.sim @@ -0,0 +1,90 @@ +! Discrete Simulation using the Simula's class SIMULATION ; +! Example: ; +! (Pooley: An Introduction to Programming in Simula) ; + +simulation begin + + !Global variables; + + ref(head) receptionistq, interviewq1, interviewq2; + integer i, manual; + + process class interviewer(title, myqueue); + text title; + ref(head) myqueue; + begin + ref(link) next; + inspect myqueue do + while true do + begin + if not empty then + begin + hold(3.5); + next :- first; + next.out; + activate next after current; + hold(3.0); + end + else + hold(5.0); + end + end--of--interviewer; + + process class jobhunter(skillcategory); + integer skillcategory; + begin + outtext("Job hunter "); + outint(skillcategory, 4); + outtext(" joins receptionist queue at time "); + outfix(time, 4, 8); + outimage; + wait(receptionistq); + outtext("Job hunter "); + outint(skillcategory, 4); + outtext(" joins interview queue"); + outimage; + hold(1.0); + if skillcategory = manual then + wait(interviewq1) + else + wait(interviewq2); + outtext("Job hunter "); + outint(skillcategory, 4); + outtext(" leaves employment office"); + outimage + end--of--jobhunter; + + process class receptionist; + begin + ref(link) customer; + while true do + begin + if not receptionistq.empty then + begin + hold(2.0); + customer :- receptionistq.first; + customer.out; + activate customer + end + else + hold(1.0) + end + end--of--receptionist; + + !Program body; + + manual := 1; + receptionistq :- new head; + interviewq1 :- new head; + interviewq2 :- new head; + activate new receptionist; + activate new interviewer("Manual", interviewq1); + activate new interviewer("Skilled", interviewq2); + for i := 1, 2, 2, 1 do + begin + activate new jobhunter(i); + hold(2.0) + end; + hold(100) + +end**of**program; diff --git a/examples/sim-man-machine.sim b/examples/sim-man-machine.sim new file mode 100644 index 0000000..40bcc0e --- /dev/null +++ b/examples/sim-man-machine.sim @@ -0,0 +1,77 @@ +! Discrete Simulation using the Simula's class SIMULATION ; +! Example: ; +! (Pooley: An Introduction to Programming in Simula) ; +! The example is a model of a man operating a machine. ; +! Both man and machine are expressed as processes. ; +! The man performs repeatedly during 400 time units the ; +! following activities: ; +! - loading the machine with a new supply of 50 components; +! which takes 5.0 time units, ; +! - starting (activating) the machine, ; +! - checking at regular intervals 0.5 time units whether ; +! the machine has finished the work, ; +! - unloading the machine which takes 10.0 time units. ; +! The machine processes the components, it needs 2.0 time ; +! units per component. ; + + + +simulation begin + + !Global variables; + + integer count; + ref(man) worker; + + + process class man(mill); ref(machine) mill; + begin + while time < 400 do + begin + outtext("Loading starts"); + outfix(time,2,10); outimage; + count := count+1; + hold(5.0); !Loading the machine; + mill.components := mill.components+50; + activate mill; + while mill.components > 0 do hold(0.5); !Checking the machine; + hold(10.0); !Unloading the machine; + outtext("Unloading finishes"); + outfix(time,2,10); outimage; + end--of--loop; + passivate; + end++of++man; + + process class machine; + begin + integer components; + while true do + begin + outtext("Machine starts"); + outfix(time,2,10); outimage; + while components > 0 do + begin + hold(2.0); !Processing one component; + components := components-1 + end; + passivate; !The machine passivates itself after; + !processing of all elements. ; + end + end++of++machine; + + + + !MAIN program body; + + worker :- new man(new machine); + !Creating the man and the machine; + activate worker; !Activating the man; + + hold (800); !Duration of an experiment; + + !Experiment evaluation: ; + + outtext("Count = "); outint(count,4); outimage; + outtext("Simulation ends"); outimage + +end**of**program; diff --git a/examples/sim-nested.sim b/examples/sim-nested.sim new file mode 100644 index 0000000..b128b5e --- /dev/null +++ b/examples/sim-nested.sim @@ -0,0 +1,189 @@ +! NESTED Simulation using the Simula's class SIMULATION ; +! ; +! The example is a model of a bank. Customers are first ; +! served by tellers, then by cashiers. ; +! The input rate changes in three periods: there is a busy ; +! period, then an idle period and again a busy one. ; +! For each period the repeated inner simulation experiment ; +! simulates the first queue for the particular input rate ; +! and for various numbers of servers. Then it shows the ; +! results (average time spent at the first server) and ; +! prompts the user for the number of tellers and the number; +! of cashiers. Tellers always finish a service that has ; +! already started. The simulation should find the ; +! time customers spend in the bank (average and maximum) ; +! for various numbers of clerks in the three periods. ; + +Simulation Begin + ! Global variables: ; + Integer Period,Trial; ! Period, Trial number; + Real Array MinInt,MaxInt(1:3); ! Min and Max intervals; + Real Array Duration(1:3); ! Duration of periods [min]; + Ref(Head) Queue1,Queue2; ! The two queues; + Integer MaxClerks, Tellers, Cashiers; ! Total numbers; + Integer BusyTellers, BusyCashiers; ! Numbers of working clerks; + Real S1Mean, S1Std, S2Mean, S2Std; ! Random normal servers; + Integer SeedG, SeedS1, SeedS2; ! Seeds of the random generators; + Long Real TotalTime, MaxTime; ! Variables for statistics; + Integer CustomersOut; ! Number of served customers; + + Process Class Generator; + Begin + While true do begin + ! Interval between arrivals: ; + Hold(Uniform(MinInt(Period),MaxInt(Period),SeedG)); + Activate New Customer(Time); + End While; + End of Generator; + + Process Class Customer(Arrival); Real Arrival; + Begin + Ref(Customer) Next; + Real Spent; + + If (not Queue1.Empty) or (BusyTellers >= Tellers) then + Wait(Queue1); ! Has to wait in Queue1; + ! Service can start; + BusyTellers := BusyTellers + 1; + Hold(Normal(S1Mean, S1Std, SeedS1)); ! This is the teller service; + BusyTellers := BusyTellers - 1; + + If (not Queue1.Empty) and (BusyTellers < Tellers) then begin + Next :- Queue1.First; + Next.Out; ! First from Queue1 served; + Activate Next after Current; + End If; + + If (not Queue2.Empty) or (BusyCashiers >= Cashiers) then + Wait(Queue2); ! Has to wait in Queue2; + ! Service can start; + BusyCashiers := BusyCashiers + 1; + Hold(Normal(S2Mean, S2Std, SeedS2)); ! This is the cashier service; + BusyCashiers := BusyCashiers - 1; + + If (not Queue2.Empty) and (BusyCashiers < Cashiers) then begin + Next :- Queue2.First; + Next.Out; ! First from Queue2 served; + Activate Next after Current; + End If; + + CustomersOut := CustomersOut + 1; + Spent := Time - Arrival; + TotalTime := TotalTime + Spent; + If Spent > MaxTime then MaxTime := Spent; + End of Customer; + + Procedure Report; ! Experiment evaluation; + Begin + outtext(" *** Report on external simulation ***"); outimage; + outint(CustomersOut,6); outtext(" customers ready at time "); + outfix(Time,2,10); outimage; + outtext("Average time in system: "); + outfix(TotalTime/CustomersOut,2,10); outimage; + outtext("Maximum time in system: "); + outfix(MaxTime,2,10); outimage; + End of Report; + +! MAIN program body; + + SeedG := 11; ! Seeds of random variables; + SeedS1 := 13; + SeedS2 := 17; + MinInt(1) := 1; MaxInt(1) := 4; ! Min and Max intervals; + MinInt(2) := 2; MaxInt(2) := 9; + MinInt(3) := 1; MaxInt(3) := 3; + Duration(1) := 120; ! Duration of periods; + Duration(2) := 240; + Duration(3) := 120; + MaxClerks := 6; + BusyTellers := BusyCashiers :=0; ! Numbers of working clerks; + S1Mean := 6; ! Random normal servers; + S1Std := 1; + S2Mean := 8; + S2Std := 2; + Queue1 :- New Head; + Queue2 :- New Head; + TotalTime := MaxTime := 0; ! Variables for statistics; + CustomersOut := 0; + Period := 1; + Activate New Generator; + +For Period:=1 step 1 until 3 do begin + + Real Array TimeSpent(1:MaxClerks); + + outtext(" *** Results of internal simulation *** Period "); + outint(Period,1); outimage; + outtext(" Tellers Average time spent"); outimage; + + For Trial:=1 step 1 until MaxClerks do + ! ********************************************************** ; + Simulation Begin + ! Internal Global variables: ; + Real TrialDuration; ! Internal experiment [min]; + Ref(Head) Queue; ! The queue; + Integer Servers; ! Total number; + Integer BusyServers; ! Numbers of working clerks; + Integer TrialSeedG,TrialSeedS; ! Seeds of the random generators; + Long Real TotTime; ! Variables for statistics; + Integer CustOut; ! Number of served customers; + + Process Class IGenerator; + Begin + While true do begin + Hold(Uniform(MinInt(Period),MaxInt(Period),TrialSeedG)); + Activate New ICustomer(Time); ! Interval between arrivals: ; + End While; + End of IGenerator; + + Process Class ICustomer(Arrival); Real Arrival; + Begin + Ref(ICustomer) Next; + + If not Queue.Empty or (BusyServers >= Servers) then + Wait(Queue); ! Has to wait in Queue; + ! Service can start; + BusyServers := BusyServers + 1; + + Hold(Normal(S1Mean, S1Std, TrialSeedS)); ! This is the teller service; + BusyServers := BusyServers - 1; + + If not Queue.Empty then begin + Next :- Queue.First; + Next.Out; ! First from Queue served; + Activate Next after Current; + End If; + + CustOut := CustOut + 1; + TotTime := TotTime + Time - Arrival; + End of ICustomer; + + ! Internal MAIN program body; + + TrialSeedG := 7; ! Seeds for random variables; + TrialSeedS := 23; + Servers := Trial; + BusyServers := 0; + TrialDuration := 600; + TotTime := 0; ! Variables for statistics; + CustOut := 0; + Queue :- New Head; + Activate New IGenerator; + Hold(TrialDuration); ! Internal experiment duration; + TimeSpent(Trial) := TotTime/CustOut; + outint(Trial,13); + outfix(TimeSpent(Trial),3,23); outimage; + + End of internal simulation; + ! ********************************************************** ; + + outtext("Enter the number of tellers : "); outimage; + Tellers := InInt; + outtext("Enter the number of cashiers : "); outimage; + Cashiers := InInt; + ! Cashiers:= Clerks - Tellers; + Hold(Duration(Period)); + Report; + outtext("Press Enter to Continue."); outimage; InImage; + End For; +End of program; diff --git a/examples/sim-office.sim b/examples/sim-office.sim new file mode 100644 index 0000000..2ed32a8 --- /dev/null +++ b/examples/sim-office.sim @@ -0,0 +1,98 @@ +! Discrete Simulation using the Simula's class SIMULATION ; +! Example: ; +! (Pooley: An Introduction to Programming in Simula) ; +! The example is a model of an office. Two writers write ; +! documents an pass them to the typing pool. Then the ; +! documents are typed by typers. The simulation should ; +! find the best number of typers - neither idle typers, ; +! nor waiting writers. ; +! Writing takes a random time from 5 to 10. ; +! Typing takes a random time from 10 to 50. ; +! (Both uniformly distributed) ; +! The model uses 2 processes: - Writer ; +! - Typer ; + +Simulation Begin + + Class Document;; ! Empty class; + + Procedure Report; ! Experiment evaluation; + Begin + OutText(" *** Report *** "); OutImage; + Outint(Count,6); OutText(" documents ready at time "); + OutFix(Time,2,10); OutImage; + OutText("Total waiting time of writers: "); OutFix(Waiting,2,10); + OutImage; + OutText("Number of waiting typists : "); + OutInt(TypingPool.Cardinal,4); OutImage; + End of Report; + + Process Class Writer; + Begin + Ref(Typer) Typist; ! Typist = typer typing the document; + Ref(Document) Doc; ! Doc = document completed; + Real WTime; + While True Do ! Life = writing document and starting ; + Begin ! its typing for ever. ; + Hold(Uniform(5.0,10.0,R1)); ! Writing the document ; + Doc :- New Document; + Typist :- TypingPool.First; ! Taking the 1st free typist; + WTime := 0; + While Typist==None Do Begin + Hold(0.5); + WTime := WTime + 0.5; + Typist :- TypingPool.First; + End Wait; + Waiting := Waiting + WTime; ! Total waiting time; + Typist.Out; + Activate Typist ! Starting his/her work; + End While + End of Writer; + + + Process Class Typer; + Begin + Wait(TypingPool); ! Life starts by entering the queue; + While True Do ! This is performed after removing the typist; + ! from the queue and after his/her activating; + ! by one of the two writers. ; + Begin + Hold(Uniform(10.0,50.0,R2)); ! This is the typing; + OutText("Document ready at "); + OutFix(Time,2,10); outimage; + Count := Count + 1; + Wait(TypingPool) ! Waiting in the queue until removed by; + End While ! one of the two writers. ; + End of Typer; + + ! Global variables: ; + + Ref(Head) TypingPool; ! Typingpool is a list (queue); + Integer I,Count,R1,R2; + Integer TypNum; + Real Waiting; + Character C; + + !MAIN program body; + + R1 := 13; ! Seeds of random variables; + R2 := 17; + TypingPool :- New Head; !Creating an empty queue; + OutText("Enter the number of typists:"); OutImage; + TypNum := InInt; + For I := 1 Step 1 Until TypNum Do Activate New Typer; + ! All of them will enter the queue - see the life.; + Activate New Writer; + !The life of the 1st writer starts at 0 time units; + Activate New Writer At 25; + !The life of the 2nd writer starts at 25 time units; + + C := 'Y'; + While C='Y' Or C='y' Do Begin + Hold(50); + Report; ! Report after each 50 time units; + OutText("Continue ? (Y/N)"); OutImage; + InImage; C := InChar; + End While; + +End of program; diff --git a/examples/simset.pas b/examples/simset.pas new file mode 100644 index 0000000..e34ba21 --- /dev/null +++ b/examples/simset.pas @@ -0,0 +1,230 @@ +Unit SimSet; { This unit models the Simula class SIMSET } + +{***********************************************************} + +Interface + +Type LinkageP = ^Linkage; + HeadP = ^Head; + LinkP = ^Link; + + Linkage = object + Constructor Init; + Function IsIn: String; Virtual; + Function Prev: LinkageP; + Function Suc : LinkP; + Function Pred: LinkP; + Private + Succc: LinkageP; { Hidden pointers } + Predd: LinkageP; + Function IsInHidden: String; Virtual; + end{of Linkage}; + + Head = object (Linkage) + Constructor Init; + Function IsIn: String; Virtual; + Function First : LinkP; + Function Last : LinkP; + Function Empty : Boolean; + Function Cardinal : Integer; { Number of items } + Procedure Clear; + Private + Function IsInHidden: String; Virtual; + end; + + Link = object (Linkage) + Function IsIn: String; Virtual; + Procedure Out; { Removes this Link from a list } + Procedure Follow (Ptr: LinkageP); + { Inserts This Link after Ptr } + Procedure Precede(Ptr: LinkageP); + { Inserts This Link before Ptr } + Procedure Into(S: HeadP); + { Inserts ThisLinkage to S at end - FIFO } + Private + Function IsInHidden: String; Virtual; + end; + +{***********************************************************} + +Implementation + +Constructor Linkage.Init; +begin + Succc := nil; + Predd := nil +end; + +{***********************************************************} + +Function Linkage.IsIn: String; +begin + IsIn := 'Linkage'; +end; + +{***********************************************************} + +Function Linkage.IsInHidden: String; +begin + IsInHidden := 'Linkage'; +end; + +{***********************************************************} + +Function Linkage.Prev; +begin + Prev := Predd; +end; + +{***********************************************************} + +Function Linkage.Suc : LinkP; +begin + If Succc^.IsInHidden = 'Link' then {Is the type Link ?} + Suc := LinkP(Succc) + Else + Suc := nil; +end; + +{***********************************************************} + +Function Linkage.Pred: LinkP; +begin + If Predd^.IsInHidden = 'Link' then {Is the type Link ?} + Pred := LinkP(Predd) + Else + Pred := nil; +end; + +{***********************************************************} + +Constructor Head.Init; +begin + Succc := @Self; + Predd := @Self; +end; + +{***********************************************************} + +Function Head.IsIn: String; +begin + IsIn := 'Head'; +end; + +{***********************************************************} + +Function Head.IsInHidden: String; +begin + IsInHidden := 'Head'; +end; + +{***********************************************************} + +Function Head.First : LinkP; +begin + First := Suc +end; + +{***********************************************************} + +Function Head.Last : LinkP; +begin + Last := Pred +end; + +{***********************************************************} + +Function Head.Empty : Boolean; +begin + Empty := (@Self=Succc) +end; + +{***********************************************************} + +Function Head.Cardinal : Integer; +Var i : Integer; + p : LinkP; +begin + p := First; + i := 0; + While p<>nil do begin + Inc(i); + p := p^.Suc; + end{while}; + Cardinal := i +end; + +{***********************************************************} + +Procedure Head.Clear; +Var ptr : LinkP; +begin + While First<>nil do begin + ptr := First; + ptr^.Out; + Dispose(ptr); + end{while} +end; + +{***********************************************************} + +Function Link.IsIn: String; +begin + IsIn := 'Link'; +end; + +{***********************************************************} + +Function Link.IsInHidden: String; +begin + IsInHidden := 'Link'; +end; + +{***********************************************************} + +Procedure Link.Out; +begin + If Succc<>nil then begin + Succc^.Predd := Predd; + Predd^.Succc := Succc; + Succc := nil; + Predd := nil + end{if} +end; + +{***********************************************************} + +Procedure Link.Follow (Ptr: LinkageP); +begin + Out; + If (Ptr<>nil) and (Ptr^.Succc<>nil) then begin + Predd := Ptr; + Succc := Ptr^.Succc; + Succc^.Predd := @Self; + Ptr^.Succc := @Self + end{if} +end; + +{***********************************************************} + +Procedure Link.Precede(Ptr: LinkageP); +begin + Out; + If (Ptr<>nil) and (Ptr^.Predd<>nil) then begin + Predd := Ptr^.Predd; + Succc := Ptr; + Predd^.Succc := @Self; + Ptr^.Predd := @Self + end{if} +end; + +{***********************************************************} + +Procedure Link.Into(S: HeadP); +begin + Precede(S) +end; + +{***********************************************************} + +end. diff --git a/examples/stacks.pas b/examples/stacks.pas new file mode 100644 index 0000000..aad0a21 --- /dev/null +++ b/examples/stacks.pas @@ -0,0 +1,63 @@ +Unit Stacks; { Stack Implementation based on SimSet } + +{***********************************************************} + +Interface + +Uses SimSet; + +Type + StackP = ^Stack; + ItemP = ^Item; + + Stack = Object(Head) { Stack as such } + Procedure Push(X : ItemP); + Function Pop : ItemP; + Function Size : Integer; + Function Top : ItemP; + Function IsIn : String; Virtual; + (* Inherited methods to be used: + Function Empty : Boolean; + Procedure Clear; *) + end; + + Item = Object(Link) { Stack item able to show itself. } + Procedure Show; Virtual; { SHOW has to be declared in each } + end; { subclass according to the item type.} + +{***********************************************************} + +Implementation + + Procedure Stack.Push(X : ItemP); + Begin + X^.Follow(@Self); + End; + + Function Stack.Pop : ItemP; + Begin + Pop := ItemP(First); + First^.Out; + End; + + Function Stack.Size : Integer; + Begin + Size := Cardinal; + End; + + Function Stack.Top : ItemP; + Begin + Top := ItemP(First); + End; + + Function Stack.IsIn : String; + Begin + IsIn := 'Stack'; + End; + + Procedure Item.Show; + Begin + Write('Do not use me !'); + End; + +End. diff --git a/examples/stacks.sim b/examples/stacks.sim new file mode 100644 index 0000000..d648509 --- /dev/null +++ b/examples/stacks.sim @@ -0,0 +1,19 @@ +! Stack implementation using the system class SIMSET; +Simset class Stacks; +begin + Head class Stack; + begin + procedure Push(x); + ref(Link) x; + x.Follow(this Head); + + ref(Link) procedure Pop; + begin + Pop :- First; + First.Out; + end Pop; + + integer procedure Size; + Size := Cardinal; + end Stack; +end Stacks; diff --git a/examples/test-geom.sim b/examples/test-geom.sim new file mode 100644 index 0000000..f1dad94 --- /dev/null +++ b/examples/test-geom.sim @@ -0,0 +1,57 @@ +! OOP in the Simula language ; +! ; +! This program tests the main class "Geometry". ; +! In the prefixed block the "Colour_Point" and ; +! the "Square" are defined as subclasses of point ; +! and rectangle respectively. ; +! Simple use of all objects is shown. ; + +external class Geometry; +Geometry begin + ! The prefixing means that all classes and ; + ! variables of geometry may be used in this ; + ! block as if they were standard identifiers. ; + + Point class Color_Point(C); + character C; + ! The knowledge of "Point" is used to declare ; + ! the "Color_Point". One more attribute is ; + ! defined. The life is ammended. ; + begin + ! This life of color_point follows the life of point: ; + outtext("Color is "); + outchar(C); + outimage + end of Color_Point; + + Rectangle class Square; + begin + Height := Width; !Life of square; + Update; + outtext("Has been changed to a square !"); + outimage; + end of Square; + + !Variables declared in the prefixed block: ; + + ref(Color_Point) A1; + ref(Point) C, D; + ref(Circle) K; + ref(Line) E, F; + ref(Rectangle) R1; + ref(Square) S1; + + !Block body - here the program starts: ; + + C :- new Point(5, 6); + D :- new Point(20, 30); + A1 :- new Color_Point(3, 4, 'G'); + K :- new Circle(10, C); + E :- new Line(C, D); + F :- X; + K.Shift(1, 1); + R1 :- new Rectangle("Rec_R1", 5, 4); + S1 :- new Square("Square_S1", 4, 6); + S1.Show; + outimage; +end of prefixed block; diff --git a/examples/test-stacks-char.sim b/examples/test-stacks-char.sim new file mode 100644 index 0000000..75fe4b0 --- /dev/null +++ b/examples/test-stacks-char.sim @@ -0,0 +1,45 @@ +! Stack implementation using the system class SIMSET; +! Character stack; + +external class Stacks; +Stacks begin + + Link class Node(char); + character char; + ! User defined character stack element; + begin end; + + ref(Stack) S; + ref(Node) Item; + character c; + + ! Program body; + + S :- new Stack; ! Creating a stack; + + outtext("Stack created, size = "); + outint(S.Size, 3); + outimage; + outtext("Enter a sentence, finish it by '.'"); + outimage; + c := ' '; + while c <> '.' do begin + c := InChar; + Item :- new Node(c); + S.Push(Item); + end while; + + outtext("Number of characters in the stack: "); + outint(S.Size, 3); + outimage; + outtext("The sentence inverted: "); + outimage; + + while not S.Empty do begin + Item :- S.Pop; + c := Item.char; + outchar(c); + end while; + outimage; + +end**of**program; diff --git a/examples/test-stacks-var.sim b/examples/test-stacks-var.sim new file mode 100644 index 0000000..b40ab60 --- /dev/null +++ b/examples/test-stacks-var.sim @@ -0,0 +1,97 @@ +! Stack implementation using the system class SIMSET; +! Storing items of various types; + +external class Stacks; +Stacks begin + + Link class NodeC(C); + character C; + !User defined character stack element; + begin + procedure Show; + outchar(C); + end; + + Link class NodeI(I); + integer I; + !User defined integer stack element; + begin + procedure Show; + outint(I, 4); + end; + + Link class NodeR(R); + real R; + !User defined real stack element; + begin + procedure Show; + outfix(R, 2, 8); + end; + + ref(Stack) S; + ref(Link) Item; + ref(NodeC) ItemC; + ref(NodeI) ItemI; + ref(NodeR) ItemR; + character C; + integer J; + real X; + + !Program body; + + S :- new Stack; !creating a stack; + + outtext("Stack created, size = "); + outint(S.Size, 3); + outimage; + + outtext("Enter a sentence, finish it by '.'"); + outimage; + C := ' '; + while C <> '.' do begin + C := InChar; + ItemC :- new NodeC(C); + S.Push(ItemC); + end while; + + outtext("Enter integer numbers, finish by '0'"); + outimage; + J := -1; + while J <> 0 do begin + J := InInt; + ItemI :- new NodeI(J); + S.Push(ItemI); + end while; + + outtext("Enter real numbers, finish by '0'"); + outimage; + X := -1; + while X <> 0 do begin + X := InReal; + ItemR :- new NodeR(X); + S.Push(ItemR); + end while; + + outtext("Number of items in the stack:"); + outint(S.Size, 3); + outimage; + + outtext("One more Link pushed in the stack."); + outimage; + Item :- new Link; + S.Push(Item); + + outtext("The whole sequence inverted:"); + outimage; + + while not S.Empty do begin + Item :- S.Pop; + inspect Item + when NodeC do Show + when NodeI do Show + when NodeR do Show + otherwise outtext("Unknown item"); + end while; + outimage; + +end**of**program; diff --git a/examples/tsimset.pas b/examples/tsimset.pas new file mode 100644 index 0000000..c47ff77 --- /dev/null +++ b/examples/tsimset.pas @@ -0,0 +1,105 @@ +Program TSimSet; { Testing SimSet } +Uses SimSet; + +Type + Node1P = ^Node1; + Node1 = object (Link) { User defined integer list element } + N : Integer; + end; + + Node2P = ^Node2; + Node2 = object (Link) { User defined real list element } + R : Real; + end; + +Var List : HeadP; + Nod : LinkP; + N1 : Node1P; + N2 : Node2P; + i : Integer; + +Procedure DispList; { Late binding not used } +Var Nod : LinkP; +begin + Nod := List^.First; + While Nod<>nil do begin + If TypeOf(Nod^) = TypeOf(Node1) then begin + N1 := Node1P(Nod); + Write(N1^.N:3); + end + Else begin + N2 := Node2P(Nod); + Write(N2^.R:6:1); + end{if}; + Nod := Nod^.Suc; + end{while}; + Writeln +end; + + +Begin { of the program body } + New(List,Init); + +{ Empty list: } + Writeln('New list created'); + Write('Cardinal = ',List^.Cardinal); + Writeln(' Empty = ',List^.Empty,' Press Enter'); + Readln; + + For i := 1 to 5 do begin + New(N1,Init); + N1^.N := i; + N1^.Into(List) + end; + + Writeln('Now there are 5 integer items:'); + Displist; + Write('Cardinal = ',List^.Cardinal); + Writeln(' Empty = ',List^.Empty,' Press Enter'); + Readln; + + For i := 1 to 5 do begin + New(N2,Init); + N2^.R := i*2; + N2^.Into(List) + end; + + Writeln('Now there are 5 integer and 5 real items:'); + Displist; + Writeln('Cardinal = ',List^.Cardinal); + Writeln; + +{ Last goes second: } + Write('And Now the last goes second: (Press Enter)'); + Readln; + List^.Last^.Follow(List^.First); + DispList; Writeln; + +{ First goes last but two: } + Write('And Now the first goes last but two: (Press Enter)'); + Readln; + List^.First^.Precede(List^.Last^.Pred); + DispList; Writeln; + +{ Third removed and deleted: } + Write('And Now the third will be deleted: (Press Enter)'); + Readln; + Nod := List^.First^.Suc^.Suc; + Nod^.Out; + Dispose(Nod); + Displist; + Writeln('Cardinal = ',List^.Cardinal); + Writeln; + +{ Deleting the list: } + Write('Now the list will be deleted: (Press Enter)'); + Readln; + List^.Clear; + DispList; + Write('Cardinal = ',List^.Cardinal); + Writeln(' Empty = ',List^.Empty); + Write('Press Enter'); + Dispose(List); + Readln; + +End. diff --git a/examples/tstacks.pas b/examples/tstacks.pas new file mode 100644 index 0000000..57499c6 --- /dev/null +++ b/examples/tstacks.pas @@ -0,0 +1,98 @@ +Program TStacks; { Testing the unit STACKS } +Uses Simset, Stacks, Crt; + +Type + StackItemCP = ^StackItemC; { Object pointers } + StackItemIP = ^StackItemI; + StackItemRP = ^StackItemR; + + StackItemC = Object(Item) { Character stack item } + C : Char; + Procedure Show; Virtual; + End; + + StackItemI = Object(Item) { Integer stack item } + I : Integer; + Procedure Show; Virtual; + End; + + StackItemR = Object(Item) { Real stack item } + R : Real; + Procedure Show; Virtual; + End; + + Procedure StackItemC.Show; + Begin + Write(C) + End; + + Procedure StackItemI.Show; + Begin + Write(I:5) + End; + + Procedure StackItemR.Show; + Begin + Write(R:8:2) + End; + +Var + S : ^Stack; + SItem : ItemP; + ItemC : StackItemCP; + ItemI : StackItemIP; + ItemR : StackItemRP; + C : Char; + J : Integer; + X : Real; + +Begin + ClrScr; + New(S,Init); + Writeln('Enter a sentence, finish by "."'); + Repeat + Read(C); + New(ItemC,Init); + ItemC^.C := C; + S^.Push(ItemC); + Until C='.'; + Readln; + Writeln('Stack size =',S^.Size:3); + ItemC := StackItemCP(S^.Top); + Writeln('Top item = ',ItemC^.C); + + Writeln('Enter integers, finish by "0"'); + Repeat + Read(J); + New(ItemI,Init); + ItemI^.I := J; + S^.Push(ItemI); + Until J=0; + Readln; + Writeln('Stack size =',S^.Size:3); + ItemI := StackItemIP(S^.Top); + Writeln('Top item = ',ItemI^.I); + + Writeln('Enter reals, finish by "-1"'); + Repeat + Read(X); + New(ItemR,Init); + ItemR^.R := X; + S^.Push(ItemR); + Until X=-1; + Readln; + Writeln('Stack size =',S^.Size:3); + ItemR := StackItemRP(S^.Top); + Writeln('Top item = ',ItemR^.R:8:2); + + Writeln('The whole sequence goes out:'); + + Repeat + SItem := S^.Pop; + SItem^.Show; + Dispose(SItem); + Until S^.Empty; + Dispose(S); + Writeln; + Readln; +End. diff --git a/lib/.gitignore b/lib/.gitignore index 8b17731..40897a0 100644 --- a/lib/.gitignore +++ b/lib/.gitignore @@ -1,3 +1 @@ -/simset.c -/simulation.c /*.shl diff --git a/lib/CMakeLists.txt b/lib/CMakeLists.txt new file mode 100644 index 0000000..d5ed6c3 --- /dev/null +++ b/lib/CMakeLists.txt @@ -0,0 +1,263 @@ +include_directories( + ${CMAKE_SOURCE_DIR} + ${CMAKE_BINARY_DIR} + ${CMAKE_CURRENT_SOURCE_DIR} + ${CMAKE_CURRENT_BINARY_DIR} +) + +# +# Build cim library +# +add_library(cim STATIC + sysin.c + sysout.c + syserr.c + copytexttoc.c + addroffirstchar.c + addroffirstelem.c + copytextarrtoc.c + copyarrtoc.c + mod.c + rem.c + signr.c + signdr.c + signi.c + signdi.c + signdx.c + entier.c + intrea.c + powii.c + powri.c + pow.c + addepsilon.c + subepsilon.c + absr.c + absi.c + sqrt.c + sin.c + cos.c + tan.c + cotan.c + arcsin.c + arccos.c + arctan.c + arctan2.c + sinh.c + cosh.c + tanh.c + ln.c + log10.c + exp.c + mint.c + minc.c + minr.c + mini.c + maxt.c + maxc.c + maxr.c + maxi.c + simulaid.c + datetime.c + cputime.c + clocktime.c + lowerbound.c + upperbound.c + draw.c + randint.c + uniform.c + normal.c + negexp.c + poisson.c + erlang.c + discrete.c + linear.c + histd.c + histo.c + terror.c + filename.c + isopen.c + setaccess.c + leftshift.c + field.c + setpos.c + pos.c + more.c + length.c + dlocation.c + dendfile.c + dlocked.c + dcheckpoint.c + dunlock.c + dlock.c + dopen.c + dclose.c + dlocate.c + dlastloc.c + dmaxloc.c + dinimage.c + doutimage.c + ddeleteimage.c + iendfile.c + iopen.c + iclose.c + iinimage.c + iinrecord.c + iinchar.c + ilastitem.c + iintext.c + iinint.c + iinreal.c + iinfrac.c + oopen.c + oclose.c + ooutimage.c + ooutrecord.c + obreakoutimage.c + ooutchar.c + oouttext.c + ooutint.c + ooutfix.c + ooutreal.c + ooutfrac.c + pline.c + ppage.c + popen.c + pclose.c + plinesperpage.c + pspacing.c + peject.c + poutimage.c + poutrecord.c + bytesize.c + ibendfile.c + ibopen.c + ibclose.c + ibinbyte.c + ibintext.c + obopen.c + obclose.c + oboutbyte.c + obouttext.c + dbendfile.c + dblocation.c + dbmaxloc.c + dblocked.c + dbunlock.c + dblock.c + dbopen.c + dbclose.c + dblastloc.c + dblocate.c + dbinbyte.c + dboutbyte.c + dbintext.c + dbouttext.c + tsglob.c + start.c + printfilline.c + error.c + warning.c + trace.c + systemerror.c + initier.c + ss.c + rs.c + cp.c + cpp.c + cpb.c + ccb.c + ep.c + epp.c + oa.c + cprb.c + cprbb.c + b.c + be.c + resume.c + exchange.c + detach.c + call.c + goto.c + enddecl.c + inner.c + endclass.c + ca.c + in.c + rin.c + is.c + gbc.c + ct.c + eth.c + getav.c + getcbv.c + getrv.c + getta.c + gettv.c + getproc.c + getlab.c + geta.c + getsa.c + dump.c + argc.c + argv.c + return.c + tconstant.c + tstart.c + tlength.c + tmain.c + tpos.c + tmore.c + tsub.c + tstrip.c + tsetpos.c + tgetchar.c + tgetint.c + tgetreal.c + tgetfrac.c + tputchar.c + tputint.c + tputfix.c + tputreal.c + tputfrac.c + copy.c + conc.c + blanks.c + textvalassign.c + textassign.c + eqrtext.c + eqtext.c + lttext.c + letext.c + char.c + isochar.c + rank.c + isorank.c + digit.c + letter.c + lowten.c + decimalmark.c + upcase.c + lowcase.c + simfile.c + simenvir.c + xmalloc.c + simset.c + simulation.c + rdiv0.c + idiv0.c +) + +#TODO: compile simset.sim into simset.c +#gnucim -H -L -L. -I. -S simset.sim + +#TODO: compile simulation.sim into simulation.c +#gnucim -H -L -L. -I. -S simulation.sim + +# +# Install the library. +# +install(TARGETS cim DESTINATION lib) +install(FILES libcim-atr.a DESTINATION lib) +install(FILES cim.h DESTINATION include) + +#TODO: install simfile.o simenvir.o diff --git a/lib/cim.h b/lib/cim.h index b8b0432..3277589 100644 --- a/lib/cim.h +++ b/lib/cim.h @@ -18,6 +18,7 @@ /****************************************************************************** Definition of runtime-constants */ +#include #define __FALSE 0 #define __TRUE 1 @@ -453,7 +454,7 @@ typedef struct } __labelnamepar; -/* Label var and standard transmitted parameter or +/* Label var and standard transmitted parameter or * a name, var or standard transmitted switch parameter */ typedef struct /* No thunk for switch parameter by name */ @@ -510,7 +511,7 @@ extern char *__errnone, extern __progadr __goto, __return; extern long __vreturn; -extern void __main_modul (); +void __main_modul (); /* switch */ extern int __swv; @@ -518,7 +519,7 @@ extern int __swv; /* Local-block, parameter-block, and static environm,ent to rcp(p)() */ extern __dhp __lb, __pb; -extern __dhp __sl; /* Can't be a parameter since GBC must update +extern __dhp __sl; /* Can't be a parameter since GBC must update * it */ /* Garbage collections statistics */ @@ -594,7 +595,7 @@ extern __dhp __p; /* RTCK.C */ __dhp __rca (__arrp a); -extern __dhp __ralloc (); +__dhp __ralloc (long); char __rin (__dhp bpx, __pty p); char __rrin (__pty q, __pty p); char __ris (__dhp bpx, __pty p); @@ -604,7 +605,7 @@ char __rgetrv (__refnamepar *p, long as, int ret, void (*mret) ()); char __rgettv (__textnamepar *p, long as, int ret, void (*mret)); char __rgetproc (__procname *p, long as, int ret, void (*mret) ()); char __rgetlab (__labelnamepar *p, long as, int ret, void (*mret) ()); -char __rgetsa (__simplenamepar *p, long as, int ret, void (*mret) ()); +char __rgetsa (__aritnamepar *p, long as, int ret, void (*mret) ()); void __rreturn (long vret, int ret, void (*mret) ()); void __rundump (__txtvp t, int ret, void (*mret) ()); void __rdump (__txtvp t, int ret, void (*mret) ()); @@ -614,6 +615,7 @@ void __rexchange (__dhp sh, __dhp ob, int ret, void (*mret) ()); char __rgetav (char ftype, __aritnamepar *p, long as, int ret, void (*mret) ()); void __rcp (__pty ppx, long as); +void __rcpp (__pty ppx); void __rterror (__txtvp t); void __renddecl (int plev); void __rep (void); @@ -622,9 +624,11 @@ void __rrs (void); void __rcpb (int ret, void (*mret) ()); void __rss (long as); void __rcprb (__pty ppx); +void __rcprbb (int ret, void (*mret) ()); void __reth (void); void __rgbc (void); void __do_for_each_pointer (__dhp p, void (*doit) (), void (*doit_notest) ()); +void __do_for_each_stat_pointer (void (*doit) (), void (*doit_notest) (), int force); void __rgoto (__dhp ob); void __rsystemerror (char *s); void __rendclass (int plev); @@ -643,6 +647,7 @@ void __rstart (int argc, char *argv[]); void __rb (__pty ppx); void __rtrace (void); void __repp (void); +void __rbe (void); /* RTBASICIO.C */ __dhp __rsysin (void); @@ -651,6 +656,7 @@ __dhp __rsyserr (void); /* ENVIRONMENT.C */ +void __init_FILE (void); void __init_SIMENVIR (void); void __rprintfilline (void); void __rhisto (__arrp A, __arrp B, double c, double d); @@ -683,7 +689,6 @@ double __rrdiv0(double i); /* Power functions */ double __rpow (double x, double r); double __rpowri (double r, long i); -extern double __rpow (); /* Text utilities */ char __rchar (long i); @@ -765,10 +770,9 @@ __txtvp __rtstrip (__txtvp t); __txtvp __rcopy (long as, __txtvp t); __txtvp __rblanks (long as, long n); __txtvp __rconc (long as, __txtvp t1x, __txtvp t2x); -extern __txtvp __rtextvalassign (); +__txtvp __rtextvalassign (__txtvp t1x, __txtvp t2x); __txtvp __rtextassign (__txtvp t1x, __txtvp t2x); char __reqrtext (__txtvp t1x, __txtvp t2x); -extern char __reqrtext (); char __reqtext (__txtvp t1x, __txtvp t2x); char __rlttext (__txtvp t1x, __txtvp t2x); char __rletext (__txtvp t1x, __txtvp t2x); @@ -779,7 +783,7 @@ void __rleftshift (__txtvp t, long j); /* FILESYSTEM.C */ -extern long __rfsize (); +long __rfsize (); /* Class file */ __txtvp __rfilename (long as, __bs1FILE *p); @@ -813,7 +817,7 @@ __dhp __rooutimage (__bs2FILE *p) /* Skriver ikke ut etterfolgende blanke */; __dhp __rooutrecord (__bs2FILE *p); __dhp __robreakoutimage (__bs2FILE *p); __dhp __rooutchar (__bs2FILE *p, char c); -extern __dhp __roouttext (); +__dhp __roouttext (__bs2FILE *p, __txtvp t); __dhp __rooutint (__bs2FILE *p, long i, long w); __dhp __rooutfix (__bs2FILE *p, double r, long i, long w); __dhp __rooutreal (__bs2FILE *p, double r, long i, long w); @@ -886,3 +890,5 @@ char **__rcopytextarrtoc (__arrp p, char byvalue); char *__rcopyarrtoc (__arrp p); char *xmalloc (unsigned int size); +void __update_gl_to_obj (void); +void __update_gl_to_null (void); diff --git a/lib/copytexttoc.c b/lib/copytexttoc.c index e37923d..da996b7 100644 --- a/lib/copytexttoc.c +++ b/lib/copytexttoc.c @@ -18,6 +18,7 @@ */ #include "cim.h" +#include /****************************************************************************** RCOPYTEXTTOC */ @@ -26,12 +27,6 @@ * C-prosedyre. Rutinen allokerer plass i C-space ved } bruke malloc, for s} * } kopiere teksten over i dette omr}det. Teksten blir terminert med 0 */ -#if STDC_HEADERS || HAVE_STRING_H -#include -#else -#include -#endif - char *__rcopytexttoc (__txtvp t) { char *p; diff --git a/lib/datetime.c b/lib/datetime.c index 96afbd3..706a7f0 100644 --- a/lib/datetime.c +++ b/lib/datetime.c @@ -71,7 +71,7 @@ __txtvp __rdatetime (long as) tmp->tm_year + 1900, tmp->tm_mon + 1, tmp->tm_mday, tmp->tm_hour, tmp->tm_min, tmp->tm_sec #if HAVE_GETTIMEOFDAY - ,tip.tv_usec / 10000 + , (int)(tip.tv_usec / 10000) #endif ); return (&__et); diff --git a/lib/dbclose.c b/lib/dbclose.c index 4a3d6df..74c544b 100644 --- a/lib/dbclose.c +++ b/lib/dbclose.c @@ -19,6 +19,7 @@ #define INCLUDE_SIMFILE_H #include "cim.h" +#include /****************************************************************************** BOOLEAN PROCEDURE CLOSE */ diff --git a/lib/dbinbyte.c b/lib/dbinbyte.c index bff36ff..39684c6 100644 --- a/lib/dbinbyte.c +++ b/lib/dbinbyte.c @@ -19,6 +19,7 @@ #define INCLUDE_SIMFILE_H #include "cim.h" +#include /****************************************************************************** (SHORT) INTEGER PROCEDURE INBYTE */ @@ -30,7 +31,7 @@ long __rdbinbyte (__bs10FILE *p) __rerror ("Inbyte: Writeonly file"); if (!((__bs1FILE *) p)->open) __rerror ("Inbyte: File closed"); - if (p->lastop == __WRITE + if (p->lastop == __WRITE && fseek (((__bs1FILE *) p)->file, p->loc - 1, 0) == __EOF) __rerror ("Outbyte: Not possible to seek"); p->lastop = __READ; diff --git a/lib/dblastloc.c b/lib/dblastloc.c index 49e1e5b..56109a9 100644 --- a/lib/dblastloc.c +++ b/lib/dblastloc.c @@ -19,6 +19,7 @@ #define INCLUDE_SIMFILE_H #include "cim.h" +#include /****************************************************************************** INTEGER PROCEDURE LASTLOC */ diff --git a/lib/dblocate.c b/lib/dblocate.c index aacdfc6..f2e34d8 100644 --- a/lib/dblocate.c +++ b/lib/dblocate.c @@ -19,6 +19,7 @@ #define INCLUDE_SIMFILE_H #include "cim.h" +#include /****************************************************************************** PROCEDURE LOCATE(i) */ diff --git a/lib/dboutbyte.c b/lib/dboutbyte.c index 14ba0ba..30c99f4 100644 --- a/lib/dboutbyte.c +++ b/lib/dboutbyte.c @@ -19,6 +19,7 @@ #define INCLUDE_SIMFILE_H #include "cim.h" +#include /****************************************************************************** PROCEDURE OUTBYTE(x) */ @@ -33,7 +34,7 @@ __dhp __rdboutbyte (__bs10FILE *p, long x) __rerror ("Outbyte: File overflow"); if (p->loc < p->minwriteloc) __rerror ("Outbyte: Append underflow or read-only file"); - if (p->lastop == __READ + if (p->lastop == __READ && fseek (((__bs1FILE *) p)->file, p->loc - 1, 0) == __EOF) __rerror ("Outbyte: Not possible to seek"); p->lastop = __WRITE; diff --git a/lib/dcheckpoint.c b/lib/dcheckpoint.c index 8bd797d..43ceb69 100644 --- a/lib/dcheckpoint.c +++ b/lib/dcheckpoint.c @@ -19,6 +19,7 @@ #define INCLUDE_SIMFILE_H #include "cim.h" +#include /****************************************************************************** BOOLEAN PROCEDURE CHECKPOINT */ diff --git a/lib/dclose.c b/lib/dclose.c index 570879f..f73d56c 100644 --- a/lib/dclose.c +++ b/lib/dclose.c @@ -19,6 +19,7 @@ #define INCLUDE_SIMFILE_H #include "cim.h" +#include /****************************************************************************** BOOLEAN PROCEDURE CLOSE */ diff --git a/lib/dinimage.c b/lib/dinimage.c index 25c05a0..84465ec 100644 --- a/lib/dinimage.c +++ b/lib/dinimage.c @@ -48,7 +48,7 @@ __dhp __rdinimage (__bs5FILE *p) l = ((__bs5FILE *) p)->imagelength; f = ((__bs1FILE *) p)->file; - if (((__bs5FILE *) p)->endfile = (((__bs5FILE *) p)->loc > __rdlastloc (p))) + if ((((__bs5FILE *) p)->endfile = (((__bs5FILE *) p)->loc > __rdlastloc (p)))) { *(c++) = 25; for (i = 2; i <= l; i++) @@ -56,7 +56,7 @@ __dhp __rdinimage (__bs5FILE *p) } else { - if (p->lastop == __WRITE + if (p->lastop == __WRITE && fseek (((__bs1FILE *) p)->file, 0L, 1) == __EOF) __rerror ("Inimage: Not possible to seek"); p->lastop = __READ; diff --git a/lib/dlastloc.c b/lib/dlastloc.c index 0b976ca..12a3353 100644 --- a/lib/dlastloc.c +++ b/lib/dlastloc.c @@ -19,6 +19,7 @@ #define INCLUDE_SIMFILE_H #include "cim.h" +#include /****************************************************************************** INTEGER PROCEDURE LASTLOC */ diff --git a/lib/dlocate.c b/lib/dlocate.c index 01764d6..82a7408 100644 --- a/lib/dlocate.c +++ b/lib/dlocate.c @@ -19,6 +19,7 @@ #define INCLUDE_SIMFILE_H #include "cim.h" +#include /****************************************************************************** PROCEDURE LOCATE */ @@ -30,7 +31,7 @@ __dhp __rdlocate (__bs5FILE *p, long i) if (p->loc != i) { p->loc = i; - if (fseek (((__bs1FILE *) p)->file, + if (fseek (((__bs1FILE *) p)->file, (i - 1) * (((__bs5FILE *) p)->imagelength + 1), 0) == __EOF) __rerror ("Locate: Not possible to seek"); p->lastop = __SEEK; diff --git a/lib/field.c b/lib/field.c index 3b4e580..a1da11c 100644 --- a/lib/field.c +++ b/lib/field.c @@ -29,13 +29,14 @@ void __rfield (__bs2FILE *p, long w) { if (w > p->IMAGE.length) __rerror ("Outint, outfix etc: Width on out field is greater than IMAGE.length"); - if (p->IMAGE.pos + w - 1 > p->IMAGE.length) + if (p->IMAGE.pos + w - 1 > p->IMAGE.length) { if (((__bs1FILE *) p)->h.pp == &__p6FILE) __rpoutimage (((__bs6FILE *) p)); else if (((__bs1FILE *) p)->h.pp == &__p5FILE) __rdoutimage ((__bs5FILE *) p); else __rooutimage (p); + } __et.obj = p->IMAGE.obj; __et.start = p->IMAGE.start + p->IMAGE.pos - 1; __et.length = w; diff --git a/lib/gbc.c b/lib/gbc.c index c630a8f..8a16cd1 100644 --- a/lib/gbc.c +++ b/lib/gbc.c @@ -34,10 +34,10 @@ /* Denne rutinen g}r igjennom alle stakk-pekere og gj|r utf|rer rutinen * doit for hver data peker. * Denne rutinen kalles fra pass 1 og pass 3 i GBC. - * Dessuten kalles den ogs} fra add_to_pointers i det tilfellet + * Dessuten kalles den ogs} fra add_to_pointers i det tilfellet * at poolen blir flyttet */ -static do_for_stack_pointers (void (*doit) ()) +static void do_for_stack_pointers (void (*doit) (__dhp*)) { int i, ar, @@ -59,10 +59,10 @@ static do_for_stack_pointers (void (*doit) ()) /* Denne rutinen g}r igjennom alle pekere for et dataobjekt * og utf|rer rutinen doit(_notest) for hver data peker. * Denne rutinen kalles fra pass 1 og pass 3 i GBC. - * Dessuten kalles den ogs} fra add_to_pointers i det tilfellet + * Dessuten kalles den ogs} fra add_to_pointers i det tilfellet * at poolen blir flyttet */ -void __do_for_each_pointer (__dhp p, void (*doit) (), void (*doit_notest) ()) +void __do_for_each_pointer (__dhp p, void (*doit) (__dhp*), void (*doit_notest) (__dhp*)) { __dhp *ph, *qh; @@ -180,8 +180,8 @@ static void do_add_to_list (__dhp *qp) /* Brukes som parameter til do_for_stack_pointers og do_for_each_pointer * for } f} oppdatert samtlige pekere til et objekt. * Den gies som parameter til de to nevnte rutinene fra GBC pass 3. - * Den benytter seg av at adressen (etter flytting av objektet) - * til et objekt ligger i objektets GB-ord. + * Den benytter seg av at adressen (etter flytting av objektet) + * til et objekt ligger i objektets GB-ord. * Denne informasjonen er lagt i GB-ordet av GBC pass 2 */ static void do_update_pointer (__dhp *qp) @@ -320,7 +320,7 @@ void __rgbc (void) /* Disse rutinene s|rger for at pekere blir oppdatert etter at pool'en er * flyttet. Do_add_to_pointer brukes som parameter til do_for_stack_pointers * og do_for_each_pointer, slik at pekerene blir oppdatert riktig. - * Legg merke til at det er kun de pekere + * Legg merke til at det er kun de pekere * som peker innenfor poolen som skal oppdateres. * Denne oppdateringen gj|res ved } traversere samtlige objekter p} * samme m}te som i GBC pass 3. */ @@ -371,7 +371,7 @@ static void add_to_pointers (void) __dhp __ralloc (long size) { - void __rgbc (); + //void __rgbc (); static __dhp mem; if (__sto != __NULL) { diff --git a/lib/geta.c b/lib/geta.c index e4e58c6..7588a1d 100644 --- a/lib/geta.c +++ b/lib/geta.c @@ -47,7 +47,7 @@ char __rgeta (__arraynamepar *p, long as, int ret, void (*mret) ()) * lenger peker riktig, leses disse * verdiene f|r kallet. */ __sl = p->sl; - __rct (as); /* Oppretter objektet og overf|rer + __rct (as); /* Oppretter objektet og overf|rer * returadressen. */ ((__thunkp) __pb)->h.ex.ment = mret; ((__thunkp) __pb)->h.ex.ent = ret; @@ -62,4 +62,5 @@ char __rgeta (__arraynamepar *p, long as, int ret, void (*mret) ()) return (__FALSE); } /* NOTREACHED */ + return 0; } diff --git a/lib/getav.c b/lib/getav.c index db8fa97..4fea1e6 100644 --- a/lib/getav.c +++ b/lib/getav.c @@ -57,7 +57,7 @@ char __rgetav (char ftype, __aritnamepar *p, long as, int ret, void (*mret) ()) * lenger peker riktig, leses disse * verdiene f|r kallet. */ - __goto = p->adr; + __goto = p->adr; __sl = p->sl; __rct (as); /* Oppretter objektet */ ((__thunkp) __pb)->conv = tconv; @@ -69,13 +69,13 @@ char __rgetav (char ftype, __aritnamepar *p, long as, int ret, void (*mret) ()) return (__TRUE); case __ADDRESS_NOTHUNK: if (ftype == __TINTG) - __ev.i = (p->conv == __NOCONV + __ev.i = (p->conv == __NOCONV ? *(long *) (((char *) p->bp) + p->v.ofs) : (long) *(double *) (((char *) p->bp) + p->v.ofs)); else - __ev.f = (p->conv == __NOCONV + __ev.f = (p->conv == __NOCONV ? *(double *) (((char *) p->bp) + p->v.ofs) : - p->conv == __INTREAL + p->conv == __INTREAL ? (double) *(long *) (((char *) p->bp) + p->v.ofs) : (double) (long) *(double *) (((char *) p->bp) + p->v.ofs)); #if SPLIT_MODUL @@ -96,4 +96,5 @@ char __rgetav (char ftype, __aritnamepar *p, long as, int ret, void (*mret) ()) return (__FALSE); } /* NOTREACHED */ + return 0; } diff --git a/lib/getcbv.c b/lib/getcbv.c index e9954a1..ee1dc0f 100644 --- a/lib/getcbv.c +++ b/lib/getcbv.c @@ -70,4 +70,5 @@ char __rgetcbv (__charboolnamepar *p, long as, int ret, void (*mret) ()) return (__FALSE); } /* NOTREACHED */ + return 0; } diff --git a/lib/getlab.c b/lib/getlab.c index 44e2eda..001ba24 100644 --- a/lib/getlab.c +++ b/lib/getlab.c @@ -48,7 +48,7 @@ char __rgetlab (__labelnamepar *p, long as, int ret, void (*mret) ()) * lenger peker riktig, leses disse * verdiene forer kallet. */ __sl = p->sl; - __rct (as); /* Oppretter objektet og overf|rer + __rct (as); /* Oppretter objektet og overf|rer * returadressen. */ ((__thunkp) __pb)->h.ex.ment = mret; ((__thunkp) __pb)->h.ex.ent = ret; @@ -65,4 +65,5 @@ char __rgetlab (__labelnamepar *p, long as, int ret, void (*mret) ()) return (__FALSE); } /* NOTREACHED */ + return 0; } diff --git a/lib/getproc.c b/lib/getproc.c index 2f52312..6068d2a 100644 --- a/lib/getproc.c +++ b/lib/getproc.c @@ -64,4 +64,5 @@ char __rgetproc (__procname *p, long as, int ret, void (*mret) ()) return (__FALSE); } /* NOTREACHED */ + return 0; } diff --git a/lib/getrv.c b/lib/getrv.c index 13e8d81..7016495 100644 --- a/lib/getrv.c +++ b/lib/getrv.c @@ -66,7 +66,7 @@ char __rgetrv (__refnamepar *p, long as, int ret, void (*mret) ()) return (__TRUE); case __ADDRESS_NOTHUNK: __er = *(__dhp *) (((char *) p->bp) + p-> v.ofs); - if ((p->conv == __READTEST || p->conv == __READWRITETEST) + if ((p->conv == __READTEST || p->conv == __READWRITETEST) && !__rin (__er, p->q)) __rerror ("Getrv: Wrong qualification"); #if SPLIT_MODUL @@ -83,4 +83,5 @@ char __rgetrv (__refnamepar *p, long as, int ret, void (*mret) ()) return (__FALSE); } /* NOTREACHED */ + return 0; } diff --git a/lib/getsa.c b/lib/getsa.c index abe2f77..9610db3 100644 --- a/lib/getsa.c +++ b/lib/getsa.c @@ -39,7 +39,7 @@ * ret, mret -> Returadressen * Returnerer: Adressen i er og __ev (også hvis en thunk kalles) */ -char __rgetsa (__simplenamepar *p, long as, int ret, void (*mret) ()) +char __rgetsa (__aritnamepar *p, long as, int ret, void (*mret) ()) { switch (p->namekind) { @@ -50,7 +50,7 @@ char __rgetsa (__simplenamepar *p, long as, int ret, void (*mret) ()) case __ADDRESS_THUNK: __goto = p->adr; /* I tilfelle at kallet p} rct f|rer til * garbage collection, slik at p ikke - * lenger peker riktig, leses disse + * lenger peker riktig, leses disse * verdiene f|r kallet. */ __sl = p->sl; __rct (as); /* Oppretter objektet og @@ -70,4 +70,5 @@ char __rgetsa (__simplenamepar *p, long as, int ret, void (*mret) ()) return (__FALSE); } /* NOTREACHED */ + return 0; } diff --git a/lib/getta.c b/lib/getta.c index b11db5e..fe20b1a 100644 --- a/lib/getta.c +++ b/lib/getta.c @@ -29,26 +29,26 @@ char __rgetta (__textnamepar *p, long as, int ret, void (*mret) ()) case __VALUE_THUNK: __goto = p->adr; /* I tilfelle at kallet p} rct f|rer til * garbage collection, slik at p ikke - * lenger peker riktig, leses disse + * lenger peker riktig, leses disse * verdiene f|r kallet. */ __sl = p->sl; __rct (as); /* Oppretter objektet og overf|rer * returadressen. */ ((__thunkp) __pb)->h.ex.ment = mret; - ((__thunkp) __pb)->h.ex.ent = ret; - + ((__thunkp) __pb)->h.ex.ent = ret; + __lb = __pb; /* Gj|r thunken eksikverbar. */ return (__TRUE); case __ADDRESS_THUNK: __goto = p->adr; /* I tilfelle at kallet p} rct f|rer til * garbage collection, slik at p ikke - * lenger peker riktig, leses disse + * lenger peker riktig, leses disse * verdiene f|r kallet. */ __sl = p->sl; __rct (as); /* Oppretter objektet og overf|rer * returadressen. */ ((__thunkp) __pb)->h.ex.ment = mret; - ((__thunkp) __pb)->h.ex.ent = ret; + ((__thunkp) __pb)->h.ex.ent = ret; ((__thunkp) __pb)->writeaccess = __TRUE; __lb = __pb; /* Gj|r thunken eksikverbar. */ return (__TRUE); @@ -69,4 +69,5 @@ char __rgetta (__textnamepar *p, long as, int ret, void (*mret) ()) return (__FALSE); } /* NOTREACHED */ + return 0; } diff --git a/lib/gettv.c b/lib/gettv.c index 39f3928..44dd631 100644 --- a/lib/gettv.c +++ b/lib/gettv.c @@ -50,13 +50,13 @@ char __rgettv (__textnamepar *p, long as, int ret, void (*mret)) case __ADDRESS_THUNK: __goto = p->adr; /* I tilfelle at kallet p} rct f|rer til * garbage collection, slik at p ikke - * lenger peker riktig, leses disse + * lenger peker riktig, leses disse * verdiene f|r kallet. */ __sl = p->sl; __rct (as); /* Oppretter objektet og overf|rer * returadressen. */ ((__thunkp) __pb)->h.ex.ment = mret; - ((__thunkp) __pb)->h.ex.ent = ret; + ((__thunkp) __pb)->h.ex.ent = ret; __lb = __pb; /* Gj|r thunken eksikverbar. */ return (__TRUE); case __ADDRESS_NOTHUNK: @@ -75,4 +75,5 @@ char __rgettv (__textnamepar *p, long as, int ret, void (*mret)) return (__FALSE); } /* NOTREACHED */ + return 0; } diff --git a/lib/ibclose.c b/lib/ibclose.c index f911feb..4caed7d 100644 --- a/lib/ibclose.c +++ b/lib/ibclose.c @@ -19,6 +19,7 @@ #define INCLUDE_SIMFILE_H #include "cim.h" +#include /****************************************************************************** BOOLEAN PROCEDURE CLOSE */ @@ -27,7 +28,7 @@ char __ribclose (__bs8FILE *p) { if (((__bs1FILE *) p)->open) { - if (((__bs1FILE *) p)->re_wind == __REWIND + if (((__bs1FILE *) p)->re_wind == __REWIND && fseek (((__bs1FILE *) p)->file, 0L, 0) == __EOF) __rerror ("Close: Not possible to rewind"); fclose (((__bs1FILE *) p)->file); diff --git a/lib/ibinbyte.c b/lib/ibinbyte.c index 9c7ec14..ba30a15 100644 --- a/lib/ibinbyte.c +++ b/lib/ibinbyte.c @@ -19,6 +19,7 @@ #define INCLUDE_SIMFILE_H #include "cim.h" +#include /****************************************************************************** (SHORT) INTEGER PROCEDURE INBYTE */ diff --git a/lib/iclose.c b/lib/iclose.c index 8a6fb8c..56a7866 100644 --- a/lib/iclose.c +++ b/lib/iclose.c @@ -19,6 +19,7 @@ #define INCLUDE_SIMFILE_H #include "cim.h" +#include /****************************************************************************** BOOLEAN PROCEDURE CLOSE */ @@ -27,7 +28,7 @@ char __riclose (__bs1FILE *p) { if (p->open) { - if (((__bs1FILE *) p)->re_wind == __REWIND + if (((__bs1FILE *) p)->re_wind == __REWIND && fseek (((__bs1FILE *) p)->file, 0L, 0) == __EOF) __rerror ("Close: Not possible to rewind"); fclose (((__bs1FILE *) p)->file); diff --git a/lib/iinimage.c b/lib/iinimage.c index f13ca76..68e3787 100644 --- a/lib/iinimage.c +++ b/lib/iinimage.c @@ -72,4 +72,5 @@ __dhp __riinimage (__bs2FILE *p) return ((__dhp) p); inimageerror: __rerror ("Inimage: IMAGE to short"); + return 0; } diff --git a/lib/lowcase.c b/lib/lowcase.c index 917daa6..3f29b00 100644 --- a/lib/lowcase.c +++ b/lib/lowcase.c @@ -18,6 +18,7 @@ */ #include "cim.h" +#include /****************************************************************************** TEXT PROCEDURE LOWCASE(t) */ @@ -30,8 +31,8 @@ __txtvp __rlowcase (__txtvp t) for (i = 0; i < t->length; i++) s[t->start + i - 1] = - (isalpha (s[t->start + i - 1]) - ? (isupper (s[t->start + i - 1]) + (isalpha (s[t->start + i - 1]) + ? (isupper (s[t->start + i - 1]) ? tolower ((int) s[t->start + i - 1]) : s[t->start + i - 1]) : s[t->start + i - 1]); __et.obj = t->obj; diff --git a/lib/lowten.c b/lib/lowten.c index 4dd0ea8..e2dfeaf 100644 --- a/lib/lowten.c +++ b/lib/lowten.c @@ -18,6 +18,7 @@ */ #include "cim.h" +#include /****************************************************************************** CHARACTER PROCEDURE LOWTEN(c) */ @@ -25,7 +26,7 @@ char __rlowten (char c) { char s; - if (isdigit (c) || c == '+' || c == '-' + if (isdigit (c) || c == '+' || c == '-' || c == '.' || c == ',' || c == 127 || c < 32 || __risorank (c) > 127) __rerror ("Lowten: Illegal character"); diff --git a/lib/normal.c b/lib/normal.c index d450f37..345e646 100644 --- a/lib/normal.c +++ b/lib/normal.c @@ -46,12 +46,8 @@ double __rnormal (double a, double b, long *U) p = 1.0 - u; else p = u; -#if MATHLIB y = sqrt (-log (p * p)); -#else - y = __rsqrt (-__rln (p * p)); -#endif - x = y + ((((y * p4 + p3) * y + p2) * y + p1) * y + p0) + x = y + ((((y * p4 + p3) * y + p2) * y + p1) * y + p0) / ((((y * q4 + q3) * y + q2) * y + q1) * y + q0); if (u < 0.5) x = -x; diff --git a/lib/obclose.c b/lib/obclose.c index 537d317..8bcbff3 100644 --- a/lib/obclose.c +++ b/lib/obclose.c @@ -19,6 +19,7 @@ #define INCLUDE_SIMFILE_H #include "cim.h" +#include /****************************************************************************** BOOLEAN PROCEDURE CLOSE */ diff --git a/lib/oboutbyte.c b/lib/oboutbyte.c index d4830bd..3eb2d53 100644 --- a/lib/oboutbyte.c +++ b/lib/oboutbyte.c @@ -19,6 +19,8 @@ #define INCLUDE_SIMFILE_H #include "cim.h" +#include + /****************************************************************************** PROCEDURE OUTBYTE(x) */ diff --git a/lib/oclose.c b/lib/oclose.c index ec2fadc..21aa832 100644 --- a/lib/oclose.c +++ b/lib/oclose.c @@ -19,6 +19,7 @@ #define INCLUDE_SIMFILE_H #include "cim.h" +#include /****************************************************************************** BOOLEAN PROCEDURE CLOSE */ @@ -27,7 +28,7 @@ char __roclose (__bs1FILE *p) { if (p->open) { - if (((__bs1FILE *) p)->re_wind == __REWIND + if (((__bs1FILE *) p)->re_wind == __REWIND && fseek (((__bs1FILE *) p)->file, 0L, 0) == __EOF) __rerror ("Close: Not possible to rewind"); if (((__bs2FILE *) p)->IMAGE.pos > 1) diff --git a/lib/peject.c b/lib/peject.c index bceb6e9..4307e58 100644 --- a/lib/peject.c +++ b/lib/peject.c @@ -19,6 +19,7 @@ #define INCLUDE_SIMFILE_H #include "cim.h" +#include /****************************************************************************** PROCEDURE EJECT */ diff --git a/lib/pow.c b/lib/pow.c index d75dae2..6891fe5 100644 --- a/lib/pow.c +++ b/lib/pow.c @@ -25,7 +25,7 @@ double __rpow (double x, double r) { - if (x < 0.0 | (x == 0.0 & r <= 0.0)) + if (x < 0.0 || (x == 0.0 & r <= 0.0)) __rerror ("Power: Illegal parameters"); return (x > 0 ? exp (r * log (x)) : 0.0); } diff --git a/lib/setaccess.c b/lib/setaccess.c index 7ad0c60..7219127 100644 --- a/lib/setaccess.c +++ b/lib/setaccess.c @@ -20,6 +20,7 @@ #define INCLUDE_SIMFILE_H #include "cim.h" #include +#include /****************************************************************************** BOOLEAN PROCEDURE SETACCESS */ @@ -73,7 +74,7 @@ char __rsetaccess (__bs1FILE *p, __txtvp t) p->purge = __NOPURGE; return (__TRUE); } - if (ppx->pref[2] == &__p5FILE || ppx->pref[2] == &__p10FILE) + if (ppx->pref[2] == &__p5FILE || ppx->pref[2] == &__p10FILE) /* DIRECT FILES */ { if (length == 8 && __rcompstr (s, "READONLY", 8)) @@ -113,7 +114,7 @@ char __rsetaccess (__bs1FILE *p, __txtvp t) if (length == 10 && __rcompstr (s, "BYTESIZE:0", 10)) return (__TRUE); } - if (!(ppx->pref[2] == &__p4FILE || ppx->pref[2] == &__p8FILE)) + if (!(ppx->pref[2] == &__p4FILE || ppx->pref[2] == &__p8FILE)) /* NOT IN FILES */ { if (length == 6 && __rcompstr (s, "APPEND", 6)) diff --git a/lib/simset.c b/lib/simset.c new file mode 100644 index 0000000..a1c8417 --- /dev/null +++ b/lib/simset.c @@ -0,0 +1,374 @@ +/*Cim_ccode*/ +#include "./cim.h" +void __m_SIMSET(); +__map __mapSIMSET[3]={"simset.sim",0L,1L, +"",-123L,124L, +"",0L,2147483647L}; +typedef struct /* */ + { + __dh h; + __dhp c1; + __dhp c2; + } __bs0; +extern __bs0 __blokk0FILE; +extern __ptyp __p0FILE; +typedef struct /* FILE */ + { + __dh h; + __txt filename; + long file; + char open; + char shared; + char append; + char create; + char readwrite; + char re_wind; + char purge; + } __bs96; +extern __ptyp __p1FILE; +typedef struct /* IMAGEFILE */ + { + __bs96 s; + __txt IMAGE; + } __bs100; +extern __ptyp __p2FILE; +typedef struct /* OUTFILE */ + { + __bs100 s; + } __bs105; +extern __ptyp __p3FILE; +typedef struct /* INFILE */ + { + __bs100 s; + char endfile; + } __bs118; +extern __ptyp __p4FILE; +typedef struct /* DIRECTFILE */ + { + __bs100 s; + long loc; + long maxloc; + long minwriteloc; + long imagelength; + char endfile; + char locked; + char lastop; + char writeonly; + } __bs130; +extern __ptyp __p5FILE; +typedef struct /* PRINTFILE */ + { + __bs105 s; + long line; + long lines_per_page; + long spacing; + long page; + } __bs157; +extern __ptyp __p6FILE; +typedef struct /* BYTEFILE */ + { + __bs96 s; + char endfile; + char bytesize; + } __bs167; +extern __ptyp __p7FILE; +typedef struct /* INBYTEFILE */ + { + __bs167 s; + } __bs169; +extern __ptyp __p8FILE; +typedef struct /* OUTBYTEFILE */ + { + __bs167 s; + } __bs175; +extern __ptyp __p9FILE; +typedef struct /* DIRECTBYTEFILE */ + { + __bs167 s; + long loc; + long maxloc; + long minwriteloc; + char locked; + char lastop; + char writeonly; + } __bs181; +extern __ptyp __p10FILE; +typedef struct /* */ + { + __dh h; + } __bs205; +__bs205 __blokk205SIMSET; +extern __ptyp __p205SIMSET;__pty __pl205SIMSET[1]={&__p205SIMSET}; +__ptyp __p205SIMSET={'B',0,1,sizeof(__bs205),0,0,0,0,0,0,0,0,__pl205SIMSET,__NULL}; +extern __ptyp __p206SIMSET; +typedef struct /* SIMSET */ + { + __dh h; + } __bs206; +extern __ptyp __p206SIMSET;__pty __pl206SIMSET[8]={&__p206SIMSET}; +__ptyp __p206SIMSET={'C',0,2,sizeof(__bs206),2,__m_SIMSET,0,0,0,0,0,0,__pl206SIMSET,__NULL}; +extern __ptyp __p207SIMSET; +typedef struct /* LINKAGE */ + { + __dh h; + __dhp zzsuc; + __dhp zzpred; + } __bs207; +short __rl207SIMSET[2]={(short)((char *)&((__bs207 *)0)->zzsuc-(char *)0),(short)((char *)&((__bs207 *)0)->zzpred-(char *)0),}; +extern __ptyp __p207SIMSET;__pty __pl207SIMSET[8]={&__p207SIMSET}; +__ptyp __p207SIMSET={'C',0,3,sizeof(__bs207),5,__m_SIMSET,0,0,2,0,__rl207SIMSET,0,__pl207SIMSET,__NULL}; +typedef struct /* SUC */ + { + __dh h; + __dhp er; + } __bs208; +short __rl208SIMSET[1]={(short)((char *)&((__bs208 *)0)->er-(char *)0),}; +extern __ptyp __p208SIMSET;__pty __pl208SIMSET[8]={&__p208SIMSET}; +__ptyp __p208SIMSET={'P',0,4,sizeof(__bs208),8,__m_SIMSET,0,0,1,0,__rl208SIMSET,0,__pl208SIMSET,__NULL}; +typedef struct /* PRED */ + { + __dh h; + __dhp er; + } __bs209; +short __rl209SIMSET[1]={(short)((char *)&((__bs209 *)0)->er-(char *)0),}; +extern __ptyp __p209SIMSET;__pty __pl209SIMSET[8]={&__p209SIMSET}; +__ptyp __p209SIMSET={'P',0,4,sizeof(__bs209),9,__m_SIMSET,0,0,1,0,__rl209SIMSET,0,__pl209SIMSET,__NULL}; +typedef struct /* PREV */ + { + __dh h; + __dhp er; + } __bs210; +short __rl210SIMSET[1]={(short)((char *)&((__bs210 *)0)->er-(char *)0),}; +extern __ptyp __p210SIMSET;__pty __pl210SIMSET[8]={&__p210SIMSET}; +__ptyp __p210SIMSET={'P',0,4,sizeof(__bs210),10,__m_SIMSET,0,0,1,0,__rl210SIMSET,0,__pl210SIMSET,__NULL}; +extern __ptyp __p211SIMSET; +typedef struct /* LINK */ + { + __bs207 s; + } __bs211; +extern __ptyp __p211SIMSET;__pty __pl211SIMSET[8]={&__p207SIMSET,&__p211SIMSET}; +__ptyp __p211SIMSET={'C',1,3,sizeof(__bs211),11,__m_SIMSET,0,0,0,0,0,0,__pl211SIMSET,__NULL}; +typedef struct /* OUT */ + { + __dh h; + } __bs212; +extern __ptyp __p212SIMSET;__pty __pl212SIMSET[1]={&__p212SIMSET}; +__ptyp __p212SIMSET={'P',0,4,sizeof(__bs212),14,__m_SIMSET,0,0,0,0,0,0,__pl212SIMSET,__NULL}; +typedef struct /* FOLLOW */ + { + __dh h; + __dhp PTR; + __dhp __r1; + } __bs213; +short __rl213SIMSET[2]={(short)((char *)&((__bs213 *)0)->__r1-(char *)0),(short)((char *)&((__bs213 *)0)->PTR-(char *)0),}; +extern __ptyp __p213SIMSET;__pty __pl213SIMSET[1]={&__p213SIMSET}; +__ptyp __p213SIMSET={'P',0,4,sizeof(__bs213),15,__m_SIMSET,0,0,2,0,__rl213SIMSET,0,__pl213SIMSET,__NULL}; +typedef struct /* PRECEDE */ + { + __dh h; + __dhp PTR; + __dhp __r1; + } __bs214; +short __rl214SIMSET[2]={(short)((char *)&((__bs214 *)0)->__r1-(char *)0),(short)((char *)&((__bs214 *)0)->PTR-(char *)0),}; +extern __ptyp __p214SIMSET;__pty __pl214SIMSET[1]={&__p214SIMSET}; +__ptyp __p214SIMSET={'P',0,4,sizeof(__bs214),16,__m_SIMSET,0,0,2,0,__rl214SIMSET,0,__pl214SIMSET,__NULL}; +typedef struct /* INTO */ + { + __dh h; + __dhp S; + } __bs215; +short __rl215SIMSET[1]={(short)((char *)&((__bs215 *)0)->S-(char *)0),}; +extern __ptyp __p215SIMSET;__pty __pl215SIMSET[1]={&__p215SIMSET}; +__ptyp __p215SIMSET={'P',0,4,sizeof(__bs215),17,__m_SIMSET,0,0,1,0,__rl215SIMSET,0,__pl215SIMSET,__NULL}; +extern __ptyp __p216SIMSET; +typedef struct /* HEAD */ + { + __bs207 s; + } __bs216; +extern __ptyp __p216SIMSET;__pty __pl216SIMSET[8]={&__p207SIMSET,&__p216SIMSET}; +__ptyp __p216SIMSET={'C',1,3,sizeof(__bs216),18,__m_SIMSET,0,0,0,0,0,0,__pl216SIMSET,__NULL}; +typedef struct /* FIRST */ + { + __dh h; + __dhp er; + } __bs217; +short __rl217SIMSET[1]={(short)((char *)&((__bs217 *)0)->er-(char *)0),}; +extern __ptyp __p217SIMSET;__pty __pl217SIMSET[8]={&__p217SIMSET}; +__ptyp __p217SIMSET={'P',0,4,sizeof(__bs217),21,__m_SIMSET,0,0,1,0,__rl217SIMSET,0,__pl217SIMSET,__NULL}; +typedef struct /* LAST */ + { + __dh h; + __dhp er; + } __bs218; +short __rl218SIMSET[1]={(short)((char *)&((__bs218 *)0)->er-(char *)0),}; +extern __ptyp __p218SIMSET;__pty __pl218SIMSET[8]={&__p218SIMSET}; +__ptyp __p218SIMSET={'P',0,4,sizeof(__bs218),22,__m_SIMSET,0,0,1,0,__rl218SIMSET,0,__pl218SIMSET,__NULL}; +typedef struct /* EMPTY */ + { + __dh h; + char ec; + } __bs219; +extern __ptyp __p219SIMSET;__pty __pl219SIMSET[1]={&__p219SIMSET}; +__ptyp __p219SIMSET={'P',0,4,sizeof(__bs219),23,__m_SIMSET,0,0,0,0,0,0,__pl219SIMSET,__NULL}; +typedef struct /* CARDINAL */ + { + __dh h; + long I; + __dhp PTR; + long ev; + } __bs220; +short __rl220SIMSET[1]={(short)((char *)&((__bs220 *)0)->PTR-(char *)0),}; +extern __ptyp __p220SIMSET;__pty __pl220SIMSET[1]={&__p220SIMSET}; +__ptyp __p220SIMSET={'P',0,4,sizeof(__bs220),24,__m_SIMSET,0,0,1,0,__rl220SIMSET,0,__pl220SIMSET,__NULL}; +typedef struct /* CLEAR */ + { + __dh h; + __dhp PTR; + __dhp PTRSUC; + __dhp __r1; + } __bs221; +short __rl221SIMSET[3]={(short)((char *)&((__bs221 *)0)->__r1-(char *)0),(short)((char *)&((__bs221 *)0)->PTR-(char *)0),(short)((char *)&((__bs221 *)0)->PTRSUC-(char *)0),}; +extern __ptyp __p221SIMSET;__pty __pl221SIMSET[1]={&__p221SIMSET}; +__ptyp __p221SIMSET={'P',0,4,sizeof(__bs221),25,__m_SIMSET,0,0,3,0,__rl221SIMSET,0,__pl221SIMSET,__NULL}; +void __m_SIMSET(void){goto __s; +# 25 "simset.sim" +__sto= (__dhp)&__blokk205SIMSET;__rb(&__p205SIMSET);goto __ll0;/* START CLASS SIMSET *//* START CLASS LINKAGE *//* START PROCEDURE SUC */__l8: +# 31 "simset.sim" + +# 32 "simset.sim" +;((__bs208 *)__lb)->er=(((__bp=(__rin(((__bs207 *)__lb->sl)->zzsuc,&__p211SIMSET)?((__bs207 *)__lb->sl)->zzsuc:__NULL))!=__NULL && (__bp->pp->pref[1]!= &__p211SIMSET))?(__dhp)__rerror(__errqual):__bp);__er=((__bs208 *)__lb)->er;__rep();goto __sw;/* SLUTT PROCEDURE SUC *//* START PROCEDURE PRED */__l9: +# 34 "simset.sim" + +# 35 "simset.sim" +;((__bs209 *)__lb)->er=(((__bp=(__rin(((__bs207 *)__lb->sl)->zzpred,&__p211SIMSET)?((__bs207 *)__lb->sl)->zzpred:__NULL))!=__NULL && (__bp->pp->pref[1]!= &__p211SIMSET))?(__dhp)__rerror(__errqual):__bp);__er=((__bs209 *)__lb)->er;__rep();goto __sw;/* SLUTT PROCEDURE PRED *//* START PROCEDURE PREV */__l10: +# 37 "simset.sim" +;((__bs210 *)__lb)->er=((__bs207 *)__lb->sl)->zzpred;__er=((__bs210 *)__lb)->er;__rep();goto __sw;/* SLUTT PROCEDURE PREV */__l5: +# 28 "simset.sim" +__renddecl(0);goto __sw;__l6:__rinner(0);goto __sw;__l7: +# 39 "simset.sim" +__rendclass(0);goto __sw;/* SLUTT CLASS LINKAGE *//* START CLASS LINK *//* START PROCEDURE OUT */__l14: +# 45 "simset.sim" + +# 46 "simset.sim" +;if(!((((__bs207 *)__lb->sl)->zzsuc!=__NULL)))goto __ll1; +# 47 "simset.sim" +;((__bs207 *)((__bp=((__bs207 *)__lb->sl)->zzsuc)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzpred=((__bs207 *)__lb->sl)->zzpred; +# 48 "simset.sim" +;((__bs207 *)((__bp=((__bs207 *)__lb->sl)->zzpred)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsuc=((__bs207 *)__lb->sl)->zzsuc; +# 49 "simset.sim" +;((__bs207 *)__lb->sl)->zzsuc=((__bs207 *)__lb->sl)->zzpred=__NULL; +# 50 "simset.sim" +__ll1:__repp();goto __sw;/* SLUTT PROCEDURE OUT *//* START PROCEDURE FOLLOW */__l15: +# 52 "simset.sim" +if((__bp=((__bs213 *)__lb)->PTR)!=__NULL && (__bp->pp->pref[0]!= &__p207SIMSET))__rerror(__errqual); +# 53 "simset.sim" +__sl=__lb->sl;__rcpp(&__p212SIMSET);__rcpb(26,__m_SIMSET);goto __sw;__l26:;; +# 54 "simset.sim" +;if(!(((((__bs213 *)__lb)->PTR!=__NULL)&&(((__bs207 *)((__bp=((__bs213 *)__lb)->PTR)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsuc!=__NULL))))goto __ll2; +# 55 "simset.sim" +;((__bs207 *)__lb->sl)->zzpred=((__bs213 *)__lb)->PTR; +# 56 "simset.sim" +;((__bs207 *)__lb->sl)->zzsuc=((__bs207 *)((__bp=((__bs213 *)__lb)->PTR)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsuc; +# 57 "simset.sim" +(((__bs213 *)__lb)->__r1=(((__bs207 *)__lb->sl)->zzsuc));((__bs207 *)((__bp=((__bs213 *)__lb)->__r1)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzpred=((__bs207 *)((__bp=((__bs213 *)__lb)->PTR)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsuc=__lb->sl; +# 58 "simset.sim" +__ll2:__repp();goto __sw;/* SLUTT PROCEDURE FOLLOW *//* START PROCEDURE PRECEDE */__l16: +# 60 "simset.sim" +if((__bp=((__bs214 *)__lb)->PTR)!=__NULL && (__bp->pp->pref[0]!= &__p207SIMSET))__rerror(__errqual); +# 61 "simset.sim" +__sl=__lb->sl;__rcpp(&__p212SIMSET);__rcpb(27,__m_SIMSET);goto __sw;__l27:;; +# 62 "simset.sim" +;if(!(((((__bs214 *)__lb)->PTR!=__NULL)&&(((__bs207 *)((__bp=((__bs214 *)__lb)->PTR)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzpred!=__NULL))))goto __ll3; +# 63 "simset.sim" +;((__bs207 *)__lb->sl)->zzsuc=((__bs214 *)__lb)->PTR; +# 64 "simset.sim" +;((__bs207 *)__lb->sl)->zzpred=((__bs207 *)((__bp=((__bs214 *)__lb)->PTR)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzpred; +# 65 "simset.sim" +(((__bs214 *)__lb)->__r1=(((__bs207 *)__lb->sl)->zzpred));((__bs207 *)((__bp=((__bs214 *)__lb)->__r1)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsuc=((__bs207 *)((__bp=((__bs214 *)__lb)->PTR)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzpred=__lb->sl; +# 66 "simset.sim" +__ll3:__repp();goto __sw;/* SLUTT PROCEDURE PRECEDE *//* START PROCEDURE INTO */__l17: +# 68 "simset.sim" +if((__bp=((__bs215 *)__lb)->S)!=__NULL && (__bp->pp->pref[1]!= &__p216SIMSET))__rerror(__errqual);__sl=__lb->sl;__rcpp(&__p214SIMSET);((__bs214 *)__pb)->PTR=((__bs215 *)__lb)->S;__rcpb(28,__m_SIMSET);goto __sw;__l28:;;__repp();goto __sw;/* SLUTT PROCEDURE INTO */__l11: +# 42 "simset.sim" +__renddecl(1);goto __sw;__l12:__rinner(1);goto __sw;__l13: +# 70 "simset.sim" +__rendclass(1);goto __sw;/* SLUTT CLASS LINK *//* START CLASS HEAD *//* START PROCEDURE FIRST */__l21: +# 76 "simset.sim" + +# 78 "simset.sim" +;((__bs217 *)__lb)->er=(((__bp=(__rin(((__bs207 *)__lb->sl)->zzsuc,&__p211SIMSET)?((__bs207 *)__lb->sl)->zzsuc:__NULL))!=__NULL && (__bp->pp->pref[1]!= &__p211SIMSET))?(__dhp)__rerror(__errqual):__bp);__er=((__bs217 *)__lb)->er;__rep();goto __sw;/* SLUTT PROCEDURE FIRST *//* START PROCEDURE LAST */__l22: +# 80 "simset.sim" + +# 82 "simset.sim" +;((__bs218 *)__lb)->er=(((__bp=(__rin(((__bs207 *)__lb->sl)->zzpred,&__p211SIMSET)?((__bs207 *)__lb->sl)->zzpred:__NULL))!=__NULL && (__bp->pp->pref[1]!= &__p211SIMSET))?(__dhp)__rerror(__errqual):__bp);__er=((__bs218 *)__lb)->er;__rep();goto __sw;/* SLUTT PROCEDURE LAST *//* START PROCEDURE EMPTY */__l23: +# 84 "simset.sim" +;(((__bs219 *)__lb)->ec=((((__bs207 *)__lb->sl)->zzsuc==__lb->sl)));__ev.c=((__bs219 *)__lb)->ec;__rep();goto __sw;/* SLUTT PROCEDURE EMPTY *//* START PROCEDURE CARDINAL */__l24: +# 86 "simset.sim" + +# 94 "simset.sim" +;((__bs220 *)__lb)->PTR=((__bs207 *)__lb->sl)->zzsuc; +# 95 "simset.sim" +__ll4:;if(!((((__bs220 *)__lb)->PTR!=__lb->sl)))goto __ll5; +# 96 "simset.sim" +;(((__bs220 *)__lb)->I=((((__bs220 *)__lb)->I+1L))); +# 97 "simset.sim" +;((__bs220 *)__lb)->PTR=((__bs207 *)((__bp=((__bs220 *)__lb)->PTR)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsuc; +# 98 "simset.sim" +goto __ll4;__ll5: +# 101 "simset.sim" +;(((__bs220 *)__lb)->ev=(((__bs220 *)__lb)->I));__ev.i=((__bs220 *)__lb)->ev;__rep();goto __sw;/* SLUTT PROCEDURE CARDINAL *//* START PROCEDURE CLEAR */__l25: +# 104 "simset.sim" + +# 107 "simset.sim" +;((__bs221 *)__lb)->PTR=((__bs207 *)__lb->sl)->zzsuc; +# 108 "simset.sim" +__ll6:;if(!((((__bs221 *)__lb)->PTR!=__lb->sl)))goto __ll7; +# 110 "simset.sim" +;((__bs221 *)__lb)->PTRSUC=((__bs207 *)((__bp=((__bs221 *)__lb)->PTR)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsuc; +# 111 "simset.sim" +(((__bs221 *)__lb)->__r1=(((__bs221 *)__lb)->PTR));((__bs207 *)((__bp=((__bs221 *)__lb)->__r1)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsuc=((__bs207 *)((__bp=((__bs221 *)__lb)->PTR)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzpred=__NULL; +# 112 "simset.sim" +;((__bs221 *)__lb)->PTR=((__bs221 *)__lb)->PTRSUC; +# 113 "simset.sim" +goto __ll6;__ll7: +# 115 "simset.sim" +;((__bs207 *)__lb->sl)->zzsuc=((__bs207 *)__lb->sl)->zzpred=__lb->sl;__repp();goto __sw;/* SLUTT PROCEDURE CLEAR */__l18: +# 73 "simset.sim" +__renddecl(1);goto __sw;__l19: +# 118 "simset.sim" +;((__bs207 *)__lb)->zzsuc=((__bs207 *)__lb)->zzpred=__lb; +# 73 "simset.sim" +__rinner(1);goto __sw;__l20: +# 118 "simset.sim" +__rendclass(1);goto __sw;/* SLUTT CLASS HEAD */__l2: +# 25 "simset.sim" +__renddecl(0);goto __sw;__l3:__rinner(0);goto __sw;__l4: +# 120 "simset.sim" +__rendclass(0);goto __sw;/* SLUTT CLASS SIMSET */__ll0:__rbe();__sw:if(__goto.ment!=(void (*)())__m_SIMSET)return;__s:switch(__goto.ent){case 2: goto __l2; +case 3: goto __l3; +case 4: goto __l4; +case 5: goto __l5; +case 6: goto __l6; +case 7: goto __l7; +case 8: goto __l8; +case 9: goto __l9; +case 10: goto __l10; +case 11: goto __l11; +case 12: goto __l12; +case 13: goto __l13; +case 14: goto __l14; +case 15: goto __l15; +case 16: goto __l16; +case 17: goto __l17; +case 18: goto __l18; +case 19: goto __l19; +case 20: goto __l20; +case 21: goto __l21; +case 22: goto __l22; +case 23: goto __l23; +case 24: goto __l24; +case 25: goto __l25; +case 26: goto __l26; +case 27: goto __l27; +case 28: goto __l28; +}} diff --git a/lib/simulation.c b/lib/simulation.c new file mode 100644 index 0000000..ae390ad --- /dev/null +++ b/lib/simulation.c @@ -0,0 +1,645 @@ +/*Cim_ccode*/ +#include "./cim.h" +struct __tt1 {__txt tvar;__th h;char string[27];} +__tk1SIMULATION={(__textref)&__tk1SIMULATION.h.pp,26,1,1,(__pty)__TEXT,(__dhp)&__tk1SIMULATION.h.pp,__CONSTANT,26,"No\040Evtime\040for\040idle\040process"}; +struct __tt2 {__txt tvar;__th h;char string[11];} +__tk2SIMULATION={(__textref)&__tk2SIMULATION.h.pp,10,1,1,(__pty)__TEXT,(__dhp)&__tk2SIMULATION.h.pp,__CONSTANT,10,"SQS:\040Empty"}; +struct __tt3 {__txt tvar;__th h;char string[24];} +__tk3SIMULATION={(__textref)&__tk3SIMULATION.h.pp,23,1,1,(__pty)__TEXT,(__dhp)&__tk3SIMULATION.h.pp,__CONSTANT,23,"SQS:\040Terminated\040process"}; +struct __tt4 {__txt tvar;__th h;char string[11];} +__tk4SIMULATION={(__textref)&__tk4SIMULATION.h.pp,10,1,1,(__pty)__TEXT,(__dhp)&__tk4SIMULATION.h.pp,__CONSTANT,10,"SQS:\040Empty"}; +struct __tt5 {__txt tvar;__th h;char string[11];} +__tk5SIMULATION={(__textref)&__tk5SIMULATION.h.pp,10,1,1,(__pty)__TEXT,(__dhp)&__tk5SIMULATION.h.pp,__CONSTANT,10,"SQS:\040Empty"}; +struct __tt6 {__txt tvar;__th h;char string[11];} +__tk6SIMULATION={(__textref)&__tk6SIMULATION.h.pp,10,1,1,(__pty)__TEXT,(__dhp)&__tk6SIMULATION.h.pp,__CONSTANT,10,"SQS:\040Empty"}; +struct __tt7 {__txt tvar;__th h;char string[11];} +__tk7SIMULATION={(__textref)&__tk7SIMULATION.h.pp,10,1,1,(__pty)__TEXT,(__dhp)&__tk7SIMULATION.h.pp,__CONSTANT,10,"SQS:\040Empty"}; +void __m_SIMULATION(); +__map __mapSIMULATION[3]={"simulation.sim",0L,1L, +"",-233L,234L, +"",0L,2147483647L}; +typedef struct /* */ + { + __dh h; + __dhp c1; + __dhp c2; + } __bs0; +extern __bs0 __blokk0FILE; +extern __ptyp __p0FILE; +typedef struct /* FILE */ + { + __dh h; + __txt filename; + long file; + char open; + char shared; + char append; + char create; + char readwrite; + char re_wind; + char purge; + } __bs96; +extern __ptyp __p1FILE; +typedef struct /* IMAGEFILE */ + { + __bs96 s; + __txt IMAGE; + } __bs100; +extern __ptyp __p2FILE; +typedef struct /* OUTFILE */ + { + __bs100 s; + } __bs105; +extern __ptyp __p3FILE; +typedef struct /* INFILE */ + { + __bs100 s; + char endfile; + } __bs118; +extern __ptyp __p4FILE; +typedef struct /* DIRECTFILE */ + { + __bs100 s; + long loc; + long maxloc; + long minwriteloc; + long imagelength; + char endfile; + char locked; + char lastop; + char writeonly; + } __bs130; +extern __ptyp __p5FILE; +typedef struct /* PRINTFILE */ + { + __bs105 s; + long line; + long lines_per_page; + long spacing; + long page; + } __bs157; +extern __ptyp __p6FILE; +typedef struct /* BYTEFILE */ + { + __bs96 s; + char endfile; + char bytesize; + } __bs167; +extern __ptyp __p7FILE; +typedef struct /* INBYTEFILE */ + { + __bs167 s; + } __bs169; +extern __ptyp __p8FILE; +typedef struct /* OUTBYTEFILE */ + { + __bs167 s; + } __bs175; +extern __ptyp __p9FILE; +typedef struct /* DIRECTBYTEFILE */ + { + __bs167 s; + long loc; + long maxloc; + long minwriteloc; + char locked; + char lastop; + char writeonly; + } __bs181; +extern __ptyp __p10FILE; +typedef struct /* */ + { + __dh h; + } __bs205; +__bs205 __blokk205SIMULATION; +extern __ptyp __p205SIMULATION;__pty __pl205SIMULATION[1]={&__p205SIMULATION}; +__ptyp __p205SIMULATION={'B',0,1,sizeof(__bs205),0,0,0,0,0,0,0,0,__pl205SIMULATION,__NULL}; +extern void __m_SIMSET(); +typedef struct /* SIMSET */ + { + __dh h; + } __bs206; +extern __ptyp __p206SIMSET; +typedef struct /* LINKAGE */ + { + __dh h; + __dhp zzsuc; + __dhp zzpred; + } __bs207; +extern __ptyp __p207SIMSET; +typedef struct /* SUC */ + { + __dh h; + __dhp er; + } __bs208; +extern __ptyp __p208SIMSET; +typedef struct /* PRED */ + { + __dh h; + __dhp er; + } __bs209; +extern __ptyp __p209SIMSET; +typedef struct /* PREV */ + { + __dh h; + __dhp er; + } __bs210; +extern __ptyp __p210SIMSET; +typedef struct /* LINK */ + { + __bs207 s; + } __bs211; +extern __ptyp __p211SIMSET; +typedef struct /* OUT */ + { + __dh h; + } __bs212; +extern __ptyp __p212SIMSET; +typedef struct /* FOLLOW */ + { + __dh h; + __dhp PTR; + } __bs213; +extern __ptyp __p213SIMSET; +typedef struct /* PRECEDE */ + { + __dh h; + __dhp PTR; + } __bs214; +extern __ptyp __p214SIMSET; +typedef struct /* INTO */ + { + __dh h; + __dhp S; + } __bs215; +extern __ptyp __p215SIMSET; +typedef struct /* HEAD */ + { + __bs207 s; + } __bs216; +extern __ptyp __p216SIMSET; +typedef struct /* FIRST */ + { + __dh h; + __dhp er; + } __bs217; +extern __ptyp __p217SIMSET; +typedef struct /* LAST */ + { + __dh h; + __dhp er; + } __bs218; +extern __ptyp __p218SIMSET; +typedef struct /* EMPTY */ + { + __dh h; + char ec; + } __bs219; +extern __ptyp __p219SIMSET; +typedef struct /* CARDINAL */ + { + __dh h; + long ev; + } __bs220; +extern __ptyp __p220SIMSET; +typedef struct /* CLEAR */ + { + __dh h; + } __bs221; +extern __ptyp __p221SIMSET; +extern __ptyp __p222SIMULATION; +typedef struct /* SIMULATION */ + { + __bs206 s; + __dhp zzsqs; + __dhp MAIN; + __dhp __r1; + } __bs222; +short __rl222SIMULATION[3]={(short)((char *)&((__bs222 *)0)->__r1-(char *)0),(short)((char *)&((__bs222 *)0)->zzsqs-(char *)0),(short)((char *)&((__bs222 *)0)->MAIN-(char *)0),}; +extern __ptyp __p222SIMULATION;__pty __pl222SIMULATION[8]={&__p206SIMSET,&__p222SIMULATION}; +__ptyp __p222SIMULATION={'C',1,2,sizeof(__bs222),2,__m_SIMULATION,0,0,3,0,__rl222SIMULATION,0,__pl222SIMULATION,__NULL}; +typedef struct /* CURRENT */ + { + __dh h; + __dhp er; + } __bs223; +short __rl223SIMULATION[1]={(short)((char *)&((__bs223 *)0)->er-(char *)0),}; +extern __ptyp __p223SIMULATION;__pty __pl223SIMULATION[8]={&__p223SIMULATION}; +__ptyp __p223SIMULATION={'P',0,3,sizeof(__bs223),5,__m_SIMULATION,0,0,1,0,__rl223SIMULATION,0,__pl223SIMULATION,__NULL}; +typedef struct /* TIME */ + { + __dh h; + double ef; + } __bs224; +extern __ptyp __p224SIMULATION;__pty __pl224SIMULATION[1]={&__p224SIMULATION}; +__ptyp __p224SIMULATION={'P',0,3,sizeof(__bs224),6,__m_SIMULATION,0,0,0,0,0,0,__pl224SIMULATION,__NULL}; +extern __ptyp __p225SIMULATION; +typedef struct /* PROCESS */ + { + __bs211 s; + __dhp zzsqssuc; + __dhp zzsqspred; + double zzevtime; + char zzterminated_process; + } __bs225; +short __rl225SIMULATION[2]={(short)((char *)&((__bs225 *)0)->zzsqssuc-(char *)0),(short)((char *)&((__bs225 *)0)->zzsqspred-(char *)0),}; +extern __ptyp __p225SIMULATION;__pty __pl225SIMULATION[8]={&__p207SIMSET,&__p211SIMSET,&__p225SIMULATION}; +__ptyp __p225SIMULATION={'C',2,3,sizeof(__bs225),7,__m_SIMULATION,0,0,2,0,__rl225SIMULATION,0,__pl225SIMULATION,__NULL}; +typedef struct /* IDLE */ + { + __dh h; + char ec; + } __bs226; +extern __ptyp __p226SIMULATION;__pty __pl226SIMULATION[1]={&__p226SIMULATION}; +__ptyp __p226SIMULATION={'P',0,4,sizeof(__bs226),10,__m_SIMULATION,0,0,0,0,0,0,__pl226SIMULATION,__NULL}; +typedef struct /* TERMINATED */ + { + __dh h; + char ec; + } __bs227; +extern __ptyp __p227SIMULATION;__pty __pl227SIMULATION[1]={&__p227SIMULATION}; +__ptyp __p227SIMULATION={'P',0,4,sizeof(__bs227),11,__m_SIMULATION,0,0,0,0,0,0,__pl227SIMULATION,__NULL}; +typedef struct /* EVTIME */ + { + __dh h; + double ef; + } __bs228; +extern __ptyp __p228SIMULATION;__pty __pl228SIMULATION[1]={&__p228SIMULATION}; +__ptyp __p228SIMULATION={'P',0,4,sizeof(__bs228),12,__m_SIMULATION,0,0,0,0,0,0,__pl228SIMULATION,__NULL}; +typedef struct /* NEXTEV */ + { + __dh h; + __dhp er; + } __bs229; +short __rl229SIMULATION[1]={(short)((char *)&((__bs229 *)0)->er-(char *)0),}; +extern __ptyp __p229SIMULATION;__pty __pl229SIMULATION[8]={&__p229SIMULATION}; +__ptyp __p229SIMULATION={'P',0,4,sizeof(__bs229),13,__m_SIMULATION,0,0,1,0,__rl229SIMULATION,0,__pl229SIMULATION,__NULL}; +typedef struct /* activat */ + { + __dh h; + char REAC; + __dhp X; + char CODE; + double T; + __dhp Y; + char PRIO; + __dhp b; + __dhp cur; + double tm; + } __bs230; +short __rl230SIMULATION[4]={(short)((char *)&((__bs230 *)0)->X-(char *)0),(short)((char *)&((__bs230 *)0)->Y-(char *)0),(short)((char *)&((__bs230 *)0)->b-(char *)0),(short)((char *)&((__bs230 *)0)->cur-(char *)0),}; +extern __ptyp __p230SIMULATION;__pty __pl230SIMULATION[1]={&__p230SIMULATION}; +__ptyp __p230SIMULATION={'P',0,3,sizeof(__bs230),14,__m_SIMULATION,0,0,4,0,__rl230SIMULATION,0,__pl230SIMULATION,__NULL}; +typedef struct /* HOLD */ + { + __dh h; + double t; + __dhp p; + __dhp q; + } __bs231; +short __rl231SIMULATION[2]={(short)((char *)&((__bs231 *)0)->p-(char *)0),(short)((char *)&((__bs231 *)0)->q-(char *)0),}; +extern __ptyp __p231SIMULATION;__pty __pl231SIMULATION[1]={&__p231SIMULATION}; +__ptyp __p231SIMULATION={'P',0,3,sizeof(__bs231),15,__m_SIMULATION,0,0,2,0,__rl231SIMULATION,0,__pl231SIMULATION,__NULL}; +typedef struct /* PASSIVATE */ + { + __dh h; + __dhp p; + } __bs232; +short __rl232SIMULATION[1]={(short)((char *)&((__bs232 *)0)->p-(char *)0),}; +extern __ptyp __p232SIMULATION;__pty __pl232SIMULATION[1]={&__p232SIMULATION}; +__ptyp __p232SIMULATION={'P',0,3,sizeof(__bs232),16,__m_SIMULATION,0,0,1,0,__rl232SIMULATION,0,__pl232SIMULATION,__NULL}; +typedef struct /* WAIT */ + { + __dh h; + __dhp S; + __dhp p; + } __bs233; +short __rl233SIMULATION[2]={(short)((char *)&((__bs233 *)0)->S-(char *)0),(short)((char *)&((__bs233 *)0)->p-(char *)0),}; +extern __ptyp __p233SIMULATION;__pty __pl233SIMULATION[1]={&__p233SIMULATION}; +__ptyp __p233SIMULATION={'P',0,3,sizeof(__bs233),17,__m_SIMULATION,0,0,2,0,__rl233SIMULATION,0,__pl233SIMULATION,__NULL}; +typedef struct /* CANCEL */ + { + __dh h; + __dhp x; + __dhp cur; + } __bs234; +short __rl234SIMULATION[2]={(short)((char *)&((__bs234 *)0)->x-(char *)0),(short)((char *)&((__bs234 *)0)->cur-(char *)0),}; +extern __ptyp __p234SIMULATION;__pty __pl234SIMULATION[1]={&__p234SIMULATION}; +__ptyp __p234SIMULATION={'P',0,3,sizeof(__bs234),18,__m_SIMULATION,0,0,2,0,__rl234SIMULATION,0,__pl234SIMULATION,__NULL}; +extern __ptyp __p235SIMULATION; +typedef struct /* zzmain_program */ + { + __bs225 s; + } __bs235; +extern __ptyp __p235SIMULATION;__pty __pl235SIMULATION[8]={&__p207SIMSET,&__p211SIMSET,&__p225SIMULATION,&__p235SIMULATION}; +__ptyp __p235SIMULATION={'C',3,3,sizeof(__bs235),19,__m_SIMULATION,0,0,0,0,0,0,__pl235SIMULATION,__NULL}; +typedef struct /* ACCUM */ + { + __dh h; + __aritnamepar A; + __aritnamepar B; + __aritnamepar C; + double D; + __dhp __r1; + __valuetype __v1; + __valuetype __v2; + __valuetype __v3; + __valuetype __v4; + __valuetype __v5; + } __bs236; +short __rl236SIMULATION[7]={(short)((char *)&((__bs236 *)0)->__r1-(char *)0),(short)((char *)&((__bs236 *)0)->A.bp-(char *)0),(short)((char *)&((__bs236 *)0)->A.sl-(char *)0),(short)((char *)&((__bs236 *)0)->B.bp-(char *)0),(short)((char *)&((__bs236 *)0)->B.sl-(char *)0),(short)((char *)&((__bs236 *)0)->C.bp-(char *)0),(short)((char *)&((__bs236 *)0)->C.sl-(char *)0),}; +extern __ptyp __p236SIMULATION;__pty __pl236SIMULATION[1]={&__p236SIMULATION}; +__ptyp __p236SIMULATION={'P',0,3,sizeof(__bs236),22,__m_SIMULATION,0,0,7,0,__rl236SIMULATION,0,__pl236SIMULATION,__NULL}; +void __m_SIMULATION(void){goto __s; +# 27 "simulation.sim" +__sto= (__dhp)&__blokk205SIMULATION;__rb(&__p205SIMULATION);goto __ll0;/* START CLASS SIMULATION *//* START PROCEDURE CURRENT */__l5: +# 33 "simulation.sim" +;((__bs223 *)__lb)->er=((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc;__er=((__bs223 *)__lb)->er;__rep();goto __sw;/* SLUTT PROCEDURE CURRENT *//* START PROCEDURE TIME */__l6: +# 35 "simulation.sim" +;(((__bs224 *)__lb)->ef=(((__bs225 *)((__bp=((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzevtime));__ev.f=((__bs224 *)__lb)->ef;__rep();goto __sw;/* SLUTT PROCEDURE TIME *//* START CLASS PROCESS *//* START PROCEDURE IDLE */__l10: +# 46 "simulation.sim" +;(((__bs226 *)__lb)->ec=((((__bs225 *)__lb->sl)->zzsqssuc==__NULL)));__ev.c=((__bs226 *)__lb)->ec;__rep();goto __sw;/* SLUTT PROCEDURE IDLE *//* START PROCEDURE TERMINATED */__l11: +# 48 "simulation.sim" +;(((__bs227 *)__lb)->ec=(((__bs225 *)__lb->sl)->zzterminated_process));__ev.c=((__bs227 *)__lb)->ec;__rep();goto __sw;/* SLUTT PROCEDURE TERMINATED *//* START PROCEDURE EVTIME */__l12: +# 50 "simulation.sim" + +# 51 "simulation.sim" +;if(!((((__bs225 *)__lb->sl)->zzsqssuc==__NULL)))goto __ll2; +# 52 "simulation.sim" +;__rterror((__txtvp)&__tk1SIMULATION);goto __ll1;__ll2:;(((__bs228 *)__lb)->ef=(((__bs225 *)__lb->sl)->zzevtime));__ll1:__ev.f=((__bs228 *)__lb)->ef;__rep();goto __sw;/* SLUTT PROCEDURE EVTIME *//* START PROCEDURE NEXTEV */__l13: +# 54 "simulation.sim" + +# 56 "simulation.sim" +;((__bs229 *)__lb)->er=(((__bp=(((((__bs225 *)__lb->sl)->zzsqssuc==__NULL)||(((__bs225 *)__lb->sl)->zzsqssuc==((__bs222 *)__lb->sl->sl)->zzsqs))?__NULL:((__bs225 *)__lb->sl)->zzsqssuc))!=__NULL && (__bp->pp->pref[2]!= &__p225SIMULATION))?(__dhp)__rerror(__errqual):__bp);__er=((__bs229 *)__lb)->er;__rep();goto __sw;/* SLUTT PROCEDURE NEXTEV */__l7: +# 37 "simulation.sim" +__renddecl(2);goto __sw;__l8: +# 58 "simulation.sim" +;((__bs225 *)__lb)->zzsqssuc=((__bs225 *)__lb)->zzsqspred=__NULL; +# 60 "simulation.sim" +;__rdetach(__lb,23,__m_SIMULATION);goto __sw;__l23:; +# 61 "simulation.sim" +__rinner(2);goto __sw;__l9: +# 62 "simulation.sim" +;(((__bs225 *)__lb)->zzterminated_process=(1)); +# 65 "simulation.sim" +;((__bs225 *)((__bp=((__bs225 *)__lb)->zzsqssuc)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred=((__bs225 *)__lb)->zzsqspred; +# 66 "simulation.sim" +;((__bs225 *)((__bp=((__bs225 *)__lb)->zzsqspred)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc=((__bs225 *)__lb)->zzsqssuc; +# 67 "simulation.sim" +;((__bs225 *)__lb)->zzsqspred=((__bs225 *)__lb)->zzsqssuc=__NULL; +# 69 "simulation.sim" +;if(!((((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc==((__bs222 *)__lb->sl)->zzsqs)))goto __ll4; +# 70 "simulation.sim" +;__rterror((__txtvp)&__tk2SIMULATION);goto __ll3;__ll4:;__rresume(((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc,24,__m_SIMULATION);goto __sw;__l24:;__ll3: +# 72 "simulation.sim" +;__rterror((__txtvp)&__tk3SIMULATION); +# 73 "simulation.sim" +__rendclass(2);goto __sw;/* SLUTT CLASS PROCESS *//* START PROCEDURE activat */__l14: +# 75 "simulation.sim" +if((__bp=((__bs230 *)__lb)->X)!=__NULL && (__bp->pp->pref[2]!= &__p225SIMULATION))__rerror(__errqual);if((__bp=((__bs230 *)__lb)->Y)!=__NULL && (__bp->pp->pref[2]!= &__p225SIMULATION))__rerror(__errqual); +# 85 "simulation.sim" +;if(!(((((__bs230 *)__lb)->X!=__NULL)&&((!((__bs225 *)((__bp=((__bs230 *)__lb)->X)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzterminated_process)&&(((__bs230 *)__lb)->REAC||(((__bs225 *)((__bp=((__bs230 *)__lb)->X)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc==__NULL))))))goto __ll5; +# 87 "simulation.sim" +;((__bs230 *)__lb)->cur=((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc;;(((__bs230 *)__lb)->tm=(((__bs225 *)((__bp=((__bs230 *)__lb)->cur)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzevtime)); +# 89 "simulation.sim" +;if(!(((unsigned char)((__bs230 *)__lb)->CODE==(unsigned char)1)))goto __ll7; +# 91 "simulation.sim" +;if(!((((__bs230 *)__lb)->X==((__bs230 *)__lb)->cur)))goto __ll8;;goto __l25;__ll8: +# 92 "simulation.sim" +;(((__bs230 *)__lb)->T=(((__bs230 *)__lb)->tm));;((__bs230 *)__lb)->b=((__bs222 *)__lb->sl)->zzsqs; +# 93 "simulation.sim" +goto __ll6;__ll7: +# 94 "simulation.sim" +;if(!(((unsigned char)((__bs230 *)__lb)->CODE==(unsigned char)2)))goto __ll10; +# 96 "simulation.sim" +;if(!((((__bs230 *)__lb)->T<=((__bs230 *)__lb)->tm)))goto __ll11; +# 97 "simulation.sim" +;if(!((((__bs230 *)__lb)->PRIO&&(((__bs230 *)__lb)->X==((__bs230 *)__lb)->cur))))goto __ll13;;goto __l25;__ll13:;(((__bs230 *)__lb)->T=(((__bs230 *)__lb)->tm));__ll12:__ll11: +# 98 "simulation.sim" +goto __ll9;__ll10: +# 99 "simulation.sim" +;if(!(((unsigned char)((__bs230 *)__lb)->CODE==(unsigned char)3)))goto __ll15; +# 101 "simulation.sim" +;(((__bs230 *)__lb)->T=((((__bs230 *)__lb)->T+((__bs230 *)__lb)->tm))); +# 102 "simulation.sim" +;if(!((((__bs230 *)__lb)->T<=((__bs230 *)__lb)->tm)))goto __ll16; +# 103 "simulation.sim" +;if(!((((__bs230 *)__lb)->PRIO&&(((__bs230 *)__lb)->X==((__bs230 *)__lb)->cur))))goto __ll18;;goto __l25;__ll18:;(((__bs230 *)__lb)->T=(((__bs230 *)__lb)->tm));__ll17:__ll16: +# 104 "simulation.sim" +goto __ll14;__ll15: +# 107 "simulation.sim" +;if(!(((((__bs230 *)__lb)->Y==__NULL)||(((__bs225 *)((__bp=((__bs230 *)__lb)->Y)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc==__NULL))))goto __ll19; +# 109 "simulation.sim" +;if(!((((__bs225 *)((__bp=((__bs230 *)__lb)->X)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc!=__NULL)))goto __ll20; +# 111 "simulation.sim" +;((__bs225 *)((__bp=((__bs225 *)((__bp=((__bs230 *)__lb)->X)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred=((__bs225 *)((__bp=((__bs230 *)__lb)->X)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred; +# 112 "simulation.sim" +;((__bs225 *)((__bp=((__bs225 *)((__bp=((__bs230 *)__lb)->X)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc=((__bs225 *)((__bp=((__bs230 *)__lb)->X)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc; +# 113 "simulation.sim" +;((__bs225 *)((__bp=((__bs230 *)__lb)->X)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred=__NULL;;((__bs225 *)((__bp=((__bs230 *)__lb)->X)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc=__NULL; +# 114 "simulation.sim" +__ll20: +# 116 "simulation.sim" +;if(!((((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc==((__bs222 *)__lb->sl)->zzsqs)))goto __ll21;;__rterror((__txtvp)&__tk4SIMULATION);__ll21: +# 117 "simulation.sim" +;goto __l25;__ll19: +# 120 "simulation.sim" +;if(!((((__bs230 *)__lb)->X==((__bs230 *)__lb)->Y)))goto __ll22;;goto __l25;__ll22: +# 122 "simulation.sim" +;(((__bs230 *)__lb)->T=(((__bs225 *)((__bp=((__bs230 *)__lb)->Y)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzevtime)); +# 124 "simulation.sim" +;if(!(((unsigned char)((__bs230 *)__lb)->CODE==(unsigned char)4)))goto __ll24;;((__bs230 *)__lb)->b=((__bs225 *)((__bp=((__bs230 *)__lb)->Y)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred;goto __ll23;__ll24:;((__bs230 *)__lb)->b=((__bs230 *)__lb)->Y;__ll23: +# 125 "simulation.sim" +__ll14:__ll9:__ll6: +# 127 "simulation.sim" +;if(!((((__bs225 *)((__bp=((__bs230 *)__lb)->X)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc!=__NULL)))goto __ll25; +# 129 "simulation.sim" +;((__bs225 *)((__bp=((__bs225 *)((__bp=((__bs230 *)__lb)->X)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred=((__bs225 *)((__bp=((__bs230 *)__lb)->X)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred; +# 130 "simulation.sim" +;((__bs225 *)((__bp=((__bs225 *)((__bp=((__bs230 *)__lb)->X)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc=((__bs225 *)((__bp=((__bs230 *)__lb)->X)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc; +# 131 "simulation.sim" +__ll25: +# 133 "simulation.sim" +;if(!((((__bs230 *)__lb)->b==__NULL)))goto __ll26; +# 135 "simulation.sim" +;((__bs230 *)__lb)->b=((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred; +# 136 "simulation.sim" +__ll27:;if(!((((__bs225 *)((__bp=((__bs230 *)__lb)->b)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzevtime>((__bs230 *)__lb)->T)))goto __ll28;;((__bs230 *)__lb)->b=((__bs225 *)((__bp=((__bs230 *)__lb)->b)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred;goto __ll27;__ll28: +# 137 "simulation.sim" +;if(!(((__bs230 *)__lb)->PRIO))goto __ll29; +# 138 "simulation.sim" +__ll30:;if(!((((__bs225 *)((__bp=((__bs230 *)__lb)->b)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzevtime==((__bs230 *)__lb)->T)))goto __ll31;;((__bs230 *)__lb)->b=((__bs225 *)((__bp=((__bs230 *)__lb)->b)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred;goto __ll30;__ll31:__ll29: +# 139 "simulation.sim" +__ll26: +# 141 "simulation.sim" +;(((__bs225 *)((__bp=((__bs230 *)__lb)->X)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzevtime=(((__bs230 *)__lb)->T)); +# 142 "simulation.sim" +;((__bs225 *)((__bp=((__bs230 *)__lb)->X)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred=((__bs230 *)__lb)->b;;((__bs225 *)((__bp=((__bs230 *)__lb)->X)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc=((__bs225 *)((__bp=((__bs230 *)__lb)->b)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc; +# 143 "simulation.sim" +;((__bs225 *)((__bp=((__bs230 *)__lb)->b)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc=((__bs230 *)__lb)->X;;((__bs225 *)((__bp=((__bs225 *)((__bp=((__bs230 *)__lb)->X)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred=((__bs230 *)__lb)->X; +# 145 "simulation.sim" +;if(!((((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc!=((__bs230 *)__lb)->cur)))goto __ll32;;__rresume(((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc,26,__m_SIMULATION);goto __sw;__l26:;__ll32: +# 146 "simulation.sim" +__ll5: +# 147 "simulation.sim" +/*exit_230*/__l25: +# 148 "simulation.sim" +__repp();goto __sw;/* SLUTT PROCEDURE activat *//* START PROCEDURE HOLD */__l15: +# 150 "simulation.sim" + +# 153 "simulation.sim" +;((__bs231 *)__lb)->p=((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc; +# 154 "simulation.sim" +;if(!((((__bs231 *)__lb)->t> 0.0000000000000000e+00)))goto __ll33;;(((__bs225 *)((__bp=((__bs231 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzevtime=((((__bs225 *)((__bp=((__bs231 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzevtime+((__bs231 *)__lb)->t)));__ll33: +# 155 "simulation.sim" +;(((__bs231 *)__lb)->t=(((__bs225 *)((__bp=((__bs231 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzevtime)); +# 156 "simulation.sim" +;if(!(((((__bs225 *)((__bp=((__bs231 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc!=((__bs222 *)__lb->sl)->zzsqs)&&(((__bs225 *)((__bp=((__bs225 *)((__bp=((__bs231 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzevtime<=((__bs231 *)__lb)->t))))goto __ll34; +# 158 "simulation.sim" +;((__bs225 *)((__bp=((__bs225 *)((__bp=((__bs231 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred=((__bs225 *)((__bp=((__bs231 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred; +# 159 "simulation.sim" +;((__bs225 *)((__bp=((__bs225 *)((__bp=((__bs231 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc=((__bs225 *)((__bp=((__bs231 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc; +# 161 "simulation.sim" +;((__bs231 *)__lb)->q=((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred; +# 162 "simulation.sim" +__ll35:;if(!((((__bs225 *)((__bp=((__bs231 *)__lb)->q)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzevtime>((__bs231 *)__lb)->t)))goto __ll36;;((__bs231 *)__lb)->q=((__bs225 *)((__bp=((__bs231 *)__lb)->q)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred;goto __ll35;__ll36: +# 164 "simulation.sim" +;((__bs225 *)((__bp=((__bs231 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred=((__bs231 *)__lb)->q;;((__bs225 *)((__bp=((__bs231 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc=((__bs225 *)((__bp=((__bs231 *)__lb)->q)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc; +# 165 "simulation.sim" +;((__bs225 *)((__bp=((__bs231 *)__lb)->q)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc=((__bs231 *)__lb)->p;;((__bs225 *)((__bp=((__bs225 *)((__bp=((__bs231 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred=((__bs231 *)__lb)->p; +# 167 "simulation.sim" +;__rresume(((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc,27,__m_SIMULATION);goto __sw;__l27:; +# 168 "simulation.sim" +__ll34: +# 169 "simulation.sim" +__repp();goto __sw;/* SLUTT PROCEDURE HOLD *//* START PROCEDURE PASSIVATE */__l16: +# 171 "simulation.sim" + +# 173 "simulation.sim" +;((__bs232 *)__lb)->p=((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc; +# 174 "simulation.sim" +;((__bs225 *)((__bp=((__bs225 *)((__bp=((__bs232 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred=((__bs225 *)((__bp=((__bs232 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred; +# 175 "simulation.sim" +;((__bs225 *)((__bp=((__bs225 *)((__bp=((__bs232 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc=((__bs225 *)((__bp=((__bs232 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc; +# 176 "simulation.sim" +;((__bs225 *)((__bp=((__bs232 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred=__NULL;;((__bs225 *)((__bp=((__bs232 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc=__NULL; +# 178 "simulation.sim" +;if(!((((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc==((__bs222 *)__lb->sl)->zzsqs)))goto __ll38; +# 179 "simulation.sim" +;__rterror((__txtvp)&__tk5SIMULATION);goto __ll37;__ll38:;__rresume(((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc,28,__m_SIMULATION);goto __sw;__l28:;__ll37: +# 180 "simulation.sim" +__repp();goto __sw;/* SLUTT PROCEDURE PASSIVATE *//* START PROCEDURE WAIT */__l17: +# 182 "simulation.sim" +if((__bp=((__bs233 *)__lb)->S)!=__NULL && (__bp->pp->pref[1]!= &__p216SIMSET))__rerror(__errqual); +# 184 "simulation.sim" +;((__bs233 *)__lb)->p=((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc; +# 185 "simulation.sim" +__sl=((__bp=((__bs233 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp);__rcpp(&__p215SIMSET);((__bs215 *)__pb)->S=((__bs233 *)__lb)->S;__rcpb(29,__m_SIMULATION);return;__l29:;; +# 187 "simulation.sim" +;((__bs225 *)((__bp=((__bs225 *)((__bp=((__bs233 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred=((__bs225 *)((__bp=((__bs233 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred; +# 188 "simulation.sim" +;((__bs225 *)((__bp=((__bs225 *)((__bp=((__bs233 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc=((__bs225 *)((__bp=((__bs233 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc; +# 189 "simulation.sim" +;((__bs225 *)((__bp=((__bs233 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred=__NULL;;((__bs225 *)((__bp=((__bs233 *)__lb)->p)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc=__NULL; +# 191 "simulation.sim" +;if(!((((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc==((__bs222 *)__lb->sl)->zzsqs)))goto __ll40; +# 192 "simulation.sim" +;__rterror((__txtvp)&__tk6SIMULATION);goto __ll39;__ll40:;__rresume(((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc,30,__m_SIMULATION);goto __sw;__l30:;__ll39: +# 193 "simulation.sim" +__repp();goto __sw;/* SLUTT PROCEDURE WAIT *//* START PROCEDURE CANCEL */__l18: +# 195 "simulation.sim" +if((__bp=((__bs234 *)__lb)->x)!=__NULL && (__bp->pp->pref[2]!= &__p225SIMULATION))__rerror(__errqual); +# 198 "simulation.sim" +;if(!(((((__bs234 *)__lb)->x!=__NULL)&&(((__bs225 *)((__bp=((__bs234 *)__lb)->x)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc!=__NULL))))goto __ll41; +# 200 "simulation.sim" +;((__bs234 *)__lb)->cur=((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc; +# 201 "simulation.sim" +;((__bs225 *)((__bp=((__bs225 *)((__bp=((__bs234 *)__lb)->x)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred=((__bs225 *)((__bp=((__bs234 *)__lb)->x)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred; +# 202 "simulation.sim" +;((__bs225 *)((__bp=((__bs225 *)((__bp=((__bs234 *)__lb)->x)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc=((__bs225 *)((__bp=((__bs234 *)__lb)->x)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc; +# 203 "simulation.sim" +;((__bs225 *)((__bp=((__bs234 *)__lb)->x)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred=__NULL;;((__bs225 *)((__bp=((__bs234 *)__lb)->x)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc=__NULL; +# 205 "simulation.sim" +;if(!((((__bs234 *)__lb)->x==((__bs234 *)__lb)->cur)))goto __ll42; +# 207 "simulation.sim" +;if(!((((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc==((__bs222 *)__lb->sl)->zzsqs)))goto __ll44; +# 208 "simulation.sim" +;__rterror((__txtvp)&__tk7SIMULATION);goto __ll43;__ll44:;__rresume(((__bs225 *)((__bp=((__bs222 *)__lb->sl)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc,31,__m_SIMULATION);goto __sw;__l31:;__ll43: +# 209 "simulation.sim" +__ll42: +# 210 "simulation.sim" +__ll41: +# 211 "simulation.sim" +__repp();goto __sw;/* SLUTT PROCEDURE CANCEL *//* START CLASS zzmain_program */__l19: +# 213 "simulation.sim" +__renddecl(3);goto __sw;__l20: +# 215 "simulation.sim" +__ll45:;if(!(1))goto __ll46; +# 216 "simulation.sim" +;__rdetach(__lb,32,__m_SIMULATION);goto __sw;__l32:;goto __ll45;__ll46: +# 213 "simulation.sim" +__rinner(3);goto __sw;__l21: +# 216 "simulation.sim" +__rendclass(3);goto __sw;/* SLUTT CLASS zzmain_program *//* START PROCEDURE ACCUM */__l22: +# 218 "simulation.sim" + +# 221 "simulation.sim" +if(__rgetsa(&((__bs236 *)__lb)->A,0L,33,__m_SIMULATION))goto __sw;__l33:;((__bs236 *)__lb)->__r1= __er;((__bs236 *)__lb)->__v1.i= __ev.i;if(__rgetav(__TREAL,&((__bs236 *)__lb)->A,0L,34,__m_SIMULATION))goto __sw;__l34:;((__bs236 *)__lb)->__v2.f= __ev.f;if(__rgetav(__TREAL,&((__bs236 *)__lb)->C,0L,35,__m_SIMULATION))goto __sw;__l35:;((__bs236 *)__lb)->__v3.f= __ev.f;__sl=__lb->sl;__rcp(&__p224SIMULATION,0L);__rcpb(36,__m_SIMULATION);goto __sw;__l36:;((__bs236 *)__lb)->__v4.f= __ev.f;if(__rgetav(__TREAL,&((__bs236 *)__lb)->B,0L,37,__m_SIMULATION))goto __sw;__l37:;((__bs236 *)__lb)->__v5.f= __ev.f;(__ev.f=((((__bs236 *)__lb)->__v2.f+(((__bs236 *)__lb)->__v3.f*(((__bs236 *)__lb)->__v4.f-((__bs236 *)__lb)->__v5.f)))));if((__nvp= &((__bs236 *)__lb)->A)->conv==__NOCONV) *(double *)(((char *)((__bs236 *)__lb)->__r1)+((__bs236 *)__lb)->__v1.i)=__ev.f;else if(__nvp->conv==__INTREAL) *(long *)(((char *)((__bs236 *)__lb)->__r1)+((__bs236 *)__lb)->__v1.i)=__ev.f;else *(double *)(((char *)((__bs236 *)__lb)->__r1)+((__bs236 *)__lb)->__v1.i)=__rintrea(__ev.f);if(__rgetsa(&((__bs236 *)__lb)->B,0L,38,__m_SIMULATION))goto __sw;__l38:;((__bs236 *)__lb)->__r1= __er;((__bs236 *)__lb)->__v1.i= __ev.i;__sl=__lb->sl;__rcp(&__p224SIMULATION,0L);__rcpb(39,__m_SIMULATION);goto __sw;__l39:;((__bs236 *)__lb)->__v2.f= __ev.f;(__ev.f=(((__bs236 *)__lb)->__v2.f));if((__nvp= &((__bs236 *)__lb)->B)->conv==__NOCONV) *(double *)(((char *)((__bs236 *)__lb)->__r1)+((__bs236 *)__lb)->__v1.i)=__ev.f;else if(__nvp->conv==__INTREAL) *(long *)(((char *)((__bs236 *)__lb)->__r1)+((__bs236 *)__lb)->__v1.i)=__ev.f;else *(double *)(((char *)((__bs236 *)__lb)->__r1)+((__bs236 *)__lb)->__v1.i)=__rintrea(__ev.f);if(__rgetsa(&((__bs236 *)__lb)->C,0L,40,__m_SIMULATION))goto __sw;__l40:;((__bs236 *)__lb)->__r1= __er;((__bs236 *)__lb)->__v1.i= __ev.i;if(__rgetav(__TREAL,&((__bs236 *)__lb)->C,0L,41,__m_SIMULATION))goto __sw;__l41:;((__bs236 *)__lb)->__v2.f= __ev.f;(__ev.f=((((__bs236 *)__lb)->__v2.f+((__bs236 *)__lb)->D)));if((__nvp= &((__bs236 *)__lb)->C)->conv==__NOCONV) *(double *)(((char *)((__bs236 *)__lb)->__r1)+((__bs236 *)__lb)->__v1.i)=__ev.f;else if(__nvp->conv==__INTREAL) *(long *)(((char *)((__bs236 *)__lb)->__r1)+((__bs236 *)__lb)->__v1.i)=__ev.f;else *(double *)(((char *)((__bs236 *)__lb)->__r1)+((__bs236 *)__lb)->__v1.i)=__rintrea(__ev.f); +# 222 "simulation.sim" +__repp();goto __sw;/* SLUTT PROCEDURE ACCUM */__l2: +# 27 "simulation.sim" +__renddecl(1);goto __sw;__l3: +# 224 "simulation.sim" +__sl=__lb;__rcp(&__p225SIMULATION,0L);__rccb(42,__m_SIMULATION);goto __sw;__l42:;((__bs222 *)__lb)->__r1= __er;((__bs222 *)__lb)->zzsqs=((__bs222 *)__lb)->__r1;;(((__bs225 *)((__bp=((__bs222 *)__lb)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzevtime=( -1.0000000000000000e+00)); +# 226 "simulation.sim" +__sl=__lb;__rcp(&__p235SIMULATION,0L);__rccb(43,__m_SIMULATION);goto __sw;__l43:;((__bs222 *)__lb)->__r1= __er;((__bs222 *)__lb)->MAIN=((__bs222 *)__lb)->__r1; +# 227 "simulation.sim" +;((__bs225 *)((__bp=((__bs222 *)__lb)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc=((__bs222 *)__lb)->MAIN;;((__bs225 *)((__bp=((__bs222 *)__lb)->zzsqs)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred=((__bs222 *)__lb)->MAIN; +# 228 "simulation.sim" +;((__bs225 *)((__bp=((__bs222 *)__lb)->MAIN)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqssuc=((__bs222 *)__lb)->zzsqs;;((__bs225 *)((__bp=((__bs222 *)__lb)->MAIN)==__NULL?(__dhp)__rerror(__errnone):__bp))->zzsqspred=((__bs222 *)__lb)->zzsqs; +# 27 "simulation.sim" +__rinner(1);goto __sw;__l4: +# 230 "simulation.sim" +__rendclass(1);goto __sw;/* SLUTT CLASS SIMULATION */__ll0:__rbe();__sw:if(__goto.ment!=(void (*)())__m_SIMULATION)return;__s:switch(__goto.ent){case 2: goto __l2; +case 3: goto __l3; +case 4: goto __l4; +case 5: goto __l5; +case 6: goto __l6; +case 7: goto __l7; +case 8: goto __l8; +case 9: goto __l9; +case 10: goto __l10; +case 11: goto __l11; +case 12: goto __l12; +case 13: goto __l13; +case 14: goto __l14; +case 15: goto __l15; +case 16: goto __l16; +case 17: goto __l17; +case 18: goto __l18; +case 19: goto __l19; +case 20: goto __l20; +case 21: goto __l21; +case 22: goto __l22; +case 23: goto __l23; +case 24: goto __l24; +case 25: goto __l25; +case 26: goto __l26; +case 27: goto __l27; +case 28: goto __l28; +case 29: goto __l29; +case 30: goto __l30; +case 31: goto __l31; +case 32: goto __l32; +case 33: goto __l33; +case 34: goto __l34; +case 35: goto __l35; +case 36: goto __l36; +case 37: goto __l37; +case 38: goto __l38; +case 39: goto __l39; +case 40: goto __l40; +case 41: goto __l41; +case 42: goto __l42; +case 43: goto __l43; +}} diff --git a/lib/start.c b/lib/start.c index 81f26b9..3cafe11 100644 --- a/lib/start.c +++ b/lib/start.c @@ -19,6 +19,7 @@ #define INCLUDE_SIMFILE_H #include "file.h" +#include #if STDC_HEADERS #include @@ -49,7 +50,7 @@ static char __roptions (long antarg, char arg1[]) if (arg1[1] == 'k' || arg1[1] == 'K') (void) fprintf (stderr, "Poolsize is changed to %ldK\n", __poolsize); else - (void) fprintf (stderr, "Poolsize is changed to %ldM\n", + (void) fprintf (stderr, "Poolsize is changed to %ldM\n", __poolsize / 1024); } return (__TRUE); @@ -117,6 +118,9 @@ RETSIGTYPE __rbus_trap (int ignore) __rerror ("System error: Bus error"); } #endif + +extern void __init (void); + void __rstart (int argc, char *argv[]) { #if CLOCK @@ -134,7 +138,7 @@ void __rstart (int argc, char *argv[]) __init (); -/* SYSIN :- new infile("..."); +/* SYSIN :- new infile("..."); * SYSOUT :- new printfile("..."); * SYSIN.open(blanks(INPUT_LINE_LENGTH)); * SYSOUT.open(blanks(OUTPUT_LINE_LENGTH)); @@ -152,8 +156,8 @@ void __rstart (int argc, char *argv[]) __rtextvalassign (&((__bs2FILE *) __rsysout ())->IMAGE, (__txtvp) & __tk0); __rtextvalassign (&((__bs2FILE *) __rsyserr ())->IMAGE, (__txtvp) & __tk0); - /* Kobler c1,c2 i blokk0 til objektene av infile og printfile * henholdsvis - * + /* Kobler c1,c2 i blokk0 til objektene av infile og printfile * henholdsvis + * * * * * * * * * * * sysin og sysout. */ __blokk0FILE.c1 = __rsysin (); __blokk0FILE.c2 = __rsysout (); diff --git a/lib/tgetreal.c b/lib/tgetreal.c index 8712c85..42f2798 100644 --- a/lib/tgetreal.c +++ b/lib/tgetreal.c @@ -63,20 +63,21 @@ double __rtgetreal (__txtvp t) skipblanke; if (!more) __rerror ("Getreal: Can't find any real item"); - if (sign = fortegn) + if ((sign = fortegn)) i++; if (sign == -1) cs[csi++] = '-'; skipblanke; if (!more) __rerror ("Getreal: Can't find any integer item"); - if (!digit) + if (!digit) { if (s[i] == __currentlowten) { cs[csi++] = '1'; } else if (s[i] != __currentdecimalmark) __rerror ("Getreal: Illegal real item"); + } for (; more && digit; i++) { if (csi >= __RTPUTTEXTLENGTH) @@ -103,7 +104,7 @@ double __rtgetreal (__txtvp t) skipblanke; if (!more) __rerror ("Getreal: Can't find any real item"); - if (sign = fortegn) + if ((sign = fortegn)) i++; if (csi >= __RTPUTTEXTLENGTH) goto texttolong; @@ -139,4 +140,5 @@ double __rtgetreal (__txtvp t) texttolong: __rerror ("Getreal: To big real item"); /* NOTREACHED */ + return 0; } diff --git a/lib/tputfrac.c b/lib/tputfrac.c index c16c40f..f44b6dc 100644 --- a/lib/tputfrac.c +++ b/lib/tputfrac.c @@ -30,7 +30,7 @@ __txtvp __rtputfrac (__txtvp t, long i, long n) antg = 0, k; - if (minus = i < 0) + if ((minus = i < 0)) i *= -1; if (t->obj == __NULL) __rerror ("Putfrac: Notext"); diff --git a/lib/tputreal.c b/lib/tputreal.c index 3e42463..3e58dfb 100644 --- a/lib/tputreal.c +++ b/lib/tputreal.c @@ -47,7 +47,8 @@ __txtvp __rtputreal (__txtvp t, double r, long n) if (t->obj->h.konstant) __rerror ("Putreal: Constant text object"); s = t->obj->string; - (void) sprintf (fcs, "%%.%ld%s", (n > 0) ? n - 1 : 0, "le"); + unsigned char n1 = (n > 0) ? n - 1 : 0; + (void) snprintf (fcs, sizeof(fcs), "%%.%u%s", n1, "le"); (void) sprintf /* ARGSUSED */ (cs, fcs, r); if ((cs[0] == 'I') | (cs[1] == 'I')) /* Test p} om det er lik uendelig */ diff --git a/lib/upcase.c b/lib/upcase.c index 7a7b318..131272a 100644 --- a/lib/upcase.c +++ b/lib/upcase.c @@ -18,6 +18,7 @@ */ #include "cim.h" +#include /****************************************************************************** TEXT PROCEDURE UPCASE(t) */ @@ -30,8 +31,8 @@ __txtvp __rupcase (__txtvp t) for (i = 0; i < t->length; i++) s[t->start + i - 1] = - (isalpha (s[t->start + i - 1]) - ? (islower (s[t->start + i - 1]) + (isalpha (s[t->start + i - 1]) + ? (islower (s[t->start + i - 1]) ? toupper ((int) s[t->start + i - 1]) : s[t->start + i - 1]) : s[t->start + i - 1]); __et.obj = t->obj; diff --git a/limit.h b/limit.h index 9cf7e10..e111cd6 100644 --- a/limit.h +++ b/limit.h @@ -17,6 +17,7 @@ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "config.h" +#include /* lex.c */ #define MAX_TEXT_CHAR 65535 /* Max size of text-objects DO NOT EDIT */ @@ -29,15 +30,15 @@ #define FIRST_DATA_LOCATION ((int)(&__start_data_segment)) /* Define MAX_INT */ -#if SIZEOF_LONG == 8 -#define MAX_INT (~(1L<<63)) -#else -#define MAX_INT (~(1L<<31)) -#endif +#define MAX_INT INT_MAX /* Define TYPE_32_INT */ -#if SIZEOF_LONG == 8 #define TYPE_32_INT int -#else -#define TYPE_32_INT long -#endif + +#define MIN_DOUBLE DBL_MIN +#define MAX_DOUBLE DBL_MAX + +#define LINES_PER_PAGE 60 +#define DYNMEMSIZEKB 512 +#define INPUT_LINE_LENGTH 80 +#define OUTPUT_LINE_LENGTH 80 diff --git a/man/Makefile.am b/man/Makefile.am deleted file mode 100644 index ccc9d28..0000000 --- a/man/Makefile.am +++ /dev/null @@ -1,21 +0,0 @@ -## Process this file with automake to create Makefile.in -## $Id: $ - -# Copyright (C) 1997 Sverre Hvammen Johansen, -# Department of Informatics, University of Oslo. -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; version 2. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -man_MANS = cim.1 -EXTRA_DIST = cim.1 diff --git a/man/cim.txt b/man/cim.txt new file mode 100644 index 0000000..cfdfff6 --- /dev/null +++ b/man/cim.txt @@ -0,0 +1,176 @@ +CIM(1) General Commands Manual CIM(1) + + + +NAME + cim - Compile Simula programs into C + + +SYNOPSIS + cim [ options ] file ... + +DESCRIPTION + GNU Cim is the Simula compiler that compiles into C. The C program will + then be compiled with cc , and linked with other modules. + + GNU Cim will accept one Simula program and other none Simula modules. + The specified Simula program will be compiled and linked with the mod‐ + ules. If a main Simula program is compiled then it will be automatic + linked with the Simula modules that it uses. If a separate Class or + Procedure is compiled, then the linking will be supressed. + +OPTIONS + The following options are accepted by the cim command: + + -a Try to produce an atr-file even if an error occurs. Compare the + produced atr-file with the atr-file produced from previous com‐ + pilation and if they differ return an error status code. With + use of this option it is possible to have external modules with + circular dependencies. You will then need to compile all the + modules with this option until no error status codes are re‐ + turned. Then you should do a final compilation with option -p or + option -d. To get this to work it is important that the topmost + external head does not contain any external declaration that is + part of the circular dependency. Such external declarations must + be placed in an external head that comes after the first class- + or procedure decraration. + + -b The following argument will be parsed to the CC-command. + + -B The following argument will be parsed to the link-command. + + -c Supress linking of the complete program. + + -Cname Set the name of the C compiler. + + -d Compare the produced c-code with the code produced from previous + compilation and if they are equal then touch the object-file in‐ + stead of compiling the c-code. + + -Dname Define a symbol name. + + -e On systems that support dynamic linking, this prevents linking + with the shared libraries. On other systems, this option has no + effect. + + -E Run only the preprocessor and output the result to standard out‐ + put. + + -g Make the C compiler produce debugging information. This option + is useful for debugging the generated code. + + -G Invoke the Gnu Project C compiler instead of the standard C com‐ + piler. This option is useful if the standard C compiler don't + generate correct code. + + -h Print a summary of the options to `cim', and exit. + + -H Omit line number information in the compiled program. This + will make the program smaller and faster. + + -I dir Use the Simula include file located in directory dir instead of + the standard directory. + + -llibrary + Link with object library library. This option is parsed to the + link-command. + + -L dir Use the Simula library located in directory dir instead of the + standard directory. + + -m The memory pool size may be set at runtime by an option -mn. + + -mn Set the initial memory pool size to n mega bytes. + + -Mn Set the maximal memory pool size to n mega bytes. + + -N Only link the specifiede files. + + -o The following argument is the name of the output executable + file. + + -p If supported for the target machines, generate position-indepen‐ + dent code, suitable for use in a shared library. + + -P Only link the specifiede files. + + -q Run the compiler in quiet mode. + + -s Only C-compile and link the specified files. + + -S Run the source file trough Simula-compiler, only. + + -R Recompile the module using the same timestamp. + + -t Do not remove temporary files. If a main program is compiled + with option -r, then the executable file will be removed unless + this option or option -T is specified. + + -Uname Remove any initial definition of the symbol name (Inverse of the + -D option). + + -v Run the compiler in verbose mode. + + -V Print the version number of Cim and exit. + + -w Do not print warnings. + +FILES + file Executable file. + + file.a Library of source files, attribute files and object files. In‐ + clude this simula library when compiling and linking. The sim‐ + ula library is created with ar(1V) and ranlib(1). All source + and .atr files should be placed before .o files in the archive. + + file.o Object file. + + file.c Simula-compiler output file. + + file.h Output file that is included in file.c. + + file.sim + Simula source file. + + file File names without an extension are assumed to be shorthand no‐ + tation for the corresponding .sim file. + + /usr/local/lib/libcim.a + Simula library that contains the environment, Run Time System + and class Simset and Simulation. The source code to Simset and + Simulation is also included, so these parts can be compiled us‐ + ing compiler directive %include. + + /usr/local/include/cim.h + Include file for the produced C-code. + +SE ALSO + cc(1), ld(1), ar(1V), lorder(1), topsort(1), ranlib(1) + + Standard Simula, SS 636114. The Simula Standards Group, August 1986. + + Viderefoering og testing av et portabelt Simula-system. Hovedoppgave + til cand.scient.-graden av Terje Mjoes. Institutt for informatikk, + Universitetet i Oslo, April 1989. + + Et portabelt Simula-system bygget paa C. Hovedoppgave til cand.scient- + graden av Sverre Johansen. Institutt for informatikk, Universitetet i + Oslo, Mai 1987. + + +DIAGNOSTICS + The diagnostics produced by the Simula compiler are intended to be + self-explanatory. + + +BUGS + Bugs should be reported to bug-cim@gnu.org. + + +AUTHOR + Sverre Hvammen Johansen, Department of Informatics, University of Oslo. + + + + + 13 Jan 1989 CIM(1) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt new file mode 100644 index 0000000..a3bfa10 --- /dev/null +++ b/src/CMakeLists.txt @@ -0,0 +1,53 @@ +# +# Include both source and build directories. +# +include_directories( + ${CMAKE_SOURCE_DIR} + ${CMAKE_BINARY_DIR} + ${CMAKE_CURRENT_SOURCE_DIR} + ${CMAKE_CURRENT_BINARY_DIR} +) + +# +# Need Bison parser. +# +find_package(BISON REQUIRED) +bison_target(parser parser.y "${CMAKE_CURRENT_BINARY_DIR}/parser.c") + +# +# Build 'gnucim' binary. +# +add_executable(gnucim + error.c + pargen.c + name.c + dekl.c + linegen.c + strgen.c + extspec.c + transcall.c + expgen.c + getopt1.c + getopt.c + parser.c + lex.c + filelist.c + newstr.c + cimcomp.c + mellbuilder.c + expbuilder.c + sentbuilder.c + sentchecker.c + expchecker.c + computeconst.c + sentgen.c + obstack.c + mapline.c + senttrans.c + salloc.c + passes.c + dump.c + "${CMAKE_CURRENT_BINARY_DIR}/parser.c" +) +target_link_libraries(gnucim PUBLIC m) +install(TARGETS gnucim DESTINATION bin) diff --git a/src/Makefile.am b/src/Makefile.am deleted file mode 100644 index 21150b7..0000000 --- a/src/Makefile.am +++ /dev/null @@ -1,49 +0,0 @@ -## Process this file with automake to create Makefile.in -## $Id: $ - -# Copyright (C) 1997 Sverre Hvammen Johansen, -# Department of Informatics, University of Oslo. -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; version 2. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -bin_PROGRAMS = cim - -cim_SOURCES = error.c pargen.c name.c dekl.c linegen.c strgen.c \ - extspec.c transcall.c expgen.c getopt1.c \ - getopt.c parser.y lex.c filelist.c newstr.c cimcomp.c \ - mellbuilder.c expbuilder.c sentbuilder.c sentchecker.c \ - expchecker.c computeconst.c sentgen.c obstack.c \ - mapline.c senttrans.c salloc.c passes.c dump.c - -cim_LDADD = @ALLOCA@ - -noinst_HEADERS = cimcomp.h const.h dekl.h gen.h name.h error.h \ - getopt.h filelist.h newstr.h lex.h \ - extspec.h mellbuilder.h builder.h checker.h \ - obstack.h mapline.h expmacros.h trans.h salloc.h \ - passes.h dump.h - -AM_YFLAGS= -d -BUILT_SOURCES = parser.h - -# Variables controlling compilation of the generated C-code -SCC = $(CC) -SCFLAGS = $(CFLAGS) -SLDFLAGS = $(LDFLAGS) -SLIBS = $(LIBS) - -AM_CPPFLAGS = -I$(top_srcdir) - -cimcomp.o: cimcomp.c Makefile - $(COMPILE) '-DSCC="$(SCC)"' '-DSCFLAGS="$(SCFLAGS)"' '-DSLDFLAGS="$(SLDFLAGS)"' '-DSLIBS="$(SLIBS)"' '-DLIBDIR="$(libdir)"' '-DINCLUDEDIR="$(includedir)"' -c $(srcdir)/cimcomp.c diff --git a/src/cimcomp.c b/src/cimcomp.c index 2a67045..f820c8f 100644 --- a/src/cimcomp.c +++ b/src/cimcomp.c @@ -30,6 +30,7 @@ #include "gen.h" #include "trans.h" #include "passes.h" +#include "extspec.h" #if STDC_HEADERS || HAVE_STRING_H #include @@ -232,7 +233,7 @@ static char *basename (char *str) && strcmp (&str[i - 4], ".cim") && strcmp (&str[i - 4], ".CIM"))) str[i - 4] = '\0'; - + return str; } @@ -250,9 +251,9 @@ static int print_help(int status) "\n " " [-d] [--compare]" " [-D NAME] [--define=NAME]" - " [-e] [--static]" + " [-e] [--static]" "\n " - " [-E] [--preprocess]" + " [-E] [--preprocess]" " [-F] [--write-mif]" " [-g] [--debug]" "\n " @@ -358,10 +359,10 @@ static int parseoptions (int argc, char *argv[]) switch (c) { - case 0: - /* If this option set a flag, do nothing else now. */ - break; - case 'a': + case 0: + /* If this option set a flag, do nothing else now. */ + break; + case 'a': option_atr = TRUE; option_checkdiff = TRUE; option_reuse_timestamp = TRUE; @@ -579,8 +580,7 @@ static int parseoptions (int argc, char *argv[]) /****************************************************************************** MAIN */ - -main (int argc, char *argv[], char *envp[]) +int main (int argc, char *argv[], char *envp[]) { char *archname; char *kom; @@ -596,7 +596,7 @@ main (int argc, char *argv[], char *envp[]) init_trap_routines(); get_all_env(); - + insert_name_in_dirlist (systemlibdir); init_name (); @@ -608,24 +608,26 @@ main (int argc, char *argv[], char *envp[]) if (option_verbose) { - fprintf - (stderr, + fprintf + (stderr, "Cim Compiler (version: %s configuration name: %s).\n" "Copyright 1989-1998 by Sverre Hvammen Johansen, Stein Krogdahl," - "Terje Mjøs and Free Software Foundation, Inc.\n" + "Terje MjÞs and Free Software Foundation, Inc.\n" "Cim comes with ABSOLUTELY NO WARRANTY.\n" "This is free software, and you are welcome to redistribute it\n" - "under the GNU General Public License; version 2.\n", + "under the GNU General Public License; version 2.\n", PACKAGE_VERSION, SYSTEM_TYPE); } - if(option_atr) - system (newstrcat6 ("cp -f ", extcodename, " ", extcodename, - ".old", " 2>/dev/null")); - + if(option_atr) { + if (system (newstrcat6 ("cp -f ", extcodename, " ", extcodename, + ".old", " 2>/dev/null")) != 0) { + fprintf (stderr, "Failed to copy %s to %s.old\n", extcodename, extcodename); + } + } if(option_checkdiff) { - rename (ccodename, newstrcat2 (ccodename, ".old")); + rename (ccodename, newstrcat2 (ccodename, ".old")); } if (!option_nosim && passes_do ()) @@ -634,13 +636,13 @@ main (int argc, char *argv[], char *envp[]) if(option_checkdiff) { - rename (ccodename, newstrcat2 (ccodename, ".old")); + rename (ccodename, newstrcat2 (ccodename, ".old")); } return (1); } #if 0 - /* Følgende skal ikke gjøre skade. + /* Følgende skal ikke gjøre skade. Må få dette til å virke før cim kan gjøre mer enn en kompilering. */ @@ -655,7 +657,7 @@ main (int argc, char *argv[], char *envp[]) char status; unlink (ccodename); - status = system (newstrcat5 ("cmp -s ", extcodename, " ", + status = system (newstrcat5 ("cmp -s ", extcodename, " ", extcodename, ".old 2>/dev/null")); unlink (newstrcat2 (extcodename, ".old")); if (status) @@ -676,7 +678,7 @@ main (int argc, char *argv[], char *envp[]) return (1); } - fprintf (shlfile, + fprintf (shlfile, "#! /bin/sh\n" "\n" "CC='%s'\n" @@ -777,7 +779,7 @@ main (int argc, char *argv[], char *envp[]) " fi\n" "fi\n" "\n", - ccomp, "", SLDFLAGS, + ccomp, "-Wno-unsequenced", SLDFLAGS, WL_FLAG, LINK_STATIC_FLAG, PIC_FLAG, ccodename, ccodename, ccodename, @@ -795,15 +797,17 @@ main (int argc, char *argv[], char *envp[]) " fi\n" "\n" " $CC $LDFLAGS -o %s %s %s %s || exit 1\n" - "fi\n", + "fi\n", outputname, ocodename, get_names_in_linklist (), outputname, ocodename, get_names_in_linklist (), SLIBS); } - if (!((option_nolink && !separat_comp) + if (!((option_nolink && !separat_comp) || option_nocc || option_notempdel)) fprintf (shlfile, "rm -f %s\n",shlname); fclose (shlfile); - system (newstrcat2 ("chmod +x ", shlname)); + if (system (newstrcat2 ("chmod +x ", shlname)) != 0) { + fprintf (stderr, "%s: Failed to set executable flag\n", shlname); + } } fflush (stdout); argv[0]= shlname; diff --git a/src/computeconst.c b/src/computeconst.c index f385a6c..fd715f1 100644 --- a/src/computeconst.c +++ b/src/computeconst.c @@ -17,7 +17,7 @@ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #include -#include +#include "obstack.h" #include #include "const.h" @@ -25,6 +25,8 @@ #include "checker.h" #include "expmacros.h" #include "newstr.h" +#include "error.h" +#include "gen.h" /****************************************************************************** SETDANGER_CONST */ @@ -56,17 +58,17 @@ char setdanger_const (exp_t *re) sub_danger = setdanger_const (LEFT); if (RIGHT != NULL) sub_danger |= setdanger_const (RIGHT); - DANGER = FALSE; + re->danger = FALSE; switch (re->token) { case MNEWARG: case MARRAYARG: case MCONC: - DANGER = TRUE; + re->danger = TRUE; break; case MPROCARG: - DANGER = danger_proc (RD); - if (DANGER == FALSE) + re->danger = danger_proc (RD); + if (re->danger == FALSE) { exp_t *rex; KONST = TRUE; @@ -81,6 +83,8 @@ char setdanger_const (exp_t *re) case MINTEGERKONST: case MBOOLEANKONST: continue; + default: + break; } KONST = FALSE; break; @@ -89,24 +93,26 @@ char setdanger_const (exp_t *re) break; case MASSIGNR: if (UPTOKEN == MASSIGNR && RIGHTTOKEN != MASSIGNR) - DANGER = TRUE; + re->danger = TRUE; break; case MREFASSIGNT: if (UPTOKEN == MVALASSIGNT) - DANGER = TRUE; + re->danger = TRUE; break; case MIDENTIFIER: if (RD->kind == CNAME) - DANGER = TRUE; + re->danger = TRUE; break; case MORELSEE: case MANDTHENE: case MIFE: case MELSE: - DANGER = sub_danger; + re->danger = sub_danger; + break; + default: break; } - return (sub_danger | DANGER); + return (sub_danger | re->danger); } /****************************************************************************** @@ -119,11 +125,12 @@ static int sstrcmp (char s[], char t[]) ss, tt; i = 0; - if (s == NOTEXT) + if (s == NOTEXT) { if (t == NOTEXT) return (0); else return ((char) -1); + } while (s[i] == t[i]) { if (s[i] == '\0') @@ -159,14 +166,15 @@ int sstrlen (char s[]) while (s[i]) { ii++; - if (s[i++] == '\\') + if (s[i++] == '\\') { if (s[i++] == '\n') ii--; else i += 2; + } } if (ii >= MAX_TEXT_CHAR) - serror (44); + serror (44, "", 0); return (ii); } @@ -182,7 +190,7 @@ int sstrlen (char s[]) * Den fjerner ogs} noder med token lik MNOOP, med unntak n} * typen er lik TTEXT og tokenet til noden over i treet er lik MDOT, * og tokenet til venstrenoden er lik MIF, MARRAYARG eller MIDENTIFIER. - * Den fjerner noder med token lik MREAINT + * Den fjerner noder med token lik MREAINT * og MINTREA mellom multippel assign.*/ char computeconst (exp_t *re) @@ -271,7 +279,7 @@ char computeconst (exp_t *re) if (lconst == FALSE && LEFT != NULL) { - if (TOKEN == MNOOP && (TYPE != TTEXT || UPTOKEN != MDOT + if (TOKEN == MNOOP && (TYPE != TTEXT || UPTOKEN != MDOT || (LEFTTOKEN != MIFE && LEFTTOKEN != MARRAYARG && LEFTTOKEN != MIDENTIFIER))) { @@ -404,8 +412,8 @@ char computeconst (exp_t *re) long i, s; VALUE.rval = 1.0; if (LEFTVALUE.rval == 0 && RIGHTVALUE.ival == 0) - serror (4); - if (RIGHTVALUE.ival < 0) + serror (4, "", 0); + if (RIGHTVALUE.ival < 0) { RIGHTVALUE.ival= -RIGHTVALUE.ival; s= 1; @@ -450,7 +458,7 @@ char computeconst (exp_t *re) TOKEN = MINTEGERKONST; if (RIGHTVALUE.ival == 0) { - serror (1); + serror (1, "", 0); VALUE.ival = LEFTVALUE.ival; } else @@ -461,7 +469,7 @@ char computeconst (exp_t *re) long i; VALUE.ival = 1; if (RIGHTVALUE.ival < 0) - serror (4); + serror (4, "", 0); for (i = 1; i <= RIGHTVALUE.ival; i++) VALUE.ival *= LEFTVALUE.ival; TOKEN = MINTEGERKONST; @@ -483,4 +491,3 @@ char computeconst (exp_t *re) RIGHT = NULL; return (TRUE); } - diff --git a/src/dekl.c b/src/dekl.c index 3c911da..fc6c120 100644 --- a/src/dekl.c +++ b/src/dekl.c @@ -25,17 +25,17 @@ #include "name.h" #include "salloc.h" #include "cimcomp.h" +#include "extspec.h" +#include "error.h" #include -#include +#include "obstack.h" #include "config.h" #if STDC_HEADERS #include #endif -char *xmalloc(); - #define obstack_chunk_alloc xmalloc #define obstack_chunk_free free @@ -62,12 +62,12 @@ int localused; int arrdim; -block_t *ssblock; /* First system block - (The outermost system block with blev=0) +block_t *ssblock; /* First system block + (The outermost system block with blev=0) the system environment is conected to this block */ block_t *cblock; /* Current block */ -block_t *sblock; /* First non system block +block_t *sblock; /* First non system block (The outermost block with blev=1) sblock is connected with ssblock through two INSP blocks (sysin and sysout) */ @@ -76,13 +76,13 @@ static block_t *lblock; static int cblno; -block_t *seenthrough; /* Settes av find_global og find_local og peker +block_t *seenthrough; /* Settes av find_global og find_local og peker * p} en utenforliggende inspect blokk(hvis * den finnes). Det er fordi jeg onsker * } vite n}r en variable er sett gjennom * inspect. Trenger denne informasjon i * kode genereringen for } aksessere - * variable fra den inspiserte klassen + * variable fra den inspiserte klassen * gjennom inspect variabelen */ decl_t *classtext; @@ -90,7 +90,7 @@ decl_t *classtext; int cblev; decl_t *cprevdecl; - + /* Har en peker som peker p} en array deklarasjon som ikke har f}tt * satt sin dim verdi. */ decl_t *last_array; @@ -171,7 +171,7 @@ void decl_init_pass1 (void) { block_t *rb; decl_t *rd; - + cblev= -1; unknowns = new_block (); unknowns->quant.kind = KERROR; @@ -186,7 +186,7 @@ void decl_init_pass1 (void) i en evig løkke dersom det er noe som er udeklarert. Er ikke sikker på om å bare kommentere det ut er riktig løsning */ - lesinn_external_spec (tag ("TEXTOBJ*"), "simenvir"); + lesinn_external_spec (tag ("TEXTOBJ*"), "simenvir", KSIMPLE); commonprefiks = find_global (tag ("COMMON*"), TRUE); commonprefiks->plev = -1; @@ -195,13 +195,13 @@ void decl_init_pass1 (void) begin_block (KINSP); begin_block (KINSP); rd = find_global (tag ("MAXLONGREAL"), TRUE); - rd->value.rval = MAX_DOUBLE; + rd->value.rval = DBL_MAX; rd = find_global (tag ("MINLONGREAL"), TRUE); - rd->value.rval = -MAX_DOUBLE; + rd->value.rval = -DBL_MAX; rd = find_global (tag ("MAXREAL"), TRUE); - rd->value.rval = MAX_DOUBLE; + rd->value.rval = DBL_MAX; rd = find_global (tag ("MINREAL"), TRUE); - rd->value.rval = -MAX_DOUBLE; + rd->value.rval = -DBL_MAX; rd = find_global (tag ("MAXRANK"), TRUE); rd->value.ival = MAXRANK; rd = find_global (tag ("MAXINT"), TRUE); @@ -321,10 +321,10 @@ static decl_t *newnotseen (char *ident) FINDDECL */ /* Find_decl leter etter deklarasjonen ident lokalt i blokken og langs - * den prefikskjede.Den kalles rekursivt for hvert BLOCK objekt langs - * prefikskjeden.Ved en inspect blokk kalles den for den ispiserte - * klassen og dens prefikser.Finnes den returneres en peker til - * deklarasjonspakka, hvis ikke returneres NULL + * den prefikskjede.Den kalles rekursivt for hvert BLOCK objekt langs + * prefikskjeden.Ved en inspect blokk kalles den for den ispiserte + * klassen og dens prefikser.Finnes den returneres en peker til + * deklarasjonspakka, hvis ikke returneres NULL * HVIS virt==TRUE skal det først letes i evt. virtuell liste */ decl_t *find_decl (char *ident, block_t *rb, char virt) @@ -354,7 +354,7 @@ decl_t *find_decl (char *ident, block_t *rb, char virt) || rb->quant.kind == KFOR || rb->quant.kind == KCON) if (rb->quant.plev > -1 && rb->quant.prefqual != NULL) if ((rd = find_decl (ident, rb->quant.prefqual->descr, - rb->quant.kind == KCLASS | rb->quant.kind == KPRBLK ? FALSE : virt)) != NULL) + (rb->quant.kind == KCLASS | rb->quant.kind == KPRBLK) ? FALSE : virt)) != NULL) return (rd); return (NULL); @@ -363,9 +363,9 @@ decl_t *find_decl (char *ident, block_t *rb, char virt) /****************************************************************************** FINDGLOBAL */ -/* Find_global finner den deklarasjonen som svarer til et navn - * Den leter for hvert blokknivaa, i prefikskjeden og lokalt - * Stopper ved f\rste forekomst, fins den ikke kalles newnotseen +/* Find_global finner den deklarasjonen som svarer til et navn + * Den leter for hvert blokknivaa, i prefikskjeden og lokalt + * Stopper ved f\rste forekomst, fins den ikke kalles newnotseen * Hvis virt==true skal det først letes i evt. virtuell liste */ decl_t *find_global (char *ident, char virt) @@ -390,7 +390,7 @@ decl_t *find_global (char *ident, char virt) } /****************************************************************************** - SAMEPARAM */ + SAMEPARAM */ /* Sjekker om parameterene er de samme */ @@ -466,14 +466,14 @@ static void makeequal (decl_t *rd1, decl_t *rd2) decl_t *commonqual (decl_t *rdx, decl_t *rdy) { /* Hvis rdx eller rdy peker på - * commonprefiks (som har plev=-1) s} vil + * commonprefiks (som har plev=-1) s} vil * den leveres som felles kvalifikasjon, som - * er ønskelig i den situasjonen. Men hvis + * er ønskelig i den situasjonen. Men hvis * ikke en av dem peker dit så vil IKKE * commonprefiks være felles kvalifikasjon. - * Dette betyr at det ikke er nødvendig - * med spesialbehandling for parametere til - * call, resume. Hvis rdx eller rdy er lik + * Dette betyr at det ikke er nødvendig + * med spesialbehandling for parametere til + * call, resume. Hvis rdx eller rdy er lik * NULL, returneres den andre. */ if (rdx == NULL) return (rdy); if (rdy == NULL) return (rdx); @@ -556,10 +556,10 @@ void begin_block (char kind) if (lastcblock != NULL) { if (lastcblock->lastparloc == NULL) - cprevdecl= lastcblock->parloc=lastcblock->lastparloc= + cprevdecl= lastcblock->parloc=lastcblock->lastparloc= &cblock->quant; else - cprevdecl= lastcblock->lastparloc= + cprevdecl= lastcblock->lastparloc= lastcblock->lastparloc->next= &cblock->quant; cblock->quant.type= TNOTY; cblock->quant.categ= CLOCAL; @@ -707,7 +707,7 @@ void reg_decl (char *ident, char type, char kind, char categ) case CVAR: /* Denne er kun satt for eksterne moduler */ if (kind == KNOKD) { - for (pd = cblock->parloc; + for (pd = cblock->parloc; pd != NULL && pd->ident != ident; pd = pd->next); if (pd != NULL || type != TVARARGS) { @@ -858,7 +858,7 @@ void reg_decl (char *ident, char type, char kind, char categ) } break; default: - d1error (37); + d1error (37, ident); break; } #ifdef DEBUG @@ -870,7 +870,7 @@ void reg_decl (char *ident, char type, char kind, char categ) /****************************************************************************** REGINNER */ -/* Kalles fra syntakssjekkeren hver gang +/* Kalles fra syntakssjekkeren hver gang * inner oppdages, sjekker da lovligheten */ void reg_inner (void) @@ -881,11 +881,11 @@ void reg_inner (void) ,lineno, cblev); #endif if (cblock->quant.kind != KCLASS) - d1error (38); + d1error (38, ""); else { if (cblock->inner) - d1error (39); + d1error (39, ""); else cblock->inner = TRUE; } @@ -907,7 +907,7 @@ void reg_inner (void) #ifdef DEBUG -static +static dumpdekl (rd) decl_t *rd; { @@ -967,7 +967,7 @@ dumpblock (rb) block_t *rb; { decl_t *rd; - printf + printf ("->BLOCK:(%d,%d) k:%c, np:%d, nv:%d, nvl:%d, f:%d, c:%d, l:%ld, ", rb->blno, rb->blev, rb->quant.kind, rb->napar, rb->navirt, rb->navirtlab, rb->fornest, @@ -1083,7 +1083,7 @@ dump () /* Setter/fjerner protected merket når klasser entres/forlates */ -static setprotectedvirt (block_t *rb, decl_t *rd, char protected) +static void setprotectedvirt (block_t *rb, decl_t *rd, char protected) { block_t *rbx; decl_t *rdx; @@ -1140,7 +1140,7 @@ static void setprotected (block_t *rb, char protected) SETPREFCHAIN */ /* Setter opp prefikskjeden rekursift - * Oppdager ulovlig prefiks og feil prefiksnivå + * Oppdager ulovlig prefiks og feil prefiksnivå * Oppdager ved merking sirkulær prefikskjede */ static void setprefchain (decl_t *rd) @@ -1178,9 +1178,9 @@ static void setprefchain (decl_t *rd) } else if ((cblock->quant.kind == KFOR && rdx->encl != rd->encl) /* For for-block s} blir ikke blokkniv}et |ket. Prefiksen vil aldri - * v{re deklarert i for-blokken (da ville det v{rt lagt p} en ekstra - * blokk), den vil ligge i prefiksen til for-blokken, og det er - * ulovlig, da en for-blokk alltid skal opptre som om det er en blokk + * v{re deklarert i for-blokken (da ville det v{rt lagt p} en ekstra + * blokk), den vil ligge i prefiksen til for-blokken, og det er + * ulovlig, da en for-blokk alltid skal opptre som om det er en blokk */ || (rdx->encl->blev != rd->encl->blev)) { @@ -1207,7 +1207,7 @@ static void setprefchain (decl_t *rd) /****************************************************************************** SETQUALPREFCHAIN */ -/* Setter opp prefikskjeden og kvalifikasjonen til pekere +/* Setter opp prefikskjeden og kvalifikasjonen til pekere * gjør kall på setprefchain og sjekker kvalifikasjonen */ static decl_t *setqualprefchain (decl_t *rd, int param) @@ -1225,13 +1225,13 @@ static decl_t *setqualprefchain (decl_t *rd, int param) rd->plev = 0; if (rdx->categ == CNEW) { - d2error (53, rd); + d2error (53, rd, rdx); rdx->categ = CERROR; } else if (rdx->kind != KCLASS) { if (rdx->categ != CERROR) - d2error (54, rd); + d2error (54, rd, rdx); rdx->categ = CERROR; rd->type = TERROR; } @@ -1246,9 +1246,9 @@ static decl_t *setqualprefchain (decl_t *rd, int param) /****************************************************************************** SJEKKDEKL */ -/* Kalles i pass 2 for hver blokk som ikke er en prosedyre eller klasse - * Sjekkdekl tar seg av å sjekke og akumulere opp virtuelle - * Prefikskjeden og kvalifikasjoner settes ved kall på setqualprefchain +/* Kalles i pass 2 for hver blokk som ikke er en prosedyre eller klasse + * Sjekkdekl tar seg av å sjekke og akumulere opp virtuelle + * Prefikskjeden og kvalifikasjoner settes ved kall på setqualprefchain * den sjekker også konsistensen for type kind og categ */ static void sjekkdekl (block_t *rb) @@ -1320,9 +1320,9 @@ static void sjekkdekl (block_t *rb) || rdx->protected == TRUE; rdx = rdx->next); if (rdx != rd) { - if (kind == KPROC && (rdx->categ == CDEFLT || + if (kind == KPROC && (rdx->categ == CDEFLT || rdx->categ == CVALUE || - rdx->categ == CNAME || + rdx->categ == CNAME || rdx->categ == CVAR) && rd->categ != CDEFLT && rd->categ != CVALUE && rd->categ != CNAME && rd->categ != CVAR) @@ -1335,11 +1335,11 @@ static void sjekkdekl (block_t *rb) obstack_free (&os_pref, s); } else - d2error (55, rd); + d2error (55, rd, rdx); } } if (rd->kind == KNOKD && rd->type != TVARARGS) - d2error (63, rd); + d2error (63, rd, rdx); if (rd->kind == KARRAY && rd->type == TNOTY) rd->type = TREAL; switch (rd->categ) @@ -1355,17 +1355,17 @@ static void sjekkdekl (block_t *rb) /* if (kind == KCLASS) { if (rd->kind == KPROC | rd->type == TLABEL) - d2error (56, rd); + d2error (56, rd, rdx); }*/ if (rd->type == TVARARGS) { if (rd->next != NULL) - d2error (80, rd); + d2error (80, rd, rdx); if (kind != KPROC || rb->quant.categ != CCPROC) - d2error (81, rd); + d2error (81, rd, rdx); } if (rd->type == TLABEL && rb->quant.categ == CCPROC) - d2error (82, rd); + d2error (82, rd, rdx); break; case CVALUE: /* Sjekker om lovlig valueoverføring */ @@ -1379,14 +1379,14 @@ static void sjekkdekl (block_t *rb) else if (rd->type == TVARARGS) { if (rd->next != NULL) - d2error (80, rd); + d2error (80, rd, rdx); if (kind != KPROC || rb->quant.categ != CCPROC) - d2error (81, rd); + d2error (81, rd, rdx); } else - d2error (57, rd); + d2error (57, rd, rdx); if (rd->type == TLABEL && rb->quant.categ == CCPROC) - d2error (82, rd); + d2error (82, rd, rdx); break; case CVAR: if (rd->type == TREF && (rd->kind == KSIMPLE | rd->kind == KARRAY)) @@ -1396,30 +1396,30 @@ static void sjekkdekl (block_t *rb) case CNAME: /* Nameparameter til klasser er ikke lovlig */ /* if (kind == KCLASS) - d2error (58, rd);*/ + d2error (58, rd, rdx);*/ if (kind == KPROC && rb->quant.categ == CCPROC && (rd->type == TTEXT || rd->type == TREF)) - d2error (77, rd); + d2error (77, rd, rdx); if (rd->type == TVARARGS) { if (rd->next != NULL) - d2error (80, rd); + d2error (80, rd, rdx); if (kind != KPROC || rb->quant.categ != CCPROC) - d2error (81, rd); + d2error (81, rd, rdx); } if (rd->type == TLABEL && rb->quant.categ == CCPROC) - d2error (82, rd); + d2error (82, rd, rdx); break; case CEXTR: case CEXTRMAIN: break; case CCPROC: if (rd->type == TREF) - d2error (78, rd); + d2error (78, rd, rdx); break; default: /* ULOVLIG CATEG */ - d2error (59, rd); + d2error (59, rd, rdx); } } if (rb->quant.kind == KCLASS || rb->quant.kind == KPRBLK) @@ -1465,7 +1465,7 @@ static void sjekkdekl (block_t *rb) va->protected == TRUE; va = va->next); if (va != vc) { - d2error (60, vc); + d2error (60, vc, rdx); while (va->next != vc) va = va->next; va->next = vc->next; @@ -1476,7 +1476,7 @@ static void sjekkdekl (block_t *rb) /* Sjekker om det er lovlig virtuell */ if (vc->kind != KPROC && vc->type != TLABEL) { - d2error (61, vc); + d2error (61, vc, rdx); vc->type = TERROR; vc->kind = KERROR; } @@ -1513,7 +1513,7 @@ static void sjekkdekl (block_t *rb) if ((rd->kind == KCLASS && rd->match != sjekkdeklcalled) || (rd->kind == KPROC && (rd->categ == CLOCAL || rd->categ == CCPROC))) { - cblock = rd->descr; + cblock = rd->descr; sjekkdekl (rd->descr); } else @@ -1536,12 +1536,12 @@ static void sjekkdekl (block_t *rb) { if (vc->protected) continue; - for (va = rb->parloc; va != NULL && va->ident != vc->ident; + for (va = rb->parloc; va != NULL && va->ident != vc->ident; va = va->next); if (va != NULL) { if ((vc->type == TERROR && (va->kind == KPROC || va->type == TLABEL)) - || (vc->type == TLABEL && va->type == TLABEL + || (vc->type == TLABEL && va->type == TLABEL && vc->kind == va->kind) || (vc->kind == KPROC && va->kind == KPROC && subordinate (va, vc) && same_param (vc->descr, va->descr))) @@ -1551,7 +1551,7 @@ static void sjekkdekl (block_t *rb) vc->prefqual = va->prefqual; } else - d2error (62, va); + d2error (62, va, rdx); } else if (vc->match == vc) vc->match = NULL; @@ -1564,11 +1564,11 @@ static void sjekkdekl (block_t *rb) rdx = find_local (rd->ident, &rb->quant, TRUE); if (rdx->categ == CNEW) { - d2error (74, rd); + d2error (74, rd, rdx); rdx->categ = CERROR; } else if (rd->categ != CHIDEN && rdx->encl != rb) - d2error (75, rd); + d2error (75, rd, rdx); else if (rd->categ != CHIDEN && rdx->categ == CVIRT) { if (rb->quant.plev == 0) @@ -1578,11 +1578,11 @@ static void sjekkdekl (block_t *rb) else vno = rb->quant.prefqual->descr->navirtlab; if (rdx->virtno <= vno) - d2error (75, rd); + d2error (75, rd, rdx); else rd->match = rdx; } - else if (rd->categ == CHIDEN && rdx->categ == CVIRT + else if (rd->categ == CHIDEN && rdx->categ == CVIRT && rb->quant.plev > 0) { for (rdy = rb->quant.prefqual->descr->virt; @@ -1598,7 +1598,7 @@ static void sjekkdekl (block_t *rb) for (rd = rb->hiprot; rd != NULL; rd = rd->next) if (rd->categ == CHIDEN && rd->match != NULL && rd->match->protected == FALSE) - d2error (76, rd); + d2error (76, rd, rdx); } } @@ -1608,7 +1608,7 @@ static void sjekkdekl (block_t *rb) /*****************************************************************************/ /****************************************************************************** - FIRSTCLASS */ + FIRSTCLASS */ block_t *firstclass (void) { /* Retunerer med blev for den n{rmeste @@ -1671,7 +1671,7 @@ void out_block (void) { cblock->quant.prefqual->descr->when = NULL; } - if (cblock->quant.kind == KFOR || cblock->quant.kind == KINSP + if (cblock->quant.kind == KFOR || cblock->quant.kind == KINSP || cblock->quant.kind == KCON) cblock = cblock->quant.prefqual->descr; else @@ -1698,7 +1698,7 @@ void reginsp (block_t *rb, decl_t *rd) { if (rd == NULL) { - d2error (73, &rb->quant); + d2error (73, &rb->quant, NULL); rd = find_global (tag ("Noqual"), FALSE); rd->categ = CERROR; } @@ -1741,7 +1741,7 @@ decl_t *reg_this (char *ident) if (rd->ident == ident) { if (rd->descr->thisused == MAYBEE) - d2error (72, rd); + d2error (72, rd, rdx); rd->descr->thisused |= TRUE; #ifdef DEBUG if (option_input) @@ -1762,17 +1762,17 @@ decl_t *reg_this (char *ident) if (option_input) printf ("---end\n"); #endif - d2error (79, rd = find_global (ident, FALSE)); + d2error (79, rd = find_global (ident, FALSE), rdx); return (rd); } /****************************************************************************** FINDLOCAL */ -/* Find_local finner den deklarasjonen som svarer til et navn - * Den leter lokalt i den lista den har fåt og dens prefikskjede - * Har den ikke fåt noen liste leter den slik find_global gjør - * Den registrerer også localused +/* Find_local finner den deklarasjonen som svarer til et navn + * Den leter lokalt i den lista den har fåt og dens prefikskjede + * Har den ikke fåt noen liste leter den slik find_global gjør + * Den registrerer også localused * Hvis virt==TRUE skal det først letes i evt. virtuell liste */ decl_t *find_local (char *ident, decl_t *rd, char virt) @@ -1793,8 +1793,8 @@ decl_t *find_local (char *ident, decl_t *rd, char virt) /****************************************************************************** NEXTPARAM & FIRSTPARAM */ -/* To prosedyrer for å finne parameterene - * til en prosedyre eller klasse +/* To prosedyrer for å finne parameterene + * til en prosedyre eller klasse * Får som input forrige parameter */ decl_t *next_param (decl_t *rd) @@ -1866,8 +1866,8 @@ decl_t *first_param (decl_t *rd) else arrayparam->dim = USPECDIM; return (arrayparam); - } - /* else Kommentertut p.g.a full spesifisering + } + /* else Kommentertut p.g.a full spesifisering * av parametere til formelle prosedyrer. * if(rd->kind==KPROC && rd->categ==CDEFLT) { * return(procparam); } */ @@ -1905,7 +1905,7 @@ int more_param (decl_t *rd) return (TRUE); return (FALSE); } - /* er kommenter ut siden formelle procedyrer er fullt ut spesifisert + /* er kommenter ut siden formelle procedyrer er fullt ut spesifisert * if(rd==procparam)return(MAYBEE); */ return (TRUE); } @@ -1922,7 +1922,7 @@ int body (decl_t *rd) rbx = cblock; rb = rd->descr; for (rbx= cblock; rbx->blev > 0; rbx= rbx->quant.encl) - { + { /* Hvis vi er inne i en inspect blokk eller for blokk */ /* m} match f|lges for } f} riktig blokk. KAN BARE */ /* BRUKES FOR ] UNDERS\KE OM MAN ER INNE I EN PROSEDYRE */ @@ -1935,7 +1935,7 @@ int body (decl_t *rd) } /****************************************************************************** - DANGERPROC */ + DANGERPROC */ /* Er prosedyren farlig og m] isoleres i uttrykk */ @@ -1963,7 +1963,7 @@ char danger_proc (decl_t *rd) void remove_block (block_t *rb) { decl_t *rd; - if (rb->quant.encl->parloc->descr == rb) + if (rb->quant.encl->parloc->descr == rb) rb->quant.encl->parloc= rb->quant.encl->parloc->next; else { diff --git a/src/dekl.h b/src/dekl.h index 7fd43bc..204d08a 100644 --- a/src/dekl.h +++ b/src/dekl.h @@ -181,7 +181,7 @@ struct _block * parameter */ #define CCTEXTDANGER 12 #define CCFILEBLANKSCOPY 13 /* Kall p} filename */ -#define CCFILE 9 /* Peker til file-klasse som f|rste parameter +#define CCFILE 9 /* Peker til file-klasse som f|rste parameter */ #define CCFILEDANGER 3 #define CCDETACH 4 /* Peker til klasse som skal detach'es som @@ -189,7 +189,7 @@ struct _block #define CCCALLRESUME 5 /* Siste parameter er returadressen */ #define CCEXIT 6 /* Main modul: goto ll; Ekstern * modul: lgoto=;mgoto=0;return; */ -#define CCRANDOMRUTDANGER 7 /* Ranom rutinene har siste parameter +#define CCRANDOMRUTDANGER 7 /* Ranom rutinene har siste parameter * overfort by name */ #define CCCPROC 8 /* Ekstern C-prosedyre */ @@ -199,10 +199,9 @@ void end_block (char *rtname, char codeclass); void reg_decl (char *ident, char type, char kind, char categ); void reg_inner (void); decl_t *new_decl (void); -extern block_t *firstclass (void); +block_t *firstclass (void); void in_block (void); void out_block (void); -extern decl_t *reg_this (); void remove_block (block_t *rb); @@ -248,4 +247,6 @@ void reginsp (block_t *rb, decl_t *rd); decl_t *reg_this (char *ident); extern char yaccerror; + +char *xmalloc (unsigned int size); #endif diff --git a/src/error.c b/src/error.c index 8eba5ba..632692f 100644 --- a/src/error.c +++ b/src/error.c @@ -19,11 +19,11 @@ /* Inneholder de tekstlige feilmeldingene som kompilatoren kan gi. * For noen tilfeller b|r det gis bedre og mer spesifike feilmeldinger. * Dette gjelder spesielt for feilmeldinger fra sjekkeren. - * + * * Siden det kan inkluderes filer m} det lages et tabellverk som * holder greie p} hvilke linjenummere internt i kompilator-programmet - * som h|rer til de enkelte filene. - * Dette tabellverket brukes s} i forbindelse med utskrift + * som h|rer til de enkelte filene. + * Dette tabellverket brukes s} i forbindelse med utskrift * av feilmeldinger. */ #include "const.h" @@ -33,17 +33,18 @@ #include "extspec.h" #include "mapline.h" +#include "config.h" + #if STDC_HEADERS #include #endif -#include "config.h" - #if STDC_HEADERS || HAVE_STRING_H #include #else #include #endif +#include int anterror; @@ -60,7 +61,7 @@ starterror (long line) } /****************************************************************************** - LERROR */ + LERROR */ /* Feil som oppdages av LEX */ @@ -181,7 +182,7 @@ void lerror (int errcode) } /****************************************************************************** - YERROR */ + YERROR */ /* Feil som oppdages av YACC */ @@ -249,7 +250,7 @@ void yerror (int errcode, char *txt) } /****************************************************************************** - D1ERROR */ + D1ERROR */ /* Feil som oppdages av DECL PASS 1 */ @@ -290,7 +291,7 @@ void d1error (int errcode, char *name) } /****************************************************************************** - D2ERROR */ + D2ERROR */ /* Feil som oppdages av DECL PASS 2 */ @@ -408,7 +409,7 @@ void d2error (int errcode, decl_t *rd1, decl_t *rd2) } /****************************************************************************** - TEXTNUMBER */ + TEXTNUMBER */ char *textnumber (int i) { @@ -452,7 +453,7 @@ char *textnumber (int i) } /****************************************************************************** - SERROR */ + SERROR */ /* Feil som oppdages av SJEKKEREN */ @@ -492,7 +493,7 @@ void serror (int errcode, char *name, int ant) exit (TRUE); break; case 71: - fprintf (stderr, "System error: Illegal symbol in M.\n" + fprintf (stderr, "System error: Illegal symbol %s in M.\n" , name); exit (TRUE); break; @@ -640,7 +641,7 @@ void serror (int errcode, char *name, int ant) } /****************************************************************************** - GERROR */ + GERROR */ /* Feil som oppdages av kodegeneratoren */ @@ -728,7 +729,7 @@ void merror (int errcode, char *name) ,name); break; default: - fprintf (stderr, "System error: No Message specified (%d).\n", + fprintf (stderr, "System error: No Message specified (%d).\n", errcode); } exit (TRUE); diff --git a/src/expbuilder.c b/src/expbuilder.c index f2a4e6b..dde4e15 100644 --- a/src/expbuilder.c +++ b/src/expbuilder.c @@ -17,7 +17,7 @@ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #include -#include +#include "obstack.h" #include "const.h" #include "builder.h" @@ -34,8 +34,6 @@ #include #endif -char *xmalloc(); - #define obstack_chunk_alloc xmalloc #define obstack_chunk_free free @@ -59,7 +57,7 @@ void ebuilder_init_pass2 (void) } /****************************************************************************** - NEWEXP */ + NEWEXP */ exp_t *newexp(void) { @@ -176,7 +174,7 @@ static void eclean(void ) /****************************************************************************** EPUSH */ -static epush(exp_t *re) +static void epush(exp_t *re) { obstack_grow (&os_stack, &re, sizeof (void *)); } @@ -305,6 +303,3 @@ void ebuild (void) token= min(); } } - - - diff --git a/src/expchecker.c b/src/expchecker.c index 5bfdcb1..ff55d52 100644 --- a/src/expchecker.c +++ b/src/expchecker.c @@ -22,6 +22,7 @@ #include "checker.h" #include "expmacros.h" #include "name.h" +#include "error.h" static decl_t *absfunction; static decl_t *absfunctionr; @@ -127,31 +128,31 @@ static void sserror (int melding, exp_t *re) { if (RD && RD->categ == CNEW) { - serror (melding, RD->ident); + serror (melding, RD->ident, 0); RD->categ = CERROR; } else if (LEFT && LEFTRD && LEFTRD->categ == CNEW) { - serror (melding, LEFTRD->ident); + serror (melding, LEFTRD->ident, 0); LEFTRD->categ = CERROR; } else if (RIGHT && RIGHTRD && RIGHTRD->categ == CNEW) { - serror (melding, RIGHTRD->ident); + serror (melding, RIGHTRD->ident, 0); RIGHTRD->categ = CERROR; } else if (QUAL && QUAL->categ == CNEW) { - serror (melding, QUAL->ident); + serror (melding, QUAL->ident, 0); QUAL->categ = CERROR; } - else if ((LEFT ? LEFTTYPE != TERROR : TRUE) + else if ((LEFT ? LEFTTYPE != TERROR : TRUE) && (RIGHT ? RIGHTTYPE != TERROR : TRUE) && (UP ? UPTYPE != TERROR : TRUE) && (RD ? RD->type != TERROR : TRUE) && - (QUAL ? QUAL->type != TERROR : TRUE) + (QUAL ? QUAL->type != TERROR : TRUE) && (UPRD ? UPRD->type != TERROR : TRUE) && (TYPE != TERROR)) - serror (melding, RD ? RD->ident : 0); + serror (melding, RD ? RD->ident : 0, 0); TYPE = TERROR; } @@ -188,7 +189,7 @@ static void konvtype (exp_t **re, char type, decl_t *qual) { if (((*re)->up->left == NULL || (*re)->up->left->type != TERROR) && ((*re)->up->right == NULL || (*re)->up->right->type != TERROR)) - serror (85, (*re)->up->token); + serror (85, "", (*re)->up->token); (*re)->type = (*re)->up->type = TERROR; } else if ((rd = commonqual ((*re)->qual, qual)) == qual) /* OK */ ; @@ -210,7 +211,7 @@ static void konvtype (exp_t **re, char type, decl_t *qual) if (((*re)->token == MNEWARG) || (((*re)->up->left == NULL || (*re)->up->left->type != TERROR) && ((*re)->up->right == NULL || (*re)->up->right->type != TERROR))) - serror (85, (*re)->up->token); + serror (85, "", (*re)->up->token); (*re)->type = (*re)->up->type = TERROR; } } @@ -230,7 +231,7 @@ static void sametype (exp_t **rel, exp_t **rer) /****************************************************************************** ARGUMENTERROR */ -static argumenterror (int melding, exp_t *re) +static void argumenterror (int melding, exp_t *re) { int i = 1; if (TYPE == TERROR) @@ -243,7 +244,6 @@ static argumenterror (int melding, exp_t *re) if (re->type == TERROR) return; serror (melding, re->value.ident, i); - } /****************************************************************************** @@ -310,7 +310,7 @@ static void exp_check (exp_t *re) if(TOKEN==MUNTIL && TYPE==TINTG && RIGHTTYPE==TREAL) { - } + } else { konvtype (&RIGHT, TYPE, QUAL); @@ -354,7 +354,7 @@ static void exp_check (exp_t *re) if (UPTOKEN != MASSIGN && UPTOKEN != MASSIGNR && UPTOKEN != MENDASSIGN && UPTOKEN != MCONST) SERROR (118); - else if (TYPE != TTEXT && LEFTTOKEN != MIDENTIFIER + else if (TYPE != TTEXT && LEFTTOKEN != MIDENTIFIER && LEFTTOKEN != MPROCASSIGN && LEFTTOKEN != MARRAYARG && LEFTTOKEN != MDOT) SERROR (90); @@ -586,7 +586,7 @@ static void exp_check (exp_t *re) if (RD->kind != KCLASS) { if (RD->kind != KERROR) - serror (84); + serror (84, "", 0); } } else if (RD == sourcelinefunction) @@ -661,7 +661,7 @@ static void exp_check (exp_t *re) } else SERROR (7); - } + } break; case MTHIS: RD = reg_this (VALUE.ident); @@ -986,6 +986,8 @@ static void exp_check (exp_t *re) break; } break; + default: + break; } } @@ -998,4 +1000,3 @@ void main_exp_check (exp_t *re) computeconst (re); setdanger_const (re); } - diff --git a/src/expgen.c b/src/expgen.c index 7561e31..60e0ab0 100644 --- a/src/expgen.c +++ b/src/expgen.c @@ -19,6 +19,8 @@ #include "limit.h" #include "gen.h" #include "extspec.h" +#include "error.h" +#include "checker.h" int stack; static int anttext; @@ -83,7 +85,7 @@ void genchain (block_t *rb, char atr) int i; if (rb->stat) if (atr) - fprintf (ccode, "(__blokk%d%s).", rb->blno, + fprintf (ccode, "(__blokk%d%s).", rb->blno, rb->timestamp?rb->timestamp:timestamp); #if 0 else if (rb == sblock && separat_comp) @@ -92,14 +94,14 @@ void genchain (block_t *rb, char atr) #endif fprintf (ccode, "__NULL"); else - fprintf (ccode, "((__dhp)&__blokk%d%s)", rb->blno, + fprintf (ccode, "((__dhp)&__blokk%d%s)", rb->blno, rb->timestamp?rb->timestamp:timestamp); else { block_t *rbx; /* rbx = display[rb->blev];*/ for (rbx= cblock; rbx->blev != rb->blev; rbx= rbx->quant.encl); - + while (rbx->quant.kind == KFOR || rbx->quant.kind == KINSP || rbx->quant.kind == KCON) rbx = rbx->quant.prefqual->descr; @@ -108,12 +110,12 @@ void genchain (block_t *rb, char atr) if (atr) { fprintf (ccode, "((__bs%d *)&__blokk%d%s)->", - rb->blno, rbx->blno, + rb->blno, rbx->blno, rbx->timestamp?rbx->timestamp:timestamp); } else - fprintf (ccode, "((__dhp)&__blokk%d%s)", - rbx->blno, + fprintf (ccode, "((__dhp)&__blokk%d%s)", + rbx->blno, rbx->timestamp?rbx->timestamp:timestamp); } else @@ -121,11 +123,11 @@ void genchain (block_t *rb, char atr) if (atr) fprintf (ccode, "((__bs%d *)__lb", rb->blno); else - fprintf (ccode, "__lb", rb->blno); + fprintf (ccode, "__lb"); for (i = cblev + (inthunk ? 1 : 0); i > rb->blev; i--) fprintf (ccode, "->sl"); if (atr) - fprintf (ccode, ")->", rb->blno); + fprintf (ccode, ")->"); } } } @@ -168,8 +170,8 @@ void gen_adr_prot (FILE *code, decl_t *rd) fprintf (code, "&__p%d%s" ,rd->descr->timestamp == 0 ? rd->descr->blno : rd->descr->ptypno ,rd->descr->timestamp == 0 ? - (rd->encl->blev == SYSTEMGLOBALBLEV && - rd->encl->quant.plev == 0 + (rd->encl->blev == SYSTEMGLOBALBLEV && + rd->encl->quant.plev == 0 ? "" :timestamp) : rd->descr->timestamp); } @@ -209,7 +211,7 @@ static void gen_attr_object (int i, int type) rb= cblock; } - if ((rb->quant.kind == KCLASS || rb->quant.kind == KPRBLK) && + if ((rb->quant.kind == KCLASS || rb->quant.kind == KPRBLK) && rb->quant.plev > 0) { while (rb->quant.plev >0) @@ -362,13 +364,13 @@ void genvalue (exp_t *re) break; case MPROCARG: - /* Predefinerte prosedyrer, C-prosedyrer eller vanlige + /* Predefinerte prosedyrer, C-prosedyrer eller vanlige * proper-procedures, som er behandlet av transcall. De * predefinerte og C-prosedyrene skal behandles her, mens vanlige * proper-procedures allerede er behandlet i transcall. */ if (re->rd->descr->codeclass == CCNO) { - /* Statisk link overf|res i den globale variabelen sl. + /* Statisk link overf|res i den globale variabelen sl. * Genererer kallet p} rcp. */ if (re->rd->categ != CNAME) @@ -388,13 +390,13 @@ void genvalue (exp_t *re) if (re->rd->categ == CVIRT) { - /* Kall p} en virtuell prosedyre. - * Prosedyrens prototype er gitt i virtuell tabellen. + /* Kall p} en virtuell prosedyre. + * Prosedyrens prototype er gitt i virtuell tabellen. * M} teste at den ikke er NULL, som gir * run-time error. */ fprintf (ccode, "if((__pp="); gensl (re, FALSE, OFF); - fprintf (ccode, "->pp->virt[%d])==__NULL)__rerror(__errvirt);", + fprintf (ccode, "->pp->virt[%d])==__NULL)__rerror(__errvirt);", re->rd->virtno - 1); } @@ -420,7 +422,7 @@ void genvalue (exp_t *re) if (re->type == TNOTY) fprintf (ccode, ");"); else - fprintf (ccode, ",%ldL);", + fprintf (ccode, ",%ldL);", re->value.n_of_stack_elements); /* Kaller p} genprocparam som genererer kode for parameter- @@ -432,10 +434,10 @@ void genvalue (exp_t *re) * kalles.(Den informasjonen trengs ikke da) */ - /* N} er alle parameterene overf}rt, + /* N} er alle parameterene overf}rt, * og prosedyren kan settes i gang. */ - { + { int l; fprintf (ccode, "__rcpb(%d,", l= newlabel ()); genmodulemark(NULL); @@ -454,8 +456,8 @@ void genvalue (exp_t *re) /* H}ndterer evt. funksjonsverdier. Sjekker om det * er n|dvendig med konvertering av aritm. returverier eller * kvalifikasjonskontroll for type REF Dette gjelder formelle - * prosedyrer med categ lik CVAR og CNAME (type = TREF, - * TINTG og TREAL) + * prosedyrer med categ lik CVAR og CNAME (type = TREF, + * TINTG og TREAL) */ switch (re->type) @@ -516,7 +518,7 @@ void genvalue (exp_t *re) gencproccall (re); fprintf (ccode, ";"); fprintf (ccode, "__rblanks(%ldL,__ctext==__NULL?0:" - "strlen(__ctext));(void)strcpy(", + "strlen(__ctext));(void)strcpy(", re->value.n_of_stack_elements); fprintf (ccode, "__et.obj->string,__ctext);"); @@ -734,7 +736,7 @@ void genvalue (exp_t *re) fprintf (ccode, ","); genvalue (re->right); fprintf (ccode, ");"); - + break; case MTEXTKONST: fprintf (ccode, "(__txtvp)&__tk%d%s", re->value.tval.id, @@ -817,7 +819,7 @@ void genvalue (exp_t *re) (re->type == TREAL || re->type == TINTG) && (!(re->up->token == MASSIGN && re->up->left == re))) { /* Lese aksess av aritm. var-parameter. For - * bare er gjort RT-call for skrive-aksess. + * bare er gjort RT-call for skrive-aksess. */ if (re->type == TINTG) { /* To muligheter : ingen eller real -> int */ @@ -844,17 +846,17 @@ void genvalue (exp_t *re) re->rd->ident); } } - else if (re->rd->categ == CNAME + else if (re->rd->categ == CNAME && re->up->token == MASSIGN && re->up->right == re) { /* Lese-aksess av en name-parameter som det nettopp * er gjort skrive-aksess p}. Vanligvis gj|res - * konvertering av NAME-parametere av RT-rutiene, men - * ikke i tilfelle med multippel assignment. Det gj|res + * konvertering av NAME-parametere av RT-rutiene, men + * ikke i tilfelle med multippel assignment. Det gj|res * da her. Noden er omd|pt fra MNAMEADR til * MIDENTIFER i case MASSIGN grenen i genvalue. */ - + if (re->type == TINTG) { /* To muligheter : ingen eller real -> int */ fprintf (ccode, "(("); @@ -900,7 +902,7 @@ void genvalue (exp_t *re) /* Lese-aksess av referanse var-parametere. Legger inn * kode som sjekker om re er "in" strengeste * kvalifikasjon p} aksessveien. */ - + fprintf (ccode, "((((__vrp= &"); gensl (re, TRUE, ON); fprintf (ccode, "%s)->conv==__READTEST " @@ -913,11 +915,11 @@ void genvalue (exp_t *re) } else { - /* For parametere av type Character, Boolean, LESE og + /* For parametere av type Character, Boolean, LESE og * SKRIVE-AKSESS AV B]DE VAR OG NAME- PARAMETERE som * ikke er behandlet lengre oppe */ - - if (re->rd->kind == KARRAY) + + if (re->rd->kind == KARRAY) if (re->rd->categ ==CNAME) fprintf (ccode, "(__arrp)__er"); else @@ -933,25 +935,23 @@ void genvalue (exp_t *re) fprintf (ccode, " *("); gentype (re); fprintf (ccode, " *)(((char *)"); - + gensl (re, TRUE, ON); fprintf (ccode, "%s.", re->rd->ident); - + if (re->rd->categ == CVAR) fprintf (ccode, "bp)+"); else - fprintf (ccode, "bp)+", - re->rd->ident); - + fprintf (ccode, "bp)+"); + gensl (re, TRUE, ON); fprintf (ccode, "%s.", re->rd->ident); - + if (re->rd->categ == CVAR) - fprintf (ccode, "ofs)", re->rd->ident); + fprintf (ccode, "ofs)"); else - fprintf (ccode, "v.ofs)", - re->rd->ident); + fprintf (ccode, "v.ofs)"); } } } /* End Var eller Name-parameter */ @@ -993,7 +993,7 @@ void genvalue (exp_t *re) * for de etterf|lgende aksessene */ fprintf (ccode, "__bp="); gensl (re, FALSE, ON); - fprintf (ccode, ";__rgoto(((__bs%d *)__bp)->%s.ob);" + fprintf (ccode, ";__rgoto(((__bs%d *)__bp)->%s.ob);" "__goto=((__bs%d *)__bp)->%s.adr;", re->rd->encl->blno, re->rd->ident, re->rd->encl->blno, re->rd->ident); @@ -1006,7 +1006,7 @@ void genvalue (exp_t *re) gensl (re, FALSE, ON); fprintf (ccode, ");"); fprintf (ccode, "if((__pp=__lb"); - } + } else { fprintf (ccode, "if((__pp="); @@ -1030,7 +1030,7 @@ void genvalue (exp_t *re) if (re->rd->encl->timestamp != 0) { /* Skal hoppe til en label i en annen modul */ - fprintf (ccode, "__goto.ent=%ld;__goto.ment=", + fprintf (ccode, "__goto.ent=%ld;__goto.ment=", re->rd->plev); genmodulemark(re->rd->encl->timestamp); fprintf (ccode, ";"); @@ -1041,7 +1041,7 @@ void genvalue (exp_t *re) break; } not_reached = TRUE; - } + } else { int i, dim; @@ -1064,22 +1064,21 @@ void genvalue (exp_t *re) for (rex = re->right; rex->token != MENDSEP; rex = rex->right) dim++; - fprintf + fprintf (ccode, "((__arrp)"); gen_ref_stack (re->value.stack.ref_entry); - fprintf (ccode, ")->h.dim!=%d?__rerror(__errarr):1;", - dim, re->rd->ident); + fprintf (ccode, ")->h.dim!=%d?__rerror(__errarr):1;", dim); } dim= 0; for (rex = re->right; rex->token != MENDSEP; rex = rex->right) { if (dim == MAX_ARRAY_DIM) - gerror (85); + gerror (85, ""); fprintf (ccode, "__h[%d]=", dim++); genvalue (rex->left); fprintf (ccode, "-((__arrp)"); gen_ref_stack (re->value.stack.ref_entry); - fprintf (ccode, ")->limits[%d].low;", + fprintf (ccode, ")->limits[%d].low;", dim - 1); } fprintf (ccode, "if("); @@ -1146,7 +1145,7 @@ void genvalue (exp_t *re) gensl (re, TRUE, ON); { int i; - fprintf (ccode, "%s,%ldL,%d,", re->rd->ident, + fprintf (ccode, "%s,%ldL,%d,", re->rd->ident, re->value.n_of_stack_elements, i = newlabel ()); genmodulemark(NULL); fprintf (ccode, "))"); @@ -1162,14 +1161,14 @@ void genvalue (exp_t *re) gen_int_stack (re->value.stack.val_entry); fprintf (ccode, "=__ev.i;"); gen_ref_stack (re->value.stack.ref_entry); - fprintf (ccode, "=__er;" + fprintf (ccode, "=__er;" "break; case __VALUE_THUNK: case __VALUE_NOTHUNK: "); gen_txt_stack (re->value.stack.txt_entry); fprintf (ccode, "=__et;"); gen_ref_stack (re->value.stack.ref_entry); fprintf (ccode, "= __NULL;" ""); - fprintf (ccode, ""); + fputs ("", ccode); gen_int_stack (re->value.stack.val_entry); fprintf (ccode, "= ((char *)&"); gen_txt_stack (re->value.stack.txt_entry); @@ -1202,8 +1201,8 @@ void genvalue (exp_t *re) genchain (re->qual->descr, FALSE); break; case MQUA: - /* Sjekker om det er n\dvendig } utf\re en none-test, eller om den er - * utf\rt lengre ned i treet. */ + /* Checks whether it is necessary to perform a none test, + * or whether it has been performed further down the tree. */ if (re->left->token != MDOT && re->left->token != MQUA && re->left->token != MQUANOTNONE && nonetest == ON) { @@ -1227,8 +1226,8 @@ void genvalue (exp_t *re) fprintf (ccode, ")?(__dhp)__rerror(__errqual):__bp)"); break; case MQUANOTNONE: - /* Sjekker om det er n\dvendig } utf\re en none-test, eller om den er - * utf\rt lengre ned i treet. */ + /* Checks whether it is necessary to perform a none test, + * or whether it has been performed further down the tree. */ if (re->left->token != MDOT && re->left->token != MQUA && re->left->token != MQUANOTNONE) { @@ -1345,7 +1344,7 @@ void genvalue (exp_t *re) fprintf (ccode, "("); if (re->right->token == MASSIGN) { - if (re->right->left->token == MNAMEADR + if (re->right->left->token == MNAMEADR || re->right->left->token == MTEXTADR) { if (re->right->left->type == TREAL) @@ -1385,7 +1384,7 @@ void genvalue (exp_t *re) re->left->rd->ident); } else - { /* Tre muligheter : ingen, int -> real, og + { /* Tre muligheter : ingen, int -> real, og * real ->int ->real */ fprintf (ccode, "if((__vvp= &"); gensl (re->left, TRUE, ON); @@ -1474,7 +1473,7 @@ void genvalue (exp_t *re) "|| __vrp->conv==__READWRITETEST) && !__rin((__bp= ", rex->rd->ident); genvalue (re->right); - fprintf + fprintf (ccode, "),__vrp->q))?(__dhp)__rerror(__errqual):(__bp="); genvalue (re->right); fprintf (ccode, "))"); @@ -1485,7 +1484,7 @@ void genvalue (exp_t *re) case MNOOP: if (re->type == TTEXT) { - /* Parantes i forbindelse med tekster. Venstre-siden skal legges p} + /* Parantes i forbindelse med tekster. Venstre-siden skal legges p} * en anonym tekst-variabel. */ fprintf (ccode, "__rtextassign(&__et,"); genvalue (re->left); @@ -1495,7 +1494,7 @@ void genvalue (exp_t *re) genvalue (re->left); break; case MSL: - + break; case MSENTCONC: genvalue (re->left); @@ -1609,7 +1608,7 @@ void gen_textconst (exp_t *re) anttext, antchar + 1, anttext, timestamp, anttext, timestamp, antchar, anttext, timestamp, antchar, t); - + re->value.tval.id = anttext; } } diff --git a/src/expmacros.h b/src/expmacros.h index fa66b6e..82da25a 100644 --- a/src/expmacros.h +++ b/src/expmacros.h @@ -67,6 +67,4 @@ #define UPISLEFT re->up->up->left==re->up #define ISRIGHT re->up->right==re -#undef DANGER -#define DANGER re->danger #define KONST re->konst diff --git a/src/extspec.c b/src/extspec.c index e6ee47a..9923491 100644 --- a/src/extspec.c +++ b/src/extspec.c @@ -27,6 +27,7 @@ #include "cimcomp.h" #include "extspec.h" #include "name.h" +#include "error.h" #if STDC_HEADERS || HAVE_STRING_H #include @@ -51,15 +52,15 @@ double strtod (); #endif -#include -char *xmalloc(); +#include "obstack.h" +#include #define obstack_chunk_alloc xmalloc #define obstack_chunk_free free static struct obstack os_extspec; static char *first_object_allocated_ptr_extspec; -/* HUSK AT REKKEF\LGEN SKAL V[RE categ,type,kind +/* HUSK AT REKKEF\LGEN SKAL V[RE categ,type,kind * * Filen starter alltid med * @@ -101,8 +102,8 @@ static char *first_object_allocated_ptr_extspec; #define CPROC_MARKER '^' #define NO_MARKER '$' #define inchar(f) getc(f) -#define getval(f, i) { int tmp;fscanf(f,"%d",&tmp);i=tmp;} -#define getconst(f, i) { fscanf(f,"%ld",&i);} +#define getval(f, i) { int tmp; if (1 == fscanf(f,"%d",&tmp)) i=tmp; else i=0; } +#define getconst(f, i) { if (1 != fscanf(f,"%ld",&i)) i=0; } /****************************************************************************** INITEXTSPEC */ @@ -134,10 +135,10 @@ static char * getname (FILE *f) return sx; } -/* fscanf leter frem til neste \n eller blank (eller til slutten) men lar - * \n eller blank bli igjen. - * Hvis \n er forste tegn n}r fscanf kalles s} kastes dette tegnet.Men - * getc kalles etter fscanf s} vil denne returnere med \n.Derfor m} dette +/* fscanf leter frem til neste \n eller blank (eller til slutten) men lar + * \n eller blank bli igjen. + * Hvis \n er forste tegn n}r fscanf kalles s} kastes dette tegnet.Men + * getc kalles etter fscanf s} vil denne returnere med \n.Derfor m} dette * tegnet leses av etter at hvert navn er lest inn * For å overføre filnavn id til deklarasjonslageret */ @@ -146,10 +147,10 @@ char *directive_timestamp=""; struct stamp *first_stamp; static char timestampchars[63] = -{'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', - 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z', - 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', - 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', +{'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', + 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z', + 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', + 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '_'}; /****************************************************************************** @@ -167,7 +168,7 @@ void gettimestamp (void) if (strcmp (directive_timestamp, "")) timestamp= directive_timestamp; - else if (option_reuse_timestamp && (f = searc_and_open_name_in_archlist + else if (option_reuse_timestamp && (f = searc_and_open_name_in_archlist (extcodename, TRUE)) != NULL) { if (option_verbose) @@ -176,8 +177,8 @@ void gettimestamp (void) { char r_buff[12]; r_buff[0] = '\0'; - fscanf (f, "%11s\n", r_buff); - if (strcmp (r_buff, "/*Cim_atr*/")) + if (fscanf (f, "%11s\n", r_buff) == 1 && + strcmp (r_buff, "/*Cim_atr*/")) merror (5, extcodename); } @@ -235,10 +236,10 @@ static char *genatrfilenamefromfilename (char *filename) { char *s, *sx; int len = strlen (filename); - - if (len >=4 && !strcmp (&filename[len - 4], ".atr")) + + if (len >=4 && !strcmp (&filename[len - 4], ".atr")) return (tag (filename)); - + if (len >=4 && !(strcmp (&filename[len - 4], ".sim") && strcmp (&filename[len - 4], ".SIM") && strcmp (&filename[len - 4], ".cim") @@ -276,7 +277,7 @@ static char external_is_in (char *ident, char kind) static char *lesinn (char *filename); -static nextdecl (FILE *f, char *filename, char *timestamp) +static int nextdecl (FILE *f, char *filename, char *timestamp) { char type, kind, categ; char tegn; @@ -428,14 +429,14 @@ static char *lesinn (char *filename) { char r_buff[12]; r_buff[0] = '\0'; - fscanf (f, "%11s\n", r_buff); - if (strcmp (r_buff, "/*Cim_atr*/")) + if (fscanf (f, "%11s\n", r_buff) == 1 && + strcmp (r_buff, "/*Cim_atr*/")) merror (5, filename); } /* Leser tidsmerke */ - timestamp= getname (f); + timestamp= getname (f); for (st = first_stamp; st != NULL; st = st->next) if (st->timestamp == timestamp) @@ -565,9 +566,9 @@ static void write_text_mif (FILE *f, unsigned char *s) /****************************************************************************** WRITE_DECL_MIF */ -static write_decl_mif (FILE *f, decl_t *rd, int level) +static void write_decl_mif (FILE *f, decl_t *rd, int level) { - if (rd->kind == KBLOKK || rd->kind == KPRBLK || rd->kind == KFOR || + if (rd->kind == KBLOKK || rd->kind == KPRBLK || rd->kind == KFOR || rd->kind == KINSP) return; if (level == 0) { @@ -670,7 +671,7 @@ static write_decl_mif (FILE *f, decl_t *rd, int level) rb = rd->descr; if (rd->categ == CEXTROUT) rd->categ = CEXTR; - + /* evt. parametere */ fprintf (f, " ("); for (rdx = rb->parloc; rdx != NULL && (rdx->categ == CDEFLT || rdx->categ == CNAME || @@ -738,26 +739,26 @@ static write_decl_mif (FILE *f, decl_t *rd, int level) if (rd->type == TLABEL) fprintf (f, "\n%% ENT %d", rd->plev); #endif - if (rd->categ == CCONST) - if (rd->type == TTEXT) - write_text_mif (f, rd->value.tval.txt); - else if (rd->type == TREAL) - { + if (rd->categ == CCONST) { + if (rd->type == TTEXT) { + write_text_mif (f, (unsigned char*)rd->value.tval.txt); + } else if (rd->type == TREAL) { char s[100]; int i; sprintf (s, "= %.16le", rd->value.rval); - for (i=0; s[i]; i++) - if (s[i]=='e') + for (i=0; s[i]; i++) + if (s[i]=='e') { s[i]='&'; break; } fprintf (f, "%s", s); - } - else if (rd->type == TCHAR) + } else if (rd->type == TCHAR) { write_char_mif (f, rd->value.ival); - else + } else { fprintf (f, "= %ld", rd->value.ival); + } + } if (rd->kind == KARRAY && rd->type != TLABEL) { int i; @@ -773,14 +774,14 @@ static write_decl_mif (FILE *f, decl_t *rd, int level) case CNAME: case CVAR: case CVALUE: - if (rd->next!=NULL && (rd->next->categ == CDEFLT || + if (rd->next!=NULL && (rd->next->categ == CDEFLT || rd->next->categ == CNAME || - rd->next->categ == CVAR || + rd->next->categ == CVAR || rd->next->categ == CVALUE)) fprintf(f, ", "); break; case CLOCAL: - if (rd->type == TLABEL && rd->kind == KSIMPLE) + if (rd->type == TLABEL && rd->kind == KSIMPLE) { fprintf (f, ":"); break; @@ -821,7 +822,7 @@ static void write_all_mif (void) for (rd = sblock->parloc; rd != NULL; rd = rd->next) if (rd->categ == CEXTR) /* OK */ ; - else + else if (rd->categ == CEXTRMAIN) { rd->categ = CEXTR; @@ -841,10 +842,9 @@ static void write_all_mif (void) /****************************************************************************** WRITE_DECL_EXT */ - -static write_decl_ext (FILE *f, decl_t *rd) +static void write_decl_ext (FILE *f, decl_t *rd) { - if (rd->kind == KBLOKK || rd->kind == KPRBLK || rd->kind == KFOR || + if (rd->kind == KBLOKK || rd->kind == KPRBLK || rd->kind == KFOR || rd->kind == KINSP) ; else if (rd->categ == CEXTR || rd->categ == CEXTRMAIN) fprintf (f, "&%c%c%s %s %s\n", rd->type, rd->kind @@ -918,7 +918,7 @@ static write_decl_ext (FILE *f, decl_t *rd) else if (rd->type == TLABEL) fprintf (f, "%ld", rd->plev); - if (rd->categ == CCONST) + if (rd->categ == CCONST) { if (rd->type == TTEXT) fprintf (f, "%ld %s " ,strlen (rd->value.tval.txt) @@ -927,6 +927,7 @@ static write_decl_ext (FILE *f, decl_t *rd) fprintf (f, "%.16e ", rd->value.rval); else fprintf (f, "%ld ", rd->value.ival); + } if (rd->kind == KARRAY) fprintf (f, "%c", (rd->dim + ((short) '0'))); } @@ -1003,13 +1004,13 @@ void more_modules (void) { char *newlink_moduler; char r_buff[12]; - + /* Leser identifikasjon , som alltid ligger f|rst p} filen */ r_buff[0] = '\0'; - fscanf (f, "%11s\n", r_buff); - if (strcmp (r_buff, "/*Cim_atr*/")) + if (fscanf (f, "%11s\n", r_buff) == 1 && + strcmp (r_buff, "/*Cim_atr*/")) merror (5, st->filename); - + /* Leser tidsmerke */ local_timestamp= getname (f); @@ -1017,9 +1018,9 @@ void more_modules (void) { if (option_verbose) fprintf (stderr, "Reading atr-file %s\n", st->filename); - insert_name_in_linklist + insert_name_in_linklist (transform_name (st->filename, ".atr", ".o"), TRUE); - + } } } diff --git a/src/filelist.c b/src/filelist.c index 257dd45..b09bcde 100644 --- a/src/filelist.c +++ b/src/filelist.c @@ -22,15 +22,15 @@ #include "newstr.h" #include "filelist.h" #include "config.h" +#include "error.h" #if STDC_HEADERS #include #endif #include -#include - -char *xmalloc(); +#include +#include "obstack.h" #define obstack_chunk_alloc xmalloc #define obstack_chunk_free free @@ -126,7 +126,7 @@ static char insert_name (filelist_t *listp, char *name, char first) { new->next= listp->first; listp->first= new; - } + } else { listp->last= listp->last->next= new; @@ -143,6 +143,7 @@ char insert_name_in_dirlist (char *name) if (name==NULL) { clear_list (&dirlist); + return TRUE; } else { @@ -197,7 +198,7 @@ static FILE *open_name (filelist_t *dirlist, filelist_t *linklist, char *name, c if ((f = fopen (str, "r"))!= NULL) #endif { - if (link) + if (link) insert_name (linklist, transform_name (str, ".atr", ".o"), TRUE); return (f); } @@ -249,17 +250,23 @@ static FILE *open_and_position_arch_name (char *archname, char *name) #endif if (f == NULL) merror (6, archname); - fscanf (f, "%7s", s1); + if (fscanf (f, "%7s", s1) != 1) + merror (7, archname); getc (f); if (strcmp (s1, "!")) merror (7, archname); while ((s2 = short_file_name (f)) != NULL) { - fscanf (f, "%12ld", &l); - fscanf (f, "%6ld", &l); - fscanf (f, "%6ld", &l); - fscanf (f, "%8ld", &l); - fscanf (f, "%10ld", &l); + if (fscanf (f, "%12ld", &l) != 1) + merror (8, archname); + if (fscanf (f, "%6ld", &l) != 1) + merror (8, archname); + if (fscanf (f, "%6ld", &l) != 1) + merror (8, archname); + if (fscanf (f, "%8ld", &l) != 1) + merror (8, archname); + if (fscanf (f, "%10ld", &l) != 1) + merror (8, archname); while ((c = getc (f)) != '`' && c != EOF); if (c != '`' || getc (f) != '\n') merror (8, archname); @@ -317,11 +324,11 @@ FILE *searc_and_open_name_in_archlist (char *name, char link) if (link) insert_name (&linklist, transform_name(name,".atr",".o"), TRUE); return (f); } - + f=open_name (&dirlist, &linklist, name, link); for (elem= archlist.first; elem!=NULL; elem= elem->next) - if ((f= open_and_position_arch_name (elem->name, name)) != NULL) + if ((f= open_and_position_arch_name (elem->name, name)) != NULL) return(f); return (NULL); @@ -361,14 +368,10 @@ static char searc_and_insert_name (filelist_t *dirlistp, filelist_t *listp, char void new_lib (char *name) { - searc_and_insert_name (&dirlist, &archlist, - transform_name (newstrcat3 (LIBPREFIX, name, - LIBSUFFIX), + searc_and_insert_name (&dirlist, &archlist, + transform_name (newstrcat3 (LIBPREFIX, name, + LIBSUFFIX), LIBSUFFIX, LIBARCHSUFFIX)); - + insert_name (&linklist, newstrcat2 ("-l", name), FALSE); } - - - - diff --git a/src/getopt.h b/src/getopt.h index 45541f5..7c47e5c 100644 --- a/src/getopt.h +++ b/src/getopt.h @@ -95,14 +95,10 @@ struct option #define optional_argument 2 #if __STDC__ -#if defined(__GNU_LIBRARY__) /* Many other libraries have conflicting prototypes for getopt, with differences in the consts, in stdlib.h. To avoid compilation errors, only prototype getopt for the GNU C library. */ extern int getopt (int argc, char *const *argv, const char *shortopts); -#else /* not __GNU_LIBRARY__ */ -extern int getopt (); -#endif /* not __GNU_LIBRARY__ */ extern int getopt_long (int argc, char *const *argv, const char *shortopts, const struct option *longopts, int *longind); extern int getopt_long_only (int argc, char *const *argv, diff --git a/src/lex.c b/src/lex.c index 3b71541..791a9b3 100644 --- a/src/lex.c +++ b/src/lex.c @@ -34,8 +34,7 @@ double strtod (); #endif -#include -char *xmalloc(); +#include "obstack.h" #define obstack_chunk_alloc xmalloc #define obstack_chunk_free free @@ -66,8 +65,8 @@ static char leerror = FALSE; static char end_of_file; -char external = FALSE; /* Har man sett "EXTERNAL PROC/CLASS =" angir - * external at man venter et filnavn +char external = FALSE; /* Har man sett "EXTERNAL PROC/CLASS =" angir + * external at man venter et filnavn * som ikke skal behandles som * en text-konstant. */ @@ -116,7 +115,7 @@ static int input (void) ) lerror (7); if (yytchar == '#' && notintext) return('%'); - return (islower (yytchar) && notintext && sensitive == OFF + return (islower (yytchar) && notintext && sensitive == OFF ? toupper (yytchar) : yytchar); } @@ -133,7 +132,7 @@ static int input (void) * til objekter. * %stripsideeffects Ikke ta hensyn til sideeffekter i * uttrykk. - * %casesensitive + * %casesensitive * on/off Case-sensitive p} samtlige symboler. * Hvis on er satt s} m} n|kkelord skrives * med store bokstaver. @@ -143,7 +142,7 @@ static int input (void) * %nocomment Resten av linje blir behandlet p} vanlig * m}te. Dette direktivet er nyttig p} den * m}ten at andre kompilatorer vanligvis vil - * ignorere denne linjen, mens cim ikke + * ignorere denne linjen, mens cim ikke * gj|r det. F.eks. Lund gir bare en warning * for slike linjer. * %define Definerer et symbol. @@ -151,7 +150,7 @@ static int input (void) * %ifdef Sjekker om symbolet er definert. * %ifnotdef Sjekker om symbolet ikke er definert. * %else Se nedenfor. - * %endif %ifdef og %ifnotdef er etterfulgt av + * %endif %ifdef og %ifnotdef er etterfulgt av * et antall linjer muligens etterfulgt * av %else og deretter etterfulgt av %endif. * Hvis betingelsen er sann da vil alle @@ -161,7 +160,7 @@ static int input (void) * (hvis %else er utelatt) ignorert. * %elsedef Forkortelse for %else - %ifdef - %endif. * %elsenotdef Forkortelse for %else - %ifnotdef - %endif. - * %timestamp Setter opp et tidsmerke for en + * %timestamp Setter opp et tidsmerke for en * ekstern modul * %eof End of file. Brukes for include-filer * som er lagt i ar-biblioteker. */ @@ -529,7 +528,7 @@ static long radix (int r, char *t) static void scan_nows (void) { obstack_free (&os_lex, yytext); - while (lexchar != '\n' && lexchar != EOF + while (lexchar != '\n' && lexchar != EOF && lexchar != ' ' && lexchar != '\t') { obstack_1grow (&os_lex, lexchar); @@ -539,7 +538,7 @@ static void scan_nows (void) yytext= obstack_finish (&os_lex); } -static scan_name (void) +static void scan_name (void) { obstack_free (&os_lex, yytext); while ((isalnum (lexchar) || lexchar == '_')) @@ -566,7 +565,7 @@ static void scan_ifdef (void) if (!strcmp (yytext, "ENDIF")) { if (ifdefp == include_ifdefp ()) lerror (23); - else + else { ifdefstack_t *prev= ifdefp->prev; obstack_free (&os_ifdef, ifdefp); @@ -603,7 +602,7 @@ static void scan_ifdef (void) { elsedef = FALSE; notdef = TRUE; - } + } else goto proceed; while (lexchar == ' ' | lexchar == '\t') @@ -611,7 +610,7 @@ static void scan_ifdef (void) if (isalpha (lexchar) || lexchar == '_') { scan_name (); - + if (elsedef == TRUE) { if (!(ifdefp->ifdef & IFGREN)) @@ -632,7 +631,7 @@ static void scan_ifdef (void) } ifdefp->ifdef = ifdef_name (tag (yytext)) | IFGREN | scan; } - else + else { if (!bl_in_dir_line) lerror (8); goto proceed; @@ -655,7 +654,7 @@ static void scan_ifdef (void) if ((ifdefp->ifdef == (IFGREN | TRUE)) || (ifdefp->ifdef == (ELSEGREN | FALSE))) break; - + proceed: while (lexchar != EOF) { @@ -663,7 +662,7 @@ static void scan_ifdef (void) lineno++; if (!option_write_tokens) mout (MNEWLINE); - if (newlexchar == '%' && + if (newlexchar == '%' && ((newlexchar == ' ' && option_bl_in_dir_line) ? (newlexchar, bl_in_dir_line = TRUE) : ((bl_in_dir_line = FALSE), TRUE)) && isalpha (lexchar)) @@ -761,16 +760,16 @@ static void scan_dirline (void) while (lexchar != '\n' && lexchar != EOF) newlexchar; if (lexchar == EOF) lerror (19); - + lineno++; if (!option_write_tokens) mout (MNEWLINE); - if (newlexchar == '%' && + if (newlexchar == '%' && ((newlexchar == ' ' && - option_bl_in_dir_line) ? newlexchar : 0, TRUE) + option_bl_in_dir_line) ? newlexchar : 0, TRUE) && isalpha (lexchar)) { scan_name (); - + if (!strcmp (yytext, "COMMENT")) comlev++; if (!strcmp (yytext, "ENDCOMMENT")) @@ -783,12 +782,12 @@ static void scan_dirline (void) case 'D': if (!strcmp (yytext, "DEFINE")) { - while (lexchar == ' ' | lexchar == '\t') + while (lexchar == ' ' || lexchar == '\t') newlexchar; - if (isalpha (lexchar) | lexchar == '_') + if (isalpha (lexchar) || lexchar == '_') { scan_name (); - + define_name (tag (yytext), TRUE); } else if (!bl_in_dir_line) lerror (8); @@ -821,7 +820,7 @@ static void scan_dirline (void) if (lexchar != '\n' | lexchar != EOF) { scan_nows (); - + notintext = TRUE; pushfilmap (tag (yytext), ifdefp); @@ -853,7 +852,7 @@ static void scan_dirline (void) } obstack_1grow (&os_lex, 0); yytext= obstack_finish (&os_lex); - + nylinje = radix (10, yytext); notintext = FALSE; while (lexchar == ' ' | lexchar == '\t') @@ -861,7 +860,7 @@ static void scan_dirline (void) if (lexchar != '\n' & lexchar != EOF) { scan_nows (); - + setfilmap (tag (yytext), nylinje); } else @@ -875,9 +874,9 @@ static void scan_dirline (void) case 'M': if (!strcmp (yytext, "MAIN")) { - while (lexchar == ' ' | lexchar == '\t') + while (lexchar == ' ' || lexchar == '\t') newlexchar; - if (isalpha (lexchar) | lexchar == '_') + if (isalpha (lexchar) || lexchar == '_') { scan_name (); @@ -925,12 +924,12 @@ static void scan_dirline (void) case 'T': if (!strcmp (yytext, "TIMESTAMP")) { - while (lexchar == ' ' | lexchar == '\t') + while (lexchar == ' ' || lexchar == '\t') newlexchar; - if (isalpha (lexchar) | lexchar == '_') + if (isalpha (lexchar) || lexchar == '_') { scan_name (); - + directive_timestamp= yytext; yytext= obstack_finish (&os_lex); } @@ -942,9 +941,9 @@ static void scan_dirline (void) case 'U': if (!strcmp (yytext, "UNDEF")) { - while (lexchar == ' ' | lexchar == '\t') + while (lexchar == ' ' || lexchar == '\t') newlexchar; - if (isalpha (lexchar) | lexchar == '_') + if (isalpha (lexchar) || lexchar == '_') { scan_name (); @@ -1004,7 +1003,7 @@ void lex_reinit (void) obstack_free (&os_ifdef, first_object_allocated_ptr_ifdef); } /****************************************************************************** - PUTCHARACTER */ + PUTCHARACTER */ /* Hjelpe-prosedyre for } bygge opp et konstant-tektsobjekt. */ @@ -1021,13 +1020,13 @@ static char *putcharacter (unsigned char character) } /****************************************************************************** - PUTCHARTEXT */ + PUTCHARTEXT */ /* Prosedyre som fungerer som grensesnitt mot scanner, * for } bygge opp et konstant-tekstobjekt. * Denne rutinen kalles for hvert tegn som skal inn i tekst-objektet. */ -static putchartext ( unsigned char character) +static void putchartext ( unsigned char character) { char *s; s = putcharacter (character); @@ -1035,10 +1034,10 @@ static putchartext ( unsigned char character) } /****************************************************************************** - GETQUOTEDTEXT */ + GETQUOTEDTEXT */ /* Denne rutinen bygger opp et internt konstant-tekstobjekt og returnerer - * en peker til det. Teksten er bygget opp p} en slik m}te at den + * en peker til det. Teksten er bygget opp p} en slik m}te at den * kun inneholder skrivbare tegn eksklusiv '\' ' ' og '"'. * Ikke skrivbare tegn og de tre som er nevnt ovenfor er kodet oktalt * i teksten (\nnn). Denne teksten kan uten videre skrives ut i C og trenger @@ -1088,7 +1087,7 @@ int yylex (void) if (isalpha (newlexchar)) { scan_name (); - + unput (lexchar); switch (yytext[0]) { @@ -1160,49 +1159,49 @@ int yylex (void) { if (newlexchar == 'N') { - if (newlexchar == 'D' && !isalnum (newlexchar) + if (newlexchar == 'D' && !isalnum (newlexchar) && lexchar != '_') { /* END is found and comment is terminated */ unput (lexchar); newsymbole = HEND; return (HEND); - } else - if (antnewline && !reported) + } else + if (antnewline && !reported) {lerror (32); reported = 1;} } - else if (lexchar == 'L' && newlexchar == 'S' + else if (lexchar == 'L' && newlexchar == 'S' && newlexchar == 'E' && !isalnum (newlexchar) && lexchar != '_') { /* ELSE is found and comment is terminated */ unput (lexchar); newsymbole = HELSE; return (HEND); - } else if (antnewline && !reported) + } else if (antnewline && !reported) {lerror (32); reported = 1;} } else if (lexchar == 'W') { - if (newlexchar == 'H' && newlexchar == 'E' + if (newlexchar == 'H' && newlexchar == 'E' && newlexchar == 'N' && !isalnum (newlexchar) && lexchar != '_') { /* WHEN is found and comment is terminated */ unput (lexchar); newsymbole = HWHEN; return (HEND); - } else if (antnewline && !reported) + } else if (antnewline && !reported) {lerror (32); reported = 1;} } - else if (lexchar == 'O' && newlexchar == 'T' - && newlexchar == 'H' && newlexchar == 'E' + else if (lexchar == 'O' && newlexchar == 'T' + && newlexchar == 'H' && newlexchar == 'E' && newlexchar == 'R' && newlexchar == 'W' - && newlexchar == 'I' && newlexchar == 'S' + && newlexchar == 'I' && newlexchar == 'S' && newlexchar == 'E' && !isalnum (newlexchar) && lexchar != '_') { /* OTHERWISE is found and comment is terminated */ unput (lexchar); newsymbole = HOTHERWISE; return (HEND); - } else if (antnewline && !reported) + } else if (antnewline && !reported) {lerror (32); reported = 1;} while (isalpha (lexchar) || lexchar == '_') newlexchar; @@ -1388,7 +1387,7 @@ int yylex (void) yylval.token = HEQR; return (HREFRELOPERATOR); } - if (lexchar == '/') + if (lexchar == '/') { if (newlexchar == '=') { yylval.token = HNER; @@ -1396,6 +1395,7 @@ int yylex (void) } else lerror (7); + } unput (lexchar); yylval.token = HEQ; return (HVALRELOPERATOR); @@ -1491,11 +1491,12 @@ int yylex (void) return (HREALKONST); } - if (lexchar == '.') + if (lexchar == '.') { if (newlexchar == '.') return (HDOTDOTDOT); else lerror (7); + } unput (lexchar); return (HDOT); case ',': @@ -1576,7 +1577,7 @@ int yylex (void) if (newlexchar == '!') { if (firstchar < '2' - || (firstchar == '2' && + || (firstchar == '2' && (secondchar < '5' || (secondchar == '5' && thirdchar < '6')))) @@ -1665,14 +1666,14 @@ int yylex (void) thirdchar = lexchar; if (newlexchar == '!') { - if (firstchar < '2' - || (firstchar == '2' + if (firstchar < '2' + || (firstchar == '2' && (secondchar < '5' || (secondchar == '5' && thirdchar < '6')))) { - putchartext - ((unsigned char) + putchartext + ((unsigned char) (((firstchar - '0') * 10 + secondchar - '0') * 10 + thirdchar - '0')); @@ -1696,7 +1697,7 @@ int yylex (void) } else if (lexchar == '!') { - putchartext ((unsigned char) + putchartext ((unsigned char) ((firstchar - '0') * 10 + secondchar - '0')); newlexchar; @@ -1783,7 +1784,7 @@ int yylex (void) obstack_free (&os_lex, yytext); obstack_1grow (&os_lex, lexchar); - if (newlexchar == 'R' && (first_lexchar == '2' | first_lexchar == '4' + if (newlexchar == 'R' && (first_lexchar == '2' | first_lexchar == '4' | first_lexchar == '8')) { lexradix = first_lexchar - '0'; @@ -1834,7 +1835,7 @@ int yylex (void) lerror (24); ifdefp = (ifdefstack_t *) include_ifdefp (); } - fclose (include_file ()); + fclose (include_file ()); popfilmap (); if (no_filemap ()) return (NOSYMBOL); @@ -1870,7 +1871,7 @@ void scan_and_write_tokens (void) int token; long line = 1L; /* printf("% Cim_pp\n%line 1 %s\n",sourcename); */ - while (token = yylex ()) + while ((token = yylex ())) { while (line < lineno) { @@ -1880,4 +1881,3 @@ void scan_and_write_tokens (void) print_lexsymbol (token, &yylval); } } - diff --git a/src/lex.h b/src/lex.h index ed55707..e97b271 100644 --- a/src/lex.h +++ b/src/lex.h @@ -24,9 +24,14 @@ extern char nameasvar; extern char sensitive; extern char staticblock; +int ylex (void); int yylex (void); +int yyparse (void); void lex_init (void); int lex_init_pass1 (char *sourcename); void lex_reinit (void); void scan_and_write_tokens (void); void print_lexsymbol (int lextok, YYSTYPE *yylvalp); +void parser_init (void); +void parser_init_pass1 (void); +void parser_reinit (void); diff --git a/src/mapline.c b/src/mapline.c index 62599ca..219588e 100644 --- a/src/mapline.c +++ b/src/mapline.c @@ -29,11 +29,10 @@ #include #endif -#include +#include "obstack.h" #include "mapline.h" #include "name.h" - -char *xmalloc(); +#include "error.h" #define obstack_chunk_alloc xmalloc #define obstack_chunk_free free @@ -100,11 +99,11 @@ int pushfilmap (char *filename, void *ifdefp) perror (newstrcat3 (progname, ": ", filename)); return TRUE; } - } + } else { mapstack_t *ms; - + for (ms= mapstackp; ms != NULL; ms= ms->prev) { if (!strcmp (filename, ms->filename)) @@ -123,7 +122,7 @@ int pushfilmap (char *filename, void *ifdefp) fprintf (stderr, "Reading include file %s\n", filename); } - mapstackp= (mapstack_t *) + mapstackp= (mapstack_t *) obstack_alloc (&os_mapstack, sizeof (mapstack_t)); mapstackp->line= lineno + 1 + lastmappos->line; mapstackp->filename= lastmappos->filename; @@ -167,31 +166,31 @@ void setfilmap (char *filename, long line) mappos->filename = filename ? filename : lastmappos->filename; mappos->line = line - lineno - 1; mappos->fromline = lineno + 1; - mappos = (lastmappos = mappos)->neste + mappos = (lastmappos = mappos)->neste = (map_t *) obstack_alloc (&os_map, sizeof (map_t)); mappos->fromline = MAX_INT; } /****************************************************************************** - GETMAPLINE */ + GETMAPLINE */ long getmapline (long line) { if (mapindeks->fromline > line) mapindeks = firstmappos; - while (mapindeks->neste->fromline <= line) + while (mapindeks->neste != NULL && mapindeks->neste->fromline <= line) mapindeks = mapindeks->neste; return (line + mapindeks->line); } /****************************************************************************** - GETMAPFILE */ + GETMAPFILE */ char *getmapfile (long line) { if (mapindeks->fromline > line) mapindeks = firstmappos; - while (mapindeks->neste->fromline <= line) + while (mapindeks->neste != NULL && mapindeks->neste->fromline <= line) mapindeks = mapindeks->neste; return (mapindeks->filename); } @@ -207,11 +206,9 @@ void genmap (void) ,separat_comp ? timestamp : "main", antmap); for (i = 1; i < antmap; i++) { - fprintf (ccode, "\"%s\",%ldL,%ldL,\n", m->filename, + fprintf (ccode, "\"%s\",%ldL,%ldL,\n", m->filename, m->line, m->fromline); m = m->neste; } - fprintf (ccode, "\"\",0L,%ldL};\n", MAX_INT); + fprintf (ccode, "\"\",0L,%dL};\n", MAX_INT); } - - diff --git a/src/mellbuilder.c b/src/mellbuilder.c index b159bae..a63be81 100644 --- a/src/mellbuilder.c +++ b/src/mellbuilder.c @@ -16,7 +16,7 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ -#include +#include "obstack.h" #include "mellbuilder.h" #include "config.h" @@ -31,7 +31,7 @@ #include #endif -char *xmalloc(); +char *xmalloc (unsigned int size); #define obstack_chunk_alloc xmalloc #define obstack_chunk_free free @@ -168,4 +168,3 @@ void mbuilder_reinit(void) first_object_allocated_ptr_mell= 0; } - diff --git a/src/name.c b/src/name.c index 8435a15..9f73656 100644 --- a/src/name.c +++ b/src/name.c @@ -23,14 +23,13 @@ #include "name.h" #include +#include #if STDC_HEADERS #include #endif -#include - -char *xmalloc(); +#include "obstack.h" #define obstack_chunk_alloc xmalloc #define obstack_chunk_free free diff --git a/src/newstr.c b/src/newstr.c index e786e71..4aaaa71 100644 --- a/src/newstr.c +++ b/src/newstr.c @@ -17,7 +17,7 @@ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #include -#include +#include "obstack.h" #include "newstr.h" #include "config.h" @@ -31,8 +31,7 @@ #include #endif - -char *xmalloc(); +char *xmalloc (unsigned int size); #define obstack_chunk_alloc xmalloc #define obstack_chunk_free free @@ -148,4 +147,3 @@ char *newstrcat6(char *s1, char *s2, char *s3, char *s4, char *s5, char *s6) obstack_grow0 (&os_newstr, s6, strlen(s6)); return obstack_finish (&os_newstr);; } - diff --git a/src/pargen.c b/src/pargen.c index 5c34a77..08c7d22 100644 --- a/src/pargen.c +++ b/src/pargen.c @@ -38,10 +38,10 @@ static void gen_conv_and_q (exp_t *rex, char procedure, char transported, char c goto nextcase; } else - /* END-LIK AKTUELL OG FORMELL KVALIFIKASJON */ + /* END-LIK AKTUELL OG FORMELL KVALIFIKASJON */ if (subclass (rex->left->qual, rex->rd->prefqual) && !procedure) { - /* AKTUELL kval. er en subklasse av FORMELL kval. + /* AKTUELL kval. er en subklasse av FORMELL kval. * FP.CONV = AP.CONV || writetest -- FP.Q = AP.Q */ nextcase: if (!transported || !copied_all || writetest) @@ -51,8 +51,7 @@ static void gen_conv_and_q (exp_t *rex, char procedure, char transported, char c { if (copied_all) if (writetest) - fprintf (ccode, "|= __WRITETEST;", - rex->left->value.ident); + fprintf (ccode, "|= __WRITETEST;"); else; else { @@ -82,26 +81,26 @@ static void gen_conv_and_q (exp_t *rex, char procedure, char transported, char c fprintf (ccode, ";"); } else - /* END-AKTUELL KVAL. EN SUBKLASSE AV FORMELL KVAL. */ + /* END-AKTUELL KVAL. EN SUBKLASSE AV FORMELL KVAL. */ if (subclass (rex->rd->prefqual, rex->left->qual)) { if (transported) { /* FORMELL kval. er en subklasse av AKTUELL kval. - * if(FORMELL kval. sub AP.kval) - * { - * FP.CONV=readtest;FP.Q=FORMELL kval. - * }else - * if(AP.kval sub FORMELL kval.) - * { - * FP.CONV=AP.CONV;FP.Q=AP.Q - * }else - * __rerror(); + * if(FORMELL kval. sub AP.kval) + * { + * FP.CONV=readtest;FP.Q=FORMELL kval. + * }else + * if(AP.kval sub FORMELL kval.) + * { + * FP.CONV=AP.CONV;FP.Q=AP.Q + * }else + * __rerror(); * - * rrin() er en runtime som utf|rer en in test - * Den skal ha to prototype pekerer som parametere - * i motsetning til rin() som skal ha en objektpeker - * og en prototype peker + * rrin() er en runtime som utf|rer en in test + * Den skal ha to prototype pekerer som parametere + * i motsetning til rin() som skal ha en objektpeker + * og en prototype peker * Tester alts} om par1 in par2 */ fprintf (ccode, "if(__rrin("); @@ -131,7 +130,7 @@ static void gen_conv_and_q (exp_t *rex, char procedure, char transported, char c fprintf (ccode, "((__bs%d *)__pb)->%s.conv=", rex->rd->encl->blno, rex->rd->ident); gensl (rex->left, TRUE, ON); - fprintf (ccode, "%s.conv;((__bs%d *)__pb)->%s.q=", + fprintf (ccode, "%s.conv;((__bs%d *)__pb)->%s.q=", rex->left->value.ident, rex->rd->encl->blno, rex->rd->ident); gensl (rex->left, TRUE, ON); @@ -239,7 +238,7 @@ static void send_to_formal_par (exp_t *rex, char addressthunk) /* Genererer kode som for ADDRESS_THUNK avgj|r om thunken skal returnere * med en adresse eller en verdi. Dersom en verdi skal returners - * genereres det ogs} kode som utf|rer evt. konverteringer og + * genereres det ogs} kode som utf|rer evt. konverteringer og * kvalifikasjonstester */ void gen_thunk_simple_address (exp_t *rex) @@ -262,7 +261,7 @@ void gen_thunk_simple_address (exp_t *rex) if (nonetest == ON) fprintf (ccode, ")==__NULL?(__dhp)__rerror(__errnone):__bp)"); - fprintf + fprintf (ccode, ";__ev.i=((char *)&((__bs%d *)__p)->%s) - (char *)__p;", rex->left->right->rd->encl->blno, rex->left->right->rd->ident); @@ -273,7 +272,7 @@ void gen_thunk_simple_address (exp_t *rex) fprintf (ccode, "if(!((__thunkp)__pb)->writeaccess)" "__ev.c= *(char *)(((char *)__er)+__ev.i);"); else if (rex->rd->type == TINTG || rex->rd->type == TREAL) - { /* Leser og konverterer verdien hvis det ikke + { /* Leser og konverterer verdien hvis det ikke * er skrive aksess. */ fprintf (ccode, "if(!((__thunkp)__pb)->writeaccess)" " if(((__thunkp)__pb)->ftype==__TINTG)"); @@ -333,7 +332,7 @@ void gen_thunk_simple_value (exp_t *rex) /* KONVERTERING OG KVAL. TESTER */ if (rex->rd->type == TINTG || rex->rd->type == TREAL) - { /* Leser og konverterer verdien hvis det ikke + { /* Leser og konverterer verdien hvis det ikke * er skrive aksess. */ fprintf (ccode, "if(((__thunkp)__pb)->ftype==__TINTG)"); if (rex->left->type == TINTG) @@ -344,8 +343,8 @@ void gen_thunk_simple_value (exp_t *rex) if (rex->left->type == TINTG) fprintf (ccode, "__ev.f=__ev.i;"); else - fprintf - (ccode, + fprintf + (ccode, "if(((__thunkp)__pb)->conv==__REALINTREAL)__ev.f=__rintrea(__ev.f);"); } else if (rex->rd->type == TREF) @@ -361,10 +360,7 @@ void gen_thunk_simple_value (exp_t *rex) static void gensimplepar (exp_t *rex) { - int i; /***** ENKEL INTEGER, REAL, CHAR, REF,TEXT ELLER BOOL PARAMETER ****/ - exp_t *re; - char index_is_const = TRUE; if (rex->rd->categ == CVALUE && rex->rd->type == TTEXT) { @@ -381,7 +377,7 @@ static void gensimplepar (exp_t *rex) if (rex->rd->type == TTEXT) { - fprintf + fprintf (ccode, "((__bs%d *)__pb)->%s= *", rex->rd->encl->blno, rex->rd->ident); genvalue (rex->left); @@ -410,16 +406,16 @@ static void gensimplepar (exp_t *rex) gensl (rex->left, TRUE, ON); fprintf (ccode, "%s;", rex->left->value.ident); gen_conv (rex, FALSE, TRUE); - } /* END VIDEREFRING AV ENKEL VAR-PARAMETER */ + } /* END VIDEREFRING AV ENKEL VAR-PARAMETER */ else if (rex->left->rd->categ == CNAME) { - /* Aktuell parameter er en formell NAME-par i + /* Aktuell parameter er en formell NAME-par i * en ytre prosedyre. Kallet p} transcall som * legger ut kode for kall p} __rgetsa. Den - * returnerer adressen til variabelen i er og + * returnerer adressen til variabelen i er og * ev. */ fprintf (ccode, "((__bs%d *)__pb)->%s.bp=__er;" - "((__bs%d *)__pb)->%s.ofs=__ev.i;", + "((__bs%d *)__pb)->%s.ofs=__ev.i;", rex->rd->encl->blno, rex->rd->ident, rex->rd->encl->blno, rex->rd->ident); gen_conv (rex, FALSE, FALSE); @@ -427,7 +423,7 @@ static void gensimplepar (exp_t *rex) else { /* ENKEL VAR PARAMETER, IKKE VIDEREF\RING Tilordner bp */ - fprintf (ccode, "((__bs%d *)__pb)->%s.bp=", + fprintf (ccode, "((__bs%d *)__pb)->%s.bp=", rex->rd->encl->blno, rex->rd->ident); switch (rex->left->token) @@ -447,8 +443,10 @@ static void gensimplepar (exp_t *rex) case MIDENTIFIER: gensl (rex->left, FALSE, ON); break; + default: + break; } - fprintf (ccode, ";((__bs%d *)__pb)->%s.ofs=", + fprintf (ccode, ";((__bs%d *)__pb)->%s.ofs=", rex->rd->encl->blno,rex->rd->ident); if (rex->left->token == MARRAYADR) @@ -459,8 +457,7 @@ static void gensimplepar (exp_t *rex) else fprintf (ccode, "((char *)&((__bs%d *)__p)->%s)" "-(char *)__p;", - rex->left->rd->encl->blno, rex->left->rd->ident, - rex->rd->encl->blno, rex->rd->ident); + rex->left->rd->encl->blno, rex->left->rd->ident); gen_conv (rex, FALSE, FALSE); } /* END IKKE VIDEREF\RING AV ENKEL * VAR-PARAMETER */ @@ -472,7 +469,7 @@ static void gensimplepar (exp_t *rex) switch (rex->left->token) { case MTEXTKONST: - /* VALUE NOTHUNK Overf|rer peker til textvariabelen for konstanten + /* VALUE NOTHUNK Overf|rer peker til textvariabelen for konstanten */ fprintf (ccode, "((__bs%d *)__pb)->%s.tp=", rex->rd->encl->blno, rex->rd->ident); @@ -538,12 +535,12 @@ static void gensimplepar (exp_t *rex) gen_conv (rex, FALSE, TRUE); } /* END-VIDEREF\RING AV FORMELL NAME-PARAMETER I EN YTRE - * PROSEDYRE. */ + * PROSEDYRE. */ else if (rex->left->rd->categ == CVAR) { /* AKTUELL PARAMETER ER EN FORMELL VAR-PARAMETER I EN YTRE * PROSEDYRE. Setter bp, en hjelpevariabel, til } peker p} den - * aktuelle parameterens blokk. Dermed blir aksessveien kortere + * aktuelle parameterens blokk. Dermed blir aksessveien kortere * under kopieringen. */ fprintf (ccode, "__bp="); @@ -552,7 +549,7 @@ static void gensimplepar (exp_t *rex) /* Tilordner den formelle name-parameterens bp og ofs */ fprintf (ccode, ";((__bs%d *)__pb)->%s.bp=" "((__bs%d *)__bp)->%s.bp;((__bs%d *)__pb)->%s.v.ofs=" - "((__bs%d *)__bp)->%s.ofs;", + "((__bs%d *)__bp)->%s.ofs;", rex->rd->encl->blno, rex->rd->ident, rex->left->rd->encl->blno, rex->left->value.ident, @@ -578,7 +575,7 @@ static void gensimplepar (exp_t *rex) "((char *)&((__bs%d *)__p)->%s)-(char *)__p;", rex->rd->encl->blno, rex->rd->ident, rex->left->rd->encl->blno, - rex->left->rd->ident, rex->left->rd->encl->blno); + rex->left->rd->ident); #if ADDNOTH fprintf (ccode, "((__bs%d *)__pb)->%s.namekind" "=__ADDRESS_NOTHUNK;", @@ -605,6 +602,8 @@ static void gensimplepar (exp_t *rex) #endif gen_conv (rex, FALSE, FALSE); break; + default: + break; } /* END SWITCH */ } /* END-if(rex->rd->categ == CNAME) */ else /* FEIL */ @@ -622,7 +621,7 @@ static void genlabelparexp (exp_t *rex, exp_t *formellpar, char thunk) * genererer kode for et uttrykk av "if-i-uttrykk"-setninger som skal * gi labelens adresse og objekt-peker. Genvalue ville lagd kode * for } hoppe til labelen. - * Parameteren rex peker til en node i uttrykks-treet (enten + * Parameteren rex peker til en node i uttrykks-treet (enten * MIFE, MELSEE eller MIDENTIFIER) mens formellpar peker p} noden for * den formelle parameteren. Hvis den formelle parameteren har * categ==CNAME, skal det genereres en thunk. Parameteren exit er @@ -642,7 +641,7 @@ static void genlabelparexp (exp_t *rex, exp_t *formellpar, char thunk) } else { /* rex->token==MIDENTIFIER Hvis det ikke er - * tatt av en label i systemet, s} gj|res det + * tatt av en label i systemet, s} gj|res det * her, og den legges i plev attributtet */ if (rex->token == MARRAYARG) @@ -672,7 +671,7 @@ static void genlabelparexp (exp_t *rex, exp_t *formellpar, char thunk) if (thunk) fprintf (ccode, ";__er="); else - fprintf (ccode, ";((__bs%d *)__pb)->%s.ob=", + fprintf (ccode, ";((__bs%d *)__pb)->%s.ob=", formellpar->rd->encl->blno, formellpar->rd->ident); gensl (rex, FALSE, ON); @@ -697,8 +696,6 @@ void gen_thunk_lable (exp_t *rex) static void genlabelswitchpar (exp_t *rex) { - int i; - if (rex->left->token == MIDENTIFIER) { switch (rex->left->rd->categ) @@ -706,7 +703,7 @@ static void genlabelswitchpar (exp_t *rex) case CNAME: if (rex->rd->kind != KARRAY && rex->rd->categ != CNAME) { - /* Label par og ikke switch par. Aktuell parameter er en name + /* Label par og ikke switch par. Aktuell parameter er en name * parameter i en ytre prosedyre. M} kalle p} transcall * som genererer kode for kall p} __rgetlab() . og som * returnerer med adressen i modul og ev, og objekt peker i @@ -748,9 +745,9 @@ static void genlabelswitchpar (exp_t *rex) /* VIDEREF\RING AV FORMELL CDEFLT ELLER CVAR (eller NAME for * switch) I EN YTRE PROSEDYRE KOPIERER ment, ent og ob. Setter * bp, en hjelpevariabel, til } peker p} den aktuelle - * parameterens blokk. Dermed blir aksessveien under kopieringen. + * parameterens blokk. Dermed blir aksessveien under kopieringen. */ - + fprintf (ccode, "((__bs%d *)__pb)->%s=", rex->rd->encl->blno, rex->rd->ident); gensl (rex->left, TRUE, ON); @@ -761,7 +758,7 @@ static void genlabelswitchpar (exp_t *rex) rex->rd->encl->blno, rex->rd->ident); gensl (rex->left, FALSE, ON); /* ment og ent er gitt av virt tabellen */ - fprintf (ccode, ";((__bs%d *)__pb)->%s.adr=" + fprintf (ccode, ";((__bs%d *)__pb)->%s.adr=" "((__bs%d *)__pb)->%s.ob->pp->virtlab[%d];", rex->rd->encl->blno, rex->rd->ident, rex->rd->encl->blno, rex->rd->ident, @@ -775,18 +772,18 @@ static void genlabelswitchpar (exp_t *rex) case CLOCAL: fprintf (ccode, "((__bs%d *)__pb)->%s.adr.ment=", rex->rd->encl->blno, rex->rd->ident); - + /* Bestemmer modulnavnet */ - + genmodulemark(rex->left->rd->encl->timestamp); fprintf (ccode, ";"); - + /* Hvis det ikke er tatt av en label i systemet, s} gj|res det * her, og den legges i plev attributtet */ - + if (rex->left->rd->plev == 0) rex->left->rd->plev = newlabel (); - + fprintf (ccode, "((__bs%d *)__pb)->%s.adr.ent=%ld;" "((__bs%d *)__pb)->%s.ob=", rex->rd->encl->blno, rex->rd->ident, @@ -806,7 +803,7 @@ static void genlabelswitchpar (exp_t *rex) /* FORMELL CATEG LIK CDEFLT eller CVAR for label eller CATEG LIK * CDEFLT, CVAR eller CNAME for switch. Alle disse tilfellene skal * behandles likt. Aktuell token kan enten v{re MIDENTIFIER eller - * MIFE. Hvis det er MIFE, kalles genlabelparexp som legger ut kode + * MIFE. Hvis det er MIFE, kalles genlabelparexp som legger ut kode * slik at overf|ringen gj|res i hver gren. */ genlabelparexp (rex->left, rex, FALSE); } @@ -826,7 +823,6 @@ void gen_thunk_array (exp_t *rex) static void genarraypar (exp_t *rex) { - int i; switch (rex->rd->categ) { case CVALUE: @@ -874,7 +870,7 @@ static void genarraypar (exp_t *rex) { if (rex->left->rd->categ == CNAME) { - /* Viderf|ring av en array parameter Kopierer aktuell parameter + /* Viderf|ring av en array parameter Kopierer aktuell parameter * spesifikasjon som er en formell parameter spesifikasjon i * ytre en prosedyre. (ment, ent ,sl, ap og namekind) Setter * bp, en hjelpevariabel, til } peker p} den aktuelle @@ -931,7 +927,6 @@ void gen_thunk_procedure (exp_t *rex) static void genprocedurepar (exp_t *rex) { - int i; /* OVERF\RING AV PROSEDYRER SOM PARAMETERE */ if (rex->left->token == MIDENTIFIER) @@ -969,12 +964,12 @@ static void genprocedurepar (exp_t *rex) { /* AKTUELL PARAMETER ER EN NAME-PAR I EN YTRE PROSEDYRE * Kallerp} transcall som skriver ut koden for kallet - * __rgetproc. Den rutinen returnerer med statisk + * __rgetproc. Den rutinen returnerer med statisk * omgivelse i sl og prototypen i pp. * Disse overf|res til den formelle parameteren */ fprintf (ccode, "((__bs%d *)__pb)->%s.psl=__sl;" - "((__bs%d *)__pb)->%s.pp=__pp;", + "((__bs%d *)__pb)->%s.pp=__pp;", rex->rd->encl->blno, rex->rd->ident, rex->rd->encl->blno, rex->rd->ident); gen_conv (rex, TRUE, FALSE); @@ -1015,7 +1010,7 @@ static void genprocedurepar (exp_t *rex) { /* Aktuell par.token = MDOT */ - fprintf (ccode, "((__bs%d *)__pb)->%s.psl=", + fprintf (ccode, "((__bs%d *)__pb)->%s.psl=", rex->rd->encl->blno, rex->rd->ident); if (nonetest == ON) fprintf (ccode, "((__bp="); @@ -1053,18 +1048,18 @@ void genprocparam (exp_t *re) for (rex = re->right; rex->token != MENDSEP; rex = rex->right) { - if(rex->token == MSENTCONC) + if(rex->token == MSENTCONC) { genvalue (rex->left); fprintf (ccode, ";"); - } + } else if (rex->token == MSENDADDRESSTHUNKTOFORMALPAR) { send_to_formal_par (rex, TRUE); - } + } else if (rex->token == MSENDVALUETHUNKTOFORMALPAR) { send_to_formal_par (rex, FALSE); - } + } else if (rex->rd->kind == KSIMPLE) { /* ENKEL PARAMETER */ @@ -1076,7 +1071,7 @@ void genprocparam (exp_t *re) /* TEXT ELLER BOOLEAN PARAMETER */ } else - /* END-ENKEL PARAMETER */ + /* END-ENKEL PARAMETER */ if (rex->rd->kind == KARRAY) { if (rex->rd->type != TLABEL) /* ARRAY PARAMETER */ @@ -1086,7 +1081,7 @@ void genprocparam (exp_t *re) } else if (rex->rd->kind == KPROC) genprocedurepar (rex); - else /* FEIL */; + else /* FEIL */; }/* END FOR L\KKE */ } /* END GENPROCPARAM */ @@ -1097,12 +1092,12 @@ void genpredefproccall (exp_t *re) { int i; /* Hvis danger = TRUE s} skal returverdien legges p} stakken */ - + exp_t *rex; if (re->rd->descr->codeclass != CCEXIT) fprintf (ccode, "%s(", re->rd->descr->rtname); - + switch (re->rd->descr->codeclass) { case CCRANDOMRUTDANGER: @@ -1133,8 +1128,8 @@ void genpredefproccall (exp_t *re) break; case CCEXIT: /* TERMINATE_PROGRAM */ if (separat_comp) - fprintf - (ccode, "__goto.ent=%d,__goto.ment=__NULL;return;", + fprintf + (ccode, "__goto.ent=%d,__goto.ment=__NULL;return;", STOPLABEL); else gotolabel (STOPLABEL); @@ -1152,7 +1147,7 @@ void genpredefproccall (exp_t *re) case CCBLANKSCOPY: case CCFILEBLANKSCOPY: fprintf (ccode, "%ldL", re->value.n_of_stack_elements); - if (re->right->token != MENDSEP + if (re->right->token != MENDSEP || re->rd->descr->codeclass == CCFILEBLANKSCOPY) fprintf (ccode, ","); if (re->rd->descr->codeclass == CCBLANKSCOPY) @@ -1162,14 +1157,14 @@ void genpredefproccall (exp_t *re) /* En av fil-prosedyrene. F|rste parameter er peker til fil * klasse objektet */ gensl (re, FALSE, nonetest); - + if (re->right->token != MENDSEP) fprintf (ccode, ","); break; } /* END-SWITCH */ - + /* Overf|rer bruker parameterene */ - + for (rex = re->right; rex->token != MENDSEP; rex = rex->right) { if (rex->rd->categ == CVAR) @@ -1179,12 +1174,12 @@ void genpredefproccall (exp_t *re) fprintf (ccode, "&"); } genvalue (rex->left); - + if (rex->right->token != MENDSEP) fprintf (ccode, ","); } fprintf (ccode, ")"); - + } /* END-Genpredefproccall */ @@ -1200,13 +1195,13 @@ void genpredefproccall (exp_t *re) static decl_t *getfirstclassattribut (decl_t *rd) { decl_t *rdd; - - if (rd->plev != 0 + + if (rd->plev != 0 && (rdd = getfirstclassattribut (rd->prefqual)) != NULL) return (rdd); - + for (rdd = rd->descr->parloc; rdd != NULL && - !(rdd->categ == CLOCAL && (rdd->kind == KSIMPLE + !(rdd->categ == CLOCAL && (rdd->kind == KSIMPLE || rdd->kind == KARRAY)); rdd = rdd->next); return (rdd); @@ -1236,7 +1231,7 @@ static void par_to_cproc (exp_t *rex) } else if (rex->rd->categ == CDEFLT) { - /* By referanse, Overf|rer en peker til f|rste character. + /* By referanse, Overf|rer en peker til f|rste character. * (dette gj|res av rt-rutienen raddroffirstchar */ fprintf (ccode, "__raddroffirstchar("); genvalue (rex->left); @@ -1257,7 +1252,7 @@ static void par_to_cproc (exp_t *rex) * til } peke p} f|rste attributt i klassen * rex->left->qual eller i en av dens prefiks-klasser. * Hvis klassen ikke har noen attributter overf|res NULL */ - + rd = getfirstclassattribut (rex->left->qual); if (rd == NULL) fprintf (ccode, "__NULL"); @@ -1318,7 +1313,7 @@ static void par_to_cproc (exp_t *rex) rex->left->right->rd->descr->rtname : rex->left->rd->descr->rtname)); break; - + } } @@ -1329,19 +1324,19 @@ static void par_to_cproc (exp_t *rex) void gencproccall (exp_t *re) { exp_t *rex; - + fprintf (ccode, "%s(", re->rd->descr->rtname); - + /* Overf|rer parameterene */ - + for (rex = re->right; rex->token != MENDSEP; rex = rex->right) { par_to_cproc (rex); if (rex->right->token != MENDSEP) fprintf (ccode, ","); - + } /* END-OVERF\RING AV PARAMETERE */ - + fprintf (ccode, ")"); - + } diff --git a/src/parser.y b/src/parser.y index c20c385..58931b5 100644 --- a/src/parser.y +++ b/src/parser.y @@ -27,9 +27,12 @@ #include "name.h" #include "mellbuilder.h" #include -#include -char *xmalloc(); +#include "obstack.h" +#include "error.h" +#include "extspec.h" + void yyerror (char s[]); + #define obstack_chunk_alloc xmalloc #define obstack_chunk_free free @@ -104,7 +107,7 @@ struct _blockstack char *ident; char *tval; char stat_decl; - char kind; + char kind; } %token @@ -113,7 +116,7 @@ struct _blockstack HCHARACTER HCLASS /*HCOMMENT*/ HCONC HDELAY HDO HELSE HEND HEQ /*HEQV*/ HEXTERNAL - HFOR + HFOR HGE HGO HGOTO HGT HHIDDEN HIF /*HIMP*/ HIN HINNER HINSPECT HINTEGER HIS @@ -124,17 +127,17 @@ struct _blockstack HQUA HREACTIVATE HREAL HREF HSHORT HSTEP HSWITCH - HTEXT HTHEN HTHIS HTO + HTEXT HTHEN HTHIS HTO HUNTIL HVALUE HVAR HVIRTUAL HWHEN HWHILE - + HASSIGNVALUE HASSIGNREF /*HDOT*/ HPAREXPSEPARATOR HLABELSEPARATOR HSTATEMENTSEPARATOR HBEGPAR HENDPAR HEQR HNER HADD HSUB HMUL HDIV HINTDIV HEXP - HDOTDOTDOT + HDOTDOTDOT %token HIDENTIFIER %token HBOOLEANKONST HINTEGERKONST HCHARACTERKONST @@ -144,7 +147,7 @@ struct _blockstack %type EXT_IDENT %type DECLSTATEMENT MODULSTATEMENT MBEE_DECLSTMS MBEE_DECLSTMSU %type MODULS -%type EXPRESSION_SIMP MBEE_ARG_R_PT +%type EXPRESSION_SIMP MBEE_ARG_R_PT %type BAUND_PAIR_LIST %type FOR_LIST @@ -165,7 +168,7 @@ struct _blockstack %left HTERMOPERATOR %left UNEAR %left HFACTOROPERATOR -%left HPRIMARYOPERATOR +%left HPRIMARYOPERATOR %left HQUA @@ -177,12 +180,12 @@ struct _blockstack MAIN_MODULE : { categ=CLOCAL; mout(MBLOCK); begin_block(KBLOKK);separat_comp=FALSE;} MODULS { end_block(NULL,CCNO); mout(MENDBLOCK);} - | error HSTATEMENTSEPARATOR MBEE_DECLSTMS + | error HSTATEMENTSEPARATOR MBEE_DECLSTMS ; EXT_DECLARATION : HEXTERNAL MBEE_TYPE HPROCEDURE - { MBEENEWBLOCK(); + { MBEENEWBLOCK(); kind=KPROC;} EXT_LIST | @@ -193,7 +196,7 @@ EXT_DECLARATION : HEXTERNAL type=TNOTY; kind=KPROC; if($2==Ckind)categ=CCPROC;else - yerror (1); + yerror (1, ""); ysensitive=sensitive; sensitive=ON;} HIDENTIFIER { $$=$5; @@ -202,14 +205,14 @@ EXT_DECLARATION : HEXTERNAL { categ=CLOCAL;} | HEXTERNAL HCLASS - { MBEENEWBLOCK(); + { MBEENEWBLOCK(); kind=KCLASS;} EXT_LIST - + ; EXTERNAL_KIND_ITEM: EXT_IDENT HOBJRELOPERATOR - { if($2!=HIS)yerror (2);} + { if($2!=HIS)yerror (2, "");} MBEE_TYPE HPROCEDURE HIDENTIFIER { reg_decl($6, type, KPROC, CCPROC); @@ -219,12 +222,12 @@ EXTERNAL_KIND_ITEM: EXT_IDENT end_block($1==NULL?$0:tag($1),CCCPROC);} /* | EXT_IDENT - { if($1!=NULL)yerror (3); + { if($1!=NULL)yerror (3, ""); reg_decl($0, type, kind, categ);} MBEE_REST_EXT_LIST { end_block(NULL,CCNO);} ; -MBEE_REST_EXT_LIST: /* EMPTY +MBEE_REST_EXT_LIST: /* EMPTY | HPAREXPSEPARATOR EXT_KIND_LIST ; EXT_KIND_LIST : EXT_KIND_ITEM @@ -232,7 +235,7 @@ EXT_KIND_LIST : EXT_KIND_ITEM ; EXT_KIND_ITEM : HIDENTIFIER EXT_IDENT - { if($2!=NULL)yerror (3); + { if($2!=NULL)yerror (3, ""); reg_decl($1, type, kind, categ);}*/ ; EMPTY_BLOCK : /*EMPT*/ @@ -246,7 +249,7 @@ EXT_ITEM : HIDENTIFIER { lesinn_external_spec($1,$2, kind);} ; EXT_IDENT : /* EMPTY */ { $$=NULL;} - | HVALRELOPERATOR { if($1!=HEQ)yerror (9); + | HVALRELOPERATOR { if($1!=HEQ)yerror (9, ""); external=TRUE;} HTEXTKONST { $$=$3;external=FALSE;} ; @@ -258,9 +261,9 @@ MBEE_TYPE : NO_TYPE ; TYPE : HREF HBEGPAR HIDENTIFIER - { prefquantident=$3; + { prefquantident=$3; type=TREF;} - HENDPAR + HENDPAR | HTEXT { type=TTEXT;} | HBOOLEAN { type=TBOOL;} | HCHARACTER { type=TCHAR;} @@ -269,10 +272,10 @@ TYPE : HREF HBEGPAR | HREAL { type=TREAL;} | HLONG HREAL { type=TLONG;} ; - + /* GRAMATIKK FOR DEL AV SETNINGER */ MBEE_ELSE_PART : /*EMPT*/ -/* | HELSE +/* | HELSE HIF EXPRESSION HTHEN { mout(MELSE); @@ -292,7 +295,7 @@ FOR_LIST : FOR_LIST_ELEMENT { mout(MENDSEP); $$=KFORLIST;} ; FOR_LIST_ELEMENT: EXPRESSION - MBEE_F_L_EL_R_PT + MBEE_F_L_EL_R_PT ; MBEE_F_L_EL_R_PT: /*EMPT*/ | HWHILE @@ -310,28 +313,28 @@ GOTO : HGO CONN_STATE_R_PT : WHEN_CLAUSE_LIST | HDO { begin_block(KCON); mout(MDO); OBSBLOCK(); } - BLOCK { end_block(NULL,CCNO); + BLOCK { end_block(NULL,CCNO); MBEEENDBLOCK(); mout(MENDDO);} ; WHEN_CLAUSE_LIST: HWHEN HIDENTIFIER HDO { begin_block(KCON); mout(MIDENTIFIER); OBSBLOCK(); mout_id($2); - mout(MWHEN);} - BLOCK { end_block(NULL,CCNO); + mout(MWHEN);} + BLOCK { end_block(NULL,CCNO); MBEEENDBLOCK(); mout(MENDWHEN);} | WHEN_CLAUSE_LIST HWHEN HIDENTIFIER HDO { begin_block(KCON); mout(MIDENTIFIER); OBSBLOCK(); mout_id($3); - mout(MWHEN);} - BLOCK { end_block(NULL,CCNO); + mout(MWHEN);} + BLOCK { end_block(NULL,CCNO); MBEEENDBLOCK(); mout(MENDWHEN);} - ; + ; MBEE_OTWI_CLAUS : /*EMPT*/ | HOTHERWISE {OBSBLOCK(); mout(MOTHERWISE);} - + BLOCK {MBEEENDBLOCK();mout(MENDOTHERWISE);} ; ACTIVATOR : HACTIVATE { mout(MBOOLEANKONST); @@ -374,15 +377,15 @@ MODULSTATEMENT : HWHILE HDO { STOPOBSBLOCK(); mout(MWHILE); OBSBLOCK();} BLOCK { MBEEENDBLOCK(); mout(MENDWHILE); - $$=STATEMENT;} - | HIF + $$=STATEMENT;} + | HIF EXPRESSION HTHEN { STOPOBSBLOCK(); mout(MIF); OBSBLOCK();} BLOCK { MBEEENDBLOCK();} MBEE_ELSE_PART { mout(MENDIF); $$=STATEMENT;} - | HFOR + | HFOR HIDENTIFIER HASSIGN { STOPOBSBLOCK(); mout(MIDENTIFIER); mout_id($2);} @@ -408,13 +411,13 @@ MODULSTATEMENT : HWHILE | HINNER { STOPOBSBLOCK(); mout(MINNER); reg_inner(); $$=STATEMENT;} | HIDENTIFIER - HLABELSEPARATOR + HLABELSEPARATOR { STOPOBSBLOCK(); reg_decl($1, TLABEL, KSIMPLE, categ); mout(MLABEL); mout_id($1); mout(MENDLABEL);} DECLSTATEMENT { if($4<=DECLARATION) - { yerror (27); + { yerror (27, ""); $$=DECLARATION;} else $$=$4;} | EXPRESSION_SIMP @@ -475,7 +478,7 @@ MODULSTATEMENT : HWHILE BLOCK { end_block(NULL,CCNO); $$=DECLARATION; mout(MENDCLASS);} | HCLASS - NO_TYPE + NO_TYPE HIDENTIFIER { prefquantident=0; MBEENEWBLOCK(); mout(MCLASS); @@ -487,9 +490,9 @@ MODULSTATEMENT : HWHILE | EXT_DECLARATION { $$=EXTDECLARATION;} | /*EMPT*/{ STOPOBSBLOCK(); $$=EMPTYSTATEMENT;} ; -IMPORT_SPEC_MODULE: { MBEENEWBLOCK(); +IMPORT_SPEC_MODULE: { MBEENEWBLOCK(); kind=KCLASS; - if($0==simsetident && + if($0==simsetident && find_decl(simsetident,cblock,FALSE)==NULL) lesinn_external_spec(simsetident, SIMSETATRFILE, kind); @@ -522,7 +525,7 @@ DECLSTATEMENT : MODULSTATEMENT | TYPE HIDENTIFIER MBEE_CONSTANT - HPAREXPSEPARATOR + HPAREXPSEPARATOR { MBEENEWBLOCK(); kind=KSIMPLE; reg_decl($2, type, KSIMPLE, categ); @@ -534,7 +537,7 @@ DECLSTATEMENT : MODULSTATEMENT { MBEENEWBLOCK(); reg_decl($2, type, KSIMPLE, categ); categ=CLOCAL; $$=DECLARATION;} - | MBEE_TYPE + | MBEE_TYPE HARRAY { MBEENEWBLOCK(); kind=KARRAY;} ARR_SEGMENT_LIST { $$=DECLARATION;} @@ -547,31 +550,31 @@ DECLSTATEMENT : MODULSTATEMENT mout(MSWITCH); mout(MENDSWITCH);} ; -BLOCK : DECLSTATEMENT { if($1<=DECLARATION)yerror (29);} +BLOCK : DECLSTATEMENT { if($1<=DECLARATION)yerror (29, "");} | HBEGIN MBEE_DECLSTMS HEND | HBEGIN error HSTATEMENTSEPARATOR MBEE_DECLSTMS HEND | HBEGIN error HEND ; -MBEE_DECLSTMS : MBEE_DECLSTMSU { if($1<=DECLARATION)yerror (28); +MBEE_DECLSTMS : MBEE_DECLSTMSU { if($1<=DECLARATION)yerror (28, ""); $$=$1;} ; MBEE_DECLSTMSU : DECLSTATEMENT { $$=$1;} | MBEE_DECLSTMSU HSTATEMENTSEPARATOR DECLSTATEMENT { if($1>=STATEMENT && $3<=DECLARATION) - yerror (26); + yerror (26, ""); $$=$3;} ; MODULS : MODULSTATEMENT { if($1==DECLARATION) {separat_comp=TRUE;gettimestamp();} $$=$1;} - | MODULS HSTATEMENTSEPARATOR MODULSTATEMENT + | MODULS HSTATEMENTSEPARATOR MODULSTATEMENT { if($1>=STATEMENT && $3<=DECLARATION) - yerror (26);else - if($1>=STATEMENT - && $3!=EMPTYSTATEMENT)yerror (25); + yerror (26, "");else + if($1>=STATEMENT + && $3!=EMPTYSTATEMENT)yerror (25, ""); if(separat_comp && $3==STATEMENT) - yerror (25); + yerror (25, ""); if($3==DECLARATION && !separat_comp) {separat_comp=TRUE;gettimestamp();} $$=$3;} @@ -592,7 +595,7 @@ ARRAY_SEGMENT : ARRAY_SEGMENT_EL { mout(MENDSEP); mout(MARRAYSEP);} | ARRAY_SEGMENT_EL - HPAREXPSEPARATOR + HPAREXPSEPARATOR ARRAY_SEGMENT { mout(MARRAYSEP);} ; ARRAY_SEGMENT_EL: HIDENTIFIER { mout(MIDENTIFIER); @@ -633,7 +636,7 @@ FMAL_PAR_PART : HBEGPAR NO_TYPE MBEE_LISTV HENDPAR ; MBEE_LISTV : /*EMPT*/ - | LISTV + | LISTV ; LISTV : HIDENTIFIER { reg_decl($1, type, KNOKD, CDEFLT);} | FPP_CATEG HDOTDOTDOT { reg_decl(varargsid, TVARARGS, KNOKD, categ);} @@ -654,21 +657,21 @@ FPP_LISTV : FPP_CATEG HDOTDOTDOT { reg_decl(varargsid, TVARARGS, KNOK | FPP_SPEC HPAREXPSEPARATOR LISTV ; -FPP_SPEC : FPP_CATEG SPECIFIER HIDENTIFIER +FPP_SPEC : FPP_CATEG SPECIFIER HIDENTIFIER { reg_decl($3, type, kind, categ);} | FPP_CATEG FPP_PROC_DECL_IN_SPEC ; -FPP_CATEG : HNAME HLABELSEPARATOR +FPP_CATEG : HNAME HLABELSEPARATOR { categ=CNAME;} - | HVALUE HLABELSEPARATOR + | HVALUE HLABELSEPARATOR { categ=CVALUE;} - | HVAR HLABELSEPARATOR + | HVAR HLABELSEPARATOR { categ=CVAR;} | /*EMPT*/ { categ=CDEFLT;} ; FPP_PROC_DECL_IN_SPEC: MBEE_TYPE HPROCEDURE HIDENTIFIER - { $$=categ; + { $$=categ; reg_decl($3, type, KPROC, categ); begin_block(KPROC);} FPP_HEADING @@ -718,14 +721,14 @@ SPEC_PART : ONE_SPEC ; ONE_SPEC : SPECIFIER IDENTIFIER_LIST HSTATEMENTSEPARATOR | NO_TYPE HPROCEDURE HIDENTIFIER HOBJRELOPERATOR - { if($4!=HIS) yerror (8);} + { if($4!=HIS) yerror (8, "");} PROC_DECL_IN_SPEC HSTATEMENTSEPARATOR | FPP_PROC_DECL_IN_SPEC HSTATEMENTSEPARATOR | MBEE_TYPE HPROCEDURE HIDENTIFIER HSTATEMENTSEPARATOR - { yerror (45);} + { yerror (45, "");} | MBEE_TYPE HPROCEDURE HIDENTIFIER HPAREXPSEPARATOR IDENTIFIER_LIST HSTATEMENTSEPARATOR - { yerror (45);} + { yerror (45, "");} ; SPECIFIER : TYPE { kind=KSIMPLE;} | MBEE_TYPE @@ -737,12 +740,12 @@ SPECIFIER : TYPE { kind=KSIMPLE;} ; PROC_DECL_IN_SPEC: MBEE_TYPE HPROCEDURE HIDENTIFIER - { $$=categ; + { $$=categ; reg_decl($3, type, KPROC, categ); begin_block(KPROC);} HEADING { categ=$4; /* M} settes tilbake*/} - MBEE_BEGIN_END + MBEE_BEGIN_END { end_block(NULL,CCNO);} ; MBEE_BEGIN_END : /* EMPTY */ @@ -774,22 +777,22 @@ IDENTIFIER_LIST : HIDENTIFIER { reg_decl($1, type, kind, categ);} | IDENTIFIER_LIST HPAREXPSEPARATOR HIDENTIFIER { reg_decl($3, type, kind, categ);} ; -IDENTIFIER_LISTC: HIDENTIFIER +IDENTIFIER_LISTC: HIDENTIFIER MBEE_CONSTANT { reg_decl($1, type, kind, categ); categ=CLOCAL;} | IDENTIFIER_LISTC HPAREXPSEPARATOR - HIDENTIFIER + HIDENTIFIER MBEE_CONSTANT { reg_decl($3, type, kind, categ); categ=CLOCAL;} ; MBEE_CONSTANT : /* EMPTY */ | HVALRELOPERATOR { MBEENEWBLOCK(); - if($1!=HEQ) yerror (8); - if(type==TREF)yerror (7); + if($1!=HEQ) yerror (8, ""); + if(type==TREF)yerror (7, ""); categ=CCONSTU; mout(MIDENTIFIER); - mout_id($0);} + mout_id($0);} EXPRESSION { mout(MASSIGN); mout(MCONST);} ; @@ -862,7 +865,7 @@ EXPRESSION_SIMP : EXPRESSION_SIMP else mout(MSUB);$$=NULL;} | EXPRESSION_SIMP HFACTOROPERATOR - EXPRESSION_SIMP + EXPRESSION_SIMP { if($2==HMUL) mout(MMUL); else if($2==HDIV) mout(MDIV); else mout(MINTDIV);$$=NULL;} @@ -925,9 +928,9 @@ void yyerror (char s[]) { yaccerror=TRUE; #if 0 - if(s[0]=='s')yerror (13);else - if(s[0]=='y')yerror (14);else - yerror (16); + if(s[0]=='s')yerror (13, "");else + if(s[0]=='y')yerror (14, "");else + yerror (16, ""); #else yerror (21,s); #endif @@ -936,7 +939,7 @@ void yyerror (char s[]) /****************************************************************************** YLEX */ - + #ifdef yylex #undef yylex int ylex(void) diff --git a/src/passes.c b/src/passes.c index a0bf5f2..a612bcc 100644 --- a/src/passes.c +++ b/src/passes.c @@ -28,6 +28,8 @@ #include "gen.h" #include "trans.h" #include "passes.h" +#include "extspec.h" +#include "salloc.h" sent_t *main_sent; diff --git a/src/salloc.c b/src/salloc.c index 9be004c..0f7141d 100644 --- a/src/salloc.c +++ b/src/salloc.c @@ -19,7 +19,7 @@ #include "config.h" #include "cimcomp.h" #include -#include +#include "obstack.h" #if STDC_HEADERS #include diff --git a/src/sentbuilder.c b/src/sentbuilder.c index cf03e75..e2e006d 100644 --- a/src/sentbuilder.c +++ b/src/sentbuilder.c @@ -17,12 +17,13 @@ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #include -#include +#include "obstack.h" #include "gen.h" #include "salloc.h" #include "passes.h" #include "config.h" +#include "error.h" #if STDC_HEADERS || HAVE_STRING_H #include @@ -34,8 +35,6 @@ #include #endif -char *xmalloc(); - #define obstack_chunk_alloc xmalloc #define obstack_chunk_free free @@ -46,7 +45,7 @@ sent_t module; /****************************************************************************** SPUSH */ -static spush(sent_t *re) +static void spush(sent_t *re) { obstack_grow (&os_stack, &re, sizeof (void *)); } @@ -115,7 +114,7 @@ static sent_t *create_sent(int token, exp_t *exp) if (parent->first == NULL) { parent->first= parent->last= new; - } + } else { parent->last->next= new; @@ -135,7 +134,7 @@ void insert_after_sent (sent_t *parent, sent_t *after, sent_t *new) if (parent->first == NULL) { parent->first= parent->last= new; - } + } else { parent->first->prev= new; @@ -149,7 +148,7 @@ void insert_after_sent (sent_t *parent, sent_t *after, sent_t *new) { new->prev= after; after->next= parent->last= new; - } + } else { after->next->prev= new; @@ -303,7 +302,7 @@ sent_t *sbuild(void) p= mpointer; ebuild (); if (p == mpointer) - serror (71, token); + serror (71, "", token); continue; } } @@ -324,7 +323,7 @@ void insert_thunk (exp_t *rex, int token) new->exp= rex; new->cblock= cblock; rex->value.thunk.label= newlabel (); - + rex->value.thunk.inthunk= inthunk+1; insert_before_sent (main_sent, NULL, new); } diff --git a/src/sentchecker.c b/src/sentchecker.c index 93385a5..a6a5574 100644 --- a/src/sentchecker.c +++ b/src/sentchecker.c @@ -21,6 +21,8 @@ #include "builder.h" #include "checker.h" #include "trans.h" +#include "error.h" +#include "gen.h" /****************************************************************************** SENTCHECK */ @@ -41,13 +43,13 @@ void sent_check (sent_t *parent_sent, char res_labels) main_exp_check (sent->exp); { - /* TBD Har ikke implementert fremoverreferanser for konstant deklarasjoner */ + /* TBD Har ikke implementert fremoverreferanser for konstant deklarasjoner */ int token = sent->exp->right->token; - if (token != MREALKONST & token != MTEXTKONST + if (token != MREALKONST & token != MTEXTKONST & token != MCHARACTERKONST & token != MINTEGERKONST & token != MBOOLEANKONST & sent->exp->right->type != TERROR) - serror (6); + serror (6, "", 0); } sent->exp->left->rd->value = sent->exp->right->value; sent->exp->left->rd->categ = CCONST; @@ -62,14 +64,14 @@ void sent_check (sent_t *parent_sent, char res_labels) main_exp_check (sent->exp); in_block (); sent->cblock=cblock; - if (res_labels) + if (res_labels) { sent->cblock->ent = newlabel (); newlabel (); } if (sent->exp->type != TERROR && (sent->exp->token != MARGUMENT || sent->exp->rd->kind != KCLASS)) - serror (3); + serror (3, "", 0); sent_check (sent, res_labels); out_block (); break; @@ -83,7 +85,7 @@ void sent_check (sent_t *parent_sent, char res_labels) case MCLASS: in_block (); sent->cblock=cblock; - if (res_labels) + if (res_labels) { sent->cblock->ent = newlabel (); newlabel (); /* Label etter dekl. del */ @@ -95,7 +97,7 @@ void sent_check (sent_t *parent_sent, char res_labels) case MINSPECT: main_exp_check (sent->exp); if (sent->exp->type != TREF && sent->exp->type != TERROR) - serror (73, token); + serror (73, "", token); in_block (); sent->cblock=cblock; reginsp (sent->cblock, sent->exp->qual); @@ -115,30 +117,30 @@ void sent_check (sent_t *parent_sent, char res_labels) sent->cblock=cblock; { char not_removed=TRUE; - /* Sjekker om rd er samme klasse eller en subklasse til * klassen + /* Sjekker om rd er samme klasse eller en subklasse til * klassen * som inspiseres,eller omvendt */ if (!subclass (sent->exp->rd, parent_sent->cblock->virt) && !subclass (parent_sent->cblock->virt, sent->exp->rd)) { - serror (83, sent->exp->rd->ident); + serror (83, sent->exp->rd->ident, 0); /* Trenger ikke å legge ut kode for denne WHEN grenen */ remove_block (sent->cblock); - remove_sent (parent_sent, sent); + remove_sent (parent_sent, sent); not_removed= FALSE; } else if (subclass (parent_sent->cblock->virt, sent->exp->rd) && sent->prev == NULL) { - serror (82, sent->exp->rd->ident); + serror (82, sent->exp->rd->ident, 0); } else { - for (when_sent=parent_sent->first; when_sent != sent; + for (when_sent=parent_sent->first; when_sent != sent; when_sent= when_sent->next) { if (subclass (sent->exp->rd, when_sent->exp->rd)) { - serror (83, sent->exp->rd->ident); + serror (83, sent->exp->rd->ident, 0); /* Ingen kode for denne WHEN grenen */ remove_block (sent->cblock); remove_sent (parent_sent, sent); @@ -161,7 +163,7 @@ void sent_check (sent_t *parent_sent, char res_labels) in_block (); sent->cblock=cblock; main_exp_check (sent->exp); - if (sent->first == NULL) serror (81); + if (sent->first == NULL) serror (81, "", 0); sent_check (sent, res_labels); out_block (); break; @@ -169,8 +171,8 @@ void sent_check (sent_t *parent_sent, char res_labels) sent->cblock=cblock; main_exp_check (sent->exp); if (sent->exp->type != TBOOL && sent->exp->type != TERROR) - serror (77, token); - if (sent->first == NULL) serror (81); + serror (77, "", token); + if (sent->first == NULL) serror (81, "", 0); sent_check (sent, res_labels); break; case MIF: @@ -178,7 +180,7 @@ void sent_check (sent_t *parent_sent, char res_labels) main_exp_check (sent->exp); if (sent->exp->type != TBOOL) if (sent->exp->type != TERROR) - serror (77, token); + serror (77, "", token); sent_check (sent, res_labels); break; case MELSE: @@ -193,7 +195,7 @@ void sent_check (sent_t *parent_sent, char res_labels) sent->cblock=cblock; main_exp_check (sent->exp); if (sent->exp->type != TLABEL && sent->exp->type != TERROR) - serror (108, token); + serror (108, "", token); break; case MINNER: sent->cblock=cblock; @@ -210,7 +212,7 @@ void sent_check (sent_t *parent_sent, char res_labels) sent->exp->token != MASSIGNR && sent->exp->token != MVALASSIGNT && (sent->exp->token != MDOT || sent->exp->right->token != MPROCARG) && sent->exp->type != TERROR) - serror (115); + serror (115, "", 0); break; case MENDARRAY: sent->cblock=cblock; @@ -220,7 +222,8 @@ void sent_check (sent_t *parent_sent, char res_labels) sent->cblock=cblock; main_exp_check (sent->exp); break; + default: + break; } } } - diff --git a/src/sentgen.c b/src/sentgen.c index 422a6f0..ed60905 100644 --- a/src/sentgen.c +++ b/src/sentgen.c @@ -22,6 +22,8 @@ #include "error.h" #include "passes.h" #include "dump.h" +#include "checker.h" +#include "trans.h" char not_reached; @@ -61,7 +63,7 @@ static void gen_init (void) { fprintf (ccode, "int __start_data_segment=1;\n"); } - fprintf (ccode, "#include \"%s/cim.h\"\n", + fprintf (ccode, "#include \"%s/cim.h\"\n", includedir); #endif } @@ -78,7 +80,7 @@ static void module_gen (sent_t *sent) { fprintf (ccode, "int __start_data_segment=1;\n"); } - fprintf (ccode, "#include \"%s/cim.h\"\n", + fprintf (ccode, "#include \"%s/cim.h\"\n", includedir); #ifdef DEBUG @@ -189,7 +191,7 @@ static void block_gen (sent_t *sent) gotollabel (sent->cblock->ent = newllabel ()); sent_list_gen (sent, 0); - + if (not_reached == FALSE) fprintf (ccode, "__rbe();"); } @@ -221,7 +223,7 @@ static void prblock_gen (sent_t *sent) genmodulemark(NULL); fprintf (ccode, ");"); gotoswitch (); - + sent_list_gen (sent, sent->cblock->ent+1); if (not_reached == FALSE) fprintf (ccode, "__rendclass(%ld);", sent->cblock->quant.plev); @@ -247,13 +249,13 @@ static void procedure_gen (sent_t *sent) else if (sent->cblock->quant.type == TTEXT) fprintf (ccode, "__et=((__bs%d *)__lb)->et;", sent->cblock->blno); else if (sent->cblock->quant.type == TREAL) - fprintf (ccode, "__ev.f=((__bs%d *)__lb)->ef;", + fprintf (ccode, "__ev.f=((__bs%d *)__lb)->ef;", sent->cblock->blno); else if (sent->cblock->quant.type == TINTG) - fprintf (ccode, "__ev.i=((__bs%d *)__lb)->ev;", + fprintf (ccode, "__ev.i=((__bs%d *)__lb)->ev;", sent->cblock->blno); else - fprintf (ccode, "__ev.c=((__bs%d *)__lb)->ec;", + fprintf (ccode, "__ev.c=((__bs%d *)__lb)->ec;", sent->cblock->blno); fprintf (ccode, "__rep();"); } @@ -326,9 +328,9 @@ static void inspect_gen (sent_t *sent) typellabel (labnull); cblock= sent->last->cblock; cblev= cblock->blev; - + sent_list_gen (sent->last, 0); - + if (not_reached == FALSE) genline (); } @@ -361,7 +363,7 @@ static void when_gen (sent_t *sent, int labexit) cblock= sent->cblock; cblev= cblock->blev; - fprintf (ccode, "if(__pp->plev < %ld || __pp->pref[%ld]!= ", + fprintf (ccode, "if(__pp->plev < %ld || __pp->pref[%ld]!= ", sent->exp->rd->plev, sent->exp->rd->plev); gen_adr_prot (ccode, sent->exp->rd); @@ -421,9 +423,9 @@ static int forelemgen (exp_t *re, exp_t *rex, fprintf (ccode, "= %d;", ++*listnrp); gotollabel (labdo); fprintf (ccode, "}"); - + gotollabel ( labnext= newllabel ()); - + fprintf (ccode, " case %d:", *listnrp); } genvalue (rey->right->right); fprintf (ccode, ";"); @@ -492,17 +494,17 @@ static int forgen (exp_t *re, int labcontinue, int labdo, int labexit) gotollabel (labnext= newllabel ()); typellabel (labcontinue); - + fprintf (ccode, "switch ("); gen_for_val(cblock->fornest); - fprintf (ccode, " ){"); + fprintf (ccode, " ){"); typellabel (labnext); for (rex = re->right; rex->token != MENDSEP; rex = rex->right) { - notlastdefault= - forelemgen (re, rex, labcontinue, labdo, labexit, FALSE, + notlastdefault= + forelemgen (re, rex, labcontinue, labdo, labexit, FALSE, notlastdefault, &listnr); } gotollabel (labexit); @@ -525,7 +527,7 @@ static void fordo_gen (sent_t *sent) cblev= cblock->blev; labcontinue= newllabel (); - labdo= newllabel (); + labdo= newllabel (); labexit= newllabel (); iterate= forgen (sent->exp, labcontinue, labdo, labexit); @@ -593,13 +595,13 @@ static void if_gen (sent_t *sent) if (sent->last->token == MTHEN) { gotollabel (labexit); - sent_list_gen (sent->first, 0); + sent_list_gen (sent->first, 0); } else { gotollabel (labelse= newllabel ()); - sent_list_gen (sent->first, 0); + sent_list_gen (sent->first, 0); if (not_reached == FALSE) { @@ -608,7 +610,7 @@ static void if_gen (sent_t *sent) } typellabel (labelse); - sent_list_gen (sent->last, 0); + sent_list_gen (sent->last, 0); } if (not_reached == FALSE) genline (); @@ -669,7 +671,7 @@ static void procedure_entry_gen (sent_t *sent) { if (rd->kind == KSIMPLE && rd->type == TREF && rd->categ != CNAME) { - fprintf (ccode, "(((__bp=((__bs%d *)__lb)->%s" + fprintf (ccode, "if((__bp=((__bs%d *)__lb)->%s" ,rd->encl->blno,rd->ident); fprintf (ccode, ")!=__NULL && ("); if (rd->prefqual->plev >= DEF_PLEV_TAB_SIZE) @@ -678,11 +680,11 @@ static void procedure_entry_gen (sent_t *sent) fprintf (ccode, "__bp->pp->pref[%ld]!= ", rd->prefqual->plev); gen_adr_prot (ccode, rd->prefqual); - fprintf (ccode, "))?(__dhp)__rerror(__errqual):__bp);"); + fprintf (ccode, "))__rerror(__errqual);"); } rd = rd->next; } - + } /****************************************************************************** @@ -752,10 +754,10 @@ static void endarray_gen (sent_t *sent) genvalue (sent->iexp); fprintf (ccode, ";"); for (re1 = re->left; re1->token != MENDSEP; re1 = re1->right) { - fprintf (ccode, " /* Array %s */", + fprintf (ccode, " /* Array %s */", re1->left->value.ident); - /* Legger inn kode som sjekker at ovre grense > nedre grense Hvis dette - * er en deklarasjon av flere array, f.eks integer array a,b(1:10), s} + /* Legger inn kode som sjekker at ovre grense > nedre grense Hvis dette + * er en deklarasjon av flere array, f.eks integer array a,b(1:10), s} * er det ikke n|dvendig } foreta sjekkingen av grensene mer enn en * gang. */ if (re1->up == re) @@ -763,11 +765,11 @@ static void endarray_gen (sent_t *sent) for (re2 = re->right; re2->token != MENDSEP; re2 = re2->right) { if ((MINTEGERKONST == ( - re2->left->left->token == MUSUBI + re2->left->left->token == MUSUBI ? re2->left->left->left->token : re2->left->left->token)) && (MINTEGERKONST == ( - re2->left->right->token == MUSUBI + re2->left->right->token == MUSUBI ? re2->left->right->left->token : re2->left->right->token))) { /* KONSTANTER (kan ogs} v{re med minus foran @@ -935,6 +937,8 @@ static void thunk_gen (sent_t *sent) case MTHUNKPROCEDURE: gen_thunk_procedure (sent->exp); break; + default: + break; } gotoswitch (); } @@ -1022,5 +1026,7 @@ void sent_gen (sent_t *sent, int lab) case MTHUNKPROCEDURE: thunk_gen (sent); break; + default: + break; } } diff --git a/src/senttrans.c b/src/senttrans.c index 8924548..26d5a5d 100644 --- a/src/senttrans.c +++ b/src/senttrans.c @@ -104,7 +104,7 @@ static void sent_list_trans (sent_t *parent_sent) MODULETRANS */ static void module_trans (sent_t *sent) -{ +{ if (! separat_comp) insert_before_sent (sent, NULL, new_sent (MGOTOSTOP)); sent_list_trans (sent); @@ -157,7 +157,7 @@ static void class_trans (sent_t *sent) static void inspect_trans (sent_t *sent) { cblock= sent->cblock; - sent->iexp= transcall (sent->exp->up, sent->exp, 1, 1, 1); + sent->iexp= transcall (sent->exp->up, sent->exp, 1, 1, 1); sent_list_trans (sent); } @@ -208,11 +208,11 @@ static void forelem_trans (exp_t *re, exp_t *rex) konst_step = rey->right->left->token == MINTEGERKONST; restep= transcall (rey->right, rey->right->left, 1, 1, 1); - restep= concexp (restep, transcall (rey->right, rey->right->right, + restep= concexp (restep, transcall (rey->right, rey->right->right, 1, 1, 1)); reinit= transcall (rey, rey->left, 1, 1, 1); - reinit= concexp (reinit, red= makeexp(MASSIGND,copytree (re->left), + reinit= concexp (reinit, red= makeexp(MASSIGND,copytree (re->left), rey->left)); red->type= red->right->type; reinit= concexp (reinit, copytree (restep)); @@ -223,10 +223,10 @@ static void forelem_trans (exp_t *re, exp_t *rex) if (!konst_step) retest= makeexp (MMUL, (notnegativ?rey->right->left: rey->right->left->left), retest); - retest= makeexp (notnegativ?MLE:MGE, retest, + retest= makeexp (notnegativ?MLE:MGE, retest, makeexp (MINTEGERKONST, NULL, NULL)); - restep= concexp (restep, red= makeexp(MASSIGNADD,copytree (re->left), + restep= concexp (restep, red= makeexp(MASSIGNADD,copytree (re->left), rey->right->left)); red->type= red->right->type; @@ -240,7 +240,7 @@ static void forelem_trans (exp_t *re, exp_t *rex) case MFORWHILE: restep= transcall (rey, rey->left, 1, 1, 1); restep= concexp (restep, makeexp (re->left->type==TTEXT?re->token==MFOR? - MVALASSIGNT:MREFASSIGNT:MASSIGND, + MVALASSIGNT:MREFASSIGNT:MASSIGND, copytree (re->left),rey->left)); restep= concexp (restep, transcall (rey, rey->right, 1, 1, 1)); rey->left= restep; @@ -248,7 +248,7 @@ static void forelem_trans (exp_t *re, exp_t *rex) default: restep= transcall (rex, rey, 1, 1, 1); restep= concexp (restep, makeexp (re->left->type==TTEXT?re->token==MFOR? - MVALASSIGNT:MREFASSIGNT:MASSIGND, + MVALASSIGNT:MREFASSIGNT:MASSIGND, copytree (re->left),rey)); rex->left= restep; break; @@ -274,7 +274,7 @@ static void fordo_trans (sent_t *sent) static void while_trans (sent_t *sent) { - sent->iexp= transcall (sent->exp->up, sent->exp, 1, 1, 1); + sent->iexp= transcall (sent->exp->up, sent->exp, 1, 1, 1); sent_list_trans (sent); } @@ -455,5 +455,7 @@ void sent_trans (sent_t *sent) case MTHUNKPROCEDURE: thunk_trans (sent); break; + default: + break; } } diff --git a/src/strgen.c b/src/strgen.c index 724045d..cb835cc 100644 --- a/src/strgen.c +++ b/src/strgen.c @@ -24,13 +24,14 @@ #include "extspec.h" #include "mapline.h" #include "name.h" +#include "gen.h" -static short plevnull; /* Hvis en blokks prefiksniv} er 0 s} er +static short plevnull; /* Hvis en blokks prefiksniv} er 0 s} er * plevnull=TRUE.Brukes for } initsialisere - * offset adressene til pekerne.M} vite om - * structen til denne blokken inneholder - * deklarasjonen struct dhp h.Ellers s} m} - * .s f}lges plev ganger for } komme til h.pp + * offset adressene til pekerne.M} vite om + * structen til denne blokken inneholder + * deklarasjonen struct dhp h.Ellers s} m} + * .s f}lges plev ganger for } komme til h.pp */ @@ -238,20 +239,20 @@ static void blockmainstructure (block_t *rb, char output_refs) if (rb->quant.kind == KPROC && rb->quant.type != TNOTY) { if (rb->quant.type == TTEXT) - write_refs (rb, NULL, "et.obj", output_refs); + write_refs (rb, NULL, "et.obj", output_refs); else if (rb->quant.type == TREF) - write_refs (rb, NULL, "er", output_refs); + write_refs (rb, NULL, "er", output_refs); } - + { int mincon= 1; - if ((rb->quant.kind == KCLASS || rb->quant.kind == KPRBLK) && + if ((rb->quant.kind == KCLASS || rb->quant.kind == KPRBLK) && rb->quant.plev > 0) { if (rb->connest < rb->quant.prefqual->descr->connest) rb->connest= rb->quant.prefqual->descr->connest; mincon= rb->quant.prefqual->descr->connest+1; - } + } for (i = mincon; i <= rb->connest; i++) { char s[10]; @@ -263,11 +264,11 @@ static void blockmainstructure (block_t *rb, char output_refs) #if ACSTACK_IN_OBJ { int minref= 1, mintxt= 1; - if ((rb->quant.kind == KCLASS || rb->quant.kind == KPRBLK) && + if ((rb->quant.kind == KCLASS || rb->quant.kind == KPRBLK) && rb->quant.plev > 0) { minref= rb->quant.prefqual->descr->maxusedref+1; - mintxt= rb->quant.prefqual->descr->maxusedtxt+1; + mintxt= rb->quant.prefqual->descr->maxusedtxt+1; } for (i= minref; i <= rb->maxusedref; i++) @@ -276,7 +277,7 @@ static void blockmainstructure (block_t *rb, char output_refs) sprintf (s, "__r%d", i); write_refs (rb, NULL, s, output_refs); } - + for (i= mintxt; i <= rb->maxusedtxt; i++) { char s[20]; @@ -294,7 +295,7 @@ static void specifier_structure (block_t *rb); /****************************************************************************** BLOCKSTRUCTURE */ -static blockstructure (block_t *rb) +static void blockstructure (block_t *rb) { int i; decl_t *rd; @@ -341,12 +342,12 @@ static blockstructure (block_t *rb) } else if (rb->codeclass != CCNO) break; } - - if ((rb->quant.kind == KCLASS || rb->quant.kind == KPROC) + + if ((rb->quant.kind == KCLASS || rb->quant.kind == KPROC) && rb->timestamp != 0 && rb->quant.encl->timestamp != rb->timestamp) { - + if (&rb->quant == classtext || &rb->quant == commonprefiks) break; /* Definerer den eksterne modulen som extern på .h filen */ fprintf (ccode, "extern void __m_%s();\n", @@ -354,29 +355,29 @@ static blockstructure (block_t *rb) } - if ((rb->quant.kind == KCLASS || rb->quant.kind == KPRBLK) + if ((rb->quant.kind == KCLASS || rb->quant.kind == KPRBLK) && rb->timestamp == 0) { fprintf (ccode, "extern __ptyp __p%d%s;\n", rb->blno, timestamp); for (rd = rb->virt; rd != NULL; rd = rd->next) - if (rd->kind == KPROC && rd->match!= NULL) + if (rd->kind == KPROC && rd->match!= NULL) blockstructure (rd->match->descr); } - - if ((rb->quant.kind == KCLASS && rb->quant.plev > 0) + + if ((rb->quant.kind == KCLASS && rb->quant.plev > 0) || (rb->quant.kind == KPRBLK)) { /* Går gjennom prefikskjeden */ blockstructure (rb->quant.prefqual->descr); plevnull = FALSE; - } + } else plevnull= TRUE; fprintf (ccode, "typedef struct /* %s */\n {\n" ,rb->quant.ident == NULL ? "" : rb->quant.ident); - if ((rb->quant.kind == KCLASS && rb->quant.plev > 0) + if ((rb->quant.kind == KCLASS && rb->quant.plev > 0) || (rb->quant.kind == KPRBLK)) fprintf (ccode, " __bs%d s;\n", rb->quant.prefqual->descr->blno); @@ -384,9 +385,9 @@ static blockstructure (block_t *rb) fprintf (ccode, " __dh h;\n"); naref = 0; - /* NB !!!. Deklarasjonene må skrives ut før evt. hjelpe variable + /* NB !!!. Deklarasjonene må skrives ut før evt. hjelpe variable * (for,inspect) og før returverdivariabelen. Slipper da å skrive - * ut disse i structene for virtuelle og formelle prosedyre + * ut disse i structene for virtuelle og formelle prosedyre * spesifikasjoner. Gjelder prosedyrer. */ blockmainstructure (rb, FALSE); @@ -406,7 +407,7 @@ static blockstructure (block_t *rb) { int minfor= 1, mincon=1; - if ((rb->quant.kind == KCLASS || rb->quant.kind == KPRBLK) && + if ((rb->quant.kind == KCLASS || rb->quant.kind == KPRBLK) && rb->quant.plev > 0) { if (rb->fornest < rb->quant.prefqual->descr->fornest) @@ -415,7 +416,7 @@ static blockstructure (block_t *rb) rb->connest= rb->quant.prefqual->descr->connest; minfor= rb->quant.prefqual->descr->fornest+1; mincon= rb->quant.prefqual->descr->connest+1; - } + } for (i = minfor; i <= rb->fornest; i++) fprintf (ccode, " short f%d;\n", i); for (i = mincon; i <= rb->connest; i++) @@ -425,7 +426,7 @@ static blockstructure (block_t *rb) #if ACSTACK_IN_OBJ { int minval= 1, minref= 1, mintxt= 1; - if ((rb->quant.kind == KCLASS || rb->quant.kind == KPRBLK) && + if ((rb->quant.kind == KCLASS || rb->quant.kind == KPRBLK) && rb->quant.plev > 0) { if (rb->maxusedref < rb->quant.prefqual->descr->maxusedref) @@ -435,14 +436,14 @@ static blockstructure (block_t *rb) if (rb->maxusedval < rb->quant.prefqual->descr->maxusedval) rb->maxusedval= rb->quant.prefqual->descr->maxusedval; minref= rb->quant.prefqual->descr->maxusedref+1; - mintxt= rb->quant.prefqual->descr->maxusedtxt+1; - minval= rb->quant.prefqual->descr->maxusedval+1; - } - for (i= minref; i<=rb->maxusedref; i++) + mintxt= rb->quant.prefqual->descr->maxusedtxt+1; + minval= rb->quant.prefqual->descr->maxusedval+1; + } + for (i= minref; i<=rb->maxusedref; i++) fprintf (ccode, " __dhp __r%d;\n", i); - for (i= mintxt; i<=rb->maxusedtxt; i++) + for (i= mintxt; i<=rb->maxusedtxt; i++) fprintf (ccode, " __txt __t%d;\n", i); - for (i= minval; i<=rb->maxusedval; i++) + for (i= minval; i<=rb->maxusedval; i++) fprintf (ccode, " __valuetype __v%d;\n", i); } @@ -453,8 +454,8 @@ static blockstructure (block_t *rb) if (rb->stat) { if (rb->timestamp) fprintf (ccode, "extern "); - fprintf - (ccode, "__bs%d __blokk%d%s;\n", rb->blno, rb->blno, + fprintf + (ccode, "__bs%d __blokk%d%s;\n", rb->blno, rb->blno, rb->timestamp?rb->timestamp:timestamp); } @@ -467,7 +468,7 @@ static blockstructure (block_t *rb) { if (naref) { - fprintf (ccode, "short __rl%d%s[%d]={", + fprintf (ccode, "short __rl%d%s[%d]={", rb->blno, timestamp, naref); blockmainstructure (rb, TRUE); @@ -480,7 +481,7 @@ static blockstructure (block_t *rb) { if (rb->navirt) { - fprintf (ccode, "__pty __vl%d%s[%d]={", + fprintf (ccode, "__pty __vl%d%s[%d]={", rb->blno, timestamp, rb->navirt); for (rd = rb->virt; rd != NULL; rd = rd->next) { @@ -515,7 +516,7 @@ static blockstructure (block_t *rb) fprintf (ccode, "%ld,__m_%s,", rd->match->plev, rd->match->encl->timestamp); - + else if (separat_comp) fprintf (ccode, "%ld,__m_%s,", rd->match->plev, timestamp); @@ -531,7 +532,7 @@ static blockstructure (block_t *rb) } } - fprintf (ccode, "extern __ptyp __p%d%s;__pty __pl%d%s[%ld]={", + fprintf (ccode, "extern __ptyp __p%d%s;__pty __pl%d%s[%ld]={", rb->blno, timestamp, rb->blno, timestamp, (rb->quant.prefqual==NULL)?1: @@ -546,7 +547,7 @@ static blockstructure (block_t *rb) rb->blev, rb->blno, rb->ent); - if (separat_comp && (rb->quant.kind == KCLASS + if (separat_comp && (rb->quant.kind == KCLASS || rb->quant.kind == KPROC || rb->quant.kind == KPRBLK)) fprintf (ccode, "__m_%s", timestamp); @@ -554,9 +555,9 @@ static blockstructure (block_t *rb) fprintf (ccode, "0"); fprintf (ccode, ",%d,%d,%d,%d", - rb->fornest, + rb->fornest, rb->connest, - naref, + naref, rb->navirt); if (naref) @@ -571,14 +572,14 @@ static blockstructure (block_t *rb) fprintf (ccode, ",__pl%d%s", rb->blno, timestamp); - if ((rb->quant.kind == KCLASS || rb->quant.kind == KPRBLK) + if ((rb->quant.kind == KCLASS || rb->quant.kind == KPRBLK) && rb->navirtlab) fprintf (ccode, ",__labvl%d%s};\n", rb->blno, timestamp); else fprintf (ccode, ",__NULL};\n"); } - rb->structure_written = TRUE; /* merker av at det er lagt ut type for denne + rb->structure_written = TRUE; /* merker av at det er lagt ut type for denne * blokken */ /* Sjekker om det må skrives ut structer for virtuelle- og formelle @@ -611,15 +612,15 @@ static void specifier_proc_structure (decl_t *rd) { if (rd->descr->parloc != NULL) { - fprintf + fprintf (ccode, "typedef struct /* %s SPEC*/\n {\n", rd->ident); fprintf (ccode, " __dh h;\n"); - + /* Skriver alle parameterne */ for (rdi = rd->descr->parloc; rdi != NULL; rdi = rdi->next) declstructure (rdi, FALSE); fprintf (ccode, " } __bs%d;\n", rd->descr->blno); - + /* Flere nivåer ? */ specifier_structure (rd->descr); } @@ -630,7 +631,7 @@ static void specifier_proc_structure (decl_t *rd) static void specifier_structure (block_t *rb) { /* Kaller på param_structure som skriver ut - * structer for evt. parameterspesifikasjoner + * structer for evt. parameterspesifikasjoner * til virtuelle og formelle prosedyre- * spesifikasjoner. Altså kun for de som * inneholder parametere. */ @@ -639,9 +640,9 @@ static void specifier_structure (block_t *rb) *rdi; /* Ser forst etter formell prosedyre spesifikasjoner */ - for (rd = rb->parloc; rd != NULL && (rd->categ == CDEFLT + for (rd = rb->parloc; rd != NULL && (rd->categ == CDEFLT || rd->categ == CNAME && - rd->categ == CVAR + rd->categ == CVAR && rd->categ == CVALUE); rd = rd->next) specifier_proc_structure (rd); @@ -711,9 +712,9 @@ static void do_for_each_stat_pointer (block_t *block) case KBLOKK: case KPRBLK: if (block->stat) - fprintf (ccode, "if(((__dhp)&__blokk%d%s)->gl!=__NULL|force)" + fprintf (ccode, "if((((__dhp)&__blokk%d%s)->gl!=__NULL)|force)" "__do_for_each_pointer((__dhp)&__blokk%d%s,doit,doit_notest);\n" - ,block->blno, timestamp, block->blno, + ,block->blno, timestamp, block->blno, block->timestamp?block->timestamp:timestamp); } for (rd= block->parloc; rd!= NULL; rd= rd->next) @@ -746,7 +747,7 @@ static void update_gl_null (block_t *block) case KBLOKK: case KPRBLK: if (block->stat) - fprintf (ccode, "((__dhp)&__blokk%d%s)->gl=(__dhp)0;\n",block->blno, + fprintf (ccode, "((__dhp)&__blokk%d%s)->gl=(__dhp)0;\n",block->blno, block->timestamp?block->timestamp:timestamp); } for (rd= block->parloc; rd!= NULL; rd= rd->next) @@ -779,11 +780,11 @@ static void update_gl_obj (block_t *block) case KBLOKK: case KPRBLK: if (block->stat) - fprintf - (ccode, + fprintf + (ccode, "if(((__dhp)&__blokk%d%s)->gl)((__dhp)&__blokk%d%s)->gl=(__dhp)&__blokk%d%s;\n" ,block->blno, block->timestamp?block->timestamp:timestamp - ,block->blno, block->timestamp?block->timestamp:timestamp, + ,block->blno, block->timestamp?block->timestamp:timestamp, block->blno, block->timestamp?block->timestamp:timestamp); } @@ -815,9 +816,9 @@ void stat_pointers (void) if (!separat_comp) { /* TBD __init(){__init_FILE();__init_SIMENVIR(); should be removed */ fprintf (ccode, "\nvoid __init(void){__init_FILE();__init_SIMENVIR();}\n"); - fprintf - (ccode, - "__do_for_each_stat_pointer(void(*doit)(),void(*doit_notest)(),int force){\n"); + fprintf + (ccode, + "void __do_for_each_stat_pointer(void(*doit)(),void(*doit_notest)(),int force){\n"); do_for_each_stat_pointer (sblock); @@ -825,10 +826,9 @@ void stat_pointers (void) update_gl_obj (sblock); - fprintf (ccode, "}\n__update_gl_to_null(void){\n"); + fprintf (ccode, "}\nvoid __update_gl_to_null(void){\n"); update_gl_null (sblock); fprintf (ccode, "}\n"); } } - diff --git a/src/transcall.c b/src/transcall.c index 11eb82f..d80f63e 100644 --- a/src/transcall.c +++ b/src/transcall.c @@ -17,6 +17,7 @@ #include "config.h" #include "gen.h" #include "extspec.h" +#include "error.h" static int dim; /****************************************************************************** @@ -35,7 +36,7 @@ static exp_t *savepar (exp_t *ret, exp_t *re, char up, char *ident, exp_t *rex; if (first) stackno=0; - + if (up) { rex = re->up; @@ -53,7 +54,7 @@ static exp_t *savepar (exp_t *ret, exp_t *re, char up, char *ident, minval, minref, mintxt); savepar (ret, rex, TRUE, ident, type, FALSE, minval, minref, mintxt); - } + } else { if (rex->left != NULL) @@ -66,7 +67,7 @@ static exp_t *savepar (exp_t *ret, exp_t *re, char up, char *ident, else { if (re->token == MIDENTIFIER && re->rd->ident == ident) - { + { if (re->up->token == MARGUMENTSEP && (re->up->rd->categ == CNAME || re->up->rd->categ == CVAR)) @@ -74,7 +75,7 @@ static exp_t *savepar (exp_t *ret, exp_t *re, char up, char *ident, else { exp_t *restack1, *restack2, *reconc; - + if (stackno == 0) { switch (type) @@ -89,18 +90,18 @@ static exp_t *savepar (exp_t *ret, exp_t *re, char up, char *ident, stackno= findallentry (ret, re, USEDVAL, minval); break; } - + restack1= makeexp (MSTACK, NULL, NULL); if (re->up->left == re) re->up->left= restack1; else re->up->right= restack1; restack1->up= re->up; - - reconc= - makeexp(rex->type==TTEXT? MREFASSIGNT:MASSIGN, + + reconc= + makeexp(rex->type==TTEXT? MREFASSIGNT:MASSIGN, restack2=makeexp (MSTACK, NULL,NULL), re); - + restack1->value.entry= restack2->value.entry= stackno; restack1->type= restack2->type= type; return reconc; @@ -181,8 +182,7 @@ int findallentry (exp_t *ret, exp_t *re, int type, int min) while (rex != ret) { rex = re->up; - while (rex != ret & (rex->left == re | rex->left == NULL - | rex->token == MELSE)) + while (rex != ret && (rex->left == re || rex->left == NULL || rex->token == MELSE)) { re = rex; rex = rex->up; @@ -227,10 +227,11 @@ int findallentry (exp_t *ret, exp_t *re, int type, int min) if (i > rb->maxusedval) rb->maxusedval= i; break; } -#endif +#endif return (i); } - gerror (87); + gerror (87, ""); + return 0; } /****************************************************************************** @@ -241,9 +242,9 @@ long ant_stack (exp_t *ret, exp_t *re, int minval, int minref, int mintxt) #if ACSTACK_IN_OBJ return (0); #else - return - (((long) findallentry (ret, re, USEDVAL | MAXUSED, minval)) << 16 - | ((long) findallentry (ret, re, USEDREF | MAXUSED, minref)) << 8 + return + (((long) findallentry (ret, re, USEDVAL | MAXUSED, minval)) << 16 + | ((long) findallentry (ret, re, USEDREF | MAXUSED, minref)) << 8 | (findallentry (ret, re, USEDTXT | MAXUSED, mintxt))); #endif } @@ -301,7 +302,7 @@ static exp_t *genstack (exp_t *ret, exp_t *re, char only_pointers, int minval, i * evalueres og resultatet legges p} stakken. */ if (!rex->left->konst || rex->left->rd->descr->codeclass == CCTEXT) - goto save; + goto save; break; case MTEXTKONST: case MCHARACTERKONST: @@ -316,8 +317,8 @@ static exp_t *genstack (exp_t *ret, exp_t *re, char only_pointers, int minval, i default: save: if (rex->left->type == TLABEL) - return reconc; - { + return reconc; + { int entry; int type= rex->left->type; exp_t *restack; @@ -342,7 +343,7 @@ static exp_t *genstack (exp_t *ret, exp_t *re, char only_pointers, int minval, i break; } - reconc= concexp (reconc, makeexp(rex->left->type==TTEXT? MREFASSIGNT:MASSIGN, + reconc= concexp (reconc, makeexp(rex->left->type==TTEXT? MREFASSIGNT:MASSIGN, restack=makeexp(MSTACK, NULL,NULL), rex->left)); rex->left= makeexp (MSTACK, NULL, NULL); @@ -350,12 +351,12 @@ static exp_t *genstack (exp_t *ret, exp_t *re, char only_pointers, int minval, i restack->value.entry= rex->left->value.entry= entry; restack->type= rex->left->type= type; - if (rex->token == MBOUNDPARSEP && rex->right != re && + if (rex->token == MBOUNDPARSEP && rex->right != re && !only_pointers) /* sjekk at det er slik at rex->right!=NULL */ { entry= findallentry (ret, rex->right, USEDVAL, minval); reconc= concexp (reconc, makeexp(rex->left->type==TTEXT? MREFASSIGNT:MASSIGN, - restack=makeexp (MSTACK, + restack=makeexp (MSTACK, NULL,NULL), rex->right)); type= rex->type; @@ -372,14 +373,14 @@ static exp_t *genstack (exp_t *ret, exp_t *re, char only_pointers, int minval, i /****************************************************************************** WORKBEFORETEST */ -/* G}r gjennom subtreet og ser om det vil bli skrevet ut noen kode f|r +/* G}r gjennom subtreet og ser om det vil bli skrevet ut noen kode f|r * genvalue() kalles. Brukes i forbindelse med if i uttrykk og i forbindelse * med ORELSE og ANDTHEN */ static char workbeforetest (exp_t *re) { int token; /* token er deklarert som int fordi - * kompilatoren ga warning om at constant 136 + * kompilatoren ga warning om at constant 136 * is out of range of char comparison etter * at MCONC ble lagt inn. Dette m} ses * n{rmere p}. */ @@ -407,7 +408,7 @@ static void transparam (exp_t *ret, exp_t *re, int minval, int minref, int mintx rexp=re; for (rex = re->right; rex->token != MENDSEP; rex = rex->right) { - if (rex->rd->categ == CNAME) + if (rex->rd->categ == CNAME) { if (rex->rd->kind == KSIMPLE) { @@ -434,13 +435,13 @@ static void transparam (exp_t *ret, exp_t *re, int minval, int minref, int mintx re = re->right) if (re->left->token != MINTEGERKONST) index_is_const = FALSE; - + if (!index_is_const) insert_thunk (rex, MTHUNKSIMPLEADDRESS); else goto trcall; break; case MDOT: - /* Dersom det er et dot'et prosedyre-kall, + /* Dersom det er et dot'et prosedyre-kall, * s} skal det genereres * VALUE_THUNK og ikke ADDRESS_THUNK. */ if (rex->left->right->rd->kind != KPROC) @@ -451,11 +452,11 @@ static void transparam (exp_t *ret, exp_t *re, int minval, int minref, int mintx else; /* Denne grenen skal IKKE ha break, Skal gli * rett over i neste case. */ default: - + insert_thunk (rex, MTHUNKSIMPLEVALUE); } } - else if (rex->rd->kind == KARRAY && rex->rd->type != TLABEL && + else if (rex->rd->kind == KARRAY && rex->rd->type != TLABEL && rex->left->token == MDOT) { /* ADDRESS_THUNK */ @@ -509,7 +510,7 @@ exp_t *transcall (exp_t *ret, exp_t *re, int minval, int minref, int mintxt) rex= makeexp (MASSIGND, makeexp (MSTACK, NULL, NULL), makeexp (MEXITARGUMENT, NULL, NULL)); rex->type= rex->left->type= rex->right->type= TREF; - rex->left->value.entry= re->value.entry= + rex->left->value.entry= re->value.entry= findallentry (ret, re, USEDREF, minref); reconc= concexp (reconc, rex); break; @@ -529,12 +530,12 @@ exp_t *transcall (exp_t *ret, exp_t *re, int minval, int minref, int mintxt) if (re->rd->categ == CNAME) { rex= copytree (re); - rex->value.n_of_stack_elements= + rex->value.n_of_stack_elements= ant_stack (ret, re, minval, minref, mintxt); rex->token= MNAMEREADACESS; reconc= concexp (reconc, rex); } - + switch (re->type) { case TREF: @@ -550,7 +551,7 @@ exp_t *transcall (exp_t *ret, exp_t *re, int minval, int minref, int mintxt) break; } - re->value.n_of_stack_elements= + re->value.n_of_stack_elements= ant_stack(ret, re, minval, minref, mintxt); reconc= concexp (reconc, replacenode (&re, MSTACK)); @@ -575,19 +576,19 @@ exp_t *transcall (exp_t *ret, exp_t *re, int minval, int minref, int mintxt) * parametere. */ if ((rex->rd->categ == CNAME || rex->rd->categ == CVAR) && rex->left->token == MIDENTIFIER) - reconc= concexp (reconc, savepar (ret, re, TRUE, + reconc= concexp (reconc, savepar (ret, re, TRUE, rex->left->rd->ident, rex->left->rd->type, TRUE, minval, minref, mintxt)); } - for (rex = re->right; rex->token != MENDSEP; + for (rex = re->right; rex->token != MENDSEP; rex = rex->right) - reconc= concexp (reconc, transcall (ret, rex->left, + reconc= concexp (reconc, transcall (ret, rex->left, minval, minref, mintxt)); if (re->type == TTEXT) { entry= findallentry (ret, re, USEDTXT, mintxt); - re->value.n_of_stack_elements= + re->value.n_of_stack_elements= ant_stack (ret, re, minval, minref, mintxt); reconc= concexp (reconc, replacenode (&re, MSTACK)); @@ -618,7 +619,7 @@ exp_t *transcall (exp_t *ret, exp_t *re, int minval, int minref, int mintxt) for (rex = re->right; rex->token != MENDSEP; rex = rex->right) reconc= concexp (reconc, transcall (ret, rex->left, minval, minref, mintxt)); - + if (re->rd->descr->codeclass == CCRANDOMRUTDANGER) { /* Leter etter siste aktuelle parameter, som */ @@ -645,8 +646,8 @@ exp_t *transcall (exp_t *ret, exp_t *re, int minval, int minref, int mintxt) entry= findallentry (ret, re, USEDVAL, minval); break; } - - re->value.n_of_stack_elements= + + re->value.n_of_stack_elements= ant_stack (ret, re, minval, minref, mintxt); if (re->type == TNOTY) @@ -681,7 +682,7 @@ exp_t *transcall (exp_t *ret, exp_t *re, int minval, int minref, int mintxt) minval, minref, mintxt)); if ((rex = re->left)->token == MNAMEADR && rex->type == TREF) { - reconc= concexp (reconc, makeexp(MINSTRONGEST,copytree(re->left), + reconc= concexp (reconc, makeexp(MINSTRONGEST,copytree(re->left), copytree(re->right))); } break; @@ -706,9 +707,9 @@ exp_t *transcall (exp_t *ret, exp_t *re, int minval, int minref, int mintxt) kan den følgende koden fjernes */ re->left= makeexp (MARRAYADR, NULL, NULL); re->left->up = re; - re->left->value.stack.ref_entry= re->value.stack.ref_entry= + re->left->value.stack.ref_entry= re->value.stack.ref_entry= findallentry (ret, re, USEDREF, minref); - re->left->value.stack.val_entry= re->value.stack.val_entry= + re->left->value.stack.val_entry= re->value.stack.val_entry= findallentry (ret, re, USEDVAL, minval); if (re->rd->categ == CNAME) { @@ -754,21 +755,21 @@ exp_t *transcall (exp_t *ret, exp_t *re, int minval, int minref, int mintxt) rex= makeexp (MASSIGND, makeexp (MSTACK, NULL, NULL), makeexp (MEXITARGUMENT, NULL, NULL)); rex->type= rex->left->type= rex->right->type= TREF; - rex->left->value.entry= re->value.stack.ref_entry= + rex->left->value.entry= re->value.stack.ref_entry= findallentry (ret, re, USEDREF, minref); reconc= concexp (reconc, rex); rex= makeexp (MASSIGND, makeexp (MSTACK, NULL, NULL), makeexp (MEXITARGUMENT, NULL, NULL)); rex->type= rex->left->type= rex->right->type= TINTG; - rex->left->value.entry= re->value.stack.val_entry= + rex->left->value.entry= re->value.stack.val_entry= findallentry (ret, re, USEDVAL, minval); reconc= concexp (reconc, rex); re->token = MNAMEADR; } /* END-SKRIVEAKSESS NAME-PARAMETER */ else - + { /* LESE AKSESS */ rex->token= MNAMEREADACESS; @@ -779,11 +780,11 @@ exp_t *transcall (exp_t *ret, exp_t *re, int minval, int minref, int mintxt) else if (re->type == TTEXT) { rex= copytree (re); - rex->value.stack.val_entry= re->value.stack.val_entry= + rex->value.stack.val_entry= re->value.stack.val_entry= findallentry (ret, re, USEDVAL, minval); - rex->value.stack.ref_entry= re->value.stack.ref_entry= + rex->value.stack.ref_entry= re->value.stack.ref_entry= findallentry (ret, re, USEDREF, minref); - rex->value.stack.txt_entry= re->value.stack.txt_entry= + rex->value.stack.txt_entry= re->value.stack.txt_entry= findallentry (ret, re, USEDTXT, mintxt); rex->token= MNAMEREADTEXT; reconc= concexp (reconc, rex); @@ -795,7 +796,7 @@ exp_t *transcall (exp_t *ret, exp_t *re, int minval, int minref, int mintxt) rex= makeexp (MASSIGND, makeexp (MSTACK, NULL, NULL), makeexp (MEXITARGUMENT, NULL, NULL)); rex->type= rex->left->type= rex->right->type= re->type; - rex->left->value.entry= re->value.entry= + rex->left->value.entry= re->value.entry= findallentry (ret, re, re->type == TREF?USEDREF:USEDVAL, re->type == TREF?minref:minval); reconc= concexp (reconc, rex); @@ -813,9 +814,9 @@ exp_t *transcall (exp_t *ret, exp_t *re, int minval, int minref, int mintxt) int i; reconc= concexp (reconc, genstack (ret, re, FALSE, minval, minref, mintxt)); - rex= makeexp (re->token == MANDTHENE ? MANDTHEN : MORELSE, + rex= makeexp (re->token == MANDTHENE ? MANDTHEN : MORELSE, copytree (re->left), transcall (ret, re->right, - minval, minref, + minval, minref, mintxt)); rex->type= re->type; reconc= concexp (reconc, rex); @@ -827,7 +828,7 @@ exp_t *transcall (exp_t *ret, exp_t *re, int minval, int minref, int mintxt) { reconc= concexp (reconc, genstack (ret, re->right, FALSE, minval, minref, mintxt)); - rex= makeexp (MIF, re->left, transcall (ret, re->right, + rex= makeexp (MIF, re->left, transcall (ret, re->right, minval, minref, mintxt)); rex->type= re->type; rex->qual= re->qual; @@ -835,7 +836,7 @@ exp_t *transcall (exp_t *ret, exp_t *re, int minval, int minref, int mintxt) } break; case MELSEE: - rex= makeexp (MELSE, transcall (ret, re->left, minval, minref, mintxt), + rex= makeexp (MELSE, transcall (ret, re->left, minval, minref, mintxt), transcall (ret, re->right, minval, minref, mintxt)); rex->type= re->type; rex->qual= re->qual; @@ -846,7 +847,7 @@ exp_t *transcall (exp_t *ret, exp_t *re, int minval, int minref, int mintxt) reconc= concexp (reconc, transcall (ret, re->right, minval, minref, mintxt)); - re->value.n_of_stack_elements= + re->value.n_of_stack_elements= ant_stack (ret, re, minval, minref, mintxt); rex= newexp (); *rex= *re; @@ -856,7 +857,7 @@ exp_t *transcall (exp_t *ret, exp_t *re, int minval, int minref, int mintxt) rex= makeexp (MASSIGND, makeexp (MSTACK, NULL, NULL), makeexp (MEXITARGUMENT, NULL, NULL)); rex->type= rex->left->type= rex->right->type= TTEXT; - rex->left->value.entry= re->value.entry= + rex->left->value.entry= re->value.entry= findallentry (ret, re, USEDTXT, mintxt); reconc= concexp (reconc, rex); diff --git a/stamp-h.in b/stamp-h.in deleted file mode 100644 index 9788f70..0000000 --- a/stamp-h.in +++ /dev/null @@ -1 +0,0 @@ -timestamp diff --git a/test/.gitignore b/test/.gitignore index 44f35ba..3ad6295 100644 --- a/test/.gitignore +++ b/test/.gitignore @@ -1,2 +1,4 @@ -/test.shl +/*.shl +/*.c /test +/hello diff --git a/test/hello.sim b/test/hello.sim new file mode 100644 index 0000000..41647de --- /dev/null +++ b/test/hello.sim @@ -0,0 +1,4 @@ +begin + outtext("Hello, World!"); + outimage; +end