From 436b8d86a9f4a13ac8a9df77c7083edda4adb93f Mon Sep 17 00:00:00 2001 From: Serge Vakulenko Date: Tue, 23 Aug 2022 18:15:01 -0700 Subject: [PATCH 01/17] Add scripts for cmake. --- .gitignore | 2 ++ CMakeLists.txt | 13 ++++++++++ src/CMakeLists.txt | 61 ++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 76 insertions(+) create mode 100644 CMakeLists.txt create mode 100644 src/CMakeLists.txt diff --git a/.gitignore b/.gitignore index d6fddd4..415e079 100644 --- a/.gitignore +++ b/.gitignore @@ -21,3 +21,5 @@ Makefile Makefile.in .deps .libs +build +build.log diff --git a/CMakeLists.txt b/CMakeLists.txt new file mode 100644 index 0000000..292eced --- /dev/null +++ b/CMakeLists.txt @@ -0,0 +1,13 @@ +cmake_minimum_required(VERSION 2.9) +project(cim) + +# +# Create config.h. +# +configure_file(config.h.in config.h @ONLY) + +# +# Build subdirectories. +# +add_subdirectory(src) +#add_subdirectory(lib) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt new file mode 100644 index 0000000..673c5f1 --- /dev/null +++ b/src/CMakeLists.txt @@ -0,0 +1,61 @@ +# +# Include both source and build directories. +# +include_directories( + ${CMAKE_SOURCE_DIR} + ${CMAKE_BINARY_DIR} + ${CMAKE_CURRENT_BINARY_DIR} +) + +# +# Check for system include files. +# +include(CheckIncludeFile) +check_include_file("string.h" HAVE_STRING_H) + +# +# Need Bison parser. +# +find_package(BISON REQUIRED) +bison_target(parser parser.y "${CMAKE_CURRENT_BINARY_DIR}/parser.c") + +# +# Build 'cim' binary. +# +add_executable(cim + 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(cim PUBLIC m) +#target_compile_options(cim PRIVATE +# -Wall -g -O3 -ffast-math -fomit-frame-pointer -DHAVE_STRING_H=${HAVE_STRING_H} +#) +install(TARGETS cim DESTINATION bin) From 983725eb942583298a7530294fc80bdcba03997c Mon Sep 17 00:00:00 2001 From: Serge Vakulenko Date: Tue, 23 Aug 2022 19:47:40 -0700 Subject: [PATCH 02/17] Compile cim with cmake. --- CMakeLists.txt | 2 + config.h.in | 35 +++++++++ src/CMakeLists.txt | 1 + src/cimcomp.c | 39 +++++----- src/computeconst.c | 37 ++++----- src/dekl.c | 190 +++++++++++++++++++++++---------------------- src/error.c | 29 +++---- src/expbuilder.c | 7 +- src/expchecker.c | 31 ++++---- src/expgen.c | 102 ++++++++++++------------ src/expmacros.h | 2 - src/extspec.c | 65 ++++++++-------- src/filelist.c | 24 +++--- src/lex.c | 98 +++++++++++------------ src/lex.h | 4 + src/mapline.c | 19 +++-- src/mellbuilder.c | 3 +- src/name.c | 3 +- src/newstr.c | 3 +- src/parser.y | 144 +++++++++++++++++----------------- src/passes.c | 2 + src/salloc.c | 2 +- src/sentbuilder.c | 13 ++-- src/sentchecker.c | 41 +++++----- src/sentgen.c | 54 ++++++------- src/strgen.c | 118 ++++++++++++++-------------- src/transcall.c | 113 ++++++++++++++------------- 27 files changed, 617 insertions(+), 564 deletions(-) create mode 100644 config.h.in diff --git a/CMakeLists.txt b/CMakeLists.txt index 292eced..9f27144 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -6,6 +6,8 @@ project(cim) # configure_file(config.h.in config.h @ONLY) +add_definitions(-DHAVE_CONFIG_H) + # # Build subdirectories. # diff --git a/config.h.in b/config.h.in new file mode 100644 index 0000000..7791ea6 --- /dev/null +++ b/config.h.in @@ -0,0 +1,35 @@ +/* + * 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 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/src/CMakeLists.txt b/src/CMakeLists.txt index 673c5f1..1218ac1 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -4,6 +4,7 @@ include_directories( ${CMAKE_SOURCE_DIR} ${CMAKE_BINARY_DIR} + ${CMAKE_CURRENT_SOURCE_DIR} ${CMAKE_CURRENT_BINARY_DIR} ) diff --git a/src/cimcomp.c b/src/cimcomp.c index 2a67045..b53bbc2 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; @@ -596,7 +597,7 @@ main (int argc, char *argv[], char *envp[]) init_trap_routines(); get_all_env(); - + insert_name_in_dirlist (systemlibdir); init_name (); @@ -608,24 +609,24 @@ 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" "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, + system (newstrcat6 ("cp -f ", extcodename, " ", extcodename, ".old", " 2>/dev/null")); if(option_checkdiff) { - rename (ccodename, newstrcat2 (ccodename, ".old")); + rename (ccodename, newstrcat2 (ccodename, ".old")); } if (!option_nosim && passes_do ()) @@ -634,13 +635,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 +656,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 +677,7 @@ main (int argc, char *argv[], char *envp[]) return (1); } - fprintf (shlfile, + fprintf (shlfile, "#! /bin/sh\n" "\n" "CC='%s'\n" @@ -795,11 +796,11 @@ 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); diff --git a/src/computeconst.c b/src/computeconst.c index f385a6c..efcf9c0 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; @@ -89,24 +91,24 @@ 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; } - return (sub_danger | DANGER); + return (sub_danger | re->danger); } /****************************************************************************** @@ -166,7 +168,7 @@ int sstrlen (char s[]) i += 2; } if (ii >= MAX_TEXT_CHAR) - serror (44); + serror (44, "", 0); return (ii); } @@ -182,7 +184,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 +273,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 +406,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 +452,7 @@ char computeconst (exp_t *re) TOKEN = MINTEGERKONST; if (RIGHTVALUE.ival == 0) { - serror (1); + serror (1, "", 0); VALUE.ival = LEFTVALUE.ival; } else @@ -461,7 +463,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 +485,3 @@ char computeconst (exp_t *re) RIGHT = NULL; return (TRUE); } - diff --git a/src/dekl.c b/src/dekl.c index 3c911da..99acd10 100644 --- a/src/dekl.c +++ b/src/dekl.c @@ -25,9 +25,11 @@ #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 @@ -62,12 +64,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 +78,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 +92,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 +173,7 @@ void decl_init_pass1 (void) { block_t *rb; decl_t *rd; - + cblev= -1; unknowns = new_block (); unknowns->quant.kind = KERROR; @@ -186,7 +188,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 +197,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 +323,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 +356,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 +365,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 +392,7 @@ decl_t *find_global (char *ident, char virt) } /****************************************************************************** - SAMEPARAM */ + SAMEPARAM */ /* Sjekker om parameterene er de samme */ @@ -466,14 +468,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 +558,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 +709,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 +860,7 @@ void reg_decl (char *ident, char type, char kind, char categ) } break; default: - d1error (37); + d1error (37, ident); break; } #ifdef DEBUG @@ -870,7 +872,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 +883,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 +909,7 @@ void reg_inner (void) #ifdef DEBUG -static +static dumpdekl (rd) decl_t *rd; { @@ -967,7 +969,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 +1085,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 +1142,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 +1180,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 +1209,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 +1227,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 +1248,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 +1322,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 +1337,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 +1357,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 +1381,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 +1398,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 +1467,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 +1478,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 +1515,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 +1538,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 +1553,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 +1566,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 +1580,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 +1600,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 +1610,7 @@ static void sjekkdekl (block_t *rb) /*****************************************************************************/ /****************************************************************************** - FIRSTCLASS */ + FIRSTCLASS */ block_t *firstclass (void) { /* Retunerer med blev for den n{rmeste @@ -1671,7 +1673,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 +1700,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 +1743,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 +1764,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 +1795,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 +1868,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 +1907,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 +1924,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 +1937,7 @@ int body (decl_t *rd) } /****************************************************************************** - DANGERPROC */ + DANGERPROC */ /* Er prosedyren farlig og m] isoleres i uttrykk */ @@ -1963,7 +1965,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/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..f989e1d 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" @@ -59,7 +59,7 @@ void ebuilder_init_pass2 (void) } /****************************************************************************** - NEWEXP */ + NEWEXP */ exp_t *newexp(void) { @@ -305,6 +305,3 @@ void ebuild (void) token= min(); } } - - - diff --git a/src/expchecker.c b/src/expchecker.c index 5bfdcb1..5e75ef8 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, 0); (*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); @@ -998,4 +998,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..b9827d9 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 @@ -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,20 +935,20 @@ 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); - + gensl (re, TRUE, ON); fprintf (ccode, "%s.", re->rd->ident); - + if (re->rd->categ == CVAR) fprintf (ccode, "ofs)", re->rd->ident); else @@ -993,7 +995,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 +1008,7 @@ void genvalue (exp_t *re) gensl (re, FALSE, ON); fprintf (ccode, ");"); fprintf (ccode, "if((__pp=__lb"); - } + } else { fprintf (ccode, "if((__pp="); @@ -1030,7 +1032,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 +1043,7 @@ void genvalue (exp_t *re) break; } not_reached = TRUE; - } + } else { int i, dim; @@ -1064,22 +1066,22 @@ 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;", + fprintf (ccode, ")->h.dim!=%d?__rerror(__errarr):1;", dim, re->rd->ident); } 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 +1148,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,7 +1164,7 @@ 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;"); @@ -1345,7 +1347,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 +1387,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 +1476,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 +1487,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 +1497,7 @@ void genvalue (exp_t *re) genvalue (re->left); break; case MSL: - + break; case MSENTCONC: genvalue (re->left); @@ -1609,7 +1611,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..43aa7c6 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,7 +52,9 @@ double strtod (); #endif -#include +#include "obstack.h" +#include + char *xmalloc(); #define obstack_chunk_alloc xmalloc @@ -59,7 +62,7 @@ char *xmalloc(); 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 * @@ -134,10 +137,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 +149,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 +170,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) @@ -235,10 +238,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 +279,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 +431,14 @@ static char *lesinn (char *filename) { char r_buff[12]; r_buff[0] = '\0'; - fscanf (f, "%11s\n", r_buff); + fscanf (f, "%11s\n", r_buff); if (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 +568,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 +673,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 || @@ -746,8 +749,8 @@ static write_decl_mif (FILE *f, decl_t *rd, int level) 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; @@ -773,14 +776,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 +824,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; @@ -844,7 +847,7 @@ static void write_all_mif (void) static 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 @@ -1003,13 +1006,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*/")) merror (5, st->filename); - + /* Leser tidsmerke */ local_timestamp= getname (f); @@ -1017,9 +1020,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..52af937 100644 --- a/src/filelist.c +++ b/src/filelist.c @@ -22,13 +22,15 @@ #include "newstr.h" #include "filelist.h" #include "config.h" +#include "error.h" #if STDC_HEADERS #include #endif #include -#include +#include +#include "obstack.h" char *xmalloc(); @@ -126,7 +128,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; @@ -197,7 +199,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); } @@ -317,11 +319,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 +363,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/lex.c b/src/lex.c index 3b71541..cf8959e 100644 --- a/src/lex.c +++ b/src/lex.c @@ -34,7 +34,8 @@ double strtod (); #endif -#include +#include "obstack.h" + char *xmalloc(); #define obstack_chunk_alloc xmalloc @@ -66,8 +67,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 +117,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 +134,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 +144,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 +152,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 +162,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 +530,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); @@ -566,7 +567,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 +604,7 @@ static void scan_ifdef (void) { elsedef = FALSE; notdef = TRUE; - } + } else goto proceed; while (lexchar == ' ' | lexchar == '\t') @@ -611,7 +612,7 @@ static void scan_ifdef (void) if (isalpha (lexchar) || lexchar == '_') { scan_name (); - + if (elsedef == TRUE) { if (!(ifdefp->ifdef & IFGREN)) @@ -632,7 +633,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 +656,7 @@ static void scan_ifdef (void) if ((ifdefp->ifdef == (IFGREN | TRUE)) || (ifdefp->ifdef == (ELSEGREN | FALSE))) break; - + proceed: while (lexchar != EOF) { @@ -663,7 +664,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 +762,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")) @@ -788,7 +789,7 @@ static void scan_dirline (void) if (isalpha (lexchar) | lexchar == '_') { scan_name (); - + define_name (tag (yytext), TRUE); } else if (!bl_in_dir_line) lerror (8); @@ -821,7 +822,7 @@ static void scan_dirline (void) if (lexchar != '\n' | lexchar != EOF) { scan_nows (); - + notintext = TRUE; pushfilmap (tag (yytext), ifdefp); @@ -853,7 +854,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 +862,7 @@ static void scan_dirline (void) if (lexchar != '\n' & lexchar != EOF) { scan_nows (); - + setfilmap (tag (yytext), nylinje); } else @@ -930,7 +931,7 @@ static void scan_dirline (void) if (isalpha (lexchar) | lexchar == '_') { scan_name (); - + directive_timestamp= yytext; yytext= obstack_finish (&os_lex); } @@ -1004,7 +1005,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,7 +1022,7 @@ static char *putcharacter (unsigned char character) } /****************************************************************************** - PUTCHARTEXT */ + PUTCHARTEXT */ /* Prosedyre som fungerer som grensesnitt mot scanner, * for } bygge opp et konstant-tekstobjekt. @@ -1035,10 +1036,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 +1089,7 @@ int yylex (void) if (isalpha (newlexchar)) { scan_name (); - + unput (lexchar); switch (yytext[0]) { @@ -1160,49 +1161,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; @@ -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); @@ -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..4528013 100644 --- a/src/lex.h +++ b/src/lex.h @@ -24,9 +24,13 @@ extern char nameasvar; extern char sensitive; extern char staticblock; +int ylex (void); int yylex (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..2fa2fc6 100644 --- a/src/mapline.c +++ b/src/mapline.c @@ -29,9 +29,10 @@ #include #endif -#include +#include "obstack.h" #include "mapline.h" #include "name.h" +#include "error.h" char *xmalloc(); @@ -100,11 +101,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 +124,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,13 +168,13 @@ 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) { @@ -185,7 +186,7 @@ long getmapline (long line) } /****************************************************************************** - GETMAPFILE */ + GETMAPFILE */ char *getmapfile (long line) { @@ -207,11 +208,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); } - - diff --git a/src/mellbuilder.c b/src/mellbuilder.c index b159bae..5d40787 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" @@ -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..523e941 100644 --- a/src/name.c +++ b/src/name.c @@ -23,12 +23,13 @@ #include "name.h" #include +#include #if STDC_HEADERS #include #endif -#include +#include "obstack.h" char *xmalloc(); diff --git a/src/newstr.c b/src/newstr.c index e786e71..35e5cd2 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" @@ -148,4 +148,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/parser.y b/src/parser.y index c20c385..2686aaa 100644 --- a/src/parser.y +++ b/src/parser.y @@ -27,9 +27,13 @@ #include "name.h" #include "mellbuilder.h" #include -#include +#include "obstack.h" +#include "error.h" +#include "extspec.h" + char *xmalloc(); void yyerror (char s[]); + #define obstack_chunk_alloc xmalloc #define obstack_chunk_free free @@ -104,7 +108,7 @@ struct _blockstack char *ident; char *tval; char stat_decl; - char kind; + char kind; } %token @@ -113,7 +117,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 +128,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 +148,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 +169,7 @@ struct _blockstack %left HTERMOPERATOR %left UNEAR %left HFACTOROPERATOR -%left HPRIMARYOPERATOR +%left HPRIMARYOPERATOR %left HQUA @@ -177,12 +181,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 +197,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 +206,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 +223,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 +236,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 +250,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 +262,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 +273,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 +296,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 +314,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 +378,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 +412,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 +479,7 @@ MODULSTATEMENT : HWHILE BLOCK { end_block(NULL,CCNO); $$=DECLARATION; mout(MENDCLASS);} | HCLASS - NO_TYPE + NO_TYPE HIDENTIFIER { prefquantident=0; MBEENEWBLOCK(); mout(MCLASS); @@ -487,9 +491,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 +526,7 @@ DECLSTATEMENT : MODULSTATEMENT | TYPE HIDENTIFIER MBEE_CONSTANT - HPAREXPSEPARATOR + HPAREXPSEPARATOR { MBEENEWBLOCK(); kind=KSIMPLE; reg_decl($2, type, KSIMPLE, categ); @@ -534,7 +538,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 +551,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 +596,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 +637,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 +658,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 +722,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 +741,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 +778,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 +866,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 +929,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 +940,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..0edea5d 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 @@ -115,7 +116,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 +136,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 +150,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 +304,7 @@ sent_t *sbuild(void) p= mpointer; ebuild (); if (p == mpointer) - serror (71, token); + serror (71, token, 0); continue; } } @@ -324,7 +325,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..a86a7a6 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, 0); 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, 0); + 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, 0); 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, 0); 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; @@ -223,4 +225,3 @@ void sent_check (sent_t *parent_sent, char res_labels) } } } - diff --git a/src/sentgen.c b/src/sentgen.c index 422a6f0..8389539 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 (); @@ -682,7 +684,7 @@ static void procedure_entry_gen (sent_t *sent) } 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 diff --git a/src/strgen.c b/src/strgen.c index 724045d..505787c 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); @@ -713,7 +714,7 @@ static void do_for_each_stat_pointer (block_t *block) if (block->stat) 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,8 +816,8 @@ 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, + fprintf + (ccode, "__do_for_each_stat_pointer(void(*doit)(),void(*doit_notest)(),int force){\n"); do_for_each_stat_pointer (sblock); @@ -831,4 +832,3 @@ void stat_pointers (void) 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); From a50ad6d63ccd3380786d7d3b1ff53a77c18ef323 Mon Sep 17 00:00:00 2001 From: Serge Vakulenko Date: Tue, 23 Aug 2022 19:56:58 -0700 Subject: [PATCH 03/17] Enable debug info. --- CMakeLists.txt | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index 9f27144..418e8cd 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,6 +1,12 @@ cmake_minimum_required(VERSION 2.9) 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() + # # Create config.h. # From d19424c88e536e11887389753839bbe76662d90b Mon Sep 17 00:00:00 2001 From: Serge Vakulenko Date: Tue, 23 Aug 2022 20:25:27 -0700 Subject: [PATCH 04/17] Fix bug in limit.h. --- limit.h | 10 +--------- src/mapline.c | 4 ++-- 2 files changed, 3 insertions(+), 11 deletions(-) diff --git a/limit.h b/limit.h index 9cf7e10..0112785 100644 --- a/limit.h +++ b/limit.h @@ -29,15 +29,7 @@ #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 diff --git a/src/mapline.c b/src/mapline.c index 2fa2fc6..f20d7a2 100644 --- a/src/mapline.c +++ b/src/mapline.c @@ -180,7 +180,7 @@ 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); } @@ -192,7 +192,7 @@ 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); } From 294b19a76961b7d28315c13db2370da7c12395e8 Mon Sep 17 00:00:00 2001 From: Serge Date: Sat, 18 Mar 2023 01:02:23 -0700 Subject: [PATCH 05/17] Add cmake script for library. --- CMakeLists.txt | 2 +- Makefile.am | 24 ----- README | 24 ++--- acinclude.m4 | 262 --------------------------------------------- configure.ac | 107 ------------------ doc/Makefile.am | 21 ---- lib/CMakeLists.txt | 254 +++++++++++++++++++++++++++++++++++++++++++ limit.h | 1 + man/Makefile.am | 21 ---- man/cim.txt | 176 ++++++++++++++++++++++++++++++ src/Makefile.am | 49 --------- src/expchecker.c | 2 +- stamp-h.in | 1 - test/hello.sim | 4 + 14 files changed, 445 insertions(+), 503 deletions(-) delete mode 100644 Makefile.am delete mode 100644 acinclude.m4 delete mode 100644 configure.ac delete mode 100644 doc/Makefile.am create mode 100644 lib/CMakeLists.txt delete mode 100644 man/Makefile.am create mode 100644 man/cim.txt delete mode 100644 src/Makefile.am delete mode 100644 stamp-h.in create mode 100644 test/hello.sim diff --git a/CMakeLists.txt b/CMakeLists.txt index 418e8cd..55f1a4f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -18,4 +18,4 @@ add_definitions(-DHAVE_CONFIG_H) # Build subdirectories. # add_subdirectory(src) -#add_subdirectory(lib) +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/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/lib/CMakeLists.txt b/lib/CMakeLists.txt new file mode 100644 index 0000000..97e46d7 --- /dev/null +++ b/lib/CMakeLists.txt @@ -0,0 +1,254 @@ +include_directories( + ${CMAKE_SOURCE_DIR} + ${CMAKE_BINARY_DIR} + ${CMAKE_CURRENT_SOURCE_DIR} + ${CMAKE_CURRENT_BINARY_DIR} +) + +# +# Check for system include files. +# +include(CheckIncludeFile) +check_include_file("string.h" HAVE_STRING_H) + +# +# Build cim library +# +add_library(libcim 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 + #TODO: simset.c + #TODO: simulation.c + rdiv0.c + idiv0.c +) diff --git a/limit.h b/limit.h index 0112785..bb931f3 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 */ 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/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/expchecker.c b/src/expchecker.c index 5e75ef8..4451f84 100644 --- a/src/expchecker.c +++ b/src/expchecker.c @@ -211,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, 0); + serror (85, "", (*re)->up->token); (*re)->type = (*re)->up->type = TERROR; } } 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/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 From 4a489976b947730a4f1c392663fff71d8c17b33d Mon Sep 17 00:00:00 2001 From: Serge Date: Sat, 18 Mar 2023 01:27:01 -0700 Subject: [PATCH 06/17] Compile library. --- config.h.in | 2 ++ lib/CMakeLists.txt | 8 +------- limit.h | 8 ++++++++ src/CMakeLists.txt | 17 ++++------------- 4 files changed, 15 insertions(+), 20 deletions(-) diff --git a/config.h.in b/config.h.in index 7791ea6..814742b 100644 --- a/config.h.in +++ b/config.h.in @@ -14,6 +14,8 @@ #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 CPU_TYPE "ARM" #define MANUFACTURER "APPLE" diff --git a/lib/CMakeLists.txt b/lib/CMakeLists.txt index 97e46d7..73a01bd 100644 --- a/lib/CMakeLists.txt +++ b/lib/CMakeLists.txt @@ -5,16 +5,10 @@ include_directories( ${CMAKE_CURRENT_BINARY_DIR} ) -# -# Check for system include files. -# -include(CheckIncludeFile) -check_include_file("string.h" HAVE_STRING_H) - # # Build cim library # -add_library(libcim STATIC +add_library(cim STATIC sysin.c sysout.c syserr.c diff --git a/limit.h b/limit.h index bb931f3..e111cd6 100644 --- a/limit.h +++ b/limit.h @@ -34,3 +34,11 @@ /* Define TYPE_32_INT */ #define TYPE_32_INT int + +#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/src/CMakeLists.txt b/src/CMakeLists.txt index 1218ac1..a3bfa10 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -8,12 +8,6 @@ include_directories( ${CMAKE_CURRENT_BINARY_DIR} ) -# -# Check for system include files. -# -include(CheckIncludeFile) -check_include_file("string.h" HAVE_STRING_H) - # # Need Bison parser. # @@ -21,9 +15,9 @@ find_package(BISON REQUIRED) bison_target(parser parser.y "${CMAKE_CURRENT_BINARY_DIR}/parser.c") # -# Build 'cim' binary. +# Build 'gnucim' binary. # -add_executable(cim +add_executable(gnucim error.c pargen.c name.c @@ -55,8 +49,5 @@ add_executable(cim dump.c "${CMAKE_CURRENT_BINARY_DIR}/parser.c" ) -target_link_libraries(cim PUBLIC m) -#target_compile_options(cim PRIVATE -# -Wall -g -O3 -ffast-math -fomit-frame-pointer -DHAVE_STRING_H=${HAVE_STRING_H} -#) -install(TARGETS cim DESTINATION bin) +target_link_libraries(gnucim PUBLIC m) +install(TARGETS gnucim DESTINATION bin) From 494c2c92c5e8aedff626f0fe2e3fdf672234d268 Mon Sep 17 00:00:00 2001 From: Serge Date: Sat, 18 Mar 2023 02:15:27 -0700 Subject: [PATCH 07/17] Install library. Fix a few gcc warnings. --- lib/CMakeLists.txt | 19 +++++++++++++++++-- lib/cim.h | 7 +++++-- src/strgen.c | 4 ++-- test/.gitignore | 2 ++ 4 files changed, 26 insertions(+), 6 deletions(-) diff --git a/lib/CMakeLists.txt b/lib/CMakeLists.txt index 73a01bd..d5ed6c3 100644 --- a/lib/CMakeLists.txt +++ b/lib/CMakeLists.txt @@ -241,8 +241,23 @@ add_library(cim STATIC simfile.c simenvir.c xmalloc.c - #TODO: simset.c - #TODO: simulation.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..de8d024 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 */ @@ -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 */ @@ -643,6 +644,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 +653,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); diff --git a/src/strgen.c b/src/strgen.c index 505787c..fc76c86 100644 --- a/src/strgen.c +++ b/src/strgen.c @@ -818,7 +818,7 @@ void stat_pointers (void) 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"); + "void __do_for_each_stat_pointer(void(*doit)(),void(*doit_notest)(),int force){\n"); do_for_each_stat_pointer (sblock); @@ -826,7 +826,7 @@ 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/test/.gitignore b/test/.gitignore index 44f35ba..855e16f 100644 --- a/test/.gitignore +++ b/test/.gitignore @@ -1,2 +1,4 @@ /test.shl /test +/hello.shl +/hello From aacbca27a00eef3f081c59aae730999245436566 Mon Sep 17 00:00:00 2001 From: Serge Date: Sat, 18 Mar 2023 21:25:50 -0700 Subject: [PATCH 08/17] Add simset.c and simulation.c. --- lib/.gitignore | 2 - lib/simset.c | 374 +++++++++++++++++++++++++++ lib/simulation.c | 645 +++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 1019 insertions(+), 2 deletions(-) create mode 100644 lib/simset.c create mode 100644 lib/simulation.c 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/simset.c b/lib/simset.c new file mode 100644 index 0000000..e7291d8 --- /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" +(((__bp=((__bs213 *)__lb)->PTR)!=__NULL && (__bp->pp->pref[0]!= &__p207SIMSET))?(__dhp)__rerror(__errqual):__bp); +# 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" +(((__bp=((__bs214 *)__lb)->PTR)!=__NULL && (__bp->pp->pref[0]!= &__p207SIMSET))?(__dhp)__rerror(__errqual):__bp); +# 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" +(((__bp=((__bs215 *)__lb)->S)!=__NULL && (__bp->pp->pref[1]!= &__p216SIMSET))?(__dhp)__rerror(__errqual):__bp);__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..bc7e402 --- /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" +(((__bp=((__bs230 *)__lb)->X)!=__NULL && (__bp->pp->pref[2]!= &__p225SIMULATION))?(__dhp)__rerror(__errqual):__bp);(((__bp=((__bs230 *)__lb)->Y)!=__NULL && (__bp->pp->pref[2]!= &__p225SIMULATION))?(__dhp)__rerror(__errqual):__bp); +# 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" +(((__bp=((__bs233 *)__lb)->S)!=__NULL && (__bp->pp->pref[1]!= &__p216SIMSET))?(__dhp)__rerror(__errqual):__bp); +# 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" +(((__bp=((__bs234 *)__lb)->x)!=__NULL && (__bp->pp->pref[2]!= &__p225SIMULATION))?(__dhp)__rerror(__errqual):__bp); +# 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; +}} From 98c1529a9d2cf6ce07debb990c1d4051b090fec5 Mon Sep 17 00:00:00 2001 From: Serge Vakulenko Date: Sat, 18 Mar 2023 22:04:18 -0700 Subject: [PATCH 09/17] Fix build on macos. --- lib/cim.h | 5 +++++ lib/dbclose.c | 1 + lib/dbinbyte.c | 3 ++- lib/dblastloc.c | 1 + lib/dblocate.c | 1 + lib/dboutbyte.c | 3 ++- lib/dcheckpoint.c | 1 + lib/dclose.c | 1 + lib/dlastloc.c | 1 + lib/dlocate.c | 3 ++- lib/gbc.c | 12 ++++++------ lib/ibclose.c | 3 ++- lib/ibinbyte.c | 1 + lib/iclose.c | 3 ++- lib/lowcase.c | 5 +++-- lib/lowten.c | 3 ++- lib/obclose.c | 1 + lib/oboutbyte.c | 2 ++ lib/oclose.c | 3 ++- lib/peject.c | 1 + lib/setaccess.c | 5 +++-- lib/start.c | 12 ++++++++---- lib/upcase.c | 5 +++-- src/strgen.c | 2 +- test/.gitignore | 4 ++-- 25 files changed, 56 insertions(+), 26 deletions(-) diff --git a/lib/cim.h b/lib/cim.h index de8d024..69454c8 100644 --- a/lib/cim.h +++ b/lib/cim.h @@ -615,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); @@ -623,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); @@ -889,3 +892,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/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/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/gbc.c b/lib/gbc.c index c630a8f..92b2b50 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) ()) { int i, ar, @@ -59,7 +59,7 @@ 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) ()) @@ -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. */ 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/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/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/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/start.c b/lib/start.c index 81f26b9..47efa74 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 __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/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/src/strgen.c b/src/strgen.c index fc76c86..cb835cc 100644 --- a/src/strgen.c +++ b/src/strgen.c @@ -712,7 +712,7 @@ 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->timestamp?block->timestamp:timestamp); diff --git a/test/.gitignore b/test/.gitignore index 855e16f..3ad6295 100644 --- a/test/.gitignore +++ b/test/.gitignore @@ -1,4 +1,4 @@ -/test.shl +/*.shl +/*.c /test -/hello.shl /hello From d0232266737438c6f6d730d258f8d4428f9e90b8 Mon Sep 17 00:00:00 2001 From: Serge Date: Sat, 18 Mar 2023 22:10:24 -0700 Subject: [PATCH 10/17] Fix build on Linux. --- lib/cim.h | 2 +- lib/getsa.c | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/cim.h b/lib/cim.h index 69454c8..decf199 100644 --- a/lib/cim.h +++ b/lib/cim.h @@ -605,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) ()); diff --git a/lib/getsa.c b/lib/getsa.c index abe2f77..66f1c66 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 From e4b0931becef6eeee8096fb1dc4604d1fade24d9 Mon Sep 17 00:00:00 2001 From: Serge Date: Sat, 18 Mar 2023 22:27:05 -0700 Subject: [PATCH 11/17] Add examples from https://staff.um.edu.mt/jskl1/talk.html --- examples/chess.sim | 49 +++++++++ examples/chess1.sim | 40 +++++++ examples/chess2.sim | 44 ++++++++ examples/chess3.sim | 9 ++ examples/geometry.sim | 104 ++++++++++++++++++ examples/ns1.sim | 188 ++++++++++++++++++++++++++++++++ examples/readme | 36 ++++++ examples/sime1.sim | 98 +++++++++++++++++ examples/sime2.sim | 77 +++++++++++++ examples/sime3.sim | 81 ++++++++++++++ examples/simeset.sim | 108 ++++++++++++++++++ examples/simexac.sim | 54 +++++++++ examples/simexas.sim | 67 ++++++++++++ examples/simproc1.sim | 11 ++ examples/simproc2.sim | 16 +++ examples/simset.pas | 230 +++++++++++++++++++++++++++++++++++++++ examples/stacks.pas | 63 +++++++++++ examples/stacks.sim | 18 +++ examples/testfor.sim | 7 ++ examples/tgeom.sim | 55 ++++++++++ examples/tsimset.pas | 105 ++++++++++++++++++ examples/tstacks.pas | 98 +++++++++++++++++ examples/tstackschar.sim | 39 +++++++ examples/tstacksvar.sim | 85 +++++++++++++++ 24 files changed, 1682 insertions(+) create mode 100644 examples/chess.sim create mode 100644 examples/chess1.sim create mode 100644 examples/chess2.sim create mode 100644 examples/chess3.sim create mode 100644 examples/geometry.sim create mode 100644 examples/ns1.sim create mode 100644 examples/readme create mode 100644 examples/sime1.sim create mode 100644 examples/sime2.sim create mode 100644 examples/sime3.sim create mode 100644 examples/simeset.sim create mode 100644 examples/simexac.sim create mode 100644 examples/simexas.sim create mode 100644 examples/simproc1.sim create mode 100644 examples/simproc2.sim create mode 100644 examples/simset.pas create mode 100644 examples/stacks.pas create mode 100644 examples/stacks.sim create mode 100644 examples/testfor.sim create mode 100644 examples/tgeom.sim create mode 100644 examples/tsimset.pas create mode 100644 examples/tstacks.pas create mode 100644 examples/tstackschar.sim create mode 100644 examples/tstacksvar.sim diff --git a/examples/chess.sim b/examples/chess.sim new file mode 100644 index 0000000..832cee8 --- /dev/null +++ b/examples/chess.sim @@ -0,0 +1,49 @@ +! 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,3); 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/chess1.sim b/examples/chess1.sim new file mode 100644 index 0000000..8061300 --- /dev/null +++ b/examples/chess1.sim @@ -0,0 +1,40 @@ +! 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,3); 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/chess2.sim b/examples/chess2.sim new file mode 100644 index 0000000..1467014 --- /dev/null +++ b/examples/chess2.sim @@ -0,0 +1,44 @@ +! 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,3); 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/chess3.sim b/examples/chess3.sim new file mode 100644 index 0000000..69a1999 --- /dev/null +++ b/examples/chess3.sim @@ -0,0 +1,9 @@ +! 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,3); OutImage; +End of Program; diff --git a/examples/geometry.sim b/examples/geometry.sim new file mode 100644 index 0000000..932ac37 --- /dev/null +++ b/examples/geometry.sim @@ -0,0 +1,104 @@ +! OOP in the Simula language ; +! ; +! The program defines the main class "geometry". ; +! It represents a theory with terms: ; +! "point,rectangle,circle,line". ; +! The life of geometry generates the origin and ; +! the axes x and y. ; +! Later the class geometry will be used as prefix. ; + +Class Geometry; +Begin + !Definition of classes (terms) local in geometry: ; + + Class Point(X,Y); Real X,Y; ! Cartesian coordinates; + Begin + Procedure Print; ! Displaying the location; + Begin + OutText("Point: "); + OutFix(x,1,4); OutText(","); + OutFix(y,1,4); + End of Print; + + Procedure Shift(Dx,Dy); ! Dx, Dy are increments of the shift; + Real Dx,Dy; + Begin + X := X + Dx; Y := Y + Dy; + End of Shift; + + Print; ! Life of point; + OutText(" created"); OutImage + End of Point; + + Class Rectangle(RecName,Width,Height); ! Class with 3 parameters; + Text RecName; Real Width, Height; ! Specification of parameters; + Begin + Real Area, Perimeter; ! Attributes; + + Procedure Update; ! Method; + Begin + Area := Width * Height; + Perimeter := 2*(Width + Height) + End of update; + + Procedure Show; ! Method; + Begin + OutText(" I am a rectangle "); OutText(RecName); OutImage; + OutText(" Width: "); OutFix(Width,2,6); + OutText(" Height: "); OutFix(Height,2,6); + OutText(" Area: "); OutFix(Area,2,7); + OutText(" Perimeter: "); OutFix(Perimeter,2,6); OutImage + end of Show; + + Update; ! Life of rectangle; + OutText("Rectangle created."); OutImage; + Show; + End of rectangle; + + Class Circle(Radius, Center); + Real Radius; Ref(Point) Center; + Begin + Procedure Shift(Dx,Dy); Real Dx,Dy; + Begin + Center.Shift(Dx,Dy); + OutText("Circle shifted to "); + OutFix(Center.X,1,4); OutFix(Center.Y,1,4); OutImage + End of Shift; + + Outtext("Circle created at "); ! Life of circle; + Center.Print; + OutText(" with radius "); OutFix(Radius,1,5); OutImage + End of Circle; + + Class Line(M,N); Ref(Point) M,N; ! Line defined by two points; + Begin + Real Slope; + + Slope := If M.X=N.X Then MaxReal ! Life of line; + Else (N.Y-M.Y)/(N.X-M.X); + OutText("Line ("); + M.Print; + OutText("),("); + N.Print; + OutText(") with slope ="); + If Slope=MaxReal Then OutText(" 90 degrees ") + Else OutFix(Slope,2,12); + OutText(" created"); OutImage + End of Line; + + + !Variables declared in geometry: ; + + Ref(Point) Origin,A,B; + Ref(Line) X,Y; + + !Life of geometry: ; + + Origin :- New Point(0,0); !creating the origin; + A :- New Point(1,0); + B :- New Point(0,1); + X :- New Line(Origin,A); !creating the axes; + Y :- New Line(Origin,B); + OutText("*** Geometry initialized ***"); OutImage; + +End of Geometry; diff --git a/examples/ns1.sim b/examples/ns1.sim new file mode 100644 index 0000000..4772184 --- /dev/null +++ b/examples/ns1.sim @@ -0,0 +1,188 @@ +! 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/readme b/examples/readme new file mode 100644 index 0000000..693e954 --- /dev/null +++ b/examples/readme @@ -0,0 +1,36 @@ + ================= + | LIST OF FILES | + ================= + +TESTFOR SIM = General For Statement +SIMPROC1 SIM = Procedure (right indented outtext) +SIMPROC2 SIM = Type Procedure (GCD) + +GEOMETRY SIM = Package (Main class) Geometry with local classes +TGEOM SIM = Testing Geometry + +SIMESET SIM = Working with SIMSET +STACKS SIM = Stack implementation based on SIMSET +TSTACKSCHAR SIM = Testing STACKS.SIM (character stack) +TSTACKSVAR SIM = Testing STACKS.SIM (storing items of various types) + +SIME1 SIM = Simulation model from [1] +SIME2 SIM = Simulation model from [1] +SIME3 SIM = Simulation model from [1] + +SIMEXAC SIM = Simulation model of a queuing system (active customer) +SIMEXAS SIM = Simulation model of a queuing system (active server) + +CHESS1 SIM = QPS: Chess control - Two Masters +CHESS2 SIM = QPS: Chess control - Master + Two Slaves +CHESS SIM = QPS: Chess control as a package (Main class CHESS) +CHESS3 SIM = QPS: Chess control - Testing CHESS + +NS1 SIM = Nested simulation + +SIMSET PAS = Turbo Pascal unit (like Simset of Simula) +TSIMSET PAS = Testing SIMSET.PAS +STACKS PAS = Stack implementation based on SIMSET.PAS +TSTACKS PAS = Testing STACKS.PAS + +[1] Rob Pooley: An Introduction to Programming in Simula. Blackwell Publ. diff --git a/examples/sime1.sim b/examples/sime1.sim new file mode 100644 index 0000000..5eb00bc --- /dev/null +++ b/examples/sime1.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/sime2.sim b/examples/sime2.sim new file mode 100644 index 0000000..8feddef --- /dev/null +++ b/examples/sime2.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/sime3.sim b/examples/sime3.sim new file mode 100644 index 0000000..93e4231 --- /dev/null +++ b/examples/sime3.sim @@ -0,0 +1,81 @@ +! 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/simeset.sim b/examples/simeset.sim new file mode 100644 index 0000000..ed08bd8 --- /dev/null +++ b/examples/simeset.sim @@ -0,0 +1,108 @@ +! 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); integer i; ! User defined list element; + 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/simexac.sim b/examples/simexac.sim new file mode 100644 index 0000000..04716df --- /dev/null +++ b/examples/simexac.sim @@ -0,0 +1,54 @@ +! Active customer approach; +Simulation Begin + Real TrialDuration; ! Experiment length [min]; + Ref(Head) Queue; ! The queue; + Integer Servers; ! Total number of servers; + Integer BusyServers; ! Numbers of working 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; + + 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 Customer(Arrival); Real Arrival; + Begin + Ref(Customer) Next; + If not Queue.Empty or (BusyServers >= 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; + CustomersOut := CustomersOut + 1; ! Statistics; + TotalTime := TotalTime + Time - Arrival; + End of Customer; + + ! MAIN program body: ; + TrialSeedG := 7; TrialSeedS := 23; ! Seeds for random variables; + MinInt := 1; MaxInt := 3; ! Min and Max intervals; + SMean := 8; SStd := 2; ! Random normal servers; + 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/simexas.sim b/examples/simexas.sim new file mode 100644 index 0000000..463d661 --- /dev/null +++ b/examples/simexas.sim @@ -0,0 +1,67 @@ +! 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; + CustomersOut := CustomersOut + 1; ! Statistics; + TotalTime := TotalTime + Time - Arrival; + End of Customer; + + ! MAIN program body: ; + TrialSeedG := 7; TrialSeedS := 23; ! Seeds for random variables; + MinInt := 1; MaxInt := 3; ! Min and Max intervals; + SMean := 8; SStd := 2; ! Random normal servers; + 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/simproc1.sim b/examples/simproc1.sim new file mode 100644 index 0000000..59b265b --- /dev/null +++ b/examples/simproc1.sim @@ -0,0 +1,11 @@ +Begin + Procedure RightText(T, N); Text T; Integer N; + Begin + Integer i; + For i:=1 step 1 until N-T.Length do OutText(" "); + OutText(T) + End of RighText; + + RightText("Short",30); OutImage; + RightText("And the long one",30); +End of Program; diff --git a/examples/simproc2.sim b/examples/simproc2.sim new file mode 100644 index 0000000..3bc31ea --- /dev/null +++ b/examples/simproc2.sim @@ -0,0 +1,16 @@ +Begin + Integer Procedure GCD(M, N); Integer M, N; + Begin + While M<>N do begin + If M