--- /dev/null
+1997.11.26
+
+ loggraph: Dodany nowy komunikat GRAPH_MAGIC (magiczna grafika!!)
+ logint: HFONT8 wysyla GRAPH_MAGIC
+ logedit: zmiana czcionki w menu
+
+1997.11.27
+
+ loggraph:1) poprawione odczytywanie znaku z klawiatury, poprzednio
+ gubil znaki !!!
+ 2) poprawione readln
+ logedit: rozbudowany edytor- dodane "find", "copy", "paste","save as"
+
+1997.12.01
+
+ loggraph: 1) skrocona MESSAGE dla graph - G_MESSAGE
+ 2) poprawione inkey - wczesniej blokowalo!
+
+1997.12.03
+ logedit: wypisuje pozycje kursora
+ logint: wypisywanie bledow na zasobie graficznym a nie na stderr
+
+1997.12.05
+ logcomp: preprocesor dla kompilatora, mozna uzywac #include
+ logedit: poprawiony wskaznik pozycji kursora
+
+1997.12.12
+ logker: zmienione dlugosci cmd dla funkcji 'system' (byly za male!)
+ logker: zrobione opcje "Connect" i "Info"
+ logedit: wyrzucona opcja 'Help' i dodana do logker
+ loghelp: mikro- przegladarka do HTML,
+
+1997.12.15
+ inkey: zwraca kody klawiszy funkcyjnych
+ klasa "Machine": klasa funkcji zwracajacych informacje o Maszynie
+ Wirtualnej
+ dokumentacja: uzupelniona dokumentacja do klasy Machine, ANSI i inkey
+
+1998.01.07
+ Zmieniona koncepcja modulu GRAPH, teraz kazdy interpreter ma swoj
+ wlasny modul GRAPH !!!
+
+1998.01.09
+ Poczatek klasy GUI: Read/Write Int, Text, Real, Char
+
+1998.01.10
+ Dodane: PutImgFile do klasy GUI kopiuje .BMP,.XPM .GIF
+
+1998.01.12
+ Zrobiona klasa GUI
+
+1998.01.13
+ Poprawione accept() w cint.c, bo Linux ma tu blad!
+
+1998.01.14
+ Zmieniony sposob transmisji pliku z kodem, w zwiazku z tym
+ zmniejszenie dlugosci struktury MESSAGE
+
+1998.01.15
+ Dolaczona opcja TCP_NODELAY do wszystkich gniazdek, chyba chodzi
+ szybciej!
--- /dev/null
+### Includes for QT library
+QINC=/usr/lib/qt-1.45/include
+
+### QT library directory
+QLIB=/usr/lib/qt-1.45/lib
+
+### moc compiler directory
+MOCDIR=/usr/lib/qt-1.45/bin
+
+### Install directory
+INSTALLDIR=/usr/local/vlp
--- /dev/null
+Pre-requisite:
+ Prior To compile and run Virtual LOGLAN Processor you should compile
+ the QT library.(You may consult the file "inst/LICENSE.QT" for more informations
+ about the QT.
+ Read the file
+ installQT.html
+ and follow the instructions contained there.
+
+
+
+First, you MUST edit the file "Dir" and set the proper directories:
+
+QINC - directory where the QT library includes are stored
+QLIB - directory where you have your QT library (ver. 1.30)
+MOCDIR - QT library has a special compiler named "moc", write
+ the directory where this compiler is stored
+
+INSTALLDIR - directory where the Virtual LOGLAN Processor will be
+ installed
+
+Next, run the following:
+
+ ./configure
+
+to configure source files
+
+ make
+
+to build VLP and
+
+ make install
+
+to install Virtual LOGLAN Processor
+
+Now you must configure your "vlp.cfg" file which is stored in
+the instalation directory.
+WARNING! Variable "homedir" should point to the directory where
+you have program "logker" installed. This MUST be a full path !!!
+
+
+
+
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html>
+<head>
+ <title>installation of VLP</title>
+
+</head>
+ <body>
+
+<h1>Installing VLP - Virtual Loglan Processor<br>
+</h1>
+<h2>Pre-requisite:</h2>
+ Prior to compile and run Virtual LOGLAN Processor you should install
+ the QT library <font color="#cc0000">qt-1.45</font>.(You may consult the
+file "inst/LICENSE.QT" for more informations about the QT. <br>
+If your system does not contain the library qt-1.45 (nowadays most systems
+contains a newer, yet incompatible version of qt library)<br>
+Read the file <br>
+ <font color="#000099">installQT.html</font> <br>
+ and follow the instructions contained there.<br>
+ <br>
+ <br>
+
+<h2>Installation:</h2>
+<ol>
+ <li>Create an empty directory e.g. <br>
+ /usr/local/vlp.build</li>
+ <li>Put the file <br>
+ vlp26.tgz<br>
+in this directory.</li>
+ <li>Extract the files executing e.g<br>
+ gunzip vlp26.tgz<br>
+ tar -xvf vlp26.tar</li>
+ <li> First, you MUST edit the file "<font color="#990000">Dir</font>"
+ and set the proper directories: <br>
+QINC - directory where the QT library includes are stored, usually, /usr/lib/qt-1.45/include<br>
+ QLIB - directory where you have your QT library, usually, /usr/lib/qt-1.45/lib<br>
+ MOCDIR - QT library has a special compiler named "moc", write
+the directory where this compiler is stored, usually, /usr/lib/qt-1.45/bin<br>
+ INSTALLDIR - directory where the Virtual LOGLAN Processor will be
+ installed e.g.<br>
+ /usr/local/vlp.</li>
+ <li> Next, run the following:<br>
+ <font color="#cc0000">./configure</font> <br>
+ to configure source files, </li>
+ <li>execute <br>
+ <font color="#cc0000">make </font> <br>
+ to build VLP and </li>
+ <li>execute <br>
+ <font color="#cc0000">make install </font> <br>
+ to install Virtual LOGLAN Processor.</li>
+ <li>Now you should configure your "vlp.cfg" file which is stored in the
+ instalation directory. <br>
+Assure that the variable node_number has different value on each computer
+you installed VLP. <br>
+This is <i>required</i> to identify the nodes of virtual distributed Loglan
+multiprocessor. </li>
+ <li>WARNING! Variable "homedir" should point to the directory where you
+ have program "logker" installed. This MUST be a full path !!!<br>
+ something like<br>
+ /usr/local/vlp</li>
+ <li>If everything went smoothly and your VLP works correctly you may wish
+to delete the directory <br>
+ /usr/local/vlp.build<br>
+ </li>
+
+</ol>
+ <br>
+
+</body>
+</html>
--- /dev/null
+### Includes for QT library
+QINC=/usr/lib/qt-1.45/include
+
+### QT library directory
+QLIB=/usr/lib/qt-1.45/lib
+
+### moc compiler directory
+MOCDIR=/usr/lib/qt-1.45/bin
+
+### Install directory
+INSTALLDIR=/usr/local/vlp
+
+
+all:
+ cd graph; $(MAKE)
+ cd net; $(MAKE)
+ cd kernel; $(MAKE)
+ cd int; $(MAKE)
+ cd edit; $(MAKE)
+ cd lgconfig; $(MAKE)
+ cd preproc; $(MAKE)
+ cd help; $(MAKE)
+
+clean:
+ cd graph; $(MAKE) clean
+ cd net; $(MAKE) clean
+ cd kernel; $(MAKE) clean
+ cd int; $(MAKE) clean
+ cd edit; $(MAKE) clean
+ cd lgconfig; $(MAKE) clean
+ cd preproc; $(MAKE) clean
+ cd help; $(MAKE) clean
+
+install:
+ rm -r -f $(INSTALLDIR)
+ mkdir $(INSTALLDIR)
+ mkdir $(INSTALLDIR)/doc
+ mkdir $(INSTALLDIR)/pics
+ mkdir $(INSTALLDIR)/modules
+ mkdir $(INSTALLDIR)/config
+ mkdir $(INSTALLDIR)/compile
+ mkdir $(INSTALLDIR)/doc/lang
+ mkdir $(INSTALLDIR)/examp
+ cp -r examp/* $(INSTALLDIR)/examp
+ cp inst/loglan $(INSTALLDIR)/compile
+ cp inst/gen $(INSTALLDIR)/compile
+ cp preproc/logcomp $(INSTALLDIR)/compile
+ cp inst/logo.bmp $(INSTALLDIR)/config
+ cp lgconfig/lgconfig $(INSTALLDIR)/config
+ cp -r doc/* $(INSTALLDIR)/doc
+ cp net/lognet $(INSTALLDIR)/modules
+ cp int/logint $(INSTALLDIR)/modules
+ cp graph/loggraph $(INSTALLDIR)/modules
+ cp edit/logedit $(INSTALLDIR)/modules
+ cp inst/close.bmp $(INSTALLDIR)/pics
+ cp kernel/logker $(INSTALLDIR)
+ cp help/loghelp $(INSTALLDIR)/modules
+ cp inst/LICENSE.GNU $(INSTALLDIR)
+ cp inst/LICENSE.QT $(INSTALLDIR)
+ echo node_number=1 > $(INSTALLDIR)/vlp.cfg
+ echo type=explicit >> $(INSTALLDIR)/vlp.cfg
+ echo homedir=$(INSTALLDIR) >> $(INSTALLDIR)/vlp.cfg
+ echo progdir=./ >> $(INSTALLDIR)/vlp.cfg
+ chmod a+rwx $(INSTALLDIR)
+ chmod a+rx $(INSTALLDIR)/doc
+ chmod a+rx $(INSTALLDIR)/pics
+ chmod a+rwx $(INSTALLDIR)/modules
+ chmod a+rx $(INSTALLDIR)/config
+ chmod a+rwx $(INSTALLDIR)/compile
+ chmod a+rx $(INSTALLDIR)/doc/lang
+ chmod a+rwx $(INSTALLDIR)/examp
+ chmod a+rx $(INSTALLDIR)/logker
+ chmod a+rx $(INSTALLDIR)/modules/*
+ chmod a+rx $(INSTALLDIR)/compile/*
--- /dev/null
+#!/bin/sh
+
+cat Dir graph/mfile > graph/Makefile
+cat Dir net/mfile > net/Makefile
+
+cat Dir kernel/mfile > kernel/Makefile
+cat Dir lgconfig/mfile > lgconfig/Makefile
+cat Dir edit/mfile > edit/Makefile
+cat Dir preproc/mfile > preproc/Makefile
+cat Dir help/mfile > help/Makefile
+cat Dir ./mfile > ./Makefile
--- /dev/null
+<HTML>
+<HEAD>
+</HEAD>
+<BODY>
+<B>Class ANSI</B><BR>
+Class <B> ANSI </B> implements simple operations in the text mode.
+<UL>
+<LI> unit <B>GotoXY</B>:procedure(x,y:integer)<BR>
+Moves the text cursor to the position (x,y)
+<LI> unit <B>SetColor</B>:procedure(color:integer)<BR>
+Sets the foreground color for text writing.
+<LI> unit <B>SetBackground</B>:procedure(color:integer)<BR>
+Sets the background color for text writing.
+<LI> unit <B>Bold</B>:procedure<BR>
+Sets the font to bold font.
+<LI> unit <B>Normal</B>:procedure<BR>
+Sets the font to normal font.
+<LI> unit <B>Clear</B>:procedure<BR>
+Clears terminal.
+</UL>
+<HR>
+<A HREF="index.html">Return to Index</A>
+</BODY>
+</HTML>
--- /dev/null
+<HTML>
+<HEAD></HEAD>
+<BODY>
+<B> class GUI - Graphic User Interface </B>
+<HR>
+<UL>
+<LI> <A HREF="gui1.html"> GUI procedures and functions </A>
+<LI> <A HREF="gui2.html"> GUI constants and variables </A>
+</UL>
+
+</BODY>
+</HTML>
--- /dev/null
+<HTML>
+<HEAD></HEAD>
+<BODY>
+<B>GUI procedures and functions </B> <HR>
+<UL>
+<LI>unit <B>GUI_Clear</B>:procedure;<BR>
+Clears the screen.
+<BR>
+<LI>unit <B>GUI_ClearArea</B>:procedure(x1,y1,w,h:integer);<BR>
+Clears a rectangular area.<BR>
+(x1,y1) - left corner of the rectangle<BR>
+w - rect width<BR>
+h - rect height<BR>
+<LI>unit <B>GUI_Point</B>:procedure(x,y,col:integer);<BR>
+Draws a point at (x,y) with the color col.<BR>
+<LI>unit <B>GUI_Move</B>:procedure(x,y:integer);<BR>
+Moves the graphic cursor to the position (x,y).<BR>
+<LI>unit <B>GUI_Line</B>:procedure(x1,y1,x2,y2,col:integer);
+Draws a line from (x1,y1) to (x2,y2) with the color col.<BR>
+<LI>unit <B>GUI_LineTo</B>:procedure(x,y,col:integer);
+Draws a line from actual position of the graphic cursor to the point
+(x,y) with the color col.<BR>
+<LI>unit <B>GUI_Rect</B>:procedure(x1,y1,x2,y2,fcol,icol:integer);<BR>
+Draws a rectangle.<BR>
+(x1,y1) - left corner<BR>
+(x2,y2) - right corner<BR>
+fcol - frame color<BR>
+icol - interior color<BR>
+<LI>unit <B>GUI_Ellipse</B>:procedure(x,y,a,b,sa,ea,fcol,icol:integer);<BR>
+Draws an ellipse.<BR>
+(x,y) - center point<BR>
+a - horizontal radius<BR>
+b - vertical radius<BR>
+sa - start angle (in degrees)<BR>
+ea - end angle<BR>
+fcol - frame color<BR>
+icol - interior color<BR>
+<LI>unit <B>GUI_WriteInt</B>:procedure(x,y,i,fcol,bcol:integer);<BR>
+Writes integer <I>i</I> at position (x,y).<BR>
+fcol - foreground color<BR>
+bcol - background color<BR>
+<LI>unit <B>GUI_WriteChar</B>:procedure(x,y:integer;c:char;fcol,bcol:integer);<BR>
+Writes character <I>c</I> at position (x,y).<BR>
+fcol - foreground color<BR>
+bcol - background color<BR>
+<LI>unit <B>GUI_WriteReal</B>:procedure(x,y:integer;r:real;fcol,bcol:integer);<BR>
+Writes real <I>r</I> at position (x,y).<BR>
+fcol - foreground color<BR>
+bcol - background color<BR>
+<LI>unit <B>GUI_WriteText</B>:procedure(x,y:integer;t:array_of char;fcol,bcol:integer);<BR>
+Writes text <I>t</I> at position (x,y).<BR>
+fcol - foreground color<BR>
+bcol - background color<BR>
+<LI>unit <B>GUI_ReadText</B>:function(x,y,fcol,bcol:integer):array_of char;<BR>
+Reads text at position (x,y).<BR>
+fcol - foreground color<BR>
+bcol - background color<BR>
+<LI>unit <B>GUI_ReadInt</B>:function(x,y,fcol,bcol:integer):integer;<BR>
+Reads integer at position (x,y).<BR>
+fcol - foreground color<BR>
+bcol - background color<BR>
+<LI>unit <B>GUI_ReadChar</B>:function(x,y,fcol,bcol:integer):char;<BR>
+Reads character at position (x,y).<BR>
+fcol - foreground color<BR>
+bcol - background color<BR>
+<LI>unit <B>GUI_ReadReal</B>:function(x,y,fcol,bcol:integer):real;<BR>
+Reads real at position (x,y).<BR>
+fcol - foreground color<BR>
+bcol - background color<BR>
+<LI>unit <B>GUI_PutImgFile</B>:procedure(x,y:integer;fname:string);<BR>
+Loads the image from file <I>fname</I> (it could be .BMP, .GIF, .XPM file)
+and puts it at position (x,y).<BR>
+<LI>unit <B>GUI_GetImg</B>:function(x,y,w,h:integer):array_of integer;<BR>
+Gets the contents of the screen from position (x,y) and stores them in the array.<BR>
+w - width of the image<BR>
+h - height of the image<BR>
+<LI>unit <B>GUI_PutImg</B>:procedure(x,y:integer;map:array_of integer);<BR>
+Puts an image from <I>map</I> at the position (x,y).<BR>
+<LI>unit <B>GUI_KillImg</B>:procedure(map:array_of integer);<BR>
+Destroys an image from <I>map</I>. (This is a proper procedure to delete
+a map stored by GUI_GetImg!)<BR>
+<LI>unit <B>GUI_MousePressed</B>:MOUSE procedure(INOUT x,y,btn:integer);<BR>
+Checks if the mouse button was pressed.<BR>
+(x,y) - mouse pointer position after press<BR>
+btn - number of the mouse button: 0 - none, 1 - left, 2 - middle, 3 - right<BR>
+<LI>unit <B>GUI_KeyPressed</B>:function:integer;<BR>
+Checks if the key was pressed. Returns the same value as the <B> inkey </B>
+procedure.
+<HR>
+<A HREF="index.html"> Return to Index </A>
+</BODY>
+</HTML>
--- /dev/null
+<HTML>
+<HEAD></HEAD>
+<BODY>
+<B> GUI constants and variables </B>
+<HR>
+<B>Colors:</B><BR>
+<PRE>
+ c_white,c_yellow,c_rose,c_red,
+ c_turq,c_green,c_blue,c_darkgrey,
+ c_lightgrey,c_brown,c_violet, c_darkred,
+ c_darkturq,c_darkgreen,c_darkblue,
+ c_black;
+</PRE>
+<B> Variables:</B>
+<UL>
+<LI> cursor_x - X position of the graphic cursor
+<LI> cursor_y - Y position of the graphic cursor
+</UL>
+<HR>
+<A HREF="index.html"> Return to Index </A>
+</BODY>
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+ <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
+ <META NAME="GENERATOR" CONTENT="Mozilla/4.04 [en] (X11; I; Linux 2.0.0 i586) [Netscape]">
+</HEAD>
+<BODY>
+<B>class IIUWGRAPH:</B>
+<UL>
+<LI>
+<A NAME="#inkey"></A><B>inkey</B></LI>
+</UL>
+<A NAME="inkey"></A><I>unit INKEY:function:integer;</I>
+This function checks for pressed key but
+is not waiting for an input. The key
+code is returned if the key was pressed and 0 if
+not. Special keys return the following codes:
+<PRE>
+F1 = -10 F9 = -18 Right = -26
+F2 = -11 F10 = -19 Up = -27
+F3 = -12 Insert = -20 Down = -28
+F4 = -13 Home = -21 Tab = 9
+F5 = -14 End = -22 Esc = 27
+F6 = -15 PgUp = -23 Backspace = 8
+F7 = -16 PgDown = -24 Del = 117
+F8 = -17 Left = -25
+</PRE>
+
+</BODY>
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+ <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
+ <META NAME="GENERATOR" CONTENT="Mozilla/4.04 [en] (X11; I; Linux 2.0.0 i586) [Netscape]">
+</HEAD>
+<BODY>
+<B>LOGLAN Help Index</B>
+<UL>
+<LI>
+<A HREF="userg.html">Virtual Processor User Guide</A></LI>
+
+<LI>
+<A HREF="langg.html">Language reference</A></LI>
+
+<LI>
+<A HREF="machine.html">class <B>MACHINE</B></A></LI>
+
+<LI>
+<A HREF="ansi.html">class <B>ANSI</B></A></LI>
+
+<LI>
+<A HREF="iiuwgraph.html">class <B>IIUWGRAPH</B></A></LI>
+<LI>
+<A HREF="gui.html"> class <B> GUI </B> </A>
+</UL>
+
+</BODY>
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+ <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
+ <META NAME="GENERATOR" CONTENT="Mozilla/4.04 [en] (X11; I; Linux 2.0.0 i586) [Netscape]">
+</HEAD>
+<BODY>
+
+<HR>Sorry, documentation and help are <B>strictly</B> under construction
+!!!
+<HR>
+<BR><A HREF="index.html">Return to Index</A>
+</BODY>
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+</HEAD>
+<BODY>
+<B> Class MACHINE </B><BR>
+<BR>
+Class <B> Machine </B> is the set of functions designed to
+give informations about Virtual LOGLAN Machine.
+<UL>
+<LI> unit <B>LocalNode</B>:function:integer<BR>
+Returns the ID of local Virtual Processor.
+<LI> unit <B>NodesNum</B>:function:integer<BR>
+Returns the number of Virtual Processors actually available
+in the Machine.<BR>
+Warning! The local VLP is not counted, so function returns
+0 if there are no other Processors.
+<LI> unit <B>NodeExists</B>:function(<I>node</I>:integer):boolean<BR>
+Returns TRUE if the Virtual Processor with the ID equal to the
+<I>node</I> is connected to the Machine.
+<LI> unit <B>MachineInfo</B>:function:NodeInfo<BR>
+This function returns full information about all connected Virtual
+Processors. Information is given as a list of <I>NodeInfo</I>
+structures.<BR>
+The <I>NodeInfo</I> structure is defined in the class Machine
+as follow:
+<PRE>
+unit NodeInfo:class;
+var num:integer, (* an ID of a Virtual Processor *)
+ addr:arrayof char (* IP address of a VLP *)
+ next:NodeInfo (* next structure on the list *)
+end NodeInfo;
+</PRE>
+</UL>
+<HR>
+<A HREF="index.html">Return to Index</A>
+</BODY>
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+ <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
+ <META NAME="GENERATOR" CONTENT="Mozilla/4.04 [en] (X11; I; Linux 2.0.0 i586) [Netscape]">
+</HEAD>
+<BODY>
+
+<HR>Sorry, documentation and help are <B>strictly</B> under construction
+!!!
+<HR>
+<BR><A HREF="index.html">Return to Index</A>
+</BODY>
+</HTML>
--- /dev/null
+### Includes for QT library
+QINC=/usr/lib/qt-1.45/include
+
+### QT library directory
+QLIB=/usr/lib/qt-1.45/lib
+
+### moc compiler directory
+MOCDIR=/usr/lib/qt-1.45/bin
+
+### Install directory
+INSTALLDIR=/usr/local/vlp
+#######
+####### Change the INCDIR, LFLAGS and MOC
+
+INCDIR = $(QINC)
+CFLAGS = -O2 -fno-strength-reduce -Wall -W -I/usr/X11R6/include
+LIBCFLAGS = -fPIC
+YACCCFLAGS = -Wno-unused -Wno-parentheses
+LFLAGS = -L$(QLIB) -lqt
+CC = g++
+MOC = $(MOCDIR)/moc
+SHELL = /bin/sh
+
+
+####### Files
+
+HEADERS = editor.h
+SOURCES = editor.cpp
+OBJECTS = editor.o
+SRCMOC = moc_editor.cpp
+OBJMOC = moc_editor.o
+TARGET = logedit
+
+####### Implicit rules
+
+.SUFFIXES: .cpp .c
+
+.cpp.o:
+ $(CC) -c $(CFLAGS) -I$(INCDIR) -o $@ $<
+
+.c.o:
+ $(CC) -c $(CFLAGS) -I$(INCDIR) -o $@ $<
+
+####### Build rules
+
+all: $(TARGET)
+
+$(TARGET): $(OBJECTS) $(OBJMOC)
+ $(CC) $(OBJECTS) $(OBJMOC) -o $(TARGET) $(LFLAGS)
+
+moc: $(SRCMOC)
+
+clean:
+ -rm -f $(OBJECTS) $(OBJMOC) $(SRCMOC) $(TARGET)
+
+####### Compile
+
+editor.o: editor.cpp \
+ editor.h
+
+
+moc_editor.o: moc_editor.cpp \
+ editor.h
+
+moc_editor.cpp: editor.h
+ $(MOC) editor.h -o moc_editor.cpp
--- /dev/null
+
+
+#include <qapp.h>
+#include <qmenubar.h>
+#include <qpopmenu.h>
+#include <qlabel.h>
+#include <qlistbox.h>
+#include <qfile.h>
+#include <qfiledlg.h>
+#include <qfontmet.h>
+#include <qtooltip.h>
+#include <qfont.h>
+#include <qpixmap.h>
+#include <qmsgbox.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <qscrbar.h>
+#include <qpainter.h>
+#include <qcolor.h>
+#include <qpoint.h>
+#include <qtstream.h>
+#include <qchkbox.h>
+#include <qkeycode.h>
+
+#include "editor.h"
+
+#define TYPENUM 5
+
+
+Editor *e;
+
+
+char *UnitTypes[5] = {"CLASS","PROCEDURE","FUNCTION","PROCESS","COROUTINE"};
+
+
+My_Edit::My_Edit(QWidget *parent=0,const char *name=0)
+: QMultiLineEdit(parent,name)
+{
+}
+
+void My_Edit::keyPressEvent(QKeyEvent *ev)
+{
+ QMultiLineEdit::keyPressEvent(ev);
+ emit cursorMove();
+}
+
+
+Editor::Editor( char *hdir,QWidget * parent , const char * name)
+ : QWidget( parent, name )
+{
+ QFont f1("Helvetica",12,QFont::Bold);
+
+
+ strcpy(HomeDir,hdir);
+ strcpy(find_text,"");
+ sensitive=FALSE;
+ m = new QMenuBar( this, "menu" );
+ m->setFont(f1);
+ QPopupMenu * file = new QPopupMenu();
+ QPopupMenu * comp = new QPopupMenu();
+ QPopupMenu * loglan = new QPopupMenu();
+ QPopupMenu *medit = new QPopupMenu();
+
+ file->setFont(f1);
+ comp->setFont(f1);
+ loglan->setFont(f1);
+ medit->setFont(f1);
+ CHECK_PTR( file );
+ CHECK_PTR( comp );
+ m->insertItem( "&File ", file );
+ m->insertItem( "&Edit", medit );
+ m->insertItem( "&Compile", this,SLOT(cmp()) );
+
+// m->insertItem( "&LOGLAN ", loglan );
+ m->insertItem( "&Properties", this, SLOT(props()));
+
+
+
+
+ file->insertItem( "New ", this, SLOT(create()), CTRL+Key_N);
+ file->insertItem( "Open ", this, SLOT(load()), CTRL+Key_O);
+ file->insertItem( "Save ", this, SLOT(save()),CTRL+Key_S);
+ file->insertItem( "Save as", this, SLOT(save_as()),CTRL+Key_A);
+ file->insertSeparator();
+ file->insertItem( "Quit ", qApp, SLOT(quit()));
+
+// comp->insertItem( "Compile ", this, SLOT(cmp()), CTRL+Key_C);
+// comp->insertItem( "Gen ", this, SLOT(gen()), CTRL+Key_G);
+// comp->insertItem( "Compile & Gen ", this, SLOT(comp_all()));
+
+// loglan->insertItem( "Program structure", this, SLOT(log_prog()));
+// loglan->insertItem( "Unit structure", this, SLOT(log_unit()));
+
+
+
+ e = new My_Edit( this, "editor" );
+ connect(e,SIGNAL(cursorMove()),this,SLOT(updateline()));
+ medit->insertItem("Copy ",e,SLOT(copyText()),CTRL+Key_Insert);
+ medit->insertItem("Paste ",e,SLOT(paste()), SHIFT+Key_Insert);
+ medit->insertItem("Cut ",e,SLOT(cut()), CTRL+Key_Delete);
+ medit->insertItem("Clear All ",e,SLOT(clear()));
+ medit->insertSeparator();
+ medit->insertItem("Find ",this,SLOT(findText()), CTRL+Key_F);
+ medit->insertItem("Find Next ",this,SLOT(find_next()),CTRL+Key_L);
+
+ msg = new QMultiLineEdit( this, "messages" );
+ msg->setReadOnly(TRUE);
+ compiler_path.sprintf("%s/%s",HomeDir,"compile/logcomp");
+ gen_path.sprintf("%s/%s",HomeDir,"compile/gen");
+ file_path.sprintf("%s",HomeDir);
+
+ QFont f2("Times",14,QFont::Bold);
+ e->setFont(f1);
+ QColor col(200,200,200);
+ QColorGroup grp(black,col,col.light(),col.dark(),col.dark(),black,col);
+
+ msg->setPalette(QPalette(grp,grp,grp));
+ position = new QLabel(this);
+ position->setFont(f2);
+ position->setFrameStyle(QFrame::NoFrame);
+ position->setAutoResize(TRUE);
+ resize(400,300);
+
+}
+
+
+Editor::~Editor()
+{
+
+}
+
+
+
+
+void Editor::updateline()
+{
+ char pom[255];
+ int cx,cy;
+
+ e->getCursorPosition(&cx,&cy);
+ sprintf(pom," %d:%d ",cx,cy);
+ position->setText(pom);
+}
+
+void Editor::resizeEvent( QResizeEvent * )
+{
+ if ( e && m )
+ {
+ e->setGeometry( 0, m->height(), width(), 3*(int)(( height() - m->height() )/4) );
+ msg->setGeometry( 0, m->height()+ e->height(), width(), (int)(( height() - m->height() )/4) );
+ position->setGeometry(width()-80,m->height()+ e->height()-10,
+ position->width(),position->height());
+ }
+}
+
+
+void Editor::load()
+{
+ QString fn = QFileDialog::getOpenFileName(file_path.data(),"*.log");
+ if ( !fn.isEmpty() )
+ load( fn );
+}
+
+
+void Editor::load( const char *fileName )
+{
+ fname.sprintf("%s",fileName);
+
+
+ QFile f( fileName );
+ if ( !f.open( IO_ReadOnly ) )
+ return;
+
+ e->setAutoUpdate( FALSE );
+ e->clear();
+
+ QTextStream t(&f);
+ while ( !t.eof() ) {
+ QString s = t.readLine();
+ e->append( s );
+ }
+ f.close();
+
+ e->setAutoUpdate( TRUE );
+ e->repaint();
+ setCaption( fileName );
+}
+
+
+void Editor::save()
+{
+ if (fname.isEmpty())
+ {
+ QString fn = QFileDialog::getSaveFileName(file_path.data(),"*.log");
+ if ( !fn.isEmpty() )
+ {
+ fname.sprintf("%s",fn.data());
+ save( fn );
+ }
+ }
+ else
+ save(fname);
+ setCaption(fname);
+}
+
+void Editor::save_as()
+{
+ QString fn = QFileDialog::getSaveFileName(file_path.data(),"*.log");
+ if ( !fn.isEmpty() )
+ {
+ fname.sprintf("%s",fn.data());
+ save( fn );
+ }
+ setCaption(fname);
+}
+
+void Editor::save(const char *fileName)
+{
+
+ QFile f(fileName);
+ if (!f.open(IO_WriteOnly)) return;
+ f.reset();
+ f.writeBlock( e->text().data(),e->text().size() );
+ f.close();
+
+
+}
+
+
+void Editor::create()
+{
+ e->clear();
+ fname.sprintf("%s","");
+}
+
+
+void Editor::print()
+{
+
+}
+
+
+
+void Editor::cmp()
+{
+ save();
+ compile(COMP_MODE);
+}
+
+void Editor::gen()
+{
+ compile(GEN_MODE);
+}
+
+void Editor::comp_all()
+{
+ save();
+ compile(ALL_MODE);
+}
+
+
+void Editor::compile(int mode)
+{
+ char cmd[255];
+
+ msg->setAutoUpdate( FALSE );
+ msg->setReadOnly(FALSE);
+ msg->clear();
+ msg->repaint();
+
+
+ //i = fname.find('.');
+// if (i>=0)
+ {
+ QString fn = fname.data();
+// fn.truncate(i);
+
+ switch(mode)
+ {
+
+ case COMP_MODE:
+ sprintf(cmd,"%s %s > comp_data!",compiler_path.data(),fname.data());
+ break;
+ case GEN_MODE:
+ sprintf(cmd,"%s %s > comp_data!",gen_path.data(),fn.data());
+ break;
+ case ALL_MODE:
+ sprintf(cmd,"%s %s > comp_data!",compiler_path.data(),fn.data());
+ system(cmd);
+ sprintf(cmd,"%s %s >> comp_data!",gen_path.data(),fn.data());
+ break;
+
+ } /*switch */
+
+ system(cmd);
+ QFile f( "comp_data!" );
+ if ( !f.open( IO_ReadOnly ) )
+ return;
+
+
+ QTextStream t(&f);
+ while ( !t.eof() ) {
+ QString s = t.readLine();
+ msg->append( s );
+ }
+ f.close();
+ msg->setReadOnly(TRUE);
+ msg->setAutoUpdate( TRUE );
+ msg->repaint();
+ unlink("comp_data!");
+ }
+}
+
+
+
+void Editor::props()
+{
+ QDialog dlg(this,"Properties",TRUE);
+
+
+ QLineEdit* files;
+ files = new QLineEdit( &dlg, "f_path" );
+ files->setGeometry( 130, 20, 250, 30 );
+ files->setText( file_path.data() );
+ files->setMaxLength( 32767 );
+ files->setEchoMode( QLineEdit::Normal );
+ files->setFrame( TRUE );
+
+ QLabel* tmpQLabel;
+ tmpQLabel = new QLabel( &dlg, "Label_1" );
+ tmpQLabel->setGeometry( 10, 20, 100, 30 );
+ tmpQLabel->setText( "Path to files:" );
+ tmpQLabel->setAlignment( 289 );
+ tmpQLabel->setMargin( -1 );
+
+ tmpQLabel = new QLabel( &dlg, "Label_2" );
+ tmpQLabel->setGeometry( 10, 60, 100, 30 );
+ tmpQLabel->setText( "Path to compiler:" );
+ tmpQLabel->setAlignment( 289 );
+ tmpQLabel->setMargin( -1 );
+
+/* tmpQLabel = new QLabel( &dlg, "Label_3" );
+ tmpQLabel->setGeometry( 10, 100, 100, 30 );
+ tmpQLabel->setText( "Path to gen:" );
+ tmpQLabel->setAlignment( 289 );
+ tmpQLabel->setMargin( -1 );*/
+
+ QLineEdit* compp;
+ compp = new QLineEdit( &dlg, "l_path" );
+ compp->setGeometry( 130, 60, 250, 30 );
+ compp->setText( compiler_path.data() );
+ compp->setMaxLength( 32767 );
+ compp->setEchoMode( QLineEdit::Normal );
+ compp->setFrame( TRUE );
+
+/* QLineEdit* genp;
+ genp = new QLineEdit( &dlg, "g_path" );
+ genp->setGeometry( 130, 100, 250, 30 );
+ genp->setText( gen_path.data() );
+ genp->setMaxLength( 32767 );
+ genp->setEchoMode( QLineEdit::Normal );
+ genp->setFrame( TRUE );*/
+
+
+ QPushButton* tmpQPushButton;
+ tmpQPushButton = new QPushButton( &dlg, "OkBtn" );
+ tmpQPushButton->setGeometry( 90, 100, 70, 30 );
+ tmpQPushButton->setText( "Ok" );
+ tmpQPushButton->setAutoRepeat( FALSE );
+ tmpQPushButton->setAutoResize( FALSE );
+ connect(tmpQPushButton,SIGNAL(clicked()),&dlg,SLOT(accept()));
+
+ tmpQPushButton = new QPushButton( &dlg, "CancelBtn" );
+ tmpQPushButton->setGeometry( 180, 100, 70, 30 );
+ tmpQPushButton->setText( "Cancel" );
+ tmpQPushButton->setAutoRepeat( FALSE );
+ tmpQPushButton->setAutoResize( FALSE );
+ connect(tmpQPushButton,SIGNAL(clicked()),&dlg,SLOT(reject()));
+ dlg.resize(400,140);
+
+ if (dlg.exec())
+ {
+ compiler_path.sprintf("%s",compp->text());
+// gen_path.sprintf("%s",genp->text());
+ file_path.sprintf("%s",files->text());
+ };
+ }
+
+/* --------------------------------------- */
+
+
+
+
+
+void Editor::log_unit()
+{
+ QString txt;
+ QDialog dlg(this,"unit",TRUE);
+ int cx,cy,i;
+ char uname[255];
+
+
+ QLineEdit* files;
+ files = new QLineEdit( &dlg, "f_path" );
+ files->setGeometry( 130, 20, 250, 30 );
+ files->setText("" );
+ files->setMaxLength( 32767 );
+ files->setEchoMode( QLineEdit::Normal );
+ files->setFrame( TRUE );
+
+ QLabel* tmpQLabel;
+ tmpQLabel = new QLabel( &dlg, "Label_1" );
+ tmpQLabel->setGeometry( 10, 20, 100, 30 );
+ tmpQLabel->setText( "Unit name:" );
+ tmpQLabel->setAlignment( 289 );
+ tmpQLabel->setMargin( -1 );
+
+ QPushButton* tmpQPushButton;
+ tmpQPushButton = new QPushButton( &dlg, "OkBtn" );
+ tmpQPushButton->setGeometry( 40, 170, 70, 30 );
+ tmpQPushButton->setText( "Ok" );
+ tmpQPushButton->setAutoRepeat( FALSE );
+ tmpQPushButton->setAutoResize( FALSE );
+ connect(tmpQPushButton,SIGNAL(clicked()),&dlg,SLOT(accept()));
+
+ tmpQPushButton = new QPushButton( &dlg, "CancelBtn" );
+ tmpQPushButton->setGeometry( 130, 170, 100, 30 );
+ tmpQPushButton->setText( "Cancel" );
+ tmpQPushButton->setAutoRepeat( FALSE );
+ tmpQPushButton->setAutoResize( FALSE );
+ connect(tmpQPushButton,SIGNAL(clicked()),&dlg,SLOT(reject()));
+
+ tmpQLabel = new QLabel( &dlg, "Label_1" );
+ tmpQLabel->setGeometry( 10, 50, 100, 60 );
+ tmpQLabel->setText( "Unit type:" );
+
+
+ QListBox lst(&dlg,"type");
+ for(i=0;i<TYPENUM;i++) lst.insertItem(UnitTypes[i]);
+ lst.setGeometry(130,60,180,80);
+ lst.setCurrentItem(0);
+
+ if (dlg.exec())
+ {
+ strcpy(uname,files->text());
+ e->getCursorPosition(&cx,&cy);
+
+ txt.sprintf("UNIT %s : %s( <params> );\nBEGIN\n\nEND %s;",uname,
+ lst.text(lst.currentItem()), uname);
+ e->insertAt(txt,cx,cy);
+ };
+}
+
+
+void Editor::log_prog()
+{
+ QString txt;
+ QDialog dlg(this,"unit",TRUE);
+ int cx,cy;
+ char uname[255];
+
+
+ QLineEdit* files;
+ files = new QLineEdit( &dlg, "f_path" );
+ files->setGeometry( 130, 20, 250, 30 );
+ files->setText("" );
+ files->setMaxLength( 32767 );
+ files->setEchoMode( QLineEdit::Normal );
+ files->setFrame( TRUE );
+
+ QLabel* tmpQLabel;
+ tmpQLabel = new QLabel( &dlg, "Label_1" );
+ tmpQLabel->setGeometry( 10, 20, 100, 30 );
+ tmpQLabel->setText( "Program name:" );
+
+ QPushButton* tmpQPushButton;
+ tmpQPushButton = new QPushButton( &dlg, "OkBtn" );
+ tmpQPushButton->setGeometry( 40, 70, 70, 30 );
+ tmpQPushButton->setText( "Ok" );
+ tmpQPushButton->setAutoRepeat( FALSE );
+ tmpQPushButton->setAutoResize( FALSE );
+ connect(tmpQPushButton,SIGNAL(clicked()),&dlg,SLOT(accept()));
+
+ tmpQPushButton = new QPushButton( &dlg, "CancelBtn" );
+ tmpQPushButton->setGeometry( 130, 70, 100, 30 );
+ tmpQPushButton->setText( "Cancel" );
+ tmpQPushButton->setAutoRepeat( FALSE );
+ tmpQPushButton->setAutoResize( FALSE );
+ connect(tmpQPushButton,SIGNAL(clicked()),&dlg,SLOT(reject()));
+
+
+ if (dlg.exec())
+ {
+ strcpy(uname,files->text());
+ e->getCursorPosition(&cx,&cy);
+
+ txt.sprintf("PROGRAM %s\n\nBEGIN\n\nEND ",uname);
+ e->insertAt(txt,cx,cy);
+ };
+
+}
+
+
+void Editor::findText()
+{
+ QDialog dlg(this,"",TRUE);
+ QString *txt;
+ int res,line,pom;
+
+
+ QLineEdit* tmpQLineEdit;
+ tmpQLineEdit = new QLineEdit( &dlg, "LineEdit_1" );
+ tmpQLineEdit->setGeometry( 60, 10, 180, 30 );
+ tmpQLineEdit->setText( "" );
+
+ QLabel* tmpQLabel;
+ tmpQLabel = new QLabel( &dlg, "Label_1" );
+ tmpQLabel->setGeometry( 10, 10, 50, 30 );
+ {
+ QFont font( "helvetica", 12, 75, 0 );
+ font.setStyleHint( (QFont::StyleHint)0 );
+ font.setCharSet( (QFont::CharSet)0 );
+ tmpQLabel->setFont( font );
+ }
+ tmpQLabel->setText( "Text:" );
+
+ QCheckBox* tmpQRadioButton;
+ tmpQRadioButton = new QCheckBox( &dlg, "RadioButton_1" );
+ tmpQRadioButton->setGeometry( 70, 50, 150, 30 );
+ tmpQRadioButton->setText( "Case sensitive" );
+ tmpQRadioButton->setAutoRepeat( FALSE );
+ tmpQRadioButton->setAutoResize( FALSE );
+
+ QPushButton *okbtn, *cbtn;
+ okbtn = new QPushButton( &dlg, "PushButton_1" );
+ okbtn->setGeometry( 260, 10, 100, 30 );
+ okbtn->setText( "Find" );
+ okbtn->setDefault(TRUE);
+ connect(okbtn,SIGNAL(clicked()),&dlg,SLOT(accept()));
+
+ cbtn = new QPushButton( &dlg, "PushButton_2" );
+ cbtn->setGeometry( 260, 50, 100, 30 );
+ cbtn->setText( "Close" );
+ connect(cbtn,SIGNAL(clicked()),&dlg,SLOT(reject()));
+ dlg.resize( 380, 90 );
+
+ if (dlg.exec())
+ {
+ e->getCursorPosition(&pom,&res);
+ sensitive=tmpQRadioButton->isChecked();
+ for(line=pom+1;line<e->numLines();line++)
+ {
+ txt = new QString(e->textLine(line));
+ if (tmpQRadioButton->isChecked())
+ res=txt->find(tmpQLineEdit->text(),0,TRUE);
+ else
+ res=txt->find(tmpQLineEdit->text(),0,FALSE);
+ delete txt;
+ if (res>=0) { e->setCursorPosition(line,1);strcpy(find_text,tmpQLineEdit->text());
+ break;}
+ } //for
+ }
+
+}
+
+void Editor::find_next()
+{
+ int pom,res,line;
+ QString *txt;
+
+ e->getCursorPosition(&pom,&res);
+ for(line=pom+1;line<e->numLines();line++)
+ {
+ txt = new QString(e->textLine(line));
+ if (sensitive)
+ res=txt->find(find_text,0,TRUE);
+ else
+ res=txt->find(find_text,0,FALSE);
+ delete txt;
+ if (res>=0) { e->setCursorPosition(line,1);
+ break;}
+ } //for
+
+}
+
+int main( int argc, char **argv )
+{
+ QApplication a( argc, argv );
+ a.setStyle(WindowsStyle);
+ e = new Editor(argv[1]);
+ e->resize( 600, 400 );
+ e->show();
+ return a.exec();
+}
+
--- /dev/null
+
+#ifndef QWERTY_H
+#define QWERTY_H
+
+#include <qwidget.h>
+#include <qmenubar.h>
+#include <qmlined.h>
+#include <qlist.h>
+#include <qstrlist.h>
+#include <qframe.h>
+#include <qmlined.h>
+#include <qlined.h>
+#include <qpushbt.h>
+#include <qcombo.h>
+#include <qlabel.h>
+
+
+#define COMP_MODE 1
+#define GEN_MODE 2
+#define ALL_MODE 3
+
+
+
+typedef struct FuncEntry
+{
+ char name[255],filename[255];
+};
+
+typedef struct CategoryEntry
+{
+ QList<FuncEntry> dictionary;
+ QStrList names;
+ char name[255];
+};
+
+
+
+
+class My_Edit:public QMultiLineEdit
+{
+Q_OBJECT
+public:
+ My_Edit(QWidget *parent=0,const char *name=0);
+ virtual void keyPressEvent(QKeyEvent *ev);
+signals:
+ void cursorMove();
+};
+
+class Editor : public QWidget
+{
+ Q_OBJECT
+public:
+ QString compiler_path;
+ QString gen_path;
+ QString file_path;
+
+ Editor(char *hdir=0, QWidget *parent=0, const char *name=0);
+ ~Editor();
+
+ void compile(int mode);
+
+public slots:
+ void load();
+ void load( const char *fileName );
+ void save();
+ void save( const char *fileName );
+ void save_as();
+ void create();
+ void props();
+ void print();
+ void cmp();
+ void gen();
+ void comp_all();
+
+ void log_unit();
+ void log_prog();
+
+ void findText();
+ void find_next();
+// void gotoline();
+ void updateline();
+
+protected:
+ void resizeEvent( QResizeEvent * );
+
+private:
+ QMenuBar *m;
+ My_Edit *e;
+ QMultiLineEdit *msg;
+ QLabel *position;
+ QString fname;
+ char find_text[256];
+ bool sensitive;
+ char HomeDir[255];
+
+};
+
+
+#endif // QWERTY_H
--- /dev/null
+#######
+####### Change the INCDIR, LFLAGS and MOC
+
+INCDIR = $(QINC)
+CFLAGS = -O2 -fno-strength-reduce -Wall -W -I/usr/X11R6/include
+LIBCFLAGS = -fPIC
+YACCCFLAGS = -Wno-unused -Wno-parentheses
+LFLAGS = -L$(QLIB) -lqt
+CC = g++
+MOC = $(MOCDIR)/moc
+SHELL = /bin/sh
+
+
+####### Files
+
+HEADERS = editor.h
+SOURCES = editor.cpp
+OBJECTS = editor.o
+SRCMOC = moc_editor.cpp
+OBJMOC = moc_editor.o
+TARGET = logedit
+
+####### Implicit rules
+
+.SUFFIXES: .cpp .c
+
+.cpp.o:
+ $(CC) -c $(CFLAGS) -I$(INCDIR) -o $@ $<
+
+.c.o:
+ $(CC) -c $(CFLAGS) -I$(INCDIR) -o $@ $<
+
+####### Build rules
+
+all: $(TARGET)
+
+$(TARGET): $(OBJECTS) $(OBJMOC)
+ $(CC) $(OBJECTS) $(OBJMOC) -o $(TARGET) $(LFLAGS)
+
+moc: $(SRCMOC)
+
+clean:
+ -rm -f $(OBJECTS) $(OBJMOC) $(SRCMOC) $(TARGET)
+
+####### Compile
+
+editor.o: editor.cpp \
+ editor.h
+
+
+moc_editor.o: moc_editor.cpp \
+ editor.h
+
+moc_editor.cpp: editor.h
+ $(MOC) editor.h -o moc_editor.cpp
--- /dev/null
+ PROGRAM Geometria;
+ #include "classes/gui.inc"
+(*Program ma pokazac dzialanie algorytmow geometrycznych *)
+(* o ktorych mowilam na wykladzie*)
+
+ signal ERROR_exec;
+ CONST
+
+ MinX = 0,
+ MinY = 0,
+ MaxX = 640,
+ MaxY = 480,
+ comX = 30,
+ comY = 440,
+ sz = 30, (*szerokosc paska menu*)
+ my_ecranMinX = MinX+5,
+ my_ecranMinY = MinY+sz+3,
+ my_ecranMaxX= MaxX-5,
+ my_ecranMaxY= MaxY-(2*sz+1),
+ exit_posX = 550,
+ exit_posY = 420,
+ help_posX = 20,
+ help_posY = 50,
+ grubosc = 2,
+ maly = 1;
+
+
+(*------------------------------------------------------------------------*)
+
+(*------------------------------------------------------------------------*)
+(* klasa definiujaca procedury graficzne *)
+(*------------------------------------------------------------------------*)
+ UNIT graphics : GUI CLASS;
+
+
+ UNIT pauza : PROCEDURE(JakDlugo:integer);
+ var i : integer;
+ BEGIN
+ for i :=1 to JakDlugo do i:=i od;
+ END pauza;
+
+
+ UNIT waitt : PROCEDURE;
+ (* wait for a key *)
+ BEGIN
+ While GUI_KeyPressed=/= 0 DO OD;
+ END waitt;
+
+ UNIT clear_all : procedure;
+ begin
+ call GUI_Rect(my_ecranMinX, my_ecranMinY, my_ecranMaxX,
+ my_EcranMaxY,c_DarkGrey,c_LightGrey);
+ call GUI_Rect(my_EcranMinX, MaxY-2*sz,
+ my_EcranMaxX,MaxY-5,c_DarkGrey,c_DarkGrey);
+ end clear_all;
+
+ UNIT clear : PROCEDURE(x0,y0,x1,y1,c1,c2: integer);
+ (* wymaz wszystko w prostokacie (x0,y0)-(y1,y1) *)
+ (* Zostaw ekran w kolorze c2*)
+ var i,j,x,y : integer;
+ BEGIN
+ x := (x1-x0) div 2;
+ y := (y1-y0) div 2;
+ i :=0; j :=0;
+ while i<=x and j<=y do
+ call GUI_Rect(x0+i,y0+j,x1-i,y1-j,c_black,c_lightGrey);
+ i := i+1; j := j+1;
+ od;
+ while i>=0 and j>=0 do
+ call GUI_Rect(x0+i,y0+j,x1-i,y1-j,c1,c2);
+ i := i-1; j :=j-1
+ od;
+ END clear;
+
+
+(**************************************************************************)
+
+ UNIT katy : procedure(col1,col2,x,y,u,v,grubosc: integer);
+ var i : integer;
+ BEGIN
+ for i :=0 to grubosc
+ do
+ call GUI_Line(x+i,y+i,u-i,y+i, col1);
+ call GUI_Line(x+i,y+i,x+i,v-i, col1)
+ od;
+ for i :=0 to grubosc
+ do
+ call GUI_Line(u-i,v-i,x+i,v-i,col2);
+ call GUI_Line(u-i,v-i,u-i,y+i, col2);
+ od;
+ END katy;
+
+
+ unit comment: procedure(ss:string);
+ begin
+ call GUI_Rect(minX+4,maxY-2*sz,maxX-4,maxY-10,c_darkGrey,c_darkGrey);
+ (* wymazanie obszaru pod komentarze *)
+ call GUI_writeText(comX+10,comY,unpack(ss),c_white,c_darkGrey);
+ end comment;
+
+ unit YES : function : boolean;
+ var c : char;
+ begin
+ while (c <> 'y' and c<> 'Y' and c <> 'n' and c<> 'N' ) do
+ call GUI_move(comX,comY);
+ c:= GUI_ReadChar(comX,comY,c_turq,c_lightGrey) od;
+ if (c= 'y' or c='Y') then
+ result := true else result := false
+ fi;
+ end YES;
+
+ END graphics;
+(*************************************************************************)
+
+ BEGIN
+ pref GRAPHICS block
+
+
+(*-----------------------------------------------------------------------*)
+
+(* M E N U *)
+(*-----------------------------------------------------------------------*)
+ unit option : class(nb : integer);
+ var Nom : arrayof string;
+ unit virtual action : procedure(j : integer);
+ begin
+ end action;
+ begin
+ array Nom dim (1:nb);
+ inner;
+ end option;
+
+ unit ikona : class(c,x,y,u,v,grubosc : integer, ss : string);
+ var sub_menu : menu;
+ unit write_i : procedure;
+ var i: integer;
+ begin
+ call GUI_Rect(x,y,u,v,c_black,c);
+ call katy(c_white,c_darkGrey,x,y,u,v,grubosc);
+ call GUI_writeText(x+grubosc+3,y+(v-y)div 2 - 5 ,unpack(ss),c_black,c)
+ end write_i;
+
+ unit wymaz : procedure;
+ begin
+ call GUI_Rect(x,y,u,v,c_black,c_lightGrey);
+ end wymaz;
+
+ unit push : procedure;
+ (* nacisniecie wybranej ikony *)
+ begin
+ call katy(c_darkGrey,c_white,x,y,u,v,grubosc);
+ call pauza(200);
+ call katy (c_white,c_darkGrey,x,y,u,v,grubosc);
+ call pauza(200);
+ end push;
+
+ unit inactive : procedure;
+ begin
+ call katy(c_white,c_darkGrey,x,y,u,v,grubosc);
+ call pauza(500);
+ call katy (c_darkGrey,c_white,x,y,u,v,grubosc);
+ call pauza(500);
+ end inactive;
+ end ikona;
+
+ unit CZY : function(xx,yy:integer,IC:Ikona): boolean;
+ begin (* czy mysz nacisnieta w polozeniu ikony IC *)
+ result := (IC.x<xx and xx<IC.u
+ and IC.y<yy and yy<IC.v)
+ end CZY;
+
+
+ unit menu : coroutine(minX,maxX,MinY,MaxY :integer, OPTIONS :option);
+ (* sz szerokosc paska ikon *)
+ var ICONES: arrayof IKONA, i,j,nb, x1, y1, dl : integer,
+ l,r,z,
+ col,xx,yy : integer,
+ boo : boolean;
+ (* dl and sz - wymiary ikon w tym menu *)
+
+ unit instalation : procedure;
+ (* rysowanie menu oraz jego ikon *)
+ var i : integer;
+ begin
+ call GUI_Rect(minX,minY,maxX,maxY,c_black,c_lightGrey);
+ (* duzy obszar szary *)
+
+ call GUI_Rect(minX+4,maxY-(2*sz),maxX-4,maxY-4,c_black,c_darkGrey);
+ (*obszar dla komentarzy*)
+ for i := 1 to nb
+ do
+ call ICONES(i).write_i
+ od;
+ end instalation;
+
+ unit INI : procedure;
+ var x,y,u,v : integer;
+ BEGIN
+ nb := OPTIONS.nb;
+ dl := (MaxX-Minx) div nb ;
+
+ array ICONES dim(1:nb);
+ x := minX+2; y := minY+2;
+ u := minX+dl-4; v := minY+sz;
+ for i := 1 to nb
+ do
+ ICONES(i) := new ikona(c_lightGrey,x,y,u,v,2,OPTIONS.NOM(i));
+ x := x+dl; u := u+dl;
+ od;
+ end INI;
+handlers
+ when ERROR_exec :
+ call comment(" error exec ");
+ call YES_ikona.write_i;
+ call NO_ikona.write_i;
+ z :=0;
+ while not z=1 do call GUI_MousePressed(xx,yy,z) od;
+ call comment("");
+ (* szukam gdzie zostal nacisniety lewy klawisz myszki*)
+ if CZY(xx,yy,YES_ikona)
+ then
+ call YES_ikona.push;
+ call clear(minX+5,minY+sz+3,maxX-5,maxY-2*sz-1,c_white,c_lightGrey);
+ wind
+ fi;
+ if CZY(xx,yy,NO_ikona)
+ then
+ call NO_ikona.push;
+ call clear(minX+5,minY+sz+3,maxX-5,maxY-2*sz-1,c_white,c_lightGrey);
+ call ENDRUN
+ fi;
+
+
+ others call comment(" ERROR press YES to continue or NO to stop?");
+
+ call YES_ikona.write_i;
+ call NO_ikona.write_i;
+ z :=0;
+ while not z=1 do call GUI_MousePressed(xx,yy,z) od;
+ call comment("");
+ (* szukam gdzie zostal nacisniety lewy klawisz myszki*)
+ if CZY(xx,yy,YES_ikona)
+ then
+ call YES_ikona.push;
+ call clear(minX+5,minY+sz+3,maxX-5,maxY-2*sz-1,c_white ,c_lightGrey);
+ wind
+ fi;
+ if CZY(xx,yy,NO_ikona)
+ then
+ call NO_ikona.push;
+ call clear(minX+5,minY+sz+3,maxX-5,maxY-2*sz-1,c_white ,c_lightGrey);
+ call ENDRUN
+ fi;
+
+end handlers;
+
+ begin
+ call INI;
+ return;
+ do (* obsluga menu *)
+ call instalation; (* rysowanie ikon z tego menu *)
+ do
+ xx, yy,i := 0;
+
+ while i=0 do
+ call GUI_MousePressed(xx,yy,i) ;
+ od;
+
+ (* szukam gdzie zostal nacisniety lewy klawisz myszki *)
+ for j :=1 to nb
+ do
+ if czy(xx,yy,ICONES(j))
+ then
+ call ICONES(j).push;exit;
+ fi;
+ od;
+ if j>0 and j<nb+1
+ then
+ call OPTIONS.Action(j);
+ if j=1 then detach;
+ exit
+ else
+ if ICONES(j).sub_menu<>none then
+ attach(ICONES(j).sub_menu);
+ exit;
+ fi;
+ fi;
+ fi;
+ od;
+ od;
+ end menu;
+
+ unit OPTIONS_MAIN : option class;
+ unit virtual Action : procedure(j : integer);
+ begin (* opcje glownego menu*)
+
+ case j
+ when 1 : call comment("Exit ");
+ when 2 : call comment("Wczytanie danych do problemu otoczki.");
+ call WczytajDane(il_punktow,TAB);
+ when 3 : call comment("Dane do problemu przeciec odcinkow");
+
+ when 4 : call comment("Tu ma byc informacja o algorytmie");
+
+ esac;
+ end action;
+ begin
+ Nom(1) := "EXIT";
+ Nom(2) := "OTOCZKA";
+ Nom(3) := "ODCINKI";
+ Nom(4) := "HELP";
+ end OPTIONS_MAIN;
+
+ unit OPTIONS_OTOCZKA : option class;
+ unit virtual Action : procedure(j : integer);
+ var x: integer, boo : boolean;
+ begin
+ case j
+ when 1 : call comment("RETURN ");
+ when 2 : call GRAHAM(il_punktow,TAB);
+ when 3 : call JARVIS(il_punktow,TAB);
+ when 4 : call TROJKATY(il_punktow,TAB);
+ call clear_all;
+ esac;
+ end action;
+ begin
+ Nom(1) := "RETURN";
+ Nom(2) := "GRAHAM";
+ Nom(3) := "JARVIS";
+ Nom(4) := "TROJKATY";
+ end OPTIONS_OTOCZKA;
+
+
+ unit OPTIONS_help : option class;
+ var ch : char, i:integer;
+ unit virtual Action : procedure(j : integer);
+ begin
+ case j
+ when 1 : call comment(" ");
+ when 2 : call comment("NACISNIJ Y lub N");
+ if YES then call comment("") fi;
+ when 3 : call comment("");
+ esac;
+ end Action;
+ begin
+ NOM(1) := "RETURN";
+ NOM(2) := "NEXT";
+ NOM(3) := "PREV";
+ end OPTIONS_help;
+
+ (*===================================================================*)
+
+ unit WczytajDane : procedure(inout il_punktow:integer,TAB : arrayof punkt);
+ const pminX = 30, pminY =50, pmaxX= 400, pmaxY=200,
+ il_ikon =5;
+ var i ,xx, yy: integer, IK : arrayof IKONA;
+ begin
+
+ array IK dim(1 : il_ikon);
+ call GUI_Rect(pminX,pminY,pmaxX,pmaxY,c_darkGrey,c_green);
+ call GUI_WriteText(pminX+10, pminY+10,unpack("Ilosc punktow = "),
+ c_darkGrey,c_green);
+ call GUI_writeInt(pminX+150,pminY+10,
+ il_punktow, c_darkGrey,c_green);
+ call GUI_WriteText(pminX+10, pminY+45,unpack("Jakosc w % = "),
+ c_darkGrey,c_green);
+
+ IK(1) :=new IKONA (6,pminX+200,pminY+10,pminX+250,pminY+35,3,"PLUS");
+ IK(2) :=new IKONA (6,pminX+260,pminY+10,pminX+310,pminY+35,3,"MINUS");
+ IK(3) :=new IKONA (6,pminX+200,pminY+45,pminX+250,pminY+70,3,"PLUS");
+ IK(4) :=new IKONA (6,pminX+260,pminY+45,pminX+310,pminY+70,3,"MINUS");
+ IK(5) := new IKONA (6,pminX+200,pminY+120,pminX+250,pminY+145,3,"EXIT");
+ for i:=1 to il_ikon do call IK(i).write_i; od;
+ (*badanie ktora ikona zostala nacisnieta*)
+ do
+ xx, yy,i := 0;
+ while i=0 do
+ call GUI_MousePressed(xx,yy,i) ;
+ od;
+
+ (* szukam gdzie zostal nacisniety lewy klawisz myszki *)
+ for i :=1 to il_ikon do
+ if czy(xx,yy,IK(i))
+ then
+ call IK(i).push; exit
+ fi;
+ od;
+ case i
+ when 1 : il_punktow := il_punktow+10;
+
+call GUI_Rect(pminX+150,pminY+10,pminX+180,pminY+25, c_green,c_green);
+call GUI_writeInt(pminX+150,pminY+10,il_punktow, c_darkGrey,c_green);
+ when 2 : il_punktow := il_punktow-10;
+call GUI_Rect(pminX+150,pminY+10, pminX+180,pminY+25, c_green,c_green);
+call GUI_writeInt(pminX+150,pminY+10, il_punktow, c_darkGrey,c_green);
+ when 3 : i := i+1;
+call GUI_Rect(pminX+150,pminY+45, pminX+180,pminY+60, c_green,c_green);
+call GUI_writeInt(pminX+150,pminY+45, i, c_darkGrey,c_green);
+ when 4 : i := i-1;
+call GUI_Rect(pminX+150,pminY+45, pminX+180,pminY+60, c_green,c_green);
+call GUI_writeInt(pminX+150,pminY+45, i, c_darkGrey,c_green);
+ when 5 : exit;
+ esac;
+ od;
+ call comment("Losowanie punktow.");
+ array Tab dim(1: il_punktow);
+ for i :=1 to il_punktow do
+ TAB(i) := new punkt(20+random*600,40+random*360,c_red);
+ od;
+ call comment("");
+ call clear_all;
+ end WczytajDane;
+
+(*-------------------------------------------------------------*)
+ UNIT PokazPunkty : procedure(il_punktow:integer, TAB:arrayof punkt);
+ var i : integer, pp : punkt;
+ begin
+ call clear(minX+5,minY+sz+3,maxX-5,maxY-(2*sz+1),c_yellow,c_blue);
+ for i := 1 to il_punktow do pp:= TAB(i);
+ call pp.rysuj
+ od;
+ end PokazPunkty;
+
+ UNIT WylosujPunkty : procedure(il_punktow:integer; inout Tab:arrayof punkt);
+ var pp : punkt;
+ begin
+ call clear(minX+5,minY+sz+3,maxX-5,maxY-(2*sz+1),c_yellow,c_blue);
+ call comment("Losowanie punktow.");
+ array Tab dim(1: il_punktow);
+ for i :=1 to il_punktow do
+ pp:= new punkt(20+random*600,40+random*360,c_red);
+ TAB(i) := pp
+ od;
+ call comment("");
+ end WylosujPunkty;
+
+ unit INFO : procedure(il,ilb : integer);
+ begin
+ call comment("");
+ call GUI_WriteText( MinX+10, MaxY -50,
+ unpack("ilosc punktow : "), c_red,c_darkGrey);
+ call GUI_WriteInt(MinX+200, MaxY-50,il,c_red,c_darkGrey);
+
+ call GUI_WriteText(MinX+10,MaxY-30,
+ unpack("ilosc bialych"),c_white,c_darkGrey);
+ call GUI_WriteInt(MinX+200, MaxY-30,ilb,c_white,c_darkGrey);
+ call STOP_IKONA.write_i;
+ end INFO;
+(*--------------------------------------------------------------*)
+
+ Unit GRAHAM : procedure(il_punktow: integer, TAB : arrayof punkt);
+ UNIT SORTUJ : procedure(p0:punkt);
+ unit mniejsze : function(p,q:punkt) : boolean;
+ (* q jest na lewo od p0,p *)
+ begin
+ result := false;
+ if q.naLewo(p0,p) then
+ result := true
+ fi;
+ end mniejsze;
+
+ unit pokaz : procedure(c,k:integer);
+ var i : integer;
+ begin
+ for i:=1 to 10 do
+ call GUI_Line (p0.x,p0.y, Tab(k).x,Tab(k).y, c_green ) ;
+ od;
+ call GUI_Line (p0.x,p0.y, Tab(k).x,Tab(k).y, c)
+ end pokaz;
+
+ unit poprawHeap: procedure(k:integer);
+ var i,j : integer, v : punkt;
+ begin
+ v := Tab(k);
+ call pokaz(c_blue,k);
+ while(k<= kk div 2) do
+ j:= 2*k;
+ if j < kk then
+ if mniejsze(Tab(j+1),Tab(j)) then j:=j+1 fi
+ fi;
+ if mniejsze(v,Tab(j)) then exit fi;
+ Tab(k) := Tab(j);
+ k := j
+ od;
+ Tab(k) := v;
+ call pokaz(c_blue,k);
+ end poprawHeap;
+ unit usun : procedure(ii:integer);
+ var p : punkt;
+ begin
+ p:=Tab(ii); Tab(ii):=Tab(1); Tab(1):=p;
+ call PoprawHeap(1);
+ end usun;
+ var i,j, k : integer;
+ BEGIN
+ call comment("sortowanie");
+ for i := kk div 2 downto 1 do
+ call poprawHeap(i)
+ od;
+ call comment(" teraz wynik ");
+ j:= kk;
+ for i :=1 to kk do
+ Wielokat(i) := Tab(1);
+ call pokaz(c_green,1) ;
+ call usun(j);
+ j:= j-1;
+
+ k := 0;
+ call GUI_MousePressed(xx,yy,k);
+ od;
+ END SORTUJ;
+
+ var c, kk,i, lewy,prawy,gora,dol : integer , pp : punkt,
+ Wielokat : arrayof punkt;
+ begin
+ call comment ("ALGORYTM GRAHAMA ");
+ array WIELOKAT dim(1:il_punktow);
+ call PokazPunkty(il_punktow,TAB);
+ call comment(" Punkty do problemu otoczki ");
+ (* uproszczenie: *)
+ (* znajdz punkty najbardziej wysuniete na lewo , na prawo itd*)
+ (* usun punkty wewnetrzne czworokata : dol,gora,lewy, prawy*)
+ dol:=1; gora:=1;
+ lewy:=1; prawy :=1;
+ call STOP_IKONA.write_i;
+ call continue_IKONA.write_i;
+
+ for i :=2 to il_punktow do
+ if TAB(i).y>Tab(dol).y then dol:=i
+ else
+ if TAB(i).y<TAB(gora).y then gora :=i fi
+ fi;
+ if TAB(i).x>Tab(prawy).x then prawy := i
+ else
+ if TAB(i) .x< Tab(lewy).x then lewy := i fi
+ fi;
+ od;
+ Wielokat(1) := TAB(dol);
+ Wielokat(2) := TAB(prawy);
+ Wielokat(3) := TAB(gora);
+ Wielokat(4) := TAB(lewy);
+ (* narysuj czworokat o ekstrmalnych wierzcholkach*)
+ call NarysujWielokat(c_yellow,4,Wielokat);
+ (* usun wszystkie punkty, ktore sa wewnatrz tego wielokata*)
+ call Wnetrze(4,Wielokat,kk);
+ (* kk= il punktow ktore zostaly po usunieciu wnetrza*)
+ call INFO(kk,il_punktow-kk);
+ i := 0;
+ call GUI_MousePressed(xx,yy,i);
+ if i=1 then
+ if CZY(xx, yy,STOP_IKONA) then
+ call STOP_IKONA.push;
+ exit
+ else if CZY(xx,yy,CONTINUE_IKONA) then
+ call CONTINUE_IKONA.push fi
+ fi
+ fi;
+ (*wymazanie wielokata *)
+ call NarysujWielokat(c_blue,4,Wielokat);
+ (*posortuj tablice Tab ze wzgledu na katy *)
+ call SORTUJ(WIELOKAT(1));
+ (* Rysuj boki otoczki *)
+
+ end GRAHAM;
+
+
+
+ UNIT JARVIS : procedure(n:integer,TAB:arrayof punkt);
+ BEGIN
+ END JARVIS;
+
+ UNIT TROJKATY : procedure(n:integer,TAB:arrayof punkt);
+ var Wielokat : arrayof punkt, i,j,k,x,kk :integer;
+ BEGIN
+ call comment ("ALGORYTM - trojkaty ");
+ array WIELOKAT dim(1:n);
+ call PokazPunkty(n,TAB);
+ call comment(" Punkty do problemu otoczki ");
+ for i := 1 to n do
+ WIELOKAT(1):= TAB(i);
+ for j:= i +1 to n do
+ WIELOKAT(2):= TAB(j);
+ for k :=j+1 to n do
+ WIELOKAT(3):= TAB(k);
+ call narysujWielokat(c_red,3,Wielokat);
+ (* narysuj trojkat *)
+ for x:=1 to n do call Wnetrze(3,Wielokat,kk); od;
+ (* sprawdz co jest w srodku *)
+ (*usun srodek*)
+ call narysujWielokat(c_blue,3,Wielokat);
+ od
+ od
+ od;
+ END TROJKATY;
+
+ UNIT NarysujWielokat : procedure(c,n:integer,T: arrayof punkt);
+ var i : integer;
+ BEGIN
+ for i :=2 to n do
+ call GUI_Line(T(i-1).x,T(i-1).y,T(i).x,T(i).y,c);
+ call pauza(500);
+ od;
+ call GUI_Line(T(1).x,T(1).y,T(n).x,T(n).y,c);
+ END NarysujWielokat;
+
+ UNIT WYPISZ_INFO : procedure(cz,b,il_cz,il_b, ocena : integer);
+ BEGIN
+
+ END WYPISZ_INFO;
+
+ unit Insert: procedure(pp: punkt,Tab : arrayof punkt, il : integer);
+ (* doloaczanie punktu pp do uporzadkowanej tablicy Tab o il-elementach *)
+ var j : integer;
+ begin
+ j := il -1;
+ while j>0 do
+ if pp.mniejsze (Tab(j)) then
+ Tab(j+1) := Tab(j); j := j-1;
+ else exit fi
+ od;
+ Tab(j+1) := pp;
+ end Insert;
+
+ unit punkt : class(x,y,c: integer);
+ var boo : boolean;
+ unit mniejsze : function( p : punkt) : boolean;
+ begin
+ result := (y< p.y or (y=p.y and x< p.x))
+ end mniejsze;
+
+ unit naLewo : function(p1,p2: punkt):boolean;
+ (*(x,y) jest na lewo (na ekranie ) od odcinka p1,p2 *)
+ begin
+ if ( (x-p1.x)*(p2.y - p1.y) -(p2.x-p1.x)*(y-p1.y))>0 then
+ result := true
+ else result := false fi
+ end naLewo;
+
+ unit rysuj : procedure;
+ begin
+ call GUI_Ellipse(x,y,5,5,0,360,c,c)
+ end rysuj;
+ end punkt;
+
+ unit WYMAZ_KONIEC: procedure(L : arrayof punkt, nr : integer);
+ begin
+ call GUI_Line(L(nr-1).x, L(nr-1).y, L(nr).x, L(nr).y, c_blue);
+ end WYMAZ_KONIEC;
+
+ UNIT WNETRZE : procedure(n: integer, WIELOKAT: arrayof punkt;output k:integer);
+ var i, j : integer, boo : boolean, pp: punkt;
+ begin
+ for i := 1 to il_punktow do
+ j := 2;
+ boo:= true;
+ while (j>1 and j<=n) and boo do
+ if Tab(i).naLewo(WIELOKAT(j-1),WIELOKAT(j)) then j:= j+1
+ else boo := false fi
+ od;
+
+ if boo and Tab(i).naLewo(WIELOKAT(n),WIELOKAT(1)) then
+ TAB(i).boo := true;
+ Tab(i).c := c_white;
+ call TAB(i).rysuj;
+ fi
+ od ;
+ (* przesun biale na koniec tablicy *)
+ k:= il_punktow;
+ for i := il_punktow downto 1 do
+ if Tab(i).boo then
+ pp :=Tab(k); Tab(k) :=Tab(i); Tab(i) :=pp;
+ k :=k-1;
+ fi
+ od;
+ end WNETRZE;
+
+ UNIT NaLewo : procedure(p1,p2:punkt; output cz,b : integer);
+ var i : integer;
+ begin
+
+ end NaLewo;
+
+ UNIT chromosom : class(x,y, u,w,ocena: integer);
+ begin
+ end chromosom;
+
+
+(*--------------------------------------------------------------*)
+ UNIT ODCINKI : procedure;
+ END Odcinki;
+
+ UNIT ALG_2 : procedure(ilCZ, ilB : integer);
+ var POKOLENIE : arrayof chromosom,
+ ch : chromosom,
+ p1, p2 : punkt,
+ il_pokolen, b, cz,ocena,
+ ii, i, j, mocP, il_prob, nrChromosomu : integer;
+
+ begin
+
+ i := 0;
+ call GUI_MousePressed(xx,yy,i);
+ if i=1 and CZY(xx, yy,STOP_IKONA) then call clear_all;exit fi;
+
+ end ALG_2;
+
+
+
+(*--------------------------------------------------------------*)
+
+ VAR TAB : arrayof punkt, il_punktow, il_porownan: integer,
+ OK_ikona,YES_ikona,NO_ikona, STOP_IKONA,
+ EXIT_IKONA, CONTINUE_IKONA : IKONA,
+ menu_main, menu_START : menu,
+ i ,xx,yy : integer;
+
+ handlers
+ when MEMERROR : call comment("Zabraklo pamieci");
+ call waitt;
+ when ACCERROR : call comment("Reference to none PR GLOWNY");
+ call waitt;
+ when LOGERROR : call comment("Niepoprawny Attach PR GLOWNY");
+ call waitt;
+ when CONERROR : call comment(" Array-index error PR GLOWNY");
+ call waitt;
+ when SYSERROR : call comment("input-output error");
+ call waitt;
+ when NUMERROR : call comment("blad numeryczny");
+ call waitt;
+ others : call comment("Jakis blad ");
+ call waitt;
+ end handlers;
+
+
+ BEGIN (* tu musi sie wygenerowac menu *)
+
+ YES_ikona := new IKONA(6,450,360,500,385,3,"YES");
+ NO_ikona := new IKONA(6,505,360,555,385,3,"NO");
+ STOP_IKONA := new IKONA(c_green,590,430,635,460,3,"STOP");
+ CONTINUE_IKONA :=
+ new IKONA(c_green,450,430,550,460,3,"CONTINUE");
+
+ (* Strona tytulowa *)
+ CALL GUI_Rect(minX+1,minY+1,maxX-2,maxY-2,c_black,c_lightGrey);
+
+ CALL GUI_writeText(250,100,unpack("PROJEKT"), c_black,c_lightGrey);
+ CALL GUI_writeText(250,200,unpack(
+ "ALGORYTMY W GEOMETRII"), c_black,c_lightGrey);
+
+ call CONTINUE_IKONA.write_i;
+ i := 0;
+ while i<>1 or not CZY(xx,yy,CONTINUE_IKONA) do
+ call GUI_MousePressed(xx,yy,i);
+ od;
+ call CONTINUE_IKONA.push;
+
+
+ (* creation of main menu *)
+ menu_main := new menu(minX,maxX,minY,maxY,new OPTIONS_MAIN(4));
+
+ menu_main.ICONES(4).sub_menu :=
+ new menu(minX,maxX,minY,maxY,new OPTIONS_help(3));
+
+ menu_main.ICONES(2).sub_menu :=
+ new menu(minX,maxX,minY,maxY,new OPTIONS_OTOCZKA(4));
+
+
+
+ attach(menu_main);
+
+ call comment("THIS ENDS THE PROGRAM EXECUTION !!!!!");
+ call endRun;
+ END;
+
+ END (* block od Grafiki *)
+END GEOMETRIA;
+
+
+
+ \0\0
\ No newline at end of file
--- /dev/null
+ H E L P - D O C U M E N T A T I O N\r
+( do programu GRAF.log kwiecien/maj 97)\r
+\r
+\r
+CONTENTS\r
+\r
+ 0. AIMS\r
+ 1. THE STATIC STRUCTURE OF THE PROGRAM \r
+ 2. DATA STRUCTURES \r
+ 2.1 LISTS\r
+ 2.2 QUEUES\r
+ 2.3 STACKS\r
+ 2.4 GRAPH\r
+\r
+ 3. ALGORITHMES\r
+ 3.1 Search algorithmes \r
+ 3.2 \r
+\r
+\r
+ 4. MAIN PROCEDURES AND FUNCTIONS\r
+ 4.1\r
+ 4.2\r
+ \r
+ 5. MENU STRUCTURE\r
+\r
+ 6. USER MANUAL\r
+ 6.1 System Configuration\r
+ 6.2 Files used by the program:\r
+ c:/loglan95/graf.txt\r
+ c:/loglan95/graf.dta\r
+\r
+\r
+\r
+AD.0 \r
+\r
+ The aim of the program was to show the possibility to reuse\r
+ the procedure Traverse twice in two different environments: \r
+ Stacks and Queues.\r
+\r
+ Traverse+Stacks => Depth First Search \r
+ Traverse+Queues => Breadth First Search\r
+\r
+ The restriction imposed was:\r
+ TO NOT DUPLICATE THE TEXT OF TRAVERSE!\r
+\r
+AD.1 \r
+\r
+ The static structure of the program:\r
+\r
+ program GRAF;\r
+ begin pref mouse block\r
+ begin pref IIUWGRAPH block\r
+ (* DECLARATIONS*)\r
+ unit LISTE: class; end liste;\r
+ unit STRUCTURE: class ; end STRUCTURE;\r
+ unit QUEUES : STRUCTURE class; end QUEUES;\r
+ unit STACKS : STRUCTURE class; end STACKS;\r
+ unit BST : QUEUES procedure; end BST;\r
+ unit DFS : STQCKS procedure; end DFS;\r
+ unit GRAPH : class; \r
+ (* graph is represented as an \r
+ Array of LISTE *)\r
+ end GRAPH;\r
+ unit MENU : coroutine; end menu;\r
+ begin (* main program *)\r
+ (*CREATION of the menu-OPTIONS *)\r
+ attach(main_menu)\r
+ end\r
+ end\r
+ end GRAF; \r
+\r
+\r
+ AD 5.\r
+\r
+ Type Menu is implemented as a coroutine which have as attributes\r
+ (a) the list of possible options and\r
+ (b) a sub_menu\r
+ This imply that the different menus form an arbre; \r
+ It is fixed, in this implementation, that the first option is always \r
+ a step to the previous menu. \r
+ Menu was generated in the main program; The structure of it is as follows:\r
+\r
+\r
+ main menu\r
+\r
+ / !\r
+ graph algorithms help\r
+ / / ! )\r
+ clear import modify create next prev reset \r
+ / !\r
+ file memory add_node add_arc del_arc save print getmap \r
+\r
+\r
+\r
+ algorithmes\r
+ / !\r
+ search path \r
+\r
+\r
+ 6\r
+ AD 6.1 \r
+\r
+ Before executing the program make sure that an appropriate \r
+ driver was selected. \r
+ In order to do so execute a batch file\r
+ exec\r
+ (Do not forget to leave Norton Commander!)\r
+ The ecran dimention is 640x480.\r
+\r
+ The auxiliary files \r
+ graf.txt\r
+ graf.dta\r
+ graf1.dta etc\r
+ are supposed to be in c:/loglan95/ \r
+ This can be obiously changed bz programer (in the text of the program).\r
+ \r
+ The is supposed to be QWERTZ.\r
+\r
+
\ No newline at end of file
--- /dev/null
+
+program GRAF;
+#include "classes/gui.inc"
+
+ (* wersja z usuwaniem lukow grafu i tablica list reprezentujaca graf *)
+ (* Algorithmes : search *)
+ (* BFS + DFS + STRANGE-STACK chodzenie po grafie *)
+ (* path, cycle, topological sort ???*)
+ (* Program wykorzystuje plik z przygotowanym grafem /graf.dta *)
+ (* oraz plik /graf.txt z odrobina informacji o programie *)
+ (* Wykonanie algorytmow mozna przerywac, naciskajac prawy klawisz myszy*)
+ (* gdy pojawi sie STOP? *)
+const
+ dimX = 640,
+ dimY = 480,
+ MinX = 10,
+ MinY = 5,
+ MaxX = dimX-10,
+ MaxY = 372,
+ comX = MinX+10,
+ comY = dimY-40,
+ piszX = MinX+10,
+ piszY = MaxY-17,
+ StrMinY = dimY-100,
+ StrMaxY = dimY-20,
+ wrnX = MinX+ 10, (* miejsce na ostrzezenia*)
+ wrnY = StrMinY+ 20,
+
+ mysz = 1,
+ klawiatura = 1,
+ nie_klawiatura =0;
+
+unit punkt : class(x,y:integer);
+end punkt;
+
+
+begin
+ pref GUI block
+
+
+
+
+(*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+(* STRUKTURA LIST *)
+(* first - funkcja bez parametrow, ktorej wynikiem jest pierwszy element *)
+(* dodatkowo ustawia biezacy element jako poczatek listy *)
+(* out - procedura powalajaca usunac pierwszy element listy *)
+(* insert- procedura z jednym parametrem typu elem, ktora pozwala dolaczyc *)
+(* nowy element na koncu listy *)
+(* next - nastepny element listy lub none, jesli go nie ma *)
+(* prev - poprzedni element listy lub none, jesli go nie ma *)
+(* link - jest typem pomocniczym, ogniwem w liscie *)
+(*-------------------------------------------------------------------------*)
+
+ unit Liste : class;
+ var premier, dernier, courant : link;
+
+ unit link : class(e: elem, prec:link, suiv: link);
+ var used: boolean;
+ unit use :procedure;
+ begin
+ used:= true;
+ end use;
+ begin
+ used := false;
+ end link;
+
+ unit debut : procedure;
+ (* post condition: (courant= x) => debut (courant= premier)) *)
+ begin
+ courant := premier;
+ end debut;
+
+ unit restore : procedure;
+ begin
+ courant := premier;
+ while courant<>none
+ do courant.used:= false; courant:= courant.suiv od;
+ courant := premier;
+ end restore;
+
+ unit next : function : elem;
+ begin
+ result := none;
+ if courant<>none then
+ courant := courant.suiv;
+ if courant<>none then
+ result := courant.e
+ fi
+ fi;
+ end next;
+
+ unit prev : function : elem;
+ begin
+ result := none;
+ if courant<>none then
+ if courant.prec<> none then
+ courant := courant.prec;
+ result := courant.e
+ fi
+ fi;
+ end prev;
+
+ unit first : function : elem;
+ begin
+ result:= none;
+ if premier <> none then
+ result := premier.e;
+ fi;
+ end first;
+
+ unit insert: procedure(e:elem);
+ (* post condition: (courant=x) => insert(e)(courant=x and e is_in_this_list) *)
+ var l : link;
+ begin
+ l := new link(e,dernier,none);
+ if premier=none then
+ premier := l;
+ else
+ dernier.suiv := l;
+ fi;
+ dernier := l;
+ end insert;
+
+ unit delete : procedure(e : elem);
+ (* delete an element e; *)
+ (* post condition : delete(e)(courant=premier and e is_not_in_this_list) *)
+ var l,l1,aux : link, trouve : boolean;
+ begin
+ aux := premier;
+ while aux<>none
+ do
+ if aux.e.egal(e) then
+ trouve := true; exit
+ else
+ aux := aux.suiv
+ fi
+ od;
+ if trouve then
+ l := aux.prec;
+ l1 := aux.suiv;
+ if l<>none then
+ l.suiv := l1;
+ if l1<>none then
+ l1.prec := l
+ fi;
+ kill(aux)
+ else
+ premier := premier.suiv;
+ fi;
+ fi;
+ courant := premier
+ end delete;
+
+ unit empty : function: Boolean;
+ begin
+ result := (premier = none)
+ end empty;
+
+ begin
+ premier := none; dernier := none; courant := premier;
+ end liste;
+
+
+(*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+(* ELEM jest typem elementow uzywanych we wszystkich strukturach tego progr.*)
+
+ unit elem : class;
+ unit virtual visite : function : boolean;
+ end visite;
+ unit virtual egal : function (e:elem) : boolean;
+ end egal;
+ unit virtual affichage : procedure;
+ end affichage;
+ end elem;
+
+(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+(* OGOLNY MODEL STRUKTURY ABSTRAKCYJNEJ *)
+
+ unit structure : class;
+ const x0= MinX+40,
+ y0= StrMinY+40,
+ delta= 30;
+ var speedL : integer;
+ (*pozycja poczatkowa i przesuniecie dla ilustracji zawartosci struktury*)
+
+ unit virtual first : function : elem;
+ end first;
+ unit virtual delete : procedure;
+ end delete;
+ unit virtual insert : procedure (e:elem);
+ end insert;
+ unit virtual empty : function : boolean;
+ end empty;
+
+ unit box : class;
+ var e : elem,
+ next : box;
+ end box;
+
+ UNIT TRAVERSE : procedure (G : Graph );
+ (* przegladanie grafu(ktory ma postac tablicy list) z uzyciem*)
+ (* nieznanej struktury danych z operacjami: empty,first,insert,delete*)
+ var i,debut,fin : integer,
+ aux, aux1 : node;
+ begin
+ debut:= G.root; fin:= G.nr;
+ i:= debut;
+ while i <= fin
+ do
+ aux := G.lista(i);
+ if not aux.visite
+ then
+ call aux.visite_le;
+ call insert(aux);
+ aux.father := none;
+ while not empty
+ do
+ aux := first;
+ call delete;
+ if aux.father<>none then
+ call G.strzalka(aux.father,aux,i mod 7,c_black)
+ fi;
+ call aux.wypisz(i mod 7);(* i wyznacza kolor *)
+
+ if not aux.lista.empty then
+ aux1 := aux.lista.first;
+ while aux1<>none
+ do
+ if not aux1.visite then
+ call aux1.visite_le;
+ call insert(aux1) ;
+ aux1.father := aux
+ fi;
+ aux1 := aux.lista.next
+ od;
+ fi;
+ if arret then
+ call comment("This execution has been stopped! Use MENU now.");
+ exit exit
+ fi;
+ od (* not empty *);
+ fi;
+ (* dla kazdego i inna skladowa *)
+ call waittt;
+ i:= i+1;
+ if (i>fin and debut<>1) then debut,i:=1; fin:= G.root-1; fi
+ od
+ end traverse;
+
+ UNIT TRAVERSE_bis : procedure (G : Graph );
+ (* przegladanie grafu(ktory ma postac tablicy list) z uzyciem*)
+ (* nieznanej struktury danych z operacjami: empty,first,insert,delete*)
+ (* wierzcholek jest usuwany dopiero gdy jego synowie juz zostali obsluzeni*)
+ var i,debut,fin : integer,
+ aux, aux1 : node;
+ begin
+ debut:= G.root; fin:= G.nr;
+ i:= debut;
+ while i <= fin
+ do
+ aux := G.lista(i);
+ if not aux.visite
+ then
+ call aux.visite_le;
+ call insert(aux);
+ call aux.wypisz(i); (* i wyznacza kolor *)
+ aux.father := none;
+ while not empty
+ do
+ aux := first; (* to jest pierwszy w str. pomocniczej*)
+ if (aux.lista.courant=none) then
+ call delete;
+ (* usuwam go ze struktury tylko wtedy, gdy juz *)
+ (* odwiedzilam wszystkich jego synow *)
+ else
+ (* courant powinien pokazywac syna, ktorego mam teraz odwiedzic*)
+ aux1 := aux.lista.courant.e;
+ while aux1<>none
+ do
+ if arret then
+ call comment(
+ "This execution has been stopped! Use MENU now.");
+ return;
+ fi;
+
+ if not aux1.visite then
+ call aux1.visite_le;
+ call insert(aux1) ;
+ aux1.father := aux;
+ call G.strzalka(aux1.father,aux1,i,c_black);
+ call aux1.wypisz(i);
+ aux1 := aux.lista.next;
+ exit
+ fi;
+ aux1 := aux.lista.next
+ od;
+
+ if arret then
+ call comment("This execution has been stopped! Use MENU now.");
+ return;
+ fi;
+ fi (* if lista.courant=none *);
+
+ od (* not empty *);
+ fi (* if visite*);
+ (* dla kazdego i inna skladowa *)
+ call waittt;
+ i:= i+1;
+ if (i>fin and debut<>1) then debut,i:=1; fin:= G.root-1; fi
+ od
+ end traverse_bis;
+
+
+ unit printSTRplace : procedure(s:string);
+ var j,i,l,r,z,xx,yy,pos : integer,
+ less, more,boo : boolean;
+ begin
+ call GUI_writetext(MinX+10,StrMinY+10,
+ unpack("CONTENTS OF THE AUXILIARY STRUCTURE - "),c_white,c_lightgrey);
+ call GUI_writetext(MaxX-323,StrMinY+10,unpack(s),c_white,c_lightgrey);
+ call GUI_Rect(MaxX-172,StrMinY+8,MaxX-20,StrMinY+25,c_white,c_black);
+ call GUI_Rect(MaxX-170,StrMinY+9,MaxX-42,StrMinY+23,c_black,c_black);
+ call GUI_writetext(MaxX-170,StrMinY+8,unpack("SPEED:"),c_white,c_lightgrey);
+ call GUI_writetext(MaxX-46,StrMinY+8,unpack(" > "),c_white,c_lightgrey);
+ call comment("Use the LEFT button to change and RIGHT to accep the speed.");
+
+ pos:= MinX+ 500;
+ speedL := 1;
+ do
+ z:=0;
+ while not (z=1 or z=3) do
+ call GUI_MousePressed(xx,yy,z) ;
+ od;
+ (*call sleep(1);*)
+ less:= (yy<STrMinY+23 and yy>StrMinY+10 and xx<(MinX+574));
+ more:= (yy<STrMinY+23 and yy>StrMinY+10 and xx>(MinX+574));
+ (* szukam gdzie zostal nacisniety klawisz myszki *)
+ if ((z=1 and less) and(speedL>1) ) then
+ speedL:= speedL-1;
+ call GUI_writetext(pos-8,StrMinY+8,unpack(" "),c_black,c_black);
+ pos := pos-8
+ else
+ if ((z=1 and more) and(speedL<10)) then
+ speedL:= speedL+1;
+ call GUI_writetext(pos,StrMinY+8,unpack(" "),
+ c_darkturq,c_darkturq);
+ pos := pos+8
+ else
+ if z=3 then call comment("");exit fi;
+ fi
+ fi ;
+ od;
+
+ end printSTRplace;
+
+
+ end structure;
+(*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+
+ unit queue : structure class;
+ var premier, dernier : box;
+ var dernierX : integer;
+
+ unit virtual first : function : elem;
+ begin
+ if not empty
+ then
+ result := premier.e;
+ fi;
+ end first;
+
+ unit virtual insert : procedure( e: elem);
+ var aux : box;
+ begin
+ if empty then dernierX:=x0 else dernierX:= dernierX+delta fi;
+ aux := new box;
+ aux.e := e;
+ if premier=none
+ then
+ premier := aux;
+ dernier := aux;
+ else
+ dernier.next := aux;
+ dernier := aux
+ fi;
+ (* dorysuj *)
+ call GUI_ellipse(dernierX,y0,5,5,0,360,c_yellow,c_yellow);
+ call GUI_writeInt(dernierX,y0+3,e qua node.nr,c_black,c_lightGrey);
+ (*call speed(speedL); *)
+
+ end insert;
+
+ unit virtual delete : procedure;
+ var aux : box;
+ var pomX : integer;
+ begin
+ if not empty
+ then
+ call GUI_ellipse(x0,y0,5,5,0,360,c_LightGrey,c_LightGrey);
+ call GUI_writeInt(x0,y0+3,15,c_LightGrey,c_LightGrey);
+ (*wymazanie pierwszego*)
+ call sleep(1);
+ aux := premier;
+ pomX := x0;
+ while aux.next<>none
+ do
+ call GUI_ellipse(pomX+delta,y0,5,5,0,360,c_LightGrey,c_LightGrey);
+ call GUI_writeInt(pomX+delta,y0+3,15,c_LightGrey,c_LightGrey); (*wymazanie*)
+ call GUI_ellipse(pomX,y0,5,5,0,360,c_yellow,c_yellow);
+ call GUI_writeInt(pomX,y0+3,aux.next.e qua node.nr,c_black,c_lightgrey);
+ (* zmiana numerkow= przesuniecie w kolejce*)
+ aux := aux.next;
+ pomX := pomX + delta;
+ call sleep(2)
+ od;
+ premier := premier.next;
+ if premier= none then dernier:= none fi;
+
+ call GUI_ellipse(dernierX,y0,5,5,0,360,c_LightGrey,c_LightGrey);
+ call GUI_writeInt(dernierX,y0+3,15,c_LightGrey,c_Lightgrey);
+ if dernierX> x0 then dernierX := dernierX - delta fi;
+ fi;
+ end delete;
+
+ unit virtual empty : function : boolean;
+ begin
+ result := (premier=none)
+ end empty;
+
+ end queue;
+ (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+
+ unit stack : Structure class;
+ var premier : box;
+ var topX : integer;
+
+ unit virtual first : function : elem;
+ begin
+ if not empty
+ then
+ result := premier.e;
+ fi;
+ end first;
+
+ unit virtual insert : procedure( e: elem);
+ var aux : box;
+ begin
+ if empty then topX := x0 else topX := topX+delta fi;
+ aux := new box;
+ aux.e := e;
+ aux.next := premier;
+ premier := aux;
+ (*dorysuj*)
+ call GUI_ellipse(topX,y0,5,5,0,360,c_yellow,c_yellow);
+ call GUI_writeInt(topX,y0+3,e qua node.nr,c_black,c_lightgrey);
+ (* call speed(speedL); *)
+ end insert;
+
+ unit virtual delete : procedure;
+ var j : integer;
+ begin
+ if not empty
+ then
+ premier := premier.next;
+ call GUI_ellipse(topX,y0,5,5,0,360,c_LightGrey,c_LightGrey);
+ call GUI_writeInt(topX,y0+3,15,c_LightGrey,c_LightGrey);
+ if topX> x0 then topX := topX - delta fi;
+ fi;
+ end delete;
+
+ unit virtual empty : function : boolean;
+ begin
+ result := (premier=none)
+ end empty;
+
+
+ end stack;
+
+(*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+ unit PILE_FILE : Structure class;
+ var premier, dernier,aux,aux1 : box;
+ var topX,dernierX : integer;
+
+ (* struktura, w ktorej delete i insert maja wlasnosci stosu*)
+ (* ale first dziala tak jak w kolejce *)
+
+ unit virtual first : function : elem;
+ begin call comment("first");
+ if not empty
+ then
+ result := premier.e;
+ fi;
+ end first;
+
+ unit virtual insert : procedure( e: elem);
+ var aux : box;
+ begin call comment("insert");
+ if empty then topX,dernierX:=x0 else dernierX:= dernierX+delta fi;
+ aux := new box;
+ aux.e := e;
+ if premier=none
+ then
+ premier, dernier := aux;
+ else
+ dernier.next := aux;
+ dernier := aux
+ fi;
+ (* dorysuj *)
+ call GUI_Ellipse(dernierX,y0,5,5,0,360,c_yellow,c_yellow);
+ call GUI_writeInt(dernierX,y0,e qua node.nr,c_lightgrey,c_black);
+ (* call speed(speedL); *)
+ end insert;
+
+ unit virtual delete : procedure;
+ var aux, aux1: box;
+ begin
+ if not empty
+ then call comment("delete");
+ aux := premier;
+ if premier.next=none then dernier,premier:=none
+ else
+ aux1:= none; aux := premier;
+ while aux.next<>none do aux1:=aux; aux := aux.next od;
+ dernier := aux1; dernier.next:= none
+ fi;
+ call GUI_ellipse(dernierX,y0,5,5,0,360,c_darkgrey,c_darkgrey);
+ call GUI_writeInt(dernierX,y0,15,c_darkgrey,c_darkgrey);
+ if dernierX> x0 then dernierX := dernierX - delta fi;
+ fi;
+ end delete;
+
+ unit virtual empty : function : boolean;
+ begin
+ result := (premier=none)
+ end empty;
+
+ end PILE_FILE;
+
+
+ UNIT PI_FI : PILE_FILE procedure(G:GRAPH);
+ begin
+ call printSTRplace(" QUEUE ");
+ call comment("PILE_FILE SEARCH");
+ call traverse_bis(G);
+ end PI_FI;
+
+
+ (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+
+ unit STRANGE : Structure class;
+ var premier : box, extra: box;
+ var topX : integer;
+
+ unit virtual first : function : elem;
+ begin
+ if not emptyN
+ then
+ result := premier.e;
+ else
+ result := extra.e
+ fi;
+ end first;
+
+ unit virtual insert : procedure( e : elem);
+ var aux : box;
+ begin
+ if empty then topX := x0 else topX := topX+delta fi;
+ if emptyN then extra := new box; extra.e := e fi;
+ aux := new box;
+ aux.e := e;
+ aux.next := premier;
+ premier := aux;
+ call GUI_ellipse(topX,y0,5,5,0,360,c_yellow,c_yellow);
+ call track(topX,y0,e qua node.nr,c_lightgrey,c_black);
+ (* call speed(speedL); *)
+ end insert;
+
+ unit virtual delete : procedure;
+ begin
+ if not emptyN
+ then
+ premier := premier.next;
+ call GUI_ellipse(topX,y0,5,5,0,360,c_darkgrey,c_darkgrey);
+ call track(topX,y0,15,c_darkgrey,c_darkgrey);
+ if topX> x0 then topX := topX - delta fi;
+ fi;
+ end delete;
+
+ unit emptyN : function : boolean;
+ begin
+ result := (premier=none)
+ end emptyN;
+
+ unit virtual empty : function : boolean;
+ begin
+ result := false
+ end empty;
+
+ end STRANGE;
+
+ (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+ (* ALGORITHMS *)
+ (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+
+
+ UNIT DFS : STACK procedure(G: GRAPH);
+ begin
+ call printSTRplace(" STACK ");
+ call comment("DEPTH FIRST SEARCH");
+ call traverse(G);
+ end DFS;
+
+ UNIT DFS_bis : STACK procedure(G: GRAPH);
+ begin
+ call printSTRplace(" STACK ");
+ call comment("DEPTH FIRST SEARCH");
+ call traverse_bis(G);
+ end DFS_bis;
+
+
+ UNIT BFS : QUEUE procedure(G:GRAPH);
+ begin
+ call printSTRplace(" QUEUE ");
+ call comment("BREADTH FIRST SEARCH");
+ call traverse(G);
+ end BFS;
+
+ UNIT BFS_bis : QUEUE procedure(G:GRAPH);
+ begin
+ call printSTRplace(" QUEUE ");
+ call comment("BREADTH FIRST SEARCH");
+ call traverse_bis(G);
+ end BFS_bis;
+
+
+ UNIT WHAT : STRANGE procedure (G: GRAPH);
+ begin
+ call printSTRplace(" STACK?? ");
+ call comment("STRANGE SEARCH");
+ call traverse(G);
+ end WHAT;
+
+ unit look_all: class(G: GRAPH);
+ var i,debut,fin : integer,
+ aux : node;
+ begin
+ debut:= G.root; fin:= G.nr;
+ i:= debut;
+ while i <= fin
+ do
+ aux := G.lista(i);
+ inner;
+ call waittt;
+ i:= i+1;
+ if (i>fin and debut<>1) then debut,i:=1; fin:= G.root-1; fi
+ od;
+ end look_all;
+
+ unit traverse_rec : look_all procedure;
+ unit DFS : procedure (aux: node,i:integer);
+ var aux1:node;
+ begin
+ if not aux.visite
+ then
+ call aux.visite_le;
+ if aux.father<>none then
+ call G.strzalka(aux.father,aux,(i+9)mod 16,c_black)
+ fi;
+ call aux.wypisz((i+9)mod 16);(* i wyznacza kolor *)
+
+ aux1 := aux.lista.first;
+ while aux1<>none
+ do
+ aux1.father:= aux;
+ call DFS(aux1,i);
+ aux1:= aux.lista.next
+ od;
+
+ fi;
+ end DFS;
+ begin
+ call DFS(aux,i);
+ end traverse_rec;
+
+
+
+ unit cycle_fond : procedure(G:GRAPH);
+ var STOS : arrayof integer,
+ ii,iii : integer,
+ pile : stack;
+ (* stos przechowuje tylko numery wierzcholkow ze stosu*)
+ (* pile przechowuje wierzcholki zeby pokazac zawartosc stosu *)
+
+ unit CF : look_all procedure;
+ var aux1 : node,
+ x, j : integer;
+ begin
+ if (not aux.visite and not aux.use)
+ then
+ ii := ii+1;
+ stos(ii) := aux.nr;
+ call aux.visite_le;
+ call pile.insert(aux);
+ while not pile.empty
+ do
+ if arret then
+ call warning("This execution has been stopped! Use MENU now.");
+ return;
+ fi;
+
+ aux := pile.first;
+ if aux.father<>none then
+ call G.strzalka(aux.father,aux,11,c_black);
+ fi;
+ for j := 1 to 160 do call aux.affichage(11) od;
+ call aux.affichage(11);
+
+ (* staram sie dopisac cos do stosu *)
+ if aux.lista.courant<>none then
+ aux1 := aux.lista.courant.e;
+ while aux1<>none
+ do
+ if not aux1.visite and not aux1.use then
+ aux1.father:= aux;
+ ii := ii+1;
+ stos(ii) := aux1.nr;
+ call aux1.visite_le;
+ call pile.insert(aux1);
+ exit
+ else
+ if ( not aux1.use and ii>1) then(* cykl ? *)
+ if aux1.nr<>STOS(ii-1) then
+ iii := ii;
+ call GUI_writeText(piszX+delta,piszY,
+ unpack("("),c_blue,c_lightgrey);
+ delta := delta + 8;
+ while iii>0
+ do
+ x := STOS(iii);
+ call G.lista(x).wypisz(c_blue);
+ if x=aux1.nr then exit fi;
+ iii := iii-1;
+ od;
+ call GUI_writeText(piszX+delta,piszY,
+ unpack(")"),c_blue,c_lightgrey);
+ delta := delta+8;
+
+ call waittt;
+ fi
+ fi(* not aux.use *);
+ (* trzeba przejsc do nastepnego wierzch *)
+ aux1 := aux.lista.next
+ fi
+
+ od (* while aux1<>none *);
+ fi (* if courant<>none *);
+
+ if aux.lista.courant=none then
+ aux.kolor := c_lightgrey; (* element zuzyty*)
+ if ii>0 then ii:= ii-1 fi;(* usuwam ze stosu*)
+ call pile.delete
+ fi;
+ od(* while not empty pile *)
+ fi;
+ end CF;
+
+ begin
+ array STOS dim(1:G.nr);
+ pile := new stack;
+ call G.restore; (* odnowic structure grafu *)
+ call pile.printSTRplace(" STACK ");
+ ii:=0; (* ilosc elementow w stosie-tablicy*)
+ call CF(G);
+ end cycle_fond;
+
+
+ unit xxxxx: procedure (G:GRAPH);
+ var stos : stack;
+
+ unit trie_topologique : look_all procedure;
+ unit DFS : procedure (aux: node,i:integer);
+ var aux1 : node;
+ begin
+ if not aux.visite
+ then
+ call aux.visite_le;
+ if aux.father<>none then
+ call G.strzalka(aux.father,aux,i mod 7 ,c_black)
+ fi;
+ call aux.wypisz(i mod 7);(* i wyznacza kolor *)
+
+ aux1 := aux.lista.first;
+ while aux1<>none
+ do
+ aux1.father:= aux;
+ call DFS(aux1,i);
+ aux1:= aux.lista.next
+ od;
+ call stos.insert(aux);
+ fi;
+ end DFS;
+ begin
+ call DFS(aux,i);
+ end trie_topologique;
+ begin
+ call G.restore;
+ stos := new stack;
+ call stos.printSTRplace(" STACK");
+ call trie_topologique(G);
+ call GUI_Rect(piszX,piszY,maxX-5,piszY+13,c_lightGrey,c_lightGrey);
+
+ delta:= 0;
+ while not stos.empty
+ do
+ call stos.first qua node.wypisz(5);
+ call stos.delete;
+ od;
+ end xxxxx;
+
+(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+ UNIT EULER : procedure(G:GRAPH);
+ var aux,aux1,aux2 : node,
+ booooo : boolean,
+ pile : stack;
+ begin
+ pile := new stack;
+ call G.restore;
+ call pile.printSTRplace(" STACK ");
+ aux := G.lista(G.root);
+ call pile.insert(aux);
+ while not pile.empty
+ do
+ aux := pile.first; (* to jest pierwszy w str. pomocniczej*)
+
+ booooo := false;
+ call aux.lista.debut;
+ aux1 := aux.lista.first;
+ (* courant jest teraz na poczatku listy*)
+ while (not booooo and aux1<>none)
+ do
+ if not aux.lista.courant.used then
+ (* jezeli krawedz do courant nie byla jeszcze uzyta*)
+ call aux.lista.courant.use;
+ call pile.insert(aux1);
+ call G.strzalka(aux,aux1,12,c_black);
+ (* w liscie incydencji aux1 tez trzeba zmienic*)
+ call aux1.lista.debut;
+ aux2 := aux1.lista.first;
+ while aux2<>none
+ do
+ if (*aux.egal(aux2)*) aux.nr=aux2.nr then
+ call aux1.lista.courant.use;
+ exit
+ else
+ aux2 := aux1.lista.next
+ fi;
+ od;
+ booooo := true;
+ else
+ aux1 := aux.lista.next
+ fi;
+ od;
+ if not booooo then
+ call pile.delete;
+ call aux.wypisz(12);
+ fi;
+ if arret then
+ call comment("This execution has been stopped! Use MENU now.");
+ return;
+ fi;
+ od (* not empty *);
+ end EULER;
+
+ UNIT HAMILTON : procedure(G:GRAPH);
+ begin
+
+ end HAMILTON;
+
+(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+
+ UNIT GRAPH : class;
+ var lista : arrayof node,
+ directed : boolean,
+ root,nr : integer,
+ obraz : arrayof integer ;
+
+ unit createNODE : procedure;
+ var lista1 : arrayof node,
+ fin, boo : boolean,
+ i,l,r,z,x,y : integer,
+ w : node;
+ begin
+ z := 0;
+
+ while not (z=3 ) do
+ call GUI_mousePressed(x,y,z);
+ od;
+ if z=3 then
+ nr := nr+1;
+ w := new node(x,y,nr);
+ call w.affichage(14);
+ if nr <= upper(lista) then
+ lista(nr) := w
+ else
+ array lista1 dim (1: upper(lista)+10);
+ for i := 1 to upper(lista)
+ do lista1(i) := lista(i) od;
+ lista := lista1;
+ lista(nr) := w
+ fi
+ fi
+ end createNODE;
+
+ unit change_root : procedure;
+ var x, y,i,l,r,z : integer;
+ begin
+ call warning("You can change the starting point which is now: ");
+ call GUI_writeInt(maxX-200,wrnY,root,
+ c_lightGrey,c_black);
+ call GUI_writetext(maxX-100,wrnY,
+ unpack(" change "),c_lightGrey,c_turq);
+ call GUI_writetext(maxX-100,wrnY+16,
+ unpack(" accept "),c_lightGrey,c_turq);
+ while true do
+ z := 0;
+ call GUI_MousePressed(x,y,z) ;
+ call sleep(2);
+ if (z=1) then
+ if (y>wrnY and y<wrnY+10) then
+ root := (root mod nr)+1;
+ call GUI_writetext(maxX-205,wrnY,
+ unpack(" "),c_lightGrey,c_lightGrey);
+ call GUI_writeInt(maxX-200,wrnY,
+ root,c_lightGrey,c_black);
+ fi;
+ if (y>wrnY+15 and y<wrnY+30) then exit fi;
+ fi;
+ od;
+ call GUI_writetext(maxX-100,wrnY,
+ unpack(" "),c_darkGrey,c_darkGrey);
+ call GUI_writetext(maxX-100,wrnY+16,
+ unpack(" "),c_darkGrey,c_darkGrey);
+
+ call comment("");
+ call warning("")
+ end change_root;
+
+ unit createARC : WEZ_DWA PROCEDURE;
+ BEGIN
+ (* do listy "w" dopisuje "w1"*)
+ call w.lista.insert(w1);
+ if not directed then call w1.lista.insert(w) fi;
+ end createARC ;
+
+
+ unit DeleteARC : wez_dwa procedure;
+ begin
+ (*zaznacz luk pokazujac dwa wierzcholki nim polaczone*)
+ (* wez z listy wierzcholkow poczatek luku "w"*)
+ (* i z jego listy incydencji usun drugi koniec luku "w1" *)
+ call w.lista.delete(w1);
+ if not directed then call w1.lista.delete(w) fi;
+ end DeleteARC;
+
+
+ UNIT WEZ_DWA : class(cc:char);
+ var w, w1, aux : node,
+ i,l,r,z,xx,yy : integer,
+ boo, found, rysuj : boolean;
+ begin
+ if nr>0 then
+ (* czekam na nacisniecie prawego klawisza myszy w wierzcholku*)
+ call warning("I am waiting for the right-button of the mouse.");
+ z := 0;
+
+ while not z=3 do
+ call GUI_MousePressed(xx,yy,z);
+ od;
+
+ w := szukaj(xx,yy,true);
+ if w<> none then
+
+ (* prawy klawisz w jakims wierz.= koniec krawedzi *)
+ call warning("To draw/remove use LEFT-B; Press RIGHT-B to mark the end of an arc.");
+ z := 0;
+ while not z=3
+ do (*jesli chcesz sam rysowac/wymazac to naciskaj lewy klawisz myszy*)
+ if z=1 then
+ rysuj := true;
+ case cc
+ when 'd' : call GUI_ellipse(xx,yy,3,3,0,360,c_lightGrey,c_lightGrey);
+ when 'i' :
+ call GUI_point(xx,yy,c_red);
+ esac;
+ fi;
+ call GUI_MousePressed(xx,yy,z);
+ od;
+ call warning("");
+ (* szukam odpowiadajacego wierzcholka w1 *)
+ w1 := SZUKAJ(xx,yy,true);
+ if w1<> none then
+
+ (* MOZNA dopisac/dorysowac lub usunac/wymazac*)
+ inner;
+
+ if not rysuj then
+ case cc
+ when 'd' : call strzalka(w,w1,c_lightgrey,c_lightGrey);
+ when 'i' : call strzalka(w,w1,c_Yellow,c_black);
+ esac;
+ fi;
+ else
+ call warning("I can not find the end of this arc, repeat the last action! ")
+ fi;
+ else call warning("Not found, repeat please!")fi (* w<>none *);
+ fi (* sa juz jakies wierzcholki *);
+ end WEZ_dwa;
+
+ UNIT SZUKAJ : function(xx,yy : integer,b : boolean) : node;
+ var aux : node,i,j : integer;
+ begin
+ for i := 1 to nr
+ do
+ aux := lista(i);
+ if b then
+ for j:=1 to 50 do call aux.affichage(5) od;
+ call aux.affichage(14);
+ fi;
+ (* szukam odpowiadajacego wierzcholka w*)
+ if (abs(aux.x- xx)<7 and abs(aux.y-yy)<7)
+ then
+ result := aux; exit
+ fi;
+ od;
+ end SZUKAJ;
+
+
+ unit SAVE : procedure;
+ var U,GL : arrayof integer, W : arrayof arrayof integer,
+ nn,i,j : integer,
+ sciezka : arrayof char,
+ aux, aux1 : node;
+ begin
+
+ (*call warning("Give the name of your file or press CR to accept this");*)
+ sciezka := unpack("/usr/local/vlp/examp/graf.dta");
+ call warning("");
+
+ open(G_file,direct,sciezka);
+ call rewrite(G_file);
+ call seek(G_file,0,2);
+ nn := 2* intSize;
+ array U dim (1:2);
+ U(1) := nr; if directed then U(2):=1 else U(2):=0 fi;
+ putrec (G_file,U,nn);
+ array GL dim (1:nr);
+ array W dim (1:nr);
+ for i := 1 to nr do array W(i) dim (1:nr) od;
+ (* dla kazdego wierzcholka z listy zidentyfikuj jego sasiadow*)
+ for i := 1 to nr
+ do
+ aux := lista(i);
+ call aux.lista.debut;
+ aux1 := aux.lista.first;
+ j := 0; (* j= liczbie wierzcholkow incydentnych dla aux *)
+ while aux1<> none
+ do
+ j := j+1;
+ W(i,j) := aux1.x*1000*100 + aux1.y*100 ;
+ aux1 := aux.lista.next
+ od;
+ GL(i) := aux.x*1000*100 + aux.y*100 + j;
+ od;
+ nn := nr * intSize;
+ putrec (G_file,GL,nn);
+ for i := 1 to nr
+ do
+ nn := (GL(i) mod 100) * intSize ;
+ if GL(i) >0 then putrec(G_file,W(i),nn)fi;
+ od;
+ kill(G_file);
+
+
+ end SAVE;
+
+ unit TAKE : procedure;
+ (* odczytaj graf z pliku *)
+ var U,W,SASIEDZI : arrayof integer,
+ x,y,n,nn,ile,j,i : integer,
+ sciezka : arrayof char,
+ aux, aux1 : node;
+
+ unit decode : procedure(a: integer; output x,y,ile: integer);
+ begin
+ ile := a mod 100;
+ y := (a div 100) mod 1000;
+ x := (a div 100000)
+ end decode;
+ begin
+
+ (* call warning("Give the name of your file or press CR to accept");*)
+ (* call GUI_Rect(20,338,20,140,c_black,c_lightGrey);*)
+ (*sciezka := GUI_ReadText(20,338,c_yellow,c_black);*)
+ (* call GUI_Rect(20,338,20,140,c_LightGrey,c_lightGrey);*)
+
+ call warning("");
+ sciezka := unpack("/usr/local/vlp/examp/graf.dta");
+ open(G_file,direct,sciezka);
+ call reset(G_file);
+ call seek(G_file,position(G_file),0);
+ array U dim(1:2);
+ nn := 2* intSize;
+ getrec (G_file,U,nn);
+ nr := U(1);
+ directed := (U(2)=1);
+ array W dim (1:nr);
+ call seek(G_file,position(G_file),0);
+
+ nn := nr * intSize;
+ getrec (G_file,W,nn);
+ if upper(lista) < nr then
+ array lista dim(1: nr)
+ fi;
+ array SASIEDZI dim (1:nr);
+ for j:= 1 to nr
+ do
+ (* utworzyc odczytany j-ty wierzcholek *)
+ (* i wpisac go na liste *)
+ call decode(W(j),x,y,ile);
+ aux := new node(x,y,j);
+ lista(j) := aux;
+ SASIEDZI(j) := ile;
+ od;
+ (* jezeli lista sasiadow j-tego wierz.jest>0 *)
+ (* odczytac jego sasiadow i wpisac do odp. listy*)
+ for j := 1 to nr
+ do
+ if SASIEDZI(j)<>0 then
+ nn := SASIEDZI(j) * intSize;
+ call seek(G_file,position(G_file),0);
+
+ getrec(G_file,W,nn);
+ for i := 1 to SASIEDZI(j)
+ do
+ call decode(W(i),x,y,ile);
+ aux1 := SZUKAJ(x,y,false);
+ call lista(j).lista.insert (aux1);
+ od;
+ fi;
+ od;
+ kill(G_FILE);
+
+ if directed then call warning("THIS IS A DIRECTED GRAPH ")
+ else
+ call warning("THIS IS AN UNDIRECTED GRAPH ")
+ fi;
+ end take;
+
+
+ unit restore : procedure;
+ (* odnawia stan wierzcholkow *)
+ var i : integer;
+ begin
+ delta := 0;
+ for i := 1 to nr
+ do
+ if lista(i).lista<>none
+ then call lista(i).lista.restore fi;
+ lista(i).kolor := c_yellow;
+ lista(i).father := none
+ od;
+ end restore;
+
+ UNIT strzalka : procedure(A,B : node, kol1,kol2:integer);
+ (* grot strzalki jest skierowany w strone B *)
+ var r : real, cx,cy,dx,dy,ex,ey,delt,del : integer;
+ BEGIN
+ del := 15; delt:=7; (* decyduja o wielkosci grota *)
+
+ call GUI_line(A.x,A.y,B.x,B.y,kol1);
+ if directed then
+ (* kol2=kolor grota *)
+ r := sqrt((b.y-a.y)*(b.y-a.y)+(b.x-a.x)*(b.x-a.x));
+ cx := b.x- entier((b.x-a.x)*del/r );
+ cy := b.y- entier((b.y-a.y)*del/r );
+ dx := b.x- entier((b.x-a.x)*(del+delt)/r + (b.y-a.y)*delt/r);
+ dy := b.y- entier((b.y-a.y)*(del+delt)/r - (b.x-a.x)*delt/r);
+ ex := b.x- entier((b.x-a.x)*(del+delt)/r - (b.y-a.y)*delt/r);
+ ey := b.y- entier((b.y-a.y)*(del+delt)/r + (b.x-a.x)*delt/r);
+ call GUI_line(dx,dy,cx,cy,kol2);
+ call GUI_line(ex,ey,cx,cy,kol2);
+ fi;
+ END strzalka;
+
+
+ unit print : procedure;
+ var aux, aux1 : node, i : integer;
+ begin
+ for i :=1 to nr
+ do
+ aux := lista(i);
+ call aux.affichage(c_yellow);
+ if aux.lista<>none
+ then
+ call aux.lista.debut;
+ aux1 := aux.lista.first;
+ while aux1 <> none
+ do
+ call strzalka(aux,aux1,c_yellow,c_black);
+ aux1 := aux.lista.next;
+ od
+ fi;
+ od;
+ call warning("")
+ end print;
+
+ unit directORnot :procedure;
+ var T: arrayof choix, i,j:integer;
+ begin
+ array T dim(1:2);
+ for i:= 1 to 2 do
+ T(i) := new choix
+ od;
+ T(1).name:="direct";
+ T(2).name:="indirect";
+ j:= choice(100,100,T);
+ directed:=(j=1)
+ end directORnot;
+ begin
+ array lista dim(1:10);
+ nr := 0; root:= 1;
+ (* ustal czy graf zorientowany czy nie*)
+ end graph;
+
+(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+(* NODE - wierzcholek grafu *)
+(* x,y pozycja na ekranie, nr numer wierzcholka *)
+(* lista - lista wierzcholkow incydentnych *)
+(*----------------------------------------------------------------------*)
+ unit node : elem class(x,y,nr: integer);
+ (* (x,y) pozycja wierzcholka na ekranie, nr =jego numer *)
+ (* dla kazdego nowego wierzcholka w jest w.lista.empty *)
+ var lista : liste,
+ father : node,
+ kolor : integer;
+
+ unit affichage : procedure(c: integer);
+ begin
+ if c= c_lightgrey then
+ call GUI_ellipse(x,y,5,5,0,360,c_black,c_darkGrey)
+ else
+ call GUI_ellipse(x,y,5,5,0,360,c,c)
+ fi;
+ call GUI_writeInt(x+5,y+5,nr,c_lightGrey,c_black);
+ end affichage;
+
+ unit wypisz : procedure(i: integer);
+ (* wypisz kolejnosc odwiedzania wierzcholkow *)
+ (* parametr i wyznacza nowy kolor wierzcholka*)
+ var j : integer;
+ begin
+ for j := 1 to 160 do call affichage(j mod 16 ) od;
+ if (i=8 or i=7)then i:=1 fi;
+ call affichage(i);
+ call GUI_writeInt(piszX+delta,piszY,nr,i,c_lightGrey);
+ if nr>9 then
+ delta := delta+2*9
+ else
+ delta := delta+9
+ fi;
+ call GUI_writetext(piszX+delta,piszY,unpack(","),i,c_lightGrey);
+ delta:= delta+8;
+ end wypisz;
+
+ unit virtual visite : function : boolean;
+ (* Czy wierzcholek byl juz odwiedzony *)
+ begin
+ if kolor=c_black then result := true else result:= false fi;
+ end visite;
+
+ unit virtual use : function : boolean;
+ (* Czy wierzcholek jest juz zuzyty *)
+ begin
+ if kolor=c_lightGrey then result := true else result:= false fi;
+ end use;
+
+ unit virtual visite_le : procedure;
+ (* Wierzcholek odwiedzony dostaje kolor czarny*)
+ begin
+ kolor:= c_black
+ end visite_le;
+
+ unit virtual egal : function( e: node) : boolean;
+ begin
+ if (x= e.x and y= e.y and nr = e.nr) then
+ result := true
+ else
+ result := false
+ fi;
+ end egal;
+ begin
+ lista := new liste; kolor := c_yellow;
+ end node;
+ (*--------------------------------------------------------------------*)
+
+
+ unit clear : procedure(col : integer);
+ var i,y, sr : integer;
+ begin
+ y := MinY+40; (* omijam menu *)
+ sr := (minX+maxX) div 2;
+ for i := 0 to (maxX - minX) div 2
+ do
+ call GUI_line(sr, maxY,sr+i, Y,col);
+ call GUI_line(sr, maxY,sr-i, Y,col);
+
+ od;
+ for i := 0 to (maxY - Y)
+ do
+ call GUI_Line( sr, maxY,maxX, Y+i,col);
+ call GUI_Line( sr, maxY,minX, Y+i,col);
+
+ od;
+ call GUI_Rect(MinX,Y,MaxX,MaxY,c_black,c_LightGrey);
+ call GUI_Rect(MinX,StrMinY,MaxX,StrMaxY,c_black,C_lightGrey);
+ end clear;
+
+
+ unit clear_all : procedure(col : integer);
+ begin
+ call GUI_Rect(MinX,MaxY,MaxX,MaxY,c_black,c_lightGrey);
+ call GUI_Rect(MinX,StrMinY,MaxX,StrMaxY,c_black,C_lightGrey);
+ end clear_all;
+
+ unit waittt : procedure;
+ var x,y,i,l,r,z : integer, boo : boolean;
+ begin
+ call GUI_writetext(maxX-100,maxY-25,
+ unpack("continue"),c_lightGrey,c_red);
+
+ while z=0 do call GUI_mousePressed(x,y,z) od;
+ call GUI_writetext(maxX-100,maxY-25, unpack(" "),c_lightGrey,c_lightgrey);
+
+ end waittt;
+
+ unit arret : function : boolean;
+ var x,y,z : integer;
+ begin
+ call Gui_writetext(maxX-100,maxY-25,
+ unpack("STOP? "),c_lightGrey,c_red);
+ call GUI_MousePressed(x,y,z) ;
+ if ( z=3) then
+ result := true;
+ call GUI_writetext(maxX-100,maxY-25,
+ unpack(" "),c_lightGrey,c_lightGrey);
+ else result := false
+ fi;
+ end arret;
+
+ unit YES : function : boolean;
+ var x,y : integer, l : char;
+ begin
+ l:=GUI_ReadChar(x,y,c_green,c_black);
+ if (l= 'y' or l='Y') then
+ result := true
+ else
+ result := false ;
+ call warning("")
+ fi;
+ end YES;
+
+ unit speed: procedure(n : integer);
+ var j : integer;
+ begin
+ n:= entier(10/n);
+ for j:=1 to n do j:=j od;
+ end speed;
+
+ unit sleep: procedure(n : integer);
+ var j : integer;
+ begin
+ for j:=1 to n do j:=j od;
+ end sleep;
+
+ unit comment : procedure (s : string);
+ begin
+ call GUI_Rect(comX,comY+12,MaxX-5,comY,c_lightGrey,c_lightGrey);
+ call GUI_writetext(comX,comY,unpack(s),c_white,c_lightGrey);
+ end comment;
+
+ unit warning : procedure (s : string);
+ begin
+ call GUI_Rect(MinX,StrMinY,MaxX,StrMaxY,c_black,c_lightGrey);
+ call GUI_writetext(wrnX,wrnY,
+ unpack(s),c_white,c_lightgrey);
+ end warning;
+
+ unit choix : class;
+ var uwaga : string, name : string,
+ x,y : integer;
+ end choix;
+
+ unit choice : function(xx,yy : integer, T: arrayof choix) : integer;
+ var i,j,l,r,z,x,y,n : integer, boo : boolean,
+ IMAGE : arrayof integer;
+ begin
+ n := upper(T);
+ IMAGE := GUI_getImg(xx,yy,100,15*(n+1));
+ call GUI_Rect(xx,yy,xx+100,yy+15*(n+1),c_white,c_white);
+ for i:= 1 to n do
+ call GUI_writetext(xx+2,yy+i*15,unpack(T(i).name),c_black,c_lightGrey);
+ T(i).x:= xx+2;
+ T(i).y:= yy+i*15;
+ od;
+
+ do
+ call sleep(2);
+ z := 0;
+ call GUI_MousePressed(x,y,z) ;
+
+ for j:= 1 to n do
+ if ((x>xx and x< (xx+100)) and
+ (y>T(j).y and y<(T(j).y+15)))
+ then
+ call GUI_writetext(xx+2,yy+j*15,
+ unpack(T(j).name),c_white,c_black);
+ result:=j; (* j-ta opcja wybrana*)
+ else
+ call GUI_writetext(xx+2,yy+j*15,
+ unpack(T(j).name),c_black,c_lightgrey)
+ fi;
+
+ od;
+ if ( z=1) then
+ exit ;
+ fi;
+ od;
+ call GUI_putImg(xx,yy,IMAGE)
+ end choice;
+
+
+(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+(* M E N U *)
+(*--------------------------------------------------------------------*)
+
+
+ unit ramki_menu : procedure;
+ begin
+ call GUI_Rect(MinX,MinY,MaxX,MaxY,c_black,c_lightgrey);
+ call GUI_Rect(MinX,StrMinY,MaxX,StrMaxY,c_black,C_lightGrey);
+ end ramki_menu;
+
+ unit option : class(nb : integer);
+ var Nom : arrayof string;
+ unit virtual action : procedure(j : integer);
+ begin
+ end action;
+ begin
+ array Nom dim (1:nb);
+ inner;
+ end option;
+
+ unit ikona : class(c:integer,p,q: punkt,ss:string);
+ var sub_menu : menu;
+ unit write_i : procedure;
+ begin
+ call GUI_Rect(p.x,p.y,q.x,q.y,c_white,c_lightGrey);
+ call GUI_writetext(p.x,p.y,unpack(ss),c_white,c);
+ end write_i;
+ end ikona;
+
+
+ unit menu : coroutine(Nom:string,
+ minX,maxX,MinY,MaxY:integer,OPTIONS:option);
+ var ICONES: arrayof IKONA,
+ j,i,nb,dl,sz,l,r,w,z,xx,yy : integer,
+ boo : boolean, p,q : punkt;
+ (* dl and sz - wymiary ikon w tym menu *)
+
+ unit instalation : procedure;
+ var i : integer;
+ begin
+ call GUI_Rect(MinX+1,7,MaxX-4,45,c_blue,c_lightGrey);
+ for i := 0 to nb
+ do
+ call ICONES(i).write_i
+ od;
+ end instalation;
+
+handlers
+ others call warning(" ERROR press Y to continue or N to stop?");
+
+ boo := YES;
+ if not boo then call GROFF; call ENDRUN fi;
+ call warning("");
+ wind;
+
+end handlers;
+
+ begin
+ nb := OPTIONS.nb;
+ dl := (MaxX-Minx) div nb; sz := 18;
+
+ array ICONES dim(0:nb);
+ p:= new punkt(MinX+2,MinY+2);
+ q := new punkt(MaxX-2,MinY +sz);
+ ICONES(0) := new ikona(1,p,q,NOM);
+ for i := 1 to nb
+ do
+ p := new punkt(MinX+2 +(i-1)*dl,minY+sz+2) ;
+ q := new punkt(p.x+dl-2,p.y+sz);
+ ICONES(i) := new ikona(c_lightGrey,p,q,OPTIONS.NOM(i));
+ od;
+ call ramki_menu;
+ return;
+
+ do (* obsluga menu *)
+
+ call instalation; (* rysowanie ikon z tego menu *)
+ do
+ z:=0;
+ while not z=1 do
+ call GUI_MousePressed(xx,yy,z) ;
+ od;
+ call sleep(2); (*nie umiem powstrzymac myszy*)
+ boo := false;
+ (*szukam gdzie zostal nacisniety klawisz myszki*)
+ for j :=1 to nb
+ do
+ if( ICONES(j).p.x<xx and xx<ICONES(j).q.x
+ and ICONES(j).p.y<yy and yy<ICONES(j).q.y)
+ then
+ boo := true; exit;
+ fi;
+ od;
+ if boo then
+ boo := false;
+ call OPTIONS.Action(j);
+ if j=1 then detach; exit fi;
+ if ICONES(j).sub_menu<>none then
+ attach(ICONES(j).sub_menu);
+ exit;
+ fi;
+
+ fi;
+ od;
+ od;
+ end menu;
+
+(*------------------------------------------------------------------------*)
+(* MOJE MENU *)
+(* menu jest korutina *)
+(* ma swoje opcje, z ktorych kazda moze miec swoje pod-menu *)
+(* kazda opcja odpowiada jakiejs akcji, po wykonaniu ktorej *)
+(* zostaje uaktywnione pod-menu, o ile istnieje *)
+(*------------------------------------------------------------------------*)
+
+
+
+
+ unit OPTIONS_MAIN : option class;
+ unit virtual Action : procedure(j : integer);
+ var ss : string;
+ begin
+
+ case j
+ when 1 : ss :="";
+ when 2 : ss := "Create a new graph or take from a file or memory";
+
+ when 3 : call warning(
+ "To STOP the execution of an algorithme press BUTTON RIGHT!");
+ call waittt; ss :="";
+ when 4 : ss :="usr/local/examp/graf.txt";
+ open(help_file,text,unpack(ss));
+ call reset(help_file);
+ esac;
+ call warning(ss);
+ end;
+ begin
+ Nom(1) := "exit";
+ Nom(2) := "graph";
+ Nom(3) := "algorithms";
+ Nom(4) := "help";
+ end OPTIONS_MAIN;
+
+ unit OPTIONS_GRAPH : option class;
+ unit virtual Action : procedure(j : integer);
+ var ss : string;
+ begin
+
+ case j
+ when 1 : call warning(""); call comment("");
+ when 2 : call clear_all(c_lightGrey);
+ when 3 : call warning("Import a graph from the file or from the memory ");
+ when 4 : call warning("Modify the existing graph ");
+ when 5 :
+ if GRAF<>none then
+ call warning("Saving the recently defined graph.");
+ call GRAF.save
+ else
+ call warning("GRAPH IS EMPTY");
+ call waittt;
+ fi;
+
+ when 6 : call warning("Create a new graph");
+ GRAF := new graph;
+ call GRAF.directORnot;
+ call clear(c_red);
+
+ esac;
+ end;
+ begin
+ Nom(1) := "return";
+ Nom(2) := "clear";
+ Nom(3) := "import";
+ Nom(4) := "modify";
+ Nom(5) := "save";
+ Nom(6) := "create";
+ end OPTIONS_GRAPH;
+
+ unit OPTIONS_ALGO : option class;
+ unit virtual Action : procedure(j : integer);
+ var i : integer, ch : char;
+ begin
+ (* miejsce komentarzy *)
+ case j
+ when 1 : call comment(""); call warning("");
+ when 2 : call comment(
+ "To STOP the execution of an algorithme press RIGHT BUTTON");
+ call waittt; call comment("");
+ if Graf<>none then
+ if GRAF.obraz<> none then
+ call GUI_PutImg(MinX+2, MinY+40,Graf.obraz)
+ else call GRAF.print fi;
+ (* wybor wierzcholka od ktorego zacznamy chodzenie*)
+ call GRAF.change_root;
+ fi;
+
+ when 3 : call WARNING( "");
+ when 4 : call comment( "Depth First Search recursive ");
+ if graf<> NONE THEN
+ call GRAF.restore;
+ call traverse_rec(GRAF);
+ fi;
+ when 5 : call comment( "TOPOLOGICAL Sort ");
+ call warning("This algorithm require a graph without cycl!");
+ call waittt;
+ call warning("");
+ if graf<> NONE THEN
+ call xxxxx(GRAF);
+ fi;
+ esac;
+
+ end Action;
+ begin
+ NOM(1) := "return";
+ NOM(2) := "search";
+ NOM(3) := "cycls";
+ NOM(4) := "recur";
+ NOM(5) := "top_sort";
+ end OPTIONS_ALGO;
+
+
+ unit OPTIONS_cycl : option class;
+ unit virtual Action : procedure(j : integer);
+ var i : integer;
+ begin
+ case j
+ when 1 : call comment(""); call warning("");
+
+ when 2 :
+ if graf<> NONE THEN
+ call cycle_fond(GRAF);
+ fi;
+ call warning("ALL the fundamental cycls of the graph");
+ when 3 :
+ call warning("");
+ if graf<> NONE THEN
+ call EULER(GRAF);
+ fi;
+ when 4 :
+ call warning("Find a Hamilton's cycl");
+ if graf<> NONE THEN
+ call HAMILTON(GRAF);
+ fi;
+
+ when 5 :
+ call warning("");
+ call GUI_Rect(MinX,MinY+40,MaxX,MaxY,c_lightGrey,c_LightGrey);
+ if GRAF<>none then call GRAF.print fi;
+ esac;
+
+ end Action;
+ begin
+ NOM(1) := "return";
+ NOM(2) := "fundamental";
+ NOM(3) := "Euler";
+ NOM(4) := "Hamilton";
+ NOM(5) := "restore "
+ end OPTIONS_cycl;
+
+
+
+ unit OPTIONS_help : option class;
+ var page_nb : integer;
+ unit virtual Action : procedure(j : integer);
+ var i ,x,y: integer, ch : char;
+ begin
+ case j
+ when 1 : (* przy powrocie odnawiam ramki dla menu*)
+ call ramki_menu;
+ when 2 : call GUI_Rect(MinX,MinY+40,MaxX,MaxY,c_black,c_black);
+ call warning("");
+ page_nb := page_nb + 1;
+
+ for i := 1 to 19
+ (* drukuje tylko 19 linijek bo ekran jest maly*)
+ do x:=MinX+5; y:=MinY+40+13*i;
+ call GUI_move(x, y);
+ while not eof(help_file)
+ do
+ read(help_file,ch);
+ if ord(ch)=10 then exit else
+ call GUI_writeChar(x,y,ch,c_white,c_black);
+ x:= x+ 10;
+ fi
+ od
+ od;
+ if eof(help_file) then call warning("END OF FILE") fi;
+
+ when 3 : page_nb := page_nb - 1;
+ (* zresetowac i przewinac o nb stron; strona=19linijek*)
+ call reset(help_file);
+ call GUI_Rect(MinX,MinY+40,MaxX,MaxY,c_black,c_black);
+ for i := 1 to 19* page_nb
+ do
+ while not eof(help_file)
+ do
+ read(help_file,ch);
+ if ord(ch)=10 then exit fi;
+ od
+ od;
+
+ for i := 1 to 19
+ (* drukuje tylko 19 linijek bo ekran jest maly*)
+ do
+ call GUI_move(MinX+5, MinY+40+13*i);
+ while not eof(help_file)
+ do
+ read(help_file,ch);
+ if ord(ch)=10 then exit else call HASCII(ord(ch)) fi;
+ od
+ od;
+
+ when 4 :
+ call GUI_Rect(MinX,MinY+40,MaxX,MaxY,c_lightGrey,c_lightGrey);
+ call reset(help_file);
+ call warning("");
+ page_nb:= 0;
+ esac;
+
+ end Action;
+ begin
+ page_nb := 0;
+ NOM(1) := "return";
+ NOM(2) := "next";
+ NOM(3) := "prev";
+ NOM(4) := "reset";
+ end OPTIONS_help;
+
+ unit OPTIONS_import : option class;
+ unit virtual Action : procedure(j : integer);
+ begin
+ case j
+ when 1 : call comment(""); call warning("");
+ when 2 : call warning("From file c:\loglan95\graf.dta ");
+ graf := new graph;
+ call GRAF.take; call GRAF.print;
+
+ when 3 : call warning(" Taking current graf from memory ");
+ if Graf<>none then
+ if GRAF.obraz<>none then
+ call GUI_putImg(MinX+2, MinY+40,Graf.obraz) fi
+ else call warning("Graph is empty")fi;
+ esac;
+ end Action;
+ begin
+ NOM(1) := "return";
+ NOM(2) := "file";
+ NOM(3) := "memory";
+ end OPTIONS_import;
+
+ unit OPTIONS_modify : option class;
+ unit virtual Action : procedure(j : integer);
+ begin
+ case j
+ when 1 : call comment(""); call warning("");
+ when 2 : call warning("Add a new node using button RIGHT of the mouse");
+ if Graf<>none then
+ call GRAF.createNODE
+ else call warning(" GRAPH IS EMPTY!")
+ fi;
+
+ when 3 : call warning("Add a new arc ");
+ if GRAF<>none then call GRAF.createARC('i')
+ else
+ call warning("Graph is empty")
+ fi;
+
+ when 4 : if GRAF<>none then call GRAF.DeleteARC('d')
+ else
+ call warning("Graph is empty")
+ fi;
+
+ when 5 : if graf<>none then
+ call GRAF.print
+ else
+ call warning("Graph is empty")
+ fi;
+
+ when 6 : call warning("The current immage of the graph is saved.");
+ if graf<> none then
+ call move(MinX+2,MinY+40);
+ Graf.obraz := getmap(MaxX-2,MaxY-2)
+ else call warning("Graph was not yet created")fi;
+
+ when 7 : call warning(
+ "This is the immage of the graph previously saved");
+ if Graf<>none then
+ call move(MinX+2, MinY+40);
+ if GRAF.obraz<>none then call putmap(Graf.obraz)fi
+ else call warning("The image of Graph is empty")fi;
+
+ esac;
+ end Action;
+
+ begin
+ Nom(1) := "return";
+ Nom(2) := "add node";
+ Nom(3) := "add arc";
+ Nom(4) := "del arc";
+ Nom(5) := "print";
+ Nom(6) := "getmap";
+ Nom(7) := "putmap";
+ end OPTIONS_modify;
+
+ unit OPTIONS_go : option class;
+ unit virtual Action : procedure(j : integer);
+ var ss : string;
+ begin
+ (* miejsce komentarzy *)
+ case j
+ when 1 : call comment( ""); call warning("");
+ when 2 : call comment( "Breadth First Search ");
+ if GRAF<> none then
+ call GRAF.restore;
+ call BFS_bis( GRAF);
+ FI;
+ when 3 : call comment( "Depth First Search ");
+ if graf<> NONE THEN
+ call GRAF.restore;
+ call DFS(GRAF);
+ fi;
+ when 4 : call comment( "STRANGE Search ");
+ if graf<> NONE THEN
+ call GRAF.restore;
+ call WHAT(GRAF);
+ fi;
+ when 5 : call comment( "Breadth First Search_BIS ");
+ if GRAF<> none then
+ call GRAF.restore;
+ call BFS_bis( GRAF);
+ FI;
+ when 6 : call comment( "PILE_FILE SEARCH ");
+ if GRAF<> none then
+ call GRAF.restore;
+ call PI_FI( GRAF);
+ FI;
+
+ when 7 : if Graf<>none then
+ call GRAF.print
+ else call warning("Graph is empty")fi;
+
+ when 8 : call clear(c_blue);
+
+ esac;
+
+ end Action;
+ begin
+ Nom(1) := "return";
+ Nom(2) := "BFS";
+ Nom(3) := "DFS";
+ Nom(4) := "WHAT?";
+ Nom(5) := "BFS_2";
+ Nom(6) := "DFS_2";
+ Nom(7) := "print";
+ Nom(8) := "clear"
+ end OPTIONS_go;
+
+VAR i, delta : integer,
+ boo : boolean,
+ O_main, O_help, O_cycl,
+ O_graph, O_algo, O_import, O_modify, O_go : option,
+ menu_main, menu_aux : menu,
+ GRAF : GRAPH,
+ w : node,
+ G_file,help_file : file;
+handlers
+ others call warning(" ERROR press Y to continue or N to stop?");
+
+ boo := YES;
+ if not boo then call GROFF; call ENDRUN fi;
+ call warning("");
+ wind;
+
+end handlers;
+
+begin
+ (****** program glowny ******)
+
+
+
+
+ call GUI_Rect(MinX,MinY,MaxX,MaxY,c_lightGrey,c_lightGrey);
+ for i := 1 to 14 do
+ call GUI_Writetext(150+i*5,100+i*4,
+ unpack("B R E A D T H F I R S T S E A R C H"),i,c_black);
+ call GUI_Writetext(200-i*5,200+i*4,
+ unpack("D E P T H F I R S T S E A R C H"),i,c_black);
+ od;
+ call waittt;
+
+ O_MAIN := new OPTIONS_MAIN(4);
+ menu_main := new menu("MAIN_MENU",minX,maxX,minY,maxY,O_MAIN);
+
+ O_graph := new OPTIONS_graph(6);
+ menu_main.ICONES(2).sub_menu, menu_aux :=
+ new menu("CREATE or TAKE A GRAPH",minX,maxX,minY,maxY,O_graph);
+
+ O_import := new OPTIONS_import(3);
+ menu_aux.ICONES(3).sub_menu :=
+ new menu("TAKE GRAPH from a file or from memory",minX,maxX,minY,maxY,O_import);
+
+ O_modify := new OPTIONS_modify(7);
+ menu_aux.ICONES(4).sub_menu :=
+ new menu("MODIFY THE GRAPH",minX,maxX,minY,maxY,O_modify);
+
+ menu_aux.ICONES(6).sub_menu :=
+ new menu("MODIFY THE GRAPH",minX,maxX,minY,maxY,O_modify);
+
+
+ O_algo := new OPTIONS_algo(5);
+ menu_main.ICONES(3).sub_menu,menu_aux :=
+ new menu("ALGORITHMES on GRAPHS",minX,maxX,minY,maxY,O_algo);
+
+
+ O_go := new OPTIONS_go(8);
+ menu_aux.ICONES(2).sub_menu :=
+ new menu("BREDTH FIRST SEARCH or DEPTH FIRST SEARCH",minX,maxX,minY,maxY,O_go);
+
+ O_cycl := new OPTIONS_cycl(5);
+ menu_aux.ICONES(3).sub_menu :=
+ new menu("RECHERCHE the CYCLS",minX,maxX,minY,maxY,O_cycl);
+
+
+ O_help := new OPTIONS_help(4);
+ menu_main.ICONES(4).sub_menu :=
+ new menu("HELP",minX,maxX,minY,maxY,O_help);
+
+
+ attach(menu_main);
+
+
+ while true do
+ call warning("DO YOU REALY LIKE TO EXIT (Y/N)?");
+ boo := YES;
+ if boo then exit fi;
+ call warning("");
+ attach(menu_main);
+ od;
+ call GROFF;
+ end;
+ end
+ end graf;
+
+
+
+
+
+
+
+ (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+ (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+\0\0
\ No newline at end of file
--- /dev/null
+
+
+ PROGRAM LIFT;
+ signal signal1;
+
+(* symulacja windy wersja 5, 1 kwietnia 2000 *)
+(*------------------------------------------------------------------------*)
+(* klasa definiujaca procedury graficzne *)
+(*------------------------------------------------------------------------*)
+ UNIT graph : IIUWGRAPH CLASS;
+ CONST
+
+ MinX = 0, MinY = 0,
+ MaxX = 640, MaxY = 480,
+ minDx = 50,minDy=10,maxDx= 600,maxDy=450,
+
+ czarny = 0,
+ czerwony = 4,
+ szary = 7,
+ cyklamen = 13,
+ bialy = 15;
+
+
+ UNIT waitt : PROCEDURE;
+ (* wait for a key *)
+ BEGIN
+ DO
+ IF INKEY =/= 0 THEN exit FI;
+ OD;
+ END waitt;
+
+ unit ludzik : procedure(x,y,k:integer);
+ begin
+ call color(k);
+ call move(x,y);
+ call draw(x,y+6);
+ call draw(x-2,y+10);
+ call move(x,y+6);
+ call draw(x+2,y+10); call move(x-2,y+2);
+ call draw(x+2,y+2);
+ call move(x-2,y+2);
+ call draw(x-4,y+4);
+ call move(x+2,y+2);
+ call draw(x+4,y+4)
+ end ludzik;
+
+ unit COMMENT : procedure(ss: string);
+ begin
+ call outstring(250,460,ss,cyklamen,15)
+ end COMMENT;
+
+ END graph;
+
+(*----------------------------------------------------------------------*)
+
+
+ UNIT EcRAN : graph process(node :integer);
+ const
+ H = 30,(* odleglosc miedzy pietrami*)
+ xMAXw = 400, xMINw =200, yMaxW =400,
+ xpp = 405, xpl = 195, (* poczatkowe pozycje ludzikow*)
+ yp = 400;
+ var i : integer,
+ PIETRA : arrayof etage,
+ MAP : arrayof integer;
+
+ UNIT etage : class;
+ var GORA, DOL : arrayof boolean;
+ begin
+ array GORA dim(1:20); (* 20 maksymalna liczba pasazerow na pietrze*)
+ array DOL dim(1:20);
+ end etage;
+
+
+ UNIT obrazWindy : procedure(pietro : integer);
+ begin
+ call move(XminW,YmaxW-(pietro+1)*H);
+ MAP := getmap(XmaxW,YmaxW-pietro*H);
+ end ObrazWindy;
+
+ UNIT RysujWinde : procedure(Y,kolor: integer);
+ begin
+ if kolor= bialy then
+ CALL patern (XminW,Y,XmaxW,Y+H,bialy,1)
+ else
+ call move(XminW,Y);
+ call putmap(MAP)
+ fi;
+ (* i wszystkich jej pasazerow *)
+ end RysujWinde;
+
+ UNIT DOM : procedure(kolor,ile_pieter:integer);
+ (* szyb windy i pietra *)
+ var i :integer;
+ begin
+ call patern(minDX,minDY,maxDX,maxDY,szary,1);
+ CALL patern (xMINw-2,yMaxW-(ile_pieter+1)*H,xMAXw+2,yMAXw,czarny,1);
+ call color(2);
+ for i := 0 to ile_pieter do
+ call move(minDX,yMaxW-i*H); call draw(maxDX,yMAXw-i*H);
+ (* call Guzik(true,szary,i);*)
+ (* call Guzik(false,szary,i);*)
+ od;
+ i := ile_pieter+1;
+ call move(minDX,yMAXw-i*H); call draw(maxDX,yMAXw-i*H);
+
+ CALL patern (xMINw,yMAXw-i*H,xMAXw,yMAXw,bialy,1);
+
+ end DOM;
+
+ unit JESTEM : procedure(gora:boolean,k,z:integer;output i:integer);
+ var j : integer;
+ begin
+ if gora then
+ for j:=1 to 20 do
+ if not PIETRA(z).gora(j) then
+ PIETRA(z).gora(j):= true;
+ call ludzik(xpp+10*j,yp-z*H-12,k);
+ i:=j; return
+ fi
+ od
+ else
+ for j:=1 to 20 do
+ if not PIETRA(z).dol(j) then
+ PIETRA(z).dol(j):= true;
+ call ludzik(xpl-10*j,yp-z*H-12,k);
+ i:=j; return
+ fi
+
+ od
+ fi;
+ end JESTEM;
+
+ unit usunZpietra: procedure(gora: boolean,pietro,i : integer);
+ begin
+ if gora then
+ PIETRA(pietro).gora(i) := false;
+ call ludzik(xpp+10*i,yp-pietro*H-12,szary);
+ else
+ PIETRA(pietro).dol(i):= false;
+ call ludzik(xpl-10*i,yp-pietro*H-12,szary);
+ fi;
+ end usunZpietra;
+
+ unit Guzik : procedure(gora:boolean,k,i : integer);
+ begin
+ if gora then
+ call track(MaxDx-20,yMAXw-i*H-20,k,czarny,i)
+ else
+ call track(MinDx+20,yMAXw-i*H-20,k,czarny,i)
+ fi;
+ end Guzik;
+
+ unit otworz : procedure(gora: boolean,i: integer);
+ begin
+ if gora then
+ call patern(xMAXw,yMAXw-(i+1)*H,xMAXw+2,yMAXw-(i)*H,szary,1)
+ else
+ call patern(xMINw,yMAXw-(i+1)*H,xMINw-2,yMAXw-(i)*H,szary,1)
+ fi;
+ end otworz;
+
+ unit zamknij : procedure(gora:boolean,i: integer);
+ begin
+ if gora then
+ call patern(xMAXw,yMAXw-(i+1)*H,xMAXw+2,yMAXw-(i)*H,czarny,1);
+ else
+ call patern(xMINw,yMAXw-(i+1)*H,xMINw-2,yMAXw-(i)*H,czarny,1)
+ fi;
+ end zamknij;
+
+
+ unit Koniec: procedure;
+ var i : integer;
+ begin
+ for i:=1 to 2000 do i:=i od;
+ CALL GROFF; call ENDRUN
+ end Koniec;
+
+ handlers
+ others call comment("handler EKRAN ");
+ call KONIEC;
+ end handlers;
+ begin
+ call GRON(0);
+ array PIETRA dim(0:10);
+ for i := 0 to 10 do PIETRA(i) := new etage od;
+ CALL patern (xminW,yMaxW-H,xmaxW,yMaxW,szary,1);
+ call ObrazWindy(0); (* obraz windy pustej na parterze *)
+ return;
+ do
+ accept RysujWinde, JESTEM, DOM, COMMENT,LUDZIK,
+ obrazWindy, GUZIK, usunZpietra, OTWORZ, ZAMKNIJ, KONIEC;
+ od;
+
+ end ECRAN;
+
+
+(*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+
+
+ UNIT LIFT : process(node,n,MAXp : integer, EKRAN : ecran);
+ (* n = ilosc pieter, MAXp = maxymalna ilosc pasazerow w windzie *)
+ (* ile = ilosc pasazerow aktualnie w windzie *)
+ CONST
+ minX =200, maxY = 400, maxX=400, H=30,
+ xMINw =200, xMAXw =400, yMAXw = 400,
+ kolor = 7,
+ szary = 7,
+ czerwony = 5,
+ czarny = 0,
+ gora = true,
+ dol = false;
+ VAR i,j,p,jedzNa, NaPietrze,ile : integer,
+ booo, kierunek, stoj : boolean,
+ PIETRA : arrayof guzik,
+ PRZYCISKI : arrayof boolean,
+ WWindzie : arrayof boolean;
+
+ UNIT opis : class( k,x,y : integer); (* opis pasazera*)
+ (* x,y odpowiada pozycji na pietrze lub w windzie *)
+ end opis;
+
+ UNIT guzik : class;
+ var WGORE, Wdol : boolean;
+ end guzik;
+
+ UNIT pauza : PROCEDURE(JakDlugo : integer);
+ var i : integer;
+ BEGIN
+ for i :=1 to JakDlugo do i:=i od;
+ END pauza;
+
+
+ UNIT Wolam : procedure(Gora : boolean, pietro : integer);
+ begin
+ if gora then
+ PIETRA(pietro).wgore := true else PIETRA(pietro).wdol := true
+ fi;
+ call EKRAN.guzik(gora,czerwony,pietro)
+ end Wolam;
+
+ UNIT PasazerWysiada : procedure(j : integer);
+ var y : integer;
+ begin
+ (* Wymazac go z windy *)
+ Wwindzie(j):= false;
+ y := yMaxW - naPietrze*H;
+ call EKRAN.ludzik(xMINw+10*j,y-12,szary);
+ ile := ile -1;
+ PRZYCISKI(naPietrze):= false;
+ call Ekran.ObrazWindy(naPietrze)
+ end PasazerWysiada;
+
+ UNIT PasazerWsiada : procedure(z,na,k,poz:integer; output p:integer);
+ var i,j,y : integer;
+ begin
+
+ if not (naPietrze=z and kierunek=(z<na) and ile< maxP) then
+ p:= 0; return
+ fi;
+ (* Wymaz pasazera z pietra z=naPietrze*)
+ call EKRAN.UsunZpietra(z<na,naPIETRZE,poz);
+ y := yMaxw- naPietrze*H;
+
+ (* Wpisz go do windy *)
+ for j:=1 to 20 do
+ if not Wwindzie(j) then
+ Wwindzie(j):= true;
+ (* ludzik idzie *)
+ p := j;
+
+ for i:= 1 to j-1 do
+ call EKRAN.ludzik(xMAXw-10*i,y-12,k);
+ call pauza(200);
+ call EKRAN.ludzik(xMAXw-10*i,y-12,7);
+ call pauza(200)
+ od;
+ call EKRAN.ludzik(xMINw+10*j,y-12,k);
+ call pauza(300);
+ exit
+ fi
+ od;
+ ile := ile+1;
+ call Ekran.RysujWinde(yMaxW-(naPietrze+1)*H,k);
+ call Ekran.Ludzik(xMinW+10*j,y-12,k);
+ PRZYCISKI(na):= true;
+ call Ekran.ObrazWindy(naPietrze)
+ end PasazerWsiada;
+
+
+ UNIT PRZYJECHALA : function(p:integer) : boolean;
+ begin
+ result := (naPietrze=p)
+ end PRZYJECHALA;
+
+ unit CZEKAM : procedure(i: integer);
+ begin
+ call Ekran.Otworz(gora,i);
+ call Ekran.Otworz(dol,i);
+ enable PRZYJECHALA,PASAZERWSIADA, PASAZERWYSIADA;
+
+ call Ekran.Guzik(gora,czerwony,i);
+ call Ekran.Guzik(dol,czerwony,i);
+(* return enable WOLAM,PRZYJECHALA,PASAZERWSIADA, PASAZERWYSIADA;*)
+
+ end CZEKAM;
+
+ UNIT OtwieramDrzwi : procedure( i: integer);
+ begin
+ call Ekran.Otworz(kierunek,i);
+ enable PRZYJECHALA,PASAZERWSIADA, PASAZERWYSIADA;
+ call Ekran.Guzik(kierunek,czerwony,i);
+ end OtwieramDrzwi;
+
+ UNIT ZamykamDrzwi : procedure(gora:boolean, i: integer);
+ begin
+ disable WOLAM;
+ if gora then
+ PIETRA(i).wgore := false else PIETRA(i).wdol := false
+ fi;
+ enable WOLAM;
+
+ call Ekran.Zamknij(gora,i);
+ call Ekran.Guzik(gora,szary,i);
+ disable PRZYJECHALA,PASAZERwsIADA, PASAZERwySIADA;
+ end ZamykamDrzwi;
+
+ UNIT KierunekJazdy : procedure;
+ var i : integer;
+ begin
+ JEDZna := naPietrze;
+
+ if (kierunek= gora) then
+ for i := naPIETRZE+1 to n
+ do
+ if (PRZYCISKI(i) or PIETRA(i).wgore or PIETRA(i).wdol) then
+ JedzNa := i; exit fi
+ od;
+ if JedzNa=naPietrze then
+ for i := naPIETRZE-1 downto 0
+ do
+ if (PRZYCISKI(i) or PIETRA(i).wdol or PIETRA(i).wgore) then
+ JedzNa := i; exit fi
+ od;
+ fi;
+ else (*if kierunek= dol then *)
+ for i := naPIETRZE downto 0
+ do
+ if (PRZYCISKI(i) or PIETRA(i).wdol or PIETRA(i).wgore) then
+ JedzNa := i; exit fi
+ od;
+ if JedzNa= naPietrze then
+ for i := naPIETRZE+1 to n
+ do
+ if (PRZYCISKI(i) or PIETRA(i).wgore or PIETRA(i).wdol) then
+ JedzNa := i; exit fi
+ od;
+ fi;
+ fi;
+ stoj := (naPIETRZE=JEDZna);
+ if stoj then kierunek := not kierunek else
+ kierunek := naPietrze < JedzNa
+ fi;
+
+ END KierunekJazdy;
+
+ unit JEDZ : procedure(gora:boolean);
+ var j : integer;
+ begin
+ call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H,7);
+ if gora then
+ for j := 0 to H-1 do
+ call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H -j,7);
+ call pauza(2);
+ call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H -j,15);
+ call pauza(2)
+ od;
+ call EKRAN.RysujWinde(YmaxW-(naPietrze+2)*H,7)
+ else
+ for j:= 0 to H-1 do
+ call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H +j,7);
+ call pauza(2);
+ call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H +j,15);
+ call pauza(2);
+ od;
+ call EKRAN.RysujWinde(YmaxW-(naPietrze)*H,7);
+ fi;
+ end jedz;
+
+ handlers
+ others call EKRAN.comment("handler LIFT");
+ call pauza(500);
+ call EKRAN.KONIEC
+ end handlers;
+
+ BEGIN
+ array PIETRA dim(0:n);
+ for i:= 0 to n do PIETRA(i):= new guzik od;
+ array PRZYCISKI dim (0:n);
+ jedzNa := 0; naPietrze:=0;
+ array WWindzie dim(1: MAXp); (* 20 = max ilosc pasazerow *)
+
+ enable Wolam;
+ kierunek := gora;
+
+ return;
+ call EKRAN.RysujWinde(YmaxW-H, szary);
+
+ DO
+ stoj:= true;
+ while stoj
+ do
+ call CZEKAM(naPIETRZE);
+ for j := 1 to 10 do j := j od;
+ call KIERUNEKjazdy;
+ od;
+ call ZamykamDrzwi(gora,naPIETRZE);
+ call ZamykamDrzwi(dol,naPIETRZE);
+
+ if kierunek = gora then
+ for i:= naPIETRZE+1 to JEDZna DO
+ (* jade na nastepne pietro *)
+ call JEDZ(gora);
+ naPietrze:= i;
+ (*jezeli ktos czeka lub wysiada to zatrzymaj*)
+ if (PIETRA(i).wgore or PRZYCISKI(i)) then
+ call pauza(500);
+ call OtwieramDrzwi(i);
+ (* pasazerowie wsiadaja lub wysiadaja *)
+ for j := 1 to 1000 do j := j od;
+ call ZamykamDRZWI(gora,i);
+ fi;
+ od(* jedzNA*)
+ else
+ (*if kierunek = dol*)
+
+ for i := naPIETRZE-1 downto jedzNA do
+ (* zjezdzam w dol *)
+ call JEDZ(dol);
+ naPietrze:= i;
+ if ( PIETRA(i).wdol or PRZYCISKI(i)) then
+ call pauza(500);
+ call OtwieramDrzwi(i);
+ (* pasazerowie wsiadaja/ wysiadaja*)
+ call pauza(500);
+ call ZamykamDrzwi(dol,i);
+ fi;
+
+ od (* jedz w dol NA*);
+ fi;
+
+ OD (* zachowania windy *);
+ END LIFT;
+
+
+(*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+
+
+ UNIT PASAZER : process(node:integer,ss: string,z,na,kolor : integer,
+ winda: lift,EKRAN : ecran);
+ const szary = 7;
+ var i,j : integer,
+ jest,przyjechala,Wgore,wsiadlem : boolean;
+
+ handlers
+ others
+ call EKRAN.comment("handler PASAZER");
+ call EKRAN.KONIEC;
+ end handlers;
+
+ BEGIN (*** opis zachowania pasazera ***)
+
+ return;
+ Wgore := na>z;
+ call EKRAN.JESTEM(Wgore,kolor,z,i);
+ (*powinien otrzymac inormacje o swojej aktualnej pozycji na pietrze*)
+ wsiadlem := false; przyjechala:= false;
+
+ while not wsiadlem do
+ call Winda.Wolam(Wgore,z);
+ call WINDA.PasazerWsiada(z,na,kolor,i,j);
+ (* otrzymal od windy numerek j m lub 0 gdy nie wsiadl*)
+ wsiadlem :=(j<>0)
+ od;
+ while not przyjechala do
+ przyjechala := WINDA.PRZYJECHALA(na)
+ od;
+ call WINDA.PasazerWysiada(j);
+ END pasazer;
+(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+
+ UNIT irandom : FUNCTION(a,b:INTEGER):INTEGER;
+ begin
+ result := entier((b-a)*random + a)
+ end irandom;
+
+
+
+
+ (*===================================================================*)
+VAR EKRAN : ecran, Winda : LIFT,
+ P : arrayof PASAZER,pp :PASAZER,
+ i,n,m,z,na,k : integer;
+ handlers
+ when signal1 : call EKRAN.comment("K O N I E C");
+ call EKRAN.KONIEC;
+ others call EKRAN.comment("handler PROGRAM GLOWNY ");
+ call EKRAN.KONIEC
+ end handlers;
+
+BEGIN
+ EKRAN := new Ecran(0);
+ resume(EKRAN);
+ n :=10; m := 1;(* calkowita ilosc pasazerow*)
+
+ call Ekran.DOM(7,n);
+ readln;
+ array P dim(1:m);
+ Winda := new LIFT(0,n,10,EKRAN);
+
+ resume(Winda);
+
+readln;
+ DO (* generowanie pasazerow *)
+
+ for i := 1 to m
+ do
+ na,z := irandom (0,n);
+ while z=na do na := irandom(0,n) od;
+ k := 7;
+ while k=7 do k := irandom (0,14) od;
+
+ pp:= new pasazer(0,"aa",z,na,k,winda,EKRAN);
+ resume(pp);
+ od;
+
+ pref IIUWGRAPH block
+ var boo : boolean, x,y,i,l,r,z : integer;
+ begin
+ (* call init(1,1); call ShowCursor;*)
+ call EKRAN.comment("CONTINUE? (y/n)");
+
+ (* z:=0;boo:= false; i:=0;l:=0;r:=0;
+ while not (l= ord('y') or l= ord('n')) do
+ boo := getpress(x,y,i,l,r,z);
+ od;
+ *)
+ while not (l=ord('y') or l=ord('n')) do
+ l:=inkey;
+ od;
+ call EKRAN.comment(" ");
+
+ if l= ord('n') then raise signal1 fi;
+
+ end;
+ OD;
+
+
+END LIFT;
+
+(***********************************************************************)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ unit zegar: process;
+ var i,j:integer;
+
+ begin
+ do
+ call ramka(420,310,480,335);
+ call ramka(422,312,478,333);
+ call ramka(421,311,479,334);
+ call move(433,320);
+ call wypisz(i);
+ call outstring(":");
+ call wypisz(j);
+ j:=j+1;
+ if j=60 then j:=0;i:=i+1 fi;
+ call hold(1)
+ od
+ end zegar;
+
+
+
+
+
+ unit ramka:iiuwgraph procedure(x1,y1,x2,y2:integer);
+ begin
+ call move(x1,y1);
+ call draw(x2,y1);
+ call draw(x2,y2);
+ call draw(x1,y2);
+ call draw(x1,y1)
+ end ramka;
+
+
+ unit elem : class;
+ unit virtual affichage : procedure;
+ end affichage;
+ end elem;
+
+ unit box : class;
+ var e: elem, next : box;
+ end box;
+
+ unit queue : class;
+ var premier, dernier : box;
+
+ unit virtual first : function : elem;
+ begin
+ if not empty
+ then
+ result := premier.e;
+ fi;
+ end first;
+
+ unit virtual insert : procedure( e: elem);
+ var aux : box;
+ begin
+ aux := new box;
+ aux.e := e;
+ if premier=none
+ then
+ premier := aux;
+ dernier := aux;
+ else
+ dernier.next := aux;
+ dernier := aux
+ fi;
+ end insert;
+
+ unit virtual delete : procedure;
+ begin
+ if not empty
+ then
+ premier := premier.next;
+ fi;
+ end delete;
+
+ unit virtual empty : function : boolean;
+ begin
+ result := (premier=none)
+ end empty;
+ end queue;
+
+END STRUC_QUEUE;
+
+
+
+ unit wstep:procedure;
+ begin
+ call gron(0);
+ call ramka(230,120,480,220);
+ call ramka(228,118,482,222);
+ call ramka(226,116,484,224);
+ call move(250,160);
+ call outstring("Symulacja windy przy pomocy procesow");
+ call move(250,180);
+ call outstring("GM");
+ call move(250,200);
+ call outstring(" Dabrowa kwiecien 2000");
+ WHILE INKEY=0 DO OD;
+ call groff
+ end wstep;
+
+
+ (* Strona tytulowa *)
+ CONTINUE_IKONA := new IKONA(szary,400,400,550,430,3," CONTINUE");
+ CALL ramka (1,5,0,0,638,478,ciemnoszary,szary,bialy,czarny);
+ CALL ramka (3,3,230,30,390,80,niebieski,szary,bialy,granatowy);
+ CALL Tytul (1,270,50,czarny,szary," LIFT SIMULATION ");
+
+ call CONTINUE_IKONA.write_i;
+
+ do
+ boo := getpress(xx,yy,i,l,r,z);
+ if z=1 and CZY(xx,yy,CONTINUE_IKONA) then exit fi
+ od;
+ call CONTINUE_IKONA.push;
+
+
+
+ handlers
+ when MEMERROR : call comment("Zabraklo pamieci");
+ call waitt; call GROFF;
+ when ACCERROR : call comment("Reference to none ");
+ call waitt; call GROFF;
+ when LOGERROR : call comment("Niepoprawny Attach");
+ call waitt;call GROFF;
+ when CONERROR : call comment(" Array-index error ");
+ call waitt; call GROFF;
+ when SYSERROR : call comment("input-output error");
+ call waitt; call GROFF;
+ when NUMERROR : call comment("blad numeryczny");
+ call waitt; call GROFF;
+ others : call comment("Jakis blad ");
+ call waitt; call GROFF;
+ end handlers;
+
+
+
+
+
+
+
+
+
+ unit restore : procedure;
+ (* odnawia kolory wierzcholkow na ekanie *)
+ var i : integer;
+ begin
+ delta := 0;
+ for i := 1 to nr
+ do
+ lista(i).kolor := zolty;
+ od;
+ end restore;
+
+ UNIT strzalka : procedure(A,B : node);
+ var r : real, cx,cy,dx,dy,ex,ey,delt,del : integer;
+ BEGIN
+ del := 15; delt:=7;
+ call color(zolty);
+ call move(A.x,A.y);
+ call draw(B.x,B.y);
+
+ call color(noir);
+ r := sqrt((b.y-a.y)*(b.y-a.y)+(b.x-a.x)*(b.x-a.x));
+ cx := b.x- entier((b.x-a.x)*del/r );
+ cy := b.y- entier((b.y-a.y)*del/r );
+ dx := b.x- entier((b.x-a.x)*(del+delt)/r + (b.y-a.y)*delt/r);
+ dy := b.y- entier((b.y-a.y)*(del+delt)/r - (b.x-a.x)*delt/r);
+ ex := b.x- entier((b.x-a.x)*(del+delt)/r - (b.y-a.y)*delt/r);
+ ey := b.y- entier((b.y-a.y)*(del+delt)/r + (b.x-a.x)*delt/r);
+ call move(dx,dy); call draw(cx,cy);
+ call move(ex,ey); call draw(cx,cy);
+ END strzalka;
+
+
+ unit print : procedure;
+ var aux, aux1 : node, i : integer;
+ begin
+ call patern(MinX,MinY+40,MaxX,MaxY,7,1);
+ for i :=1 to nr
+ do
+ aux := lista(i);
+ call aux.affichage(zolty);
+ if not aux.lista.empty
+ then
+ aux1 := aux.lista.first;
+ while not aux1= none
+ do
+ call strzalka(aux,aux1);
+ aux1 := aux.lista.next;
+ od
+ fi;
+ od;
+ call comment("")
+ end print;
+
+ begin
+ array lista dim(1:10);
+ nr := 0;
+ end graph;
+
+(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+(* NODE - wierzcholek grafu *)
+(* x,y pozycja na ekranie, nr numer wierzcholka *)
+(* lista - lista wierzcholkow incydentnych *)
+(*----------------------------------------------------------------------*)
+ unit node : elem class(x,y,nr: integer);
+ var lista : liste,
+ kolor : integer;
+
+ unit affichage : procedure(c: integer);
+ begin
+ call cirb(x+3,y+3,5,5,0,3600,c,1);
+ call track(x+5,y+5,nr,gris,noir);
+ end affichage;
+
+ unit wypisz : procedure(i: integer);
+ (* wypisz kolejnosc odwiedzania wierzcholkow *)
+ var j, k : integer;
+ begin
+ for j := 0 to 160 do j:=j; call affichage(j mod 16 ) od;
+ k := (i+9) mod 16;
+ if k = gris then k := noir fi;
+ call affichage(k);
+ call track(piszX+delta,piszY,nr,gris,k);
+ if nr>9 then
+ delta := delta+2*10
+ else
+ delta := delta+10
+ fi;
+ end wypisz;
+
+ unit visite : function : boolean;
+ (* Czy wierzcholek byl juz odwiedzony *)
+ (* Wierzcholek odwiedzony dostaje kolor czarny*)
+ begin
+ if kolor=noir then result := true;
+ else result := false; kolor := noir
+ fi;
+ end visite;
+
+ begin
+ lista := new liste; kolor := zolty;
+ end node;
+
+ unit clear : procedure(col, minX,minY,maxX,maxY : integer);
+ var i, j, sr : integer;
+ begin
+ call color(col);
+ sr := (minX+maxX) div 2;
+ for i := 0 to (maxX - minX) div 2
+ do
+ call move( sr, maxY);
+ call draw(sr +i, minY);
+ call move(sr, maxY);
+ call draw(sr -i, minY);
+ for j:=1 to 100 do j:=j od;
+ od;
+ for i := 0 to (maxY - minY)
+ do
+ call move( sr, maxY);
+ call draw(maxX, minY+i);
+ call move(sr, maxY);
+ call draw(minX, minY+i);
+ for j:=1 to 100 do j:=j od;
+ od;
+
+ end clear;
+
+
+ unit clear_all : procedure(col, minX,minY,maxX,maxY : integer);
+ var i,j : integer;
+ begin
+ call color(col);
+ for i := 1 to ((maxY - minY) div 2)
+ do
+ call patern(minX+i,minY+i,maxX-i,maxY-i,3,0);
+ for j:=1 to 200 do j:=j od;
+ od;
+ end clear_all;
+
+ unit waittt : procedure;
+ var x,y,i,l,r,z : integer,boo : boolean;
+ begin
+ call outstring(maxX-100,maxY+25, "CONTINUE",zielony,noir);
+ boo := false;
+ while z=0 do boo := getpress(x,y,i,l,r,z) od;
+ call outstring(maxX-100,maxY+25, " ",gris,gris);
+
+ end waittt;
+
+ unit YES : function : boolean;
+ var x,y,i,l,r,z : integer,boo : boolean;
+ begin
+ boo := false;
+ while l=0 do boo := getpress(x,y,i,l,r,z) od;
+ if (l= ord('y') or l=ord('Y')) then
+ result := true else result := false
+ fi;
+ end YES;
+
+ unit comment : procedure (s : string);
+ begin
+ call patern(MinX+10,MaxY+2,MaxX,MaxY+50,gris,1);
+ call outstring(MinX+10,MaxY+16,s,noir,gris);
+ end comment;
+
+\80
+\0\0
\ No newline at end of file
--- /dev/null
+
+
+ PROGRAM LIFT5;
+(* wersja styczen 1999*)
+ #include "classes/gui.inc"
+ signal signal1;
+
+(* symulacja windy wersja 4, czerwiec 97 *)
+(*------------------------------------------------------------------------*)
+(* klasa definiujaca procedury graficzne *)
+(*------------------------------------------------------------------------*)
+ UNIT graph : GUI CLASS;
+ CONST
+
+ MinX = 0, MinY = 0,
+ MaxX = 640, MaxY = 480,
+ minDx = 50,minDy=70,maxDx= 600,maxDy=450,
+
+ czarny = c_black,
+ czerwony = c_red,
+ szary = c_LightGrey,
+ cyklamen = c_turq,
+ bialy = c_white;
+
+
+ UNIT waitt : PROCEDURE;
+ (* wait for a key *)
+ BEGIN
+ DO
+ IF GUI_KeyPressed =/= 0 THEN exit FI;
+ OD;
+ END waitt;
+
+ unit ludzik : procedure(x,y,k:integer);
+ begin
+ call GUI_move(x,y);
+ call GUI_LineTo(x,y+6,k);
+ call GUI_LineTo(x-2,y+10,k); (*??*)
+ call GUI_move(x,y+6);
+ call GUI_LineTo(x+2,y+10,k);
+ call GUI_move(x-2,y+2);
+ call GUI_LineTo(x+2,y+2,k);
+ call GUI_move(x-2,y+2);
+ call GUI_LineTo(x-4,y+4,k);
+ call GUI_move(x+2,y+2);
+ call GUI_LineTo(x+4,y+4,k)
+ end ludzik;
+
+ unit COMMENT : procedure(ss : string);
+ begin
+ call GUI_WriteText(250,460,unpack(ss),cyklamen,15)
+ end COMMENT;
+
+ END graph;
+
+(*----------------------------------------------------------------------*)
+
+
+ UNIT EcRAN : graph process(node :integer);
+ const
+ H = 30,(* odleglosc miedzy pietrami*)
+ xMAXw = 400, xMINw =200, yMaxW =400,
+ xpp = 405, xpl = 195, (* poczatkowe pozycje ludzikow*)
+ yp = 400;
+ var i : integer,
+ PIETRA : arrayof etage,
+ MAP : arrayof integer;
+
+ UNIT etage : class;
+ var GORA, DOL : arrayof boolean;
+ begin
+ array GORA dim(1:20); (* 20 maksymalna liczba pasazerow na pietrze*)
+ array DOL dim(1:20);
+ end etage;
+
+
+ UNIT obrazWindy : procedure(pietro : integer);
+ begin
+ MAP := GUI_getImg(XminW,YmaxW-(pietro+1)*H, XmaxW-XminW,H);
+ end ObrazWindy;
+
+ UNIT RysujWinde : procedure(Y,kolor: integer);
+ begin
+ if kolor= bialy then
+ CALL GUI_Rect(XminW,Y,XmaxW,Y+H,bialy,bialy)
+ else
+ call GUI_putImg(XminW,Y,MAP)
+ fi;
+ (* i wszystkich jej pasazerow *)
+ end RysujWinde;
+
+ UNIT schody : procedure(i:integer);
+ var j : integer;
+ begin
+ for j :=1 to 9 do
+
+ call GUI_Line (500+(j+1)*6, YmaxW-i*H+(j-1)*3,
+ 500+(j+1)*6,YmaxW-i*H+j*3,czarny);
+ call GUI_Line( 500+j*6,YmaxW-i*H+(j-1)*3,
+ 500+j*6+6,YmaxW-i*H+(j-1)*3, czarny);
+ od;
+ end schody;
+
+ UNIT okno : procedure(i: integer);
+ begin
+ call GUI_Rect(minDX+10,YmaxW-i*H,
+ minDX+30,YmaxW-i*H+20,czarny,c_yellow);
+ end okno;
+
+ UNIT DOM : procedure(kolor,ile_pieter : integer);
+ (* szyb windy i pietra *)
+ var i : integer;
+ begin
+ call GUI_Rect(minDX,minDY,maxDX,maxDY,1,szary);
+ (* dach *)
+ for i:=1 to 200 do
+ call GUI_Move(250,10);
+ call GUI_LineTo(minDX-20+i, 72,c_darkGrey);
+ od;
+ (*szyb windy*)
+ CALL GUI_Rect(xMINw-2,yMaxW-(ile_pieter+1)*H,xMAXw+2,yMAXw,czarny,czarny);
+ for i := 0 to ile_pieter do
+ call GUI_move(minDX,yMaxW-i*H);
+ call GUI_LineTo(maxDX,yMAXw-i*H,c_red);
+ call GUI_WriteInt(MaxDx-20,yMAXw-i*H-12,i,k,czarny);
+ od;
+
+ for i :=1 to ile_pieter do
+ call schody(i) ; call okno(i)
+ od;
+
+ i := ile_pieter+1;
+ call GUI_move(minDX,yMAXw-i*H);
+ call GUI_LineTo(maxDX,yMAXw-i*H,c_black);
+
+ CALL GUI_Rect(xMINw,yMAXw-i*H,xMAXw,yMAXw,c_white,c_white);
+ for i:=YmaxW to maxDY do
+ call GUI_Line(xMinW,YmaxW,minDx,i,c_darkGrey)
+ od;
+ for i:=YmaxW to maxDY do
+ call GUI_Line(xMaxW,YmaxW,maxDx,i,c_darkGrey)
+ od;
+ end DOM;
+
+ unit JESTEM : procedure(gora:boolean,k,z:integer;output i:integer);
+ var j : integer;
+ begin
+ if gora then
+ for j:=1 to 20 do
+ if not PIETRA(z).gora(j) then
+ PIETRA(z).gora(j):= true;
+ call ludzik(xpp+10*j,yp-z*H-12,k);
+ i:=j; return
+ fi
+ od
+ else
+ for j:=1 to 20 do
+ if not PIETRA(z).dol(j) then
+ PIETRA(z).dol(j):= true;
+ call ludzik(xpl-10*j,yp-z*H-12,k);
+ i:=j; return
+ fi
+ od
+ fi;
+ end JESTEM;
+
+ unit usunZpietra: procedure(gora: boolean,pietro,i : integer);
+ begin
+ if gora then
+ PIETRA(pietro).gora(i) := false;
+ call ludzik(xpp+10*i,yp-pietro*H-12,szary);
+ else
+ PIETRA(pietro).dol(i):= false;
+ call ludzik(xpl-10*i,yp-pietro*H-12,szary);
+ fi;
+ end usunZpietra;
+
+ unit Guzik : procedure(gora:boolean,k,i : integer);
+ begin
+ call GUI_WriteInt(MaxDx-20,yMAXw-i*H-12,i,k,czarny);
+ (* if gora then call GUI_Elipse() else fi; *)
+ end Guzik;
+
+ unit otworz : procedure(gora: boolean, i: integer);
+ begin
+ if gora then
+ call GUI_Rect(xMAXw,yMAXw-(i+1)*H,xMAXw+2,yMAXw-(i)*H,szary,szary)
+ else
+ call GUI_Rect(xMINw,yMAXw-(i+1)*H,xMINw-2,yMAXw-(i)*H,szary,szary)
+ fi;
+ end otworz;
+
+ unit zamknij : procedure(gora:boolean,i: integer);
+ begin
+ if gora then
+ call GUI_Rect(xMAXw,yMAXw-(i+1)*H,xMAXw+2,yMAXw-(i)*H,czarny,czarny);
+ else
+ call GUI_Rect(xMINw,yMAXw-(i+1)*H,xMINw-2,yMAXw-(i)*H,czarny,czarny)
+ fi;
+ end zamknij;
+
+
+ unit Koniec: procedure;
+ var i : integer;
+ begin
+ for i:=1 to 500 do i:=i od;
+ call ENDRUN
+ end Koniec;
+
+ handlers
+ others call comment("handler EKRAN ");
+ call KONIEC;
+ end handlers;
+ begin
+
+ array PIETRA dim(0:10);
+ for i := 0 to 10 do PIETRA(i) := new etage od;
+ CALL GUI_Rect(xminW,yMaxW-H,xmaxW,yMaxW,szary,szary);
+ call ObrazWindy(0); (* obraz windy pustej na parterze *)
+ return;
+ do
+ accept RysujWinde, JESTEM, DOM, COMMENT,LUDZIK,
+ obrazWindy, GUZIK, usunZpietra, OTWORZ, ZAMKNIJ, KONIEC;
+ od;
+
+ end ECRAN;
+
+
+(*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+
+
+ UNIT LIFT : process(node,n,MAXp : integer, EKRAN : ecran);
+ (* n = ilosc pieter, MAXp = maxymalna ilosc pasazerow w windzie *)
+ (* ile = ilosc pasazerow aktualnie w windzie *)
+ CONST
+ minX =200, maxY = 400, maxX=400, H=30,
+ xMINw =200, xMAXw =400, yMAXw = 400,
+ kolor = 7,
+ szary = 7,
+ czerwony = 5,
+ czarny = 0,
+ gora = true,
+ dol = false;
+ VAR i,j,p,jedzNa, NaPietrze,ile : integer,
+ booo, kierunek, stoj : boolean,
+ PIETRA : arrayof guzik,
+ PRZYCISKI : arrayof boolean,
+ WWindzie : arrayof boolean;
+
+ UNIT opis : class( k,x,y : integer); (* opis pasazera*)
+ (* x,y odpowiada pozycji na pietrze lub w windzie *)
+ end opis;
+
+ UNIT guzik : class;
+ var WGORE, Wdol : boolean;
+ end guzik;
+
+ UNIT pauza : PROCEDURE(JakDlugo : integer);
+ var i : integer;
+ BEGIN
+ for i :=1 to JakDlugo do i:=i od;
+ END pauza;
+
+
+ UNIT Wolam : procedure(Gora : boolean, pietro : integer);
+ begin
+ if gora then
+ PIETRA(pietro).wgore := true
+ else
+ PIETRA(pietro).wdol := true
+ fi;
+ call EKRAN.guzik(gora,czerwony,pietro)
+ end Wolam;
+
+ UNIT PasazerWysiada : procedure(j : integer);
+ var y : integer;
+ begin
+ (* Wymazac go z windy *)
+ Wwindzie(j):= false;
+ y := yMaxW - naPietrze*H;
+ call EKRAN.ludzik(xMINw+10*j,y-12,szary);
+ ile := ile -1;
+ PRZYCISKI(naPietrze):= false;
+ call Ekran.ObrazWindy(naPietrze)
+ end PasazerWysiada;
+
+ UNIT PasazerWsiada :procedure(z,na,k,poz:integer; output p:integer);
+ var i,j,y : integer;
+ begin
+
+ if not (naPietrze=z and kierunek=(z<na) and ile< maxP) then
+ p:= 0; return
+ fi;
+ (* Wymaz pasazera z pietra z=naPietrze*)
+ call EKRAN.UsunZpietra(z<na,naPIETRZE,poz);
+ y := yMaxw- naPietrze*H;
+
+ (* Wpisz go do windy *)
+ for j:=1 to 20 do
+ if not Wwindzie(j) then
+ Wwindzie(j):= true;
+ (* ludzik idzie *)
+ p := j;
+
+ for i:= 1 to j-1
+ do
+ call EKRAN.ludzik(xMAXw-10*i,y-12,k);
+ call pauza(50);
+ call EKRAN.ludzik(xMAXw-10*i,y-12,7);
+ call pauza(50)
+ od;
+ call EKRAN.ludzik(xMINw+10*j,y-12,k);
+ call pauza(100);
+ exit
+ fi
+ od;
+ ile := ile+1;
+ call Ekran.RysujWinde(yMaxW-(naPietrze+1)*H,k);
+ call Ekran.Ludzik(xMinW+10*j,y-12,k);
+ PRZYCISKI(na):= true;
+ call Ekran.ObrazWindy(naPietrze)
+ end PasazerWsiada;
+
+
+ UNIT PRZYJECHALA : function(p:integer) : boolean;
+ begin
+ result := (naPietrze=p)
+ end PRZYJECHALA;
+
+ unit CZEKAM : procedure(i: integer);
+ begin(*winda czeka na pasazerow*)
+ call Ekran.Otworz(gora,i);
+ call Ekran.Otworz(dol,i);
+ enable PRZYJECHALA,PASAZERWSIADA, PASAZERWYSIADA;
+
+ call Ekran.Guzik(gora,czerwony,i);
+ call Ekran.Guzik(dol,czerwony,i);
+(* return enable WOLAM,PRZYJECHALA,PASAZERWSIADA, PASAZERWYSIADA;*)
+ end CZEKAM;
+
+ UNIT OtwieramDrzwi : procedure( i: integer);
+ begin
+ call Ekran.Otworz(kierunek,i);
+ enable PRZYJECHALA,PASAZERWSIADA, PASAZERWYSIADA;
+ call Ekran.Guzik(kierunek,czerwony,i);
+ end OtwieramDrzwi;
+
+ UNIT ZamykamDrzwi : procedure(gora:boolean, i: integer);
+ begin
+ disable WOLAM;
+ if gora then
+ PIETRA(i).wgore := false else PIETRA(i).wdol := false
+ fi;
+ enable WOLAM;
+ call Ekran.Zamknij(gora,i);
+ call Ekran.Guzik(gora,szary,i);
+ disable PRZYJECHALA,PASAZERwsIADA, PASAZERwySIADA;
+ end ZamykamDrzwi;
+
+ UNIT KierunekJazdy : procedure;
+ var i : integer;
+ begin
+ JEDZna := naPietrze;
+
+ if (kierunek= gora) then
+ for i := naPIETRZE+1 to n
+ do
+ if (PRZYCISKI(i) or PIETRA(i).wgore or PIETRA(i).wdol) then
+ JedzNa := i; exit fi
+ od;
+ if JedzNa=naPietrze then
+ for i := naPIETRZE-1 downto 0
+ do
+ if (PRZYCISKI(i) or PIETRA(i).wdol or PIETRA(i).wgore) then
+ JedzNa := i; exit fi
+ od;
+ fi;
+ else (*if kierunek= dol then *)
+ for i := naPIETRZE downto 0
+ do
+ if (PRZYCISKI(i) or PIETRA(i).wdol or PIETRA(i).wgore) then
+ JedzNa := i; exit fi
+ od;
+ if JedzNa= naPietrze then
+ for i := naPIETRZE+1 to n
+ do
+ if (PRZYCISKI(i) or PIETRA(i).wgore or PIETRA(i).wdol) then
+ JedzNa := i; exit fi
+ od;
+ fi;
+ fi;
+ stoj := (naPIETRZE=JEDZna);
+ if stoj then kierunek := not kierunek else
+ kierunek := naPietrze < JedzNa
+ fi;
+
+ END KierunekJazdy;
+
+ unit JEDZ : procedure(gora:boolean);
+ var j : integer;
+ begin
+ call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H,7);
+ if gora then
+ for j := 0 to H-1 do
+ call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H -j,7);
+ call pauza(2);
+ call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H -j,15);
+ call pauza(2)
+ od;
+ call EKRAN.RysujWinde(YmaxW-(naPietrze+2)*H,7)
+ else
+ for j:= 0 to H-1
+ do
+ call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H +j,7);
+ call pauza(2);
+ call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H +j,15);
+ call pauza(2);
+ od;
+ call EKRAN.RysujWinde(YmaxW-(naPietrze)*H,7);
+ fi;
+ end jedz;
+
+ handlers
+ others call EKRAN.comment("handler LIFT");
+ call pauza(500);
+ call EKRAN.KONIEC
+ end handlers;
+
+ BEGIN
+ array PIETRA dim(0:n);
+ for i:= 0 to n do PIETRA(i):= new guzik od;
+ array PRZYCISKI dim (0:n);
+ jedzNa := 0; naPietrze:=0;
+ array WWindzie dim(1: MAXp); (* 20 = max ilosc pasazerow *)
+
+ enable Wolam;
+ kierunek := gora;
+
+ return;
+ call EKRAN.RysujWinde(YmaxW-H, szary);
+
+ DO
+ stoj:= true;
+ while stoj
+ do
+ call CZEKAM(naPIETRZE);
+ for j := 1 to 10 do j := j od;
+ call KIERUNEKjazdy;
+ od;
+ call ZamykamDrzwi(gora,naPIETRZE);
+ call ZamykamDrzwi(dol,naPIETRZE);
+
+ if kierunek = gora then
+ for i:= naPIETRZE+1 to JEDZna
+ DO
+ (* jade na nastepne pietro *)
+ call JEDZ(gora);
+ naPietrze:= i;
+ (*jezeli ktos czeka lub wysiada to zatrzymaj*)
+ if (PIETRA(i).wgore or PRZYCISKI(i)) then
+ call pauza(500);
+ call OtwieramDrzwi(i);
+ (* pasazerowie wsiadaja lub wysiadaja *)
+ for j := 1 to 1000 do j := j od;
+ call ZamykamDRZWI(gora,i);
+ fi;
+ od(* jedzNA*)
+ else
+ (*if kierunek = dol*)
+
+ for i := naPIETRZE-1 downto jedzNA
+ do
+ (* zjezdzam w dol *)
+ call JEDZ(dol);
+ naPietrze:= i;
+ if ( PIETRA(i).wdol or PRZYCISKI(i)) then
+ call pauza(500);
+ call OtwieramDrzwi(i);
+ (* pasazerowie wsiadaja/ wysiadaja*)
+ call pauza(500);
+ call ZamykamDrzwi(dol,i);
+ fi;
+
+ od (* jedz w dol NA*);
+ fi;
+
+ OD (* zachowania windy *);
+ END LIFT;
+
+
+(*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+
+
+ UNIT PASAZER : process(node:integer,ss: string,z,na,kolor : integer,
+ winda: lift,EKRAN : ecran);
+ const szary = 7;
+ var i,j : integer,
+ jest,przyjechala,Wgore,wsiadlem : boolean;
+
+ handlers
+ others
+ call EKRAN.comment("handler PASAZER");
+ call EKRAN.KONIEC;
+ end handlers;
+
+ BEGIN (*** opis zachowania pasazera ***)
+
+ return;
+ Wgore := na>z;
+ call EKRAN.JESTEM(Wgore,kolor,z,i);
+ (*powinien otrzymac inormacje o swojej aktualnej pozycji na pietrze*)
+ wsiadlem := false; przyjechala:= false;
+
+ while not wsiadlem do
+ call Winda.Wolam(Wgore,z);
+ call WINDA.PasazerWsiada(z,na,kolor,i,j);
+ (* otrzymal od windy numerek j m lub 0 gdy nie wsiadl*)
+ wsiadlem :=(j<>0)
+ od;
+ while not przyjechala do
+ przyjechala := WINDA.PRZYJECHALA(na)
+ od;
+ call WINDA.PasazerWysiada(j);
+ END pasazer;
+(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+
+ UNIT irandom : FUNCTION(a,b:INTEGER):INTEGER;
+ begin
+ result := entier((b-a)*random + a)
+ end irandom;
+
+
+
+
+ (*===================================================================*)
+VAR EKRAN : ecran, Winda : LIFT,
+ P : arrayof PASAZER,pp :PASAZER,
+ i,n,m,z,na,k : integer;
+ handlers
+ when signal1 : call EKRAN.comment("K O N I E C");
+ call EKRAN.KONIEC;
+ others call EKRAN.comment("handler PROGRAM GLOWNY ");
+ call EKRAN.KONIEC
+ end handlers;
+
+BEGIN
+ EKRAN := new Ecran(0);
+ resume(EKRAN);
+ n :=10; m := 1;
+
+ call Ekran.DOM(7,n);
+ array P dim(1:m);
+ Winda := new LIFT(0,n,10,EKRAN);
+ resume(Winda);
+
+ DO (* generowanie pasazerow *)
+
+ for i := 1 to irandom(1,5) do
+ na,z := irandom (0,n);
+ while z=na do na := irandom(0,n) od;
+ k := 7;
+ while k=7 do k := irandom (0,14) od;
+
+ pp:= new pasazer(0,"aa",z,na,k,winda,EKRAN);
+ resume(pp);
+ od;
+
+ pref GUI block
+ var l: integer;
+ begin
+
+ call EKRAN.comment("CONTINUE? (y/n)");
+ while not (l = ord('y') or l = ord('n')) do
+ l := GUI_KeyPressed;
+ od;
+ call EKRAN.comment(" ");
+ if l = ord('n') then raise signal1 fi;
+ end;
+ OD;
+
+
+END LIFT5;
+
+(***********************************************************************)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ unit zegar: process;
+ var i,j:integer;
+
+ begin
+ do
+ call ramka(420,310,480,335);
+ call ramka(422,312,478,333);
+ call ramka(421,311,479,334);
+ call move(433,320);
+ call wypisz(i);
+ call outstring(":");
+ call wypisz(j);
+ j:=j+1;
+ if j=60 then j:=0;i:=i+1 fi;
+ call hold(1)
+ od
+ end zegar;
+
+
+
+
+
+ unit ramka:iiuwgraph procedure(x1,y1,x2,y2:integer);
+ begin
+ call move(x1,y1);
+ call draw(x2,y1);
+ call draw(x2,y2);
+ call draw(x1,y2);
+ call draw(x1,y1)
+ end ramka;
+
+
+ unit elem : class;
+ unit virtual affichage : procedure;
+ end affichage;
+ end elem;
+
+ unit box : class;
+ var e: elem, next : box;
+ end box;
+
+ unit queue : class;
+ var premier, dernier : box;
+
+ unit virtual first : function : elem;
+ begin
+ if not empty
+ then
+ result := premier.e;
+ fi;
+ end first;
+
+ unit virtual insert : procedure( e: elem);
+ var aux : box;
+ begin
+ aux := new box;
+ aux.e := e;
+ if premier=none
+ then
+ premier := aux;
+ dernier := aux;
+ else
+ dernier.next := aux;
+ dernier := aux
+ fi;
+ end insert;
+
+ unit virtual delete : procedure;
+ begin
+ if not empty
+ then
+ premier := premier.next;
+ fi;
+ end delete;
+
+ unit virtual empty : function : boolean;
+ begin
+ result := (premier=none)
+ end empty;
+ end queue;
+
+END STRUC_QUEUE;
+
+
+
+ unit wstep:procedure;
+ begin
+ call gron(0);
+ call ramka(230,120,480,220);
+ call ramka(228,118,482,222);
+ call ramka(226,116,484,224);
+ call move(250,160);
+ call outstring("Symulacja windy przy pomocy procesow");
+ call move(250,180);
+ call outstring("GM");
+ call move(250,200);
+ call outstring(" Pau czerwiec 97");
+ WHILE INKEY=0 DO OD;
+ call groff
+ end wstep;
+
+
+ (* Strona tytulowa *)
+ CONTINUE_IKONA := new IKONA(szary,400,400,550,430,3," CONTINUE");
+ CALL ramka (1,5,0,0,638,478,ciemnoszary,szary,bialy,czarny);
+ CALL ramka (3,3,230,30,390,80,niebieski,szary,bialy,granatowy);
+ CALL Tytul (1,270,50,czarny,szary," LIFT SIMULATION ");
+
+ call CONTINUE_IKONA.write_i;
+
+ do
+ boo := getpress(xx,yy,i,l,r,z);
+ if z=1 and CZY(xx,yy,CONTINUE_IKONA) then exit fi
+ od;
+ call CONTINUE_IKONA.push;
+
+
+
+ handlers
+ when MEMERROR : call comment("Zabraklo pamieci");
+ call waitt; call GROFF;
+ when ACCERROR : call comment("Reference to none ");
+ call waitt; call GROFF;
+ when LOGERROR : call comment("Niepoprawny Attach");
+ call waitt;call GROFF;
+ when CONERROR : call comment(" Array-index error ");
+ call waitt; call GROFF;
+ when SYSERROR : call comment("input-output error");
+ call waitt; call GROFF;
+ when NUMERROR : call comment("blad numeryczny");
+ call waitt; call GROFF;
+ others : call comment("Jakis blad ");
+ call waitt; call GROFF;
+ end handlers;
+
+
+
+
+
+
+
+
+
+ unit restore : procedure;
+ (* odnawia kolory wierzcholkow na ekanie *)
+ var i : integer;
+ begin
+ delta := 0;
+ for i := 1 to nr
+ do
+ lista(i).kolor := zolty;
+ od;
+ end restore;
+
+ UNIT strzalka : procedure(A,B : node);
+ var r : real, cx,cy,dx,dy,ex,ey,delt,del : integer;
+ BEGIN
+ del := 15; delt:=7;
+ call color(zolty);
+ call move(A.x,A.y);
+ call draw(B.x,B.y);
+
+ call color(noir);
+ r := sqrt((b.y-a.y)*(b.y-a.y)+(b.x-a.x)*(b.x-a.x));
+ cx := b.x- entier((b.x-a.x)*del/r );
+ cy := b.y- entier((b.y-a.y)*del/r );
+ dx := b.x- entier((b.x-a.x)*(del+delt)/r + (b.y-a.y)*delt/r);
+ dy := b.y- entier((b.y-a.y)*(del+delt)/r - (b.x-a.x)*delt/r);
+ ex := b.x- entier((b.x-a.x)*(del+delt)/r - (b.y-a.y)*delt/r);
+ ey := b.y- entier((b.y-a.y)*(del+delt)/r + (b.x-a.x)*delt/r);
+ call move(dx,dy); call draw(cx,cy);
+ call move(ex,ey); call draw(cx,cy);
+ END strzalka;
+
+
+ unit print : procedure;
+ var aux, aux1 : node, i : integer;
+ begin
+ call patern(MinX,MinY+40,MaxX,MaxY,7,1);
+ for i :=1 to nr
+ do
+ aux := lista(i);
+ call aux.affichage(zolty);
+ if not aux.lista.empty
+ then
+ aux1 := aux.lista.first;
+ while not aux1= none
+ do
+ call strzalka(aux,aux1);
+ aux1 := aux.lista.next;
+ od
+ fi;
+ od;
+ call comment("")
+ end print;
+
+ begin
+ array lista dim(1:10);
+ nr := 0;
+ end graph;
+
+(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
+(* NODE - wierzcholek grafu *)
+(* x,y pozycja na ekranie, nr numer wierzcholka *)
+(* lista - lista wierzcholkow incydentnych *)
+(*----------------------------------------------------------------------*)
+ unit node : elem class(x,y,nr: integer);
+ var lista : liste,
+ kolor : integer;
+
+ unit affichage : procedure(c: integer);
+ begin
+ call cirb(x+3,y+3,5,5,0,3600,c,1);
+ call track(x+5,y+5,nr,gris,noir);
+ end affichage;
+
+ unit wypisz : procedure(i: integer);
+ (* wypisz kolejnosc odwiedzania wierzcholkow *)
+ var j, k : integer;
+ begin
+ for j := 0 to 160 do j:=j; call affichage(j mod 16 ) od;
+ k := (i+9) mod 16;
+ if k = gris then k := noir fi;
+ call affichage(k);
+ call track(piszX+delta,piszY,nr,gris,k);
+ if nr>9 then
+ delta := delta+2*10
+ else
+ delta := delta+10
+ fi;
+ end wypisz;
+
+ unit visite : function : boolean;
+ (* Czy wierzcholek byl juz odwiedzony *)
+ (* Wierzcholek odwiedzony dostaje kolor czarny*)
+ begin
+ if kolor=noir then result := true;
+ else result := false; kolor := noir
+ fi;
+ end visite;
+
+ begin
+ lista := new liste; kolor := zolty;
+ end node;
+
+ unit clear : procedure(col, minX,minY,maxX,maxY : integer);
+ var i, j, sr : integer;
+ begin
+ call color(col);
+ sr := (minX+maxX) div 2;
+ for i := 0 to (maxX - minX) div 2
+ do
+ call move( sr, maxY);
+ call draw(sr +i, minY);
+ call move(sr, maxY);
+ call draw(sr -i, minY);
+ for j:=1 to 100 do j:=j od;
+ od;
+ for i := 0 to (maxY - minY)
+ do
+ call move( sr, maxY);
+ call draw(maxX, minY+i);
+ call move(sr, maxY);
+ call draw(minX, minY+i);
+ for j:=1 to 100 do j:=j od;
+ od;
+
+ end clear;
+
+
+ unit clear_all : procedure(col, minX,minY,maxX,maxY : integer);
+ var i,j : integer;
+ begin
+ call color(col);
+ for i := 1 to ((maxY - minY) div 2)
+ do
+ call patern(minX+i,minY+i,maxX-i,maxY-i,3,0);
+ for j:=1 to 200 do j:=j od;
+ od;
+ end clear_all;
+
+ unit waittt : procedure;
+ var x,y,i,l,r,z : integer,boo : boolean;
+ begin
+ call outstring(maxX-100,maxY+25, "CONTINUE",zielony,noir);
+ boo := false;
+ while z=0 do boo := getpress(x,y,i,l,r,z) od;
+ call outstring(maxX-100,maxY+25, " ",gris,gris);
+
+ end waittt;
+
+
+
+\80
+\0\0
\ No newline at end of file
--- /dev/null
+program mtest;
+
+#include "classes/machine.inc"
+
+unit Info: Machine procedure;
+var i:integer,t:array_of char, pom,pom1:NodeInfo;
+begin
+i:=LocalNode;
+writeln("Local node number: ",i);
+i:=NodesNum;
+writeln("Number of nodes: ",i);
+pom:=MachineInfo;
+if pom<>none then
+pom1:=pom;
+while pom1<>none do write(pom1.num,":");
+ if pom1.addr<>none then
+ for i:=lower(pom1.addr) to upper(pom1.addr) do
+ write(pom1.addr(i)); od;
+ fi;
+ writeln;
+ pom1:=pom1.Next;
+ od;
+else
+writeln("t==none");
+fi;
+
+if NodeExists(5) then writeln("Node 5 exists");
+else writeln("There is no node number 5");
+fi;
+writeln;
+end Info;
+
+begin
+call Info;
+end.\80\80
--- /dev/null
+
+ program processus4;
+ #include "classes/gui.inc"
+(* czytelnicy pisarze *)
+
+ unit elem : class;
+ var ile , nr : integer,qui:pi;
+ (*nr procesu ktory zostawil informacje lub ostatni FreePl w buforze*)
+ end elem;
+
+ unit ecran : GUI process(node:integer);
+
+ unit outtext : procedure(x,y:integer, s:string);
+ begin
+ call GUI_clearArea(x,y,80,16);
+ call GUI_writeText(x,y,unpack(s),c_black,c_LightGrey);
+ end outtext;
+
+ unit outmessage: procedure(x,y:integer, s: string);
+ begin
+ call GUI_clearArea(x,y,80,16);
+ call GUI_writeText(x,y,unpack(s),c_lightgrey,c_red);
+ end outmessage;
+
+ unit circle: procedure(col,x,y,r : integer);
+ begin
+ call GUI_Ellipse(x,y,r,r,0,360,c_black,col);
+ end circle;
+
+ unit line : procedure(col,x,y,dlugosc:integer,poziomo:boolean);
+ begin
+ call GUI_move(x,y); (* pozycja linii *)
+ if poziomo
+ then
+ call GUI_LineTo(x+dlugosc,y,col);
+ else (* linia pionowa *)
+ call GUI_LineTo(x, y+dlugosc,col);
+ fi;
+ end line;
+
+ unit Fin: procedure;
+ begin
+ call endRun
+ end fin;
+
+ unit pisarz: procedure(nr:integer);
+ (*nr jest jednoczesnie numerem kolorem wlasnym i numerem pisarza*)
+ begin
+ call GUI_Ellipse((nr-1)*150+20,8,10,10,0,360,c_black,nr);
+ call GUI_WriteText((nr-1)*150+50,5,unpack("Author"),c_black,c_white);
+ call GUI_WriteInt((nr-1)*150+30,5,nr,nr,c_white);
+ call GUI_rect((Nr-1)*150+10,20,(nr-1)*150+ 110,200,c_black,c_lightgrey);
+ end pisarz;
+
+
+ unit magazyn : procedure(posX,posY : integer);
+ begin
+ call GUI_Rect(10,250,600,305, c_Black,c_lightgrey);
+ call outtext(posX,posY-8,"B U F F E R");
+ call outtext(posX,posY+60,"READERS' QUEUE");
+ call outtext(posX+ 300, posY+60,"WRITERS'QUEUE");
+ end magazyn;
+ begin
+ call GUI_clear;
+ return;
+ enable magazyn, pisarz;
+ do
+ accept Fin, line, circle, outtext, outmessage,
+ GUI_Keypressed, GUI_ClearArea
+ od;
+
+ end ecran;
+
+ unit pi : elem process(node,nr : integer, M : monitor,ek:ecran);
+ (* nr jest numerem pisarza *)
+ const stala=76;(* dludosc linii rysowanej przez pisarza *)
+ var posX, posY : integer; (* pozycja pisarza na ekranie *)
+
+ unit tempo : procedure(n:integer);
+ var i : integer;
+ begin
+ for i :=1 to n do i:= i od
+ end tempo;
+
+
+ unit wezwij_put : procedure(e:elem);
+ var czekaj : boolean;
+ begin
+ (* najpierw wymazuje z obszaru pisarza *)
+ call ek.outtext((nr-1)*150+20,210,"try to send");
+ for i := 1 to e.ile
+ do
+ call ek.line(7,(nr-1)*150+22,26+i,stala, true);
+ call tempo(50);
+ od;
+ call ek.GUI_clearArea((nr-1)*150+20,210,80,16);
+
+ call ek.outtext((nr-1)*150+20,210,"waiting");
+ do
+ call M.putt(e.nr, e.qui, e.ile, czekaj);
+ if czekaj
+ then
+ call ek.outmessage((nr-1)*150+20,210,"stopped");
+ stop ;
+ call ek.GUI_clearArea((nr-1)*150+20,210,80,16);
+ else
+ call ek.outtext((nr-1)*150+20,210,"sending");
+ exit
+ fi;
+ od;
+ end wezwij_put;
+
+ unit wezwij_get : procedure(inout e:elem);
+ var czekaj : boolean, qui:pi,n,ch:integer ;
+ (*autor chce cos odczytac z magazynu *)
+ begin
+
+ do
+ n := e.nr; qui := e.qui;
+ call m.gett(n,qui,ch, czekaj);
+ if czekaj then
+ call ek.outmessage((nr-1)*150+20,210,"stopped");
+ stop ;
+ call ek.GUI_clearArea((nr-1)*150+20,210,80,16);
+ (* magazyn jest zajety; pisarz zostanie wpisany do kolejki oczekujacych*)
+
+ else
+ e:=new elem; e.nr :=n;
+ e.qui:=qui; e.ile :=ch;
+ call ek.outtext((nr-1)*150+20,210,"receiving");
+ for i := 1 to ch
+ do
+ call ek.line(n,(nr-1)*150+22,26+i,stala,true);
+ call tempo(100);
+ od;
+ call ek.GUI_clearArea((nr-1)*150+20,210,80,16);
+
+(* otrzymalem wiadomosc od pisarza nr *)
+ exit
+ fi;
+ od;
+ end wezwij_get;
+
+ unit fin : procedure;
+ end;
+
+var el: elem, r : real;
+begin
+ call ek.pisarz(nr);
+
+
+ return;
+ do
+ r := random*100;
+ (*if r=0 then accept fin; exit fi; *)
+ (* to niezbt dobre rozwiazanie ze wzgl na kolejnosc *)
+ if r<50 then
+ (* pisarz cos produkuje i chce to wyslac *)
+ el := new elem;
+ el.qui := this pi;
+ el.nr := nr;
+ el.ile := random*170;
+ call ek.outtext((nr-1)*150+20,210,"writing");
+ for i := 1 to el.ile
+ do
+ call ek.line(nr,(nr-1)*150+22,26+i,stala,true);
+ call tempo(100);
+ od;
+ call ek.GUI_clearArea((nr-1)*150+20,210,80,16);
+ call tempo(100);
+ call wezwij_put(el)
+ else
+ (* pisarz zdecydowal sie cos przeczytac *)
+ el := new elem;
+ el.nr := nr; el.qui := this pi;
+ call ek.outtext((nr-1)*150+20,210,"demanding");
+ call wezwij_get(el);
+ call ek.GUI_clearArea((nr-1)*150+20,210,80,16);
+ call tempo(100);
+ call ek.outtext((nr-1)*150+20,210,"reading");
+ (* czytam przesylke *)
+ for i := el.ile downto 1
+ do
+ call ek.line(7,(nr-1)*150+22,26+i,stala,true);
+ call tempo(50);
+ od;
+ call ek.GUI_clearArea((nr-1)*150+20,210,80,16);
+
+ fi;
+ od;
+end pi;
+
+unit monitor : elem process(node,size,max_proc : integer, ek:ecran);
+const posX = 30,
+ posY = 250;
+
+ unit Belem : class(e:elem,posx:integer);
+ end Belem;
+
+var buffer : arrayof Belem,
+ queue_pour_lire,
+ queue_pour_ecrire : queue,
+ Qpos , x,y: integer,
+ counter, ilosc_ak, i, nb_proc: integer;
+ (* zmienna counter mowi ile jest elementow w buforze *)
+ (* ilosc_ak = ilosc miejsca w magazynie juz wykorzystana*)
+ (* nb_proc = ilosc procesow stojacuch w obu kolejkach *)
+
+ unit qEl: class;
+ var qui : pi, next : qEL;
+ end qEL;
+
+ unit queue: class(pos:integer);
+ var first, last : qEL;
+
+ unit into : procedure(p: pi,nr: integer (* nr is the no of pi*));
+ var aux : qEL, c: integer;
+ begin
+
+ call ek.circle(nr,pos+30,339,12);
+ pos := pos+30;
+ (* rysowanie kolka w odpowiedniej kolejce i odp.kolorem*)
+ nb_proc := nb_proc+1;
+ aux := new qEL;
+ aux .qui :=p;
+ aux . next := none;
+ if first=none then
+ first := aux; last := aux
+ else
+ last.next := aux;
+ last := aux;
+ fi;
+ end into;
+
+ unit out : function : pi;
+ begin
+ if first=none then exit else
+ nb_proc := nb_proc -1;
+ call ek.circle(15,pos,339,13);
+ pos :=pos-30;
+ (* wymazanie kolka w odpowiedniej kolejce *)
+ result := first.qui;
+ first := first.next;
+ fi;
+ end out;
+
+ unit empty : function: boolean;
+ begin
+ result := (first=none) ;
+ end empty;
+ end queue;
+
+ unit tempo : procedure(n:integer);
+ var j : integer;
+ begin
+ for j := 1 to n do j:= j od;
+ end tempo;
+
+ unit putt : procedure(nr:integer,qui:pi,ch:integer; output czekaj : boolean);
+ var aux, i : integer,e : elem;
+ begin
+
+ if (counter< 20 and ilosc_ak+ch<size)
+ then
+ e := new elem;
+ e.nr :=nr;
+ e.ile := ch;
+ e.qui := qui;
+ counter := counter +1;
+ buffer(counter) := new Belem(e,x);
+ (* monitor zapisuje przesylke od *)
+ for i :=1 to ch do
+ call ek.line(nr,x+i,posY+7,39,false);
+ call tempo(50);
+ od;
+ x := x+ ch;
+ ilosc_ak := ilosc_ak+ch;
+ czekaj := false;
+ if not queue_pour_lire.empty
+ then
+(* monitor budzi pisarza z kolejki czytelnikow *)
+ p := queue_pour_lire.out;
+ call ek.GUI_clearArea((nr-1)*150+20,210,80,16);
+ resume(p);
+ fi;
+ else
+(* nie ma miejsca w buforze dla pisarza *)
+ czekaj := true;
+ call queue_pour_ecrire.into(qui,nr);
+ fi;
+ end putt;
+
+ unit gett : procedure(inout nr:integer, qui:pi, ch:integer, czekaj:boolean);
+ var i ,j : integer, e:elem , p:pi;
+ begin
+ p := qui;
+ if counter<> 0 then (* mozna cos zabrac z magazynu *)
+ e := buffer(counter).e;
+ nr := e.nr; qui := e.qui; ch := e.ile;
+ counter := counter - 1;
+ czekaj := false;
+ for i := x downto x-ch
+ do
+ call ek.line(7,i,posY+7,39,false);
+ call tempo(100);
+
+ od;
+ x := x-ch;
+ ilosc_ak := ilosc_ak-ch;
+ (* w magazynie zwolnilo sie miejsce i ktos moze wpisac *)
+
+ if not queue_pour_ecrire.empty
+ then
+ (* writeln("M budzi pisarza ktory chce pisac ");*)
+ p := queue_pour_ecrire.out;
+ call ek.GUI_clearArea((nr-1)*150+20,210,80,16);
+ resume(p);
+ fi;
+ else (*jezeli counter=0 tzn. nic nie ma w magazynie *)
+(* writeln("M wpisuje pisarza",nr,"do kolejki czytelnikow");*)
+ czekaj := true;
+ (* qui := p;*) (* to jest instrukcja niepotrzebna *)
+ call queue_pour_lire.into(p,nr);
+ fi;
+ end gett;
+
+begin (* tu sie zaczyna tresc monitora *)
+
+ array buffer dim(1:20);
+
+ counter := 0;
+ x := 15; ilosc_ak := 0;
+ Qpos := posX;
+ queue_pour_lire := new queue(Qpos);
+ queue_pour_ecrire := new queue(Qpos+300);
+ call ek.magazyn(posX,posY);
+
+ return;
+ do
+ accept putt, gett;
+
+ if ek.GUI_KeyPressed<>0 then call ek.fin fi;
+ if nb_proc = max_proc
+ then
+ call ek.outmessage(470,339,"DEADLOCK! press CR");
+ readln;
+ call ek.fin;
+ fi;
+ od;
+end monitor;
+
+
+ (* M A I N *)
+
+var
+ M : monitor,
+ i, j, nbNodes,ile : integer,
+ EK : ecran, EKR : arrayof ecran,
+ PROC : arrayof arrayof pi, p : pi,
+ TABnodes, NbProc : arrayof integer;
+
+begin
+
+
+ write("The Number of nodes- processors ?: ");
+ readln(NbNodes); writeln(nbNodes);
+ if nbNodes = 0 then call ENDRun fi;
+ array TABnodes dim (1: NbNodes);
+ array NbProc dim (1: NbNodes);
+
+ ile := 0;
+ for i := 1 to NbNodes
+ do
+ write("Node number ",i, " ? ");
+ readln( TABnodes(i)); writeln;
+ write("Number of Readers/Writers on this node",TABnodes(i)," ? ");
+ readln(NbProc(i)); writeln;
+ ile := ile + NbProc(i);
+ od;
+
+ array EKR dim (1:NbNodes);
+ for i := 1 to nbNodes
+ do
+ if NbProc(i)>0 then
+ j := TABnodes(i);
+ ek := new ecran(j);
+ EKR(i) := ek;
+ resume(ek)
+ fi;
+ od;
+
+ (* ile= ilosc utworzonych procesow typu Readaes/writers na wszystkich razem komputerach polaczonych w siec*)
+ (* zakladam, ze pierwszy z uzytych "node" =0 i ma ilosc procesow >0 - to oczywiscie mozna zmienic!!*)
+
+ ek := EKR(1);
+
+ M := new monitor(0,600,ile,ek);
+ resume(M);
+
+
+ array PROC dim (1: nbNodes);
+ for i := 1 to nbNodes
+ do
+ array PROC(i) dim (1 : NbProc(i));
+ ek := ekr(i);
+ for j := 1 to NbProc(i)
+ do
+ ile := TabNodes(i);
+ P := new pi(ile,j,M,ek);
+ Proc(i,j) := P;
+ od
+
+ od;
+
+ ek := EKR(1);
+ call ek.outmessage(400,440,"press CR");
+ readln;
+ call ek.outtext(400,440," press any key to STOP ");
+
+ for i :=1 to NbNodes
+ do
+ for j := 1 to NbProc(i)
+ do
+ p := Proc(i,j);
+ resume(p);
+ od
+ od;
+
+
+end processus4;
+\0\0
\ No newline at end of file
--- /dev/null
+ PROGRAM RozdzielaniePunktow;
+ #include "classes/gui.inc"
+(*Program ma pozwolic odseparowac przy pomocy pewnej krzywej 2 zbiory punktow*)
+(* tak aby ??????? *)
+ signal ERROR_exec;
+ CONST
+
+ MinX = 0,
+ MinY = 0,
+ MaxX = 640,
+ MaxY = 480,
+ comX = 30,
+ comY = 440,
+ sz = 30, (*szerokosc paska menu*)
+ my_ecranMinX = MinX+5,
+ my_ecranMinY = MinY+sz+3,
+ my_ecranMaxX= MaxX-5,
+ my_ecranMaxY= MaxY-(2*sz+1),
+ exit_posX = 550,
+ exit_posY = 420,
+ help_posX = 20,
+ help_posY = 50,
+ grubosc = 2,
+ maly = 1;
+
+
+(*------------------------------------------------------------------------*)
+
+(*------------------------------------------------------------------------*)
+(* klasa definiujaca procedury graficzne *)
+(*------------------------------------------------------------------------*)
+ UNIT graphics : GUI CLASS;
+
+
+ UNIT pauza : PROCEDURE(JakDlugo:integer);
+ var i : integer;
+ BEGIN
+ for i :=1 to JakDlugo do i:=i od;
+ END pauza;
+
+
+ UNIT waitt : PROCEDURE;
+ (* wait for a key *)
+ BEGIN
+ While GUI_KeyPressed=/= 0 DO OD;
+ END waitt;
+
+ UNIT clear_all : procedure;
+ begin
+ call GUI_Rect(my_ecranMinX, my_ecranMinY, my_ecranMaxX,
+ my_EcranMaxY,c_DarkGrey,c_LightGrey);
+ call GUI_Rect(my_EcranMinX, MaxY-2*sz,
+ my_EcranMaxX,MaxY-5,c_DarkGrey,c_DarkGrey);
+ end clear_all;
+
+ UNIT clear : PROCEDURE(x0,y0,x1,y1,c1,c2: integer);
+ (* wymaz wszystko w prostokacie (x0,y0)-(y1,y1) *)
+ (* Zostaw ekran w kolorze c2*)
+ var i,j,x,y : integer;
+ BEGIN
+ x := (x1-x0) div 2;
+ y := (y1-y0) div 2;
+ i :=0; j :=0;
+ while i<=x and j<=y do
+ call GUI_Rect(x0+i,y0+j,x1-i,y1-j,c_black,c_lightGrey);
+ i := i+1; j := j+1;
+ od;
+ while i>=0 and j>=0 do
+ call GUI_Rect(x0+i,y0+j,x1-i,y1-j,c1,c2);
+ i := i-1; j :=j-1
+ od;
+ END clear;
+
+
+(**************************************************************************)
+
+ UNIT katy : procedure(col1,col2,x,y,u,v,grubosc: integer);
+ var i : integer;
+ BEGIN
+ for i :=0 to grubosc
+ do
+ call GUI_Line(x+i,y+i,u-i,y+i, col1);
+ call GUI_Line(x+i,y+i,x+i,v-i, col1)
+ od;
+ for i :=0 to grubosc
+ do
+ call GUI_Line(u-i,v-i,x+i,v-i,col2);
+ call GUI_Line(u-i,v-i,u-i,y+i, col2);
+ od;
+ END katy;
+
+
+ unit comment: procedure(ss:string);
+ begin
+ call GUI_Rect(minX+4,maxY-2*sz,maxX-4,maxY-10,c_darkGrey,c_darkGrey);
+ (* wymazanie obszaru pod komentarze *)
+ call GUI_writeText(comX+10,comY,unpack(ss),c_white,c_darkGrey);
+ end comment;
+
+ unit YES : function : boolean;
+ var c : char;
+ begin
+ while (c <> 'y' and c<> 'Y' and c <> 'n' and c<> 'N' ) do
+ call GUI_move(comX,comY);
+ c:= GUI_ReadChar(comX,comY,c_turq,c_lightGrey) od;
+ if (c= 'y' or c='Y') then
+ result := true else result := false
+ fi;
+ end YES;
+
+ END graphics;
+(*************************************************************************)
+
+ BEGIN
+ pref GRAPHICS block
+
+
+(*-----------------------------------------------------------------------*)
+
+(* M E N U *)
+(*-----------------------------------------------------------------------*)
+ unit option : class(nb : integer);
+ var Nom : arrayof string;
+ unit virtual action : procedure(j : integer);
+ begin
+ end action;
+ begin
+ array Nom dim (1:nb);
+ inner;
+ end option;
+
+ unit ikona : class(c,x,y,u,v,grubosc : integer, ss : string);
+ var sub_menu : menu;
+ unit write_i : procedure;
+ var i: integer;
+ begin
+ call GUI_Rect(x,y,u,v,c_black,c);
+ call katy(c_white,c_darkGrey,x,y,u,v,grubosc);
+ call GUI_writeText(x+grubosc+3,y+(v-y)div 2 - 5 ,unpack(ss),c_black,c)
+ end write_i;
+
+ unit wymaz : procedure;
+ begin
+ call GUI_Rect(x,y,u,v,c_black,c_lightGrey);
+ end wymaz;
+
+ unit push : procedure;
+ (* nacisniecie wybranej ikony *)
+ begin
+ call katy(c_darkGrey,c_white,x,y,u,v,grubosc);
+ call pauza(200);
+ call katy (c_white,c_darkGrey,x,y,u,v,grubosc);
+ call pauza(200);
+ end push;
+
+ unit inactive : procedure;
+ begin
+ call katy(c_white,c_darkGrey,x,y,u,v,grubosc);
+ call pauza(500);
+ call katy (c_darkGrey,c_white,x,y,u,v,grubosc);
+ call pauza(500);
+ end inactive;
+ end ikona;
+
+ unit CZY : function(xx,yy:integer,IC:Ikona): boolean;
+ begin (* czy mysz nacisnieta w polozeniu ikony IC *)
+ result := (IC.x<xx and xx<IC.u
+ and IC.y<yy and yy<IC.v)
+ end CZY;
+
+
+ unit menu : coroutine(minX,maxX,MinY,MaxY :integer, OPTIONS :option);
+ (* sz szerokosc paska ikon *)
+ var ICONES: arrayof IKONA, i,j,nb, x1, y1, dl : integer,
+ l,r,z,
+ col,xx,yy : integer,
+ boo : boolean;
+ (* dl and sz - wymiary ikon w tym menu *)
+
+ unit instalation : procedure;
+ (* rysowanie menu oraz jego ikon *)
+ var i : integer;
+ begin
+ call GUI_Rect(minX,minY,maxX,maxY,c_black,c_lightGrey);
+ (* duzy obszar szary *)
+
+ call GUI_Rect(minX+4,maxY-(2*sz),maxX-4,maxY-4,c_black,c_darkGrey);
+ (*obszar dla komentarzy*)
+ for i := 1 to nb
+ do
+ call ICONES(i).write_i
+ od;
+ end instalation;
+
+ unit INI : procedure;
+ var x,y,u,v : integer;
+ BEGIN
+ nb := OPTIONS.nb;
+ dl := (MaxX-Minx) div nb ;
+
+ array ICONES dim(1:nb);
+ x := minX+2; y := minY+2;
+ u := minX+dl-4; v := minY+sz;
+ for i := 1 to nb
+ do
+ ICONES(i) := new ikona(c_lightGrey,x,y,u,v,2,OPTIONS.NOM(i));
+ x := x+dl; u := u+dl;
+ od;
+ end INI;
+handlers
+ when ERROR_exec :
+ call comment(" error exec ");
+ call YES_ikona.write_i;
+ call NO_ikona.write_i;
+ z :=0;
+ while not z=1 do call GUI_MousePressed(xx,yy,z) od;
+ call comment("");
+ (* szukam gdzie zostal nacisniety lewy klawisz myszki*)
+ if CZY(xx,yy,YES_ikona)
+ then
+ call YES_ikona.push;
+ call clear(minX+5,minY+sz+3,maxX-5,maxY-2*sz-1,c_white,c_lightGrey);
+ wind
+ fi;
+ if CZY(xx,yy,NO_ikona)
+ then
+ call NO_ikona.push;
+ call clear(minX+5,minY+sz+3,maxX-5,maxY-2*sz-1,c_white,c_lightGrey);
+ call ENDRUN
+ fi;
+
+
+ others call comment(" ERROR press YES to continue or NO to stop?");
+
+ call YES_ikona.write_i;
+ call NO_ikona.write_i;
+ z :=0;
+ while not z=1 do call GUI_MousePressed(xx,yy,z) od;
+ call comment("");
+ (* szukam gdzie zostal nacisniety lewy klawisz myszki*)
+ if CZY(xx,yy,YES_ikona)
+ then
+ call YES_ikona.push;
+ call clear(minX+5,minY+sz+3,maxX-5,maxY-2*sz-1,c_white ,c_lightGrey);
+ wind
+ fi;
+ if CZY(xx,yy,NO_ikona)
+ then
+ call NO_ikona.push;
+ call clear(minX+5,minY+sz+3,maxX-5,maxY-2*sz-1,c_white ,c_lightGrey);
+ call ENDRUN
+ fi;
+
+end handlers;
+
+ begin
+ call INI;
+ return;
+ do (* obsluga menu *)
+ call instalation; (* rysowanie ikon z tego menu *)
+ do
+ xx, yy,i := 0;
+
+ while i=0 do
+ call GUI_MousePressed(xx,yy,i) ;
+ od;
+
+ (* szukam gdzie zostal nacisniety lewy klawisz myszki *)
+ for j :=1 to nb
+ do
+ if czy(xx,yy,ICONES(j))
+ then
+ call ICONES(j).push;exit;
+ fi;
+ od;
+ if j>0 and j<nb+1
+ then
+ call OPTIONS.Action(j);
+ if j=1 then detach;
+ exit
+ else
+ if ICONES(j).sub_menu<>none then
+ attach(ICONES(j).sub_menu);
+ exit;
+ fi;
+ fi;
+ fi;
+ od;
+ od;
+ end menu;
+
+ unit OPTIONS_MAIN : option class;
+ unit virtual Action : procedure(j : integer);
+ var ch : char, i,x : integer, bol : boolean;
+ begin (* opcje glownego menu*)
+
+ case j
+ when 1 : call comment("Exit ");
+ when 2 : call comment("Ustalanie parametrow.");
+ call Parametry;
+ when 3 : call comment("Tu ma byc informacja o algorytmie");
+
+ when 4 : call WczytajDane(ilCZ, ilB);
+
+
+
+ esac;
+ end action;
+ begin
+ Nom(1) := "EXIT";
+ Nom(2) := "PARAMETRY";
+ Nom(3) := "HELP";
+ Nom(4) := "ALGORITHMS";
+ end OPTIONS_MAIN;
+
+ unit OPTIONS_START : option class;
+ unit virtual Action : procedure(j : integer);
+ var x: integer, boo :boolean;
+ begin
+ case j
+ when 1 : call comment("RETURN ");
+ when 2 :
+ call ALG_1(ilcz,ilb);
+ when 3 :
+ call ALG_2(ilcz,ilb);
+ when 4 : call comment("ALG_3");
+ call clear_all;
+ esac;
+ end action;
+ begin
+ Nom(1) := "RETURN";
+ Nom(2) := "ALG_1";
+ Nom(3) := "ALG_2";
+ Nom(4) := "ALG_3";
+ end OPTIONS_START;
+
+
+ unit OPTIONS_help : option class;
+ var ch : char, i:integer;
+ unit virtual Action : procedure(j : integer);
+ begin
+ case j
+ when 1 : call comment(" ");
+ when 2 : call comment("NACISNIJ Y lub N");
+ if YES then call comment("") fi;
+ when 3 : call comment("");
+ esac;
+ end Action;
+ begin
+ NOM(1) := "RETURN";
+ NOM(2) := "NEXT";
+ NOM(3) := "PREV";
+ end OPTIONS_help;
+
+ (*===================================================================*)
+
+ unit parametry : procedure;
+ const pminX = 30, pminY =50, pmaxX= 400, pmaxY=200,
+ il_ikon =5;
+ var i ,xx, yy: integer, IK : arrayof IKONA;
+ begin
+
+ array IK dim(1 : il_ikon);
+ call GUI_Rect(pminX,pminY,pmaxX,pmaxY,c_darkGrey,c_green);
+ call GUI_WriteText(pminX+10, pminY+10,unpack("Ilosc punktow = "),
+ c_darkGrey,c_green);
+ call GUI_writeInt(pminX+150,pminY+10,
+ il_punktow, c_darkGrey,c_green);
+ call GUI_WriteText(pminX+10, pminY+45,unpack("Jakosc w % = "),
+ c_darkGrey,c_green);
+ call GUI_writeInt(pminX+150,pminY+45,
+ jakosc, c_darkGrey,c_green);
+ IK(1) := new IKONA (6,pminX+200,pminY+10,pminX+250,pminY+35,3,"PLUS");
+ IK(2) := new IKONA (6,pminX+260,pminY+10,pminX+310,pminY+35,3,"MINUS");
+ IK(3) := new IKONA (6,pminX+200,pminY+45,pminX+250,pminY+70,3,"PLUS");
+ IK(4) := new IKONA (6,pminX+260,pminY+45,pminX+310,pminY+70,3,"MINUS");
+ IK(5) := new IKONA (6,pminX+200,pminY+120,pminX+250,pminY+145,3,"EXIT");
+ for i:=1 to il_ikon do call IK(i).write_i; od;
+ (*badanie ktora ikona zostala nacisnieta*)
+ do
+ xx, yy,i := 0;
+ while i=0 do
+ call GUI_MousePressed(xx,yy,i) ;
+ od;
+
+ (* szukam gdzie zostal nacisniety lewy klawisz myszki *)
+ for i :=1 to il_ikon do
+ if czy(xx,yy,IK(i))
+ then
+ call IK(i).push; exit
+ fi;
+ od;
+ case i
+ when 1 : il_punktow := il_punktow+10;
+
+call GUI_Rect(pminX+150,pminY+10,pminX+180,pminY+25, c_green,c_green);
+call GUI_writeInt(pminX+150,pminY+10,il_punktow, c_darkGrey,c_green);
+ when 2 : il_punktow := il_punktow-10;
+call GUI_Rect(pminX+150,pminY+10, pminX+180,pminY+25, c_green,c_green);
+call GUI_writeInt(pminX+150,pminY+10, il_punktow, c_darkGrey,c_green);
+ when 3 : jakosc := jakosc+1;
+call GUI_Rect(pminX+150,pminY+45, pminX+180,pminY+60, c_green,c_green);
+call GUI_writeInt(pminX+150,pminY+45, jakosc, c_darkGrey,c_green);
+ when 4 : jakosc := jakosc-1;
+call GUI_Rect(pminX+150,pminY+45, pminX+180,pminY+60, c_green,c_green);
+call GUI_writeInt(pminX+150,pminY+45, jakosc, c_darkGrey,c_green);
+ when 5 : exit;
+ esac;
+ od;
+ call clear_all;
+ end parametry;
+
+(*-------------------------------------------------------------*)
+ UNIT PokazPunkty : procedure;
+ var i : integer;
+ begin
+ call clear(minX+5,minY+sz+3,maxX-5,maxY-(2*sz+1),c_yellow,c_blue);
+ for i := 1 to ilCz do call TabCz(i).rysuj od;
+ for i := 1 to ilB do call TabB(i).rysuj od;
+ end PokazPunkty;
+
+ UNIT WczytajDane : procedure( output il_cz, il_b : integer);
+ var pp : punkt;
+ begin
+ call clear(minX+5,minY+sz+3,maxX-5,maxY-(2*sz+1),c_yellow,c_blue);
+ call comment("Losowanie punktow.");
+ array TabCz dim(1: il_punktow);
+ array TabB dim(1: il_punktow);
+
+ il_cz := 0; il_b := 0;
+ for i :=1 to il_punktow do
+ if random*10 <=6 then (* wylosowany punkt czerwony *)
+ il_cz := il_cz + 1;
+ pp:= new punkt(10+random*600,40+random*360,c_red);
+ call pp.rysuj;
+ (* wpisz do uporzadkowanej tablicy czerwonych*)
+ call insert(pp,TabCz, il_cz);
+ else (* wylosowany punkt bialy *)
+ il_b := il_b +1;
+ pp := new punkt(10+random*600,40+random*360,c_white);
+ call pp.rysuj;
+ (*wpisz do uporzadkowanej tablicy bialych *)
+ call insert(pp,TabB, il_b);
+ fi;
+ od;
+ call comment("");
+
+ end WczytajDane;
+
+
+ unit INFO : procedure(ilcz,ilb : integer);
+ begin
+ call GUI_WriteText( MinX+10, MaxY -50,
+ unpack("wylosowano czerowonych : "), c_red,c_darkGrey);
+ call GUI_WriteInt(MinX+200, MaxY-50,ilcz,c_red,c_darkGrey);
+ call GUI_WriteText(MinX+10,MaxY-30,
+ unpack("wylosowano bialych : "),c_white,c_darkGrey);
+ call GUI_WriteInt(MinX+200, MaxY-30,ilb,c_white,c_darkGrey);
+ call GUI_WriteText(MinX+250,MaxY-50,unpack("na lewo: "),
+ c_black,c_darkGrey);
+ call GUI_WriteText(MinX+360,MaxY-50,unpack(":: "),
+ c_black,c_darkGrey);
+ call GUI_WriteText(MinX+250,MaxY-30,unpack("na prawo: "),
+ c_black,c_darkGrey);
+ call GUI_WriteText(MinX+360,MaxY-30,unpack(":: "),
+ c_black,c_darkGrey);
+ call GUI_WriteText(MinX+460,MaxY-50,unpack("ocena: "),
+ c_black,c_darkGrey);
+ call STOP_IKONA.write_i;
+ end INFO;
+(*--------------------------------------------------------------*)
+
+ Unit ALG_1 : procedure(ilCz,ilB: integer);
+ var c, i : integer , pp : punkt,
+ zle, nr, cz, b, yy, ocena, ocenaMax: integer,
+ Lamana : arrayof punkt;
+ begin
+ call PokazPunkty;
+ ocenaMax := ilCz*ilB;
+ array Lamana dim(1: il_punktow); yy := 400;
+ (* wybieram losowo pierwszy odcinek lamanej *)
+ Lamana(1) := new punkt(10+random*600, yy, c_yellow);
+ nr := 2; (*numer punktu lamanej *) yy := yy-40;
+ call INFO(ilCz, ilB);
+ zle :=0;
+ DO (*tworzenie lamanej*)
+
+ Lamana(nr):= new punkt(10+random*600, yy,c_yellow);
+ call GUI_Line(Lamana(nr-1).x, Lamana(nr-1).y,
+ Lamana(nr).x, Lamana(nr).y, c_yellow);
+
+ call Zliczanie(Lamana,nr,ilCz,ilB, cz, b);
+ ocena := cz*(ilB-b) + b*(ilCz-cz);
+
+ (*wypisanie informacji o ilosciach punktow na ekranie *)
+ call WYPISZ_Info(cz,b,ilCz,ilB,ocena);
+
+ if GUI_KeyPressed <>0 then
+ (* zeby przerwac trzeba najpierw nacisnac jakis klucz*)
+ i := 0;
+ call GUI_MousePressed(xx,yy,i);
+ if i=1 and CZY(xx, yy,STOP_IKONA) then call clear_all;exit fi;
+ fi;
+ if ocena> 0.5*ocenaMax then
+ (*zatwierdzam ten odcinek lamanej *)
+ yy := yy-40;
+ (* ocenaMax := ocena;*)
+ nr := nr+1 ;
+ zle := 0;
+ else (*wycofuje sie z ostatniego odcinka lamanej *)
+ call WYMAZ_KONIEC(LAMANA, nr);
+ zle := zle +1;
+ if zle>10 then
+ zle := 0;
+ if nr>2 then nr := nr-1; call WYMAZ_KONIEC(LAMANA,nr)
+ else
+ Lamana(1) := new punkt(10+random*600, 400, c_yellow);
+ nr:=2; yy:= 360;
+ fi;
+ fi;
+ fi;
+ if yy <50 then exit fi;
+ (* jesli lamana dojdzie na sama gore to koniec *)
+ OD;
+
+ end ALG_1;
+
+
+ UNIT WYPISZ_INFO : procedure(cz,b,il_cz,il_b, ocena : integer);
+ BEGIN
+ call GUI_Rect(MinX+320,MaxY-60,MinX+360,MaxY-10,c_darkGrey,c_darkGrey);
+ call GUI_Rect(MinX+390,MaxY-60,MinX+420,MaxY-10,c_darkGrey,c_darkGrey);
+ call GUI_Rect(MinX+510,MaxY-60,MinX+560,MaxY-10,c_darkGrey,c_darkGrey);
+ call GUI_WriteInt(MinX+320, MaxY-50, cz,c_red,c_darkGrey);
+ call GUI_WriteInt(MinX+390, MaxY-50, b,c_white,c_darkGrey);
+ call GUI_WriteInt(MinX+320, MaxY-30,il_cz-cz,c_red,c_darkGrey);
+ call GUI_WriteInt(MinX+390, MaxY-30,il_b-b,c_white,c_darkGrey);
+ call GUI_WriteInt(MinX+510, MaxY-50,ocena ,c_white,c_darkGrey);
+ END WYPISZ_INFO;
+
+ unit Insert: procedure(pp: punkt,Tab : arrayof punkt, il : integer);
+ (* doloaczanie punktu pp do uporzadkowanej tablicy Tab o il-elementach *)
+ var j : integer;
+ begin
+ j := il -1;
+ while j>0 do
+ if pp.mniejsze (Tab(j)) then
+ Tab(j+1) := Tab(j); j := j-1;
+ else exit fi
+ od;
+ Tab(j+1) := pp;
+ end Insert;
+
+ unit punkt : class(x,y,c: integer);
+ unit mniejsze : function( p : punkt) : boolean;
+ begin
+ result := (y< p.y or (y=p.y and x< p.x))
+ end mniejsze;
+
+ unit naLewo : function(p1,p2: punkt):boolean;
+ begin
+ if ( (x-p1.x)*(p2.y - p1.y) -(p2.x-p1.x)*(y-p1.y))>0 then
+ result := true
+ else result := false fi
+ end naLewo;
+
+ unit rysuj : procedure;
+ begin
+ call GUI_Ellipse(x,y,5,5,0,360,c,c)
+ end rysuj;
+ end punkt;
+
+ unit WYMAZ_KONIEC: procedure(L : arrayof punkt, nr : integer);
+ begin
+ call GUI_Line(L(nr-1).x, L(nr-1).y, L(nr).x, L(nr).y, c_blue);
+ end WYMAZ_KONIEC;
+
+ UNIT ZLICZANIE : procedure(LL: arrayof punkt, nr, ilcz,ilb :integer;
+ output cz, b : integer);
+ (*obliczanie liczby punktow czerwonych i bialych na lewo od lamanej*)
+ var i, j : integer, boo : boolean;
+ begin
+ cz:= 0; (*czerwone na lewo*)
+ for i := 1 to ilcz do
+ j := nr;
+ boo:= true;
+ while j>1 and boo do
+ if TabCz(i).naLewo(LL(j-1),LL(j)) then j:= j-1
+ else boo := false fi
+ od;
+ if boo then cz := cz+1 fi
+ od ;
+ b:= 0; (*biale na lewo*)
+ for i := 1 to ilb do
+ j := nr;
+ boo:= true;
+ while j>1 and boo do
+ if TabB(i).naLewo(LL(j-1),LL(j)) then j:= j-1
+ else boo := false fi
+ od;
+ if boo then b := b+1 fi
+ od ;
+ end ZLICZANIE;
+
+ UNIT NaLewo : procedure(p1,p2:punkt; output cz,b : integer);
+ var i : integer;
+ begin
+ cz:= 0; (*czerwone na lewo*)
+ for i := 1 to ilcz do
+ if TabCz(i).naLewo(p1,p2) then cz := cz+1 fi
+ od ;
+ b:= 0; (*biale na lewo*)
+ for i := 1 to ilb do
+ if TabB(i).naLewo(p1,p2) then b := b+1 fi
+ od ;
+ end NaLewo;
+
+ UNIT chromosom : class(x,y, u,w,ocena: integer);
+ begin
+ end chromosom;
+
+ UNIT RysujProsta :procedure(x1,y1,x2,y2,c:integer);
+ begin
+ (* Narysuj przedluzenie wylosowanej prostej
+ call GUI_Line(p1.x,400,p2.x,40, c); *)
+ end RysujProsta;
+(*--------------------------------------------------------------*)
+
+
+ UNIT ALG_2 : procedure(ilCZ, ilB : integer);
+ var POKOLENIE : arrayof chromosom,
+ ch : chromosom,
+ p1, p2 : punkt,
+ il_pokolen, b, cz,ocena,
+ ii, i, j, mocP, il_prob, nrChromosomu : integer,
+ x,xx,y,yy,mm : integer;
+
+ begin
+ mocP := 10; (*zapamietuje tylko dziesiec najlepszych prob *)
+
+ array POKOLENIE dim(1:mocP); (*dwa punkty i ocena*)
+ nrChromosomu := 0;
+ il_prob := 20;
+ il_pokolen := 15;
+ call PokazPunkty;
+ call INFO(ilCz, ilB);
+
+ for i :=1 to il_prob do
+ (* wylosuj dwa punkty*)
+
+ p1 := new punkt(10+random*600, 40+random*360, c_yellow);
+ p2 := new punkt(10+random*600, 40+random*360, c_yellow);
+ (* narysuj prosta przechodzaca przez te punkty *)
+ call GUI_Line(p1.x,p1.y,p2.x,p2.y, c_yellow); (*wywolaj RysujProsta*)
+ x := p1.x + (p2.x-p1.x)*(40-p1.y)/(p2.y-p1.y);
+ if (x> 600 or x<20) then
+ if x<20 then mm := 20 fi ;
+ (*tak aby prosta miescila sie w ramce*)
+ if x>600 then mm:= 600 fi;
+ y := p1.y + (p2.y-p1.y)*(mm-p1.x)/(p2.x-p1.x);
+ else y := 40 fi;
+
+ xx :=p1.x + (p2.x-p1.x)*(400-p1.y)/(p2.y-p1.y);
+ if (xx> 600 or xx<20) then
+ if x<20 then mm := 20 fi ;
+ if x>600 then mm:= 600 fi;
+ yy := p1.y + (p2.y-p1.y)*(mm-p1.x)/(p2.x-p1.x);
+ else yy := 400 fi;
+
+ call GUI_Line(x,y,xx,yy, c_red);
+
+ call NaLewo(p1,p2,cz, b);
+ ocena := cz*(ilB-b) + b*(ilCz-cz);
+
+ (* ocen ja *)
+ call WYPISZ_INFO(cz,b,ilCz,ilB,ocena);
+ while GUI_KeyPressed=0 do od; (*czeka na popchniecie *)
+ (*wymaz prosta*)
+ call GUI_Line(p1.x, p1.y, p2.x, p2.y, c_blue);
+ if i<10 then ii := i else ii := mocP fi;
+
+ (*wpisz te prosta do tablicy POKOLENIE , tzn.:*)
+ (*metoda insertion sort dolaczam nowy chromosom do tworzonego pokolenia*)
+ while ii > 1 do
+ if POKOLENIE(ii-1).ocena < ocena then
+ POKOLENIE (ii) := POKOLENIE (ii-1);
+ ii := ii-1;
+ else
+ exit
+ fi;
+ od;
+ POKOLENIE (ii) := new chromosom(p1.x, p1.y,p2.x,p2.y, ocena);
+ od (* koniec prob*) ;
+ for j := 1 to il_pokolen do
+ (* narysuj najlepsza prosta i jej ocene *)
+ call GUI_Line(POKOLENIE(1).x,POKOLENIE(1).y,
+ POKOLENIE(1).u,POKOLENIE(1).w, c_yellow);
+ call GUI_WriteInt(MinX+510, MaxY-50,
+ POKOLENIE(1).ocena,c_white,c_darkGrey);
+
+ (* mutacja lub / i krzyzowanie *)
+ call mutacja(prMutacji,POKOLENIE) ;
+ (* if random >pr_krzyzowanie then call krzyzowanie fi;*)
+ (*wyznaczam nastepne pokolenie*)
+ (* call ruletka; *)
+ i := 0;
+ call GUI_MousePressed(xx,yy,i);
+ if i = 1 and CZY(xx, yy,STOP_IKONA) then call clear_all; exit fi;
+ od;
+ end ALG_2;
+
+ UNIT MUTACJA : procedure(prMutacji: integer;
+ inout POKOLENIE: arrayof chromosom);
+ var i, j, ii, cz, b, mocP, ocena : integer, chr : chromosom;
+ begin
+ mocP := upper(POKOLENIE);
+ for i := 1 to mocP do
+ if random>prMutacji then
+ chr := POKOLENIE(i);
+ j := random * 8; (*wylosuj pozycje mutowana*)
+ (* zmutuj *)
+ case j
+ when 0,1 : chr.x := 10+random*600;
+ when 2,3 : chr.y := 40+random*360;
+ when 4,5 : chr.u := 10+random*600;
+ when 6,7 : chr.w := 40+random*360;
+ esac;
+
+ (* chr.ocena :=*)
+ (* wylicz ocene zmutowanego chromosomu *)
+ call NaLewo(new punkt(chr.x,chr.y,0),new punkt(chr.u,chr.w,0),cz, b);
+ ocena := cz*(ilB-b) + b*(ilCz-cz);
+
+ (* wstaw na wlasciwe miejsce w tablicy POKOLENIE*)
+ if chr.ocena > POKOLENIE(i).ocena then
+ ii := i;
+ while ii>1 do
+ if POKOLENIE(ii-1).ocena < chr.ocena then
+ POKOLENIE (ii) := POKOLENIE (ii-1);
+ ii := ii-1;
+ else exit
+ fi;
+ od;
+ POKOLENIE (ii) := chr;
+ else
+ ii := i;
+ while ii < mocP do
+ if POKOLENIE(ii+1).ocena > chr.ocena then
+ POKOLENIE (ii) := POKOLENIE (ii+1);
+ ii := ii+1;
+ else exit fi;
+ od;
+ POKOLENIE (ii) := chr;
+ fi;
+ fi;
+ od;
+ end MUTACJA;
+
+ UNIT Krzyzowanie : procedure;
+ begin
+ end Krzyzowanie;
+
+(*--------------------------------------------------------------*)
+
+ VAR
+
+ OK_ikona,YES_ikona,NO_ikona, STOP_IKONA,
+ EXIT_IKONA, CONTINUE_IKONA : IKONA,
+ menu_main, menu_START : menu,
+ boo: boolean,
+ TabCz, TabB : arrayof punkt,
+ xx,yy,r,l,z,i , il_punktow, ilCz, ilB, jakosc : integer,
+ prMutacji, prKrzyzowania : real;
+
+ handlers
+ when MEMERROR : call comment("Zabraklo pamieci");
+ call waitt;
+ when ACCERROR : call comment("Reference to none PR GLOWNY");
+ call waitt;
+ when LOGERROR : call comment("Niepoprawny Attach PR GLOWNY");
+ call waitt;
+ when CONERROR : call comment(" Array-index error PR GLOWNY");
+ call waitt;
+ when SYSERROR : call comment("input-output error");
+ call waitt;
+ when NUMERROR : call comment("blad numeryczny");
+ call waitt;
+ others : call comment("Jakis blad ");
+ call waitt;
+ end handlers;
+
+
+ BEGIN (* tu musi sie wygenerowac menu *)
+
+ YES_ikona := new IKONA(6,450,360,500,385,3,"YES");
+ NO_ikona := new IKONA(6,505,360,555,385,3,"NO");
+ STOP_IKONA := new IKONA(c_green,590,430,635,460,3,"STOP");
+ CONTINUE_IKONA :=
+ new IKONA(c_lightGrey,400,350,550,390,3," C O N T I N U E");
+
+ (* Strona tytulowa *)
+ CALL GUI_Rect(minX+1,minY+1,maxX-2,maxY-2,c_black,c_lightGrey);
+
+ CALL GUI_writeText(250,100,unpack("PROJEKT"), c_black,c_lightGrey);
+ CALL GUI_writeText(250,200,unpack(
+ "R O Z D Z I E L A N I E P U N K T O W"), c_black,c_lightGrey);
+
+ call CONTINUE_IKONA.write_i;
+ i := 0;
+ while i<>1 or not CZY(xx,yy,CONTINUE_IKONA) do
+ call GUI_MousePressed(xx,yy,i);
+ od;
+ call CONTINUE_IKONA.push;
+
+
+ (* creation of main menu *)
+ menu_main := new menu(minX,maxX,minY,maxY,new OPTIONS_MAIN(4));
+
+ menu_main.ICONES(3).sub_menu :=
+ new menu(minX,maxX,minY,maxY,new OPTIONS_help(3));
+
+ menu_main.ICONES(4).sub_menu :=
+ new menu(minX,maxX,minY,maxY,new OPTIONS_START(4));
+
+
+ il_punktow := 100;
+ jakosc := 70;
+ prMutacji := 0.7;
+ attach(menu_main);
+
+ call comment("THIS ENDS THE PROGRAM EXECUTION !!!!!");
+ call endRun;
+ END;
+
+ END (* block od Grafiki *)
+END RozdzileaniePunktow;
+
+
+
+ \0\0
\ No newline at end of file
--- /dev/null
+### Includes for QT library
+QINC=/usr/lib/qt-1.45/include
+
+### QT library directory
+QLIB=/usr/lib/qt-1.45/lib
+
+### moc compiler directory
+MOCDIR=/usr/lib/qt-1.45/bin
+
+### Install directory
+INSTALLDIR=/usr/local/vlp
+
+INCDIR = $(QINC)
+CFLAGS = -O2 -fno-strength-reduce -Wall -W -I/usr/X11R6/include
+LIBCFLAGS = -fPIC
+YACCCFLAGS = -Wno-unused -Wno-parentheses
+LFLAGS = -L$(QLIB) -lqt
+CC = g++
+MOC = $(MOCDIR)/moc
+SHELL = /bin/sh
+
+
+####### Files
+
+SOURCES = loggraph.cpp
+OBJECTS = loggraph.o
+SRCMETA = loggraph.moc
+TARGET = loggraph
+
+####### Implicit rules
+
+.SUFFIXES: .cpp
+
+.cpp.o:
+ $(CC) -c $(CFLAGS) -I$(INCDIR) $<
+
+####### Build rules
+
+all: $(TARGET)
+
+$(TARGET): $(SRCMETA) $(OBJECTS)
+ $(CC) $(OBJECTS) -o $(TARGET) $(LFLAGS) -lm
+
+depend:
+ @makedepend -I$(INCDIR) $(SOURCES) 2> /dev/null
+
+showfiles:
+ @echo $(SOURCES) $(HEADERS) Makefile
+
+clean:
+ -rm -f *.o *.bak *~ *% #*
+ -rm -f $(SRCMETA) $(TARGET)
+
+####### Meta objects
+
+loggraph.moc: loggraph.cpp
+ $(MOC) loggraph.cpp -o loggraph.moc
+
+
--- /dev/null
+//
+// Qt Example Application: drawdemo
+//
+// Demonstrates the painter and the printer.
+//
+
+#include <qwindow.h>
+#include <qpainter.h>
+#include <qprinter.h>
+#include <qpushbt.h>
+#include <qradiobt.h>
+#include <qbttngrp.h>
+#include <qapp.h>
+#include <math.h>
+#include <qpixmap.h>
+#include <qscrbar.h>
+#include <qcolor.h>
+#include <stdio.h>
+#include <qfont.h>
+#include <qfontmet.h>
+#include <qlist.h>
+#include <fcntl.h>
+#include <sys/stat.h>
+#include <netinet/in.h>
+#include "../head/genint1.h"
+#include "../head/comm.h"
+#include "socu.h"
+#include <unistd.h>
+#include <qsocknot.h>
+#include <qobject.h>
+#include <errno.h>
+#include <qqueue.h>
+#include <qmsgbox.h>
+#include <qmenubar.h>
+#include <qpopmenu.h>
+#include <qkeycode.h>
+
+
+
+#define MAXWIDTH 640
+#define MAXHEIGHT 480
+#define TEXT_LINES 50
+#define TEXT_COLS 100
+#define REQUEST_NAME "gr.req"
+#define PERM 0666
+
+
+class VGRMap
+{
+ public:
+ QPixmap *map;
+ int number;
+
+ VGRMap(int n,QPixmap *m) { number=n; map = m; };
+};
+
+
+
+
+class VGR : public QFrame
+{
+ Q_OBJECT
+public:
+
+ VGR(char*);
+ ~VGR();
+
+
+ int resp_sock;
+ int fcol,bcol,gfcol,gbcol;
+ int curx,cury;
+ int tx,ty;
+ QQueue<int> CharBuffer;
+
+ bool string_wait, char_wait, line_wait, mouse_wait, inkey_wait, was_line;
+ QColor *lcolors[256];
+ QFont *prv_font, *italic_font, *bold_font, *normal_font;
+
+ void MakeColors();
+
+ void SetForeground(int);
+ void SetBackground(int);
+ void ClearAll();
+ void ClearArea(int,int,int,int);
+
+ void Line(int,int,int,int);
+ void Ellipse(int x,int y,int a, int b,int alfa, int beta, int fill);
+ void Rect(int x1, int y1, int x2, int y2,int col, int fill);
+ void Point(int x, int y);
+ void TextXY(int x, int y, char *s);
+ void CharXY(int x, int y, char a);
+ void IntXY(int x, int y, int val);
+
+ void WriteText(char *s);
+ void WriteChar(char a);
+ void WriteLine();
+ void PutChar(char a); /* Write Char w/o changing position */
+ void DelChar();
+
+ void Outstring(int x, int y, char *s, int b, int f);
+ void writeintxy(int x, int y, int val,int c);
+ void CurPos();
+
+
+ int Getmap(int w, int h);
+ void Putmap(int map);
+
+ void MagicGraph(G_MESSAGE*);
+ bool GetInput(int);
+
+public slots:
+ void vscrolled(int);
+ void hscrolled(int);
+ void CloseMe();
+ void RequestMessage();
+
+protected:
+ virtual void resizeEvent( QResizeEvent * );
+ virtual void closeEvent(QCloseEvent *);
+ virtual void keyPressEvent(QKeyEvent *);
+ virtual void mousePressEvent(QMouseEvent *);
+ virtual void paintEvent(QPaintEvent *);
+ virtual void focusInEvent(QFocusEvent *);
+private:
+ QPixmap *canvas;
+ QScrollBar *hscroll,*vscroll;
+ QPushButton *close_btn;
+ int ox,oy,lstep,pstep,gx,gy;
+ QList<VGRMap> maps;
+ int firstfreemap;
+ bool Closed, MustRepaint,GraphRead;
+ QSocketNotifier *request;
+ char internal_buffer[256];
+ int strcnt;
+
+
+};
+
+
+
+void VGR::MakeColors()
+{
+ lcolors[0] = new QColor(0, 0, 0 ); /* black */
+ lcolors[1] = new QColor(0, 0, 139); /* blue dark */
+ lcolors[2] = new QColor(0, 100, 0 ); /* green dark */
+ lcolors[3] = new QColor(0, 197, 205 ); /* turquoise dark */
+ lcolors[4] = new QColor(205,0 , 0 ); /* red dark */
+ lcolors[5] = new QColor(238, 130,238); /* violet */
+ lcolors[6] = new QColor(139,35,35 ); /* brown */
+ lcolors[7] = new QColor(190,190,190 ); /* grey light */
+ lcolors[8] = new QColor(97, 97, 97 ); /* grey dark */
+ lcolors[9] = new QColor(0, 0, 255 ); /* blue */
+ lcolors[10] = new QColor(0, 255, 0 ); /* green */
+ lcolors[11] = new QColor(0, 229,238 ); /* turquoise */
+ lcolors[12] = new QColor(255, 0, 0 ); /* red light */
+ lcolors[13] = new QColor(255, 110,180 ); /* rose */
+ lcolors[14] = new QColor(255,255, 0 ); /* yellow */
+ lcolors[15] = new QColor(255, 255, 255 ); /* white */
+}
+
+//
+// Construct the DrawView with buttons.
+//
+
+VGR::VGR(char *sockname)
+:QFrame()
+{
+ QPixmap mp;
+ struct sockaddr_un svr;
+ int len,i,optval,on;
+
+
+
+ normal_font = new QFont("lucidatypewriter",12,QFont::Normal);
+ normal_font->setFixedPitch(TRUE);
+ bold_font = new QFont("lucidatypewriter",12,QFont::Bold);
+ bold_font->setFixedPitch(TRUE);
+ italic_font = new QFont("lucidatypewriter",12,QFont::Normal,TRUE);
+ italic_font->setFixedPitch(TRUE);
+
+ prv_font = normal_font;
+
+ MakeColors();
+ setCaption( "graphic resource" );
+ setBackgroundColor( white );
+ canvas = new QPixmap(640,480);
+ canvas->fill(backgroundColor());
+
+ ox=0;oy=0;
+ curx=0;cury=0;
+ tx=0;ty=0;gx=0;gy=0;
+ maps.setAutoDelete(TRUE);
+ firstfreemap=1;
+ Closed = FALSE;GraphRead=FALSE;
+ lstep=10;pstep=250;
+ hscroll = new QScrollBar(0,MAXWIDTH,lstep,pstep,0,QScrollBar::Horizontal,this);
+ vscroll = new QScrollBar(0,MAXHEIGHT,lstep,pstep,0,QScrollBar::Vertical,this);
+ hscroll->setTracking(TRUE);
+ vscroll->setTracking(TRUE);
+ resize( 640,300 );
+
+ hscroll->setGeometry(0,height()-16,width()-16,16);
+ vscroll->setGeometry(width()-16,0,16,height()-16);
+
+ connect(hscroll,SIGNAL(valueChanged(int)),this,SLOT(hscrolled(int)));
+ connect(vscroll,SIGNAL(valueChanged(int)),this,SLOT(vscrolled(int)));
+
+ close_btn = new QPushButton(this,"close");
+
+ if( mp.load("pics/close.bmp"))
+ close_btn->setPixmap(mp);
+ else
+ close_btn->setText("C");
+ close_btn->setGeometry(width()-16,height()-16,16,16);
+ close_btn->setEnabled(FALSE);
+ connect(close_btn,SIGNAL(clicked()),this,SLOT(CloseMe()));
+
+
+ gfcol=fcol = 0;
+ gbcol=bcol = 15;
+ resp_sock = socket(AF_UNIX,SOCK_STREAM,0);
+ bzero(&svr,sizeof(svr));
+ svr.sun_family = AF_UNIX;
+ strcpy(svr.sun_path,sockname);
+ len = strlen(svr.sun_path)+sizeof(svr.sun_family);
+ i = ::connect(resp_sock,(struct sockaddr*)&svr,len);
+ if (i==0) fcntl(resp_sock,F_SETFL,O_NONBLOCK|fcntl(resp_sock,F_GETFL,0));
+ on=1;
+ setsockopt(resp_sock,IPPROTO_TCP,TCP_NODELAY,(char*)&on,sizeof(on));
+ request = new QSocketNotifier(resp_sock,QSocketNotifier::Read);
+ connect(request,SIGNAL(activated(int)),this,SLOT(RequestMessage()));
+ optval=TCP_BUFFER_SIZE;
+// setsockopt(resp_sock,SOL_SOCKET,SO_SNDBUF,&optval,sizeof(optval));
+// setsockopt(resp_sock,SOL_SOCKET,SO_RCVBUF,&optval,sizeof(optval));
+
+ inkey_wait = FALSE;string_wait = FALSE;
+ char_wait = FALSE;line_wait = FALSE;mouse_wait = FALSE;
+ was_line=FALSE;
+ CharBuffer.clear();
+ CharBuffer.setAutoDelete(TRUE);
+
+ setFocusPolicy(QWidget::StrongFocus);
+ hscroll->setRange(0,MAXWIDTH-width()+20);
+ vscroll->setRange(0,MAXHEIGHT-height()+20);
+ hscroll->setSteps((int)(hscroll->width()/hscroll->maxValue()),(int)((hscroll->width()/hscroll->maxValue())*4));
+ vscroll->setSteps((int)(vscroll->height()/vscroll->maxValue()),(int)((vscroll->height()/vscroll->maxValue())*4));
+
+ setMaximumSize(MAXWIDTH+16,MAXHEIGHT+16);
+ setUpdatesEnabled(FALSE);
+};
+
+VGR::~VGR()
+{
+ if (request!=NULL)
+ delete request;
+}
+
+
+
+void VGR::paintEvent(QPaintEvent *p)
+{
+//if (isUpdatesEnabled())
+{
+ bitBlt(this,0,0,canvas,ox,oy,width()-16,height()-16);
+}
+ MustRepaint=FALSE;
+}
+
+void VGR::focusInEvent(QFocusEvent *)
+{
+setUpdatesEnabled(TRUE);
+repaint();
+setUpdatesEnabled(FALSE);
+}
+
+
+void VGR::resizeEvent( QResizeEvent *ev )
+{
+ hscroll->setGeometry(0,height()-16,width()-16,16);
+ vscroll->setGeometry(width()-16,0,16,height()-16);
+ close_btn->setGeometry(width()-16,height()-16,16,16);
+ hscroll->setRange(0,MAXWIDTH-width()+20);
+ vscroll->setRange(0,MAXHEIGHT-height()+20);
+ pstep=height()-32;
+ hscroll->setSteps(lstep,pstep);
+ vscroll->setSteps(lstep,pstep);
+}
+
+void VGR::closeEvent(QCloseEvent *ev)
+{
+ if (Closed) QFrame::closeEvent(ev);
+}
+
+void VGR::mousePressEvent(QMouseEvent *ev)
+{
+ G_MESSAGE msg;
+
+ if (mouse_wait)
+ {
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_MGETPRESS_RESPONSE;
+ msg.param.pword[2] = ev->pos().x()-ox;
+ msg.param.pword[3] = ev->pos().y()-oy;
+ switch(ev->button())
+ {
+ case LeftButton: msg.param.pword[7] = 1;
+ break;
+ case RightButton: msg.param.pword[7] = 3;
+ break;
+ case MidButton:msg.param.pword[7] = 2;
+ break;
+ default:msg.param.pword[7] = 0;break;
+ }
+ write(resp_sock,&msg,sizeof(G_MESSAGE));
+
+ mouse_wait = FALSE;
+ }
+ QFrame::mousePressEvent(ev);
+}
+
+
+bool VGR::GetInput(int t)
+{
+ G_MESSAGE msg;
+
+if (!CharBuffer.isEmpty())
+{
+switch(t)
+{
+case 2:
+ {
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_INKEY_RESPONSE;
+ msg.param.pword[3] = *(CharBuffer.dequeue());
+ write(resp_sock,&msg,sizeof(G_MESSAGE));
+ inkey_wait = FALSE;
+ return TRUE;
+ };break;
+
+case 0:
+ {
+ if (GraphRead)
+ {
+
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_MAGIC_RESPONSE;
+ msg.param.pword[1]=0;
+ msg.param.pchar =(char)(*(CharBuffer.dequeue()));
+ WriteChar(msg.param.pchar);
+ GraphRead=FALSE;
+ } else
+ {
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_READCHAR_RESPONSE;
+ msg.param.pchar =(char)(*(CharBuffer.dequeue()));
+ }
+
+ write(resp_sock,&msg,sizeof(G_MESSAGE));
+ char_wait = FALSE;
+ return TRUE;
+ };break;
+
+case 1:
+ {
+
+ while ( ((!CharBuffer.isEmpty()) && (!(*(CharBuffer.dequeue())=13))));
+ if (!CharBuffer.isEmpty())
+ {
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_READLN_RESPONSE;
+ write(resp_sock,&msg,sizeof(G_MESSAGE));
+ line_wait = FALSE;
+ return TRUE;
+ }
+
+ };break;// line_wait
+} //swictch
+} // buffer empty
+
+if ( (CharBuffer.isEmpty()) && (t==2))
+{
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_INKEY_RESPONSE;
+ msg.param.pword[3] = 0;
+ write(resp_sock,&msg,sizeof(G_MESSAGE));
+ inkey_wait = FALSE;
+ return TRUE;
+}
+
+ return FALSE;
+}
+
+void VGR::keyPressEvent(QKeyEvent *ev)
+{
+ G_MESSAGE msg;
+ int *pom;
+
+ pom = new int[1];
+ *pom=ev->ascii();
+ if (*pom==0)
+ switch(ev->key())
+ {
+ case Key_F1:*pom=-10;break;
+ case Key_F2:*pom=-11;break;
+ case Key_F3:*pom=-12;break;
+ case Key_F4:*pom=-13;break;
+ case Key_F5:*pom=-14;break;
+ case Key_F6:*pom=-15;break;
+ case Key_F7:*pom=-16;break;
+ case Key_F8:*pom=-17;break;
+ case Key_F9:*pom=-18;break;
+ case Key_F10:*pom=-19;break;
+ case Key_Insert:*pom=-20;break;
+ case Key_Home:*pom=-21;break;
+ case Key_End:*pom=-22;break;
+ case Key_PageUp:*pom=-23;break;
+ case Key_PageDown:*pom=-24;break;
+ case Key_Left:*pom=-25;break;
+ case Key_Right:*pom=-26;break;
+ case Key_Up:*pom=-27;break;
+ case Key_Down:*pom=-28;break;
+ }// switch
+
+ if ( (!string_wait) && (!inkey_wait) && (!char_wait) && (!line_wait) )
+ CharBuffer.enqueue(pom);
+
+
+ if (inkey_wait)
+ {
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_INKEY_RESPONSE;
+ msg.param.pword[3] = *pom;
+ write(resp_sock,&msg,sizeof(G_MESSAGE));
+ inkey_wait = FALSE;
+ };
+
+ if (char_wait)
+ {
+ if (GraphRead)
+ {
+
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_MAGIC_RESPONSE;
+ msg.param.pword[1]=0;
+ WriteChar((char)ev->ascii());
+ GraphRead=FALSE;
+ }
+ else
+{
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_READCHAR_RESPONSE;
+}
+ msg.param.pchar =(char)ev->ascii();
+ write(resp_sock,&msg,sizeof(G_MESSAGE));
+ char_wait = FALSE;
+ }
+
+ if ( (line_wait) && (ev->ascii()==13) )
+ {
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_READLN_RESPONSE;
+ write(resp_sock,&msg,sizeof(G_MESSAGE));
+ line_wait = FALSE;
+ }
+
+ if (string_wait)
+ {
+ if (ev->ascii()==13)
+ {
+ internal_buffer[strcnt]='\0';
+ DelChar();
+ if (GraphRead)
+ {
+ GraphRead=FALSE;
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_MAGIC_RESPONSE;
+ msg.param.pword[1]=0;
+ } else
+ {
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_READSTR_RESPONSE;
+ }
+ strcpy(msg.param.pstr,internal_buffer);
+ write(resp_sock,&msg,sizeof(G_MESSAGE));
+ string_wait = FALSE;
+ was_line=TRUE;
+ CharBuffer.clear();
+ }
+ else
+ if (ev->ascii()==8)
+ {
+ strcnt--;DelChar();DelChar();WriteChar('_');
+ } else
+ {internal_buffer[strcnt]=(char)ev->ascii();strcnt++;
+ DelChar();
+ WriteChar((char)ev->ascii());WriteChar('_');}
+ }
+
+
+}
+
+
+void VGR::CloseMe()
+{
+ qApp->quit();
+}
+
+
+
+void VGR::hscrolled(int val)
+{
+ox = val;
+setUpdatesEnabled(TRUE);
+repaint();
+setUpdatesEnabled(FALSE);
+}
+
+void VGR::vscrolled(int val)
+{
+oy = val;
+setUpdatesEnabled(TRUE);
+repaint();
+setUpdatesEnabled(FALSE);
+}
+
+
+// **************************************
+
+void VGR::SetForeground(int col)
+{
+ fcol = col;
+}
+
+void VGR::SetBackground(int col)
+{
+ bcol = col;
+}
+
+void VGR::Line(int x1,int y1,int x2,int y2)
+{
+ QPainter p;
+ p.begin(canvas);
+ p.setPen(*lcolors[fcol]);
+ p.drawLine(x1,y1,x2,y2);
+ p.end();
+
+ p.begin(this);
+ p.setPen(*lcolors[fcol]);
+ p.drawLine(x1-ox, y1-oy,x2-ox, y2-oy);
+ p.end();
+}
+
+
+void VGR::Ellipse(int x,int y,int a, int b,int alfa, int beta, int fill)
+{
+ QPainter p;
+
+ p.begin(canvas);
+ p.setPen(*lcolors[fcol]);
+ p.setBrush(*lcolors[fcol]);
+ if (fill>0)
+ p.drawPie(x,y,a,b,alfa*16,(beta-alfa)*16);
+ else
+ p.drawArc(x,y,a,b,alfa*16,(beta-alfa)*16);
+ p.end();
+
+ p.begin(this);
+ p.setPen(*lcolors[fcol]);
+ p.setBrush(*lcolors[fcol]);
+ if (fill>0)
+ p.drawPie(x-ox, y-oy,a,b,alfa*16,(beta-alfa)*16);
+ else
+ p.drawArc(x-ox, y-oy,a,b,alfa*16,(beta-alfa)*16);
+ p.end();
+
+}
+
+void VGR::Rect(int x1, int y1, int x2, int y2,int col, int fill)
+{
+ QPainter p;
+ QBrush b(*lcolors[col]);
+ p.begin(canvas);
+ p.setPen(*lcolors[col]);
+ if (fill>0) p.fillRect(x1,y1,x2-x1,y2-y1,b);
+ else p.drawRect(x1,y1,x2-x1,y2-y1);
+ p.end();
+
+
+ p.begin(this);
+ p.setPen(*lcolors[col]);
+ if (fill>0) p.fillRect(x1-ox, y1-oy,x2-x1,y2-y1,b);
+ else p.drawRect(x1-ox, y1-oy,x2-x1,y2-y1);
+ p.end();
+
+}
+
+void VGR::TextXY(int x, int y, char *s)
+{
+ QPainter p;
+ QFontMetrics fm(*prv_font);
+
+ p.begin(canvas);
+ p.setPen(*lcolors[fcol]);
+ p.setBackgroundColor(*lcolors[bcol]);
+ p.setBackgroundMode(OpaqueMode);
+ p.setFont(*prv_font);
+ p.drawText(x,y+fm.height(),s,strlen(s));
+ p.end();
+
+
+ p.begin(this);
+ p.setPen(*lcolors[fcol]);
+ p.setBackgroundColor(*lcolors[bcol]);
+ p.setBackgroundMode(OpaqueMode);
+ p.setFont(*prv_font);
+ p.drawText(x-ox, y-oy+fm.height(),s,strlen(s));
+ p.end();
+
+}
+
+
+void VGR::CharXY(int x, int y, char a)
+{
+ QPainter p;
+ char s[2];
+ QFontMetrics fm(*prv_font);
+
+ s[0] = a;
+ s[1] = '\0';
+ p.begin(canvas);
+ p.setPen(*lcolors[fcol]);
+ p.setBackgroundColor(*lcolors[bcol]);
+ p.setBackgroundMode(OpaqueMode);
+ p.setFont(*prv_font);
+ p.drawText(x,y+fm.height(),s,strlen(s));
+ p.end();
+
+ p.begin(this);
+ p.setPen(*lcolors[fcol]);
+ p.setBackgroundColor(*lcolors[bcol]);
+ p.setBackgroundMode(OpaqueMode);
+ p.setFont(*prv_font);
+ p.drawText(x-ox, y-oy+fm.height(),s,strlen(s));
+ p.end();
+
+}
+
+
+void VGR::IntXY(int x, int y, int val)
+{
+ QPainter p;
+ char s[80];
+ QFontMetrics fm(*prv_font);
+
+ sprintf(s,"%d",val);
+ p.begin(canvas);
+ p.setPen(*lcolors[fcol]);
+ p.setBackgroundColor(*lcolors[bcol]);
+ p.setBackgroundMode(OpaqueMode);
+ p.setFont(*prv_font);
+ p.drawText(x,y+fm.height(),s,strlen(s));
+ p.end();
+
+
+ p.begin(this);
+ p.setPen(*lcolors[fcol]);
+ p.setBackgroundColor(*lcolors[bcol]);
+ p.setBackgroundMode(OpaqueMode);
+ p.setFont(*prv_font);
+ p.drawText(x-ox, y-oy+fm.height(),s,strlen(s));
+ p.end();
+
+}
+
+void VGR::WriteText(char *s)
+{
+ QPainter p;
+ QFontMetrics fm(*prv_font);
+
+ p.begin(canvas);
+ p.setPen(*lcolors[fcol]);
+ p.setBackgroundColor(*lcolors[bcol]);
+ p.setBackgroundMode(OpaqueMode);
+ p.setFont(*prv_font);
+ p.drawText(tx*fm.maxWidth(),(ty+1)*fm.height(),s,strlen(s));
+ p.end();
+
+ p.begin(this);
+ p.setPen(*lcolors[fcol]);
+ p.setBackgroundColor(*lcolors[bcol]);
+ p.setBackgroundMode(OpaqueMode);
+ p.setFont(*prv_font);
+ p.drawText(tx*fm.maxWidth()-ox, (ty+1)*fm.height()-oy,s,strlen(s));
+ p.end();
+
+ tx = tx + strlen(s);
+ if (tx>TEXT_COLS) {tx=0;ty++;};
+ if (ty>TEXT_LINES) {ClearAll();};
+
+}
+
+void VGR::WriteChar(char a)
+{
+ QPainter p;
+ QFontMetrics fm(*prv_font);
+ char s[2];
+
+ s[0] = a;
+ s[1] = '\0';
+
+if (GraphRead)
+{
+ p.begin(canvas);
+ p.setPen(*lcolors[gfcol]);
+ p.setBackgroundColor(*lcolors[gbcol]);
+ p.setBackgroundMode(OpaqueMode);
+ p.setFont(*prv_font);
+ p.drawText(gx,gy+fm.height(),s,strlen(s));
+ p.end();
+
+ p.begin(this);
+ p.setPen(*lcolors[gfcol]);
+ p.setBackgroundColor(*lcolors[gbcol]);
+ p.setBackgroundMode(OpaqueMode);
+ p.setFont(*prv_font);
+ p.drawText(gx-ox, gy-oy+fm.height(),s,strlen(s));
+ p.end();
+
+ gx = gx + strlen(s)*fm.maxWidth();
+ if (gx>MAXWIDTH) {gy=gy+fm.height();gx=0;};
+ if (gy>MAXHEIGHT) {ClearAll();};
+}
+else
+{
+ p.begin(canvas);
+ p.setPen(*lcolors[fcol]);
+ p.setBackgroundColor(*lcolors[bcol]);
+ p.setBackgroundMode(OpaqueMode);
+ p.setFont(*prv_font);
+ p.drawText(tx*fm.maxWidth(),(ty+1)*fm.height(),s,strlen(s));
+ p.end();
+
+ p.begin(this);
+ p.setPen(*lcolors[fcol]);
+ p.setBackgroundColor(*lcolors[bcol]);
+ p.setBackgroundMode(OpaqueMode);
+ p.setFont(*prv_font);
+ p.drawText(tx*fm.maxWidth()-ox, (ty+1)*fm.height()-oy,s,strlen(s));
+ p.end();
+
+ tx = tx + strlen(s);
+ if (tx>TEXT_COLS) {tx=0;ty++;};
+ if (ty>TEXT_LINES) {ClearAll();};
+}
+}
+
+void VGR::DelChar()
+{
+ QPainter p;
+ QFontMetrics fm(*prv_font);
+
+if (GraphRead)
+{
+ p.begin(canvas);
+ p.setPen(*lcolors[fcol]);
+ p.fillRect(gx-fm.maxWidth(),gy,fm.maxWidth(),
+ fm.height()+fm.descent()+1, *lcolors[bcol]);
+ p.end();
+
+ p.begin(this);
+ p.setPen(*lcolors[fcol]);
+
+ p.fillRect(gx-ox-fm.maxWidth(), gy-oy,fm.maxWidth(),
+ fm.height()+fm.descent()+1, *lcolors[bcol]);
+ p.end();
+ gx=gx-fm.maxWidth();
+
+}
+else // Text read
+{
+ p.begin(canvas);
+ p.setPen(*lcolors[fcol]);
+ p.fillRect((tx-1)*fm.maxWidth(),(ty)*fm.height(),tx*fm.maxWidth(),
+ (ty+1)*fm.height()+fm.descent()+1, *lcolors[bcol]);
+ p.end();
+
+ p.begin(this);
+ p.setPen(*lcolors[fcol]);
+ p.fillRect((tx-1)*fm.maxWidth()-ox, (ty)*fm.height()-oy,tx*fm.maxWidth(),
+ (ty+1)*fm.height()+fm.descent()+1, *lcolors[bcol]);
+ p.end();
+
+ tx--;
+ if (tx<0) tx=0;
+}
+}
+
+void VGR::PutChar(char a)
+{
+QPainter p;
+ QFontMetrics fm(*prv_font);
+ char s[2];
+
+ s[0] = a;
+ s[1] = '\0';
+ p.begin(canvas);
+ p.setPen(*lcolors[fcol]);
+ p.setBackgroundColor(*lcolors[bcol]);
+ p.setBackgroundMode(OpaqueMode);
+ p.setFont(*prv_font);
+ p.drawText(tx*fm.maxWidth(),(ty+1)*fm.height(),s,strlen(s));
+ p.end();
+
+ p.begin(this);
+ p.setPen(*lcolors[fcol]);
+ p.setBackgroundColor(*lcolors[bcol]);
+ p.setBackgroundMode(OpaqueMode);
+ p.setFont(*prv_font);
+ p.drawText(tx*fm.maxWidth()-ox, (ty+1)*fm.height()-oy,s,strlen(s));
+ p.end();
+
+}
+
+void VGR::WriteLine()
+{
+ tx=0;ty++;
+ if (ty>TEXT_LINES) {ClearAll();};
+}
+
+
+void VGR::Point(int x, int y)
+{
+ QPainter p;
+
+ p.begin(canvas);
+ p.setPen(*lcolors[fcol]);
+ p.drawPoint(x,y);
+ p.end();
+
+ p.begin(this);
+ p.setPen(*lcolors[fcol]);
+ p.drawPoint(x-ox, y-oy);
+ p.end();
+
+}
+
+
+void VGR::ClearArea(int x, int y, int w, int h)
+{
+ QPainter p;
+ p.begin(canvas);
+ p.eraseRect(x,y,w,h);
+ p.end();
+
+ p.begin(this);
+ p.eraseRect(x-ox,y-oy,w,h);
+ p.end();
+}
+
+void VGR::ClearAll()
+{
+ QPainter p;
+ QBrush b(QColor(white));
+
+ tx = 0; ty = 0;
+ curx = 0; cury = 0;
+ canvas->fill(backgroundColor());
+
+
+ p.begin(this);
+ p.fillRect(0,0,width()-16,height()-16,backgroundColor());
+ p.end();
+
+}
+
+
+int VGR::Getmap(int w, int h)
+{
+ QPixmap *m;
+
+ m = new QPixmap(w,h);
+ bitBlt(m,0,0,canvas,curx,cury,w,h);
+ maps.append(new VGRMap(firstfreemap,m));
+ firstfreemap++;
+ return(firstfreemap-1);
+}
+
+
+void VGR::Putmap(int map)
+{
+ VGRMap *m;
+ m = maps.first();
+ while (m!=NULL)
+ {
+ if (m->number == map)
+ {
+ bitBlt(canvas,curx,cury,m->map,0,0,m->map->width(),m->map->height());
+ bitBlt(this,curx-ox, cury-oy,m->map,0,0,m->map->width(),m->map->height());
+ break;
+ }
+ m = maps.next();
+ }
+}
+
+
+
+void VGR::Outstring(int x, int y, char *s, int b, int f)
+{
+ QPainter p;
+ QFontMetrics fm(*prv_font);
+
+ p.begin(canvas);
+ p.setPen(*lcolors[f]);
+ p.setBackgroundColor(*lcolors[b]);
+ p.setBackgroundMode(OpaqueMode);
+ p.setFont(*prv_font);
+ p.drawText(x,y+fm.height(),s,strlen(s));
+ p.end();
+
+ p.begin(this);
+ p.setPen(*lcolors[f]);
+ p.setFont(*prv_font);
+ p.setBackgroundColor(*lcolors[b]);
+ p.setBackgroundMode(OpaqueMode);
+ p.drawText(x-ox, y-oy+fm.height(),s,strlen(s));
+ p.end();
+
+}
+
+void VGR::writeintxy(int x, int y, int val,int c)
+{
+ QPainter p;
+ char s[80];
+ QFontMetrics fm(*prv_font);
+
+ sprintf(s,"%d",val);
+ p.begin(canvas);
+ p.setPen(*lcolors[c]);
+ p.setFont(*prv_font);
+ p.drawText(x,y,s,strlen(s));
+ p.end();
+
+ p.begin(this);
+ p.setPen(*lcolors[c]);
+ p.setFont(*prv_font);
+ p.drawText(x-ox, y-oy+fm.height(),s,strlen(s));
+ p.end();
+
+}
+
+
+void VGR::CurPos()
+{
+ G_MESSAGE msg;
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_CURPOS_RESPONSE;
+ msg.param.pword[3] = curx;
+ msg.param.pword[4] = cury;
+ write(resp_sock,&msg,sizeof(G_MESSAGE));
+}
+
+
+void VGR::RequestMessage()
+{
+ G_MESSAGE m,mm;
+ int stat;
+
+ bzero(&m,sizeof(G_MESSAGE));
+ stat = read(resp_sock,&m,sizeof(G_MESSAGE));
+ if (stat>0)
+ if (m.msg_type == MSG_GRAPH)
+ {
+ switch(m.param.pword[0])
+ {
+
+ case GRAPH_FREE:
+ close_btn->setEnabled(TRUE);
+ delete request;
+ request=NULL;
+ break;
+ case GRAPH_SET_TITLE:setCaption(m.param.pstr);break;
+ case GRAPH_WRITE:if (strcmp(m.param.pstr,"\n")==0)
+ WriteLine();else
+ WriteText(m.param.pstr);
+ break;
+ case GRAPH_WRITEXY: TextXY(m.param.pword[3],
+ m.param.pword[4],m.param.pstr);break;
+ case GRAPH_READCHAR: if (!GetInput(0)) char_wait = TRUE;break;
+ case GRAPH_READSTR: strcpy(internal_buffer,"");strcnt=0;
+ string_wait=TRUE;WriteChar('_');break;
+ case GRAPH_READLN: if (was_line)
+ {
+ m.msg_type = MSG_GRAPH;
+ m.param.pword[0] = GRAPH_READLN_RESPONSE;
+ write(resp_sock,&m,sizeof(G_MESSAGE));
+ was_line=FALSE;
+ }
+ else { if (!GetInput(1)) line_wait = TRUE;}
+ break;
+ case GRAPH_PUTCHAR: WriteChar(m.param.pchar);break;
+ case GRAPH_LINETO: Line(curx,cury,
+ m.param.pword[3],m.param.pword[4]);break;
+ case GRAPH_ELLIPSE: Ellipse(m.param.pword[3],
+ m.param.pword[4],m.param.pword[5],m.param.pword[6],
+ m.param.pword[7],m.param.pword[8], m.param.pword[9]);
+ break;
+ case GRAPH_RECT: Rect(m.param.pword[3],
+ m.param.pword[4],m.param.pword[5],
+ m.param.pword[6], m.param.pword[7],
+ m.param.pword[8]);
+ break;
+ case GRAPH_FOREGROUND:SetForeground(m.param.pword[3]);break;
+ case GRAPH_BACKGROUND:SetBackground(m.param.pword[3]);break ;
+ case GRAPH_POINT:Point(m.param.pword[3], m.param.pword[4]);
+ break;
+ case GRAPH_CLEAR:ClearAll();
+ break;
+ case GRAPH_INKEY:if (!GetInput(2)) inkey_wait = TRUE;break;
+ case GRAPH_CURPOS:CurPos();break;
+ case GRAPH_OUTSTRING:Outstring( m.param.pword[2],m.param.pword[3],m.param.pstr,
+ m.param.pword[4],m.param.pword[5]);
+ break;
+ case GRAPH_WRITEINTXY: writeintxy(m.param.pword[2],
+ m.param.pword[3],m.param.pword[4],
+ m.param.pword[5]);break;
+ case GRAPH_GETMAP:
+ bzero(&mm,sizeof(G_MESSAGE));
+ mm.msg_type = MSG_GRAPH;
+ mm.param.pword[0] = GRAPH_GETMAP_RESPONSE;
+ mm.param.pword[2] = Getmap(m.param.pword[2]-curx,
+ m.param.pword[3]-cury);
+ mm.param.pword[3] = m.param.pword[2]-curx;
+ mm.param.pword[4] = m.param.pword[3]-cury;
+ write(resp_sock,&mm,sizeof(G_MESSAGE));
+ break;
+ case GRAPH_PUTMAP: Putmap(m.param.pword[2]);
+ break;
+ case GRAPH_MOVE: curx = m.param.pword[2];
+ cury = m.param.pword[3];
+ break;
+ case GRAPH_MGETPRESS:mouse_wait=TRUE;break;
+ case GRAPH_MAGIC: MagicGraph(&m);break;
+ case GRAPH_HASCII: if (m.param.pword[1]!=0) CharXY(curx,cury,(char)m.param.pword[1]);
+ else CharXY(curx,cury,' ');break;
+ } /* end switch */
+ } /* stat > 0 */
+}
+
+
+
+
+void VGR::MagicGraph(G_MESSAGE *msg)
+{
+ int f,b;
+ char ss[255];
+ QPixmap p;
+ VGRMap *pmap;
+
+ switch(msg->param.pword[1])
+ {
+ case 10:tx=msg->param.pword[2];ty=msg->param.pword[3];break; // gotoxy
+ case 11:fcol=msg->param.pword[2];break; // forecolor
+ case 12:bcol=msg->param.pword[2];break; // bkcolor
+ case 13:prv_font=bold_font;break;
+ case 14:prv_font=italic_font;break;
+ case 15:prv_font=normal_font;break;
+ case 16:ClearAll();break;
+ case 303: // Draw array_of char (x,y,fcol,bcol)
+ f=fcol;b=bcol;
+ fcol=msg->param.pword[4];
+ bcol=msg->param.pword[5];
+ TextXY(msg->param.pword[2],msg->param.pword[3],
+ msg->param.pstr);
+ fcol=f;bcol=b;
+ break;
+ case 300: // Draw int (x,y,int,fcol,bcol)
+ f=fcol;b=bcol;
+ fcol=msg->param.pword[5];
+ bcol=msg->param.pword[6];
+ IntXY(msg->param.pword[2],msg->param.pword[3],
+ msg->param.pword[4]);
+ fcol=f;bcol=b;
+ break;
+ case 301: // Draw char (x,y,char,fcol,bcol)
+ f=fcol;b=bcol;
+ fcol=msg->param.pword[5];
+ bcol=msg->param.pword[6];
+ CharXY(msg->param.pword[2],msg->param.pword[3],
+ (char)(msg->param.pword[4]));
+ fcol=f;bcol=b;
+ break;
+ case 302: // Draw real (x,y,int,frac,fcol,bcol)
+ f=fcol;b=bcol;
+ fcol=msg->param.pword[6];
+ bcol=msg->param.pword[7];
+ sprintf(ss,"%d.%d",msg->param.pword[4],msg->param.pword[5]);
+ TextXY(msg->param.pword[2],msg->param.pword[3],ss);
+ fcol=f;bcol=b;
+ break;
+ case -304: // ReadText (x,y,fcol,bcol)
+ case -305:
+ case -307:
+ gfcol=msg->param.pword[4];
+ gbcol=msg->param.pword[5];
+ strcpy(internal_buffer,"");strcnt=0;
+ GraphRead=TRUE;
+ gx=msg->param.pword[2];
+ gy=msg->param.pword[3];
+ string_wait=TRUE;WriteChar('_');
+ break;
+ case -306:
+ if (!GetInput(0))
+ {
+ gfcol=msg->param.pword[4];
+ gbcol=msg->param.pword[5];
+ strcpy(internal_buffer,"");strcnt=0;
+ GraphRead=TRUE;
+ gx=msg->param.pword[2];
+ gy=msg->param.pword[3];
+ char_wait = TRUE;
+ }
+ break;
+ case 308: // Put image from file (x,y,fname)
+ if (p.load(msg->param.pstr))
+ {
+ bitBlt(canvas,msg->param.pword[2],msg->param.pword[3],&p,0,0,p.width(),p.height());
+ bitBlt(this,msg->param.pword[2]-ox, msg->param.pword[3]-oy,&p,0,0,p.width(),p.height());
+ }
+ break;
+ case 309:// Kill map
+ pmap = maps.first();
+ while (pmap!=NULL)
+ {
+ if (msg->param.pword[2] == pmap->number)
+ {
+ maps.remove(pmap);
+ break;
+ }
+ pmap=maps.next();
+ }
+ break;
+ case 310: // Line (x1,y1,x2,y2,col)
+ f=fcol;
+ fcol=msg->param.pword[6];
+ Line(msg->param.pword[2],msg->param.pword[3],
+ msg->param.pword[4],msg->param.pword[5]);
+ fcol=f;
+ break;
+ case 311: // Rectangle(x1,y1,x2,y2,fcol,icol)
+ Rect(msg->param.pword[2],msg->param.pword[3],
+ msg->param.pword[4],msg->param.pword[5],
+ msg->param.pword[7],1);
+ Rect(msg->param.pword[2],msg->param.pword[3],
+ msg->param.pword[4],msg->param.pword[5],
+ msg->param.pword[6],0);
+ break;
+ case 312: // ClearArea(x1,y1,w,h)
+ ClearArea(msg->param.pword[2],msg->param.pword[3],
+ msg->param.pword[4],msg->param.pword[5]);
+ break;
+ }//switch
+}
+
+
+
+
+#include "loggraph.moc"
+
+int main( int argc, char **argv )
+{
+ QApplication app( argc, argv );
+ VGR gs(argv[1]);
+ app.setMainWidget(&gs);
+ gs.show();
+ return app.exec();
+}
--- /dev/null
+
+INCDIR = $(QINC)
+CFLAGS = -O2 -fno-strength-reduce -Wall -W -I/usr/X11R6/include
+LIBCFLAGS = -fPIC
+YACCCFLAGS = -Wno-unused -Wno-parentheses
+LFLAGS = -L$(QLIB) -lqt
+CC = g++
+MOC = $(MOCDIR)/moc
+SHELL = /bin/sh
+
+
+####### Files
+
+SOURCES = loggraph.cpp
+OBJECTS = loggraph.o
+SRCMETA = loggraph.moc
+TARGET = loggraph
+
+####### Implicit rules
+
+.SUFFIXES: .cpp
+
+.cpp.o:
+ $(CC) -c $(CFLAGS) -I$(INCDIR) $<
+
+####### Build rules
+
+all: $(TARGET)
+
+$(TARGET): $(SRCMETA) $(OBJECTS)
+ $(CC) $(OBJECTS) -o $(TARGET) $(LFLAGS) -lm
+
+depend:
+ @makedepend -I$(INCDIR) $(SOURCES) 2> /dev/null
+
+showfiles:
+ @echo $(SOURCES) $(HEADERS) Makefile
+
+clean:
+ -rm -f *.o *.bak *~ *% #*
+ -rm -f $(SRCMETA) $(TARGET)
+
+####### Meta objects
+
+loggraph.moc: loggraph.cpp
+ $(MOC) loggraph.cpp -o loggraph.moc
+
+
--- /dev/null
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <sys/un.h>
+#include <errno.h>
--- /dev/null
+/* Communication structures */
+
+
+// REDHAT DEPENDENT !!!
+#include <netinet/tcp.h>
+
+typedef char string20[20];
+
+typedef struct {
+ int node;
+ int pix;
+ int mark;
+} paddr;
+
+struct ctrl_msg
+{
+ paddr sender; /* address of the sender and */
+ paddr receiver; /* receiver of the message */
+ int type; /* message type */
+ int par; /* prototype or error signal number */
+};
+
+
+
+typedef struct
+{
+ struct ctrl_msg control;
+ char params[ 256-sizeof(struct ctrl_msg) ];
+} messg;
+
+
+typedef struct
+{
+ int pword[15];
+ char pstr[255];
+ char pchar;
+} param_struct;
+
+
+
+typedef struct
+{
+ int node;
+ int program_id;
+} ctx_struct;
+
+/* Commm struct for GRAPH element */
+
+
+#define GRAPH_ALLOCATE 1
+#define GRAPH_EXIT 2
+#define GRAPH_FREE 3
+#define GRAPH_SET_TITLE 4
+#define GRAPH_WRITE 5
+#define GRAPH_WRITEXY 6
+#define GRAPH_READCHAR 7
+#define GRAPH_READSTR 8
+#define GRAPH_READLN 9
+#define GRAPH_PUTCHAR 10
+#define GRAPH_LINE 11
+#define GRAPH_ELLIPSE 12
+#define GRAPH_RECT 13
+#define GRAPH_FOREGROUND 14
+#define GRAPH_BACKGROUND 15
+#define GRAPH_POINT 16
+#define GRAPH_CLEAR 17
+#define GRAPH_HASCII 18
+#define GRAPH_INKEY 19
+#define GRAPH_ALLOCATED 20
+#define GRAPH_INKEY_RESPONSE 21
+#define GRAPH_READCHAR_RESPONSE 22
+#define GRAPH_READSTR_RESPONSE 23
+#define GRAPH_READLN_RESPONSE 24
+#define GRAPH_MOVE 25
+#define GRAPH_CURPOS 26
+#define GRAPH_CURPOS_RESPONSE 27
+#define GRAPH_LINETO 28
+
+#define GRAPH_OPERATION_OK 29
+#define GRAPH_OUTSTRING 30
+#define GRAPH_WRITEINTXY 31
+#define GRAPH_PUTMAP 32
+#define GRAPH_GETMAP 33
+#define GRAPH_GETMAP_RESPONSE 34
+
+#define GRAPH_MGETPRESS 35
+#define GRAPH_MGETPRESS_RESPONSE 36
+
+#define GRAPH_MAGIC 37
+#define GRAPH_MAGIC_RESPONSE 38
+
+/* INT element */
+
+
+
+#define INT_CONNECTED 1
+#define INT_EXITING 2
+#define INT_CTX 3
+#define INT_CTX_REQ 4
+#define INT_REMOTE_INST 5
+#define INT_INST_OK 6
+#define INT_READY 7
+#define INT_CLOSE_INSTANCE 8
+#define INT_KILL 9
+#define INT_START_OK 10
+
+
+
+/* NET element */
+
+#define NET_PROPAGATE 0
+#define NET_PROPAGATE_OUT 1
+/* msg_type = MSG_NET, param.pword[0] = NET_PROPAGATE
+ param.pword[1] = MSG_INT or MSG_VLP
+ param.pword[2,3] = sender context or node,0
+ param.pword[4,5] = receiver context or node,0
+ param.pword[6] = VLP command
+
+ */
+
+#define NET_PROPAGATE_IN 2
+
+#define NET_UNREGISTER 3
+#define NET_REGISTER_NODE 4
+#define NET_REGISTER_OK 5
+
+#define NET_NODE 6
+
+#define NET_CCD_START 7
+#define NET_PCD_START 8
+#define NET_CODESTREAM_OK 9
+
+#define NET_TRANSMIT_CODE 10
+
+
+#define NET_CONNECT 11
+#define NET_ACCEPT 12
+
+#define NET_EXIT 13
+#define NET_CCD_CODE 14
+#define NET_PCD_CODE 15
+
+
+#define NET_CSWRITELN 16
+#define NET_DISCONNECT 17
+#define NET_NODE_EXIST 18
+#define NET_TRANSMITTED 19
+#define NET_CONNECTIONS 20
+#define NET_CONNINFO 21
+#define NET_CONNECT_TO 22
+#define NET_GET_INFO 23
+#define NET_INFO 24
+#define NET_INFO_END 25
+#define NET_NODES_NUM 26
+#define NET_NODES_NUM_RESPONSE 27
+
+
+/* VLP message */
+
+#define VLP_WRITE 0
+#define VLP_REMOTE_INSTANCE 1
+#define VLP_REMOTE_INSTANCE_OK 2
+#define VLP_REGINT 3
+#define VLP_REMOTE_INSTANCE_PLEASE 4
+#define VLP_REMOTE_INSTANCE_HERE 5
+#define VLP_CLOSE_INSTANCE 6
+#define VLP_INTERPRETER_DOWN 7
+/* ------------------------------------------------------------ */
+/* Message structure */
+/*------------------------------------------------------------*/
+
+
+#define MSG_VLP 0
+#define MSG_NET 1
+#define MSG_GRAPH 2
+#define MSG_INT 3
+
+typedef struct
+{
+ short msg_type;
+ param_struct param;
+ messg int_msg;
+} MESSAGE;
+
+
+typedef struct
+{
+ short msg_type;
+ param_struct param;
+
+} G_MESSAGE;
+
+
+
+
+#define TCP_BUFFER_SIZE 30*sizeof(MESSAGE);
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
--- /dev/null
+/* Loglan82 Compiler&Interpreter
+ Copyright (C) 1993 Institute of Informatics, University of Warsaw
+ Copyright (C) 1993, 1994 LITA, Pau
+
+ 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; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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.
+
+ contacts: Andrzej.Salwicki@univ-pau.fr
+
+or Andrzej Salwicki
+ LITA Departement d'Informatique
+ Universite de Pau
+ Avenue de l'Universite
+ 64000 Pau FRANCE
+ tel. ++33 59923154 fax. ++33 59841696
+
+=======================================================================
+*/
+
+#if GEN
+#define word address
+#endif
+
+
+/* Appetites of values : */
+#define APINT 1 /* integer,boolean,string,char */
+#define APREAL sizeof(real)/sizeof(word) /* real */
+#define APVIRT 4 /* TO TELL APART A VIRTUAL ADDRESS */
+ /* (ANY REFERENCE TYPE) FROM ANY OTHER TYPE */
+#define APREF 2 /* ACTUAL SIZE OF REFERENCE TYPE */
+#define APFMTYPE 2 /* FORMAL TYPE VALUE */
+#define APFMPROC 3 /* FORMAL PROCEURE OR FUNCTION VALUE, = APREF+1*/
+#define APOPCODE (sizeof(extopcode)+sizeof(word)-1)/sizeof(word)
+
+
+
+
+/* Values identifying types and formal parameters : */
+
+#define FORMFUNC 7 /* parameter "function" */
+#define FORMPROC 8 /* parameter "procedure" */
+#define FORMTYPE 9 /* parameter "type", also formal type */
+#define PARIN 11 /* parameter "input" */
+#define PAROUT 12 /* parameter "output" */
+#define PARINOUT 16 /* parameter "inout" */
+#define PUREPROCESS 13 /* type PROCESS */
+#define PURECOROUTINE 14 /* type COROUTINE */
+#define PRIMITIVETYPE 15 /* simple type */
+#define CLASSTYPE 17 /* class type */
+#define FILETYPE 18 /* file type */
+
+
+/* Values to identify kinds of array elements : */
+
+#define AINT -1 /* arrayof integer */
+#define AREAL -3 /* arrayof real */
+#define AVIRT -2 /* arrayof reference */
+#define APROCESS -4 /* process reference implemented as arrayof */
+#define FILEOBJECT -11 /* file object */
+#define SKILLED -99 /* killed object, only for compactification */
+
+
+#define DUMMY -1 /* dummy unit or prefix : SL for main block */
+#define MAINBLOCK 0 /* main block prototype number */
+#define MAXPROT 500 /* limit for the number of prototypes */
+
+
+/* L-code instruction addressing modes : */
+
+#define GLOBAL 0 /* M[ N ] */
+#define LOCAL 1 /* M[ c1+N ] */
+#define TEMPLOCAL 2 /* M[ c2+N ] */
+#define REMOTE 3 /* M[ M[ K ]+N ] */
+#define INDIRECT 4 /* M[ M[ N ] ] */
+#define IMMEDIATE 5 /* N */
+#define CONSTANT 6 /* M[ N ] */
+#define DOTACCESS 7 /* M[ M[ display+K ]+N ] */
+#define NOARGUMENT 8 /* ------ */
+
+
+/* Prototype kind : */
+
+#define CLASS 0
+#define RECORD 1
+#define COROUTINE 2
+#define PROCESS 3
+#define BLOCK 4
+#define PREFBLOCK 5
+#define FUNCTION 6
+#define PROCEDURE 7
+#define HANDLER 8
+
+#if GEN
+#define LRECORD RECORD
+#define LFUNCTION FUNCTION
+#define LPROCEDURE PROCEDURE
+#endif
+
+
+#if GEN
+typedef int protaddr ; /* mainblock..maxprot ; mainblock = 0; */
+ /* INDIRECT ADDRESS OF PROTOTYPE */
+typedef int dprotaddr ; /* PROTADDR + DUMMY */
+typedef int protkind ;
+
+
+
+#else
+#define protaddr int
+#define dprotaddr int
+#define protkind int
+#endif
+
+
+
+#define TRUE 1
+#define FALSE 0
+
+
+typedef int word;
+
+
+/* Prototype : */
+
+typedef struct {
+ dprotaddr slprototype ; /* PROTOTYPE OF SYNTACTIC FATHER */
+ /* OR DUMMY FOR THE MAIN BLOCK */
+ word codeaddr; /* address of code */
+ word appetite; /* object's total length */
+ word span; /* distance from beginning of object to */
+ /* temporary reference variables */
+ word reflist; /* beginning and length of table with */
+
+ int lthreflist; /* offsets of reference values in object; */
+ /* without SL, DL, CL and temporary values */
+ word parlist; /* beginning and length of table with */
+ int lthparlist; /* offsets of parameters */
+
+ word preflist; /* beginning and length of table with */
+ int lthpreflist; /* prototype numbers of prefix sequence */
+
+ word lastwill; /* lastwill code address */
+ word handlerlist; /* list of handlers, 0 if empty */
+ word virtlist; /* address of table for conversion: */
+ /* virtual number --> prototype */
+
+ /* only for processes : */
+ protaddr maskbase ; /* lowest procedure prototype number */
+ int masksize ; /* size of RPC mask for that process */
+
+ /* for procedures and functions */
+ int virtnumber; /* virtual number or -1 if not virtual */
+
+ /* for all : */
+ protkind kind ; /* kind of unit */
+
+ /* only for procedures, functions and processes : */
+ word pfdescr; /* address of table with parameters descr. addresses */
+
+ /* only for functions : */
+ int nrarray;
+ word finaltype; /* type of result */
+
+} protdescr,*pointprdsc;
+
+
--- /dev/null
+### Includes for QT library
+QINC=/usr/lib/qt-1.45/include
+
+### QT library directory
+QLIB=/usr/lib/qt-1.45/lib
+
+### moc compiler directory
+MOCDIR=/usr/lib/qt-1.45/bin
+
+### Install directory
+INSTALLDIR=/usr/local/vlp
+
+INCDIR = $(QINC)
+CFLAGS = -O2 -fno-strength-reduce -Wall -W -I/usr/X11R6/include
+LIBCFLAGS = -fPIC
+YACCCFLAGS = -Wno-unused -Wno-parentheses
+LFLAGS = -L$(QLIB) -lqt
+CC = g++
+MOC = $(MOCDIR)/moc
+SHELL = /bin/sh
+
+####### Files
+
+SOURCES = help.cpp
+OBJECTS = help.o
+SRCMETA = help.moc
+TARGET = loghelp
+
+####### Implicit rules
+
+.SUFFIXES: .cpp
+
+.cpp.o:
+ $(CC) -c $(CFLAGS) -I$(INCDIR) $<
+
+####### Build rules
+
+all: $(TARGET)
+
+$(TARGET): $(SRCMETA) $(OBJECTS)
+ $(CC) $(OBJECTS) -o $(TARGET) $(LFLAGS) -lm
+
+depend:
+ @makedepend -I$(INCDIR) $(SOURCES) 2> /dev/null
+
+showfiles:
+ @echo $(SOURCES) $(HEADERS) Makefile
+
+clean:
+ -rm -f *.o *.bak *~ *% #*
+ -rm -f $(SRCMETA) $(TARGET)
+
+####### Meta objects
+
+help.moc: help.cpp
+ $(MOC) help.cpp -o help.moc
+
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
--- /dev/null
+
+
+#include <qapp.h>
+#include <qframe.h>
+#include <qmlined.h>
+#include <qmenubar.h>
+#include <qpopmenu.h>
+#include <qdialog.h>
+#include <qbttngrp.h>
+#include <qlabel.h>
+#include <qlined.h>
+#include <qlistbox.h>
+#include <qpushbt.h>
+#include <qradiobt.h>
+#include <qlist.h>
+#include <qfile.h>
+#include <qcombo.h>
+#include <qtooltip.h>
+#include <qfont.h>
+#include <qpixmap.h>
+#include <qmsgbox.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <qfile.h>
+#include <qtstream.h>
+#include <qstring.h>
+#include <qfiledlg.h>
+#include <qfontmet.h>
+#include <qpainter.h>
+#include <qscrbar.h>
+
+
+#define TAG_TEXT 0
+#define TAG_OTHER 1
+
+#define TAG_LINK 2
+#define TAG_ANCHOR 3
+#define TAG_BOLD_ON 4
+#define TAG_BOLD_OFF 5
+#define TAG_ITALIC_ON 6
+#define TAG_ITALIC_OFF 7
+#define TAG_BREAK 8
+#define TAG_LINE 9
+#define TAG_LINK_END 10
+#define TAG_LIST_ON 11
+#define TAG_LIST_OFF 12
+#define TAG_LIST_ITEM 13
+
+#define PIX_HEIGHT 2000
+
+char names[14][40] = {"text","other","link","anchor","bold on",
+ "bold off","italic on","italic off","break",
+ "line","end link","list on","list off","list item"};
+
+
+
+class Tag
+{
+public:
+ Tag() {tag_type=0; strcpy(tag_label,""); strcpy(tag_link,"");
+ strcpy(tag_text,"");};
+ int tag_type;
+ char tag_label[255],tag_link[255],tag_text[255];
+ int x,y,w,h;
+};
+
+class HTMLAnalyzer
+{
+public:
+ QList<Tag> tags;
+ bool verbatim;
+
+ HTMLAnalyzer();
+
+
+ bool LoadFile(char*);
+ void AnalyzeTag(QString*);
+ void PackLinks();
+ void DumpList();
+ Tag *CheckTag(int,int);
+ Tag *FindAnchor(char*);
+
+
+};
+
+HTMLAnalyzer::HTMLAnalyzer()
+{
+ tags.clear();
+ verbatim=FALSE;
+}
+
+
+bool HTMLAnalyzer::LoadFile(char *fname)
+{
+
+ QFile f(fname);
+ QString poms,poms1;
+ int i;
+ Tag *pomt;
+ bool not_ended;
+
+ tags.clear();
+ if (!f.open(IO_ReadOnly)) return(FALSE);
+
+ QTextStream fs(&f);
+
+ while (!fs.eof())
+ {
+ poms = fs.readLine();
+ while (poms.length()>0)
+ {
+ i = poms.find('<');
+ if (i!=-1)
+ {
+ if (i>1)
+ {
+ poms1 = poms.left(i);
+ pomt = new Tag;
+ pomt->tag_type = TAG_TEXT;
+ if (!verbatim) poms1=poms1.simplifyWhiteSpace();
+ sprintf(pomt->tag_text," %s",poms1.data());
+ tags.append(pomt);
+ }
+ poms = poms.right(poms.length()-i);
+
+ i=poms.find('>');
+ if (i!=-1)
+ {
+ poms1 = poms.mid(1,i-1);
+ AnalyzeTag(&poms1);
+ poms=poms.right(poms.length()-i-1);
+ }
+ else { not_ended=TRUE;break;}
+ }
+ else
+ {
+ pomt = new Tag;
+ pomt->tag_type = TAG_TEXT;
+ if (!verbatim) poms=poms.simplifyWhiteSpace();
+ sprintf(pomt->tag_text," %s",poms.data());
+ tags.append(pomt);
+ break;
+ }
+ }// while length>0
+ if (verbatim) {pomt = new Tag; pomt->tag_type=TAG_BREAK; tags.append(pomt);}
+ } //eof
+
+ f.close();
+
+ return(TRUE);
+}
+
+void HTMLAnalyzer::AnalyzeTag(QString *t)
+{
+ Tag *pom;
+ int i;
+ QString poms,poms1;
+
+ *t = t->simplifyWhiteSpace();
+ pom = new Tag;
+
+ if ( (t->data()[0]!='A') && (t->data()[0]!='a') )
+ {
+ *t = t->upper();
+ if (strcmp(t->data(),"B")==0 ) {pom->tag_type = TAG_BOLD_ON;}
+ else
+ if (strcmp(t->data(),"/B")==0 ) {pom->tag_type = TAG_BOLD_OFF;}
+ else
+ if (strcmp(t->data(),"I")==0 ) {pom->tag_type = TAG_ITALIC_ON;}
+ else
+ if (strcmp(t->data(),"/I")==0 ) {pom->tag_type = TAG_ITALIC_OFF;}
+ else
+ if (strcmp(t->data(),"BR")==0 ) {pom->tag_type = TAG_BREAK;}
+ else
+ if (strcmp(t->data(),"HR")==0 ) {pom->tag_type = TAG_LINE;}
+ else
+ if (strcmp(t->data(),"/A")==0 ) {pom->tag_type = TAG_LINK_END;}
+ else
+ if (strcmp(t->data(),"UL")==0 ) {pom->tag_type = TAG_LIST_ON;}
+ else
+ if (strcmp(t->data(),"/UL")==0 ) {pom->tag_type = TAG_LIST_OFF;}
+ else
+ if (strcmp(t->data(),"LI")==0 ) {pom->tag_type = TAG_LIST_ITEM;}
+ else
+ if (strcmp(t->data(),"PRE")==0 ) {verbatim=TRUE;}
+ else
+ if (strcmp(t->data(),"/PRE")==0 ) {verbatim=FALSE;}
+ }
+
+ else // 'a' or 'A'
+
+ {
+ // links
+ i = t->find('=');
+ if (i!=-1)
+ {
+ poms=t->mid(2,i-2);
+ poms=poms.simplifyWhiteSpace();
+ poms=poms.upper();
+ poms1=t->right(t->length()-i-1);
+ poms1=poms1.simplifyWhiteSpace();
+
+ if (strcmp(poms.data(),"HREF")==0)
+ {
+ pom->tag_type = TAG_LINK;
+ strcpy(pom->tag_link,poms1.data());
+ }
+ else
+ if (strcmp(poms.data(),"NAME")==0)
+ {
+ pom->tag_type = TAG_ANCHOR;
+ if (poms1.data()[0]=='"') poms1=poms1.right(poms1.length()-1);
+ if (poms1.data()[poms1.length()-1]=='"') poms1=poms1.left(poms1.length()-1);
+ strcpy(pom->tag_label,poms1.data());
+ }
+ }
+ }
+ tags.append(pom);
+}
+
+void HTMLAnalyzer::DumpList()
+{
+ Tag *pom;
+ pom=tags.first();
+ while (pom!=NULL)
+ {
+ fprintf(stderr,"%s:%s,%s,%s\n",names[pom->tag_type], pom->tag_text,
+ pom->tag_link,pom->tag_label);
+ pom=tags.next();
+ }
+
+}
+
+void HTMLAnalyzer::PackLinks()
+{
+ Tag *pom,*pom1;
+ char s[255];
+
+ pom = tags.first();
+ while (pom!=NULL)
+ {
+ if ( (pom->tag_type==TAG_LINK ) || (pom->tag_type==TAG_ANCHOR) )
+ {
+ pom1=tags.next();
+ strcpy(s,"");
+ while ( (pom1!=NULL) && (pom1->tag_type!=TAG_LINK_END) )
+ {
+ if (pom1->tag_type==TAG_TEXT) strcat(s,pom1->tag_text);
+ tags.remove(pom1);
+ pom1=tags.current();
+ }
+ strcpy(pom->tag_text,s);
+ tags.remove(pom1);
+ pom=tags.current();
+ }
+ else
+ pom=tags.next();
+ }
+}
+
+
+Tag *HTMLAnalyzer::CheckTag(int x,int y)
+{
+ Tag *pom;
+ pom=tags.first();
+ while(pom!=NULL)
+ {
+ if ( pom->tag_type==TAG_LINK)
+ if ( (x>=pom->x) && (x<=pom->x+pom->w) &&
+ (y>=pom->y) && (y<=pom->y+pom->h)) return(pom);
+ pom=tags.next();
+ }
+ return(NULL);
+}
+
+Tag *HTMLAnalyzer::FindAnchor(char *name)
+{
+ Tag *pom;
+ pom=tags.first();
+ while(pom!=NULL)
+ {
+ if ( (pom->tag_type==TAG_ANCHOR) && (strcmp(pom->tag_label,name)==0) )
+ return(pom);
+ pom=tags.next();
+ }
+ return(pom);
+}
+//******************************
+
+
+
+class QHTML: public QFrame
+{
+ Q_OBJECT
+public:
+ QScrollBar *vscroll;
+ QMenuBar *bar;
+ HTMLAnalyzer *analyzer;
+ QPixmap *map;
+ int cx,cy,oy,lstep,pstep;
+ bool Bold,Italic;
+ QFont *normal,*bold,*italic,*bold_italic,*actual_font;
+ char homedir[255];
+
+ QHTML(char*);
+ void DrawList();
+ virtual void paintEvent(QPaintEvent *ev);
+ virtual void resizeEvent(QResizeEvent *ev);
+ virtual void mousePressEvent(QMouseEvent *ev);
+public slots:
+ void load();
+ void back();
+ void vscrolled(int);
+ void contents();
+ void user_guide();
+ void lang_guide();
+
+};
+
+
+QApplication *app;
+
+QHTML::QHTML(char *d)
+{
+
+ QPopupMenu *pp;
+ char s[255];
+
+ QFont f("Helvetica",12,QFont::Bold);
+ normal = new QFont("Helvetica",12,QFont::Normal);
+ bold = new QFont("Helvetica",12,QFont::Bold);
+ italic = new QFont("Helvetica",12,QFont::Normal,TRUE);
+ bold_italic = new QFont("Helvetica",12,QFont::Bold,TRUE);
+ strcpy(homedir,d);
+
+ actual_font = normal;
+ bar = new QMenuBar(this);
+ pp = new QPopupMenu;
+ pp->insertItem("Index",this,SLOT(contents()));
+ pp->insertItem("User Guide",this,SLOT(user_guide()));
+ pp->insertItem("Language reference",this,SLOT(lang_guide()));
+ pp->setFont(f);
+ pp->setStyle(WindowsStyle);
+ bar->insertItem("File",this,SLOT(load()));
+ bar->insertItem("Contents",pp);
+ bar->insertItem("Quit",app,SLOT(quit()));
+ bar->setFont(f);
+ setCaption("LOGLAN Help");
+ setBackgroundColor(gray);
+ analyzer = new HTMLAnalyzer;
+ map = new QPixmap(500,PIX_HEIGHT);
+ map->fill(backgroundColor());
+ resize(500,height());
+ setFixedSize(width(),height());
+ oy=0;lstep=10;pstep=height()-bar->height();
+ vscroll = new QScrollBar(0,PIX_HEIGHT,lstep,pstep,0,QScrollBar::Vertical,
+ this);
+ vscroll->setTracking(TRUE);
+ vscroll->setGeometry(width()-16,bar->height(),16,height()-bar->height());
+ connect(vscroll,SIGNAL(valueChanged(int)),this,SLOT(vscrolled(int)));
+ sprintf(s,"%s/index.html",homedir);
+ analyzer->LoadFile(s);
+ analyzer->PackLinks();
+ DrawList();
+
+}
+
+
+void QHTML::vscrolled(int v)
+{
+ oy=v;
+ repaint();
+}
+
+void QHTML::load()
+{
+ QString s(QFileDialog::getOpenFileName(homedir,"*",this));
+ if ( !s.isNull())
+ {
+ vscroll->setValue(0);
+ analyzer->LoadFile(s.data());
+ analyzer->PackLinks();
+ DrawList();
+ }
+}
+
+
+void QHTML::contents()
+{
+ char ss[255];
+ sprintf(ss,"%s/index.html",homedir);
+ analyzer->LoadFile(ss);
+ analyzer->PackLinks();
+ DrawList();
+}
+
+
+void QHTML::user_guide()
+{
+ char ss[255];
+ sprintf(ss,"%s/userg.html",homedir);
+ analyzer->LoadFile(ss);
+ analyzer->PackLinks();
+ DrawList();
+}
+
+void QHTML::lang_guide()
+{
+ char ss[255];
+ sprintf(ss,"%s/langg.html",homedir);
+ analyzer->LoadFile(ss);
+ analyzer->PackLinks();
+ DrawList();
+}
+
+void QHTML::paintEvent(QPaintEvent *ev)
+{
+ if (map!=NULL) bitBlt(this,0,bar->height(),map,0,oy,width()-16,height()-16);
+}
+
+void QHTML::resizeEvent(QResizeEvent *ev)
+{
+ DrawList();
+}
+
+void QHTML::mousePressEvent(QMouseEvent *ev)
+{
+ Tag *pom,*pom1;
+ QString poms;
+ char ss[255];
+
+ pom=analyzer->CheckTag(ev->x(),ev->y()+oy);
+ if (pom!=NULL)
+ {
+ poms.sprintf(pom->tag_link);
+ if (poms.data()[0]=='"') poms=poms.right(poms.length()-1);
+ if (poms.data()[poms.length()-1]=='"') poms=poms.left(poms.length()-1);
+ if (poms.data()[0]=='#')
+ {
+ poms=poms.right(poms.length()-1);
+ pom1=analyzer->FindAnchor(poms.data());
+ if (pom1!=NULL)
+ {
+ vscroll->setValue(pom1->y);
+ }
+ }
+ else
+ {
+ sprintf(ss,"%s/%s",homedir,poms.data());
+ analyzer->LoadFile(ss);
+ analyzer->PackLinks();
+ DrawList();
+ }
+ }
+}
+
+void QHTML::back()
+{
+}
+
+void QHTML::DrawList()
+{
+ Tag *pom;
+ QPainter p;
+
+if (!analyzer->tags.isEmpty())
+{
+ cx=5;cy=15;
+ map->fill(backgroundColor());
+ p.begin(map);
+
+ pom=analyzer->tags.first();
+ while (pom!=NULL)
+ {
+ switch(pom->tag_type)
+ {
+ case TAG_TEXT:p.setFont(*actual_font);
+ if (cx+p.fontMetrics().width(pom->tag_text)>width()-16)
+ {cx=5;cy=cy+p.fontMetrics().height();}
+ p.drawText(cx,cy,pom->tag_text);
+ cx=cx+p.fontMetrics().width(pom->tag_text);
+ break;
+ case TAG_BREAK: p.setFont(*actual_font);
+ cy=cy+p.fontMetrics().height();cx=5;
+ break;
+ case TAG_ITALIC_ON:
+ if (actual_font==bold) actual_font=bold_italic;
+ else actual_font=italic;
+ break;
+ case TAG_ITALIC_OFF:
+ if (actual_font==bold_italic) actual_font=bold;
+ else actual_font=normal;
+ break;
+ case TAG_BOLD_ON:
+ if (actual_font==italic) actual_font=bold_italic;
+ else actual_font=bold;
+ break;
+ case TAG_BOLD_OFF:
+ if (actual_font==bold_italic) actual_font=italic;
+ else actual_font=normal;
+ break;
+ case TAG_LINK:p.setFont(*actual_font);
+ if (cx+p.fontMetrics().width(pom->tag_text)>width()-16)
+ {cx=5;cy=cy+p.fontMetrics().height();}
+ p.setPen(QColor(255,0,0));
+ p.drawText(cx,cy,pom->tag_text);
+ pom->x = cx;pom->y=cy+p.fontMetrics().height();
+ pom->w = p.fontMetrics().width(pom->tag_text);
+ pom->h = p.fontMetrics().height();
+ p.setPen(QColor(0,0,0));
+ cx=cx+p.fontMetrics().width(pom->tag_text);
+ break;
+ case TAG_ANCHOR: p.setFont(*actual_font);
+ if (cx+p.fontMetrics().width(pom->tag_text)>width()-16)
+ {cx=5;cy=cy+p.fontMetrics().height();}
+ //p.setPen(QColor(0,255,0));
+ p.drawText(cx,cy,pom->tag_text);
+ pom->x = cx;pom->y=cy-p.fontMetrics().height();
+ pom->w = p.fontMetrics().width(pom->tag_text);
+ pom->h = p.fontMetrics().height();
+ p.setPen(QColor(0,0,0));
+ cx=cx+p.fontMetrics().width(pom->tag_text);
+ break;
+ case TAG_LIST_OFF:
+ case TAG_LIST_ON:p.setFont(*actual_font);
+ cx=5;cy=cy+p.fontMetrics().height();
+ break;
+ case TAG_LIST_ITEM:p.setFont(*actual_font);
+ p.setBrush(QBrush(QColor(0,0,255)));
+ cx=5;cy=cy+p.fontMetrics().height();
+ p.drawPie(cx,cy-5,5,5,0,5760);
+ cx=cx+15;
+ break;
+ case TAG_LINE:p.setFont(*actual_font);
+ cx=5;cy=cy+p.fontMetrics().height();
+ p.drawLine(cx,cy-(int)(p.fontMetrics().height()/2),
+ width()-16-5,cy-(int)(p.fontMetrics().height()/2));
+ cx=5;cy=cy+p.fontMetrics().height();
+ break;
+
+
+ }//switch
+ pom = analyzer->tags.next();
+ }
+ p.end();
+ repaint();
+}
+}
+
+
+
+#include "help.moc"
+
+int main( int argc, char **argv )
+{
+ QString ps;
+
+ app = new QApplication(argc,argv);
+ if (argc==2) ps.sprintf(argv[1]);
+ else ps.sprintf(".");
+ QHTML cfg(ps.data());
+ app->setStyle(WindowsStyle);
+ app->setMainWidget(&cfg);
+ cfg.show();
+ return app->exec();
+}
--- /dev/null
+
+INCDIR = $(QINC)
+CFLAGS = -O2 -fno-strength-reduce -Wall -W -I/usr/X11R6/include
+LIBCFLAGS = -fPIC
+YACCCFLAGS = -Wno-unused -Wno-parentheses
+LFLAGS = -L$(QLIB) -lqt
+CC = g++
+MOC = $(MOCDIR)/moc
+SHELL = /bin/sh
+
+####### Files
+
+SOURCES = help.cpp
+OBJECTS = help.o
+SRCMETA = help.moc
+TARGET = loghelp
+
+####### Implicit rules
+
+.SUFFIXES: .cpp
+
+.cpp.o:
+ $(CC) -c $(CFLAGS) -I$(INCDIR) $<
+
+####### Build rules
+
+all: $(TARGET)
+
+$(TARGET): $(SRCMETA) $(OBJECTS)
+ $(CC) $(OBJECTS) -o $(TARGET) $(LFLAGS) -lm
+
+depend:
+ @makedepend -I$(INCDIR) $(SOURCES) 2> /dev/null
+
+showfiles:
+ @echo $(SOURCES) $(HEADERS) Makefile
+
+clean:
+ -rm -f *.o *.bak *~ *% #*
+ -rm -f $(SRCMETA) $(TARGET)
+
+####### Meta objects
+
+help.moc: help.cpp
+ $(MOC) help.cpp -o help.moc
+
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
--- /dev/null
+To make your VLP run, you should copy QT library files, to your
+/usr/lib (or to any place your programs are looking for shared libraries)
+
+QT files are located at "lib" directory of this package, it should contain:
+
+libqt.so.1.30 - main library file
+libqt.so.1 - symlink to libqt.so.1.30
+libqt.so - symlink to libqt.so.1.30
+
+All binaries were compiled under Linux 2.0.0
--- /dev/null
+GNU General Public License
+
+------------------------------------------------------------------------
+
+Table of Contents
+
+ * GNU GENERAL PUBLIC LICENSE
+ o Preamble
+ o TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+ o How to Apply These Terms to Your New Programs
+
+------------------------------------------------------------------------
+
+GNU GENERAL PUBLIC LICENSE
+
+Version 2, June 1991
+
+Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+
+Everyone is permitted to copy and distribute verbatim copies
+of this license document, but changing it is not allowed.
+
+Preamble
+
+The licenses for most software are designed to take away your freedom to
+share and change it. By contrast, the GNU General Public License is intended
+to guarantee your freedom to share and change free software--to make sure
+the software is free for all its users. This General Public License applies
+to most of the Free Software Foundation's software and to any other program
+whose authors commit to using it. (Some other Free Software Foundation
+software is covered by the GNU Library General Public License instead.) You
+can apply it to your programs, too.
+
+When we speak of free software, we are referring to freedom, not price. Our
+General Public Licenses are designed to make sure that you have the freedom
+to distribute copies of free software (and charge for this service if you
+wish), that you receive source code or can get it if you want it, that you
+can change the software or use pieces of it in new free programs; and that
+you know you can do these things.
+
+To protect your rights, we need to make restrictions that forbid anyone to
+deny you these rights or to ask you to surrender the rights. These
+restrictions translate to certain responsibilities for you if you distribute
+copies of the software, or if you modify it.
+
+For example, if you distribute copies of such a program, whether gratis or
+for a fee, you must give the recipients all the rights that you have. You
+must make sure that they, too, receive or can get the source code. And you
+must show them these terms so they know their rights.
+
+We protect your rights with two steps: (1) copyright the software, and (2)
+offer you this license which gives you legal permission to copy, distribute
+and/or modify the software.
+
+Also, for each author's protection and ours, we want to make certain that
+everyone understands that there is no warranty for this free software. If
+the software is modified by someone else and passed on, we want its
+recipients to know that what they have is not the original, so that any
+problems introduced by others will not reflect on the original authors'
+reputations.
+
+Finally, any free program is threatened constantly by software patents. We
+wish to avoid the danger that redistributors of a free program will
+individually obtain patent licenses, in effect making the program
+proprietary. To prevent this, we have made it clear that any patent must be
+licensed for everyone's free use or not licensed at all.
+
+The precise terms and conditions for copying, distribution and modification
+follow.
+
+TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+0. This License applies to any program or other work which contains a notice
+placed by the copyright holder saying it may be distributed under the terms
+of this General Public License. The "Program", below, refers to any such
+program or work, and a "work based on the Program" means either the Program
+or any derivative work under copyright law: that is to say, a work
+containing the Program or a portion of it, either verbatim or with
+modifications and/or translated into another language. (Hereinafter,
+translation is included without limitation in the term "modification".) Each
+licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not covered
+by this License; they are outside its scope. The act of running the Program
+is not restricted, and the output from the Program is covered only if its
+contents constitute a work based on the Program (independent of having been
+made by running the Program). Whether that is true depends on what the
+Program does.
+
+1. You may copy and distribute verbatim copies of the Program's source code
+as you receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice and
+disclaimer of warranty; keep intact all the notices that refer to this
+License and to the absence of any warranty; and give any other recipients of
+the Program a copy of this License along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and you
+may at your option offer warranty protection in exchange for a fee.
+
+2. You may modify your copy or copies of the Program or any portion of it,
+thus forming a work based on the Program, and copy and distribute such
+modifications or work under the terms of Section 1 above, provided that you
+also meet all of these conditions:
+
+ * a) You must cause the modified files to carry prominent notices stating
+ that you changed the files and the date of any change.
+
+ * b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any part
+ thereof, to be licensed as a whole at no charge to all third parties
+ under the terms of this License.
+
+ * c) If the modified program normally reads commands interactively when
+ run, you must cause it, when started running for such interactive use
+ in the most ordinary way, to print or display an announcement including
+ an appropriate copyright notice and a notice that there is no warranty
+ (or else, saying that you provide a warranty) and that users may
+ redistribute the program under these conditions, and telling the user
+ how to view a copy of this License. (Exception: if the Program itself
+ is interactive but does not normally print such an announcement, your
+ work based on the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole. If identifiable
+sections of that work are not derived from the Program, and can be
+reasonably considered independent and separate works in themselves, then
+this License, and its terms, do not apply to those sections when you
+distribute them as separate works. But when you distribute the same sections
+as part of a whole which is a work based on the Program, the distribution of
+the whole must be on the terms of this License, whose permissions for other
+licensees extend to the entire whole, and thus to each and every part
+regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest your
+rights to work written entirely by you; rather, the intent is to exercise
+the right to control the distribution of derivative or collective works
+based on the Program.
+
+In addition, mere aggregation of another work not based on the Program with
+the Program (or with a work based on the Program) on a volume of a storage
+or distribution medium does not bring the other work under the scope of this
+License.
+
+3. You may copy and distribute the Program (or a work based on it, under
+Section 2) in object code or executable form under the terms of Sections 1
+and 2 above provided that you also do one of the following:
+
+ * a) Accompany it with the complete corresponding machine-readable source
+ code, which must be distributed under the terms of Sections 1 and 2
+ above on a medium customarily used for software interchange; or,
+
+ * b) Accompany it with a written offer, valid for at least three years,
+ to give any third party, for a charge no more than your cost of
+ physically performing source distribution, a complete machine-readable
+ copy of the corresponding source code, to be distributed under the
+ terms of Sections 1 and 2 above on a medium customarily used for
+ software interchange; or,
+
+ * c) Accompany it with the information you received as to the offer to
+ distribute corresponding source code. (This alternative is allowed only
+ for noncommercial distribution and only if you received the program in
+ object code or executable form with such an offer, in accord with
+ Subsection b above.)
+
+The source code for a work means the preferred form of the work for making
+modifications to it. For an executable work, complete source code means all
+the source code for all modules it contains, plus any associated interface
+definition files, plus the scripts used to control compilation and
+installation of the executable. However, as a special exception, the source
+code distributed need not include anything that is normally distributed (in
+either source or binary form) with the major components (compiler, kernel,
+and so on) of the operating system on which the executable runs, unless that
+component itself accompanies the executable.
+
+If distribution of executable or object code is made by offering access to
+copy from a designated place, then offering equivalent access to copy the
+source code from the same place counts as distribution of the source code,
+even though third parties are not compelled to copy the source along with
+the object code.
+
+4. You may not copy, modify, sublicense, or distribute the Program except as
+expressly provided under this License. Any attempt otherwise to copy,
+modify, sublicense or distribute the Program is void, and will automatically
+terminate your rights under this License. However, parties who have received
+copies, or rights, from you under this License will not have their licenses
+terminated so long as such parties remain in full compliance.
+
+5. You are not required to accept this License, since you have not signed
+it. However, nothing else grants you permission to modify or distribute the
+Program or its derivative works. These actions are prohibited by law if you
+do not accept this License. Therefore, by modifying or distributing the
+Program (or any work based on the Program), you indicate your acceptance of
+this License to do so, and all its terms and conditions for copying,
+distributing or modifying the Program or works based on it.
+
+6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the original
+licensor to copy, distribute or modify the Program subject to these terms
+and conditions. You may not impose any further restrictions on the
+recipients' exercise of the rights granted herein. You are not responsible
+for enforcing compliance by third parties to this License.
+
+7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot distribute so
+as to satisfy simultaneously your obligations under this License and any
+other pertinent obligations, then as a consequence you may not distribute
+the Program at all. For example, if a patent license would not permit
+royalty-free redistribution of the Program by all those who receive copies
+directly or indirectly through you, then the only way you could satisfy both
+it and this License would be to refrain entirely from distribution of the
+Program.
+
+If any portion of this section is held invalid or unenforceable under any
+particular circumstance, the balance of the section is intended to apply and
+the section as a whole is intended to apply in other circumstances.
+
+It is not the purpose of this section to induce you to infringe any patents
+or other property right claims or to contest validity of any such claims;
+this section has the sole purpose of protecting the integrity of the free
+software distribution system, which is implemented by public license
+practices. Many people have made generous contributions to the wide range of
+software distributed through that system in reliance on consistent
+application of that system; it is up to the author/donor to decide if he or
+she is willing to distribute software through any other system and a
+licensee cannot impose that choice.
+
+This section is intended to make thoroughly clear what is believed to be a
+consequence of the rest of this License.
+
+8. If the distribution and/or use of the Program is restricted in certain
+countries either by patents or by copyrighted interfaces, the original
+copyright holder who places the Program under this License may add an
+explicit geographical distribution limitation excluding those countries, so
+that distribution is permitted only in or among countries not thus excluded.
+In such case, this License incorporates the limitation as if written in the
+body of this License.
+
+9. The Free Software Foundation may publish revised and/or new versions of
+the General Public License from time to time. Such new versions will be
+similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation. If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+10. If you wish to incorporate parts of the Program into other free programs
+whose distribution conditions are different, write to the author to ask for
+permission. For software which is copyrighted by the Free Software
+Foundation, write to the Free Software Foundation; we sometimes make
+exceptions for this. Our decision will be guided by the two goals of
+preserving the free status of all derivatives of our free software and of
+promoting the sharing and reuse of software generally.
+
+NO WARRANTY
+
+11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR
+THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO
+THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM
+PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR
+CORRECTION.
+
+12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO
+LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR
+THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+END OF TERMS AND CONDITIONS
+
+How to Apply These Terms to Your New Programs
+
+If you develop a new program, and you want it to be of the greatest possible
+use to the public, the best way to achieve this is to make it free software
+which everyone can redistribute and change under these terms.
+
+To do so, attach the following notices to the program. It is safest to
+attach them to the start of each source file to most effectively convey the
+exclusion of warranty; and each file should have at least the "copyright"
+line and a pointer to where the full notice is found.
+
+one line to give the program's name and an idea of what it does.
+Copyright (C) 19yy name of author
+
+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; either version 2
+of the License, or (at your option) any later version.
+
+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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this when
+it starts in an interactive mode:
+
+Gnomovision version 69, Copyright (C) 19yy name of author
+Gnomovision comes with ABSOLUTELY NO WARRANTY; for details
+type `show w'. This is free software, and you are welcome
+to redistribute it under certain conditions; type `show c'
+for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, the commands you use may be
+called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+Yoyodyne, Inc., hereby disclaims all copyright
+interest in the program `Gnomovision'
+(which makes passes at compilers) written
+by James Hacker.
+
+signature of Ty Coon, 1 April 1989
+Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General Public
+License instead of this License.
+------------------------------------------------------------------------
--- /dev/null
+ TROLL TECH FREE SOFTWARE LICENSE
+
+Copyright (C) 1992-1997 Troll Tech AS. All rights reserved.
+
+This is the free software license for Qt version 1.30; it covers private
+use, use of third-party application programs based on Qt, and development
+of free software for the free software community.
+
+
+ COPYRIGHT AND RESTRICTIONS
+
+The Qt toolkit is a product of Troll Tech AS. This license is limited to
+use with the X Window System.
+
+You may copy this version of the Qt toolkit provided that the entire
+archive is distributed unchanged and as a whole, including this notice.
+
+You may use this version of the Qt toolkit to compile, link and use
+application programs and reusable components legally developed by
+third parties.
+
+You may use the Qt toolkit to create application programs provided that:
+ - You accept this license.
+ - Your software does not require modifications to Qt.
+ - You satisfy ONE of the following three requirements
+ EITHER
+ Users of your software can obtain source code for the software, freely
+ modify the source code (possibly with restrictions on copyright
+ notices, attributions and legal responsibility), and freely
+ redistribute original or modified versions of the software.
+ OR
+ Your software is distributed under the GNU GENERAL PUBLIC LICENSE,
+ version 2 or later, as defined by the Free Software Foundation.
+ OR
+ Your software is distributed under the GNU LIBRARY GENERAL PUBLIC
+ LICENSE, version 2 or later, as defined by the Free Software Foundation.
+
+If you are paid to develop something with Qt or it is a part of your job
+the following conditions also apply:
+ - Your software must not require libraries, programs, data or
+ documentation that are not available outside your organization in
+ order to compile or use.
+ - If and when your organization starts using the software, you must
+ notify Troll Tech AS of the following:
+ * Your organization's name and purpose.
+ * The software's name and purpose.
+ * The software's license.
+ * That your organization considers the software to be free software.
+
+You may also use the Qt toolkit to create reusable components (such as
+libraries) provided that you accept the terms above, and in addition that:
+ - Your components' documentation includes the following text:
+ [Your package] requires the Qt library, which is copyright
+ Troll Tech AS. Freely distributable programs may generally
+ use Qt for free, see [README.QT] for details.
+ - README.QT is distributed along with your components.
+ - Qt is not distributed as an integral part of your components.
+
+
+ LIMITATIONS OF LIABILITY
+
+Troll Tech AS makes no obligation under this license to support or upgrade
+Qt, or assist in the use of Qt.
+
+In no event shall Troll Tech AS be liable for any lost revenue or profits
+or other direct, indirect, special, incidental or consequential damages,
+even if Troll Tech has been advised of the possibility of such damages.
+
+QT IS PROVIDED AS IS WITH NO WARRANTY OF ANY KIND, INCLUDING THE WARRANTY
+OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html>
+<head>
+ <title>Installation of OLD qt-1.45 library</title>
+
+</head>
+<body>
+
+<h1><b>Installation of old library qt1.45</b></h1>
+ The new distributions of Linux (e.g. Mandrake 8.0, Slackware8.0, ...)
+do not contain the library qt1.4x. They come with new versions like qt2.x
+or qt3.x. <br>
+ It is relatively easy to install the library by yourself.
+<ul>
+ <li>
+ <p>Take the following files: </p>
+
+ <ul>
+ <li>compat-libstdc++ ....rpm </li>
+ <li>qt1x-1.45-16.i386.rpm</li>
+ <li>qt1x-1.45-devel-16.i386.rpm</li>
+
+ </ul>
+ or similar versions, they may differ as indicated by the number
+16, 17, ... </li>
+ <li>
+ <p>install them in this order : </p>
+
+ <ul>
+ <li>rpm -Uvh compat-libstdc++-6.2-2.9.0.16.i386.rpm </li>
+ <li>rpm -Uvh qt1x-1.45-16.i386.rpm </li>
+ <li>rpm -Uvh qt1x-devel-1.45-16.i386.rpm </li>
+
+ </ul>
+ Do not worry if a message of eventual conflicts appear. </li>
+ <li>
+ <p>The library qt1.45 is installed in the following directory /usr/lib/qt-1.45</p>
+ </li>
+
+</ul>
+Now you are ready to install VLP 2.6 - Virtual Loglan Processor version of
+1996.<br>
+<br>
+ <br>
+
+</body>
+</html>
--- /dev/null
+SHELL=/bin/bash
+#.SUFFIXES: .o .c
+
+#############################################################################
+# switches :
+# OBJECTADDR - switch on special process addressing - object simulates
+# process pointer
+# CDBG - turn on debugging of compactifier, compactifier appends to file
+# 'trace' state of memory before & after the compactification,
+# also a history of compactification & process number is dumped
+# RPCDBG - debugging of alien call, all actions : alien call, acknowledges,
+# passivations and returns are written to stderr
+# NO_GRAPH - nonstand.c defines only INKEY grom IIUWGRAPH
+# DLINK - DLINK network version
+# TCPIP - TCPIP network version - needs also OBJECTADDR
+#
+# switches depending on environment :
+# TURBOC - if using BORLAND TURBO-C compiler
+# MSDOS/OS2/UNIX - choose operating system
+# USE_CLOCK - scheduler should use clock() function to measure time
+# USE_ALARM - scheduler should use alarm() function to measure time
+# WORD_16BIT/DWORD_16BIT/WORD_32BIT - choose memory model :
+# small 16-bit / large 16-bit / small 32-bit
+#
+
+
+UNIXPARS=-DUNIX -DWORD_32BIT -DUSE_ALARM -Dpascal=
+UNIXPARSNG=$(UNIXPARS)
+
+#CC=cc $(UNIXPARSNG) -DNO_PROTOTYPES # SUN,HP
+#CC=rcc $(UNIXPARSNG) -O # SCO - AT&T C compiler
+#CC=cc -W1 $(UNIXPARSNG) # SCO
+#CC=cc -W1 $(UNIXPARSNG) -DOBJECTADDR # SCO
+#CC=cc -W1 $(UNIXPARSNG) -DOBJECTADDR -DTCPIP # SCO TCPIP
+CC=gcc $(UNIXPARSNG) -DOBJECTADDR -DSYSV # GNU C++ TCPIP
+#CC=cc -W1 $(UNIXPARS) -DSYSV -DXSIGHT # SCO with X11 graphics
+#CC=gcc -g $(UNIXPARS) -DSYSV -DXSIGHT # SCO GCC with X11 graphics
+
+CCc=$(CC) # common version
+#CCc=$(CC) -Fo$*.o # MSDOS MSC version
+
+target : int
+
+#############################################################################
+#ADDOPT = -lsocket # sun
+ADDOPT = # Linux
+
+
+OBJ= cint.o compact.o control.o util.o handler.o intdt.o \
+ memory.o object.o runsys.o standard.o \
+ execute.o fileio.o nonstand.o process.o procaddr.o queue.o \
+ rpcall.o typchk.o
+
+.c.o :
+ $(CCc) -c $*.c
+.s.o:
+ as -o $*.o $*.s
+
+
+int: $(OBJ)
+# $(CC) $(OBJ) inkeyux.o -lm -lX11 -lmalloc -lsocket -ggdb -o int
+ $(CC) $(OBJ) -lm $(ADDOPT) -o logint
+# strip logint
+# mv int $(HOME)/LOGLAN.PAU/bin
+
+nonstand.o : nonstand.c
+
+clean :
+ rm -f *.o *.bak logint
--- /dev/null
+
+
+#include "depend.h"
+#include "genint.h"
+#include "int.h"
+#include "process.h"
+#include "intproto.h"
+#include "socu.h"
+#include <fcntl.h>
+#include <sys/stat.h>
+#include <sys/time.h>
+#include <netinet/in.h>
+#include <arpa/inet.h>
+#include <errno.h>
+#include <netdb.h>
+
+
+#ifndef NO_PROTOTYPES
+static void load(char *);
+static void initiate(int,char **);
+int main(int,char **);
+#else
+static void load();
+static void initiate();
+int main();
+#endif
+
+
+int internal_sock,graph_sock,net_sock,connected=0;
+struct sockaddr_un svr;
+int GraphRes=-1;
+char ProgName[255],mygname[80], gname[80],mykname[80], nname[80], mynname[80];
+fd_set DirSet;
+int maxDirSet;
+
+ctx_struct my_ctx;
+ctx_struct parent_ctx;
+
+int RInstance[255]; /* IDs of remote instances */
+int DirConn[255]; /* Direct connection channels */
+
+/* graphic vars */
+int fcol, bcol, curx=0, cury=0;
+
+
+
+/* Macro to decode addressing modes : */
+#define getargument(a, argnr) \
+ switch (eop->args[ argnr ]) \
+ { \
+ case GLOBAL : a = M[ ic++ ]; break; \
+ case LOCAL : a = c1+M[ ic++ ]; break; \
+ case TEMPLOCAL : a = c2+M[ ic++ ]; break; \
+ case REMOTE : a = M[ M[ ic+1 ] ]+M[ ic ]; ic+=2; break;\
+ case INDIRECT : a = M[ M[ ic++ ] ]; break;\
+ case IMMEDIATE : a = ic++; break;\
+ case CONSTANT : a = M[ ic++ ]; break;\
+ case DOTACCESS : a = M[ display+M[ ic+1 ] ]+M[ ic ]; ic += 2; break;\
+ case NOARGUMENT : return; \
+ }
+
+
+static void load(_filename) /* Load code and prototypes from file */
+ char *_filename;
+{
+ FILE *fp;
+ char *cp;
+ word n, left;
+ char filename[100]; /* should suffice on all systems */
+
+ strcpy( filename, _filename );
+ M = mallocate(memorysize+1); /* allocate main memory array */
+ if (M == NULL) abend("Memory size too large (use /m option)\n");
+
+ addext(filename, ".ccd");
+ if ((fp = fopen(filename, BINARYREAD)) == NULL)
+ {
+ fprintf(stderr,"Cannot open .ccd file\n");
+ endrun(10);
+ };
+
+ ic = 0; /* read static data and code */
+ left = memorysize+1; /* from .ccd file */
+ do
+ {
+ if (left == 0) abend("Memory size too small (use /m option)\n");
+ n = min(IOBLOCK/sizeof(word), left);
+ n = fread((char *) &M[ ic ], sizeof(word), (int) n, fp);
+ ic += n;
+ left -= n;
+ } while (n != 0); /* now ic = number of words read */
+
+ fclose(fp);
+ /* Get various addresses passed by GENERATOR */
+ ipradr = M[ ic-5 ]; /* primitive type desctriptions */
+ temporary = M[ ic-4 ]; /* global temporary variables */
+ strings = M[ ic-3 ]; /* string constants */
+ lastprot = M[ ic-2 ]; /* last prototype number */
+ freem = M[ ic-1 ]; /* first free word in memory */
+
+ /* Read prototypes from .pcd file */
+ addext(filename, ".pcd");
+ if ((fp = fopen(filename, BINARYREAD)) == NULL)
+ {
+ fprintf(stderr,"Cannot open .pcd file\n");
+ endrun(10);
+ }
+ for (n = MAINBLOCK; n <= lastprot; n++ )
+ {
+ cp = ballocate(sizeof(protdescr));
+ if (cp == NULL) abend("Memory size too large (use /m option)\n");
+ prototype[ n ] = (protdescr *) cp;
+ if (fread(cp, sizeof(protdescr), 1, fp) != 1)
+ abend("Cannot read .pcd file\n");
+ }
+ fclose(fp);
+
+ /* Open trace file */
+ if (debug)
+ {
+ addext(filename, ".trd");
+ if ((tracefile = fopen(filename, "w")) == NULL)
+ abend("Cannot open .trd file\n");
+ }
+} /* end load */
+
+
+static void initiate(argc, argv) /* Establish configuration parameters */
+int argc;
+char **argv;
+{
+ long m;
+ int len,i,on;
+ char filename[80];
+ int sock;
+ fd_set rset,wset;
+
+ ournode = 0;
+ network = TRUE;
+ if ( (argc==4) && (strcmp(argv[3],"r") == 0) ) remote = TRUE;else remote=FALSE;
+ for(i=0;i<255;i++)
+ {
+ RInstance[i] = -1;
+ DirConn[i] = -1;
+ }
+
+ FD_ZERO(&DirSet);
+ maxDirSet=0;
+
+ strcpy(filename,argv[2]);
+ strcpy(ProgName,argv[2]);
+
+ strcpy(mynname,argv[1]);
+ strcat(mynname,".net");
+ unlink(mynname);
+ sock = socket(AF_UNIX,SOCK_STREAM,0);
+ bzero(&svr, sizeof(svr));
+ svr.sun_family = AF_UNIX;
+ strcpy(svr.sun_path,mynname);
+ len = strlen(svr.sun_path)+sizeof(svr.sun_family);
+ bind(sock,(struct sockaddr*)&svr, len);
+ listen(sock,5);
+
+
+ /* socket for graphic requests */
+ strcpy(mygname,argv[1]);
+ strcat(mygname,".gr");
+ unlink(mygname);
+
+
+ /* socket for KERNEL communication */
+ internal_sock = socket(AF_UNIX,SOCK_STREAM,0);
+ bzero(&svr, sizeof(svr));
+ svr.sun_family = AF_UNIX;
+ strcpy(svr.sun_path,argv[1]);
+ strcpy(mykname,argv[1]);
+ len = strlen(svr.sun_path)+sizeof(svr.sun_family);
+ i=connect(internal_sock,(struct sockaddr*)&svr,len);
+
+ if (i==0)
+ {
+ fcntl(internal_sock,F_SETFL, O_NONBLOCK|fcntl(internal_sock,F_GETFL,0));
+ }
+ else
+ while (i!=0)
+ {
+ close(internal_sock);
+ internal_sock = socket(AF_UNIX,SOCK_STREAM,0);
+ fcntl(internal_sock,F_SETFL, O_NONBLOCK|fcntl(internal_sock,F_GETFL,0));
+ i=connect(internal_sock,(struct sockaddr*)&svr,len);
+ }
+ on=1;
+ setsockopt(internal_sock,IPPROTO_TCP,TCP_NODELAY,(char*)&on,sizeof(on));
+
+ /* socket for network requests */
+ FD_ZERO(&rset);FD_ZERO(&wset);
+ FD_SET(sock,&rset);
+ if (select(sock+1,&rset,&wset,0,0))
+ net_sock = accept(sock,(struct sockaddr*)0,(int *)0);
+ if (net_sock>0)
+ {
+ fcntl(net_sock,F_SETFL,O_NONBLOCK|fcntl(net_sock,F_GETFL,0));
+ setsockopt(net_sock,IPPROTO_TCP,TCP_NODELAY,(char*)&on,sizeof(on));
+
+ }
+ close(sock);
+
+ if( filename!=NULL )
+ load(filename); /* load code and prototypes */
+ else
+ usage();
+}
+
+
+void decode(){
+ extopcode *eop;
+
+ eop = (extopcode *)(M+ic); /* pointer to extended opcode in M */
+ lastic = ic; /* save ic for possible redecoding */
+ ic += APOPCODE;
+ opcode = ((int) eop->opcode ) & 0xFF ;
+ getargument(a1, 0);
+ getargument(a2, 1);
+ getargument(a3, 2);
+}
+
+/* -------------------------------------------------------------------- */
+
+
+void send_to_graph(G_MESSAGE *msg)
+{
+ write(graph_sock,msg,sizeof(G_MESSAGE));
+}
+
+int read_from_graph(G_MESSAGE *msg)
+{
+ fd_set rset,wset;
+ struct timeval tout={0,0};
+
+ FD_ZERO(&rset);FD_ZERO(&wset);
+ FD_SET(graph_sock,&rset);
+
+
+ if (select(graph_sock+1,&rset,&wset,0,(struct timeval *)&tout)>0)
+ {
+ if (FD_ISSET(graph_sock,&rset))
+ return(read(graph_sock,msg,sizeof(G_MESSAGE)));
+ }
+ return(0);
+}
+
+int read_from_net(MESSAGE *msg)
+{
+ fd_set rset,wset;
+ struct timeval tout={0,0};
+
+ FD_ZERO(&rset);FD_ZERO(&wset);
+ FD_SET(net_sock,&rset);
+
+
+ if (select(net_sock+1,&rset,&wset,0,(struct timeval *)&tout)>0)
+ {
+ if (FD_ISSET(net_sock,&rset))
+ return(read(net_sock,msg,sizeof(MESSAGE)));
+ }
+ return(0);
+}
+
+
+/* Get graphic resource number */
+int get_graph_res()
+{
+ MESSAGE msg;
+ int sock;
+ struct sockaddr_un svr;
+ int len,i,on;
+ fd_set rset,wset;
+
+ unlink(mygname);
+ sock = socket(AF_UNIX,SOCK_STREAM,0);
+ bzero(&svr,sizeof(svr));
+ svr.sun_family = AF_UNIX;
+ strcpy(svr.sun_path,mygname);
+ len = strlen(svr.sun_path)+sizeof(svr.sun_family);
+ bind(sock,(struct sockaddr*)&svr, len);
+ listen(sock,5);
+
+
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_ALLOCATE;
+ strcpy(msg.param.pstr,mygname);
+ write(internal_sock,&msg,sizeof(MESSAGE));
+ bzero(&msg,sizeof(MESSAGE));
+ FD_ZERO(&rset);FD_ZERO(&wset);
+ FD_SET(sock,&rset);
+ if (select(sock+1,&rset,&wset,0,0))
+ graph_sock = accept(sock,(struct sockaddr*)0,(int*)0);
+
+ if (graph_sock == -1)
+ {
+ graphics=FALSE;return(0);
+ }
+ on=1;
+ close(sock);
+ fcntl(graph_sock,F_SETFL, O_NONBLOCK|fcntl(graph_sock,F_GETFL,0));
+ setsockopt(graph_sock,IPPROTO_TCP,TCP_NODELAY,(char*)&on,sizeof(on));
+
+ return(1);
+
+} /* get_graph_res */
+
+
+/* writeln string */
+void writeln_str(char *s)
+{
+ G_MESSAGE msg;
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[1] = GraphRes;
+ msg.param.pword[2] = GRAPH_WRITE;
+ strcpy(msg.param.pstr,s);
+
+ send_to_graph(&msg);
+ strcpy(msg.param.pstr,"\n");
+ send_to_graph(&msg);
+}
+
+/* write string */
+void write_str(char *s)
+{
+ G_MESSAGE msg;
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[1] = GraphRes;
+ msg.param.pword[0] = GRAPH_WRITE;
+ strcpy(msg.param.pstr,s);
+ send_to_graph(&msg);
+}
+
+/* write char */
+void write_char(char a)
+{
+ G_MESSAGE msg;
+
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[1] = GraphRes;
+ msg.param.pword[0] = GRAPH_PUTCHAR;
+ msg.param.pchar = a;
+ send_to_graph(&msg);
+}
+
+
+/* read char */
+char read_char()
+{
+ char ch;
+ G_MESSAGE msg;
+ int st;
+
+
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[1] = GraphRes;
+ msg.param.pword[0] = GRAPH_READCHAR;
+ send_to_graph(&msg);
+ while(TRUE)
+ {
+ st = read_from_graph(&msg);
+ if (st>0)
+ {
+ if ((msg.msg_type == MSG_GRAPH) &&
+ (msg.param.pword[0]==GRAPH_READCHAR_RESPONSE))
+ {ch = msg.param.pchar;break;}
+ }
+ }
+ return(ch);
+
+}
+
+/* read line */
+void read_line()
+{
+ G_MESSAGE msg;
+ int st;
+
+
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[1] = GraphRes;
+ msg.param.pword[0] = GRAPH_READLN;
+ send_to_graph(&msg);
+ while(TRUE)
+ {
+ st = read_from_graph(&msg);
+ if (st>0)
+ if ((msg.msg_type == MSG_GRAPH) && (msg.param.pword[0]== GRAPH_READLN_RESPONSE))
+ break;
+ }
+}
+
+/* read string */
+void read_str(char *s)
+{
+ char ss[255];
+ G_MESSAGE msg;
+ int st;
+
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[1] = GraphRes;
+ msg.param.pword[0] = GRAPH_READSTR;
+ send_to_graph(&msg);
+ while(TRUE)
+ {
+ st = read_from_graph(&msg);
+ if (st>0)
+ {
+ if ((msg.msg_type == MSG_GRAPH) &&
+ (msg.param.pword[0]==GRAPH_READSTR_RESPONSE))
+ { strcpy(ss,msg.param.pstr);break;}
+ }
+ }
+ strcpy(s,ss);
+
+}
+
+
+/* send message to kernel */
+void send_to_kernel(MESSAGE *msg)
+{
+ write(internal_sock,msg,sizeof(MESSAGE));
+}
+
+/* send message to net */
+void send_to_net(MESSAGE *msg)
+{
+ int k,len;
+ MESSAGE m;
+ struct sockaddr_in svr;
+
+
+ k = msg->int_msg.control.receiver.node;
+ if (RInstance[k]==-1)
+ {
+ bzero(&m,sizeof(MESSAGE));
+ m.msg_type = MSG_VLP;
+ m.param.pword[0] = VLP_REMOTE_INSTANCE_PLEASE;
+ m.param.pword[1] = my_ctx.program_id;
+ m.param.pword[2] = k;
+ send_to_kernel(&m);
+ bzero(&m,sizeof(MESSAGE));
+ while(1)
+ {
+ read(internal_sock,&m,sizeof(MESSAGE));
+ if ( (m.msg_type == MSG_VLP) && (m.param.pword[0]==VLP_REMOTE_INSTANCE_HERE)) break;
+ }
+
+ RInstance[k] = m.param.pword[1];
+ /* Make direct connection */
+ DirConn[k] = socket(AF_INET,SOCK_STREAM,0);
+ svr.sin_family = AF_INET;
+ svr.sin_addr.s_addr = inet_addr(m.param.pstr);
+ svr.sin_port = htons(m.param.pword[8]);
+ len = connect(DirConn[k],(struct sockaddr*)&svr,sizeof(svr));
+ if (len!=0)
+ {
+ RInstance[k]=-1;
+ writeln_str("Cannot connect remote instance!");
+ }
+ else
+ {
+ fcntl(DirConn[k], F_SETFL,O_NONBLOCK | fcntl(DirConn[k], F_GETFL,0));
+
+ }
+ }
+if (RInstance[k]!=-1)
+{
+ write(DirConn[k],&(msg->int_msg),sizeof(message));
+}
+}
+
+
+
+/* -------------------- Check for message on internal socket -------------*/
+
+
+void get_internal()
+{
+ MESSAGE m,m1;
+ message mx;
+
+ int r,max,i;
+ char s[80];
+ fd_set rset,wset;
+ struct timeval tout={0,0};
+
+
+
+ /* ----------- Direct connection messages -----*/
+ FD_ZERO(&DirSet);
+ maxDirSet=0;
+ for(i=0;i<255;i++)
+ if (DirConn[i]!=-1)
+ {
+ FD_SET(DirConn[i],&DirSet);
+ if (maxDirSet<DirConn[i]) maxDirSet=DirConn[i];
+ }
+
+ if (select(maxDirSet+1,&DirSet,0,0,(struct timeval *)&tout)>0)
+ {
+ for(i=0;i<255;i++)
+ {
+ if ( (DirConn[i]!=-1) && (FD_ISSET(DirConn[i],&DirSet)) )
+ {
+ r=read(DirConn[i],&mx,sizeof(mx));
+ if (r>0)
+ {
+ memcpy(globmsgqueue+msgtail,&mx,sizeof(message));
+ msgtail = (msgtail+1) % MAXMSGQUEUE;
+ msgready++;
+ }
+ }
+ }
+ }
+ /*-----------------------------------------*/
+
+
+ FD_ZERO(&rset);FD_ZERO(&wset);
+ FD_SET(net_sock,&rset);
+ FD_SET(internal_sock,&rset);
+
+ if (net_sock>internal_sock) max = net_sock; else max = internal_sock;
+
+ if (select(max+1,&rset,&wset,0,(struct timeval *)&tout)>0)
+ {
+
+ if (FD_ISSET(net_sock,&rset))
+ {
+ r = read(net_sock, &m, sizeof(MESSAGE));
+ if (r>0)
+ {
+ switch(m.msg_type)
+ {
+ case MSG_NET:
+ switch(m.param.pword[0])
+ {
+ case NET_PROPAGATE:
+ memcpy(globmsgqueue+msgtail,&m.int_msg,sizeof(message));
+ msgtail = (msgtail+1) % MAXMSGQUEUE;
+ msgready++;
+ break;
+ }; break;
+ } /*switch */
+ }
+ } /* FD_ISSET */
+
+ if (FD_ISSET(internal_sock,&rset))
+ {
+ r = read(internal_sock,&m,sizeof(MESSAGE));
+
+ if (r>0)
+ {
+ switch(m.msg_type)
+ {
+ case MSG_INT:
+ switch(m.param.pword[0])
+ {
+ case INT_CLOSE_INSTANCE: endrun(0);
+ case INT_KILL: endrun(1);
+ default:break;
+ } /* switch int */
+ case MSG_NET:
+ if (m.param.pword[0] == NET_PROPAGATE)
+ {
+ memcpy(globmsgqueue+msgtail,&m.int_msg,sizeof(message));
+ msgtail = (msgtail+1) % MAXMSGQUEUE;
+ msgready++;
+ };break;
+
+
+
+ }/*switch type */
+ }
+ } /* FD_ISSET */
+ } /* select */
+}
+
+
+void request_id()
+{
+ MESSAGE m;
+ G_MESSAGE m1;
+
+ m.msg_type = MSG_INT;
+ m.param.pword[0] = INT_CTX_REQ;
+ send_to_kernel(&m);
+ while ( (m.msg_type != MSG_INT) || (m.param.pword[0] != INT_CTX) )
+ read(internal_sock,&m,sizeof(MESSAGE));
+
+ my_ctx.node = m.param.pword[1];
+ my_ctx.program_id = m.param.pword[2];
+ if (remote)
+ {
+ parent_ctx.node = m.param.pword[3];
+ parent_ctx.program_id = m.param.pword[4];
+ RInstance[parent_ctx.node] = parent_ctx.program_id;
+ }
+ else
+ {
+ parent_ctx.node = my_ctx.node;
+ parent_ctx.program_id = my_ctx.program_id;
+ }
+ ournode = my_ctx.node;
+// strcpy(nname,m.param.pstr);
+// net_sock = open(nname,O_WRONLY);
+ m1.msg_type = MSG_GRAPH;
+ m1.param.pword[0] = GRAPH_SET_TITLE;
+ m1.param.pword[1] = GraphRes;
+ sprintf(m1.param.pstr,
+ "%s ID: %d",ProgName,my_ctx.program_id);
+ if (remote) strcat(m1.param.pstr," REMOTE instance");
+ send_to_graph(&m1);
+}
+
+
+
+void send_ready()
+{
+ int sock,len;
+ struct sockaddr_in svr;
+ char name[255];
+ struct hostent *info;
+
+
+ MESSAGE msg;
+ msg.msg_type = MSG_NET;
+ msg.param.pword[0] = NET_PROPAGATE;
+ msg.param.pword[1] = MSG_VLP;
+ msg.param.pword[2] = my_ctx.node;
+ msg.param.pword[4] = parent_ctx.node;
+ msg.param.pword[6] = VLP_REMOTE_INSTANCE_OK;
+ msg.param.pword[7] = my_ctx.program_id;
+
+ sock = socket(AF_INET,SOCK_STREAM,0);
+ bzero(&svr,sizeof(svr));
+ svr.sin_family = AF_INET;
+ svr.sin_addr.s_addr = INADDR_ANY;
+ svr.sin_port = 0;
+ bind(sock, (struct sockaddr*)&svr, sizeof(svr));
+ listen(sock,5);
+ len=sizeof(svr);
+ getsockname(sock,(struct sockaddr*)&svr,&len);
+ msg.param.pword[8] = ntohs(svr.sin_port);
+ gethostname(name,&len);
+ info = (struct hostent*)gethostbyname(name);
+ bcopy((char*)info->h_addr,(char*)&svr.sin_addr,info->h_length);
+ sprintf(msg.param.pstr,"%s",inet_ntoa(svr.sin_addr));
+ send_to_kernel(&msg);
+
+ bzero(&svr,sizeof(svr));
+ DirConn[parent_ctx.node] = accept(sock,(struct sockaddr*)&svr,&len);
+ fcntl(DirConn[parent_ctx.node], F_SETFL,O_NONBLOCK |
+ fcntl(DirConn[parent_ctx.node], F_GETFL,0));
+}
+
+int main(argc, argv)
+int argc;
+char **argv;
+{
+ initiate(argc, argv); /* initialize executor */
+ runsys(); /* initialize running system */
+ init_scheduler();
+ GraphRes = get_graph_res();
+ if ( GraphRes < 0 ) exit(12);
+
+ request_id();
+ if (remote) send_ready();
+
+
+ setjmp(contenv); /* set label for continue long jump */
+ while (TRUE) /* repeat until exit() is called */
+ {
+ get_internal();
+ schedule(); /* reschedule current process */
+ if (ready != 0)
+ {
+ decode(); /* fetch instruction */
+ execute(); /* and execute it */
+ }
+
+ }
+ return 0;
+} /* end main */
+
--- /dev/null
+/* Loglan82 Compiler&Interpreter
+ Copyright (C) 1993 Institute of Informatics, University of Warsaw
+ Copyright (C) 1993, 1994 LITA, Pau
+
+ 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; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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.
+
+ contacts: Andrzej.Salwicki@univ-pau.fr
+
+or Andrzej Salwicki
+ LITA Departement d'Informatique
+ Universite de Pau
+ Avenue de l'Universite
+ 64000 Pau FRANCE
+ tel. ++33 59923154 fax. ++33 59841696
+
+=======================================================================
+*/
+
+#include "depend.h"
+#include "genint.h"
+#include "int.h"
+#include "process.h"
+#include "intproto.h"
+
+#include <assert.h>
+
+
+#ifndef NO_PROTOTYPES
+
+static word get_pointer(word,word);
+static void phase1(void);
+static void phase2(void);
+static void phase2a(void);
+static void phase3(void);
+static void phase4(void);
+static void phase5(void);
+static void phase6(void);
+static void curtain(void);
+static void heap_walk(word);
+static void nonefy(virtaddr *);
+static void relocate(virtaddr *);
+static void traverse(word,void (*)(virtaddr *));
+static void what_we_have(virtaddr *);
+
+#else
+
+static word get_pointer();
+static void phase1();
+static void phase2();
+static void phase2a();
+static void phase3();
+static void phase4();
+static void phase5();
+static void phase6();
+static void curtain();
+static void heap_walk();
+static void nonefy();
+static void relocate();
+static void traverse();
+static void what_we_have();
+
+#endif
+
+
+#ifdef CDBG
+FILE *ff;
+static void what_we_have(va) virtaddr *va; {
+ fprintf(ff," pointer offset %d:|va=%d,va_m=%d,M[va]=%d,M[va+1]=%d|\n",
+ ((word*)va)-M,va->addr,va->mark,M[va->addr],M[va->addr+1]);
+ fflush(ff);
+}
+#endif
+
+
+/*
+ * Memory compactifier - a play in 6 acts
+ */
+
+static word nleng; /* free memory before compact. */
+static word curah; /* to preserve ah of current object */
+
+/* One of the actions for traverse: see below;
+ * converts none to absolute none, i.e. (0, 0)
+ */
+
+
+static void nonefy(va) virtaddr *va; {
+
+#ifdef CDBG
+ if(va->addr==0 && va->mark!=0){
+ fprintf(ff,"nonefy:|va=%d,va_m=%d,M[va]=%d,M[va+1]=%d|\n",
+ va->addr,va->mark,M[va->addr],M[va->addr+1]);
+ fflush(ff);
+ }
+#endif
+
+#ifndef OBJECTADDR
+ if(!isprocess(va))
+#else
+ assert( va->mark >= 0 );
+/* assert( va->mark <= M[ va->addr+1 ] );*/
+#endif
+#ifdef CDBG
+ fprintf(ff,"nonefy:|va=%d,va_mark=%d,am=%d,mark=%d|\n",
+ va->addr,va->mark,M[va->addr],M[va->addr+1]);
+ fflush(ff);
+#endif
+ if( va->mark != M[ va->addr+1 ] ) /* if NONE */
+ {
+
+#ifdef CDBG
+ fprintf(ff," set to NONE\n"); fflush(ff);
+#endif
+ va->addr = 0;
+ va->mark = 0;
+ }
+ assert( va->addr != 1 );
+} /* end nonefy */
+
+
+/* One of the actions for traverse; update the virtual address to
+ * correspond to its dictionary entry after compactification.
+ */
+
+static void relocate(va) virtaddr *va; {
+#ifndef OBJECTADDR
+ if(!isprocess(va)){
+#endif
+ va->addr = M[ va->addr+1 ]; /* new ah (after compression) */
+ va->mark = 0; /* clear mark */
+#ifndef OBJECTADDR
+ }
+#endif
+} /* end relocate */
+
+
+/* Traverse all the virtual variables of object am and perform action
+ * on each of them. Skip references to processes (see nonefy() and
+ * relocate()).
+ */
+
+static void traverse(am, action)
+ word am;
+#ifndef NO_PROTOTYPES
+ void (*action)(virtaddr *);
+#else
+ void (*action)();
+#endif
+{
+ word t1, t2, t3, length;
+ protdescr *ptr;
+
+ t1 = am+M[ am ]; /* LWA+1 of the object */
+ length = M[ am+PROTNUM ]; /* prototype number */
+ if (length == AINT || length == AREAL || length == AVIRT ||
+ length == FILEOBJECT
+#ifdef OBJECTADDR
+ || length == APROCESS
+#endif
+ )
+ {
+ if (length == AVIRT) /* ARRAYOF <reference> */
+ for (t2 = am+3; t2 < t1; t2 += 2)
+ (*action)((virtaddr *)(M+t2));
+ }
+ else /* neither an array nor a file */
+ {
+ ptr = prototype [ length ];
+ switch (ptr->kind) /* compute the number of the system */
+ /* virtual variables */
+ {
+ case RECORD : length = 0; t3 = 0; break;
+ case COROUTINE : length = 3; t3 = CL; break;
+ case PROCESS : length = 5; t3 = disp2off; break;
+ case FUNCTION :
+ case PROCEDURE : length = 2; t3 = RPCDL+1; break; /* PS */
+ case HANDLER : length = 2; t3 = SIGNR; break;
+ default : length = 2; t3 = STATSL; break;
+ }
+
+ /* action for system reference variables */
+ for (t2 = length; t2 >= 1; t2-- )
+ (*action)((virtaddr *)(M+t1+offset[ t2 ]));
+
+ /* action for temporary reference variables */
+ t1 = am+M[ am ]+t3;
+ for (t2 = am+ptr->span; t2 < t1; t2 += 2)
+ (*action)((virtaddr *)(M+t2));
+
+ /* action for user reference variables */
+ t1 = ptr->reflist;
+ for (t2 = t1+ptr->lthreflist-1; t2 >= t1; t2-- )
+ (*action)((virtaddr *)(M+am+M[ t2 ]));
+ }
+} /* end traverse */
+
+
+/* Mark killed objects by substituting prototype number by a special value.
+ * This way we will be able to tell apart the killed objects without
+ * recalling to the dictionary or to the list of killed objects.
+ */
+
+static void phase1()
+{
+ word t1, t2, t3, phead;
+
+ nleng = thisp->lastitem-thisp->lastused-1; /* free memory before comp. */
+ M[ 1 ] = 0; /* for proper update of none */
+ phead = thisp->prochead; /* head of current process */
+ M[ phead+M[ phead ]+SL ] = 0; /* make SL of head look like none */
+ t1 = thisp->headk2; /* flag killed objects */
+ while (t1 != 0) /* special list for appetite=2 */
+ {
+ t2 = t1+SHORTLINK;
+ t1 = M[ t2 ];
+ M[ t2 ] = SKILLED; /* flag object killed */
+ }
+ t1 = thisp->headk; /* now other killed objects */
+ while (t1 != thisp->lower)
+ {
+ t2 = t1;
+ while (t2 != 0)
+ {
+ t3 = t2+SHORTLINK;
+ t2 = M[ t3 ];
+ M[ t3 ] = SKILLED; /* flag object killed */
+ }
+ t1 = M[ t1+LONGLINK ]; /* goto other size list */
+ }
+} /* end phase1 */
+
+
+/* Step thru the memory area containing objects. For each object not being
+ * killed detect all its virtual variables pointing to none and convert
+ * them to absolute none i.e. (0, 0).
+ */
+
+static void phase2()
+{
+ word t1;
+
+ nonefy( &(thisp->procref ) );
+
+ t1 = thisp->lower+1; /* FWA of object area */
+ while (t1 <= thisp->lastused)
+ {
+
+#ifdef CDBG
+ fprintf(ff,"OBJECT am=%d,SIZE=%d,TYPE=%d\n",t1,M[t1],M[t1+1]);
+ fflush(ff);
+ if (M[ t1+1 ] != SKILLED) traverse(t1,what_we_have);
+#endif
+
+ if (M[ t1+1 ] != SKILLED) /* an active object */
+ traverse(t1, nonefy);
+ t1 += M[ t1 ]; /* next object address */
+ }
+} /* end phase2 */
+
+
+/* garbage collection */
+
+/* Find x-th pointer in am.
+ * Skip references to processes.
+ */
+
+static word get_pointer(am,x) word am,x; {
+
+ word t1, t2, t3, length, va;
+ protdescr *ptr;
+
+ t1 = am+M[ am ]; /* LWA+1 of the object */
+ length = M[ am+PROTNUM ]; /* prototype number */
+
+#ifdef CDBG
+ fprintf(ff,"|get_pointer(am=%d,x=%d)lenght=%d|",am,x,length);
+ fflush(ff);
+#endif
+
+ if (length == AINT || length == AREAL || length == AVIRT ||
+ length == FILEOBJECT
+#ifdef OBJECTADDR
+ || length == APROCESS
+#endif
+ )
+ {
+ if(length == AVIRT) /* ARRAYOF <reference> */
+ for(t2 = am+3; t2 < t1; t2 += 2){
+#ifndef OBJECTADDR
+ if(isprocess((virtaddr *)(M+t2))) continue;
+#endif
+ if(M[t2]==0){ assert( M[t2+1]==0 ); continue; }
+#ifdef CDBG
+ fprintf(ff,"ARR");
+ fflush(ff);
+#endif
+ if(x==0){
+#ifdef CDBG
+ fprintf(ff,"=%d|\n",t2);
+ fflush(ff);
+#endif
+ return t2;
+ }
+ x--;
+ }
+ }
+ else /* neither an array nor a file */
+ {
+ ptr = prototype [ length ];
+ switch (ptr->kind) /* compute the number of the system */
+ /* virtual variables */
+ {
+ case RECORD : length = 0; t3 = 0; break;
+ case COROUTINE : length = 3; t3 = CL; break;
+ case PROCESS : length = 5; t3 = disp2off; break;
+ case FUNCTION :
+ case PROCEDURE : length = 2; t3 = RPCDL+1; break; /* PS */
+ case HANDLER : length = 2; t3 = SIGNR; break;
+ default : length = 2; t3 = STATSL; break;
+ }
+
+ /* system reference variables */
+ for(t2 = length; t2 >= 1; t2-- ){
+ va=t1+offset[ t2 ];
+#ifndef OBJECTADDR
+ if(isprocess((virtaddr *)(M+va))) continue;
+#endif
+ if(M[va]==0){ assert( M[va+1]==0 ); continue; }
+ if(x==0){
+#ifdef CDBG
+ fprintf(ff,"=%d|\n",va);
+ fflush(ff);
+#endif
+ return va;
+ }
+ x--;
+ }
+
+ /* temporary reference variables */
+ t1 = am+M[ am ]+t3;
+ for(t2 = am+ptr->span; t2 < t1; t2 += 2){
+#ifndef OBJECTADDR
+ if(isprocess((virtaddr *)(M+t2))) continue;
+#endif
+ if(M[t2]==0){ assert( M[t2+1]==0 ); continue; }
+ if(x==0){
+#ifdef CDBG
+ fprintf(ff,"=%d|\n",t2);
+ fflush(ff);
+#endif
+ return t2;
+ }
+ x--;
+ }
+
+ /* user reference variables */
+ t1 = ptr->reflist;
+ for(t2 = t1+ptr->lthreflist-1; t2 >= t1; t2-- ){
+ va=am+M[ t2 ];
+#ifndef OBJECTADDR
+ if(isprocess((virtaddr *)(M+va))) continue;
+#endif
+ if(M[va]==0){ assert( M[va+1]==0 ); continue; }
+ if(x==0){
+#ifdef CDBG
+ fprintf(ff,"=%d|\n",va);
+ fflush(ff);
+#endif
+ return va;
+ }
+ x--;
+ }
+ }
+
+#ifdef CDBG
+ fprintf(ff,"=-1|\n");
+ fflush(ff);
+#endif
+
+ return -1;
+}
+
+static void heap_walk(curr_ah) word curr_ah;{
+ word aux,prev_ah=1; /* 1 is special value not expected in anyone virtaddr */
+ word level=0;
+
+#ifdef CDBG
+ fprintf(ff,"|prev_ah=%d|\n",prev_ah);
+ fflush(ff);
+#endif
+
+ for(;;){
+ word am=get_pointer(M[curr_ah],M[curr_ah+1]);
+ M[curr_ah+1]++;
+ if(am >= 0){
+ if(M[ M[am] +1] >0){
+#ifdef CDBG
+ fprintf(ff,"Object %d->%d invited.\n",M[am],M[M[am]]);
+ fflush(ff);
+#endif
+ continue;
+ }
+
+ /*** go ahead ***/
+ level++;
+ aux=M[am];
+ M[am]=prev_ah;
+ prev_ah=curr_ah;
+ curr_ah=aux;
+#ifdef CDBG
+ fprintf(ff,"|curr_ah set to %d|\n",curr_ah);
+ fflush(ff);
+#endif
+ continue;
+ }
+ if(prev_ah > 1){
+ /*** go back ***/
+#ifdef CDBG
+ fprintf(ff,"going back (prev_ah=%d)(lvl=%d)\n",prev_ah,level);
+ fflush(ff);
+#endif
+ level--;
+ aux=curr_ah;
+ curr_ah=prev_ah;
+ am=get_pointer(M[prev_ah],M[prev_ah+1]-1);
+ prev_ah=M[am];
+#ifdef CDBG
+ if(level==0)
+ fprintf(ff,"|prev_ah set to %d,next set to %d|\n",prev_ah,aux);
+ fflush(ff);
+#endif
+ M[am]=aux;
+ continue;
+ }
+ assert( prev_ah==1 );
+ assert( level == 0 );
+ break; /*** now all 'invited' objects have its mark >0 ***/
+ }
+}
+
+static void phase2a()
+{
+ word t1,c1_ah;
+
+ /*** generation number already is not needed so we reset it ***/
+
+ t1 = thisp->upper-1;
+ while(t1 >= thisp->lastitem){
+ if( M[t1] == c1 ) c1_ah=t1;
+ M[ t1+1 ] = 0;
+ t1-=2;
+ }
+
+#ifdef CDBG
+ fprintf(ff,"first phase of walk |from=%d,to=%d,procah=%d|\n",
+ thisp->lastitem,
+ thisp->upper-1,
+ thisp->procref.addr);
+ fflush(ff);
+#endif
+
+ heap_walk(thisp->procref.addr);
+
+#ifdef CDBG
+ fprintf(ff,"second phase of walk c1_ah=%d,c1=%d\n",c1_ah,c1);
+ fflush(ff);
+#endif
+
+ heap_walk(c1_ah);
+
+ if( thisp->blck1 != 0 )
+ heap_walk(thisp->blck1);
+
+ /*** Mark objects not traversed like SKILLED ***/
+
+ t1 = thisp->freeitem; /* head of free item list */
+ while (t1 != 0)
+ {
+ word t2;
+ t2 = M[ t1 ];
+ M[ t1 ]= 0-1; /* mark not to set object SKILLED */
+ t1 = t2; /* next free item */
+ }
+
+ t1 = thisp->upper-1; /* last dictionary item pointer */
+ while (t1 >= thisp->lastitem)
+ {
+ if (M[ t1+1 ] == 0 ){ /* entry not traversed - so killed */
+
+#ifdef CDBG
+ fprintf(ff,"MARKING dict. entry %d -> %d like SKILLED\n",t1,M[t1]);
+ fflush(ff);
+#endif
+
+ M[ t1+1 ] = MAXMARKER;
+ if( M[ t1 ] > 0 ) M [ M[ t1 ] +1 ] = SKILLED;
+ /* mark SKILLED if not set yet */
+ }
+ t1 -= 2;
+ }
+} /* end phase2a */
+
+
+
+/* For each free dictionary item set its mark to unusable status.
+ */
+
+static void phase3()
+{
+ word t1;
+
+ t1 = thisp->freeitem; /* head of free item list */
+ while (t1 != 0)
+ {
+ M[ t1+1 ] = MAXMARKER; /* flag item unusable */
+ t1 = M[ t1 ]; /* next free item */
+ }
+} /* end phase3 */
+
+
+/* Step thru the dictionary and virtually remove all unusable items.
+ * For each active item (after phase3 we have only active and unusable
+ * items) its mark is set to the new address of this item (after
+ * forthcomming compression). Moreover the contents of locations am and
+ * (old) ah are interchanged.
+ */
+
+static void phase4()
+{
+ word t1, t2, t3;
+
+ t1 = thisp->upper-1; /* last dictionary item pointer */
+ t2 = t1; /* initialize new address */
+ while (t1 >= thisp->lastitem)
+ {
+ if (M[ t1+1 ] == MAXMARKER) /* entry killed - don't decrement t2 */
+ M[ t1+1 ] = 0;
+ else
+ {
+ M[ t1+1 ] = t2; /* store new ah */;
+ t2 -= 2;
+ t3 = M[ t1 ]; /* am */
+ M[ t1 ] = M[ t3 ]; /* save (am) in (old ah) */
+ M[ t3 ] = t1; /* move old ah to (am) */
+ }
+ t1 -= 2;
+ }
+} /* end phase4 */
+
+
+/* The memory area of objects is traversed once again. Now the killed
+ * objects are removed and the remaining ones compressed. For each active
+ * object its virtual variables are relocated, their marks cleared, their
+ * ah's set to the proper new values. The contents of locations am and ah
+ * are interchanged back.
+ */
+
+static void phase5()
+{
+ word t1, t2, t3, t4, t5;
+
+ t2 = t1 = thisp->lower+1;
+ while (t1 <= thisp->lastused) /* traverse object area */
+ {
+ t5 = M[ t1 ]; /* old ah saved by phase4 */
+ if (M[ t1+1 ] == SKILLED){ /* ignore this object */
+#ifdef CDBG
+ fprintf(ff,"OBJECT am=%d,SIZE=%d,TYPE=%d\n",t1,M[t1],M[t1+1]);
+ fflush(ff);
+#endif
+ t1 += t5; /* t5=appetite in this case */
+ }
+ else
+ {
+#ifdef CDBG
+ fprintf(ff,"OBJECT am=%d,SIZE=%d,TYPE=%d\n",t1,M[t1],M[t1+1]);
+ fflush(ff);
+#endif
+ t3 = M[ t5 ]; /* appetite saved by phase4 */
+ M[ t2 ] = t3; /* send it to the new am */
+ for (t4 = 1; t4 < t3; t4++ ) /* copy the object into new am */
+ M[ t2+t4 ] = M[ t1+t4 ];
+#ifdef CDBG
+ traverse(t2,what_we_have);
+#endif
+
+ /* Update global absolute pointer to current object : */
+ if (t1 == c1) /* locate am of current */
+ {
+ c1 = t2;
+ curah = M[ t5+1 ]; /* new ah of current */
+ }
+ if (t1 == M[ temporary ])
+ M[ temporary ] = t2;
+
+ M[ t5 ] = t2; /* make (ah) looking ok */
+ traverse(t2, relocate); /* relocate virtual variables */
+#ifdef CDBG
+ fprintf(ff," --> am=%d,SIZE=%d,TYPE=%d\n",t2,M[t2],M[t2+1]);
+ fflush(ff);
+ traverse(t2,what_we_have);
+#endif
+ t1 += t3;
+ t2 += t3;
+ }
+ }
+ thisp->lastused = t2-1;
+
+
+ /* Update global absolute pointers to objects : */
+
+ relocate(&(thisp->procref ));
+
+ {
+ virtaddr v;
+ v.addr=thisp->blck1;
+ v.mark=0;
+ relocate(&v);
+ thisp->blck1=v.addr;
+ }
+
+} /* end phase5 */
+
+
+/* The dictionary is compressed. The unusable entries are moved out and
+ * the remaining ones are moved up to the positions indicated by their
+ * marks.
+ * If pointers to processes are implemented as objects we have to rebuild
+ * has table of these pointers too.
+ */
+
+static void phase6()
+{
+ word t1, t2, t3;
+
+#ifdef OBJECTADDR
+ hash_create(thisp,thisp->hash_size);
+#endif
+
+ t1 = thisp->upper+1;
+ for (t2 = t1-2; t2 >= thisp->lastitem; t2 -= 2) /* compress dictionary */
+ {
+ t3 = M[ t2+1 ];
+ if (t3 != 0) /* this is new ah */
+ {
+ M[ t3 ] = M[ t2 ];
+ M[ t3+1 ] = 0; /* clear mark */
+ t1 = t3;
+#ifdef OBJECTADDR
+ {
+ virtaddr vt3;
+ vt3.addr=t3;
+ vt3.mark=0;
+ if( isprocess(&vt3) ){
+ virtaddr obj;
+ procaddr mess;
+ obj.addr=t3;
+ obj.mark=0;
+ obj2mess(M,&obj,&mess);
+ /* force to create item - we not need it yet */
+ hash_set(&mess,t3);
+ }
+ }
+#endif
+ }
+ }
+ thisp->lastitem = t1;
+
+ thisp->prochead = M[ thisp->procref.addr ];
+ thisp->blck2 = M[ thisp->blck1 ];
+
+} /* end phase6 */
+
+
+/* System invariants are recovered, e.g. display is rebuilt to reflect the
+ * new physical addresses.
+ */
+
+static void curtain()
+{
+ word t1, phead;
+
+ phead = thisp->prochead;
+ t1=M[ c1 + PROTNUM ];
+ c2 = c1+prototype[ t1 ]->span;
+ t1 = phead+M[ phead ]; /* first free after process head */
+ display = t1+dispoff; /* display address */
+ display2 = t1+disp2off; /* indirect display */
+ M[ t1+SL ] = DUMMY; /* restore head's SL */
+ loosen(); /* rebuild DISPLAY */
+ update(c1, curah);
+ if (infmode){
+ fprintf(stderr,
+ "\n(COMPACTIFIER used for process %d,%ld words reclaimed,now %ld free)\n",
+ thispix,
+ (long) (thisp->lastitem-thisp->lastused-1-nleng),
+ (long) (thisp->lastitem-thisp->lastused-1));
+ fflush(stderr);
+ }
+#ifdef CDBG
+ fprintf(ff,
+ "(COMPACTIFIER used for process %d,%ld words reclaimed,now %ld free)\n",
+ thispix,
+ (long) (thisp->lastitem-thisp->lastused-1-nleng),
+ (long) (thisp->lastitem-thisp->lastused-1));
+ fflush(ff);
+#endif
+ thisp->freeitem = 0;
+ thisp->headk2 = 0;
+ thisp->headk = thisp->lower;
+ M[ 1 ] = 1; /* absolute none */
+ ic = lastic; /* re-decode current instruction ! */
+ decode();
+ if (opcode == 3 /*LRAISE*/) ic++; /* skip address after LRAISE */
+} /* end curtain */
+
+
+void compactify() /* Compactification */
+{
+#ifdef CDBG
+ ff=fopen("trace","a");
+ fprintf(ff,"----------------------------------------\n");
+ fprintf(ff,"COMPACTIFY (thisp=%d)\n",thispix);
+ fprintf(ff,"c1=%d,c2=%d,templ=%d\n",
+ thisp->c1,thisp->c2,thisp->template.addr);
+ fprintf(ff,"back=%d,back.mark=%d,backam=%d,backam.mark=%d\n",
+ thisp->backobj.addr,thisp->backobj.mark,
+ M[thisp->backobj.addr],M[thisp->backobj.addr+1]);
+ fprintf(ff,"blck1=%d,blck2=%d\n",thisp->blck1,thisp->blck2);
+ fflush(ff);
+#endif
+
+ phase1();
+ phase2();
+ phase2a(); /* garbage collection */
+/* phase3(); if only compactifier is needed uncomment this statement */
+/* and comment statement phase2a() */
+ phase4();
+ phase5();
+ phase6();
+ curtain();
+
+#ifdef CDBG
+ fprintf(ff,"----------------------------------------\n");
+ fflush(ff);
+ fclose(ff);
+#endif
+
+} /* end compactify */
+
+
--- /dev/null
+/* Loglan82 Compiler&Interpreter
+ Copyright (C) 1993 Institute of Informatics, University of Warsaw
+ Copyright (C) 1993, 1994 LITA, Pau
+
+ 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; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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.
+
+ contacts: Andrzej.Salwicki@univ-pau.fr
+
+or Andrzej Salwicki
+ LITA Departement d'Informatique
+ Universite de Pau
+ Avenue de l'Universite
+ 64000 Pau FRANCE
+ tel. ++33 59923154 fax. ++33 59841696
+
+=======================================================================
+*/
+
+#include "depend.h"
+#include "genint.h"
+#include "int.h"
+#include "process.h"
+#include "intproto.h"
+
+/* Transfer of control routines */
+
+#ifndef NO_PROTOTYPES
+static void att2(virtaddr *, word, word);
+static void back1(word, word, virtaddr *, word *);
+#else
+static void att2();
+static void back1();
+#endif
+
+/* Transfer control to the newly created object.
+ */
+
+void go(ah, am)
+word ah, am;
+{
+ protdescr *ptr;
+ word pnum, plen, node, apt;
+ message msg;
+
+ ptr = prototype[ M[ am+PROTNUM ] ];
+ apt = am+M[ am ];
+ if (ptr->kind == PROCESS) /* new process creation */
+ {
+ thisp->template.addr = ah; /* save template address */
+ thisp->template.mark = M[ ah+1 ];
+ msg.control.type = CREATE;
+ msg.control.par = M[ am+PROTNUM ];
+ moveparams(thispix, am, &msg, PARIN, LOADPAR);
+ msg.control.receiver.pix = 0; /* pix will create receiver */
+ msg.control.receiver.mark= 0; /* mark will create receiver */
+ msg.control.receiver.node = getnode(am); /* node we decided */
+ sendmsg1( &msg); /* send create request */
+# ifdef RPCDBG
+ fprintf(
+ stderr, "send new process from %d to node %d\n",
+ thispix,
+ msg.control.receiver.node
+ );
+# endif
+ passivate(WAITFORNEW); /* and wait for return from process */
+ }
+ else
+ if (isprocess((virtaddr*)(M+apt+SL))) /* remote procedure call */
+ {
+ thisp->backobj.addr = ah; /* save template address */
+ thisp->backobj.mark = M[ ah+1 ];
+ thisp->M[ temporary ] = am; /* physical address also */
+ {
+ virtaddr v;
+ loadvirt( v, apt+SL );
+ obj2mess( M, &v, &msg.control.receiver );
+
+ /* fprintf(
+ stderr, "send rpc from process %d to (%d,%d,%d)\n",
+ thispix,
+ msg.control.receiver.node,
+ msg.control.receiver.pix,
+ msg.control.receiver.mark
+ );*/
+
+ }
+ msg.control.type = RPCALL;
+ msg.control.par = M[ am+PROTNUM ];
+ moveparams(thispix, am, &msg, PARIN, LOADPAR);
+ sendmsg1( &msg); /* send RPC request */
+ passivate(WAITFORRPC); /* and wait for RP return */
+ }
+ else
+ {
+ M[ c1+M[ c1 ]+LSC ] = ic; /* save local control */
+ loosen(); /* release DISPLAY */
+ update(am, ah); /* update DISPLAY */
+ c1 = am; /* new current */
+ c2 = c1+ptr->span;
+ pnum = ptr->preflist;
+ plen = ptr->lthpreflist;
+ while (TRUE) /* search for executable prefix */
+ if (plen <= 1)
+ {
+ ic = ptr->codeaddr;
+ break;
+ }
+ else
+ {
+ ptr = prototype[ M[ pnum ] ];
+ plen--;
+ pnum++;
+ if (ptr->kind != RECORD) plen = 0;
+ }
+ }
+}
+
+
+/* Transfer control to a local unprefixed procedure, function, block,
+ * class or coroutine.
+ */
+
+void goloc(ah, am)
+word ah, am;
+{
+ word t1;
+ protdescr *ptr;
+
+ M[ c1+M[ c1 ]+LSC ] = ic; /* save local control */
+ c1 = am; /* new current */
+ t1 = M[ am+PROTNUM ];
+ ptr = prototype[ t1 ];
+ c2 = am+ptr->span;
+ ic = ptr->codeaddr;
+ M[ display+t1 ] = am; /* simulate update display */
+ M[ display2+t1 ] = ah;
+ M[ am+M[ am ]+STATSL ]++;
+}
+
+
+void backbl(virt, am) /* Return from block. */
+virtaddr *virt;
+word *am;
+{
+ word t1;
+
+ t1 = M[ c1+PROTNUM ];
+ virt->addr = M[ display2+t1 ];
+ virt->mark = M[ virt->addr+1 ]; /* prepare old address */
+ *am = c1; /* am of old */
+ M[ display+t1 ] = 0; /* simulate loosen */
+ t1 = c1+M[ c1 ];
+ M[ t1+STATSL ]--; /* remove from SL chain */
+ c1 = M[ t1+SL ]; /* return up along SL */
+ if (c1 == DUMMY) endprocess(0); /* return from main */
+ c1 = M[ c1 ]; /* am of new current */
+ c2 = c1+prototype[ M[ c1+PROTNUM ] ]->span;
+ ic = M[ c1+M[ c1 ]+LSC ];
+ storevirt(*virt, *am+M[ *am ]+DL); /* force DL consistency */
+}
+
+
+static void back1(at1, at2, virt, am) /* Common code for some backs below. */
+word at1, at2;
+virtaddr *virt;
+word *am;
+{
+ word t1;
+
+ loosen();
+ if (at1 == 0) endprocess(0);
+ t1 = M[ c1+PROTNUM ];
+ virt->addr = M[ display2+t1 ]; /* ah of old */
+ virt->mark = M[ virt->addr+1 ];
+ *am = c1; /* am of old */
+ storevirt(*virt, at2); /* loop up DL */
+ at2 = M[ at1 ]; /* am of DL */
+ update(at2, at1);
+ c1 = at2;
+ c2 = c1 + prototype[ M[ c1+PROTNUM ] ]->span;
+ ic = M[ c1+M[ c1 ]+LSC ];
+}
+
+
+/* Return from classes, coroutines and by end from procedures.
+ */
+
+void back(virt, am, length)
+virtaddr *virt;
+word *am;
+word length;
+{
+ word t1, t2, plist;
+ int i;
+ protdescr *ptr;
+ message msg;
+
+ t2 = c1+M[ c1 ];
+ t1 = M[ t2+DL ]; /* ah of DL */
+ ptr = prototype[ M[ c1+PROTNUM ] ]; /* prototype of current */
+ if (ptr->kind == PROCESS) /* RETURN in process */
+ {
+# ifdef RPCDBG
+ fprintf( stderr, "return from process %d\n", thispix );
+# endif
+ if (M[ c1+PROTNUM ] == MAINBLOCK) endprocess(0);
+ {
+ virtaddr v;
+ loadvirt( v, t2+DL );
+ obj2mess( M, &v, &msg.control.receiver ); /* father process */
+ }
+ msg.control.type = CREACK;
+ moveparams(thispix, c1, &msg, PAROUT, LOADPAR);
+ sendmsg1(&msg); /* send create acknowledge */
+ M[ t2+DL ] = 0; /* cut DL of new process head */
+ passivate(STOPPED); /* and suspend new process */
+ }
+ else
+ if (ptr->kind == COROUTINE)
+ {
+ if (t1 != 0) /* nothing if detached */
+ {
+ M[ t2+LSC ] = ic;
+ back1(t1, t2+DL, virt, am);
+ }
+ }
+ else
+ {
+ plist = ic; /* save begining of prototype list */
+ if (ptr->lthpreflist==1 && t1==M[t2+SL] && M[t2+DL+1]==M[t2+SL+1])
+ backbl(virt, am);
+ else
+ back1(t1, t2+DL, virt, am);
+
+/*
+# ifdef RPCDBG
+ fprintf(
+ stderr, "back (thisp=%d) from %s to %s\n",
+ thispix,
+ (
+ (ptr->kind==PROCEDURE) ?
+ "PROCEDURE" :
+ (ptr->kind==FUNCTION) ?
+ "FUNCTION" :
+ "???"
+ ),
+ isprocess((virtaddr*)(M+t2+RPCDL)) ? "PROCESS" : "OBJECT"
+ );
+# endif
+*/
+ if ((ptr->kind == PROCEDURE || ptr->kind == FUNCTION) &&
+ isprocess((virtaddr*)(M+t2+RPCDL)))
+ {
+ {
+ virtaddr v;
+ loadvirt( v, t2+RPCDL );
+ obj2mess( M, &v, &msg.control.receiver ); /* remote DL */
+ }
+
+ /*fprintf(
+ stderr, "send rpc ack from process %d to (%d,%d,%d)\n",
+ thispix,
+ msg.control.receiver.node,
+ msg.control.receiver.pix,
+ msg.control.receiver.mark
+ );*/
+
+ msg.control.type = RPCACK;
+ moveparams(thispix, *am, &msg, PAROUT, LOADPAR);
+ sendmsg1(&msg); /* send RP return - acknowledge */
+ gkill(virt); /* kill procedure object manualy */
+ popmask(thispix); /* restore RPC mask from stack */
+ for (i = 0; i < length; i++) /* and modify it */
+ {
+ t1 = virtprot(M[ plist++ ]); /* prototype number */
+ if (t1 > 0) enable(thispix, t1);
+ else disable(thispix, -t1);
+ }
+ evaluaterpc(thispix); /* check for enabled RPCs */
+ }
+ }
+}
+
+
+/* Return, end in procedures and functions without prefix.
+ */
+
+void backpr(virt, am)
+virtaddr *virt;
+word *am;
+{
+ word t1, t2, t3;
+
+ t2 = c1+M[ c1 ]+DL; /* DL pointer of current */
+ t1 = M[ t2 ]; /* ah of DL */
+ t3 = c1+M[ c1 ]+SL; /* SL pointer */
+ if (t1 == M[ t3 ] && M[ t2+1 ] == M[ t3+1 ]) backbl(virt, am); /* SL=DL */
+ else back1(t1, t2, virt, am);
+}
+
+
+void fin(backic, virt, am) /* End in classes and coroutines. */
+word backic;
+virtaddr *virt;
+word *am;
+{
+ word t1, t2, knd;
+
+ knd = prototype[ M[ c1+PROTNUM ] ]->kind;
+ if (knd != COROUTINE && knd != PROCESS)
+ back(virt, am, (word) 0); /* a class - exit as above */
+ else
+ {
+ ic = backic; /* backspace ic */
+ t2 = c1+M[ c1 ];
+ t1 = M[ t2+DL ]; /* ah of DL */
+ if (t1 == 0)
+ {
+ if (M[ t2+SL ] == DUMMY) endprocess(0);
+ ic = 0; /* coroutine terminated */
+ *am = 0;
+ detach();
+ }
+ else
+ {
+ M[ t2+LSC ] = ic;
+ back1(t1, t2+DL, virt, am);
+ }
+ }
+}
+
+
+static void att2(virt, ax, at1) /* Helper for attach/detach */
+virtaddr *virt;
+word ax, at1;
+{
+ word t1, t2, phead;
+
+ t1 = M[ display2+M[ c1+PROTNUM ] ]; /* ah of current */
+ t2 = at1+M[ at1 ]+DL; /* DL of coroutine head */
+ M[ t2 ] = t1; /* loop up DL */
+ M[ t2+1 ] = M[ t1+1 ];
+ M[ c1+M[ c1 ]+LSC ] = ic; /* preserve local control */
+ loosen();
+ phead = thisp->prochead;
+ storevirt(*virt, phead+M[ phead ]+CHD);
+ t2 = M[ ax+DL ];
+ if (t2 == 0) errsignal(RTECORAC); /* coroutine active */
+ M[ ax+DL ] = 0; /* cut DL of new coroutine head */
+ c1 = M[ t2 ];
+ update(c1, t2);
+ c2 = c1+prototype[ M[ c1+PROTNUM ] ]->span;
+ ic = M[ c1+M[ c1 ]+LSC ];
+ if (ic == 0) errsignal(RTECORTM); /* coroutine terminated */
+}
+
+
+void attach(virt)
+virtaddr *virt;
+{
+ word t1, ax, phead, chead;
+ int knd;
+
+ if (M[ virt->addr+1 ] != virt->mark) errsignal(RTEILLAT);
+ else ax = M[ virt->addr ]; /* am */
+ t1 = M[ ax+PROTNUM ];
+ if (t1 == AINT || t1 == AREAL || t1 == AVIRT || t1 == FILEOBJECT)
+ errsignal(RTEILLAT);
+ knd = prototype[ t1 ]->kind;
+ if (knd != COROUTINE && knd != PROCESS) errsignal(RTEILLAT);
+ ax = ax+M[ ax ];
+ phead = thisp->prochead;
+ chead = phead+M[ phead ]+CHD;
+ if (virt->addr != M[ chead ] || virt->mark != M[ chead+1 ])
+ {
+ M[ ax+CL ] = M[ chead ];
+ M[ ax+CL+1 ] = M[ chead+1 ];
+ att2(virt, ax, M[ M[ chead ] ]);
+ }
+}
+
+
+void detach()
+{
+ virtaddr virt;
+ word t1, phead;
+
+ phead = thisp->prochead;
+ t1 = M[ M[ phead+M[ phead ]+CHD ] ]; /* am of coroutine head */
+ loadvirt(virt, t1+M[ t1 ]+CL); /* coroutine link */
+ if (M[ virt.addr+1 ] != virt.mark) errsignal(RTEILLDT);
+ att2(&virt, M[ virt.addr ]+M[ M[ virt.addr ] ], t1);
+}
+
+
+void inner(level) /* Simulate execution of inner */
+word level;
+{
+ word t1;
+ protdescr *ptr;
+
+ ptr = prototype[ M[ c1+PROTNUM ] ]; /* prototype of current */
+ t1 = ptr->lthpreflist;
+ if (t1 != level)
+ if (level == t1-1) ic = ptr->codeaddr;
+ else ic = prototype[ M[ ptr->preflist+level ] ]->codeaddr;
+}
+
+
--- /dev/null
+/* Loglan82 Compiler&Interpreter
+ Copyright (C) 1993 Institute of Informatics, University of Warsaw
+ Copyright (C) 1993, 1994 LITA, Pau
+
+ 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; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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.
+
+ contacts: Andrzej.Salwicki@univ-pau.fr
+
+or Andrzej Salwicki
+ LITA Departement d'Informatique
+ Universite de Pau
+ Avenue de l'Universite
+ 64000 Pau FRANCE
+ tel. ++33 59923154 fax. ++33 59841696
+
+=======================================================================
+*/
+
+#if MSDOS
+#undef UNIX
+#undef OS2
+#elif UNIX
+#undef OS2
+#elif OS2
+#undef UNIX
+#else
+#error Define one of MSDOS/OS2/UNIX
+#endif
+
+#if WORD_16BIT
+#undef DWORD_16BIT
+#undef WORD_32BIT
+#elif DWORD_16BIT
+#undef WORD_32BIT
+#elif WORD_32BIT
+#undef DWORD_16BIT
+#else
+#error Define one of WORD_16BIT/DWORD_16BIT/WORD_32BIT
+#endif
+
+
+#include <stdio.h>
+#include <malloc.h>
+#include <setjmp.h>
+#include <stdlib.h>
+#include <string.h>
+
+
+typedef struct {
+ char opcode;
+ char args[ 3 ];
+ } extopcode;
+
+typedef char *lword; /* max(word, char *) but in every case was char* */
+
+#define BINARYREAD "rb"
+#define BINARYWRITE "wb"
+#define DIRECTOLD "r+b"
+#define DIRECTNEW "w+b"
+
+
+#if WORD_16BIT
+
+typedef int word;
+typedef float real;
+typedef word *memory;
+
+#if UNIX
+extern char *calloc(int,int);
+#endif
+
+#define mallocate(n) ((memory) (char /*|||huge*/ *) calloc((n),sizeof(word)))
+#define ballocate(n) ((char /*|||huge*/ *) calloc((n),1))
+
+#define MAXINTEGER 0x7FFF
+#define DEFMEMSIZE 0x7FF0 /* 32K words = 64K bytes */
+#define MAXMEMSIZE 0x7FF0 /* 32K words = 64K bytes */
+
+#endif
+
+
+
+#if DWORD_16BIT
+
+typedef long word;
+typedef double real;
+typedef word huge *memory;
+
+#if UNIX
+
+extern char *calloc(int,int);
+
+#define mallocate(n) (((n)<60000)?(memory) calloc((n),sizeof(word)):abort())
+#define ballocate(n) (calloc((n),1))
+
+#define MAXINTEGER 0x7FFFFFFFL
+#define DEFMEMSIZE 0x13C00L /* 79K words = 316K bytes */
+#define MAXMEMSIZE 0x400000L /* 4M words = 16M bytes */
+
+#elif OS2
+
+extern char huge *halloc();
+
+#define mallocate(n) ((memory) halloc((long) (n), sizeof(word)))
+#define ballocate(n) (halloc((long) (n),1L))
+
+#define MAXINTEGER 0x7FFFFFFFL
+#define DEFMEMSIZE 0x13C00L /* 79K words = 316K bytes */
+#define MAXMEMSIZE 0x400000L /* 4M words = 16M bytes */
+
+#define INCL_DOSINFOSEG
+
+#include <os2.h>
+
+#elif MSDOS && TURBOC
+
+extern char far *farcalloc();
+
+#define mallocate(n) ((memory) farcalloc((long) (n), (long) sizeof(word)))
+#define ballocate(n) (farcalloc((long) (n),1L))
+
+#define MAXINTEGER 0x7FFFFFFFL
+#define DEFMEMSIZE 0x14000L /* 80K words = 320K bytes */
+#define MAXMEMSIZE 0x28000L /* 160K words = 640K bytes */
+
+#elif MSDOS
+
+extern void huge *halloc();
+#define mallocate(n) ((memory) halloc((long) (n), sizeof(word)))
+#define ballocate(n) (halloc((long) (n),1))
+
+#define MAXINTEGER 0x7FFFFFFFL
+#define DEFMEMSIZE 0xF000L /* 60K words = 120K bytes */
+#define MAXMEMSIZE 0x28000L /* 160K words = 640K bytes */
+
+#else
+#error Allocation macros not defined.
+#endif
+
+#endif
+
+
+
+#if WORD_32BIT
+
+typedef int word;
+typedef float real;
+typedef word *memory;
+
+#define mallocate(n) ((memory) (char *) calloc((n),sizeof(word)))
+#define ballocate(n) ((char *) calloc((n),1))
+
+/* printf("|%d*4|",(n)),getchar(),\ */
+
+#define MAXINTEGER 0x7FFFFFFFL
+#define DEFMEMSIZE 0x13C00L /* 79K words = 316K bytes */
+#define MAXMEMSIZE 0x400000L /* 4M words = 16M bytes */
+
+#endif
+
+
--- /dev/null
+/**
+ ** EVENTQUE.H
+ **
+ ** Copyright (C) 1992, Csaba Biegl
+ ** 820 Stirrup Dr, Nashville, TN, 37221
+ ** csaba@vuse.vanderbilt.edu
+ **
+ ** This file is distributed under the terms listed in the document
+ ** "copying.cb", available from the author at the address above.
+ ** A copy of "copying.cb" should accompany this file; if not, a copy
+ ** should be available from where this file was obtained. This file
+ ** may not be distributed without a verbatim copy of "copying.cb".
+ ** You should also have received a copy of the GNU General Public
+ ** License along with this program (it is in the file "copying");
+ ** if not, write to the Free Software Foundation, Inc., 675 Mass Ave,
+ ** Cambridge, MA 02139, USA.
+ **
+ ** 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.
+ **/
+
+#ifndef _EVENTQUE_H_
+#define _EVENTQUE_H_
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * structures:
+ * BE CAREFUL when hacking!!! -- 16 and 32 bit compilers have to generate
+ * the same alignments
+ */
+typedef struct {
+ unsigned char evt_type; /* event type: 0: keyboard, 1: mouse */
+ unsigned char evt_kbstat; /* keyboard status (ALT, SHIFT, etc..) */
+ unsigned char evt_mask; /* mouse event mask */
+ unsigned char evt_button; /* button status */
+ unsigned short evt_xpos; /* X coord (or keycode if keybd event) */
+ unsigned short evt_ypos; /* Y coord */
+ unsigned long evt_time; /* time stamp of event */
+#define evt_keycode evt_xpos /* reuse this slot for keybd events !! */
+#define evt_scancode evt_ypos /* store here the BIOS scan code */
+} EventRecord;
+
+typedef struct {
+ unsigned short evq_maxsize; /* max size of event queue */
+ unsigned short evq_cursize; /* number of events in the queue */
+ unsigned short evq_rdptr; /* next event to read */
+ unsigned short evq_wrptr; /* next event to be written */
+ short evq_xpos; /* current X coordinate of mouse */
+ short evq_ypos; /* current Y coordinate of mouse */
+ short evq_xmin; /* minimal mouse X coordinate */
+ short evq_ymin; /* minimal mouse Y coordinate */
+ short evq_xmax; /* maximal mouse X coordinate */
+ short evq_ymax; /* maximal mouse Y coordinate */
+ short evq_xspeed; /* horizontal speed (mickey/coord) */
+ short evq_yspeed; /* vertical speed (mickey/coord) */
+ unsigned short evq_thresh; /* fast movement threshold */
+ unsigned short evq_accel; /* multiplier for fast move */
+ unsigned char evq_drawmouse; /* interrupt handler has to draw mouse */
+ unsigned char evq_moved; /* set if mouse moved */
+ unsigned char evq_delchar; /* character removed from BIOS buffer */
+ unsigned char evq_enable; /* event generation control flag */
+ EventRecord evq_events[1]; /* event buffer space */
+} EventQueue;
+
+/*
+ * event types
+ */
+#define EVENT_KEYBD 0
+#define EVENT_MOUSE 1
+
+/*
+ * MOUSE event flag bits
+ * (also defined in "mousex.h" of the graphics library)
+ */
+#ifndef M_MOTION
+
+#define M_MOTION 0x001
+#define M_LEFT_DOWN 0x002
+#define M_LEFT_UP 0x004
+#define M_RIGHT_DOWN 0x008
+#define M_RIGHT_UP 0x010
+#define M_MIDDLE_DOWN 0x020
+#define M_MIDDLE_UP 0x040
+#define M_BUTTON_DOWN (M_LEFT_DOWN | M_MIDDLE_DOWN | M_RIGHT_DOWN)
+#define M_BUTTON_UP (M_LEFT_UP | M_MIDDLE_UP | M_RIGHT_UP)
+#define M_BUTTON_CHANGE (M_BUTTON_UP | M_BUTTON_DOWN )
+
+/*
+ * MOUSE button status bits
+ */
+#define M_LEFT 1
+#define M_RIGHT 2
+#define M_MIDDLE 4
+
+#endif /* M_MOTION */
+
+/*
+ * KEYBOARD status word bits
+ * (also defined in "mousex.h" of the graphics library)
+ */
+#ifndef KB_SHIFT
+
+#define KB_RIGHTSHIFT 0x01 /* right shift key depressed */
+#define KB_LEFTSHIFT 0x02 /* left shift key depressed */
+#define KB_CTRL 0x04 /* CTRL depressed */
+#define KB_ALT 0x08 /* ALT depressed */
+#define KB_SCROLLOCK 0x10 /* SCROLL LOCK active */
+#define KB_NUMLOCK 0x20 /* NUM LOCK active */
+#define KB_CAPSLOCK 0x40 /* CAPS LOCK active */
+#define KB_INSERT 0x80 /* INSERT state active */
+
+#define KB_SHIFT (KB_LEFTSHIFT | KB_RIGHTSHIFT)
+
+#endif /* KB_SHIFT */
+
+/*
+ * set this bit in 'evq_enable' to generate the corresponding event
+ */
+#define EVENT_ENABLE(type) (1 << (type))
+
+/*
+ * prototypes
+ */
+#if defined(__TURBOC__) && defined(FOR_GO32)
+EventQueue *EventQueueInit(int qsize,int ms_stksize,void (*msdraw)(void),int,int);
+#else
+EventQueue *EventQueueInit(int qsize,int ms_stksize,void (*msdraw)(void));
+#endif
+
+void EventQueueDeInit(void);
+int EventQueueNextEvent(EventQueue *q,EventRecord *e);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* whole file */
+
+
--- /dev/null
+/* Loglan82 Compiler&Interpreter
+ Copyright (C) 1993 Institute of Informatics, University of Warsaw
+ Copyright (C) 1993, 1994 LITA, Pau
+
+ 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; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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.
+
+ contacts: Andrzej.Salwicki@univ-pau.fr
+
+or Andrzej Salwicki
+ LITA Departement d'Informatique
+ Universite de Pau
+ Avenue de l'Universite
+ 64000 Pau FRANCE
+ tel. ++33 59923154 fax. ++33 59841696
+
+=======================================================================
+*/
+
+#include "depend.h"
+#include "genint.h"
+#include "int.h"
+#include "process.h"
+#include "intproto.h"
+
+#include <assert.h>
+
+
+/* Execute one L-code instruction */
+
+
+void execute()
+{
+ word t1, t2;
+ int i;
+ real r;
+ virtaddr virt1, virt2, virt3;
+ switch (opcode)
+ {
+ case 1 : /* LOPENRC */
+ openrc(a3, &virt2, &t2);
+ storevirt(virt2, a1);
+ M[ a2 ] = t2;
+ break;
+
+ case 2 : /* LBACKADDR */
+ storevirt(thisp->backobj, a1);
+ M[ a2 ] = M[ temporary ];
+ break;
+
+ case 3 : /* LRAISE */
+ ic++; /* skip the address */
+ raise_signal(a3, M[ ic-1 ], &t1, &t2);
+ M[ a1 ] = t1;
+ M[ a2 ] = t2;
+ break;
+
+ case 4 : /* LOPEN */
+ openobj(M[ a3 ], &t1, &t2);
+ M[ a1 ] = t1;
+ M[ a2 ] = t2;
+ break;
+
+ case 5 : /* LSLOPEN */
+ loadvirt(virt3, a3);
+ slopen(M[ a3+APREF ], &virt3, &t1, &t2);
+ M[ a1 ] = t1;
+ M[ a2 ] = t2;
+ break;
+
+ case 15 : /* LTHIS */
+ virt1.addr = M[ display2+a2 ];
+ virt1.mark = M[ virt1.addr+1 ];
+ storevirt(virt1, a1);
+ break;
+
+ case 20 : /* LVIRTDISPL */
+ t2 = M[ display+a2 ];
+ t1 = M[ t2+PROTNUM ];
+ M[ a1 ] = M[ prototype[ t1 ]->virtlist+a3 ];
+ break;
+
+ case 21 : /* LSTATTYPE */
+ M[ a1 ] = a2;
+ M[ a1+1 ] = a3;
+ break;
+
+ case 23 : /* LIPAROUT */
+ M[ a1 ] = param[ a3 ].xword;
+ break;
+
+ case 24 : /* LRPAROUT */
+ MR(a1) = param[ a3 ].xreal;
+ break;
+
+ case 25 : /* LVPAROUT */
+ storevirt(param[ a3 ].xvirt, a1);
+ break;
+
+ case 31 : /* LSIGN */
+ if (M[ a2 ] == 0) M[ a1 ] = 0;
+ else
+ if (M[ a2 ] < 0) M[ a1 ] = -1;
+ else M[ a1 ] = 1;
+ break;
+
+ case 33 : /* LLOWER */
+ case 34 :
+ loadvirt(virt2, a2);
+ if (member(&virt2, &t1))
+ {
+ switch ((int) M[ t1+PROTNUM ])
+ {
+ case AINT : t2 = APINT; break;
+ case AREAL : t2 = APREAL; break;
+ case AVIRT : t2 = APREF; break;
+ }
+ M[ a1 ] = (M[ t1+2 ]+3)/t2;
+ }
+ else errsignal(RTEREFTN);
+ break;
+
+ case 35 : /* LUPPER */
+ case 36 :
+ loadvirt(virt2, a2);
+ if (member(&virt2, &t1))
+ {
+ switch ((int) M[ t1+PROTNUM ])
+ {
+ case AINT : t2 = APINT; break;
+ case AREAL : t2 = APREAL; break;
+ case AVIRT : t2 = APREF; break;
+ }
+ M[ a1 ] = (M[ t1+2 ]+M[ t1 ])/t2-1;
+ }
+ else errsignal(RTEREFTN);
+ break;
+
+ case 40 : /* LGETTYPE */
+ typep(M[ a2 ], a3, &virt1.addr, &virt1.mark);
+ storevirt(virt1, a1);
+ break;
+
+ case 41 : /* LCOPY */
+ loadvirt(virt2, a2);
+ copy(&virt2, &virt1);
+ storevirt(virt1, a1);
+ break;
+
+ case 42 : /* LNOT */
+ M[ a1 ] = ~ M[ a2 ];
+ break;
+
+ case 43 : /* LRCVAVIRT */ /* recover virtual address from ah */
+ virt1.addr = M[ a2 ];
+ virt1.mark = M[ virt1.addr+1 ];
+ storevirt(virt1, a1);
+ break;
+
+ case 44 : /* LVIRTDOT */
+ case 45 :
+ M[ a1 ] = M[ prototype[ M[ temporary ] ]->virtlist+a2 ];
+ break;
+
+ case 46 : /* LADDRPH */
+ case 47 : /* LADDRPH2 */
+ /* fprintf(stderr, "co ja tu robie?"); */
+ loadvirt(virt2, a2);
+ if (!member(&virt2, &M[ a1 ])) errsignal(RTEREFTN);
+ break;
+
+ case 48 : /* LIABS */
+ t2 = M[ a2 ];
+ M[ a1 ] = absolute(t2);
+ break;
+
+ case 49 : /* LINEG */
+ M[ a1 ] = -M[ a2 ];
+ break;
+
+ case 50 : /* LRABS */
+ r = MR(a2);
+ if( r < (real)0.0 )
+ r=(real)0.0-r;
+ MR(a1) = r;
+ break;
+
+ case 51 : /* LRNEG */
+ MR(a1) = -MR(a2);
+ break;
+
+ case 52 : /* LPARAMADDR */
+ t2 = M[ a2 ];
+ M[ a1 ] = t2+M[ prototype[ M[ t2+PROTNUM ] ]->parlist+a3 ];
+ break;
+
+ case 54 : /* LLOADT */
+ t1 = M[ ic++ ]; /* offset */
+ t2 = t1+loadt(M[ M[ a2 ] ], a3); /* object address */
+ loadvirt(virt1, t2);
+ storevirt(virt1, a1);
+ break;
+
+ case 55 : /* LIS */
+ loadvirt(virt2, a2);
+ M[ a1 ] = lbool(is(&virt2, a3));
+ break;
+
+ case 56 : /* LIN */
+ loadvirt(virt2, a2);
+ M[ a1 ] = lbool(inl(&virt2, a3));
+ break;
+
+ case 57 : /* LQUA */
+ loadvirt(virt2, a2);
+ if (member(&virt2, &M[ a1 ]))
+ qua(&virt2, a3);
+ else errsignal(RTEREFTN);
+ break;
+
+ case 58 : /* LIFIX */
+ M[ a1 ] = (word)( MR(a2) );
+ break;
+
+ case 59 : /* LFLOAT */
+ MR(a1) = (real)( M[ a2 ] );
+ break;
+
+ case 60 : /* LIMOVE */
+ M[ a1 ] = M[ a2 ];
+ break;
+
+ case 61 : /* LVMOVE */
+ loadvirt(virt1, a2);
+ storevirt(virt1, a1);
+ break;
+
+ case 62 : /* LRMOVE */ /* WARNING: these areas may overlap! */
+ r = MR(a2);
+ MR(a1) = r;
+ break;
+
+ case 63 : /* LFPMOVE */ /* WARNING: these areas may overlap! */
+ loadvirt(virt1, a2); /* MACHINE DEPENDENT */
+ t1 = M[ a2+2 ];
+ storevirt(virt1, a1);
+ M[ a1+2 ] = t1;
+ break;
+
+ case 82 : /* LEQNONE */
+ M[ a1 ] = lbool(M[ a2+1 ] != M[ M[ a2 ]+1 ]);
+ break;
+
+ case 83 : /* LNENONE */
+ M[ a1 ] = lbool(M[ a2+1 ] == M[ M[ a2 ]+1 ]);
+ break;
+
+ case 87 : /* LMDFTYPE */ /* modify the formal type */
+ loadvirt(virt1, a2);
+ virt1.addr += a3; /* number of "arrayof" */
+ storevirt(virt1, a1);
+ break;
+
+ case 100 : /* LOR */
+ M[ a1 ] = M[ a2 ] | M[ a3 ];
+ break;
+
+ case 101 : /* LAND */
+ M[ a1 ] = M[ a2 ] & M[ a3 ];
+ break;
+
+ case 102 : /* LARRAY */
+ case 103 :
+ case 104 :
+ loadvirt(virt2, a2);
+ if (member(&virt2, &t2))
+ {
+ t1 = M[ a3 ]-M[ t2+2 ]; /* index-lower+3 */
+ if (t1 < 3 || t1 >= M[ t2 ]) errsignal(RTEINVIN);
+ else M[ a1 ] = t2+t1;
+ }
+ else errsignal(RTEREFTN);
+ break;
+
+ case 105 : /* LFARRAY */ /* without any tests */
+ t1 = M[ M[ a2 ] ]; /* physical address */
+ M[ a1 ] = t1+M[ a3 ]-M[ t1+2 ];
+ break;
+
+ case 106 : /* LIEQUAL */
+ M[ a1 ] = lbool(M[ a2 ] == M[ a3 ]);
+ break;
+
+ case 107 : /* LINEQUAL */
+ M[ a1 ] = lbool(M[ a2 ] != M[ a3 ]);
+ break;
+
+ case 108 : /* LILT */
+ M[ a1 ] = lbool(M[ a2 ] < M[ a3 ]);
+ break;
+
+ case 109 : /* LILE */
+ M[ a1 ] = lbool(M[ a2 ] <= M[ a3 ]);
+ break;
+
+ case 110 : /* LIGT */
+ M[ a1 ] = lbool(M[ a2 ] > M[ a3 ]);
+ break;
+
+ case 111 : /* LIGE */
+ M[ a1 ] = lbool(M[ a2 ] >= M[ a3 ]);
+ break;
+
+ case 112 : /* LCOMBINE */
+ loadvirt(virt2, a2);
+ t1 = M[ a3 ];
+ storevirt(virt2, a1);
+ M[ a1+APREF ] = t1;
+ break;
+
+ case 113 : /* LIADD */
+ M[ a1 ] = M[ a2 ]+M[ a3 ];
+ break;
+
+ case 114 : /* LISUB */
+ M[ a1 ] = M[ a2 ]-M[ a3 ];
+ break;
+
+ case 115 : /* LIMULT */
+ M[ a1 ] = M[ a2 ] * M[ a3 ];
+ break;
+
+ case 116 : /* LSHIFT */
+ M[ a1 ] = shift(M[ a2 ], M[ a3 ]);
+ break;
+
+ case 117 : /* LIDIVE */
+ if (M[ a3 ] == 0) errsignal(RTEDIVBZ);
+ else M[ a1 ] = M[ a2 ] / M[ a3 ];
+ break;
+
+ case 118 : /* LIMODE */
+ if (M[ a3 ] == 0) errsignal(RTEDIVBZ);
+ else M[ a1 ] = M[ a2 ] % M[ a3 ];
+ break;
+
+ case 119 : /* LRADD */
+ MR(a1) = MR(a2)+MR(a3);
+ break;
+
+ case 120 : /* LRSUB */
+ MR(a1) = MR(a2)-MR(a3);
+ break;
+
+ case 121 : /* LRMULT */
+ MR(a1) = MR(a2) * MR(a3);
+ break;
+
+ case 122 : /* LRDIVE */
+ if (MR(a3) == (real)0.0) errsignal(RTEDIVBZ);
+ else MR(a1) = MR(a2) / MR(a3);
+ break;
+
+ case 123 : /* LEQREF */
+ loadvirt(virt2, a2);
+ loadvirt(virt3, a3);
+ if (member(&virt2, &t1))
+ M[ a1 ] = lbool(member(&virt3, &t2) && t1 == t2);
+ else M[ a1 ] = lbool(!member(&virt3, &t2));
+ break;
+
+ case 124 : /* LNEREF */
+ loadvirt(virt2, a2);
+ loadvirt(virt3, a3);
+ if (member(&virt2, &t1))
+ M[ a1 ] = lbool(!member(&virt3, &t2) || t1 != t2);
+ else M[ a1 ] = lbool(member(&virt3, &t2));
+ break;
+
+ case 125 : /* LREQ */
+ M[ a1 ] = lbool(MR(a2) == MR(a3));
+ break;
+
+ case 126 : /* LRNE */
+ M[ a1 ] = lbool(MR(a2) != MR(a3));
+ break;
+
+ case 127 : /* LRLT */
+ M[ a1 ] = lbool(MR(a2) < MR(a3));
+ break;
+
+ case 128 : /* LRLE */
+ M[ a1 ] = lbool(MR(a2) <= MR(a3));
+ break;
+
+ case 129 : /* LRGT */
+ M[ a1 ] = lbool(MR(a2) > MR(a3));
+ break;
+
+ case 130 : /* LRGE */
+ M[ a1 ] = lbool(MR(a2) >= MR(a3));
+ break;
+
+ case 131 : /* LXOR */
+ M[ a1 ] = M[ a2 ] ^ M[ a3 ];
+ break;
+
+ case 132 : /* LCALLPROCSTAND */
+#if USE_ALARM
+ alarm(0); /* reschedule forced so alarm may be switched off */
+#endif
+ reschedule=TRUE;
+ standard(a1);
+ break;
+
+ case 143 : /* LKILL */
+ loadvirt(virt1, a1);
+ disp(&virt1);
+ break;
+
+ case 144 : /* LHEADS */
+ loadvirt(virt1, a1);
+ heads(&virt1, a2);
+ break;
+
+ case 145 : /* LIPARINP */
+ param[ a3 ].xword = M[ a1 ];
+ break;
+
+ case 146 : /* LGKILL */
+ loadvirt(virt1, a1);
+ gkill(&virt1);
+ break;
+
+ case 147 : /* LVPARINP */
+ loadvirt(param[ a3 ].xvirt, a1);
+ break;
+
+ case 148 : /* LRPARINP */
+ param[ a3 ].xreal = MR(a1);
+ break;
+
+ case 149 : /* LQUATEST */
+ loadvirt(virt1, a1);
+ qua(&virt1, a2);
+ break;
+
+ case 150 : /* LSTYPE */
+ loadvirt(virt1, a1);
+ typref(&virt1, a2);
+ break;
+
+ case 151 : /* LIFFALSE */
+ if (M[ a1 ] == LFALSE) ic = a2;
+ break;
+
+ case 152 : /* LIFTRUE */
+ if (M[ a1 ] == LTRUE) ic = a2;
+ break;
+
+ case 159 : /* LGO */
+ go(M[ a2 ], M[ a1 ]);
+ break;
+
+ case 160 : /* LGOLOCAL */
+ goloc(M[ a2 ], M[ a1 ]);
+ break;
+
+ case 170 : /* LDTYPE */
+ loadvirt(virt1, a1); /* left side type */
+ loadvirt(virt2, a2);
+ loadvirt(virt3, a3); /* right side type */
+ typed(virt1.addr, virt1.mark, virt3.addr, virt3.mark, &virt2);
+ break;
+
+ case 172 : /* LTERMINATE */
+ term();
+ break;
+
+ case 173 : /* LWIND */
+ wind();
+ break;
+
+ case 174 : /* LBLOCK2 */
+ goloc(thisp->blck1, thisp->blck2);
+ break;
+
+ case 176 : /* LBLOCK3 */
+ disp(&thisp->backobj);
+ break;
+
+ case 177 : /* LTRACE */
+ trace(a1);
+ break;
+
+ case 178 : /* LINNER */
+ inner(a1);
+ break;
+
+ case 180 : /* LBACKHD */
+ backhd(&thisp->backobj, &M[ temporary ]);
+ break;
+
+ case 182 : /* LJUMP */
+ ic = a1;
+ break;
+
+ case 186 : /* LBLOCK1 */
+ openobj(a1, &thisp->blck1, &thisp->blck2);
+ break;
+
+ case 187 : /* LDETACH */
+ detach();
+ break;
+
+ case 188 : /* LATTACH */
+ loadvirt(virt1, a1);
+ attach(&virt1);
+ break;
+
+ case 191 : /* LBACKBL */
+ backbl(&thisp->backobj, &M[ temporary ]);
+ break;
+
+ case 192 : /* LBACKPR */
+ /* backpr(&thisp->backobj, &M[ temporary ]); */
+ back(&thisp->backobj, &M[ temporary ], (word) 0);
+ break;
+
+ case 193 : /* LBACK */
+ back(&thisp->backobj, &M[ temporary ], (word) 0);
+ break;
+
+ case 194 : /* LFIN */
+ fin(ic-APOPCODE, &thisp->backobj, &M[ temporary ]);
+ break;
+
+ case 195 : /* LCASE */
+ /* a2 = address of case description : */
+ /* minimal value, number of branches, */
+ /* remaining branches followed by "otherwise" code */
+ t1 = M[ a1 ]-M[ a2 ]; /* in 0..number of branches-1 */
+ if (t1 < 0 || t1 >= M[ a2+1 ])
+ ic = a2+2+M[ a2+1 ]; /* otherwise */
+ else
+ ic = M[ a2+2+t1 ]; /* indirect jump */
+ break;
+
+ case 220 : /* LRESUME */
+ loadvirt(virt1, a1);
+ resume(&virt1);
+ break;
+
+ case 221 : /* LSTOP */
+ passivate(STOPPED);
+ break;
+
+ case 222 : /* LKILLTEMP */
+ disp(&thisp->template);
+ break;
+
+ case 223 : /* LENABLE */
+ for (i = 0; i < a1; i++)
+ enable(thispix, virtprot(M[ ic++ ]));
+ evaluaterpc(thispix);
+ break;
+
+ case 224 : /* LDISABLE */
+ for (i = 0; i < a1; i++)
+ disable(thispix, virtprot(M[ ic++ ]));
+ break;
+
+ case 225 : /* LACCEPT1 */
+ rpc_accept(a1);
+ break;
+
+ case 226 : /* LACCEPT2 */
+ popmask(thispix);
+ rpc3();
+ break;
+
+ case 227 : /* LBACKRPC */
+ back(&thisp->backobj, &M[ temporary ], a1);
+ break;
+
+ case 228 : /* LASKPROT */
+ loadvirt(virt1, a1);
+ askprot(&virt1);
+ break;
+
+ case 240 : /* LSTEP */
+ if (M[ a1 ] < 0) errsignal(RTENEGST);
+ break;
+
+ default :
+ break;
+ }
+}
+
+
--- /dev/null
+/* Loglan82 Compiler&Interpreter
+ Copyright (C) 1993 Institute of Informatics, University of Warsaw
+ Copyright (C) 1993, 1994 LITA, Pau
+
+ 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; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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.
+
+ contacts: Andrzej.Salwicki@univ-pau.fr
+
+or Andrzej Salwicki
+ LITA Departement d'Informatique
+ Universite de Pau
+ Avenue de l'Universite
+ 64000 Pau FRANCE
+ tel. ++33 59923154 fax. ++33 59841696
+
+=======================================================================
+*/
+
+#include "depend.h"
+#include "genint.h"
+#include "int.h"
+#include "process.h"
+#include "intproto.h"
+
+#include <stdio.h>
+
+/* File I/O routines */
+
+void loadfile(status, ftype, am, fp) /* Load parameters of current file */
+word status; /* expected status of file */
+word *ftype; /* file type */
+word *am; /* file object address */
+FILE **fp; /* file stream pointer */
+{
+ word s;
+ virtaddr virt;
+
+ loadvirt(virt, currfile);
+ if (member(&virt, am)) /* file object exists */
+ {
+ s = M[ *am+FSTAT ]; /* check status */
+ if (status != s && status != UNKNOWN) errsignal(RTEILLIO);
+ *ftype = M[ *am+FTYPE ];
+ *fp = MF(*am+FFILE);
+ }
+ else errsignal(RTEREFTN); /* file not opened yet */
+} /* end loadfile */
+
+
+/* Open file object
+ */
+
+void genfileobj(ftemp, ftyp, fnam, virt, am)
+bool ftemp; /* TRUE iff file is temporary */
+word ftyp; /* file type */
+char *fnam; /* file name */
+virtaddr *virt; /* output virtual address */
+word *am; /* output physical address */
+{
+ word t1;
+
+ request((word) APFILE, &t1, am); /* generate file object */
+ virt->addr = t1;
+ virt->mark = M[ t1+1 ];
+ M[ *am+PROTNUM ] = FILEOBJECT;
+ M[ *am+FSTAT ] = UNKNOWN;
+ M[ *am+FTEMP ] = lbool(ftemp);
+ M[ *am+FTYPE ] = ftyp;
+ MN(*am+FNAME) = fnam;
+} /* end genfileobj */
+
+
+void reset(am) /* Prepare file for reading */
+word am;
+{
+ FILE *fp;
+
+ if (M[ am+FSTAT ] != UNKNOWN) /* first close file if opened */
+ if (fclose(MF(am+FFILE))) errsignal(RTEIOERR);
+ switch ((int) M[ am+FTYPE ])
+ {
+ case TEXTF : /* open text file for reading */
+ fp = fopen(MN(am+FNAME), "r");
+ M[ am+FSTAT ] = READING;
+ break;
+
+ case CHARF : /* open binary file for reading */
+ case INTF :
+ case REALF :
+ fp = fopen(MN(am+FNAME), BINARYREAD);
+ M[ am+FSTAT ] = READING;
+ break;
+
+ case DIRECT : /* open existing file for update */
+ fp = fopen(MN(am+FNAME), DIRECTOLD);
+ M[ am+FSTAT ] = UPDATING;
+ break;
+ }
+ if (fp == NULL)
+ {
+ M[ am+FSTAT ] = UNKNOWN;
+ errsignal(RTECNTOP);
+ }
+ MF(am+FFILE) = fp; /* store stream pointer */
+} /* end reset */
+
+
+void rewrite(am) /* Prepare file for writing */
+word am;
+{
+ FILE *fp;
+
+ if (M[ am+FSTAT ] != UNKNOWN) /* first close file if opened */
+ if (fclose(MF(am+FFILE))) errsignal(RTEIOERR);
+
+ switch ((int) M[ am+FTYPE ])
+ {
+ case TEXTF : /* open text file for writing */
+ fp = fopen(MN(am+FNAME), "w");
+ M[ am+FSTAT ] = WRITING;
+ break;
+
+ case CHARF : /* open binary file for writing */
+ case INTF :
+ case REALF :
+ fp = fopen(MN(am+FNAME), BINARYWRITE);
+ M[ am+FSTAT ] = WRITING;
+ break;
+
+ case DIRECT : /* create new file for update */
+ fp = fopen(MN(am+FNAME), DIRECTNEW);
+ M[ am+FSTAT ] = UPDATING;
+ break;
+ }
+ if (fp == NULL)
+ {
+ M[ am+FSTAT ] = UNKNOWN;
+ errsignal(RTECNTOP);
+ }
+ MF(am+FFILE) = fp; /* store stream pointer */
+} /* end rewrite */
+
+
+void delete(virt) /* Delete file */
+virtaddr *virt;
+{
+ word am;
+
+ if (member(virt, &am))
+ {
+ if (M[ am+FSTAT ] != UNKNOWN) /* first close file if opened */
+ if (fclose(MF(am+FFILE))) errsignal(RTEIOERR);
+ if (unlink(MN(am+FNAME))) errsignal(RTEIOERR); /* delete file */
+ free(MN(am+FNAME)); /* free memory used by file name */
+ disp(virt); /* and kill file object */
+ }
+ else errsignal(RTEREFTN);
+} /* end delete */
+
+
+char *tempfilename() /* Generate temporary file name */
+{
+ char *cp;
+ static int tempcnt = 0;
+
+ cp = ballocate(10);
+ if (cp == NULL) errsignal(RTEMEMOV);
+ sprintf(cp, "LOG%05d", tempcnt++);
+ return (cp);
+} /* end tempfilename */
+
+
+bool testeof(fp) /* Test for end of file */
+FILE *fp;
+{
+ int ch;
+
+ ch = getc(fp);
+ ungetc(ch, fp);
+ return (ch == EOF);
+} /* end testeof */
+
+
+bool testeoln(fp) /* Test for end of line */
+FILE *fp;
+{
+ int ch;
+
+ ch = getc(fp);
+ ungetc(ch, fp);
+ return (ch == '\n');
+} /* end testeoln */
+
+
+void readln(fp) /* Skip to end of line */
+FILE *fp;
+{
+ int ch,st;
+ G_MESSAGE msg;
+ if (fp == stdin)
+ {
+ read_line();
+ }
+ else
+ while (ch != '\n' && ch != EOF)
+ ch=getc(fp);
+
+} /* end readln */
+
+
+static char str[10];
+word readint(fp) /* Read integer */
+FILE *fp;
+{
+ long i=0L;
+ int j=0,c=0;
+ int bool=0;
+
+
+ while(c<'0' || c>'9'){
+ if(c=='-') bool=1;
+ else bool=0;
+
+ c=fgetc(fp);
+
+ if(c==EOF){
+ errsignal(RTEBADFM);
+ goto END;
+ }
+ }
+
+ do{
+ i=10*i+(c-'0');
+ j++;
+ c=fgetc(fp);
+ }while(c>='0' && c<='9');
+ if(c!=EOF) ungetc(c,fp);
+ if (j == 0 ) errsignal(RTEBADFM);
+ END:
+ if(bool)
+ return(-i);
+ else
+ return (i);
+} /* end readint */
+
+
+double readreal(fp) /* Read real */
+FILE *fp;
+{
+ double r;
+
+ if (fscanf(fp, "%lf", &r) != 1) errsignal(RTEBADFM);
+ return (r);
+} /* end readreal */
+
+
+void writeint(n, field, fp) /* Write integer */
+word n, field;
+FILE *fp;
+{
+ static char format[ 32 ];
+
+ sprintf(format,"%*ld",(int)field, (long)n);
+ if (fp == stdout) write_str(format); else
+ if (fprintf(fp, "%*ld", (int)field, (long) n) == 0) errsignal(RTEIOERR);
+} /* end writeint */
+
+
+void writereal(r, field1, field2, fp) /* Write real */
+double r;
+word field1, field2;
+FILE *fp;
+{
+ char format[ 32 ];
+
+ sprintf(format, "%*.*lf", (int) field1, (int) field2,r);
+ if (fp == stdout) write_str(format); else
+ if (fprintf(fp,"%*.*lf", (int)field1, (int)field2, r) == 0)
+ errsignal(RTEIOERR);
+} /* end writereal */
+
+
+void writestring(offset, field, fp) /* Write string */
+word offset;
+word field;
+FILE *fp;
+{
+ word len, addr;
+ int i;
+ char *cp;
+ char s[256];
+
+ addr = strings+offset;
+ len = M[ addr ];
+ cp = (char *) &M[ addr+1 ]; /* pointer to first char of string */
+ if (fp == stdout)
+ {
+ for(i=0;i<len;i++) s[i] = *cp++;
+ s[len] = '\0';
+ write_str(s);
+ } else
+ while (len-- > 0 && field-- != 0)
+ if (putc(*cp++, fp) == EOF) errsignal(RTEIOERR);
+} /* end writestring */
+
+
+word directio(buf, len, action, fp) /* Perform direct access read/write */
+virtaddr *buf; /* buffer array */
+word len; /* number of bytes to transfer */
+#ifndef NO_PROTOTYPES
+int (*action)(char *,int,int,FILE *); /* fread() or fwrite() */
+#else
+int (*action)(); /* fread() or fwrite() */
+#endif
+FILE *fp; /* stream pointer */
+{
+ word am, t1, result;
+ int n;
+
+ if (member(buf, &am)) /* file not none */
+ {
+ if (fseek(fp, 0L, 1)) errsignal(RTEIOERR); /* seek to current */
+ /* position required */
+ len = min(len, (M[ am ]-3)*sizeof(word)); /* check appetite */
+ result = 0; /* number of bytes transfered */
+ t1 = am+3; /* address in memory for transfer */
+ while (len >= IOBLOCK) /* transfer full blocks */
+ {
+ n = (*action)((char *) &M[ t1 ], 1, IOBLOCK, fp);
+ result += n;
+ if (n != IOBLOCK) return(result);
+ len -= IOBLOCK;
+ t1 += IOBLOCK/sizeof(word);
+ }
+ if (len > 0) /* transfer last unfilled block */
+ {
+ n = (*action)((char *) &M[ t1 ], 1, (int) len, fp);
+ result += n;
+ }
+ return(result);
+ }
+ else errsignal(RTEREFTN);
+} /* end directio */
+
--- /dev/null
+/* Loglan82 Compiler&Interpreter
+ Copyright (C) 1993 Institute of Informatics, University of Warsaw
+ Copyright (C) 1993, 1994 LITA, Pau
+
+ 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; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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.
+
+ contacts: Andrzej.Salwicki@univ-pau.fr
+
+or Andrzej Salwicki
+ LITA Departement d'Informatique
+ Universite de Pau
+ Avenue de l'Universite
+ 64000 Pau FRANCE
+ tel. ++33 59923154 fax. ++33 59841696
+
+=======================================================================
+*/
+
+#ifdef GEN
+#undef GEN
+#endif
+
+#include "genint1.h"
+
+
+/* Variables : */
+
+extern protdescr *prototype[];
+extern word ipradr; /* address of primitive type descriptions */
+extern word temporary; /* address of global temporary variables */
+extern word strings; /* base for string constants */
+extern word lastprot; /* the last used prototype number */
+extern word freem; /* first free cell in M */
+extern word currfile; /* current file virtual address */
+
--- /dev/null
+/* Loglan82 Compiler&Interpreter
+ Copyright (C) 1993 Institute of Informatics, University of Warsaw
+ Copyright (C) 1993, 1994 LITA, Pau
+
+ 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; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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.
+
+ contacts: Andrzej.Salwicki@univ-pau.fr
+
+or Andrzej Salwicki
+ LITA Departement d'Informatique
+ Universite de Pau
+ Avenue de l'Universite
+ 64000 Pau FRANCE
+ tel. ++33 59923154 fax. ++33 59841696
+
+=======================================================================
+*/
+
+#if GEN
+#define word address
+#endif
+
+
+/* Appetites of values : */
+#define APINT 1 /* integer,boolean,string,char */
+#define APREAL sizeof(real)/sizeof(word) /* real */
+#define APVIRT 4 /* TO TELL APART A VIRTUAL ADDRESS */
+ /* (ANY REFERENCE TYPE) FROM ANY OTHER TYPE */
+#define APREF 2 /* ACTUAL SIZE OF REFERENCE TYPE */
+#define APFMTYPE 2 /* FORMAL TYPE VALUE */
+#define APFMPROC 3 /* FORMAL PROCEURE OR FUNCTION VALUE, = APREF+1*/
+#define APOPCODE (sizeof(extopcode)+sizeof(word)-1)/sizeof(word)
+
+
+typedef int bool;
+#define FALSE 0
+#define TRUE 1
+
+
+/* Values identifying types and formal parameters : */
+
+#define FORMFUNC 7 /* parameter "function" */
+#define FORMPROC 8 /* parameter "procedure" */
+#define FORMTYPE 9 /* parameter "type", also formal type */
+#define PARIN 11 /* parameter "input" */
+#define PAROUT 12 /* parameter "output" */
+#define PARINOUT 16 /* parameter "inout" */
+#define PUREPROCESS 13 /* type PROCESS */
+#define PURECOROUTINE 14 /* type COROUTINE */
+#define PRIMITIVETYPE 15 /* simple type */
+#define CLASSTYPE 17 /* class type */
+#define FILETYPE 18 /* file type */
+
+
+/* Values to identify kinds of array elements : */
+
+#define AINT -1 /* arrayof integer */
+#define AREAL -3 /* arrayof real */
+#define AVIRT -2 /* arrayof reference */
+#define APROCESS -4 /* process reference implemented as arrayof */
+#define FILEOBJECT -11 /* file object */
+#define SKILLED -99 /* killed object, only for compactification */
+
+
+#define DUMMY -1 /* dummy unit or prefix : SL for main block */
+#define MAINBLOCK 0 /* main block prototype number */
+#define MAXPROT 500 /* limit for the number of prototypes */
+
+
+/* L-code instruction addressing modes : */
+
+#define GLOBAL 0 /* M[ N ] */
+#define LOCAL 1 /* M[ c1+N ] */
+#define TEMPLOCAL 2 /* M[ c2+N ] */
+#define REMOTE 3 /* M[ M[ K ]+N ] */
+#define INDIRECT 4 /* M[ M[ N ] ] */
+#define IMMEDIATE 5 /* N */
+#define CONSTANT 6 /* M[ N ] */
+#define DOTACCESS 7 /* M[ M[ display+K ]+N ] */
+#define NOARGUMENT 8 /* ------ */
+
+
+/* Prototype kind : */
+
+#define CLASS 0
+#define RECORD 1
+#define COROUTINE 2
+#define PROCESS 3
+#define BLOCK 4
+#define PREFBLOCK 5
+#define FUNCTION 6
+#define PROCEDURE 7
+#define HANDLER 8
+
+#if GEN
+#define LRECORD RECORD
+#define LFUNCTION FUNCTION
+#define LPROCEDURE PROCEDURE
+#endif
+
+
+#if GEN
+typedef int protaddr ; /* mainblock..maxprot ; mainblock = 0; */
+ /* INDIRECT ADDRESS OF PROTOTYPE */
+typedef int dprotaddr ; /* PROTADDR + DUMMY */
+typedef int protkind ;
+#else
+#define protaddr int
+#define dprotaddr int
+#define protkind int
+#endif
+
+
+/* Prototype : */
+
+typedef struct {
+ dprotaddr slprototype ; /* PROTOTYPE OF SYNTACTIC FATHER */
+ /* OR DUMMY FOR THE MAIN BLOCK */
+ word codeaddr; /* address of code */
+ word appetite; /* object's total length */
+ word span; /* distance from beginning of object to */
+ /* temporary reference variables */
+ word reflist; /* beginning and length of table with */
+
+ int lthreflist; /* offsets of reference values in object; */
+ /* without SL, DL, CL and temporary values */
+ word parlist; /* beginning and length of table with */
+ int lthparlist; /* offsets of parameters */
+
+ word preflist; /* beginning and length of table with */
+ int lthpreflist; /* prototype numbers of prefix sequence */
+
+ word lastwill; /* lastwill code address */
+ word handlerlist; /* list of handlers, 0 if empty */
+ word virtlist; /* address of table for conversion: */
+ /* virtual number --> prototype */
+
+ /* only for processes : */
+ protaddr maskbase ; /* lowest procedure prototype number */
+ int masksize ; /* size of RPC mask for that process */
+
+ /* for procedures and functions */
+ int virtnumber; /* virtual number or -1 if not virtual */
+
+ /* for all : */
+ protkind kind ; /* kind of unit */
+
+ /* only for procedures, functions and processes : */
+ word pfdescr; /* address of table with parameters descr. addresses */
+
+ /* only for functions : */
+ int nrarray;
+ word finaltype; /* type of result */
+
+} protdescr,*pointprdsc;
+
+
--- /dev/null
+#include "depend.h"
+#include "genint.h"
+#include "int.h"
+#include "process.h"
+#include "intproto.h"
+
+/* Handler routines */
+
+/* Pataud le 13-06-1995
+#if !NO_GRAPH ||!DJE
+#if MSDOS
+#include "graf\graf.h"
+#else
+#include "graf/graf.h"
+#endif
+#endif
+*/
+
+void errsignal(exception)
+int exception;
+{
+ word signum, ah, am;
+
+
+ signum = scot[ exception ];
+ /* A.Salwicki 30 pazdz. 2002 *
+ fprintf(stderr, "\n signum= %ld\n", signum);
+
+ * fprintf(stderr, " Wlazl kotek"); *
+
+
+ if (signum != -1) * attempt to call a handler *
+ {
+
+ raise_signal(signum, (word) 0, &ah, &am);
+ fprintf(stderr, "\n ic= %ld\n", ic);
+
+ /* if (ic != 0) /* continue execution *
+ {
+ go(ah, am);
+ longjmp(contenv, 1);
+ } *
+ }
+ */
+
+/* A. Salwicki 27-10-2002
+#if MSDOS && !NO_GRAPH
+ {
+ extern bool graphmode;
+
+ if (graphmode) groff();
+ graphmode = FALSE;
+ }
+#endif
+*/
+
+ putc('\n', stderr);
+ switch (exception)
+ {
+ case RTESLCOF: fprintf(stderr, " SL CHAIN CUT OFF"); break;
+ case RTEUNSTP: fprintf(stderr, " UNIMPLEMENTED STANDARD PROCEDURE"); break;
+ case RTEILLAT: fprintf(stderr, " ILLEGAL ATTACH"); break;
+ case RTEILLDT: fprintf(stderr, " ILLEGAL DETACH"); break;
+ case RTECORTM: fprintf(stderr, " COROUTINE TERMINATED"); break;
+ case RTECORAC: fprintf(stderr, " COROUTINE ACTIVE"); break;
+ case RTEINVIN: fprintf(stderr, " ARRAY INDEX ERROR"); break;
+ case RTEILLAB: fprintf(stderr, " INCORRECT ARRAY BOUNDS"); break;
+ case RTEINCQA: fprintf(stderr, " IMPROPER QUA"); break;
+ case RTEINCAS: fprintf(stderr, " ILLEGAL ASSIGNMENT"); break;
+ case RTEFTPMS: fprintf(stderr, " FORMAL TYPE MISSING"); break;
+ case RTEILLKL: fprintf(stderr, " ILLEGAL KILL"); break;
+ case RTEILLCP: fprintf(stderr, " ILLEGAL COPY"); break;
+ case RTEINCHS: fprintf(stderr, " INCOMPATIBLE HEADERS"); break;
+ case RTEHNDNF: fprintf(stderr, " HANDLER NOT FOUND"); break;
+ case RTEMEMOV: fprintf(stderr, " MEMORY OVERFLOW"); break;
+ case RTEFHTLG: fprintf(stderr, " FORMAL LIST TOO LONG"); break;
+ case RTEILLRT: fprintf(stderr, " ILLEGAL RETURN"); break;
+ case RTEREFTN: fprintf(stderr, " REFERENCE TO NONE"); break;
+ case RTEDIVBZ: fprintf(stderr, " DIVISION BY ZERO"); break;
+ case RTESYSER: fprintf(stderr, " SYSTEM ERROR"); break;
+ case RTEILLIO: fprintf(stderr, " ILLEGAL I/O OPERATION"); break;
+ case RTEIOERR: fprintf(stderr, " I/O ERROR"); break;
+ case RTECNTOP: fprintf(stderr, " CANNOT OPEN FILE"); break;
+ case RTEBADFM: fprintf(stderr, " INPUT DATA FORMAT BAD"); break;
+ case RTEILLRS: fprintf(stderr, " ILLEGAL RESUME"); break;
+ case RTETMPRC: fprintf(stderr, " TOO MANY PROCESSES ON ONE MACHINE"); break;
+ case RTEINVND: fprintf(stderr, " INVALID NODE NUMBER"); break;
+ case RTENEGST: fprintf(stderr, " NEGATIVE STEP VALUE"); break;
+ case RTENONGL: fprintf(stderr, " REFERENCE TO GLOBAL NON PROCESS OBJECT FROM PROCESS"); break;
+ default : fprintf(stderr, " UNRECOGNIZED ERROR");
+ }
+ if (thisp->trlnumber < 0) thisp->trlnumber = - thisp->trlnumber;
+ if (thisp->trlnumber != 0)
+ fprintf(stderr, "\n AT LINE: %ld\n", (long) thisp->trlnumber);
+ endprocess(4);
+} /* end errsignal */
+
+
+void raise_signal(signal, skip, ahnew, amnew) /* Raise exception */
+word signal, skip;
+word *ahnew, *amnew;
+{
+ word t1, t2, t3, t4, t5, virts;
+ protdescr *ptr;
+
+ t1 = 0; /* handler for others = no */
+ t2 = M[ display2+M[ c1+PROTNUM ] ]; /* ah of current */
+ t3 = c1; /* am of current */
+ t5 = 0; /* flag handler not found */
+ do
+ {
+ ptr = prototype[ M[ t3+PROTNUM ] ]; /* prototype of current */
+ t4 = ptr->handlerlist;
+ if (t4 != 0) /* any handlers ? */
+ {
+ do
+ {
+ t5 = M[ t4 ]; /* signal number */
+ if (t5 != signal)
+ {
+ if (t5 == 0 && t1 == 0) t1 = t4;
+ t4 = M[ t4+2 ];
+ }
+ } while (t5 != signal && t4 != 0);
+ }
+ if (t5 != signal) /* look in DL or SL */
+ {
+ if (t1 != 0) t4 = t1; /* handler for others found */
+ else
+ {
+ t4 = t3+M[ t3 ];
+ if (ptr->kind == HANDLER)
+ t2 = M[ t4+SL ]; /* use SL for handlers */
+ else
+ t2 = M[ t4+DL ]; /* or DL for other goodies */
+ if (t2 == 0) /* handler not found */
+ {
+ if (signal <= MAXSYSSN)
+ { /* system signal */
+ ic = skip;
+ if (ic != 0) longjmp(contenv, 1);
+ else return;
+ }
+ else errsignal(RTEHNDNF);
+ }
+ t3 = M[ t2 ];
+ }
+ }
+ else t1 = 0;
+ } while (t1 == 0 && t5 != signal);
+
+ virts = thisp->prochead+M[ thisp->prochead ]+VIRTSC;
+ M[ virts ] = t2; /* compactification possible */
+ M[ virts+1 ] = M[ t2+1 ];
+ t3 = M[ t4+1 ]; /* prototype number of handler */
+ t5 = prototype[ t3 ]->appetite;
+ if (t1 != 0) /* others */
+ {
+ request(t5, ahnew, amnew);
+ M[ *amnew+M[ *amnew ]+SIGNR ] = 0;
+ }
+ else
+ {
+ if (signal == scot[ RTEMEMOV ] &&
+ thisp->lastitem-thisp->lastused-1 < t5)
+ {
+ scot[ RTEMEMOV ] = -1; /* make memov look like abort */
+ errsignal(RTEMEMOV);
+ }
+ request(t5, ahnew, amnew);
+ M[ *amnew+M[ *amnew ]+SIGNR ] = signal;
+ }
+ M[ *amnew+PROTNUM ] = t3; /* provide system attributes */
+ t5 = *amnew+M[ *amnew ];
+ M[ t5+SL ] = M[ virts ];
+ M[ t5+SL+1 ] = M[ virts+1 ];
+ t2 = M[ display2+M[ c1+PROTNUM ] ]; /* ah of current */
+ M[ t5+DL ] = t2;
+ M[ t5+DL+1 ] = M[ t2+1 ];
+ if (t1 != 0) /* skip */
+ {
+ ic = skip;
+ go(*ahnew, *amnew);
+ }
+} /* end raise_signal */
+
+
+void wind()
+{
+ word t1, t2;
+
+ t1 = M[ M[ c1+M[ c1 ]+SL ] ]; /* am of handlers' SL */
+ t2 = c1; /* current */
+ while (TRUE)
+ {
+ t2 = M[ M[ t2+M[ t2 ]+DL ] ]; /* am of DL */
+ if (t2 == t1) break;
+ M[ t2+M[ t2 ]+LSC ] = prototype[ M[ t2+PROTNUM ] ]->lastwill;
+ }
+ back(&thisp->backobj, &M[ temporary ], (word) 0);
+} /* end wind */
+
+
+void term()
+{
+ word t1;
+
+ t1 = M[ M[ c1+M[ c1 ]+SL ] ]; /* am of handlers' SL */
+ M[ t1+M[ t1 ]+LSC ] = prototype[ M[ t1+PROTNUM ] ]->lastwill;
+ wind();
+} /* end term */
+
+
+/* This wraps up the above series of the handler procedures.
+ */
+
+void backhd(virt, am)
+virtaddr *virt;
+word *am;
+{
+ if (M[ c1+M[ c1 ]+SIGNR ] <= MAXSYSSN)
+ errsignal(RTEILLRT); /* illegal return */
+ else
+ back(virt, am, (word) 0);
+} /* end backhd */
--- /dev/null
+#include "../head/comm.h"
+
+#define MAXMARKER MAXINTEGER /* maximum special value of mark */
+#define MAXAPPT MAXINTEGER /* maximum appetite (easily extensible ?) */
+#define MAXTRACNT 13 /* maximum number of trace messages in line */
+#define MAXHDLEN 40 /* maximum length of formal procedure header */
+#define MAXSYSSN 62 /* maximum number of a system signal */
+#define MAXPARAM 10 /* maximum number of params to standard proc */
+#define IOBLOCK 0x4000 /* size of I/O transfer block in bytes */
+
+/* Object structure : */
+
+/* Offsets from the beginning : */
+#define PROTNUM 1 /* prototype number */
+#define SHORTLINK 1 /* link to same size list (killed only) */
+#define LONGLINK 2 /* link to other size list (killed only) */
+
+/* Files : */
+/* appetite 0 */
+/* prot number 1 always FILEOBJECT */
+#define FSTAT 2 /* file status */
+#define FTEMP 3 /* flag to tell if file is temporary */
+#define FTYPE 4 /* file type */
+#define FNAME 5 /* file name pointer */
+#define FFILE (FNAME+sizeof(char *)/sizeof(word)) /*file handle */
+#define APFILE (FFILE+sizeof(FILE *)/sizeof(word)) /*appetite of file*/
+ /* object */
+
+/* Offsets from the first address after object : */
+#define SL -2 /* static link */
+#define DL -4 /* dynamic link */
+#define LSC -5 /* local control */
+#define STATSL -6 /* number of times the object occurs in SL */
+#define SIGNR -7 /* signal number (handlers only) */
+#define RPCDL -8 /* remote dynamic link (procedures only) */
+#define CL -8 /* coroutine link (coroutine only) */
+#define CHD -10 /* coroutine head (process only) */
+#define VIRTSC -12 /* virtual scratch (process only) */
+
+/* Virtual address (also formal type) : */
+
+typedef struct {
+ word addr; /* address of dictionary item */
+ /* (node and process index for processes) */
+ /* (or for formal types - number of arrayof) */
+ word mark; /* address mark */
+ /* (negative for processes) */
+ /* (or for formal types - actual type) */
+ } virtaddr;
+
+#define loadvirt(v, a) { word ta; \
+ ta = (a); \
+ (v).addr = M[ ta++ ]; \
+ (v).mark = M[ ta ]; }
+#define storevirt(v, a) { word ta; \
+ ta = (a); \
+ M[ ta++ ] = (v).addr; \
+ M[ ta ] = (v).mark; }
+
+#define MF(a) (*( (FILE **) (M+(a)) ))
+#define MN(a) (*( (char **) (M+(a)) ))
+#define MR(a) *( (real *) (M+(a)) )
+
+
+#ifdef max
+#undef max
+#endif
+
+#ifdef min
+#undef min
+#endif
+
+#define min(x, y) ((x) < (y) ? (x) : (y))
+#define max(x, y) ((x) > (y) ? (x) : (y))
+#define absolute(x) ((x) >= 0 ? (x) : -(x))
+
+/* LOGLAN's booleans : */
+#define LFALSE ((word)0)
+#define LTRUE (~LFALSE)
+#define lbool(b) ( (b) ? LTRUE : LFALSE )
+
+/* Type of files : */
+#define TEXTF 1 /* text file */
+#define CHARF 2 /* file of char */
+#define INTF 3 /* file of integer */
+#define REALF 4 /* file of real */
+#define DIRECT 5 /* direct access file */
+
+/* File status : */
+#define READING 0 /* sequential file opened for read */
+#define WRITING 1 /* sequential file opened for write */
+#define UPDATING 2 /* direct access file */
+#define UNKNOWN 3 /* file not opened */
+
+/* Run time error types : */
+
+#define RTESLCOF 0 /* SL chain cut off */
+#define RTEUNSTP 1 /* unimplemented standard procedure */
+#define RTEILLAT 2 /* illegal attach */
+#define RTEILLDT 3 /* illegal detach */
+#define RTECORTM 4 /* coroutine terminated */
+#define RTECORAC 5 /* coroutine active */
+#define RTEINVIN 6 /* array index error */
+#define RTEILLAB 7 /* incorrect array bounds */
+#define RTEINCQA 8 /* improper QUA */
+#define RTEINCAS 9 /* illegal assignment */
+#define RTEFTPMS 10 /* formal type missing */
+#define RTEILLKL 11 /* illegal kill */
+#define RTEILLCP 12 /* illegal copy */
+#define RTEINCHS 13 /* incompatible headers */
+#define RTEHNDNF 14 /* handler not found */
+#define RTEMEMOV 15 /* memory overflow */
+#define RTEFHTLG 16 /* formal header too long */
+#define RTEILLRT 17 /* illegal return */
+#define RTEREFTN 18 /* reference to NONE */
+#define RTEDIVBZ 19 /* division by zero */
+#define RTESYSER 20 /* system error */
+#define RTEILLIO 21 /* illegal I/O operation */
+#define RTEIOERR 22 /* I/O error */
+#define RTECNTOP 23 /* Cannot open file */
+#define RTEBADFM 24 /* Input data format bad */
+#define RTEILLRS 25 /* illegal resume */
+#define RTETMPRC 26 /* too many processes on one machine */
+#define RTEINVND 27 /* invalid node number */
+#define RTENEGST 28 /* negative step value */
+#define RTENONGL 29 /* only process may be global */
+
+union value {
+ unsigned int xint;
+ word xword;
+ real xreal;
+ virtaddr xvirt;
+ word xbool;
+ };
+
+#define MAXINSTANCE 255
+
+/* Variables : */
+
+extern memory M; /* main memory for code and data */
+extern union value *param; /* pointer to standard proc. param list */
+extern int offset[]; /* offset conversion table for compact. */
+extern int scot[]; /* signal to number conversion table */
+extern int primapet[]; /* appetites of primitive types */
+extern word ic; /* instruction counter */
+extern word lastic; /* previous ic for redecoding after comp. */
+extern int opcode; /* opcode of L-code instruction */
+extern word a1, a2, a3; /* arguments of L-code instruction */
+
+/* kernel variables for the running system */
+
+extern word memorysize; /* size of memory array for code and data */
+extern word dispoff; /* DISPLAY offset in process object */
+extern word disp2off; /* indirect DISPLAY offset in process object */
+extern word display; /* DISPLAY address - physical addresses */
+extern word display2; /* DISPLAY address - indirect addresses */
+extern word c1, c2; /* pointers to current object */
+extern word mainprog; /* main block object */
+extern word mnoff; /* offset of variable main */
+
+
+extern bool infmode; /* TRUE if compactification message printed */
+extern bool debug; /* TRUE if trace is printed */
+extern FILE *tracefile; /* output file for trace */
+bool graphics; /* is graphics active ? */
+
+extern jmp_buf contenv; /* for continue execution */
+
+extern int internal_sock,graph_sock,net_sock;
+extern int connected;
+extern int GraphRes;
+extern int fcol;
+extern int bcol;
+extern int curx;
+extern int cury;
+extern char ProgName[255];
+extern ctx_struct my_ctx;
+extern void send_to_graph(G_MESSAGE*);
+extern int read_from_graph(G_MESSAGE*);
+extern int read_from_net(MESSAGE*);
+extern char mygname[80],mykname[80],mynname[80];
+extern int DirConn[MAXINSTANCE];
--- /dev/null
+#include "depend.h"
+#include "genint.h"
+#include "int.h"
+#include "process.h"
+#include "intproto.h"
+
+/* Variables common with generator : */
+
+protdescr *prototype[ MAXPROT+1 ]; /* prototypes */
+word ipradr; /* address of primitive types descriptions */
+word temporary; /* address of global temporary variables */
+word strings; /* base for string constants */
+word lastprot; /* the last used prototype number */
+word freem; /* first free cell in M */
+word currfile = 2; /* current file virtual address */
+
+/* Interpreter own variables : */
+
+memory M; /* main memory for code and data */
+union value *param; /* for comunication with standard procs */
+
+/* offset conversion table for compactification */
+int offset[] = { DUMMY, SL, DL, CL, CHD, VIRTSC };
+
+/* signal to number conversion table */
+/* -1 stands for an unrecoverable error which cannot be serviced by handler */
+
+int scot[] =
+{
+ 20, /* RTESLCOF */
+ 20, /* RTEUNSTP */
+ 20, /* RTEILLAT */
+ 20, /* RTEILLDT */
+ 20, /* RTECORTM */
+ 20, /* RTECORAC */
+ 23, /* RTEINVIN */
+ 23, /* RTEILLAB */
+ 21, /* RTEINCQA */
+ 24, /* RTEINCAS */
+ 20, /* RTEFTPMS */
+ 20, /* RTEILLKL */
+ 20, /* RTEILLCP */
+ 24, /* RTEINCHS */
+ -1, /* RTEHNDNF */
+ 22, /* RTEMEMOV */
+ 22, /* RTEFHTLG */
+ -1, /* RTEILLRT */
+ 21, /* RTEREFTN */
+ 01, /* RTEDIVBZ */
+ 02, /* RTESYSER */
+ 02, /* RTEILLIO */
+ 02, /* RTEIOERR */
+ 02, /* RTECNTOP */
+ 02, /* RTEBADFM */
+ 20, /* RTEILLRS */
+ 02, /* RTETMPRC */
+ 02, /* RTEINVND */
+ 23, /* RTENEGST */
+ -1 /* RTENONGL */
+};
+
+/* Primitive type appetites for moveparams() : */
+
+int primapet[] =
+{
+ APINT, /* INTEGER */
+ APREAL, /* REAL */
+ APINT, /* BOOLEAN */
+ APINT, /* CHAR */
+ APREF, /* COROUTINE */
+ APREF, /* PROCESS */
+ APINT /* STRING */
+};
+
+word ic; /* instruction counter */
+word lastic; /* previous ic for redecoding after compact. */
+int opcode; /* opcode of L-code instruction */
+word a1, a2, a3; /* arguments of L-code instructions */
+
+/* kernel variables for the running system: */
+
+word memorysize = DEFMEMSIZE; /* code and data memory size */
+word c1, c2; /* pointers to current object */
+word dispoff; /* DISPLAY offset in process object */
+word disp2off; /* indirect DISPLAY offset in process object */
+word display; /* DISPLAY address - physical addresses */
+word display2; /* DISPLAY address - indirect addresses */
+word mainprog; /* main block object */
+word mnoff; /* offset of variable main */
+
+
+bool infmode = FALSE; /* default: no compactification message */
+bool debug = FALSE; /* TRUE if trace is printed */
+FILE *tracefile; /* output file for trace */
+
+jmp_buf contenv; /* for continue execution */
--- /dev/null
+#ifndef NO_PROTOTYPES
+
+unsigned alarm( unsigned );
+double prandom( void );
+
+void openrc(word,virtaddr *,word *);
+void raise_signal(word,word,word *,word *);
+void openobj(word,word *,word *);
+void slopen(word,virtaddr *,word *,word *);
+void errsignal(int);
+void typep(word,word,word *,word *);
+void copy(virtaddr *,virtaddr *);
+void qua(virtaddr *,word);
+void standard(word);
+void disp(virtaddr *);
+void gkill(virtaddr *);
+void typref(virtaddr *,word);
+void go(word,word);
+void goloc(word,word);
+void typed(word,word,word,word,virtaddr *);
+void term(void);
+void wind(void);
+void trace(word);
+void inner(word);
+void backhd(virtaddr *,word *);
+void backbl(virtaddr *,word *);
+void backpr(virtaddr *,word *);
+void back(virtaddr *,word *,word);
+void detach(void);
+void attach(virtaddr *);
+void fin(word,virtaddr *,word *);
+void heads(virtaddr *,word);
+void resume(virtaddr *);
+void passivate(int);
+void enable(word,word);
+void evaluaterpc(word);
+void disable(word,word);
+void rpc_accept(word);
+void rpc3(void);
+void popmask(word);
+void askprot(virtaddr *);
+bool member(virtaddr *,word *);
+word virtprot(word);
+word loadt(word,word);
+bool is(virtaddr *,word);
+bool inl(virtaddr *,word);
+word shift(word,word);
+void execute(void);
+void abend(char *);
+void addext(char *,char *);
+void usage( void );
+void decode( void );
+void init_scheduler( void );
+void runsys( void );
+void schedule( void );
+void msginterrupt( message * );
+void loosen( void );
+void update( word, word );
+void compactify( void );
+void moveparams(word, word, message *, int, int);
+void sendmsg1(message *);
+word getnode(word);
+void endprocess(int);
+word entier(double);
+char *asciiz( virtaddr * );
+void ranset(void);
+void moveblock( char *,char *, word );
+void request( word, word *, word *);
+word memavail( void );
+void newarry( word, word, word, virtaddr *, word *);
+void initprocess( word,word,procaddr *);
+void activate( word );
+void reset( word );
+void pushmask( word );
+void trapmsg( void );
+void rpc2( void );
+void endrun( int );
+void loadfile(word,word *,word *,FILE **);
+word directio(virtaddr *,word,int (*)(),FILE *);
+void nonstandard( word );
+void genfileobj(bool,word,char *,virtaddr *,word *);
+void rewrite( word );
+void delete( virtaddr * );
+bool testeof( FILE * );
+bool testeoln( FILE * );
+char *tempfilename( void );
+word readint( FILE * );
+double readreal( FILE * );
+void writeint( word, word, FILE * );
+void writereal( double, word, word, FILE * );
+void writestring( word, word, FILE * );
+void readln( FILE * );
+void senderr( int, procaddr * );
+void rpcend( message * );
+void rpc1( message * );
+void handle_message(MESSAGE*);
+int check_port(MESSAGE*);
+void send_to_kernel(MESSAGE*);
+void writeln_str(char*);
+void write_str(char*);
+void write_char(char);
+char read_char();
+void read_str(char*);
+
+
+
+#else
+
+unsigned alarm();
+int unlink();
+int ioctl();
+
+void openrc();
+void raise_signal();
+void openobj();
+void slopen();
+void errsignal();
+void typep();
+void copy();
+void qua();
+void standard();
+void disp();
+void gkill();
+void typref();
+void go();
+void goloc();
+void typed();
+void term();
+void wind();
+void trace();
+void inner();
+void backhd();
+void backbl();
+void backpr();
+void back();
+void detach();
+void attach();
+void fin();
+void heads();
+void resume();
+void passivate();
+void enable();
+void evaluaterpc();
+void disable();
+void rpc_accept();
+void rpc3();
+void popmask();
+void askprot();
+bool member();
+word virtprot();
+word loadt();
+bool is();
+bool inl();
+word shift();
+void execute();
+void abend();
+void addext();
+void usage();
+void decode();
+void init_scheduler();
+void runsys();
+void schedule();
+void msginterrupt();
+void loosen();
+void update();
+void compactify();
+void moveparams();
+void sendmsg();
+word getnode();
+void endprocess();
+word entier();
+char *asciiz();
+void ranset();
+double prandom();
+void moveblock();
+void request();
+word memavail();
+void newarry();
+void initprocess();
+void activate();
+void pushmask();
+void trapmsg();
+void rpc2();
+void endrun();
+void loadfile();
+word directio();
+void nonstandard();
+void genfileobj();
+void reset();
+void rewrite();
+void delete();
+bool testeof();
+bool testeoln();
+char *tempfilename();
+word readint();
+double readreal();
+void writeint();
+void writereal();
+void writestring();
+void readln();
+void senderr();
+void rpcend();
+void rpc1();
+
+#endif
+
--- /dev/null
+#include "depend.h"
+#include "genint.h"
+#include "int.h"
+#include "process.h"
+#include "intproto.h"
+
+/* Memory management routines */
+
+#ifndef NO_PROTOTYPES
+static void compandtake(word, word *, word *, word *, bool);
+static void sinsert(word);
+#else
+static void compandtake();
+static void sinsert();
+#endif
+
+
+int compactify_allowed=1;
+#define space 400 /* words */
+
+
+void request(app, ah, am)
+word app, *ah, *am;
+{
+ word t2, t4, t5;
+ bool wascompactified, found;
+
+ if (app >= MAXAPPT) errsignal(RTEMEMOV);
+ wascompactified = FALSE;
+
+ if( compactify_allowed && thisp->force_compactification ){
+ compactify();
+ thisp->force_compactification=FALSE;
+ wascompactified=TRUE;
+ }
+
+ if (thisp->freeitem != 0) /* reserve dictionary item */
+ {
+ *ah = thisp->freeitem;
+ thisp->freeitem = M[ *ah ];
+ }
+ else
+ {
+ *ah = thisp->lastitem-2;
+ if (*ah <= thisp->lastused + space) /* cannot take free item */
+ {
+ if( compactify_allowed )
+ if( !wascompactified ) compactify(),wascompactified=TRUE;
+ else ;
+ else
+ thisp->force_compactification=TRUE;
+ *ah = thisp->lastitem-2;
+ if (*ah <= thisp->lastused) errsignal(RTEMEMOV);
+ }
+
+ thisp->lastitem = *ah;
+ M[ *ah+1 ] = 0; /* clear mark */
+ } /* now we have a free dict. item */
+
+
+ if (app == 2 && thisp->headk2 != 0) /* special case app=2 */
+ {
+ *am = thisp->headk2;
+ thisp->headk2 = M[ *am+SHORTLINK ];
+ }
+ else
+ {
+ word t1 = thisp->headk;
+ found = FALSE;
+ t4 = 0;
+ while (t1 != thisp->lower && !found)
+ {
+ t2 = M[ t1 ];
+ if (t2 == app) found = TRUE;
+ else
+ if (t2-app >= 2) found = TRUE;
+ else
+ {
+ t4 = t1;
+ t1 = M[ t1+LONGLINK ];
+ }
+ }
+ if( found ) {
+ t5 = M[ t1+SHORTLINK ];
+ if (t5 != 0) M[ t5+LONGLINK ] = M[ t1+LONGLINK ];
+ else t5 = M[ t1+LONGLINK ];
+ if (t4 == 0) thisp->headk = t5; else M[ t4+LONGLINK ] = t5;
+ *am = t1;
+ if (t2 > app) /* at least two extra words */
+ {
+ t5 = t1+app;
+ M[ t5 ] = t2-app;
+ sinsert(t5);
+ }
+ }
+ else
+ if ( thisp->lastitem - thisp->lastused > app + space )
+ {
+ *am = thisp->lastused+1;
+ thisp->lastused += app;
+ }
+ else
+ {
+ M[ *ah ] = thisp->freeitem; /* return dictionary item */
+ thisp->freeitem = *ah;
+ if( compactify_allowed )
+ if( !wascompactified ) compactify();
+ else ;
+ else
+ thisp->force_compactification=TRUE;
+ *ah = thisp->lastitem-2; /* reserve dictionary item */
+ thisp->lastitem = *ah;
+ M[ *ah+1 ] = 0; /* clear mark */
+ if ( thisp->lastitem - thisp->lastused > app ) {
+ *am = thisp->lastused+1;
+ thisp->lastused += app;
+ }
+ else
+ errsignal(RTEMEMOV);
+ }
+ }
+
+ M[ *am ] = app;
+ for (t2 = *am+1; t2 < *am+app; t2++ ) M[ t2 ] = 0;
+ M[ *ah ] = *am;
+
+}
+
+
+static void sinsert(am) /* Dispose of a memory item. */
+word am;
+{
+ word t1, t2, t3, t4;
+
+ t1 = M[ am ]; /* appetite */
+ if (t1 == 2) /* a special list should be used */
+ {
+ M[ am+SHORTLINK ] = thisp->headk2;
+ thisp->headk2 = am;
+ }
+ else
+ {
+ t2 = thisp->headk;
+ t4 = 0;
+ while (TRUE) /* look for a proper place */
+ {
+ t3 = M[ t2 ]; /* appetite */
+ if (t1 == t3) /* an entry with matching appetite */
+ {
+ M[ am+SHORTLINK ] = M[ t2+SHORTLINK ];
+ M[ t2+SHORTLINK ] = am;
+ break;
+ }
+ else
+ if (t1 < t3)
+ {
+ M[ am+LONGLINK ] = t2;
+ M[ am+SHORTLINK ] = 0;
+ if (t4 == 0) thisp->headk = am;
+ else M[ t4+LONGLINK ] = am;
+ break;
+ }
+ else
+ {
+ t4 = t2;
+ t2 = M[ t2+LONGLINK ];
+ }
+ }
+ }
+}
+
+
+void disp(virt) /* Simple kill. */
+virtaddr *virt;
+{
+ word t1, t2;
+
+ t1 = M[ virt->addr+1 ];
+ if (t1 == virt->mark) /* not none */
+ {
+ t1++; /* advance mark */
+ t2 = M[ virt->addr ]; /* am */
+ M[ virt->addr+1 ] = t1;
+ if (t1 != MAXMARKER) /* mark still usable */
+ {
+ M[ virt->addr ] = thisp->freeitem;
+ thisp->freeitem = virt->addr;
+ } /* now dictionary item is released */
+ if (t2+M[ t2 ]-1 == thisp->lastused) /* on the boundary */
+ thisp->lastused = t2-1;
+ else sinsert(t2);
+ }
+} /* end disp */
+
+
+word memavail() /* Compute available memory size */
+{
+ word t1, t2, avail;
+
+ avail = thisp->lastitem-thisp->lastused-1; /* contiguos memory */
+ t1 = thisp->headk2; /* go through killed 2 list */
+ while (t1 != 0)
+ {
+ avail += 2;
+ t1 = M[ t1+SHORTLINK ];
+ }
+ t1 = thisp->headk;
+ while (t1 != thisp->lower) /* go through killed object list */
+ {
+ t2 = t1;
+ while (t2 != 0)
+ {
+ avail += M[ t2 ];
+ t2 = M[ t2+SHORTLINK ];
+ }
+ t1 = M[ t1+LONGLINK ];
+ }
+ t1 = thisp->freeitem; /* go through free item list */
+ while (t1 != 0)
+ {
+ avail += 2;
+ t1 = M[ t1 ];
+ }
+ return(avail);
+} /* end memavail */
--- /dev/null
+#include "depend.h"
+#include "genint.h"
+#include "int.h"
+#include "process.h"
+#include "intproto.h"
+
+#include "nonstand.h"
+
+
+/* Call (non)standard procedures.
+ * Almost totaly implementation dependent.
+ */
+
+bool graphmode = FALSE; /* TRUE iff graphics mode active */
+param_struct par;
+
+char *s;
+char ss[255];
+char ii[50],ff[50];
+int scc,lastmsg;
+
+int wait_for_key()
+{
+ G_MESSAGE msg;
+
+ bzero(&msg,sizeof(G_MESSAGE));
+ while ((msg.msg_type != MSG_GRAPH) && (msg.param.pword[0] != GRAPH_INKEY_RESPONSE))
+{ read_from_graph(&msg);
+
+ }
+ return(msg.param.pword[3]);
+}
+
+
+void nonstandard(nrproc) /* Call (non)standard procedure */
+word nrproc;
+{
+
+ word am;
+ int cnt=0;
+ float r1, r2;
+ word ax,bx,cx,dx,i,t1,t2;
+ unsigned int v,p,h,l,r,c,sc;
+ unsigned int Res_graph_X,Res_graph_Y;
+ G_MESSAGE msg;
+ MESSAGE msg1;
+
+
+ switch ((int) nrproc)
+ {
+ case GRON :
+ case GROFF :break;
+
+ case CLS : msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_CLEAR;
+ msg.param.pword[1] = GraphRes;
+ send_to_graph(&msg);
+ break;
+
+ case POINT :
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0]=GRAPH_POINT;
+ msg.param.pword[1] = GraphRes;
+ msg.param.pword[3]=param[0].xword;
+ msg.param.pword[4]=param[1].xword;
+ send_to_graph(&msg);
+ break;
+ case MOVE :
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0]=GRAPH_MOVE;
+ msg.param.pword[1] = GraphRes;
+ msg.param.pword[2]=param[0].xword;
+ msg.param.pword[3]=param[1].xword;
+ send_to_graph(&msg);
+ break;
+
+ case DRAW :
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0]=GRAPH_LINETO;
+ msg.param.pword[1] = GraphRes;
+ msg.param.pword[3]=param[0].xword;
+ msg.param.pword[4]=param[1].xword;
+ send_to_graph(&msg);
+ break;
+
+ case INXPOS :
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0]=GRAPH_CURPOS;
+ msg.param.pword[1] = GraphRes;
+ send_to_graph(&msg);
+ while ((msg.msg_type!=MSG_GRAPH)&&(msg.param.pword[0]!=GRAPH_CURPOS_RESPONSE))
+ read_from_graph(&msg);
+ param[0].xword = msg.param.pword[3];
+ break;
+
+ case INYPOS :
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0]=GRAPH_CURPOS;
+ msg.param.pword[1] = GraphRes;
+ send_to_graph(&msg);
+ while ((msg.msg_type!=MSG_GRAPH)||(msg.param.pword[0]!=GRAPH_CURPOS_RESPONSE))
+ read_from_graph(&msg);
+ param[0].xword = msg.param.pword[4];
+ break;
+
+ case HFILL :
+ break;
+ case VFILL :
+ break;
+
+ case HASCII :
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0]=GRAPH_HASCII;
+ msg.param.pword[1]=param[0].xword;
+ send_to_graph(&msg);
+ break;
+
+ case COLOR :
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0]=GRAPH_FOREGROUND;
+ msg.param.pword[1] = GraphRes;
+ msg.param.pword[3] = param[0].xword;
+ send_to_graph(&msg);
+ break;
+
+ case BORDER :
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0]=GRAPH_BACKGROUND;
+ msg.param.pword[1] = GraphRes;
+ msg.param.pword[3] = param[0].xword;
+ send_to_graph(&msg);
+ break;
+
+ case STYLE :
+ break;
+
+ case INPIX :
+ break;
+
+ case OUTSTRING :
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0]=GRAPH_OUTSTRING;
+ msg.param.pword[1] = GraphRes;
+ msg.param.pword[2] = param[0].xword;
+ msg.param.pword[3] = param[1].xword;
+ msg.param.pword[4] = param[3].xword;
+ msg.param.pword[5] = param[4].xword;
+ {
+ s= (char *)(M + strings + param[ 2 ].xword + 1);
+ strcpy(msg.param.pstr,s);
+ send_to_graph(&msg);
+ }
+ break;
+
+ case GETMAP :
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_GETMAP;
+ msg.param.pword[1] = GraphRes;
+ msg.param.pword[2] = param[0].xword;
+ msg.param.pword[3] = param[1].xword;
+ send_to_graph(&msg);
+ while ((msg.msg_type!=MSG_GRAPH)||(msg.param.pword[0]!=GRAPH_GETMAP_RESPONSE))
+ read_from_graph(&msg);
+
+ {
+ int map;
+
+ map =msg.param.pword[2];
+ newarry((word) 1, 3, (word)AINT, ¶m[ 2 ].xvirt, &am);
+ M[ am+3 ] = map;
+ M[ am+4 ] = msg.param.pword[3];
+ M[ am+5 ] = msg.param.pword[4];
+
+ }
+ break;
+
+
+ case PUTMAP :
+ if (member(¶m[ 0 ].xvirt, &am)){
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_PUTMAP;
+ msg.param.pword[1] = GraphRes;
+ msg.param.pword[2] = M[am+3];
+ msg.param.pword[4] = M[am+4];
+ msg.param.pword[5] = M[am+5];
+ send_to_graph(&msg);
+ }
+ break;
+
+ case ORMAP :
+ case XORMAP :break;
+
+
+ case PATERN :
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0]=GRAPH_RECT;
+ msg.param.pword[1] = GraphRes;
+ msg.param.pword[3] = param[0].xword;
+ msg.param.pword[4] = param[1].xword;
+ msg.param.pword[5] = param[2].xword;
+ msg.param.pword[6] = param[3].xword;
+ msg.param.pword[7] = param[4].xword;
+ msg.param.pword[8] = param[5].xword;
+ send_to_graph(&msg); break;
+ case PALLET:break;
+
+ case TRACK :
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_WRITEINTXY;
+ msg.param.pword[1] = GraphRes;
+ msg.param.pword[2] = param[0].xword;
+ msg.param.pword[3] = param[1].xword;
+ msg.param.pword[4] = param[4].xword;
+ msg.param.pword[5] = param[2].xword;
+ send_to_graph(&msg);
+ break;
+
+ case INKEY :
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0]=GRAPH_INKEY;
+ msg.param.pword[1] = GraphRes;
+ send_to_graph(&msg);
+ param[0].xword = wait_for_key();
+ break;
+
+
+ case CIRB :
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0]=GRAPH_ELLIPSE;
+ msg.param.pword[1] = GraphRes;
+ msg.param.pword[3]=param[0].xword; msg.param.pword[4]=param[1].xword;
+ msg.param.pword[5]=param[2].xword; msg.param.pword[6]=param[3].xword;
+ msg.param.pword[7]=(double)param[4].xword;
+ msg.param.pword[8]=(double) param[5].xword;
+ msg.param.pword[9]=param[7].xword;
+ send_to_graph(&msg);
+ break;
+
+ case HFONT8: /* ___________ magic library ____________ */
+
+ if (param[0].xword==1000)
+ {
+ strcpy(ss,"");
+ } else
+ if (param[0].xword==1001)
+ {
+ sprintf(ss,"%s%c",ss,(char)(param[1].xword));
+ } else
+ if (param[0].xword==303)
+ {
+ msg.param.pword[1] = param[0].xword;
+ msg.param.pword[2] = param[1].xword;
+ msg.param.pword[3] = param[2].xword;
+ msg.param.pword[4] = param[3].xword;
+ msg.param.pword[5] = param[5].xword;
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_MAGIC;
+ strcpy(msg.param.pstr,ss);
+ send_to_graph(&msg);
+ } else
+ if (param[0].xword>500)
+ {
+ msg1.param.pword[1] = param[0].xword;
+ msg1.param.pword[2] = param[1].xword;
+ msg1.param.pword[3] = param[2].xword;
+ msg1.param.pword[4] = param[3].xword;
+ s= (char *)(M + strings + param[ 4 ].xword + 1);
+ strcpy(msg1.param.pstr,s);
+ msg1.param.pword[5] = param[5].xword;
+ msg1.param.pword[6] = param[6].xword;
+ msg1.param.pword[7] = param[7].xword;
+
+ switch(msg1.param.pword[1]) /* Machine class */
+ {
+ case 501: /* get local node */
+ newarry((word)0,2,(word)AINT,¶m[8].xvirt,&ax);
+ ax+=3;
+ M[ax++]=my_ctx.node;
+ break;
+ case 502: /* number of nodes */
+ msg1.msg_type = MSG_NET;
+ msg1.param.pword[0]=NET_NODES_NUM;
+ write(net_sock,&msg1,sizeof(MESSAGE));
+ while ((msg1.msg_type!=MSG_NET) || (msg1.param.pword[0]!=NET_NODES_NUM_RESPONSE) )
+ read_from_net(&msg1);
+ newarry((word)0,2,(word)AINT,¶m[8].xvirt,&ax);
+ ax+=3;
+ M[ax++]=msg1.param.pword[1];
+ break;
+ case 503: /* node exists */
+ msg1.msg_type = MSG_NET;
+ msg1.param.pword[0]=NET_NODE_EXIST;
+ msg1.param.pword[1]=msg1.param.pword[2];
+ write(net_sock,&msg1,sizeof(MESSAGE));
+ bzero(&msg1,sizeof(msg1));
+ while ((msg1.msg_type!=MSG_NET) || (msg1.param.pword[0]!=NET_NODE_EXIST) )
+ read_from_net(&msg1);
+ newarry((word)0,2,(word)AINT,¶m[8].xvirt,&ax);
+ ax+=3;
+ M[ax++]=msg1.param.pword[1];
+ break;
+ case 504: /* get nodes info */
+ {
+ char ss[1024];
+ strcpy(ss,"");
+ msg1.msg_type = MSG_NET;
+ msg1.param.pword[0]=NET_GET_INFO;
+ write(net_sock,&msg1,sizeof(MESSAGE));
+ while ( (msg1.msg_type!=MSG_NET) ||(msg1.param.pword[0]!=NET_INFO_END) )
+ {
+ read_from_net(&msg1);
+ if (msg1.param.pword[0]==NET_INFO)
+ strcat(ss,msg1.param.pstr);
+ }
+ newarry((word)0,strlen(ss),(word)AINT,
+ ¶m[8].xvirt,&ax);
+ ax+=3;
+ s=ss;
+ while(*s!='\0')
+ M[ax++]=*(s++);
+ } ;break;
+
+
+ }/* switch */
+ }
+ else
+ { /* graphic */
+
+ msg.param.pword[1] = param[0].xword;
+ msg.param.pword[2] = param[1].xword;
+ msg.param.pword[3] = param[2].xword;
+ msg.param.pword[4] = param[3].xword;
+ s= (char *)(M + strings + param[ 4 ].xword + 1);
+ strcpy(msg.param.pstr,s);
+ msg.param.pword[5] = param[5].xword;
+ msg.param.pword[6] = param[6].xword;
+ msg.param.pword[7] = param[7].xword;
+
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0] = GRAPH_MAGIC;
+
+ send_to_graph(&msg);
+
+ if (msg.param.pword[1]<0)
+ {
+ lastmsg=msg.param.pword[1];
+ bzero(&msg,sizeof(G_MESSAGE));
+ while (msg.param.pword[0]!=GRAPH_MAGIC_RESPONSE)
+ read_from_graph(&msg);
+ if (lastmsg==-305) // Read integer
+ {
+ newarry((word)0,10,(word)AINT,¶m[8].xvirt,&ax);
+ ax+=3;
+ M[ax++]=atoi(msg.param.pstr);
+ }
+ else
+ if (lastmsg==-306) // Read char
+ {
+ newarry((word)0,10,(word)AINT,¶m[8].xvirt,&ax);
+ ax+=3;
+ M[ax++]=msg.param.pchar;
+ }
+ else
+ if (lastmsg==-307) // Read real
+ {
+ newarry((word)0,10,(word)AINT,¶m[8].xvirt,&ax);
+ ax+=3;
+ strcpy(ii,"");strcpy(ff,"");sc=0;
+ while ((sc<strlen(msg.param.pstr)) && (msg.param.pstr[sc]!='.'))
+ {
+ ii[sc]=msg.param.pstr[sc];
+ sc++;
+ }
+ ii[sc++]='\0';scc=sc;sc=0;
+ while (scc<strlen(msg.param.pstr))
+ {
+ ff[sc++]=msg.param.pstr[scc++];
+ }
+ ff[sc]='\0';
+ M[ax++]=atoi(ii);
+ M[ax++]=atoi(ff);
+
+ }
+ else
+ if (msg.param.pword[1]==1)
+ {
+ newarry((word)0,10,(word)AINT,¶m[8].xvirt,&ax);
+ ax+=3;
+ for(l=2;l<7;l++)
+ M[ax++]=msg.param.pword[l];
+ }
+ else
+ {
+ newarry((word)0,strlen(msg.param.pstr)+2,(word)AINT,
+ ¶m[8].xvirt,&ax);
+ ax+=3;
+ s=msg.param.pstr;
+ while(*s!='\0')
+ M[ax++]=*(s++);
+ }
+ }
+ } /* graphic */
+ break;
+
+ case INIT :
+
+ break;
+
+ case STATUS :
+ break;
+
+ case GETPRESS :
+ msg.msg_type = MSG_GRAPH;
+ msg.param.pword[0]=GRAPH_MGETPRESS;
+ msg.param.pword[1] = GraphRes;
+ send_to_graph(&msg);
+ while (1)
+ {
+ read_from_graph(&msg);
+ if ( (msg.msg_type==MSG_GRAPH)&&(msg.param.pword[0]==GRAPH_MGETPRESS_RESPONSE)) break;
+ }
+ param[0].xword = msg.param.pword[2];
+ param[1].xword = msg.param.pword[3];
+ param[2].xword = msg.param.pword[4];
+ param[3].xword = msg.param.pword[5];
+ param[4].xword = msg.param.pword[6];
+ param[5].xword = msg.param.pword[7];
+ break;
+
+
+ break;
+ case GETRELEASE :
+ break;
+
+ case SHOWCURSOR :
+ case HIDECURSOR :
+ case SETPOSITION :
+ case SETWINDOW :
+ case DEFCURSOR :
+ case SETSPEED :
+ case SETMARGINS :
+ case SETTHRESHOLD :
+ break;
+
+ case GETMOVEMENT :
+ break;
+
+
+
+
+ default :
+ errsignal(RTEUNSTP);
+ }
+
+}
+
--- /dev/null
+/* Standard class IIUWGRAPH graphics primitives
+
+GRON:procedure(mode:integer)
+GROFF:procedure
+CLS:procedure
+POINT:procedure(x, y:integer)
+MOVE:procedure(x, y:integer)
+DRAW:procedure(x, y:integer)
+HFILL:procedure(x:integer)
+VFILL:procedure(y:integer)
+COLOR:procedure(color:integer)
+STYLE:procedure(style:integer)
+PATERN:procedure(p1, p2, p3, p4:integer)
+INTENS:procedure(intens:integer)
+PALLET:procedure(p:integer)
+BORDER:procedure(b:integer)
+VIDEO:procedure(buffer:arrayof integer)
+HPAGE:procedure(p, q, r:integer)
+NOCARD:function:integer
+PUSHXY:procedure
+POPXY:procedure
+INXPOS:function:integer
+INYPOS:function:integer
+INPIX:function(x, y:integer):integer
+GETMAP:function(x, y:integer):arrayof integer
+PUTMAP:procedure(arrayof integer)
+ORMAP:procedure(arrayof integer)
+XORMAP:procedure(arrayof integer)
+TRACK:procedure(x, y:integer)
+INKEY:function:integer
+HASCII:procedure(ch:integer)
+HFONT:procedure(off, seg:integer)
+HFONT8:procedure(output off, seg:integer)
+OUTSTRING:procedure(s:string)
+CIRB:procedure(x, y, r:integer, alpha, beta:real, b, i, p, q:integer)
+
+*/
+
+#define GRON 100
+#define GROFF 101
+#define CLS 102
+#define POINT 103
+#define MOVE 104
+#define DRAW 105
+#define HFILL 106
+#define VFILL 107
+#define COLOR 108
+#define STYLE 109
+#define PATERN 110
+#define INTENS 111
+#define PALLET 112
+#define BORDER 113
+#define VIDEO 114
+#define HPAGE 115
+#define NOCARD 116
+#define PUSHXY 117
+#define POPHXY 118
+#define INXPOS 119
+#define INYPOS 120
+#define INPIX 121
+#define GETMAP 122
+#define PUTMAP 123
+#define ORMAP 124
+#define XORMAP 125
+#define TRACK 126
+#define INKEY 127
+#define HASCII 128
+#define HFONT 129
+#define HFONT8 130
+#define OUTSTRING 131
+#define CIRB 132
+
+
+/* Standard class MOUSE mouse support
+
+INIT:function(output butttons:integer):boolean
+SHOWCURSOR:procedure
+HIDECURSOR:procedure
+STATUS:procedure(output x,y:integer, l,r,c:boolean)
+SETPOSITION:procedure(x, y:integer)
+GETPRESS:procedure(b:integer; output x,y,p:integer, l, r, c:boolean)
+GETRELEASE:procedure(b:integer; output x,y,p:integer, l, r, c:boolean)
+SETWINDOW:procedure(l, r, t, b:integer)
+DEFCURSOR:procedure(select, p, q:integer)
+GETMOVEMENT:procedure(output x, y:integer)
+SETSPEED:procedure(x, y:integer)
+SETMARGINS:procedure(l, r, t, b:integer)
+SETTHRESHOLD:procedure(t:integer)
+
+*/
+
+
+#define INIT 200
+#define SHOWCURSOR 201
+#define HIDECURSOR 202
+#define STATUS 203
+#define SETPOSITION 204
+#define GETPRESS 205
+#define GETRELEASE 206
+#define SETWINDOW 207
+#define DEFCURSOR 210
+#define GETMOVEMENT 211
+#define SETSPEED 215
+#define SETMARGINS 216
+#define SETTHRESHOLD 219
--- /dev/null
+#include "depend.h"
+#include "genint.h"
+#include "int.h"
+#include "process.h"
+#include "intproto.h"
+
+/* object management routines */
+
+
+void openrc(prot, virt, addr) /* Open new field for a record. */
+word prot;
+virtaddr *virt;
+word *addr;
+{
+ word t1;
+
+ request(prototype[ prot ]->appetite, &t1, addr);
+ M[ *addr+PROTNUM ] = prot;
+ virt->addr = t1;
+ virt->mark = M[ t1+1 ];
+} /* end openrc */
+
+
+void slopen(prot, sladr, ah, am)
+word prot;
+virtaddr *sladr;
+word *ah, *am;
+{
+ word t1, t2, virts;
+
+ virts = thisp->prochead+M[ thisp->prochead ]+VIRTSC;
+ storevirt(*sladr, virts); /* preserve for compactifier */
+ t1 = prototype[ prot ]->appetite;
+
+ request(t1, ah, am); /* open field */
+
+ M[ *am+PROTNUM ] = prot;
+ t1 = *am+t1; /* LWA+1 of object */
+ M[ t1+SL ] = M[ virts ]; /* prepare SL pointer */
+ M[ t1+SL+1 ] = M[ virts+1 ];
+ t2 = M[ display2+M[ c1+PROTNUM ] ]; /* ah of current */
+ M[ t1+DL ] = t2;
+ M[ t1+DL+1 ] = M[ t2+1 ];
+
+} /* end slopen */
+
+
+void openobj(prot, ah, am)
+word prot;
+word *ah, *am;
+{
+ virtaddr v1;
+ word t1;
+
+ t1 = M[ display2+prototype[ prot ]->slprototype ];
+ v1.addr = t1; /* ah of SL */
+ v1.mark = M[ t1+1 ];
+ slopen(prot, &v1, ah, am);
+} /* end openobj */
+
+
+void newarry(low, up, kind, virt, am) /* Reserve room for array */
+word low, up, kind;
+virtaddr *virt;
+word *am;
+{
+ word ap;
+
+ switch ((int) kind)
+ {
+ case AINT : ap = APINT; break;
+ case AREAL : ap = APREAL; break;
+ case AVIRT : ap = APREF; break;
+ case APROCESS : ap = APINT; break;
+ }
+ low *= ap;
+ up *= ap;
+ if (up < low) errsignal(RTEILLAB); /* illegal array bounds */
+ low -= 3;
+ request(up-low+ap, &virt->addr, am);
+ M[ *am+1 ] = kind;
+ M[ *am+2 ] = low;
+ virt->mark = M[ virt->addr+1 ];
+} /* end newarry */
+
+
+void gkill(virt) /* Generalized killer */
+virtaddr *virt;
+{
+ word t1, t2, t3;
+ virtaddr vt;
+ protdescr *ptr;
+ message msg;
+
+ if (isprocess(virt)) /* kill remote process */
+ {
+ msg.control.type = KILLPR;
+ obj2mess( M, virt, &msg.control.receiver );
+ sendmsg1( &msg);/* send remote kill request */
+ }
+ else
+ if (virt->mark == M[ virt->addr+1 ])
+ {
+ t1 = M[ virt->addr ]; /* am */
+ t2 = M[ t1+PROTNUM ];
+ if (t2 == AINT || t2 == AREAL || t2 == AVIRT)
+ disp(virt); /* simple kill for array */
+ else
+ if (t2 == FILEOBJECT)
+ { /* First close file if opened */
+ if (M[ t1+FSTAT ] != UNKNOWN)
+ if (fclose(MF(t1+FFILE))) errsignal(RTEILLIO);
+ /* Delete file if temporary */
+ if (M[ t1+FTEMP ] == LTRUE)
+ if (unlink(MN(t1+FNAME))) errsignal(RTEILLIO);
+ free(MN(t1+FNAME));
+ disp(virt);
+ }
+ else /* more than array or file */
+ {
+ ptr = prototype[ t2 ];
+ if (ptr->kind == RECORD)
+ disp(virt);
+ else
+ {
+ t3 = t1;
+ do
+ {
+ t3 += M[ t3 ]; /* LWA of object */
+ if (M[ t3+STATSL ] != 0) errsignal(RTEILLKL);
+ t3 = M[ t3+DL ]; /* next object in DL */
+ if (t3 == 0) errsignal(RTEILLKL);
+ t3 = M[ t3 ]; /* am of DL */
+ } while (t3 != t1);
+ do /* kill DL chain */
+ {
+ t3 += M[ t3 ];
+ loadvirt(vt, t3+DL);
+ disp(virt);
+ virt->addr = vt.addr;
+ virt->mark = vt.mark;
+ t3 = M[ virt->addr ];
+ } while (M[ virt->addr+1 ] == virt->mark);
+ }
+ }
+ }
+} /* end gkill */
+
+
+/* Copy object to a new object and locate it by fresh.
+ */
+
+void copy(old, fresh)
+virtaddr *old, *fresh;
+{
+ word t1, t2, t3, virts;
+ protdescr *ptr;
+ bool notrecord;
+
+ if (M[ old->addr+1 ] != old->mark)
+ { /* fine copy for none */
+ fresh->addr = 0;
+ fresh->mark = 0; /* note M[ 1 ] <> 0 */
+ }
+ else /* not none */
+ {
+ t1 = M[ old->addr ]; /* am of old */
+ notrecord = FALSE; /* assume it is a record */
+ t2 = M[ t1+PROTNUM ];
+ if (t2 != AINT && t2 != AREAL && t2 != AVIRT && t2 != FILEOBJECT)
+ { /* if not array nor file */
+ ptr = prototype[ t2 ];
+ if (ptr->kind != RECORD) /* our assumption was wrong */
+ {
+ notrecord = TRUE;
+ t3 = t1+M[ t1 ]+DL;
+ if (M[ t3 ] != old->addr || M[ t3+1 ] != old->mark)
+ errsignal(RTEILLCP); /* non-terminated object */
+ }
+ }
+ virts = thisp->prochead+M[ thisp->prochead ]+VIRTSC;
+ storevirt(*old, virts); /* preserve for compactification */
+ request(M[ t1 ], &t2, &t3); /* book field */
+ fresh->addr = t2; /* ah */
+ fresh->mark = M[ fresh->addr+1 ];
+ t1 = M[ M[ virts ] ];
+ for (t2 = 1; t2 < M[ t1 ]; t2++ )
+ M[ t3+t2 ] = M[ t1+t2 ];
+ if (notrecord)
+ {
+ storevirt(*fresh, t3+M[ t3 ]+DL); /* loop up DL */
+ M[ t3+M[ t3 ]+STATSL ] = 0; /* not in any SL chain */
+ }
+ }
+} /* end copy */
--- /dev/null
+#include "depend.h"
+#include "genint.h"
+#include "int.h"
+#include "process.h"
+#include "intproto.h"
+
+#include <assert.h>
+
+#define ldnode(addr) ((word) (addr & 0xFF))
+#define ldpix(addr) ((word) ((addr >> 8) & 0xFF))
+#define staddr(node, pix) ((word) ((pix << 8) | node))
+
+
+/*
+ These are converters from global to process pointers in memory
+ to global process pointers in message.
+ M denotes memory in which pair (pointer,object) exists or has to exist.
+ We want to create object denoting remote process instead of
+ dummy pointer without object.
+ The object will be like an arrayof integer of size 2.
+ arr[1..3] : arr[1]=node, arr[2]=pix.
+*/
+
+void obj2mess(M,obj,mess)
+ word *M;
+ virtaddr *obj;
+ procaddr *mess;
+{
+#ifdef OBJECTADDR
+ word am;
+ if( obj->mark != M[obj->addr+1] ){
+ mess->node=-1;
+ mess->pix =-1;
+ mess->mark=-1;
+ }else{
+ am=M[obj->addr];
+ mess->node=M[am+2];
+ mess->pix =M[am+3];
+ mess->mark=M[am+4];
+ }
+#else
+ mess->node=ldnode(obj->addr);
+ mess->pix =ldpix (obj->addr);
+ mess->mark=obj->mark;
+#endif
+}
+
+void mess2obj(p,mess,obj)
+ procdescr *p;
+ procaddr *mess;
+ virtaddr *obj;
+{
+
+#ifdef OBJECTADDR
+
+ word am;
+ word *currM=M;
+ word currpix=thispix;
+
+ extern int compactify_allowed;
+ compactify_allowed=0;
+ transfer(p-process);
+ hash_find(mess,obj);
+/*
+ newarry(1,4,APROCESS,obj,&am);
+ M[am+2]=mess->node;
+ M[am+3]=mess->pix;
+ M[am+4]=mess->mark;
+*/
+ transfer(currpix);
+ M=currM;
+
+ compactify_allowed=1;
+
+#else
+ obj->addr=staddr(mess->node,mess->pix);
+ obj->mark=mess->mark;
+
+#endif
+
+}
+
+
+
+bool isprocess(v) virtaddr *v; {
+
+#ifdef OBJECTADDR
+ word am=M[v->addr];
+
+ /*assert(v->mark<=M[v->addr+1]);*/
+ if( v->mark!=M[v->addr+1] ) { return 0;}
+ else { return ( M[am+1]==APROCESS );}
+
+#else
+
+ return ( v->mark < 0 );
+
+#endif
+
+}
+
+
+
+#ifdef OBJECTADDR
+
+/* hash entry is a word pointing to dictionary or 0 if empty */
+
+#ifndef NO_PROTOTYPES
+static int hash_check_item( word, procaddr * );
+static void hash_new_item( virtaddr *, procaddr * );
+static int hash_mess( procaddr * );
+static int hash_2( int );
+#else
+static int hash_check_item();
+static void hash_new_item();
+#endif
+
+void hash_create(p,size) procdescr *p; int size;{
+ /* create hash table for p process */
+ int i;
+ if( p->hash!=NULL ) free( p->hash );
+ p->hash_size = size;
+ p->hash = mallocate(size);
+ if( p->hash==NULL ) errsignal(RTEMEMOV);
+ for( i=0; i<p->hash_size; i++ ) p->hash[i]=0;
+}
+
+
+/* find pointer in hash table, add if not exists */
+
+void hash_find(mess,obj) procaddr *mess; virtaddr *obj; {
+ int i,first,jump;
+ word am;
+ first=hash_mess( mess );
+ jump=hash_2(first);
+ for( i=first; thisp->hash[i]!=0; ){
+ if( hash_check_item(thisp->hash[i],mess) ){
+ obj->addr=thisp->hash[i];
+ obj->mark=M[thisp->hash[i]+1];
+ return;
+ }
+ i=(i+jump)%thisp->hash_size;
+ if( i==first ){
+ int *curhash=thisp->hash;
+ int cursize=thisp->hash_size;
+errsignal(RTEMEMOV); /* the rest is not debugged yet */
+ thisp->hash_size = cursize*3-1;
+ thisp->hash = mallocate(thisp->hash_size);
+ if( thisp->hash==NULL ) errsignal(RTEMEMOV);
+ for( i=0; i<thisp->hash_size; i++ ) thisp->hash[i]=0;
+ for( i=0; i<cursize; i++ ){
+ if( curhash[i]!=0 ){
+ virtaddr obj;
+ procaddr mess;
+ obj.addr=curhash[i];
+ obj.mark=M[curhash[i]+1];
+ obj2mess(M,&obj,&mess);
+ hash_set(&mess,curhash[i]);
+ }
+ }
+ hash_new_item( obj, mess );
+ hash_set( mess, obj->addr );
+ return;
+ }
+ }
+ /* not exists yet */
+ hash_new_item( obj, mess );
+ thisp->hash[i]=obj->addr;
+}
+
+void hash_set(mess,ah) procaddr *mess; word ah;{
+ int i,first,jump;
+ word am;
+ first=hash_mess( mess );
+ jump=hash_2(first);
+ for( i=first; thisp->hash[i]!=0; ){
+ assert( !hash_check_item(thisp->hash[i],mess) );
+ i=(i+jump)%thisp->hash_size;
+ if( i==first ) errsignal(RTEMEMOV);
+ }
+ /* not exists yet */
+ assert( thisp->hash[i]==0 );
+ thisp->hash[i]=ah;
+}
+
+#endif
+
+
+static int hash_check_item( ah, mess ) word ah; procaddr *mess; {
+ word am=M[ah];
+ return ( mess->node==M[am+2] && mess->pix==M[am+3] && mess->mark==M[am+4] );
+}
+
+static void hash_new_item( obj, mess ) virtaddr *obj; procaddr *mess; {
+ word am;
+ newarry(1,4,APROCESS,obj,&am);
+ M[am+2]=mess->node;
+ M[am+3]=mess->pix;
+ M[am+4]=mess->mark;
+}
+
+static int hash_mess( mess ) procaddr *mess;{
+ word hash=mess->pix;
+ hash *= abs( mess->mark );
+ hash += mess->node;
+ return hash % (thisp->hash_size);
+}
+
+static int hash_2( hash_1 ) int hash_1;{
+ return thisp->hash_size -2 - ( hash_1 % ( thisp->hash_size -2 ) );
+}
+
--- /dev/null
+#include "depend.h"
+#include "genint.h"
+#include "int.h"
+#include "process.h"
+#include "intproto.h"
+
+#if DLINK
+# include "dlink.h"
+#elif TCPIP
+# include "tcpip.h"
+#endif
+
+#include <assert.h>
+
+
+/* Process management */
+
+procdescr process[ MAXPROCESS ]; /* process descriptor table */
+procdescr *thisp; /* pointer to current process descr */
+word thispix; /* current process index */
+queue ready; /* Round-Robin queue */
+bool network; /* TRUE if operating in network */
+message globmsgqueue[ MAXMSGQUEUE ]; /* queue of waiting messages */
+int msgready = 0; /* number of waiting messages */
+int msghead = 0, msgtail = 0; /* pointers to message queue */
+word ournode; /* this machine node number */
+word console; /* console node number */
+bool remote = FALSE; /* TRUE if remote node */
+bool reschedule = TRUE; /* TRUE if must re-schedule */
+
+
+
+#ifndef NO_PROTOTYPES
+static void ansprot(message *);
+static void localkill(message *);
+void transfer(word);
+static void backcreate(message *);
+static void createprocess(message *);
+static void localerror(message *);
+static void killprocess(word);
+static void mkglobal(word);
+word pix, ref;
+#else
+static void ansprot();
+static void localkill();
+void transfer();
+static void backcreate();
+static void createprocess();
+static void localerror();
+static void killprocess();
+static void mkglobal();
+#endif
+
+
+
+#if OS2
+PGINFOSEG ginf; /* pointer to Global Info Segment */
+#endif
+
+
+#if USE_ALARM
+# include <signal.h>
+# ifndef NO_PROTOTYPES
+ static void signal_catch( void );
+# else
+ static void signal_catch();
+# endif
+ static void signal_catch(){ reschedule=TRUE; }
+#endif
+
+
+void init_scheduler(){
+#if USE_ALARM
+ signal(SIGALRM,signal_catch);
+ alarm(1);
+#endif
+}
+
+void schedule() /* Choose next ready process to exec */
+{
+ trapmsg(); /* STRONGLY machine dependent */
+#if USE_ALARM
+ if(reschedule){
+ alarm(0);
+ signal(SIGALRM,signal_catch);
+ alarm(1);
+#elif USE_CLOCK
+ static char last;
+ char c;
+ c = clock() >> 5; /* the most expensive method */
+ if (reschedule || c != last) /* context switch is needed */
+ {
+ last = c;
+#elif MSDOS && ( WORD_16BIT || DWORD_16BIT ) /* DOS real memory model */
+ static char last;
+ char c;
+ static char *clk = (char *) 0x0040006CL;
+ c = *clk >> 1;
+ if (reschedule || c != last) /* context switch is needed */
+ {
+ last = c;
+#elif OS2
+ static char last;
+ char c;
+ c = ginf->hundredths >> 3;
+ if (reschedule || c != last) /* context switch is needed */
+ {
+ last = c;
+#else
+#error Scheduler time counting method not implemented !
+#endif
+
+ if (!(qempty(ready))) /* wait for event if no processes */
+ {
+ ready = qrotate(ready); /* find another ready process */
+ transfer(pfront(ready)); /* transfer control to it */
+ reschedule = FALSE;
+ }
+ }
+}
+
+
+void transfer(pix) /* Context switch to another process */
+word pix;
+{
+ word apt;
+ if (pix == thispix) return; /* optimized for case of one process */
+
+ if( thisp != NULL ) /* previous process is alive */
+ {
+ thisp->ic = ic; /* store previous context */
+ thisp->c1 = c1;
+ thisp->c2 = c2;
+ }
+ thispix = pix; /* and load new context */
+ thisp = &process[ thispix ];
+ ic = thisp->ic;
+ c1 = thisp->c1;
+ c2 = thisp->c2;
+ M = thisp->M;
+ param = thisp->param;
+ apt = thisp->prochead+M[ thisp->prochead ];
+ display = apt+dispoff;
+ display2 = apt+disp2off;
+}
+
+
+void activate(pix) /* Resume process on this node */
+word pix;
+{
+ process[ pix ].status = EXECUTING; /* flag process as ready to execute */
+ ready = pinsert(ready, pix); /* insert into ready queue */
+ reschedule = TRUE; /* force context switch */
+# ifdef RPCDBG
+ fprintf(stderr,"activate process %d\n",pix);
+# endif
+}
+
+
+void passivate(newstatus) /* Passivate process */
+int newstatus;
+{
+
+ thisp->status = newstatus; /* change to some wait status */
+ ready = qremove(ready); /* remove from ready queue */
+ reschedule = TRUE; /* force context switch */
+# ifdef RPCDBG
+ fprintf(stderr,"passivate process %d to state %d\n",thispix,newstatus);
+# endif
+}
+
+
+/* Copy parameters from object to message or vice versa. */
+
+
+void moveparams(pix, am, msg, par1, dir)
+ word pix, am;
+ message *msg;
+ int par1, dir;
+{
+ protdescr *ptr;
+ procdescr *p;
+ word i, tpd, ap, pd, prim, offset;
+ char *cp;
+ bool cflag, convert;
+
+ p = &process[ pix ];
+ ptr = prototype[ p->M[ am+PROTNUM ] ];
+ cp = (char *) msg->params;
+
+ for (i = 0; i < ptr->lthparlist; i++) /* loop through parameters */
+ {
+
+ offset = M[ ptr->parlist+i ];
+ tpd = M[ ptr->pfdescr+i ]; /* type description of param */
+ pd = M[ tpd ];
+
+ if (par1 == PARIN)
+ cflag = ( pd==PARIN || pd==PARINOUT || pd==FORMFUNC || pd==FORMPROC );
+ else
+ cflag = ( pd==PAROUT || pd==PARINOUT );
+
+ if (cflag)
+ {
+ if (pd == FORMFUNC || pd == FORMPROC)
+ {
+ ap = APFMPROC;
+ convert = TRUE;
+ }
+ else
+ if (M[ M[ tpd+2 ] ] == CLASSTYPE)
+ {
+ ap = APREF;
+ convert = TRUE;
+ }
+ else
+ {
+ prim = M[ tpd+2 ]-ipradr;
+ ap = primapet[ prim ];
+ convert = (prim == 4 || prim == 5); /* process or coroutine */
+ }
+
+ ap *= sizeof(word); /* param appetite in bytes */
+
+ switch (dir) /* copy parameter in right direction */
+ {
+
+ case LOADPAR :
+
+ /* we always load parameters from OUR process */
+ assert(pix==thispix);
+
+ if (convert){
+ procaddr pa;
+ {
+ word ah=M[am+offset];
+ if( !isprocess((virtaddr*)(M+am+offset)) &&
+ M[ ah+1 ] == M[ am+offset+1 ]
+ )
+ if (prototype[ M[ M[ ah ]+PROTNUM ] ]->kind == PROCESS)
+ {
+ pa.node = ournode;
+ pa.pix = pix;
+ pa.mark = thisp->mark;
+ }
+ else
+ /*pat errsignal(RTENONGL); */ /* only process may be global */
+ /*pat*/ obj2mess(p->M,(virtaddr*)(p->M+am+offset),&pa);
+ else
+ obj2mess(M,(virtaddr*)(M+am+offset),&pa);
+ }
+/*
+ mkglobal(am+offset);
+ obj2mess(p->M,(virtaddr*)(p->M+am+offset),&pa);
+*/
+ moveblock((char *)&pa, cp, ap=sizeof(procaddr));
+ }else
+ moveblock((char *) &p->M[ am+offset ], cp, ap);
+ break;
+
+
+ case SAVEPAR :
+
+ if (convert){
+ procaddr pa;
+ ap=sizeof(procaddr);
+ moveblock(cp,(char *)&pa, ap);
+ mess2obj(p,&pa,(virtaddr*)(p->M+am+offset));
+ }else
+ moveblock(cp, (char *) &p->M[ am+offset ], ap);
+ break;
+
+ }
+
+ cp += ap;
+ assert(cp-msg->params <= sizeof(msg->params));
+ }
+ }
+}
+
+
+word getnode(am) /* Determine node number for process */
+word am;
+{
+ protdescr *ptr;
+ word p;
+ int i;
+
+ p = prototype[ M[ am+PROTNUM ] ]->preflist;
+ while (prototype[ M[ p ] ]->kind != PROCESS) p++;
+ ptr = prototype[ M[ p ] ];
+ if (ptr->lthpreflist == 1) i = 0;
+ else i = prototype[ M[ p-1 ] ]->lthparlist;
+ return (M[ am+M[ ptr->parlist+i ] ]);
+}
+
+
+void resume(virt) /* Perform RESUME instruction */
+virtaddr *virt;
+{
+ message msg;
+
+ if (isprocess(virt)) /* is it process realy ? */
+ {
+ msg.control.type = RESUME;
+ obj2mess( M, virt, &msg.control.receiver );
+ sendmsg1( &msg); /* request remote resume */
+ }
+ else errsignal(RTEILLRS); /* illegal RESUME */
+}
+
+
+static void createprocess(msg) /* Create new process */
+message *msg;
+{
+ word i, prot;
+ for (i = 0; i < MAXPROCESS; i++) /* find unused process descr. */
+ if (!process[ i ].used && process[ i ].mark != -MAXMARKER) break;
+ if (i == MAXPROCESS) senderr(RTETMPRC, &(msg->control.sender) );
+ if (process[ i ].M == NULL) /* memory not allocated yet */
+ {
+ process[ i ].M = mallocate(memorysize+1);
+ if (process[ i ].M == NULL) senderr(RTEMEMOV, &msg->control.sender);
+ moveblock((char *) process[ 0 ].M, (char *) process[ i ].M,
+ freem * sizeof(word));
+ }
+ prot = msg->control.par; /* process prototype number */
+ initprocess(i, prot, &msg->control.sender);
+ moveparams(i, process[ i ].prochead, msg, PARIN, SAVEPAR);
+ process[ i ].status = GENERATING; /* execute process until RETURN */
+ ready = pinsert(ready, i);
+ reschedule = TRUE;
+ if ((remote) && (i==0)) { thispix=1;thisp=NULL;transfer(i); }
+}
+
+
+static void killprocess(pix) /* Release process descriptor */
+word pix;
+{
+ qfree(process[ pix ].msgqueue);
+ qfree(process[ pix ].rpcwait);
+ sfree(process[ pix ].rpcmask);
+
+ process[ pix ].used = FALSE; /* mark descriptor as unused */
+ process[ pix ].mark--; /* decrement marker */
+
+ if( pix == thispix )
+ {
+ thispix = -1;
+ thisp = NULL;
+ }
+}
+
+
+static void localkill(msg)
+message *msg;
+{
+ word pix;
+
+ pix = msg->control.receiver.pix;
+
+# if RPCDBG
+ fprintf( stderr, "kill process %d\n", pix );
+# endif
+
+ if (process[ pix ].mark == msg->control.receiver.mark) /* not none */
+ {
+ if (process[ pix ].status != STOPPED) /* is process suspended ? */
+ senderr(RTEILLKL, &msg->control.sender);
+ killprocess(pix);
+ }
+}
+
+
+void endprocess(status) /* Terminate current process */
+int status;
+{
+ int i;
+
+ passivate(STOPPED);
+# if RPCDBG
+ fprintf( stderr, "terminate process %d\n", thispix );
+# endif
+ killprocess(thispix);
+ if (remote) longjmp(contenv, 1);
+ for (i = 0; i < MAXPROCESS; i++)
+ if (process[ i ].used) longjmp(contenv, 1);
+ endrun(status);
+}
+
+
+static void backcreate(msg)
+message *msg;
+{
+ word pix, am;
+ procdescr *p;
+
+ pix = msg->control.receiver.pix;
+ p = &process[ pix ];
+
+ am = p->M[ p->template.addr ]; /* template physical address */
+ p->M[ temporary ] = am;
+ moveparams(pix, am, msg, PAROUT, SAVEPAR);
+
+ /*store new process address */
+ mess2obj(p,&(msg->control.sender),&(p->backobj));
+ activate(pix); /* end of waiting for NEW */
+}
+
+
+void senderr(exception, virt)
+int exception;
+procaddr *virt;
+{
+ message msg;
+
+ msg.control.type = ERRSIG;
+ msg.control.receiver=*virt;
+ msg.control.par = exception;
+ sendmsg1(&msg); /* send error message */
+ longjmp(contenv, 1); /* continue from next instruction */
+}
+
+
+static void localerror(msg)
+message *msg;
+{
+ word pix;
+ int s;
+
+ pix = msg->control.receiver.pix;
+ s = process[ pix ].status;
+ if (process[ pix ].mark == msg->control.receiver.mark && s != STOPPED)
+ {
+ if (s == WAITFORNEW || s == WAITFORRPC) activate(pix);
+ while (pfront(ready) != pix)
+ ready = qrotate(ready);
+ transfer(pfront(ready));
+ errsignal(msg->control.par);
+ }
+}
+
+
+void askprot(virt) /* Ask for prototype of object */
+virtaddr *virt;
+{
+ word am;
+ message msg;
+
+ if (isprocess(virt)) /* send question to remote process */
+ {
+ obj2mess( M, virt, &msg.control.receiver );
+ msg.control.type = ASKPRO;
+ sendmsg1( &msg );
+ passivate(WAITASKPRO);
+ }
+ else
+ {
+ if (member(virt, &am))
+ M[ temporary ] = M[ am+PROTNUM ];
+ else errsignal(RTEREFTN);
+ }
+}
+
+
+static void ansprot(msg) /* Answer with prototype of process */
+message *msg;
+{
+ message msg1;
+ word pix;
+
+ pix = msg->control.receiver.pix;
+ if (process[ pix ].mark == msg->control.receiver.mark) /* not none */
+ {
+ msg1.control.receiver = msg->control.sender;
+ msg1.control.type = PROACK;
+ msg1.control.par = process[ pix ].prot;
+ sendmsg1( &msg1 );
+ }
+ else senderr(RTEREFTN, &msg->control.sender);
+}
+
+
+/* Message send/receive handling : */
+
+void msginterrupt(msg) /* Receive message interrupt handler */
+ message *msg;
+{
+ moveblock((char *)msg, (char *)&globmsgqueue[ msgtail ],
+ (word) sizeof(message));
+ msgtail = (msgtail+1) % MAXMSGQUEUE;
+ msgready++;
+
+}
+
+
+void sendmsg1(msg) /* Send message via net */
+message *msg;
+{
+ MESSAGE m;
+
+ msg->control.sender.node = ournode;
+ msg->control.sender.pix = thispix;
+ msg->control.sender.mark = thisp->mark;
+ if(
+ msg->control.receiver.node == ournode
+ ||
+ msg->control.receiver.node == 0
+ )
+ /* simulate receive message interrupt */
+ {
+
+ msg->control.receiver.node == ournode;
+ msginterrupt(msg); /* call directly interrupt handler */
+ }
+ else /* send message to kernel and then to NET module */
+ {
+ m.msg_type = MSG_NET;
+ m.param.pword[0] = NET_PROPAGATE;
+ m.param.pword[1] = MSG_INT;
+ m.param.pword[2] = my_ctx.node;
+ m.param.pword[3] = my_ctx.program_id;
+ memcpy(&m.int_msg,msg,sizeof(message));
+ send_to_net(&m);
+
+ }
+}
+
+
+void trapmsg() /* Check for waiting message */
+{
+ message *msg;
+ procdescr *p;
+ word pix;
+
+ if (msgready > 0) /* at least one message is waiting */
+ {
+ msg = &globmsgqueue[ msghead ]; /* get first message from queue */
+ msghead = (msghead+1) % MAXMSGQUEUE;
+
+ switch(msg->control.type)
+ {
+ case ERRSIG :
+ localerror(msg);
+ break;
+
+ case RESUME :
+ pix = msg->control.receiver.pix;
+ if (process[ pix ].mark != msg->control.receiver.mark)
+ senderr(RTEREFTN, &msg->control.sender);
+ if (process[ pix ].status != STOPPED)
+ senderr(RTEILLRS, &msg->control.sender);
+ activate(pix);
+ break;
+
+ case CREATE :
+ createprocess(msg);
+ break;
+
+ case CREACK :
+ backcreate(msg);
+ break;
+
+ case KILLPR :
+ localkill(msg);
+ break;
+
+ case RPCALL :
+ rpc1(msg);
+ break;
+
+ case RPCACK :
+ rpcend(msg);
+ break;
+
+ case ASKPRO :
+ ansprot(msg);
+ break;
+
+ case PROACK :
+ pix = msg->control.receiver.pix;
+ p = &process[ pix ];
+ p->M[ temporary ] = msg->control.par;
+ activate(pix);
+ break;
+
+ default :
+ fprintf( stderr, " Invalid message\n" );
+ senderr(RTESYSER, &msg->control.sender);
+ }
+ msgready--;
+
+ }
+}
+
+
+static void mkglobal(ref) /* Make global a process reference */
+ word ref;
+{
+ word ah;
+ ah = M[ ref ];
+ if (!isprocess((virtaddr*)(M+ref)) && M[ ah+1 ] == M[ ref+1 ])
+ if (prototype[ M[ M[ ah ]+PROTNUM ] ]->kind == PROCESS)
+ {
+ virtaddr va;
+ procaddr pa;
+ pa.node = ournode;
+ pa.pix = pix;
+ pa.mark = thisp->mark;
+ mess2obj(thisp,&pa,&va);
+ M[ ref ] = va.addr;
+ M[ ref+1 ] = va.mark;
+#ifdef RPCDBG
+fprintf(stderr,"mkglobal REAL (thisp=%d) isprocess:node=%d pix=%d mark=%d\n",thispix,pa.node,pa.pix,pa.mark);fflush(stderr);
+#endif
+ }
+ else errsignal(RTENONGL); /* only process may be global */
+}
+
+
+
+/*
+void show_m( char *s, message *msg ){
+ char *n;
+ switch(msg->control.type)
+ {
+ case ERRSIG : n = "ERRSIG"; break;
+ case RESUME : n = "RESUME"; break;
+ case CREATE : n = "CREATE"; break;
+ case CREACK : n = "CREACK"; break;
+ case KILLPR : n = "KILLPR"; break;
+ case RPCALL : n = "RPCALL"; break;
+ case RPCACK : n = "RPCACK"; break;
+ case ASKPRO : n = "ASKPRO"; break;
+ case PROACK : n = "PROACK"; break;
+ default : n = "??????"; break;
+ }
+#ifdef RPCDBG
+ printf( "message %s type %s from %d:%d:%d to %d:%d:%d\n",
+ s, n,
+ msg->control.sender.node,
+ msg->control.sender.pix,
+ msg->control.sender.mark,
+ msg->control.receiver.node,
+ msg->control.receiver.pix,
+ msg->control.receiver.mark
+ );
+ fflush( stdout );
+#endif
+}
+*/
+
--- /dev/null
+#include "queue.h"
+
+
+/* Process management definitions : */
+
+#define MAXPROCESS 64 /* maximum number of processes on one node */
+#define MAXMSGQUEUE 16 /* maximum number of waiting messages */
+
+#define MSGLENGTH 256 /* message length defined by me (PS) */
+
+
+/* Process state : */
+
+#define GENERATING 0 /* during generation of process object */
+#define STOPPED 1 /* non-active process (suspended by STOP) */
+#define EXECUTING 2 /* active process (ready to execute) */
+#define WAITFORNEW 3 /* waiting for NEW of another process */
+#define WAITFORRPC 4 /* waiting for remote procedure call */
+#define ACCEPTING 5 /* during execution of ACCEPT statement */
+#define WAITASKPRO 6 /* waiting for process prototype */
+
+/* Process descriptor : */
+
+typedef struct
+{
+ bool used; /* TRUE if in use by some process */
+ word mark; /* process mark for proper detecting of none */
+ int status; /* process state */
+ word prot; /* process prototype number */
+ memory M; /* pointer to memory array */
+ union value param[ MAXPARAM ];
+ word ic; /* instruction counter */
+ word trlnumber; /* trace line number */
+ word lower; /* first word of object area */
+ word upper; /* last word in memory */
+ word lastused; /* last word used by objects */
+ word lastitem; /* first word used by dictionary */
+ word freeitem; /* head of free dictionary item list */
+ word headk; /* head of killed object list for size > 2 */
+ word headk2; /* head of killed object list for size = 2 */
+ word prochead; /* am of process object */
+ virtaddr procref; /* process object virtual address */
+ virtaddr template; /* remote process or procedure template */
+ word c1, c2; /* pointers to current object */
+ virtaddr backobj; /* adress of object just left */
+ word blck1, blck2; /* used for LBLOCK1, LBLOCK2, LBLOCK3 */
+ queue msgqueue; /* queue of messages for this process */
+ queue rpcwait; /* queue of disabled RPC messages */
+ stack rpcmask; /* stack of set of enabled remote procedures */
+ bool force_compactification; /* next allocate will forace compact... */
+ word *hash; /* table of pointers to processes in process */
+ word hash_size;
+} procdescr;
+
+
+/* Message type : */
+
+#define ERRSIG 0 /* error signal */
+#define RESUME 1 /* resume request */
+#define CREATE 2 /* create new process request */
+#define CREACK 3 /* create process acknowledge */
+#define KILLPR 4 /* kill process */
+#define RPCALL 5 /* remote procedure call request */
+#define RPCACK 6 /* remote procedure return */
+#define ASKPRO 7 /* ask for process prototype */
+#define PROACK 8 /* answer with process prototype */
+
+typedef struct {
+ word node;
+ word pix;
+ word mark;
+} procaddr;
+
+struct ctrlmsg
+{
+ procaddr sender; /* address of the sender and */
+ procaddr receiver; /* receiver of the message */
+ int type; /* message type */
+ int par; /* prototype or error signal number */
+};
+
+#define MAXPROCPAR (MSGLENGTH-sizeof(struct ctrlmsg))
+
+typedef struct
+{
+ struct ctrlmsg control;
+ char params[ MAXPROCPAR ];
+} message;
+
+/* Direction of copying of parameters (for moveparams()) : */
+
+#define LOADPAR 0
+#define SAVEPAR 1
+
+typedef char *mask;
+
+extern procdescr process[]; /* process descriptor table */
+extern procdescr *thisp; /* pointer to current process descriptor */
+extern word thispix; /* current process index */
+extern queue ready; /* Round-Robin queue of ready processes */
+extern bool network; /* TRUE if operating in D-Link network */
+extern message globmsgqueue[]; /* queue of waiting messages */
+extern int msgready; /* number of waiting messages */
+extern int msghead, msgtail; /* pointers to message queue */
+extern word ournode; /* this machine node number */
+extern word console; /* console node number */
+extern bool remote; /* TRUE if remote node */
+extern bool reschedule; /* TRUE if rescheduling is mandatory */
+
+#if OS2
+extern PGINFOSEG ginf; /* pointer to Global Info Segment */
+#endif
+
+
+
+#ifndef NO_PROTOTYPES
+void obj2mess(word *,virtaddr *,procaddr*);
+void mess2obj(procdescr *,procaddr *,virtaddr*);
+bool isprocess(virtaddr *);
+void hash_find(procaddr *,virtaddr *);
+void hash_create(procdescr *,int);
+void hash_set(procaddr *,word);
+#else
+void obj2mess();
+void mess2obj();
+bool isprocess();
+void hash_find();
+void hash_create();
+void hash_set();
+#endif
+
--- /dev/null
+#include "depend.h"
+#include "genint.h"
+#include "int.h"
+#include "process.h"
+#include "intproto.h"
+
+
+/* Queue management */
+/* Single linked circular lists with queue represented as pointer to rear */
+
+queue qinit() /* Initialize empty queue */
+{
+ return (NULL);
+} /* end qinit */
+
+
+stack push(q, e) /* Insert element into the queue */
+stack q;
+selem e;
+{
+ stack p;
+
+ p = (stack) ballocate(sizeof(struct queuelem));
+ if (p == NULL) errsignal(RTEMEMOV);
+ p->elem = e;
+ if (q == NULL)
+ {
+ p->next = p; /* the lonely element of the queue */
+ q = p;
+ }
+ else
+ {
+ p->next = q->next; /* insert at rear */
+ q->next = p;
+ }
+ return(q);
+} /* end push */
+
+
+qelem qfront(q) /* Get first element of the queue */
+queue q;
+{
+ if (qempty(q)){
+ fprintf( stderr, "getting first element from empty queue\n");
+ errsignal(RTESYSER);
+ }
+ return (q->next->elem);
+} /* end qfront */
+
+
+queue qremove(q) /* Remove front element from the queue */
+queue q;
+{
+ queue p;
+
+ if (qempty(q)){
+ fprintf( stderr, "removing first element from empty queue\n");
+ errsignal(RTESYSER);
+ }
+ p = q->next;
+ q->next = q->next->next;
+ if (p == q) q = NULL; /* removing last element of the queue */
+ free(p);
+ return(q);
+} /* end qremove */
+
+
+queue qdelete(q, e) /* Delete arbitrary element */
+queue q;
+qelem e;
+{
+ queue p, r, s;
+
+ if (qempty(q)) return(q);
+ r = q;
+ p = r->next;
+ while (p->elem != e)
+ {
+ if (p == q) return(q);
+ r = p;
+ p = p->next;
+ }
+ r->next = p->next;
+ if (r == p) s = NULL;
+ else
+ if (p == q) s = r;
+ else s = q;
+ free(p);
+ return(s);
+} /* end qdelete */
+
+
+queue qrotate(q) /* Remove front and insert at rear */
+queue q;
+{
+ if (qempty(q)){
+ fprintf( stderr, "rotating empty queue\n");
+ errsignal(RTESYSER);
+ }
+ return (q->next);
+} /* end qrotate */
+
+
+void qfree(q)
+queue q;
+{
+ while (!qempty(q))
+ {
+ free(qfront(q));
+ q = qremove(q);
+ }
+} /* end qfree */
--- /dev/null
+/* Header for queue management module */
+
+typedef lword qelem;
+typedef qelem selem;
+struct queuelem { qelem elem;
+ struct queuelem *next;
+ };
+typedef struct queuelem *queue;
+typedef queue stack;
+
+#ifndef NO_PROTOTYPES
+queue qinit(void);
+stack push(stack,selem);
+qelem qfront(queue);
+queue qremove(queue);
+queue qdelete(queue,qelem);
+queue qrotate(queue);
+void qfree(queue);
+#else
+queue qinit();
+stack push();
+qelem qfront();
+queue qremove();
+queue qdelete();
+queue qrotate();
+void qfree();
+#endif
+
+#define qinsert(q, e) (((queue) push((stack) (q), (selem) (e)))->next)
+#define qempty(q) ((q) == NULL)
+#define pinsert(q, p) (qinsert(q, (qelem) (p)))
+#define pfront(q) ((word) qfront(q))
+#define minsert(q, m) (qinsert(q, (qelem) (m)))
+#define mfront(q) ((message *) qfront(q))
+#define mdelete(q, m) (qdelete(q, (qelem) (m)))
+#define mpush(q, m) ((queue) push((stack) q, (selem) m))
+#define sfree(s) qfree((queue) s)
+#define sinit qinit
+#define pop(s) ((stack) qremove((queue) s))
+#define top(s) ((selem) qfront((queue) s))
--- /dev/null
+#include "depend.h"
+#include "genint.h"
+#include "int.h"
+#include "process.h"
+#include "intproto.h"
+
+
+#ifndef NO_PROTOTYPES
+static bool isenabled(word,word);
+static bool rpcready(word);
+static void bitaccess(word,word,int *,char *);
+static void dupmask(word);
+#else
+static bool isenabled();
+static bool rpcready();
+static void bitaccess();
+static void dupmask();
+#endif
+
+
+void rpc1(msg) /* preprocess RPC request */
+message *msg;
+{
+ word pix, prot;
+ procdescr *p;
+ message *msg1;
+
+ pix = msg->control.receiver.pix;
+ p = &process[ pix ];
+ if (p->mark != msg->control.receiver.mark)
+ senderr(RTEREFTN, &msg->control.sender);
+ msg1 = (message *) ballocate(sizeof(message));
+ if (msg1 == NULL) errsignal(RTEMEMOV);
+ moveblock((char *) msg, (char *) msg1, (word) sizeof(message));
+ prot = msg->control.par;
+ if (isenabled(pix, prot))
+ {
+ p->msgqueue = minsert(p->msgqueue, msg1);
+ if (p->status == ACCEPTING) activate(pix);
+ }
+ else p->rpcwait = minsert(p->rpcwait, msg1);
+}
+
+
+void rpc2()
+{
+ if (rpcready(thispix)) rpc3();
+}
+
+
+void rpc3() /* Actual remote procedure call */
+{
+ word prot, ah, am;
+ message *msg;
+
+ msg = mfront(thisp->msgqueue); /* remove first RPC message (enabled) */
+
+ /*fprintf(
+ stderr, "rpc(thisp=%d) from: node=%d, pix=%d, mark=%d\n",
+ thispix,
+ msg->control.sender.node,
+ msg->control.sender.pix,
+ msg->control.sender.mark
+ );*/
+
+ thisp->msgqueue = qremove(thisp->msgqueue);
+ pushmask(thispix); /* disable all procedures */
+ prot = msg->control.par;
+
+ slopen(prot, &thisp->procref, &ah, &am); /* open procedure object */
+
+ {
+ virtaddr v;
+ mess2obj( thisp, &(msg->control.sender), &v );
+ storevirt( v, am+M[ am ]+RPCDL ); /* set up remote DL */
+ }
+
+ moveparams(thispix, am, msg, PARIN, SAVEPAR);
+
+ go(ah, am); /* transfer control to procedure */
+
+ free(msg);
+
+}
+
+
+void rpcend(msg) /* After return from RPC */
+message *msg;
+{
+ word pix, am;
+ procdescr *p;
+
+ pix = msg->control.receiver.pix;
+
+
+ p = &process[ pix ];
+ am = p->M[ temporary ]; /* template physical address */
+ moveparams(pix, am, msg, PAROUT, SAVEPAR);
+ activate(pix); /* resume process waiting for RPC */
+}
+
+
+static void bitaccess(pix, prot, bytenr, bitmask)
+word pix, prot;
+int *bytenr;
+char *bitmask;
+{
+ int bitnr;
+
+ bitnr = prot-prototype[ process[ pix ].prot ]->maskbase;
+ *bytenr = bitnr / 8;
+ *bitmask = (char)(unsigned char)( 1 << (bitnr % 8) );
+}
+
+
+void enable(pix, prot) /* Enable remote procedure */
+word pix, prot;
+{
+ mask m;
+ int bytenr;
+ char bitmask;
+
+ m = top(process[ pix ].rpcmask);
+ bitaccess(pix, prot, &bytenr, &bitmask);
+ m[ bytenr ] |= bitmask;
+}
+
+
+void disable(pix, prot) /* Disable remote procedure */
+word pix, prot;
+{
+ mask m;
+ int bytenr;
+ char bitmask;
+
+ m = top(process[ pix ].rpcmask);
+ bitaccess(pix, prot, &bytenr, &bitmask);
+ m[ bytenr ] &= ~ bitmask;
+}
+
+
+static bool isenabled(pix, prot) /* Check if RPC allowed */
+word pix, prot;
+{
+ mask m;
+ int bytenr;
+ char bitmask;
+
+ m = top(process[ pix ].rpcmask);
+ bitaccess(pix, prot, &bytenr, &bitmask);
+ return( m[ bytenr ] & bitmask );
+}
+
+
+void pushmask(pix) /* Push empty RPC mask onto stack */
+word pix;
+{
+ mask m;
+ int i, size;
+
+ size = prototype[ process[ pix ].prot ]->masksize;
+ m = (mask) ballocate(size);
+ if (m == NULL) errsignal(RTEMEMOV);
+ for (i = 0; i < size; i++ ) m[ i ] = '\0'; /* disable all */
+ process[ pix ].rpcmask = push(process[ pix ].rpcmask, m);
+}
+
+
+static void dupmask(pix) /* Duplicate RPC mask from stack top */
+word pix;
+{
+ mask m;
+ int size;
+
+ size = prototype[ process[ pix ].prot ]->masksize;
+ m = (mask) ballocate(size);
+ if (m == NULL) errsignal(RTEMEMOV);
+ moveblock(top(process[ pix ].rpcmask), m, (word) size);
+ process[ pix ].rpcmask = push(process[ pix ].rpcmask, m);
+}
+
+
+void popmask(pix) /* Pop RPC mask from stack (restore) */
+word pix;
+{
+ mask m;
+
+ m = top(process[ pix ].rpcmask);
+ process[ pix ].rpcmask = pop(process[ pix ].rpcmask);
+ free((char *) m);
+}
+
+
+void evaluaterpc(pix) /* Check if any waiting RPC is enabled */
+word pix;
+{
+ queue q;
+ message *msg;
+
+ q = process[ pix ].rpcwait;
+ if (!qempty(q))
+ {
+ do
+ {
+ msg = mfront(q);
+ if (isenabled(pix, msg->control.par))
+ {
+ process[ pix ].msgqueue = mpush(process[ pix ].msgqueue, msg);
+ process[ pix ].rpcwait = mdelete(process[ pix ].rpcwait, msg);
+ return;
+ }
+ q = qrotate(q);
+ } while (q != process[ pix ].rpcwait);
+ }
+}
+
+
+void rpc_accept(length) /* Accept remote procedure call */
+word length;
+{
+ int i;
+
+ dupmask(thispix);
+ for (i = 0; i < length; i++)
+ enable(thispix, virtprot(M[ ic++ ]));
+ evaluaterpc(thispix);
+ if (!rpcready(thispix))
+ passivate(ACCEPTING);
+}
+
+
+static bool rpcready(pix)
+word pix;
+{
+ procdescr *p;
+ message *msg;
+ word prot;
+
+ p = &process[ pix ];
+ while (!qempty(p->msgqueue))
+ {
+ msg = mfront(p->msgqueue);
+ prot = msg->control.par;
+ if (isenabled(pix, prot)) return(TRUE);
+ p->msgqueue = qremove(p->msgqueue);
+ p->rpcwait = minsert(p->rpcwait, msg);
+ }
+ return(FALSE);
+}
+
+
+word virtprot(prot) /* Get actual prototype for virtual */
+word prot;
+{
+ bool sign;
+ word virtnr;
+
+ sign = (prot < 0);
+ prot = absolute(prot);
+ virtnr = prototype[ prot ]->virtnumber;
+ if (virtnr != -1) prot = M[ prototype[ thisp->prot ]->virtlist+virtnr ];
+ if (sign) return(-prot); else return(prot);
+}
+
+
--- /dev/null
+ /* Loglan82 Compiler&Interpreter
+ Copyright (C) 1981-1993 Institute of Informatics, University of Warsaw
+ Copyright (C) 1993, 1994 LITA, Pau
+
+ 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; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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.
+
+ contacts: Andrzej.Salwicki@univ-pau.fr
+
+or Andrzej Salwicki
+ LITA Departement d'Informatique
+ Universite de Pau
+ Avenue de l'Universite
+ 64000 Pau FRANCE
+ tel. ++33 59923154 fax. ++33 59841696
+
+=======================================================================
+*/
+
+#include "depend.h"
+#include "genint.h"
+#include "int.h"
+#include "process.h"
+#include "intproto.h"
+
+
+/* Initialize memory structures for objects, main object and a few goodies
+ * more.
+ */
+
+void runsys()
+{
+ word apt, i;
+ procaddr father;
+
+ for (i = 0; i < MAXPROCESS; i++ ) /* initialize process descriptors */
+ {
+ process[ i ].used = FALSE; /* not used */
+ process[ i ].mark = -1; /* initial mark for processes */
+ process[ i ].M = NULL; /* memory not allocated */
+ process[ i ].hash = NULL;
+ }
+ process[ 0 ].M = M; /* always contains code */
+ dispoff = VIRTSC-(lastprot+1); /* DISPLAY offset in process object */
+ disp2off = dispoff-(lastprot+1); /* indirect DISPLAY offset */
+ ready = qinit(); /* initialize Round-Robin queue */
+ ranset(); /* init pseudo-random no. generator */
+
+#if OS2
+ {
+ SEL gsel, lsel;
+ DosGetInfoSeg(&gsel, &lsel);
+ ginf = MAKEPGINFOSEG(gsel);
+ }
+#endif
+
+ if (!remote) /* create main process */
+ {
+ father.node = 0; /* dummy DL for generated process */
+ father.pix = 0;
+ father.mark = 0;
+ thispix = 0; /* current process index */
+ thisp = &process[ thispix ]; /* current process descr pointer */
+ initprocess((word) 0, (word) MAINBLOCK, &father);
+ mainprog = thisp->prochead; /* am of main */
+ c1 = thisp->c1; /* pointers to current object */
+ c2 = thisp->c2;
+ ic = thisp->ic; /* instruction counter */
+ param = thisp->param; /* parameter vector */
+ apt = mainprog+M[ mainprog ]; /* LWA+1 of main */
+ display = apt+dispoff; /* DISPLAY in main */
+ display2 = apt+disp2off; /* indirect DISPLAY in main */
+ mnoff = 2; /* offset of variable mainprog */
+ storevirt(thisp->procref, mainprog+mnoff); /* init variable main */
+ M[ apt+STATSL ]++; /* flag main included in SL chain */
+ thisp->status = STOPPED;
+ activate(thispix); /* activate main process */
+ }
+ else /* remote */
+ {
+ thispix = 0; /* a dirty trick: set junk current
+*/
+ thisp = &process[ thispix ];/* process for first
+transfer() */
+ } /* (must save 'context' somewhere) */
+#if DLINK
+ net_attention();
+#endif
+}
+
+
+void initprocess(pix, prot, father) /* Initialize process descriptor */
+word pix, prot;
+procaddr *father;
+{
+ procdescr *p;
+ protdescr *ptr;
+ word i, j, ah, am, apt;
+
+#ifdef RPCDBG
+fprintf(stderr,"new process(n,p,m) (%d,%d,%d)",0,pix,process[pix].mark);
+fprintf(stderr," from (%d,%d,%d)\n",father->node,father->pix,father->mark);
+#endif
+
+ p = &process[ pix ];
+
+#ifdef OBJECTADDR
+ hash_create(p,119);
+#endif
+ p->used = TRUE; /* process descriptor is used */
+ p->prot = prot; /* prototype number */
+ p->freeitem = 0; /* null list of free dictionary items */
+ p->upper = memorysize-1; /* highest memory address */
+ p->lower = freem; /* lowest address for data */
+ p->headk = p->lower; /* head of killed objects list */
+ p->M[ p->headk ] = MAXAPPT; /* maximum appetite sentinel */
+ p->headk2 = 0;
+ ah = p->upper-1; /* dict. item for process itself */
+ p->lastitem = ah; /* first word used by dictionary */
+ ptr = prototype[ prot ];
+ if (p->upper - p->lower - ptr->appetite < 512)
+ if (prot == MAINBLOCK)
+ abend("Memory size too small (use /m option)\n");
+ else errsignal(RTEMEMOV);
+
+ /* generate process object */
+ p->lastused = p->lower+ptr->appetite;
+ am = p->lower+1;
+ p->M[ am ] = ptr->appetite;
+ p->M[ am+PROTNUM ] = prot;
+ for (i = PROTNUM+1; i < ptr->appetite; i++)
+ p->M[ am+i ] = 0;
+ p->M[ ah ] = am;
+ p->M[ ah+1 ] = 0;
+ p->prochead = am;
+ p->procref.addr = ah;
+ p->procref.mark = 0;
+ p->c1 = am; /* initialize current object ptrs */
+ p->c2 = am+ptr->span;
+ apt = am+ptr->appetite;
+ p->M[ apt+CHD ] = ah; /* initialize coroutine head ptr */
+ p->M[ apt+CHD+1 ] = 0;
+ p->M[ apt+SL ] = DUMMY; /* dummy SL for process */
+ p->M[ 1 ] = 1; /* absolute none */
+ for (i = MAINBLOCK; i <= lastprot; i++) /* initialize DISPLAY */
+ p->M[ apt+dispoff+i ] = 0;
+ p->M[ apt+disp2off+MAINBLOCK ] = DUMMY; /* dummmy entry for MAIN */
+ j = ptr->preflist; /* set DISPLAY entries for process */
+
+ for (i = j+ptr->lthpreflist-1; i >= j; i--)
+ {
+ p->M[ apt+dispoff+M[ i ] ] = am; /* physical address */
+ p->M[ apt+disp2off+M[ i ] ] = ah; /* indirect address */
+ }
+
+ {
+ virtaddr v;
+ mess2obj( p, father, &v );
+ p->M[ apt+DL ] = v.addr;
+ p->M[ apt+DL+1 ] = v.mark;
+ }
+ p->msgqueue = qinit();
+ p->rpcwait = qinit();
+ p->rpcmask = sinit();
+ pushmask(pix); /* initialy all RPCs are disabled */
+ p->trlnumber = 0; /* trace line number */
+ i = ptr->preflist; /* search for executable prefix */
+ while (prototype[ p->M[ i ] ]->kind == RECORD) i++;
+ p->ic = prototype[ M[ i ] ]->codeaddr; /* first instruction address */
+ p->force_compactification=FALSE;
+}
+
+
+bool member(virt, am)
+virtaddr *virt;
+word *am;
+{
+ *am = M[ virt->addr ];
+ /* if (virt->mark == M[ virt->addr+1] ) fprintf(stderr, "Yes");
+ else {fprintf(stderr, "No");}; */
+ return (virt->mark == M[ virt->addr+1 ]);
+}
+
+
+void update(am, ah) /* Update DISPLAY */
+word am, ah;
+{
+ word t1, t2, t3, t4, t5, t6;
+ protdescr *ptr;
+
+ while (TRUE)
+ {
+ t1 = am+M[ am ];
+ M[ t1+STATSL ]++; /* flag object included in SL */
+ ptr = prototype[ M[ am+PROTNUM ] ];
+ t2 = ptr->preflist;
+ t3 = t2+ptr->lthpreflist-1;
+ for (t4 = t3; t4 >= t2; t4-- )
+ {
+ t6 = M[ t4 ];
+ t5 = display+t6;
+ if (M[ t5 ] == 0) /* entry to be updated */
+ {
+ M[ t5 ] = am;
+ M[ display2+t6 ] = ah;
+ }
+ }
+ ah = M[ t1+SL ];
+ if (ah == DUMMY) break;
+ if (M[ ah+1 ] != M[ t1+SL+1 ]) errsignal(RTESLCOF);
+ am = M[ ah ];
+ }
+}
+
+
+void loosen() /* Loosen DISPLAY */
+{
+ word t1, t2, t3;
+ protdescr *ptr;
+
+ t1 = c1;
+ while (TRUE)
+ {
+ ptr = prototype[ M[ t1+PROTNUM ] ];
+ t2 = ptr->preflist;
+ for (t3 = t2+ptr->lthpreflist-1; t3 >= t2; t3-- )
+ M[ display+M[ t3 ] ] = 0;
+ t3 = t1+M[ t1 ];
+ M[ t3+STATSL ]--; /* flag object removed from SL */
+ t1 = M[ t3+SL ]; /* ah of SL */
+ if (t1 == DUMMY) break; /* still not main */
+ t1 = M[ t1 ]; /* am of SL */
+ }
+}
+
+
+static int tracecnt = 0; /* To count trace messages in line */
+
+void trace(lineno) /* Trace the program if debug mode */
+word lineno;
+{
+ thisp->trlnumber = lineno;
+ if (debug && lineno > 0)
+ {
+ tracecnt++;
+ if (tracecnt == MAXTRACNT) /* change line */
+ {
+ tracecnt = 0;
+ fprintf(tracefile, "\n");
+ }
+ fprintf(tracefile, "%6ld", (long) lineno);
+ }
+ trapmsg(); /* check for waiting message */
+ rpc2(); /* check for RPC message */
+}
+
+
+void endrun(status)
+int status;
+{
+ MESSAGE msg;
+ G_MESSAGE m;
+ int i;
+
+ if (debug) fclose(tracefile);
+
+
+ msg.msg_type = MSG_INT;
+ msg.param.pword[0] = INT_EXITING;
+ strcpy(msg.param.pstr,ProgName);
+ write(internal_sock,&msg,sizeof(MESSAGE));
+ m.msg_type = MSG_GRAPH;
+ m.param.pword[0] = GRAPH_FREE;
+ write(graph_sock,&m,sizeof(G_MESSAGE));
+ close(internal_sock);
+ close(graph_sock);
+ close(net_sock);
+ unlink(mygname);
+ unlink(mykname);
+ unlink(mynname);
+ for(i=0;i<255;i++)
+ if (DirConn[i]!=-1) close(DirConn[i]);
+ exit(status);
+}
+
+
--- /dev/null
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <sys/un.h>
+#include <errno.h>
--- /dev/null
+ /* Loglan82 Compiler&Interpreter
+ Copyright (C) 1981-1993 Institute of Informatics, University of Warsaw
+ Copyright (C) 1993, 1994 LITA, Pau
+
+ 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; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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.
+
+ contacts: Andrzej.Salwicki@univ-pau.fr
+
+or Andrzej Salwicki
+ LITA Departement d'Informatique
+ Universite de Pau
+ Avenue de l'Universite
+ 64000 Pau FRANCE
+ tel. ++33 59923154 fax. ++33 59841696
+
+=======================================================================
+*/
+
+#include "depend.h"
+#include "genint.h"
+#include "int.h"
+#include "process.h"
+#include "intproto.h"
+
+#include <math.h>
+#include <time.h>
+
+/* Call standard procedure */
+
+void standard(nrproc) /* Process call to a standard proc. */
+word nrproc;
+{
+ word t1, t2, t3, t5, t6;
+ double r;
+ bool absent;
+ int ch, n;
+ long tim;
+ char *cp;
+ FILE *fp;
+ char s[80];
+
+ absent = FALSE;
+
+#ifdef TRACE
+ fprintf( stderr, "standard procedure %d\n", nrproc );
+#endif
+
+ switch ((int) nrproc)
+ {
+ case 1 : /* new array */
+ newarry(param[ 1 ].xword, param[ 0 ].xword, param[ 2 ].xword,
+ ¶m[ 3 ].xvirt, ¶m[ 4 ].xword);
+ break;
+
+ case 2 : /* rew */
+ case 3 : /* avf */
+ case 4 : /* bsf */
+ case 5 : /* weo */
+ case 6 : /* putrec */
+ case 7 : /* getrec */
+ case 8 : /* ass */
+ case 9 : /* assin */
+ case 10 : /* assout */
+ absent = TRUE;
+ break;
+
+ case 11 : /* unpack:function(s:string):arrayof char */
+ t1 = strings+param[ 0 ].xword+1;
+ t6 = M[ t1-1 ]; /* length of the string */
+ if (t6 > 0) /* string not null */
+ {
+ newarry((word) 1, t6, (word) AINT, ¶m[ 1 ].xvirt, &t5);
+ t5 += 3;
+ cp = (char *) &M[ t1 ];
+ while (t6-- > 0) M[ t5++ ] = *cp++;
+ }
+ else /* null string */
+ {
+ param[ 1 ].xvirt.addr = 0;
+ param[ 1 ].xvirt.mark = 0;
+ }
+ break;
+
+ case 12 : /* random:function:real */
+ param[ 0 ].xreal = (real)prandom();
+ break;
+
+ case 13 : /* time:function:integer */
+ time(&tim);
+ param[ 0 ].xword = tim;
+ break;
+
+ case 14 : /* sqrt:function(x:real):real */
+ param[ 1 ].xreal = (real)sqrt((double) param[ 0 ].xreal);
+ break;
+
+ case 15 : /* entier:function(x:real):integer */
+ param[ 1 ].xword = entier((double) param[ 0 ].xreal);
+ break;
+
+ case 16 : /* round:function(x:real):integer */
+ param[ 1 ].xword = entier((double) (param[ 0 ].xreal+0.5));
+ break;
+
+ case 17 : /* unused */
+ case 18 : /* intrinsic procedure */
+ absent = TRUE;
+ break;
+
+ case 19 : /* imin:function(x, y:integer):integer */
+ param[ 2 ].xword = min(param[ 0 ].xword, param[ 1 ].xword);
+ break;
+
+ case 20 : /* imax:function(x, y:integer):integer */
+ param[ 2 ].xword = max(param[ 0 ].xword, param[ 1 ].xword);
+ break;
+
+ case 21 : /* imin3:function(x, y, z:integer):integer */
+ t1 = min(param[ 0 ].xword, param[ 1 ].xword);
+ param[ 3 ].xword = min(t1, param[ 2 ].xword);
+ break;
+
+ case 22 : /* imax3:function(x, y, z:integer):integer */
+ t1 = max(param[ 0 ].xword, param[ 1 ].xword);
+ param[ 3 ].xword = max(t1, param[ 2 ].xword);
+ break;
+
+ case 23 : /* sin:function(x:real):real */
+ param[ 1 ].xreal = (real)sin((double) param[ 0 ].xreal);
+ break;
+
+ case 24 : /* cos:function(x:real):real */
+ param[ 1 ].xreal = (real)cos((double) param[ 0 ].xreal);
+ break;
+
+ case 25 : /* tan:function(x:real):real */
+ r = cos((double) param[ 0 ].xreal);
+ if (r == 0.0) errsignal(RTEDIVBZ);
+ param[ 1 ].xreal = (real)sin((double) param[ 0 ].xreal) / r;
+ break;
+
+ case 26 : /* exp:function(x:real):real */
+ param[ 1 ].xreal = (real)exp((double) param[ 0 ].xreal);
+ break;
+
+ case 27 : /* ln:function(x:real):real */
+ param[ 1 ].xreal = (real)log((double) param[ 0 ].xreal);
+ break;
+
+ case 28 : /* atan:function(x:real):real */
+ param[ 1 ].xreal = (real)atan((double) param[ 0 ].xreal);
+ break;
+
+ case 29 : /* endrun:procedure */
+ endrun(0);
+ break;
+
+ case 30 : /* ranset:procedure(x:real) */
+ ranset();
+ break;
+
+ case 31 : /* clock */
+ case 32 : /* option */
+ case 33 : /* lock */
+ case 34 : /* unlock */
+ case 35 : /* sched, boy! */
+ case 36 : /* date */
+ case 37 : /* execpar */
+ case 38 : /* test&set */
+ absent = TRUE;
+ break;
+
+ case 39 : /* eof */
+ param[ 0 ].xbool = lbool(testeof(stdin));
+ break;
+
+ case 40 : /* eof(f) */
+ loadfile((word) UNKNOWN, &t1, &t2, &fp);
+ t3 = M[ t2+FSTAT ];
+ if (t3 == READING || t3 == UPDATING)
+ param[ 0 ].xbool = lbool(testeof(fp));
+ else errsignal(RTEILLIO);
+ break;
+
+ case 41 : /* readln */
+ readln(stdin);
+ break;
+
+ case 42 : /* readln(f) */
+ loadfile((word) READING, &t1, &t2, &fp);
+ if (t1 != TEXTF) errsignal(RTEILLIO);
+ readln(fp);
+ break;
+
+ case 43 : /* readchar */
+ param[ 0 ].xword = read_char();
+ break;
+
+ case 44 : /* readchar(f) */
+ loadfile((word) READING, &t1, &t2, &fp);
+ if (t1 != TEXTF) errsignal(RTEILLIO);
+ if ((ch = getc(fp)) == EOF) errsignal(RTEIOERR);
+ param[ 0 ].xword = ch;
+ break;
+
+ case 45 : /* readint */
+ read_str(s);
+ param[ 0 ].xword = atoi(s);
+ break;
+
+ case 46 : /* readint(f) */
+ loadfile((word) READING, &t1, &t2, &fp);
+ if (t1 != TEXTF) errsignal(RTEILLIO);
+ param[ 0 ].xword = readint(fp);
+ break;
+
+ case 47 : /* readreal */
+ read_str(s);
+ param[ 0 ].xreal = (real)atof(s);
+ break;
+
+ case 48 : /* readreal(f) */
+ loadfile((word) READING, &t1, &t2, &fp);
+ if (t1 != TEXTF) errsignal(RTEILLIO);
+ param[ 0 ].xreal = (real)readreal(fp);
+ break;
+
+ case 49 : /* getchar(f) */
+ loadfile((word) READING, &t1, &t2, &fp);
+ if (t1 != CHARF) errsignal(RTEILLIO);
+ if ((ch = getc(fp)) == EOF) errsignal(RTEIOERR);
+ param[ 0 ].xword = ch;
+ break;
+
+ case 50 : /* getint(f) */
+ loadfile((word) READING, &t1, &t2, &fp);
+ if (t1 != INTF) errsignal(RTEILLIO);
+ n = fread((char *) ¶m[ 0 ].xword, sizeof(word), 1, fp);
+ if (n != 1) errsignal(RTEIOERR);
+ break;
+
+ case 51 : /* getreal(f) */
+ loadfile((word) READING, &t1, &t2, &fp);
+ if (t1 != REALF) errsignal(RTEILLIO);
+ n = fread((char *) ¶m[ 0 ].xreal, sizeof(real), 1, fp);
+ if (n != 1) errsignal(RTEIOERR);
+ break;
+
+ case 52 : /* getobject(f) */
+ absent = TRUE;
+ break;
+
+ case 53 : /* putchar(f) */
+ loadfile((word) WRITING, &t1, &t2, &fp);
+ if (t1 != CHARF) errsignal(RTEILLIO);
+ ch = (char) param[ 0 ].xword;
+ if (putc(ch, fp) == EOF) errsignal(RTEIOERR);
+ break;
+
+ case 54 : /* putint(f) */
+ loadfile((word) WRITING, &t1, &t2, &fp);
+ if (t1 != INTF) errsignal(RTEILLIO);
+ n = fwrite((char *) ¶m[ 0 ].xword, sizeof(word), 1, fp);
+ if (n != 1) errsignal(RTEIOERR);
+ break;
+
+ case 55 : /* putreal(f) */
+ loadfile((word) WRITING, &t1, &t2, &fp);
+ if (t1 != REALF) errsignal(RTEILLIO);
+ n = fwrite((char *) ¶m[ 0 ].xreal, sizeof(real), 1, fp);
+ if (n != 1) errsignal(RTEIOERR);
+ break;
+
+ case 56 : /* putobject(f) */
+ case 57 : /* putstring(f) */
+ absent = TRUE;
+ break;
+
+ case 58 : /* writeln(f) */
+ loadfile((word) WRITING, &t1, &t2, &fp);
+ if (t1 != TEXTF) errsignal(RTEILLIO);
+ if (putc('\n', fp) == EOF) errsignal(RTEIOERR);
+ if (fflush(fp)) errsignal(RTEIOERR);
+ break;
+
+ case 59 : /* writeln */
+ write_str("\n");
+ break;
+
+ case 60 : /* writechar(f) */
+ loadfile((word) WRITING, &t1, &t2, &fp);
+ if (t1 != TEXTF) errsignal(RTEILLIO);
+ if (putc((char) param[ 0 ].xword, fp) == EOF)
+ errsignal(RTEIOERR);
+ break;
+
+ case 61 : /* writechar */
+ write_char((char) param[ 0 ].xword);
+ break;
+
+ case 62 : /* writeint(f) */
+ loadfile((word) WRITING, &t1, &t2, &fp);
+ if (t1 != TEXTF) errsignal(RTEILLIO);
+ writeint(param[ 0 ].xword, param[ 1 ].xword, fp);
+ break;
+
+ case 63 : /* writeint */
+ writeint(param[ 0 ].xword, param[ 1 ].xword, stdout);
+ break;
+
+ case 64 : /* writereal0(f) */
+ case 66 : /* writereal1(f) */
+ case 68 : /* writereal2(f) */
+ loadfile((word) WRITING, &t1, &t2, &fp);
+ if (t1 != TEXTF) errsignal(RTEILLIO);
+ writereal((double) param[ 0 ].xreal, param[ 1 ].xword,
+ param[ 2 ].xword, fp);
+ break;
+
+ case 65 : /* writereal0 */
+ case 67 : /* writereal1 */
+ case 69 : /* writereal2 */
+ writereal((double) param[ 0 ].xreal, param[ 1 ].xword,
+ param[ 2 ].xword, stdout);
+ break;
+
+ case 70 : /* writestring(f) */
+ loadfile((word) WRITING, &t1, &t2, &fp);
+ if (t1 != TEXTF) errsignal(RTEILLIO);
+ writestring(param[ 0 ].xword, param[ 1 ].xword, fp);
+ break;
+
+ case 71 : /* writestring */
+ writestring(param[ 0 ].xword, param[ 1 ].xword, stdout);
+ break;
+
+ case 72 : /* open temporary file */
+ genfileobj(TRUE , param[ 1 ].xword, tempfilename(),
+ ¶m[ 0 ].xvirt, &t1);
+ break;
+
+ case 73 : /* open external file */
+ genfileobj(FALSE, param[ 1 ].xword, asciiz(¶m[ 2 ].xvirt),
+ ¶m[ 0 ].xvirt, &t1);
+ break;
+
+ case 74 : /* eoln */
+ param[ 0 ].xbool = lbool(testeoln(stdin));
+ break;
+
+ case 75 : /* eoln(f) */
+ loadfile((word) READING, &t1, &t2, &fp);
+ if (t1 != TEXTF) errsignal(RTEILLIO);
+ param[ 0 ].xbool = lbool(testeoln(fp));
+ break;
+
+ case 76 : /* this coroutine */
+ loadvirt(param[ 0 ].xvirt,
+ thisp->prochead+M[ thisp->prochead ]+CHD);
+ break;
+
+ case 77 : /* this process */
+ {
+ procaddr p;
+ virtaddr v;
+ p.node = ournode;
+ p.pix = thispix;
+ p.mark = thisp->mark;
+ mess2obj( thisp, &p, &v );
+ param[ 0 ].xvirt = v;
+ }
+ break;
+
+ case 78 : /* reset:procedure(f:file) */
+ if (member(¶m[ 0 ].xvirt, &t2))
+ reset(t2);
+ else errsignal(RTEREFTN);
+ break;
+
+ case 79 : /* rewrite:procedure(f:file) */
+ if (member(¶m[ 0 ].xvirt, &t2))
+ rewrite(t2);
+ else errsignal(RTEREFTN);
+ break;
+
+ case 80 : /* unlink:procedure(f:file) */
+ delete(¶m[ 0 ].xvirt);
+ break;
+
+ case 81 : /* seek:procedure(f:file, offset, base:integer) */
+ storevirt(param[ 0 ].xvirt, currfile);
+ loadfile((word) UPDATING, &t1, &t2, &fp);
+ if (t1 != DIRECT) errsignal(RTEILLIO);
+ if (fseek(fp, (long) param[ 1 ].xword, (int) param[ 2 ].xword))
+ errsignal(RTEIOERR);
+ break;
+
+ case 82 : /* getrec(f, a, n) */
+ loadfile((word) UPDATING, &t1, &t2, &fp);
+ if (t1 != DIRECT) errsignal(RTEILLIO);
+ param[ 1 ].xword = directio(
+ ¶m[ 0 ].xvirt,
+ param[ 1 ].xword,
+ (int (*)())fread,
+ fp
+ );
+ break;
+
+ case 83 : /* putrec(f, a, n) */
+ loadfile((word) UPDATING, &t1, &t2, &fp);
+ if (t1 != DIRECT) errsignal(RTEILLIO);
+ param[ 1 ].xword = directio(
+ ¶m[ 0 ].xvirt,
+ param[ 1 ].xword,
+ (int (*)())fwrite,
+ fp
+ );
+ break;
+
+ case 84 : /* position:function(f:file):real */
+ storevirt(param[ 0 ].xvirt, currfile);
+ loadfile((word) UPDATING, &t1, &t2, &fp);
+ if (t1 != DIRECT) errsignal(RTEILLIO);
+ param[ 1 ].xword =(int) ftell(fp);
+ break;
+
+ case 98 : /* memavail:function:integer */
+ param[ 0 ].xword = memavail();
+ break;
+
+ case 99 : /* exec:function(c:arrayof char):integer */
+ cp = asciiz(¶m[ 0 ].xvirt);
+ param[ 1 ].xword = system(cp);
+ free(cp);
+ break;
+
+ default :
+ nonstandard(nrproc);
+ break;
+ }
+# if TRACE
+ fflush( stdout );
+# endif
+ if (absent) errsignal(RTEUNSTP);
+}
+
+
--- /dev/null
+ /* Loglan82 Compiler&Interpreter
+ Copyright (C) 1981-1993 Institute of Informatics, University of Warsaw
+ Copyright (C) 1993, 1994 LITA, Pau
+
+ 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; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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.
+
+ contacts: Andrzej.Salwicki@univ-pau.fr
+
+or Andrzej Salwicki
+ LITA Departement d'Informatique
+ Universite de Pau
+ Avenue de l'Universite
+ 64000 Pau FRANCE
+ tel. ++33 59923154 fax. ++33 59841696
+
+=======================================================================
+*/
+
+#include "depend.h"
+#include "genint.h"
+#include "int.h"
+#include "process.h"
+#include "intproto.h"
+
+/* Type checking routines */
+
+
+/* Determine if prot occurs in the prefix sequence of object am
+ */
+
+#ifndef NO_PROTOTYPES
+static bool pref(word,word);
+static bool typep0(word,word,bool,word *,word *);
+static bool prefh(word,word);
+static bool typef(word,word,word,word);
+#else
+static bool pref();
+static bool typep0();
+static bool prefh();
+static bool typef();
+#endif
+
+
+static bool pref(am, prot)
+word am, prot;
+{
+ word t1, t2;
+ protdescr *ptr;
+
+ t1 = M[ am+PROTNUM ];
+ if (t1 != AINT && t1 != AVIRT && t1 != AREAL && t1 != FILEOBJECT)
+ { /* neither array nor file */
+ ptr = prototype[ t1 ];
+ t1 = ptr->preflist;
+ t2 = t1+ptr->lthpreflist;
+ while (t1 < t2)
+ {
+ if (prot == M[ t1 ]) return (TRUE);
+ t1++;
+ }
+ }
+ return (FALSE);
+} /* end pref */
+
+
+void qua(virt, tp) /* Validate qualification of object */
+virtaddr *virt;
+word tp;
+{
+ if (virt->mark != M[ virt->addr+1 ]) errsignal(RTEREFTN);
+ if (M[ tp ] != CLASSTYPE) errsignal(RTEINCQA);
+ if (!pref(M[ virt->addr ], M[ tp+1 ])) errsignal(RTEINCQA);
+} /* end qua */
+
+
+bool inl(virt, tp) /* Determine if A in B */
+virtaddr *virt;
+word tp;
+{
+ if (virt->mark != M[ virt->addr+1 ])
+ return (TRUE); /* none is in everything */
+ else
+ if (M[ tp ] != CLASSTYPE) return (FALSE);
+ else return (pref(M[ virt->addr ], M[ tp+1 ]));
+} /* end inl */
+
+
+bool is(virt, tp) /* Determine if A is B */
+virtaddr *virt;
+word tp;
+{
+ if (virt->mark != M[ virt->addr+1 ] || M[ tp ] != CLASSTYPE)
+ return (FALSE);
+ else return (M[ M[ virt->addr ]+PROTNUM ] == M[ tp+1 ]);
+} /* end is */
+
+
+/* Check correctness of an especially clumsy assignment statement
+ */
+
+void typref(virt, tp)
+virtaddr *virt;
+word tp;
+{
+ word t1, t2, t3;
+ int knd;
+
+ if (virt->mark == M[ virt->addr+1 ]) /* none always allowed */
+ {
+ t3 = M[ virt->addr ]; /* am of right hand side */
+ t1 = M[ t3+PROTNUM ];
+ if (t1 == AINT || t1 == AREAL || t1 == AVIRT) errsignal(RTEINCAS);
+ t2 = M[ tp ]; /* right hand side type */
+ if (t2 == FILETYPE)
+ {
+ if (t1 != FILEOBJECT) errsignal(RTEINCAS);
+ }
+ else
+ if (t2 == PURECOROUTINE || t2 == PUREPROCESS)
+ {
+ if (t2 == PURECOROUTINE) knd = COROUTINE;
+ else knd = PROCESS;
+ if (prototype[ t1 ]->kind != knd) errsignal(RTEINCAS);
+ }
+ else
+ {
+ if (t2 != CLASSTYPE) errsignal(RTEINCAS);
+ if (!pref(t3, M[ tp+1 ])) errsignal(RTEINCAS);
+ }
+ }
+} /* end typref */
+
+
+/* Check correctness of a dynamic assignment
+ */
+
+void typed(ldim, lt, rdim, rt, virt)
+word ldim, lt, rdim, rt;
+virtaddr *virt;
+{
+ if (ldim != rdim) errsignal(RTEINCAS);
+ if (ldim == 0) typref(virt, lt);
+ else
+ if (lt != rt) errsignal(RTEINCAS);
+} /* end typed */
+
+
+/* Search the SL chain of object am to find the nearest Y such that Y in A.
+ * prot = prototype number of A
+ */
+
+word loadt(am, prot)
+word am, prot;
+{
+ word t1, t2, t3, t4;
+
+ while( !pref(am, prot) )
+ {
+ t1 = am+M[ am ]+SL;
+ t2 = M[ t1 ]; /* try next object in chain */
+ t3 = M[ t1+1 ];
+ t4 = M[ t2+1 ];
+ if( t3 != t4 ) errsignal( RTEFTPMS );
+ am = M[ t2 ];
+ }
+ return (am);
+}
+
+
+/* Compute type of a formal parameter - see also typep (below). */
+
+static bool typep0(am, pdaddr, protp, dim, tp)
+word am, pdaddr;
+bool protp;
+word *dim, *tp;
+{
+ word t1;
+ protdescr *ptr;
+
+ if (protp) /* prototype number on input */
+ {
+ ptr = prototype[ pdaddr ];
+ *dim = ptr->nrarray;
+ *tp = ptr->finaltype;
+ }
+ else /* type address on input */
+ {
+ *dim = M[ pdaddr+1 ];
+ *tp = M[ pdaddr+2 ];
+ }
+ if (M[ *tp ] != FORMTYPE) return (TRUE);
+ else
+ {
+ t1 = M[ *tp+1 ]; /* SL prototype number */
+ if (t1 == DUMMY) return (FALSE);
+ else /* undefined */
+ {
+ *tp = loadt(am, t1)+M[ *tp+2 ];
+ *dim += M[ *tp ]; /* accumulate dim */
+ *tp = M[ *tp+1 ];
+ return (TRUE); /* AIL 1989.02.02 */
+ }
+ }
+} /* end typep0 */
+
+
+void typep(am, nr, dim, tp) /* Compute type of formal parameter */
+word am, nr;
+word *dim, *tp;
+{
+ if (!typep0(am, M[ prototype[ M[ am+PROTNUM ] ]->pfdescr+nr ],
+ FALSE, dim, tp)) errsignal(RTESYSER);
+} /* end typep */
+
+
+/* Auxiliary function for heads, almost the same as pref.
+ */
+
+static bool prefh(tp, prot)
+word tp, prot;
+{
+ word t1, t2;
+ protdescr *ptr;
+
+ ptr = prototype[ M[ tp+1 ] ];
+ t2 = ptr->preflist;
+ t1 = t2+ptr->lthpreflist-1;
+ do
+ {
+ if (M[ t1 ] == prot) return (TRUE);
+ else t1--;
+ } while (t1 >= t2);
+ return (FALSE);
+} /* end prefh */
+
+
+/* Check compatibility of generalized types, used by heads only.
+ */
+
+static bool typef(dima, ta, dimb, tb)
+word dima, ta, dimb, tb;
+{
+ word t1, t2;
+ int knd;
+
+ if (dima != dimb) errsignal(RTEINCHS); /* incompatible headers */
+ if (ta != tb) /* types different somehow */
+ {
+ if (dima != 0) errsignal(RTEINCHS); /* dim must be 0 now */
+ t1 = M[ ta ];
+ t2 = M[ tb ];
+ if (t1 == PRIMITIVETYPE || t1 == FILETYPE) errsignal(RTEINCHS);
+ if (t2 == PRIMITIVETYPE || t2 == FILETYPE) errsignal(RTEINCHS);
+ if (t1 != PURECOROUTINE && t1 != PUREPROCESS)
+ {
+ if (t2 == PURECOROUTINE || t2 == PUREPROCESS) return (TRUE);
+ else
+ {
+ if (!prefh(ta, M[ tb+1 ]))
+ {
+ if (!prefh(tb, M[ ta+1 ])) errsignal(RTEINCHS);
+ else return (TRUE);
+ }
+ }
+ }
+ else /* something pure */
+ {
+ if (t1 != t2)
+ {
+ /* AIL : t1 below replaced with t2, 1989.02.02 */
+ /* if (t1 == PURECOROUTINE || t1 == PUREPROCESS) */
+ if (t2 == PURECOROUTINE || t2 == PUREPROCESS)
+ knd = RECORD; /* used as junk */
+ else knd = prototype[ M[ tb+1 ] ]->kind;
+
+ if ((t1 == PURECOROUTINE && knd != COROUTINE) ||
+ (t1 == PUREPROCESS && knd != PROCESS))
+ {
+ if ((t1 != PURECOROUTINE) ||
+ (knd != PROCESS && t2 != PUREPROCESS))
+ return (TRUE);
+ }
+ }
+ }
+ }
+ return (FALSE);
+} /* end typef */
+
+
+/* Verify the compatibility of formal/actual procedure (function) heads.
+ */
+
+void heads(virt, nr)
+virtaddr *virt;
+word nr;
+{
+ word i, j, fp, gp, oba, g, slen, dim, t1, t2, tp, ftv;
+ protdescr *ptr;
+ bool junk;
+ word x[ MAXHDLEN+1 ], y[ MAXHDLEN+1 ];
+ /* The two arrays declared above may be dynamically generated as objects */
+ /* upon entry to heads. In fact heads was implemented this way in the */
+ /* original LOGLAN running system on MERA-400 */
+
+ oba = M[ virt->addr ];
+ ptr = prototype[ M[ oba+PROTNUM ] ];
+ fp = M[ ptr->pfdescr+nr ]; /* parameter description pointer */
+ slen = M[ fp+2 ]; /* length of its desclist */
+ if (slen > MAXHDLEN) errsignal(RTEFHTLG);
+ ftv = oba+M[ ptr->parlist+nr ]; /* type value pointer */
+ g = M[ ftv ];
+ if (M[ ftv+1 ] == M[ g+1 ]) /* not none */
+ g = M[ g ]; /* am of SL */
+ else errsignal(RTESLCOF); /* SL chain cut off */
+ gp = M[ ftv+2 ]; /* prototype number of g */
+ ptr = prototype[ gp ];
+ t2 = M[ fp ]; /* t2 = F-kind */
+ if (ptr->kind == FUNCTION)
+ {
+ if (t2 != FORMFUNC) errsignal(RTEINCHS);
+ junk = typep0(g, gp, TRUE, &dim, &tp);
+ junk = typep0(oba, fp+2, FALSE, &t1, &t2);
+ if (typef(dim, tp, t1, t2)) errsignal(RTEINCHS);
+ }
+ else
+ if (t2 != FORMPROC) errsignal(RTEINCHS);
+ if (slen != ptr->lthparlist) /* incompatible lengths */
+ errsignal(RTEINCHS);
+ t1 = M[ fp+1 ]-1; /* oba descriptlist */
+ t2 = ptr->pfdescr-1; /* g descriptlist */
+ for (i = 1; i <= slen; i++ ) /* verify second order lists */
+ {
+ x[ i ] = DUMMY; /* mark entry as empty */
+ y[ i ] = DUMMY;
+ fp = M[ t1+i ]; /* first type pointer */
+ gp = M[ t2+i ]; /* second type pointer */
+ tp = M[ fp ]; /* first type ordinal */
+ if (tp != M[ gp ]) errsignal(RTEINCHS);
+ if (tp == FORMTYPE)
+ {
+ x[ i ] = fp; /* save pointers to formal types */
+ y[ i ] = gp;
+ }
+ else
+ {
+ if (tp == PARIN || tp == PAROUT || tp == PARINOUT)
+ {
+ /* AIL 1989.02.02 */
+ /* if (typep0(oba, fp, FALSE, &dim, &tp)) */
+ if (! typep0(oba, fp, FALSE, &dim, &tp))
+ { /* undefined yet */
+ /* search preceding formals */
+ for (j = 1; j <= i; j++ )
+ if (x[ j ] == M[ fp+2 ])
+ break;
+ if (j > i) errsignal(RTEINCHS);
+ if (y[ j ] != M[ gp+2 ]) errsignal(RTEINCHS);
+ }
+ else /* already defined */
+ {
+ for (j = 1; j <= i; j++ )
+ if (y [ j ] == M[ gp+2 ])
+ errsignal(RTEINCHS);
+ junk = typep0(g, gp, FALSE, &j, &ftv);
+ junk = typef(dim, tp, j, ftv);
+ }
+ }
+ }
+ }
+}
+
--- /dev/null
+ /* Loglan82 Compiler&Interpreter
+ Copyright (C) 1981-1993 Institute of Informatics, University of Warsaw
+ Copyright (C) 1993, 1994 LITA, Pau
+
+ 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; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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.
+
+ contacts: Andrzej.Salwicki@univ-pau.fr
+
+or Andrzej Salwicki
+ LITA Departement d'Informatique
+ Universite de Pau
+ Avenue de l'Universite
+ 64000 Pau FRANCE
+ tel. ++33 59923154 fax. ++33 59841696
+
+=======================================================================
+*/
+
+#include "depend.h"
+#include "genint.h"
+#include "int.h"
+#include "process.h"
+#include "intproto.h"
+
+
+#include <time.h>
+
+/* Utility routines */
+
+
+word entier(x) /* Compute entier (floor) */
+double x;
+{
+ word i;
+
+ if (x >= 0.0)
+ {
+ i = (word)x;
+ return(i);
+ }
+ else
+ {
+ i = (word)(-x);
+ i = -i;
+ if ((double)i <= x) return(i); else return(i-1);
+ }
+} /* end entier */
+
+
+word shift(x, n) /* shift x by n bits */
+word x, n;
+{
+ if (n == 0) return (x);
+ if (n > 0) return (x << n);
+ else return ( (x >> -n) & ~(~(word)0 << (8*sizeof(word)+n)) );
+} /* end shift */
+
+
+char *asciiz(virt) /* Get ASCIIZ string from arrayof char */
+virtaddr *virt;
+{
+ word am;
+ int len, i;
+ char *cp;
+
+ if (member(virt, &am))
+ {
+ len = M[ am ]-3; /* length of the string */
+ cp = ballocate(len+1); /* allocate buffer for the string */
+ if (cp == NULL) errsignal(RTEMEMOV);
+ for (i = 0; i < len; i++) cp[ i ] = (char) M[ am+3+i ];
+ cp[ len ] = '\0'; /* terminate string with 0 byte */
+ return (cp);
+ }
+ else errsignal(RTEREFTN); /* reference to none */
+} /* end asciiz */
+
+
+void addext(fname, ext) /* Add extension to a file name */
+char *fname, *ext;
+{
+ char *cp;
+
+ cp = fname;
+ while (*cp != '\0' && *cp != '.') cp++;
+ strcpy(cp, ext);
+} /* end addext */
+
+
+void usage()
+{
+}
+
+
+void abend(msg) /* Print error message and abort */
+char *msg;
+{
+ fprintf(stderr, "Error: %s\n", msg);
+ exit(8);
+} /* end abend */
+
+
+/* Pseudo random number generator */
+
+static int ranpat1 = 7, ranpat2 = 503, ranpat3 = 15661;
+
+void ranset() /* Initialize generator */
+{
+ long tim;
+
+ time(&tim);
+ ranpat1 = tim % 30269;
+ ranpat2 = tim % 30307;
+ ranpat3 = tim % 30323;
+} /* end ranset */
+
+
+double prandom() /* Produce next pseudo random number */
+{
+ int i;
+ double r;
+
+ ranpat1 = 171*(ranpat1 % 177)- 2*(ranpat1 / 177);
+ if (ranpat1 < 0) ranpat1 += 30269;
+ ranpat2 = 172*(ranpat2 % 176)-35*(ranpat2 / 176);
+ if (ranpat2 < 0) ranpat2 += 30307;
+ ranpat3 = 170*(ranpat3 % 178)-63*(ranpat3 / 178);
+ if (ranpat3 < 0) ranpat3 += 30323;
+ r = ranpat1/30269.0 + ranpat2/30307.0 + ranpat3/30323.0;
+ i = (int)r;
+ return (r-i);
+}
+
+
+void moveblock(from, to, len) /* Copy a block of memory */
+char *from, *to;
+word len;
+{
+ while (len-- > 0) *to++ = *from++;
+} /* end moveblock */
+
+
+/**************************************************************
+
+#define LINE 10
+void dump(pix, from, len)
+word pix, from;
+int len;
+{
+ int i;
+ memory M;
+
+ M = process[ pix ].M;
+ while (len > 0)
+ {
+ printf("%6ld: ", (long) from);
+ for (i = 0; i < LINE; i++) printf("%7ld", (long)M[from++]);
+ putchar('\n');
+ len -= LINE;
+ }
+}
+
+ **************************************************************/
+
--- /dev/null
+### Includes for QT library
+QINC=/usr/lib/qt-1.45/include
+
+### QT library directory
+QLIB=/usr/lib/qt-1.45/lib
+
+### moc compiler directory
+MOCDIR=/usr/lib/qt-1.45/bin
+
+### Install directory
+INSTALLDIR=/usr/local/vlp
+
+INCDIR = $(QINC)
+CFLAGS = -O2 -fno-strength-reduce -Wall -W -I/usr/X11R6/include
+LIBCFLAGS = -fPIC
+YACCCFLAGS = -Wno-unused -Wno-parentheses
+LFLAGS = -L$(QLIB) -lqt
+CC = g++
+MOC = $(MOCDIR)/moc
+SHELL = /bin/sh
+
+
+####### Files
+
+SOURCES = kernel.cpp
+OBJECTS = kernel.o
+SRCMETA = kernel.moc
+TARGET = logker
+
+####### Implicit rules
+
+.SUFFIXES: .cpp
+
+.cpp.o:
+ $(CC) -c $(CFLAGS) -I$(INCDIR) $<
+
+####### Build rules
+
+all: $(TARGET)
+
+$(TARGET): $(SRCMETA) $(OBJECTS)
+ $(CC) $(OBJECTS) -o $(TARGET) $(LFLAGS) -lm
+
+depend:
+ @makedepend -I$(INCDIR) $(SOURCES) 2> /dev/null
+
+showfiles:
+ @echo $(SOURCES) $(HEADERS) Makefile
+
+clean:
+ -rm -f *.o *.bak *~ *% #*
+ -rm -f $(SRCMETA) $(TARGET)
+
+####### Meta objects
+
+kernel.moc: kernel.cpp
+ $(MOC) kernel.cpp -o kernel.moc
+
+
--- /dev/null
+/**************************************************************
+
+ Copyright (C) 1997 Oskar Swida
+
+ 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; either version 2
+ of the License, or (at your option) any later version.
+
+ 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+
+
+
+ NOTE: This software is using the free software license of
+ the QT library v.1.30 from Troll Tech AS.
+ See the file LICENSE.QT.
+
+
+ To contact the author, write:
+ e-mail: swida@aragorn.pb.bialystok.pl
+
+************************************************************/
+
+
+#include <qpixmap.h>
+#include <qwindow.h>
+#include <qapp.h>
+#include <qframe.h>
+#include <qmlined.h>
+#include <qpainter.h>
+#include <qcolor.h>
+#include <qbrush.h>
+#include <qmenubar.h>
+#include <qpopmenu.h>
+#include <qfont.h>
+#include <qmsgbox.h>
+#include <qfiledlg.h>
+#include <qtabdlg.h>
+#include <qstring.h>
+#include <qrect.h>
+#include <qdialog.h>
+#include <qbttngrp.h>
+#include <qlabel.h>
+#include <qlined.h>
+#include <qlistbox.h>
+#include <qpushbt.h>
+#include <qradiobt.h>
+#include <qlist.h>
+#include <qfile.h>
+#include <qcursor.h>
+#include <qcombo.h>
+#include <qsocknot.h>
+#include <qdir.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <fcntl.h>
+
+#include "../head/genint1.h"
+#include "../head/comm.h"
+#include "socu.h"
+#include <netinet/in.h>
+
+#define GPATH "loggr"
+#define IPATH "logi"
+#define NPATH "logn"
+#define REMOTE_PATH "REMOTE"
+#define MAXINTERP 20
+#define MAXINSTANCES 256
+
+
+#define MESG_COL 0
+#define WARN_COL 1
+#define NORM_COL 2
+
+
+char CharLine[25]="________________________";
+char myargs[5][255];
+
+
+/* --------------- interpreter slot -----------------*/
+class InterpEntry
+{
+public:
+ int ID; // INT identifier
+ bool remote; // Am I remote ?
+ char fullname[255],shortname[255]; // Program name
+ int sock; // Socket
+ QSocketNotifier *notify;
+ int RInstances[MAXINSTANCES]; // IDs of my remote INT modules
+ ctx_struct p_ctx; // parent INT info
+};
+/*++++++++++++++++++++++++++++++++++++++++++*/
+
+/*----------------- connection slot -------------*/
+class ConnectEntry
+{
+public:
+ char addr[256];
+ ConnectEntry(char *s) {strcpy(addr,s);};
+};
+
+/* ++++++++++++++++++++++++++++++++++++++++++ */
+
+QApplication *app;
+
+
+/* ---------------------------------------------------------- */
+/* KERNEL CLASS DEFINITION */
+/* ---------------------------------------------------------- */
+
+class QKernel : public QFrame
+{
+ Q_OBJECT
+public:
+
+ QMultiLineEdit *desktop;
+ QMenuBar *bar;
+ QPopupMenu *p,*p1,*p2;
+ char progdir[256];
+ int NodeNumber,ConType;
+
+
+ QKernel();
+
+
+ virtual void resizeEvent( QResizeEvent *ev );
+
+ void WriteMessage(char* msg);
+ void InitMessage();
+
+
+public slots:
+
+ void n_impl();
+ void Run_Prog();
+ void Edit();
+ void Help();
+ void SetOptions();
+ void AddAddress();
+ void DelAddress();
+ void LockConsole();
+ void UnlockConsole();
+ void MessageToNode();
+ void QuitProc();
+ void NetMessage();
+ void IntMessage(int);
+ void KillInterpreter();
+ void Disconnect();
+ void SetMessages();
+ void Connect();
+ void Info();
+
+
+
+private:
+ QList<InterpEntry> Interpreters;
+ QList<ConnectEntry> ConnectList;
+ QListBox *connections;
+ int Tasks; // number of working interpreters
+ int ActiveConnections; // number of connected VLPs
+ bool LOCKED,synchro,wait_for_info;
+ char LockPasswd[25];
+ int lockid,unlockid,qid,cwid,
+ optid,prid,mid,msgid,toolsid,hid;
+ int net_sock;
+ int freeINTid;
+ QSocketNotifier *Net_Notify;
+ char HomeDir[255];
+ bool info_messages;
+
+
+ void LoadConfig();
+ void RunGraphModule(char*);
+ void RunNetModule();
+ InterpEntry *findINTbySocket(int);
+ InterpEntry *findINTbyID(int);
+ InterpEntry *RunIntModule(char *ss,int r);
+ void RemoteInstance(InterpEntry*,int);
+ void CloseInstances(InterpEntry*);
+
+
+};
+/* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
+
+QKernel::QKernel()
+{
+ QFont f("Helvetica",12,QFont::Bold);
+ QFont f1("Helvetica",12,QFont::Normal);
+ QFont f2("Times Roman",12,QFont::Normal);
+ QDir q(REMOTE_PATH);
+ char ss[255];
+
+ if (!q.exists())
+ {
+ sprintf(ss,"mkdir %s",REMOTE_PATH);
+ system(ss);
+ }
+
+ info_messages=TRUE;
+ wait_for_info=FALSE;
+
+ setCaption("Virtual LOGLAN Processor");
+ setBackgroundColor(white);
+
+ bar = new QMenuBar(this);
+ bar->setFont(f);
+ p = new QPopupMenu();
+ p->setFont(f2);
+ p->insertItem("Execute",this,SLOT(Run_Prog()));
+ p->insertItem("Kill",this,SLOT(KillInterpreter()));
+ prid = bar->insertItem("&Program",p);
+ p1 = new QPopupMenu();
+ p1->insertItem("Message",this,SLOT(MessageToNode()));
+ p1->insertSeparator();
+ p1->insertItem("Connect",this,SLOT(Connect()));
+ p1->insertItem("Disconnect",this,SLOT(Disconnect()));
+ p1->insertItem("Info",this,SLOT(Info()));
+ p1->setFont(f);
+ mid = bar->insertItem("&Machine",p1);
+
+ p2 = new QPopupMenu();
+ cwid = p2->insertItem("Editor",this,SLOT(Edit()));
+ hid = p2->insertItem("Help",this,SLOT(Help()));
+ p2->insertSeparator();
+ optid = p2->insertItem("Options",this,SLOT(SetOptions()));
+ msgid = p2->insertItem("Info messages",this,SLOT(SetMessages()));
+ p2->setItemChecked(msgid,TRUE);
+ p2->insertSeparator();
+ lockid = p2->insertItem("Lock console",this,SLOT(LockConsole()));
+ unlockid = p2->insertItem("Unlock console",this,SLOT(UnlockConsole()));
+ p2->setItemEnabled(unlockid,FALSE);
+ LOCKED = FALSE;
+ p2->setFont(f);
+ toolsid = bar->insertItem("&Tools",p2);
+
+ qid = bar->insertItem("&Quit",this,SLOT(QuitProc()));
+ p->setFont(f);
+
+ desktop = new QMultiLineEdit(this,"desktop");
+ desktop->setAutoUpdate(TRUE);
+ desktop->setReadOnly(TRUE);
+ desktop->setFont(f1);
+
+ resize(400,200);
+ Tasks = 0;
+ freeINTid = 1;
+ ActiveConnections = 0;
+ strcpy(LockPasswd,"");
+ LoadConfig();
+ RunNetModule();
+
+ Net_Notify = new QSocketNotifier(net_sock,QSocketNotifier::Read,this);
+ connect(Net_Notify,SIGNAL(activated(int)),this,SLOT(NetMessage()));
+
+}
+
+
+void QKernel::resizeEvent( QResizeEvent *ev )
+{
+ QFrame::resizeEvent(ev);
+ if ( desktop )
+ desktop->setGeometry( 0,bar->height(), width(), height() - bar->height() );
+}
+
+
+
+
+void QKernel::n_impl()
+{
+ QMessageBox::information(this,"Function info","This function is not implemented
+ yet...","Ok");
+}
+
+
+/* ########### load configuration from file ############# */
+
+void QKernel::LoadConfig()
+{
+ QFile f("vlp.cfg");
+ char line[256],val[255];
+
+ if (!f.exists())
+ {
+ WriteMessage("Cannot load configuration file!");sleep(2);exit(3);
+ }
+ f.open(IO_ReadOnly);
+ f.readLine(line,256);
+ while (!f.atEnd())
+ {
+ if (line[strlen(line)-1]=='\n') line[strlen(line)-1]='\0';
+ strcpy(line,strtok(line,"="));
+ strcpy(val, strtok(NULL,"="));
+ if (strcmp(line,"node_number")==0) {NodeNumber = atoi(val);};
+ if (strcmp(line,"type")==0) {if (strcmp(val,"explicit")==0) ConType=1; else
+ ConType = 2; };
+ if (strcmp(line,"host")==0) {ConnectList.append(new ConnectEntry(val));};
+ if (strcmp(line,"progdir")==0) {strcpy(progdir,val);};
+ if (strcmp(line,"homedir")==0) {strcpy(HomeDir,val);};
+ f.readLine(line,256);
+ }
+ f.close();
+}
+/* +++++++++++++++++++++++++++++++++++++++++++++++ */
+
+
+void QKernel::Run_Prog()
+{
+ int i;
+ QString s(QFileDialog::getOpenFileName(progdir,"*.log",this));
+ if ( !s.isNull())
+ {
+ i = s.find(".log");
+ if (i>0) s.remove(i,4);
+ RunIntModule(s.data(),0);
+ }
+}
+
+
+void QKernel::Edit()
+{
+ char cmd[255];
+ sprintf(cmd,"%s/modules/logedit %s %s %s %s %s %s &",HomeDir,HomeDir,
+ myargs[0],myargs[1],myargs[2],myargs[3],myargs[4]);
+ system(cmd);
+}
+
+void QKernel::Help()
+{
+ char cmd[255];
+ sprintf(cmd,"%s/modules/loghelp %s/doc %s %s %s %s %s &",HomeDir,HomeDir,
+ myargs[0],myargs[1],myargs[2],myargs[3],myargs[4]);
+ system(cmd);
+}
+
+
+void QKernel::RunGraphModule(char *sk)
+{
+ char cmd[255];
+
+
+ sprintf(cmd,"%s/modules/loggraph %s %s %s %s %s %s",HomeDir,sk,
+ myargs[0],myargs[1],myargs[2],myargs[3],myargs[4]);
+ strcat(cmd," &");
+
+ if (system(cmd)!=0)
+ WriteMessage("Cannot connect GRAPH resources");
+
+}
+
+
+
+void QKernel::RunNetModule()
+{
+ struct sockaddr_un svr;
+ int len,on;
+ int sock;
+ char cmd[255];
+
+
+ sprintf(cmd,"%s/modules/lognet %s %s %s %s %s %s",HomeDir,NPATH,
+ myargs[0],myargs[1],myargs[2],myargs[3],myargs[4]);
+ strcat(cmd," &");
+
+ /* -------- socket for NET module -------- */
+ unlink(NPATH);
+ sock = socket(AF_UNIX,SOCK_STREAM,0);
+ bzero(&svr,sizeof(svr));
+ svr.sun_family = AF_UNIX;
+ strcpy(svr.sun_path,NPATH);
+ len = strlen(svr.sun_path)+sizeof(svr.sun_family);
+ bind(sock,(struct sockaddr*)&svr, len);
+ listen(sock,5);
+
+ if ( system(cmd) == 0)
+ {
+ net_sock = accept(sock,(struct sockaddr*)0,(unsigned int*)0);
+ // close(sock);
+ if (net_sock != 0)
+ {
+ WriteMessage("NETWORK successfully connected");
+ fcntl(net_sock,F_SETFL, O_NONBLOCK|fcntl(net_sock,F_GETFL,0));
+ on=1;
+ setsockopt(net_sock,IPPROTO_TCP,TCP_NODELAY,(char*)&on,sizeof(on));
+ }
+ else
+ {
+ WriteMessage("Cannot connect NETWORK resources");
+ WriteMessage("Exiting...");
+ sleep(2);
+ QuitProc();
+ }
+ }/* system OK */
+ else
+ {
+ WriteMessage("Cannot connect NETWORK resources");
+ WriteMessage("Exiting...");
+ sleep(2);
+ QuitProc();
+ }
+
+}
+
+
+void QKernel::Connect()
+{
+ QDialog d(this,"",TRUE);
+ QLabel lab(&d,"IP Address:");
+ QLineEdit ed(&d,"");
+ QPushButton ob(&d,""),cb(&d,"");
+ MESSAGE m;
+
+ d.setFont(QFont("Helvetica",12,QFont::Bold));
+ ob.setGeometry( 30, 60, 80, 30 );
+ ob.setText( "Ok" );
+ ob.setDefault(TRUE);
+ lab.setGeometry( 10, 10, 60, 30 );
+ lab.setText( "Address" );
+ ed.setGeometry( 70, 10, 140, 30 );
+ cb.setGeometry( 130, 60, 80, 30 );
+ cb.setText( "Cancel" );
+ d.resize( 240, 100 );
+
+ connect(&ob,SIGNAL(clicked()),&d,SLOT(accept()));
+ connect(&cb,SIGNAL(clicked()),&d,SLOT(reject()));
+ if (d.exec())
+ {
+ m.msg_type = MSG_NET;
+ m.param.pword[0] = NET_CONNECT_TO;
+ strcpy(m.param.pstr,ed.text());
+ write(net_sock,&m,sizeof(MESSAGE));
+ }
+
+}
+
+void QKernel::Disconnect()
+{
+ MESSAGE msg;
+
+ if (info_messages) WriteMessage("Disconnecting from virtual machine");
+ msg.msg_type = MSG_NET;
+ msg.param.pword[0] = NET_DISCONNECT;
+ write(net_sock,&msg,sizeof(MESSAGE));
+}
+
+void QKernel::QuitProc()
+{
+ MESSAGE msg;
+
+if (!LOCKED)
+{
+ /*
+ msg.msg_type = MSG_NET;
+ msg.param.pword[0] = NET_DISCONNECT;
+ write(net_sock,&msg,sizeof(MESSAGE));*/
+
+
+ delete Net_Notify;
+
+ msg.msg_type = MSG_NET;
+ msg.param.pword[0] = NET_EXIT;
+ write(net_sock,&msg,sizeof(MESSAGE));
+ // ::close(net_sock);
+
+ app->quit();
+}
+}
+
+
+
+
+void QKernel::AddAddress()
+{
+ QDialog d(this,"",TRUE);
+ QLabel lab(&d,"IP Address:");
+ QLineEdit ed(&d,"");
+ QPushButton ob(&d,""),cb(&d,"");
+
+ if (connections)
+ {
+ ob.setGeometry( 30, 60, 80, 30 );
+ ob.setText( "Ok" );
+ ob.setDefault(TRUE);
+ lab.setGeometry( 10, 10, 60, 30 );
+ lab.setText( "Address" );
+ ed.setGeometry( 70, 10, 140, 30 );
+ cb.setGeometry( 130, 60, 80, 30 );
+ cb.setText( "Cancel" );
+ d.resize( 240, 100 );
+ connect(&ob,SIGNAL(clicked()),&d,SLOT(accept()));
+ connect(&cb,SIGNAL(clicked()),&d,SLOT(reject()));
+ if (d.exec())
+ if (strcmp(ed.text(),"")!=0)
+ {
+ connections->insertItem(ed.text());
+ }
+ }
+}
+
+void QKernel::DelAddress()
+{
+ if (connections)
+ {
+ if (connections->currentItem()!=-1)
+ connections->removeItem(connections->currentItem());
+ }
+}
+
+
+
+void QKernel::MessageToNode()
+{
+ QDialog *dlg;
+ QLineEdit *nodenr;
+ MESSAGE m;
+
+
+ dlg = new QDialog(this,"Message",TRUE);
+
+ nodenr = new QLineEdit(dlg,"number");
+ nodenr->setGeometry( 90, 10, 50, 30 );
+ nodenr->setText("");
+
+ QLabel* tmpQLabel;
+ tmpQLabel = new QLabel( dlg, "Label_1" );
+ tmpQLabel->setGeometry( 10, 10, 77, 30 );
+ tmpQLabel->setText( "Node number:" );
+
+ tmpQLabel = new QLabel( dlg, "Label_2" );
+ tmpQLabel->setGeometry( 10, 50, 70, 30 );
+ tmpQLabel->setText( "Message:" );
+
+ QLineEdit* msg;
+ msg = new QLineEdit( dlg, "LineEdit_1" );
+ msg->setGeometry( 80, 60, 330, 30 );
+ msg->setText( "" );
+
+ QPushButton* ob,*cb;
+ ob = new QPushButton( dlg, "PushButton_1" );
+ ob->setGeometry( 230, 10, 80, 30 );
+ ob->setText( "Send" );
+ ob->setDefault(TRUE);
+ cb = new QPushButton( dlg, "PushButton_2" );
+ cb->setGeometry( 330, 10, 80, 30 );
+ cb->setText( "Cancel" );
+ dlg->resize( 430, 110 );
+ connect(ob,SIGNAL(clicked()),dlg,SLOT(accept()));
+ connect(cb,SIGNAL(clicked()),dlg,SLOT(reject()));
+ dlg->setCaption("Send message to node");
+
+ if (dlg->exec())
+ {
+ m.msg_type = MSG_NET;
+ m.param.pword[0] = NET_PROPAGATE;
+ m.param.pword[1] = MSG_VLP;
+ m.param.pword[2] = NodeNumber;
+ m.param.pword[4] = atoi(nodenr->text());
+ m.param.pword[6] = VLP_WRITE;
+ strcpy(m.param.pstr,msg->text());
+ write(net_sock,&m,sizeof(MESSAGE));
+ }
+}
+
+void QKernel::KillInterpreter()
+{
+ QDialog *dlg;
+ QLineEdit *nodenr;
+ MESSAGE m;
+ InterpEntry *pom;
+
+ dlg = new QDialog(this,"Message",TRUE);
+
+ nodenr = new QLineEdit(dlg,"number");
+ nodenr->setGeometry( 90, 10, 50, 30 );
+ nodenr->setText("");
+
+ QLabel* tmpQLabel;
+ tmpQLabel = new QLabel( dlg, "Label_1" );
+ tmpQLabel->setGeometry( 10, 10, 77, 30 );
+ tmpQLabel->setText( "Interp. ID:" );
+ QPushButton* ob,*cb;
+ ob = new QPushButton( dlg, "PushButton_1" );
+ ob->setGeometry( 160, 10, 80, 30 );
+ ob->setText( "Kill" );
+ ob->setDefault(TRUE);
+ cb = new QPushButton( dlg, "PushButton_2" );
+ cb->setGeometry( 260, 10, 80, 30 );
+ cb->setText( "Cancel" );
+ dlg->resize( 360, 50 );
+ connect(ob,SIGNAL(clicked()),dlg,SLOT(accept()));
+ connect(cb,SIGNAL(clicked()),dlg,SLOT(reject()));
+ dlg->setCaption("Kill interpreter");
+ if (dlg->exec())
+ {
+
+ m.msg_type = MSG_INT;
+ m.param.pword[0] = INT_KILL;
+ pom = findINTbyID(atoi(nodenr->text()));
+ if (pom!=NULL)
+ {
+ if (!(pom->remote))
+ write(pom->sock,&m,sizeof(MESSAGE));
+ else WriteMessage("This is a remote instance of a program!");
+ }
+ else WriteMessage("Interpreter not found");
+
+ }
+
+}
+
+
+
+void QKernel::NetMessage()
+{
+ MESSAGE msg;
+ int cnt;
+ char ss[255];
+ InterpEntry *pom;
+
+ cnt = read(net_sock,&msg,sizeof(MESSAGE));
+ if ( (cnt>0) && (msg.msg_type==MSG_NET))
+ {
+ switch(msg.param.pword[0])
+ {
+ case NET_CSWRITELN: WriteMessage(msg.param.pstr);break;
+ case NET_PROPAGATE:
+ switch(msg.param.pword[1])
+ {
+ case MSG_INT:
+ /* pom = find_link_by_ID(msg.param.pword[5]);
+ msg.msg_type = MSG_NET;
+ msg.param.pword[0] = NET_PROPAGATE;
+ send_int(pom,&msg);*/
+ break;
+ case MSG_VLP:
+ switch(msg.param.pword[6])
+ {
+ case VLP_WRITE:
+ QApplication::beep();
+ WriteMessage(CharLine);
+ WriteMessage("### Incoming Messsage ###");
+ sprintf(ss,"Mesg from Node %d: %s",msg.param.pword[2],msg.param.pstr);
+ WriteMessage(ss);
+ WriteMessage(CharLine);
+ break;
+ case VLP_REMOTE_INSTANCE:
+ sprintf(ss,"%s/%s",REMOTE_PATH,msg.param.pstr);
+ if (info_messages)
+ {
+ WriteMessage("Running program:");
+ WriteMessage(ss);
+ }
+ pom = RunIntModule(ss,1);
+ if (pom!=NULL)
+ {
+ pom->p_ctx.node = msg.param.pword[2];
+ pom->p_ctx.program_id = msg.param.pword[7];
+ pom->RInstances[msg.param.pword[2]] = msg.param.pword[7];
+ }
+ break;
+ case VLP_CLOSE_INSTANCE:
+ msg.msg_type = MSG_INT;
+ msg.param.pword[0] = INT_CLOSE_INSTANCE;
+ pom = findINTbyID(msg.param.pword[7]);
+ if (pom!=NULL)
+ {
+ write(pom->sock,&msg,sizeof(MESSAGE));
+ MESSAGE m1;
+ m1.msg_type = MSG_VLP;
+ m1.param.pword[0] = VLP_INTERPRETER_DOWN;
+ m1.param.pword[1] = pom->ID;
+ write(net_sock,&m1,sizeof(MESSAGE));
+ } else WriteMessage("Instance not found");
+ break;
+ } /* VLP switch */
+
+ }/* switch */
+ break;
+ case NET_CONNECTIONS: ActiveConnections = msg.param.pword[1];
+ WriteMessage(msg.param.pstr);
+ if (!synchro) synchro=TRUE;
+ break;
+ case NET_INFO:
+ if (wait_for_info)
+ {
+ QString poms,poms1,poms2;
+ poms.sprintf("%s",msg.param.pstr);
+ while (poms.length()>0)
+ {
+ cnt=poms.find(';');
+ if (cnt!=-1)
+ { poms1=poms.left(cnt);
+ poms=poms.right(poms.length()-cnt-1);
+ cnt=poms1.find('=');
+ if (cnt!=-1)
+ {
+ poms2=poms1.left(cnt);
+ poms1=poms1.right(poms1.length()-cnt-1);
+ sprintf(ss,"Node: %s Addr: %s",poms2.data(),poms1.data());
+ WriteMessage(ss);
+ }
+ }
+ }
+ }
+ break;
+ case NET_INFO_END:wait_for_info=FALSE;
+ WriteMessage(CharLine);
+ break;
+ } /* switch */
+ }
+
+}
+
+
+
+
+void QKernel::IntMessage(int sock)
+{
+ MESSAGE msg;
+ int cnt;
+ InterpEntry *e;
+
+ cnt = read(sock,&msg,sizeof(MESSAGE));
+ e = findINTbySocket(sock);
+ if ( (cnt>0) && (e!=NULL))
+ {
+ switch (msg.msg_type)
+ {
+ case MSG_GRAPH:
+ if (msg.param.pword[0]==GRAPH_ALLOCATE)
+ {
+ RunGraphModule(msg.param.pstr);
+ }
+ break;
+ case MSG_NET:
+ write(net_sock,&msg,sizeof(MESSAGE));break;
+ case MSG_VLP:
+ switch(msg.param.pword[0])
+ {
+ case VLP_REMOTE_INSTANCE_PLEASE:
+ RemoteInstance(e,msg.param.pword[2]);
+ break;
+ }/* switch */
+ break;
+ case MSG_INT:
+ switch(msg.param.pword[0]){
+ case INT_EXITING:
+ {
+ char ss[255];
+
+ MESSAGE m;
+ m.msg_type = MSG_VLP;
+ m.param.pword[0] = VLP_INTERPRETER_DOWN;
+ m.param.pword[1] = e->ID;
+ write(net_sock,&m,sizeof(MESSAGE));
+ if (e->remote==0) CloseInstances(e);
+ delete e->notify;
+ ::close(e->sock);
+ Interpreters.remove(e);
+ delete e;
+ if (info_messages)
+ {
+ sprintf(ss,"%s : End of program execution",msg.param.pstr);
+ WriteMessage(ss);
+ }
+ };break;
+ case INT_CTX_REQ:
+
+ msg.msg_type = MSG_INT;
+ msg.param.pword[0] = INT_CTX;
+ msg.param.pword[1] = NodeNumber;
+ msg.param.pword[2] = e->ID;
+ if (e->remote)
+ {
+ msg.param.pword[3] = e->p_ctx.node;
+ msg.param.pword[4] = e->p_ctx.program_id;
+ }
+ write(sock,&msg,sizeof(MESSAGE));
+ break;
+ };break; /* switch param.pword[0] */
+ } /* switch type */
+ } /* if */
+}
+
+
+void QKernel::WriteMessage(char *msg)
+{
+ int x,y;
+
+ desktop->getCursorPosition(&x,&y);
+ if (x>100) desktop->clear();
+ desktop->setReadOnly(FALSE);
+ desktop->append(msg);
+ desktop->setReadOnly(TRUE);
+ desktop->setCursorPosition(desktop->numLines(),1);
+ desktop->repaint();
+ if (desktop->numLines()>100) desktop->clear();
+}
+
+void QKernel::SetMessages()
+{
+
+ if (p2!=NULL)
+ {
+ if ( p2->isItemChecked(msgid))
+ {
+ p2->setItemChecked(msgid,FALSE);
+ info_messages=FALSE;
+ }
+ else
+ {
+ p2->setItemChecked(msgid,TRUE);
+ info_messages=TRUE;
+ }
+} // !=NULL
+// bar->repaint();
+}
+
+void QKernel::SetOptions()
+{
+ QDialog dlg(this,"Options",TRUE);
+ QFile *vlp_file;
+ ConnectEntry *e;
+ char line[256];
+ unsigned int i;
+
+
+ QLineEdit* progs;
+ progs = new QLineEdit( &dlg, "progs" );
+ progs->setGeometry( 150, 20, 180, 30 );
+ progs->setText(progdir);
+
+ QLabel* tmpQLabel;
+ tmpQLabel = new QLabel( &dlg, "Label_1" );
+ tmpQLabel->setGeometry( 30, 20, 120, 30 );
+ tmpQLabel->setText( "Programs directory" );
+
+ QFrame* tmpQFrame;
+ tmpQFrame = new QFrame( &dlg, "Frame_2" );
+ tmpQFrame->setGeometry( 10, 60, 380, 30 );
+ tmpQFrame->setFrameStyle( 52 );
+
+ tmpQLabel = new QLabel( &dlg, "Label_2" );
+ tmpQLabel->setGeometry( 10, 80, 340, 30 );
+ tmpQLabel->setText( "Virtual Processor properties (activated after restarting VLP):" );
+
+ QLineEdit *nn;
+ char nns[256];
+ nn = new QLineEdit( &dlg, "LineEdit_2" );
+ nn->setGeometry( 110, 110, 40, 30 );
+ sprintf(nns,"%d",NodeNumber);
+ nn->setText(nns);
+
+ tmpQLabel = new QLabel( &dlg, "Label_3" );
+ tmpQLabel->setGeometry( 20, 110, 90, 30 );
+ tmpQLabel->setText( "Node number:" );
+
+ QRadioButton *exp,*reg;
+ exp = new QRadioButton( &dlg, "RadioButton_3" );
+ exp->setGeometry( 30, 170, 100, 30 );
+ exp->setText( "Explicit" );
+ exp->setChecked( TRUE );
+
+ reg = new QRadioButton( &dlg, "RadioButton_4" );
+ reg->setGeometry( 30, 200, 100, 30 );
+ reg->setText( "Registration" );
+ reg->setEnabled(FALSE);
+
+ connections = new QListBox( &dlg, "ListBox_1" );
+ connections->setGeometry( 170, 140, 130, 100 );
+ e = ConnectList.first();
+ while (e!=NULL)
+ {
+ connections->insertItem(e->addr);
+ e = ConnectList.next();
+ }
+
+ tmpQLabel = new QLabel( &dlg, "Label_5" );
+ tmpQLabel->setGeometry( 170, 110, 100, 30 );
+ tmpQLabel->setText( "Connection list:" );
+
+ QPushButton* addbtn,*delbtn,*okbtn,*cancelbtn;
+ addbtn = new QPushButton( &dlg, "PushButton_1" );
+ addbtn->setGeometry( 310, 150, 60, 30 );
+ addbtn->setText( "Add" );
+ delbtn = new QPushButton( &dlg, "PushButton_2" );
+ delbtn->setGeometry( 310, 200, 60, 30 );
+ delbtn->setText( "Del" );
+ connect(addbtn,SIGNAL(clicked()),this,SLOT(AddAddress()));
+ connect(delbtn,SIGNAL(clicked()),this,SLOT(DelAddress()));
+ okbtn = new QPushButton( &dlg, "PushButton_3" );
+ okbtn->setGeometry( 80, 260, 100, 30 );
+ okbtn->setText( "Ok" );
+ okbtn->setDefault(TRUE);
+ cancelbtn = new QPushButton( &dlg, "PushButton_4" );
+ cancelbtn->setGeometry( 210, 260, 100, 30 );
+ cancelbtn->setText( "Cancel" );
+ connect(okbtn,SIGNAL(clicked()),&dlg,SLOT(accept()));
+ connect(cancelbtn,SIGNAL(clicked()),&dlg,SLOT(reject()));
+ QButtonGroup* group;
+ group = new QButtonGroup( &dlg, "ButtonGroup_1" );
+ group->setGeometry( 20, 150, 120, 90 );
+ group->setTitle( "Connection type" );
+ group->setAlignment( 1 );
+ group->lower();
+ group->insert(exp,1);
+ group->insert(reg,2);
+
+ dlg.resize( 400, 310 );
+ if (dlg.exec())
+ {
+ unlink("vlp.cfg");
+ vlp_file = new QFile("vlp.cfg");
+ vlp_file->open(IO_WriteOnly);
+ sprintf(line,"progdir=%s\n",progs->text());
+ vlp_file->writeBlock(line,strlen(line));
+ strcpy(progdir,progs->text());
+ sprintf(line,"node_number=%d\n",atoi(nn->text()));
+ vlp_file->writeBlock(line,strlen(line));
+ if ( exp->isChecked())
+ {
+ sprintf(line,"type=explicit\n");
+ vlp_file->writeBlock(line,strlen(line));
+ for(i=0;i<connections->count();i++)
+ {
+ sprintf(line,"host=%s\n",connections->text(i));
+ vlp_file->writeBlock(line,strlen(line));
+ }
+
+ }
+ else
+ {
+ sprintf(line,"type=register\n");
+ vlp_file->writeBlock(line,strlen(line));
+ }
+ vlp_file->close();
+ };
+}
+
+
+void QKernel::LockConsole()
+{
+ QDialog d(this,"Enter password",TRUE);
+ QLabel lab(&d,"Password");
+ QLineEdit ed(&d,"");
+ QPushButton ob(&d,""),cb(&d,"");
+
+ d.setCaption("Lock console");
+ ob.setGeometry( 30, 60, 80, 30 );
+ ob.setText( "Ok" );
+ ob.setDefault(TRUE);
+ lab.setGeometry( 10, 10, 60, 30 );
+ lab.setText( "Password:" );
+ ed.setGeometry( 70, 10, 140, 30 );
+ ed.setEchoMode(QLineEdit::Password);
+ cb.setGeometry( 130, 60, 80, 30 );
+ cb.setText( "Cancel" );
+ d.resize( 240, 100 );
+ connect(&ob,SIGNAL(clicked()),&d,SLOT(accept()));
+ connect(&cb,SIGNAL(clicked()),&d,SLOT(reject()));
+
+ if (d.exec())
+ if (strcmp(ed.text(),"")!=0)
+ {
+ strcpy(LockPasswd,ed.text());
+ lab.setText("Retype:");
+ ed.setText("");
+ if (d.exec())
+ {
+ if (strcmp(ed.text(),LockPasswd)==0)
+ {
+ bar->setItemEnabled(qid,FALSE);
+ bar->setItemEnabled(prid,FALSE);
+ bar->setItemEnabled(mid,FALSE);
+ p2->setItemEnabled(unlockid,TRUE);
+ p2->setItemEnabled(lockid,FALSE);
+ p2->setItemEnabled(cwid,FALSE);
+ p2->setItemEnabled(optid,FALSE);
+ bar->repaint();
+ WriteMessage("CONSOLE LOCKED");
+ LOCKED = TRUE;
+ }
+ else
+ {
+ QMessageBox msg(this);
+ msg.setText("Not matching!");
+ msg.setButtonText("Close");
+ msg.show();
+
+ }
+ }
+ else strcpy(LockPasswd,"");
+ }
+}
+
+void QKernel::UnlockConsole()
+{
+ QDialog d(this,"Enter password",TRUE);
+ QLabel lab(&d,"Password");
+ QLineEdit ed(&d,"");
+ QPushButton ob(&d,""),cb(&d,"");
+
+ ob.setGeometry( 30, 60, 80, 30 );
+ ob.setText( "Ok" );
+ ob.setDefault(TRUE);
+ lab.setGeometry( 10, 10, 60, 30 );
+ lab.setText( "Password:" );
+ ed.setGeometry( 70, 10, 140, 30 );
+ ed.setEchoMode(QLineEdit::Password);
+ cb.setGeometry( 130, 60, 80, 30 );
+ cb.setText( "Cancel" );
+ d.resize( 240, 100 );
+ connect(&ob,SIGNAL(clicked()),&d,SLOT(accept()));
+ connect(&cb,SIGNAL(clicked()),&d,SLOT(reject()));
+
+ if (d.exec())
+ {
+ if (strcmp(ed.text(),LockPasswd)==0)
+ {
+ bar->setItemEnabled(qid,TRUE);
+ bar->setItemEnabled(prid,TRUE);
+ bar->setItemEnabled(mid,TRUE);
+ p2->setItemEnabled(unlockid,FALSE);
+ p2->setItemEnabled(lockid,TRUE);
+ p2->setItemEnabled(cwid,TRUE);
+ p2->setItemEnabled(optid,TRUE);
+ bar->repaint();
+ WriteMessage("CONSOLE UNLOCKED");
+ LOCKED = FALSE;
+ }
+ else
+ {
+ QMessageBox msg(this);
+ msg.setText("Wrong password!");
+ msg.setButtonText("Close");
+ msg.show();
+
+ }
+ }
+}
+
+void QKernel::InitMessage()
+{
+ WriteMessage("\n Virtual LOGLAN Processor - ver 1.9: READY \n");
+}
+
+
+
+InterpEntry *QKernel::findINTbySocket(int _id)
+{
+ InterpEntry *pom;
+ pom = Interpreters.first();
+ while (pom!=NULL)
+ {
+ if (pom->sock == _id) break;
+ pom = Interpreters.next();
+ }
+ return(pom);
+}
+
+InterpEntry *QKernel::findINTbyID(int _id)
+{
+ InterpEntry *pom;
+ pom = Interpreters.first();
+ while (pom!=NULL)
+ {
+ if (pom->ID == _id) break;
+ pom = Interpreters.next();
+ }
+ return(pom);
+}
+
+
+/* ------------------ Connect INT module -----------------*/
+
+InterpEntry *QKernel::RunIntModule(char *ss, int r)
+{
+ char a[256],b[255];
+ struct sockaddr_un svr;
+ int len,sock,i,on;
+ int newint=-1;
+ char cmd[255];
+ FILE *cf;
+ MESSAGE msg;
+ InterpEntry *newINT;
+
+
+
+ newINT = NULL;
+
+ strcpy(a,ss);
+ strcat(a,".ccd");
+ cf = fopen(a,"r");
+ if (cf == NULL) {WriteMessage("File not found: no .ccd file");return(NULL);}
+ fclose(cf);
+
+ strcpy(a,ss);
+ strcat(a,".pcd");
+ cf = fopen(a,"r");
+ if (cf == NULL) {WriteMessage("File not found: no .pcd file");return(NULL);}
+ fclose(cf);
+
+ newINT = new InterpEntry;
+ for(i=0;i<MAXINSTANCES;i++) newINT->RInstances[i]=-1;
+
+ strcpy(b,rindex(ss,'/'));
+ for(i=0;i<strlen(b);i++)
+ b[i] = b[i+1];
+ if (info_messages)
+ {
+ sprintf(a,"%s : Start execution",b);
+ WriteMessage(a);
+ }
+
+ newint = freeINTid; freeINTid++;
+ newINT->ID = newint;
+ strcpy(newINT->shortname,b);
+ strcpy(newINT->fullname,ss);
+
+ sprintf(a,"%s%d",IPATH,newint);
+ sprintf(cmd,"%s/modules/logint %s %s",HomeDir,a,ss);
+ if (r) strcat(cmd," r");
+ sprintf(b," %s %s %s %s %s",myargs[0],myargs[1],myargs[2],myargs[3],myargs[4]);
+ strcat(cmd,b);
+ strcat(cmd," &");
+
+
+ sock = socket(AF_UNIX,SOCK_STREAM,0);
+ unlink(a);
+ bzero(&svr, sizeof(svr));
+ svr.sun_family = AF_UNIX;
+ strcpy(svr.sun_path,a);
+ len = strlen(svr.sun_path)+sizeof(svr.sun_family);
+ bind(sock,(struct sockaddr*)&svr, len);
+ listen(sock,5);
+ system(cmd);
+ newINT->sock = accept(sock,(struct sockaddr*)0,(unsigned int *)0);
+ //::close(sock);
+
+
+ if (newINT->sock>0)
+{
+
+ fcntl(newINT->sock,F_SETFL,
+ O_NONBLOCK|fcntl(newINT->sock,F_GETFL,0));
+ on=1;
+ setsockopt(newINT->sock,IPPROTO_TCP,TCP_NODELAY,(char*)&on,sizeof(on));
+ if (r) newINT->remote = 1;else newINT->remote=0;
+
+ bzero(&msg,sizeof(MESSAGE));
+ msg.msg_type = MSG_VLP;
+ msg.param.pword[0] = VLP_REGINT;
+ msg.param.pword[1] = newINT->ID;
+ sprintf(msg.param.pstr,"logi%d.net",newint);
+ write(net_sock,&msg,sizeof(MESSAGE));
+
+ Interpreters.append(newINT);
+ newINT->notify = new QSocketNotifier(newINT->sock,QSocketNotifier::Read);
+ connect(newINT->notify,SIGNAL(activated(int)),this,SLOT(IntMessage(int)));
+ if (info_messages) WriteMessage("INTERPRETER successfully connected");
+
+}
+ else WriteMessage("Cannot connect interpreter");
+
+ return(newINT);
+
+}
+
+/* ---------------------------------------------------------*/
+/* Allocate remote instance */
+
+void QKernel::RemoteInstance(InterpEntry *interp, int on)
+{
+ MESSAGE m;
+ char s[255];
+
+
+ m.msg_type = MSG_NET;
+ m.param.pword[0] = NET_NODE_EXIST;
+ m.param.pword[1] = on;
+ m.param.pword[2] = interp->ID;
+ write(net_sock,&m,sizeof(MESSAGE));
+ bzero(&m,sizeof(MESSAGE));
+ while( (m.msg_type!=MSG_NET) && (m.param.pword[0]!=NET_NODE_EXIST) )
+ read(net_sock,&m,sizeof(MESSAGE));
+
+if (m.param.pword[1]==1) /* means node exists */
+{
+ m.msg_type = MSG_NET;
+ m.param.pword[0] = NET_TRANSMIT_CODE;
+ m.param.pword[1] = interp->ID;
+ m.param.pword[2] = on;
+ strcpy(m.param.pstr,interp->fullname);
+ write(net_sock,&m,sizeof(MESSAGE));
+
+ Net_Notify->setEnabled(FALSE);
+ while ( (m.msg_type != MSG_NET) || (m.param.pword[0]!=NET_TRANSMITTED) )
+ read(net_sock,&m,sizeof(MESSAGE));
+
+
+ m.msg_type = MSG_NET;
+ m.param.pword[0] = NET_PROPAGATE;
+ m.param.pword[1] = MSG_VLP;
+ m.param.pword[2] = NodeNumber;
+ m.param.pword[3] = 0;
+ m.param.pword[4] = on;
+ m.param.pword[5] = 0;
+ m.param.pword[6] = VLP_REMOTE_INSTANCE;
+ m.param.pword[7] = interp->ID;
+ strcpy(m.param.pstr,interp->shortname);
+ write(net_sock,&m,sizeof(MESSAGE));
+
+ read(net_sock,&m,sizeof(MESSAGE));
+ while (1)
+ {
+ if ( (m.param.pword[0]==NET_PROPAGATE) && (m.param.pword[6] == VLP_REMOTE_INSTANCE_OK))
+ {
+ interp->RInstances[on] = m.param.pword[7];
+ break;
+ }
+ read(net_sock,&m,sizeof(MESSAGE));
+ }
+
+ Net_Notify->setEnabled(TRUE);
+
+ /*bzero(&m,sizeof(MESSAGE));*/
+ m.msg_type = MSG_VLP;
+ m.param.pword[0] = VLP_REMOTE_INSTANCE_HERE;
+ m.param.pword[1] = interp->RInstances[on];
+ write(interp->sock,&m,sizeof(MESSAGE));
+}
+ else /* There is no such a node! */
+{
+ sprintf(s,"Warning: Node number %d not found!",on);
+ WriteMessage(s);
+ WriteMessage("Allocating O-process on the local node");
+ bzero(&m,sizeof(MESSAGE));
+ m.msg_type = MSG_VLP;
+ m.param.pword[0] = VLP_REMOTE_INSTANCE_HERE;
+ m.param.pword[1] = interp->ID;
+ write(interp->sock,&m,sizeof(MESSAGE));
+}
+}
+
+
+/*-----------------------------------------------*/
+/* Close all remote instances */
+
+void QKernel::CloseInstances(InterpEntry *e)
+{
+ MESSAGE msg;
+ int i;
+
+ if (info_messages) WriteMessage("Closing remote instances");
+ for(i=0;i<MAXINSTANCES;i++)
+ if (e->RInstances[i]>=0)
+ {
+ msg.msg_type = MSG_NET;
+ msg.param.pword[0] = NET_PROPAGATE;
+ msg.param.pword[1] = MSG_VLP;
+ msg.param.pword[2] = NodeNumber;
+ msg.param.pword[4] = i;
+ msg.param.pword[6] = VLP_CLOSE_INSTANCE;
+ msg.param.pword[7] = e->RInstances[i];
+ write(net_sock,&msg,sizeof(MESSAGE));
+ }
+}
+
+
+void QKernel::Info()
+{
+ MESSAGE m;
+
+ WriteMessage(CharLine);
+ WriteMessage("### Virtual Machine Information ###");
+ m.msg_type = MSG_NET;
+ m.param.pword[0]=NET_GET_INFO;
+ write(net_sock,&m,sizeof(MESSAGE));
+ wait_for_info = TRUE;
+}
+
+#include "kernel.moc"
+
+int main( int argc, char **argv )
+{
+ int i;
+ for(i=0;i<5;i++) strcpy(myargs[i],"");
+ for(i=1;i<argc;i++) strcpy(myargs[i-1],argv[i]);
+
+ app = new QApplication(argc,argv);
+ app->setStyle(WindowsStyle);
+ QKernel draw;
+ app->setMainWidget( &draw);
+ draw.show();
+ draw.InitMessage();
+ return app->exec();
+}
--- /dev/null
+
+INCDIR = $(QINC)
+CFLAGS = -O2 -fno-strength-reduce -Wall -W -I/usr/X11R6/include
+LIBCFLAGS = -fPIC
+YACCCFLAGS = -Wno-unused -Wno-parentheses
+LFLAGS = -L$(QLIB) -lqt
+CC = g++
+MOC = $(MOCDIR)/moc
+SHELL = /bin/sh
+
+
+####### Files
+
+SOURCES = kernel.cpp
+OBJECTS = kernel.o
+SRCMETA = kernel.moc
+TARGET = logker
+
+####### Implicit rules
+
+.SUFFIXES: .cpp
+
+.cpp.o:
+ $(CC) -c $(CFLAGS) -I$(INCDIR) $<
+
+####### Build rules
+
+all: $(TARGET)
+
+$(TARGET): $(SRCMETA) $(OBJECTS)
+ $(CC) $(OBJECTS) -o $(TARGET) $(LFLAGS) -lm
+
+depend:
+ @makedepend -I$(INCDIR) $(SOURCES) 2> /dev/null
+
+showfiles:
+ @echo $(SOURCES) $(HEADERS) Makefile
+
+clean:
+ -rm -f *.o *.bak *~ *% #*
+ -rm -f $(SRCMETA) $(TARGET)
+
+####### Meta objects
+
+kernel.moc: kernel.cpp
+ $(MOC) kernel.cpp -o kernel.moc
+
+
--- /dev/null
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <sys/un.h>
+#include <errno.h>
--- /dev/null
+### Includes for QT library
+QINC=/usr/lib/qt-1.45/include
+
+### QT library directory
+QLIB=/usr/lib/qt-1.45/lib
+
+### moc compiler directory
+MOCDIR=/usr/lib/qt-1.45/bin
+
+### Install directory
+INSTALLDIR=/usr/local/vlp
+##### Change INCDIR, LFLAGS and MOC
+
+INCDIR = $(QINC)
+CFLAGS = -O2 -fno-strength-reduce -Wall -W -I/usr/X11R6/include
+LIBCFLAGS = -fPIC
+YACCCFLAGS = -Wno-unused -Wno-parentheses
+LFLAGS = -L$(QLIB) -lqt
+CC = g++
+MOC = $(MOCDIR)/moc
+SHELL = /bin/sh
+
+####### Files
+
+SOURCES = lgconfig.cpp
+OBJECTS = lgconfig.o
+SRCMETA = lgconfig.moc
+TARGET = lgconfig
+
+####### Implicit rules
+
+.SUFFIXES: .cpp
+
+.cpp.o:
+ $(CC) -c $(CFLAGS) -I$(INCDIR) $<
+
+####### Build rules
+
+all: $(TARGET)
+
+$(TARGET): $(SRCMETA) $(OBJECTS)
+ $(CC) $(OBJECTS) -o $(TARGET) $(LFLAGS) -lm
+
+depend:
+ @makedepend -I$(INCDIR) $(SOURCES) 2> /dev/null
+
+showfiles:
+ @echo $(SOURCES) $(HEADERS) Makefile
+
+clean:
+ -rm -f *.o *.bak *~ *% #*
+ -rm -f $(SRCMETA) $(TARGET)
+
+####### Meta objects
+
+lgconfig.moc: lgconfig.cpp
+ $(MOC) lgconfig.cpp -o lgconfig.moc
+
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
--- /dev/null
+
+
+#include <qapp.h>
+#include <qframe.h>
+#include <qmlined.h>
+#include <qmenubar.h>
+#include <qpopmenu.h>
+#include <qdialog.h>
+#include <qbttngrp.h>
+#include <qlabel.h>
+#include <qlined.h>
+#include <qlistbox.h>
+#include <qpushbt.h>
+#include <qradiobt.h>
+#include <qlist.h>
+#include <qfile.h>
+#include <qcombo.h>
+#include <qtooltip.h>
+#include <qfont.h>
+#include <qpixmap.h>
+#include <qmsgbox.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+
+
+class VLPEntry
+{
+public:
+ int ID;
+ char addr[255];
+ int type; /* 0 - explicit */
+ char progdir[255],homedir[255];
+ char item[255];
+};
+
+class QInstall: public QFrame
+{
+ Q_OBJECT
+public:
+ QMenuBar *bar;
+ QListBox *nodelist;
+ QPushButton *infob;
+ QList<VLPEntry> Nodes;
+
+ QInstall();
+ bool check_id(int);
+ bool check_addr(char*);
+
+public slots:
+
+ void SetOptions();
+ void AddNode();
+ void DelNode();
+ void Info();
+
+};
+
+
+QApplication *app;
+
+QInstall::QInstall()
+{
+ QFont f("Helvetica",12,QFont::Bold);
+ QPixmap mp;
+
+ infob = new QPushButton(this);
+
+
+
+ bar = new QMenuBar(this);
+ bar->insertItem("Configure",this,SLOT(SetOptions()));
+ bar->insertItem("Quit",app,SLOT(quit()));
+ bar->setFont(f);
+ setCaption("VLP Configuration Tool");
+ infob->setGeometry(0,bar->height(),200,30);
+ if( mp.load("logo.bmp"))
+ {
+ infob->setPixmap(mp);
+ infob->resize(mp.width(),mp.height());
+
+ }
+ resize(infob->width(),infob->height()+bar->height());
+ Nodes.clear();
+}
+
+
+bool QInstall::check_id(int id)
+{
+ VLPEntry *pom;
+
+ pom = Nodes.first();
+ while (pom!=NULL)
+ {
+ if (pom->ID == id) return(FALSE);
+ pom=Nodes.next();
+ }
+ return(TRUE);
+}
+
+
+
+bool QInstall::check_addr(char *addr)
+{
+ VLPEntry *pom;
+
+ pom = Nodes.first();
+ while (pom!=NULL)
+ {
+ if (strcmp(pom->addr,addr) == 0) return(FALSE);
+ pom=Nodes.next();
+ }
+ return(TRUE);
+}
+
+
+void QInstall::Info()
+{
+}
+
+
+void QInstall::AddNode()
+{
+ QDialog dlg(this,"",TRUE);
+ QLabel* tmpQLabel;
+ QLineEdit *id,*addr,*progs,*home;
+ QPushButton *okbtn,*cancelbtn;
+ VLPEntry *pom;
+ char pomstr[255];
+
+tmpQLabel = new QLabel( &dlg, "Label_2" );
+tmpQLabel->setGeometry( 110, 10, 180, 30 );
+tmpQLabel->setFrameStyle( 49 );
+tmpQLabel->setText( "Virtual Processor Properties" );
+
+id = new QLineEdit( &dlg, "LineEdit_1" );
+id->setGeometry( 130, 50, 50, 30 );
+id->setText( "" );
+
+tmpQLabel = new QLabel( &dlg, "Label_3" );
+tmpQLabel->setGeometry( 20, 50, 90, 30 );
+tmpQLabel->setText( "Node number" );
+
+tmpQLabel = new QLabel( &dlg, "Label_4" );
+tmpQLabel->setGeometry( 20, 90, 80, 30 );
+tmpQLabel->setText( "IP Address" );
+
+addr = new QLineEdit( &dlg, "LineEdit_2" );
+addr->setGeometry( 130, 90, 120, 30 );
+addr->setText( "" );
+
+tmpQLabel = new QLabel( &dlg, "Label_5" );
+tmpQLabel->setGeometry( 20, 130, 100, 30 );
+tmpQLabel->setText( "Connection type" );
+
+QComboBox* tmpQComboBox;
+tmpQComboBox = new QComboBox( FALSE, &dlg, "ComboBox_1" );
+tmpQComboBox->setGeometry( 130, 130, 100, 30 );
+tmpQComboBox->setSizeLimit( 2 );
+tmpQComboBox->setAutoResize( FALSE );
+tmpQComboBox->insertItem( "Explicit" );
+
+tmpQLabel = new QLabel( &dlg, "Label_6" );
+tmpQLabel->setGeometry( 20, 170, 110, 30 );
+tmpQLabel->setText( "Programs directory" );
+
+progs = new QLineEdit( &dlg, "LineEdit_4" );
+progs->setGeometry( 130, 170, 230, 30 );
+progs->setText( "" );
+
+tmpQLabel = new QLabel( &dlg, "Label_7" );
+tmpQLabel->setGeometry( 20, 210, 100, 30 );
+tmpQLabel->setText( "VLP directory" );
+
+home = new QLineEdit( &dlg, "LineEdit_5" );
+home->setGeometry( 130, 210, 230, 30 );
+home->setText( "" );
+
+ okbtn = new QPushButton( &dlg, "PushButton_5" );
+ okbtn->setGeometry( 80, 250, 100, 30 );
+ okbtn->setText( "Ok" );
+ connect(okbtn,SIGNAL(clicked()),&dlg,SLOT(accept()));
+ cancelbtn = new QPushButton( &dlg, "PushButton_6" );
+ cancelbtn->setGeometry( 210, 250, 100, 30 );
+ cancelbtn->setText( "Cancel" );
+ connect(cancelbtn,SIGNAL(clicked()),&dlg,SLOT(reject()));
+ dlg.resize( 380, 300 );
+ if (dlg.exec())
+ {
+ pom = new VLPEntry;
+ pom->ID = atoi(id->text());
+ if (check_id(pom->ID))
+ {
+ strcpy(pom->addr,addr->text());
+ if (check_addr(pom->addr))
+ {
+
+ if (strcmp(tmpQComboBox->currentText(),"Explicit")==0) pom->type=0;
+ strcpy(pom->progdir,progs->text());
+ strcpy(pom->homedir,home->text());
+ Nodes.append(pom);
+ sprintf(pomstr,"Node: %d Addr:%s Home dir: %s",pom->ID,pom->addr,pom->homedir);
+ nodelist->insertItem(pomstr);
+ strcpy(pom->item,pomstr);
+ } else QMessageBox::message("Error!","Only one VLP on a single computer!","Ok");
+ }
+ else QMessageBox::message("Error!","ID must be unique!","Ok");
+ }
+
+}
+
+void QInstall::DelNode()
+{
+ char pom[255];
+ VLPEntry *vpom;
+
+ if (nodelist->currentItem()>=0)
+ {
+ strcpy(pom,nodelist->text(nodelist->currentItem()));
+ vpom = Nodes.first();
+ while (vpom!=NULL)
+ {
+ if (strcmp(pom,vpom->item)==0) break;
+ vpom = Nodes.next();
+ }
+ if (vpom!=NULL)
+ if (QMessageBox::query("Delete VLP","Are you sure?","Yes","No"))
+ {
+ nodelist->removeItem(nodelist->currentItem());
+ Nodes.remove(vpom);
+ }
+ }
+}
+
+
+void QInstall::SetOptions()
+{
+ QDialog dlg(this,"",TRUE);
+ QLabel* tmpQLabel;
+ QPushButton *addbtn,*delbtn,*okbtn,*cancelbtn;
+ VLPEntry *pom;
+ QFile *vlp_file;
+ int i,j;
+ char pomstr[255],line[255];
+
+ dlg.setStyle(WindowsStyle);
+ nodelist = new QListBox( &dlg, "ListBox_1" );
+ nodelist->setGeometry( 20, 40, 480, 160 );
+
+ tmpQLabel = new QLabel( &dlg, "Label_1" );
+ tmpQLabel->setGeometry( 20, 10, 100, 30 );
+ tmpQLabel->setText( "Nodes:" );
+
+ addbtn = new QPushButton( &dlg, "PushButton_1" );
+ addbtn->setGeometry( 30, 210, 100, 30 );
+ addbtn->setText( "Add VLP" );
+ connect(addbtn,SIGNAL(clicked()),this,SLOT(AddNode()));
+ delbtn = new QPushButton( &dlg, "PushButton_2" );
+ delbtn->setGeometry( 150, 210, 100, 30 );
+ delbtn->setText( "Del VLP" );
+ connect(delbtn,SIGNAL(clicked()),this,SLOT(DelNode()));
+ okbtn = new QPushButton( &dlg, "PushButton_3" );
+ okbtn->setGeometry( 270, 210, 100, 30 );
+ okbtn->setText( "Save files" );
+ connect(okbtn,SIGNAL(clicked()),&dlg,SLOT(accept()));
+ cancelbtn = new QPushButton( &dlg, "PushButton_4" );
+ cancelbtn->setGeometry( 390, 210, 100, 30 );
+ cancelbtn->setText( "Cancel" );
+ connect(cancelbtn,SIGNAL(clicked()),&dlg,SLOT(reject()));
+ dlg.resize( 520, 260 );
+
+
+ if (dlg.exec()){
+ if (!Nodes.isEmpty())
+ {
+ pom = Nodes.first();
+ while (pom!=NULL)
+ {
+ j = Nodes.at();
+ sprintf(pomstr,"%s.cfg",pom->addr);
+ vlp_file = new QFile(pomstr);
+ vlp_file->open(IO_WriteOnly);
+ sprintf(line,"progdir=%s\n",pom->progdir);
+ vlp_file->writeBlock(line,strlen(line));
+ sprintf(line,"homedir=%s\n",pom->homedir);
+ vlp_file->writeBlock(line,strlen(line));
+ sprintf(line,"node_number=%d\n",pom->ID);
+ vlp_file->writeBlock(line,strlen(line));
+ if ( pom->type == 0)
+ {
+ sprintf(line,"type=explicit\n");
+ vlp_file->writeBlock(line,strlen(line));
+ }
+ for(i=0;i<Nodes.count();i++)
+ if (pom!=Nodes.at(i)) {
+ sprintf(line,"host=%s\n",Nodes.at(i)->addr);
+ vlp_file->writeBlock(line,strlen(line));
+ };
+ vlp_file->close();
+ pom = Nodes.at(j);
+ pom = Nodes.next();
+ }
+ }
+
+ };
+
+
+
+}
+
+
+#include "lgconfig.moc"
+
+int main( int argc, char **argv )
+{
+
+ app = new QApplication(argc,argv);
+ QInstall cfg;
+ app->setStyle(WindowsStyle);
+ app->setMainWidget(&cfg);
+ cfg.show();
+ return app->exec();
+}
--- /dev/null
+##### Change INCDIR, LFLAGS and MOC
+
+INCDIR = $(QINC)
+CFLAGS = -O2 -fno-strength-reduce -Wall -W -I/usr/X11R6/include
+LIBCFLAGS = -fPIC
+YACCCFLAGS = -Wno-unused -Wno-parentheses
+LFLAGS = -L$(QLIB) -lqt
+CC = g++
+MOC = $(MOCDIR)/moc
+SHELL = /bin/sh
+
+####### Files
+
+SOURCES = lgconfig.cpp
+OBJECTS = lgconfig.o
+SRCMETA = lgconfig.moc
+TARGET = lgconfig
+
+####### Implicit rules
+
+.SUFFIXES: .cpp
+
+.cpp.o:
+ $(CC) -c $(CFLAGS) -I$(INCDIR) $<
+
+####### Build rules
+
+all: $(TARGET)
+
+$(TARGET): $(SRCMETA) $(OBJECTS)
+ $(CC) $(OBJECTS) -o $(TARGET) $(LFLAGS) -lm
+
+depend:
+ @makedepend -I$(INCDIR) $(SOURCES) 2> /dev/null
+
+showfiles:
+ @echo $(SOURCES) $(HEADERS) Makefile
+
+clean:
+ -rm -f *.o *.bak *~ *% #*
+ -rm -f $(SRCMETA) $(TARGET)
+
+####### Meta objects
+
+lgconfig.moc: lgconfig.cpp
+ $(MOC) lgconfig.cpp -o lgconfig.moc
+
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
--- /dev/null
+
+
+all:
+ cd graph; $(MAKE)
+ cd net; $(MAKE)
+ cd kernel; $(MAKE)
+ cd int; $(MAKE)
+ cd edit; $(MAKE)
+ cd lgconfig; $(MAKE)
+ cd preproc; $(MAKE)
+ cd help; $(MAKE)
+
+clean:
+ cd graph; $(MAKE) clean
+ cd net; $(MAKE) clean
+ cd kernel; $(MAKE) clean
+ cd int; $(MAKE) clean
+ cd edit; $(MAKE) clean
+ cd lgconfig; $(MAKE) clean
+ cd preproc; $(MAKE) clean
+ cd help; $(MAKE) clean
+
+install:
+ rm -r -f $(INSTALLDIR)
+ mkdir $(INSTALLDIR)
+ mkdir $(INSTALLDIR)/doc
+ mkdir $(INSTALLDIR)/pics
+ mkdir $(INSTALLDIR)/modules
+ mkdir $(INSTALLDIR)/config
+ mkdir $(INSTALLDIR)/compile
+ mkdir $(INSTALLDIR)/doc/lang
+ mkdir $(INSTALLDIR)/examp
+ cp -r examp/* $(INSTALLDIR)/examp
+ cp inst/loglan $(INSTALLDIR)/compile
+ cp inst/gen $(INSTALLDIR)/compile
+ cp preproc/logcomp $(INSTALLDIR)/compile
+ cp inst/logo.bmp $(INSTALLDIR)/config
+ cp lgconfig/lgconfig $(INSTALLDIR)/config
+ cp -r doc/* $(INSTALLDIR)/doc
+ cp net/lognet $(INSTALLDIR)/modules
+ cp int/logint $(INSTALLDIR)/modules
+ cp graph/loggraph $(INSTALLDIR)/modules
+ cp edit/logedit $(INSTALLDIR)/modules
+ cp inst/close.bmp $(INSTALLDIR)/pics
+ cp kernel/logker $(INSTALLDIR)
+ cp help/loghelp $(INSTALLDIR)/modules
+ cp inst/LICENSE.GNU $(INSTALLDIR)
+ cp inst/LICENSE.QT $(INSTALLDIR)
+ echo node_number=1 > $(INSTALLDIR)/vlp.cfg
+ echo type=explicit >> $(INSTALLDIR)/vlp.cfg
+ echo homedir=$(INSTALLDIR) >> $(INSTALLDIR)/vlp.cfg
+ echo progdir=./ >> $(INSTALLDIR)/vlp.cfg
+ chmod a+rwx $(INSTALLDIR)
+ chmod a+rx $(INSTALLDIR)/doc
+ chmod a+rx $(INSTALLDIR)/pics
+ chmod a+rwx $(INSTALLDIR)/modules
+ chmod a+rx $(INSTALLDIR)/config
+ chmod a+rwx $(INSTALLDIR)/compile
+ chmod a+rx $(INSTALLDIR)/doc/lang
+ chmod a+rwx $(INSTALLDIR)/examp
+ chmod a+rx $(INSTALLDIR)/logker
+ chmod a+rx $(INSTALLDIR)/modules/*
+ chmod a+rx $(INSTALLDIR)/compile/*
--- /dev/null
+### Includes for QT library
+QINC=/usr/lib/qt-1.45/include
+
+### QT library directory
+QLIB=/usr/lib/qt-1.45/lib
+
+### moc compiler directory
+MOCDIR=/usr/lib/qt-1.45/bin
+
+### Install directory
+INSTALLDIR=/usr/local/vlp
+
+INCDIR = $(QINC)
+CFLAGS = -O2 -fno-strength-reduce -Wall -W -I/usr/X11R6/include
+LIBCFLAGS = -fPIC
+YACCCFLAGS = -Wno-unused -Wno-parentheses
+LFLAGS = -L$(QLIB) -lqt
+CC = g++
+MOC = $(MOCDIR)/moc
+SHELL = /bin/sh
+
+
+####### Files
+
+SOURCES = lognet.cpp
+OBJECTS = lognet.o
+SRCMETA = lognet.moc
+TARGET = lognet
+
+####### Implicit rules
+
+.SUFFIXES: .cpp
+
+.cpp.o:
+ $(CC) -c $(CFLAGS) -I$(INCDIR) $<
+
+####### Build rules
+
+all: $(TARGET)
+
+$(TARGET): $(SRCMETA) $(OBJECTS)
+ $(CC) $(OBJECTS) -o $(TARGET) $(LFLAGS) -lm
+
+depend:
+ @makedepend -I$(INCDIR) $(SOURCES) 2> /dev/null
+
+showfiles:
+ @echo $(SOURCES) $(HEADERS) Makefile
+
+clean:
+ -rm -f *.o *.bak *~ *% #*
+ -rm -f $(SRCMETA) $(TARGET)
+
+####### Meta objects
+
+lognet.moc: lognet.cpp
+ $(MOC) lognet.cpp -o lognet.moc
+
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
--- /dev/null
+#include "../head/genint1.h"
+#include "../head/comm.h"
+
+#include <sys/socket.h>
+#include <sys/un.h>
+#include <netinet/in.h>
+#include <errno.h>
+#include <netdb.h>
+#include <arpa/inet.h>
+
+#include <sys/types.h>
+#include <sys/time.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <fcntl.h>
+#include <signal.h>
+#include <sys/stat.h>
+#include <string.h>
+#include <qlist.h>
+#include <unistd.h>
+
+#define REMOTE_PATH "REMOTE"
+#define MAXLINKS 30
+#define LOGPORT 3600
+#define CODEPORT 3700
+#define CODEPORT1 3800
+#define MAXINTERP 10
+#define FILE_BUFFER_SIZE 2048
+
+
+
+// ************** Interpreter slot *******************
+class INTlink
+{
+ public:
+ int sock,ID;
+ bool connected;
+ INTlink();
+
+};
+
+INTlink::INTlink()
+{
+ connected=FALSE;
+ sock=0;
+}
+
+
+// ******************** Network slot ********************
+class NETlink
+{
+ public:
+ int sock;
+ bool connected,code_transmit;
+ char addr[255];
+
+ int node_number;
+ int aliases[5];
+
+ FILE *CodeFile;
+ char CodeName[255];
+ long CodeSize;
+
+
+ NETlink();
+};
+
+NETlink::NETlink()
+{
+ int i;
+ for(i=0;i<5;i++) aliases[i]=-1;
+ connected=FALSE;
+ sock=0;
+ code_transmit=FALSE;
+}
+
+
+
+
+//********************** NET Module ****************************
+
+class NETMOD
+{
+public:
+ int kernel_sock,listen_sock;
+ bool all_connected,local_mode;
+ int to_connect,MyNode;
+ char kername[256];
+
+
+ QList<INTlink> Interpreters; // List of the Interpeter slots
+ QList<NETlink> Links; // List of the Network slots
+
+ NETMOD(char*);
+
+ void load_config(char*);
+ void write_at_console(char*);
+ void send_to_kernel(MESSAGE*);
+ void sock_reopen(NETlink*);
+ void send_connect_info(NETlink*);
+ void send_accept_info(NETlink*);
+ void send_to_node(NETlink*,MESSAGE*);
+ void send_to_int(MESSAGE*);
+ void send_code_ack(NETlink*);
+ void send_to_all(MESSAGE *);
+
+ NETlink *findNETlink(int node);
+ INTlink *findINTlink(int id);
+ void transmit_file(int ton, char *fname, int fromINT);
+ void propagate_msg(MESSAGE *msg);
+ void check_node(int,int);
+
+ void run();
+ void exit_sequence();
+ void disconnect_seq();
+ void connect_seq(char*);
+ void accept_connection();
+ void get_internal();
+ void remote_messages();
+ void check_links();
+ void get_message(NETlink*);
+ void conn_info(int);
+};
+
+
+NETMOD::NETMOD(char *kernel_name)
+{
+ int i,len,on;
+ struct sockaddr_in svr;
+ struct sockaddr_un svr1;
+ MESSAGE m;
+ char s[256];
+
+
+ Links.clear();
+ Interpreters.clear();
+
+ bzero(&svr, sizeof(svr));
+ listen_sock = socket(AF_INET, SOCK_STREAM, 0);
+ svr.sin_family = AF_INET;
+ svr.sin_addr.s_addr = INADDR_ANY;
+ svr.sin_port = htons(LOGPORT);
+ bind(listen_sock, (struct sockaddr*)&svr, sizeof(svr));
+ listen(listen_sock,5);
+ fcntl(listen_sock, F_SETFL,O_NONBLOCK | fcntl(listen_sock, F_GETFL,0));
+
+ to_connect=0;
+ all_connected=FALSE;
+ load_config("vlp.cfg");
+
+ kernel_sock = socket(AF_UNIX,SOCK_STREAM,0);
+ bzero(&svr1,sizeof(svr1));
+ svr1.sun_family = AF_UNIX;
+ strcpy(svr1.sun_path,kernel_name);
+ strcpy(kername,kernel_name);
+ len = strlen(svr1.sun_path)+sizeof(svr1.sun_family);
+ i = connect(kernel_sock,(struct sockaddr*)&svr1,len);
+ if (i==0)
+ fcntl(kernel_sock,F_SETFL, O_NONBLOCK|fcntl(kernel_sock,F_GETFL,0));
+ on=1;
+ setsockopt(kernel_sock,IPPROTO_TCP,TCP_NODELAY,(char*)&on,sizeof(on));
+ m.msg_type = MSG_NET;
+ m.param.pword[0] = NET_NODE;
+ m.param.pword[1] = MyNode;
+ send_to_kernel(&m);
+
+ // if (regme) regme_sequence();
+
+ if (to_connect > 0){
+ write_at_console("Connecting remote VLPs...");
+ while (!all_connected) check_links();
+ }
+ sprintf(s,"Local node number %d",MyNode);
+ write_at_console(s);
+}
+
+// ##################### Load configuration ##########################
+
+void NETMOD::load_config(char *fname)
+{
+ FILE *f;
+ char line1[80],*line2;
+ int k=0,on;
+ NETlink *pomlink;
+
+ f = fopen(fname,"r");
+ if (f!=NULL)
+ {
+ while (!feof(f))
+{
+ fscanf(f,"%s\n",line1);
+ line2 = strtok(line1,"=");
+ if (line2==NULL) { write_at_console("Bad config file\n");exit(1);}
+
+ if (strcmp(line2,"node_number")==0)
+ {
+ line2 = strtok(NULL,"=");
+ MyNode = atoi(line2);
+ }
+ else
+ if (strcmp(line2,"host")==0)
+ {
+ line2 = strtok(NULL,"=");if (line2==NULL) {exit(1);}
+ k++;
+ pomlink = new NETlink;
+ strcpy(pomlink->addr,line2);
+ pomlink->connected = FALSE;
+ pomlink->sock = socket(AF_INET, SOCK_STREAM, 0);
+ fcntl(pomlink->sock, F_SETFL,O_NONBLOCK | fcntl(pomlink->sock,
+ F_GETFL,0));
+ on=1;
+ setsockopt(pomlink->sock,IPPROTO_TCP,TCP_NODELAY,(char*)&on,sizeof(on));
+ Links.append(pomlink);
+ to_connect++;
+
+ }
+ else
+ if (strcmp(line2,"type")==0)
+ {
+ }
+
+ } /* feof */
+
+ fclose(f);
+ if (k==0) all_connected=TRUE;
+ }
+ if (MyNode==-1) {write_at_console("Node number must be specified");exit(1);};
+}
+
+
+
+void NETMOD::write_at_console(char *s)
+{
+ MESSAGE msg;
+
+ msg.msg_type = MSG_NET;
+ msg.param.pword[0] = NET_CSWRITELN;
+ strcpy(msg.param.pstr,s);
+ send_to_kernel(&msg);
+}
+
+void NETMOD::send_to_kernel(MESSAGE *msg)
+{
+ write(kernel_sock,msg,sizeof(MESSAGE));
+}
+
+void NETMOD::send_to_node(NETlink *lnk, MESSAGE *msg)
+{
+ msg->msg_type = MSG_NET;
+// msg2netmsg(msg);
+if (lnk->sock)
+ write(lnk->sock,msg,sizeof(MESSAGE));
+}
+
+void NETMOD::send_to_int(MESSAGE *msg)
+{
+ INTlink *pomlink;
+
+ pomlink = findINTlink(msg->param.pword[5]);
+ if (pomlink!=NULL) write(pomlink->sock,msg,sizeof(MESSAGE));
+}
+
+
+
+void NETMOD::accept_connection()
+{
+ unsigned int sz;
+ int nsock, on;
+ struct sockaddr_in svr;
+ fd_set rset,wset;
+ struct timeval tout = {0,0};
+ NETlink *pomlink;
+
+ FD_ZERO(&rset);FD_ZERO(&wset);
+ FD_SET(listen_sock,&rset);
+
+ if (select(listen_sock+1,&rset,&wset,0,(struct timeval *)&tout)>0)
+ if (FD_ISSET(listen_sock,&rset))
+ {
+
+/* accept connection on listen socket */
+ sz = sizeof(svr);
+ bzero(&svr, sizeof(svr));
+ nsock = accept(listen_sock, (struct sockaddr*)&svr, &sz);
+
+ if (nsock>0)
+ {
+
+ /* i<0 someone wants to connect us */
+
+ pomlink = new NETlink;
+ strcpy(pomlink->addr,inet_ntoa(svr.sin_addr));
+ pomlink->sock = nsock;
+ pomlink->connected = TRUE;
+ fcntl(pomlink->sock, F_SETFL,O_NONBLOCK | fcntl(pomlink->sock,
+ F_GETFL,0));
+ on=1;
+ setsockopt(pomlink->sock,IPPROTO_TCP,TCP_NODELAY,(char*)&on,sizeof(on));
+ Links.append(pomlink);
+ } /* nsock > 0 */
+} /* ISSET */
+}
+
+
+void NETMOD::check_node(int n, int sc)
+{
+ MESSAGE m;
+ NETlink *pomlink;
+
+ m.msg_type = MSG_NET;
+ m.param.pword[0] = NET_NODE_EXIST;
+
+ pomlink = Links.first();
+ m.param.pword[1] = 0;
+ while (pomlink!=NULL)
+ {
+ if ( pomlink->node_number==n )
+ {
+ m.param.pword[1] = 1;break;
+ }
+ pomlink = Links.next();
+ }
+ write(sc,&m,sizeof(MESSAGE));
+}
+
+
+// ************* Internal message from kernel or INT *******************
+
+void NETMOD::get_internal()
+{
+ int nr,nrset;
+ MESSAGE msg;
+ int si, sj;
+ fd_set readset,writeset;
+ struct timeval tout={0,0};
+ INTlink *pomlink;
+ struct sockaddr_un svr;
+
+
+
+ FD_ZERO(&readset);FD_ZERO(&writeset);
+ FD_SET(kernel_sock,&readset);
+ nrset=kernel_sock;
+
+ pomlink = Interpreters.first();
+ while (pomlink!=NULL)
+ {
+ FD_SET(pomlink->sock,&readset);
+ if (nrset<pomlink->sock) nrset=pomlink->sock;
+ pomlink=Interpreters.next();
+ }
+
+ if (select(nrset+1,&readset,&writeset,0,(struct timeval *)&tout)>0)
+ {
+
+/* Check request sockets */
+ pomlink = Interpreters.first();
+ while (pomlink!=NULL)
+ {
+ if (FD_ISSET(pomlink->sock,&readset))
+ {
+ nr = read(pomlink->sock,&msg,sizeof(MESSAGE));
+ if (nr>0)
+ {
+ if (msg.msg_type == MSG_NET)
+ switch(msg.param.pword[0])
+ {
+ case NET_PROPAGATE:propagate_msg(&msg);break;
+ case NET_NODE_EXIST:check_node(msg.param.pword[1],pomlink->sock);break;
+ case NET_GET_INFO: conn_info(pomlink->sock);break;
+ case NET_NODES_NUM: msg.param.pword[0]=NET_NODES_NUM_RESPONSE;
+ msg.param.pword[1]=Links.count();
+ write(pomlink->sock,&msg,sizeof(MESSAGE));
+ break;
+ }/* switch */
+ }
+ } /* ISSET */
+ pomlink=Interpreters.next();
+ } // while
+
+/* Check internal socket */
+ if (FD_ISSET(kernel_sock,&readset))
+ {
+ nr = read(kernel_sock, &msg, sizeof(MESSAGE));
+ if (nr>0)
+ {
+ if (msg.msg_type == MSG_NET)
+ {
+ switch(msg.param.pword[0])
+ {
+ case NET_TRANSMIT_CODE:
+ transmit_file(msg.param.pword[2],msg.param.pstr,msg.param.pword[1]);
+ break;
+ case NET_EXIT: { disconnect_seq();exit_sequence();}
+ break;
+ case NET_GET_INFO: conn_info(kernel_sock);break;
+ case NET_PROPAGATE:propagate_msg(&msg);break;
+ case NET_DISCONNECT:disconnect_seq();
+ break;
+ case NET_NODE_EXIST: check_node(msg.param.pword[1],kernel_sock);break;
+ case NET_CONNECT_TO: connect_seq(msg.param.pstr);
+
+ } /* end switch */
+ } /* MSg_NET */
+
+ if (msg.msg_type == MSG_VLP)
+ switch(msg.param.pword[0])
+ {
+ case VLP_REGINT:
+ {
+ pomlink = new INTlink;
+ pomlink->sock = socket(AF_UNIX,SOCK_STREAM,0);
+ bzero(&svr,sizeof(svr));
+ svr.sun_family = AF_UNIX;
+ strcpy(svr.sun_path,msg.param.pstr);
+ si = strlen(svr.sun_path)+sizeof(svr.sun_family);
+ sj = connect(pomlink->sock,(struct sockaddr*)&svr,si);
+ if (sj==0)
+ fcntl(pomlink->sock,F_SETFL, O_NONBLOCK|
+ fcntl(pomlink->sock,F_GETFL,0));
+ int on=1;
+ setsockopt(pomlink->sock,IPPROTO_TCP,TCP_NODELAY,(char*)&on,sizeof(on));
+ pomlink->ID = msg.param.pword[1];
+ pomlink->connected=TRUE;
+ Interpreters.append(pomlink);
+
+ };break;
+ case VLP_INTERPRETER_DOWN:
+ {
+ pomlink = findINTlink(msg.param.pword[1]);
+ if (pomlink!=NULL)
+ {
+ close(pomlink->sock);
+ Interpreters.remove(pomlink);
+ }
+ };break;
+
+ break;
+ } /* MSg_VLP */
+ }
+ }/* ISSET */
+ } /* select >0 */
+
+
+}
+
+void NETMOD::get_message(NETlink *lnk)
+{
+ int nr;
+ MESSAGE msg;
+ char pomstr[80];
+ int rdbt,rd,sz,j,psock;
+ struct sockaddr_in svr;
+ unsigned char buffer[FILE_BUFFER_SIZE];
+ protdescr proto;
+
+if (lnk->connected)
+{
+ nr = read(lnk->sock,&msg, sizeof(MESSAGE));
+ if (nr>0)
+ {
+// netmsg2msg(&msg);
+ if (msg.msg_type == MSG_NET)
+ {
+ switch(msg.param.pword[0])
+ {
+ case NET_CCD_START:
+ lnk->code_transmit = TRUE;
+ sprintf(pomstr,"%s/%s",REMOTE_PATH,msg.param.pstr);
+ strcat(pomstr,".ccd");
+ lnk->CodeFile = fopen(pomstr,"wb");
+ if ( lnk->CodeFile == NULL) { write_at_console("Cannot open file\n");
+ lnk->code_transmit=FALSE;}
+ lnk->CodeSize=msg.param.pword[1];
+ psock = socket(AF_INET, SOCK_STREAM, 0);
+ bzero(&svr, sizeof(svr));
+ svr.sin_family = AF_INET;
+ svr.sin_port = htons(CODEPORT);
+ svr.sin_addr.s_addr = inet_addr(lnk->addr);
+ j = connect(psock, (struct sockaddr*)&svr, sizeof(svr));
+ if ( j==0)
+ {
+ //fcntl(psock, F_SETFL,O_NONBLOCK | fcntl(psock, F_GETFL,0));
+ sz=0;
+ while (sz<lnk->CodeSize)
+ {
+ rd = read(psock,&buffer,sizeof(buffer));
+ rdbt = fwrite(&buffer,sizeof(unsigned char),rd,lnk->CodeFile);
+ sz=sz+rd;
+ }
+ close(psock);
+ fclose(lnk->CodeFile);
+ }
+ break;
+
+ case NET_PCD_START:
+ lnk->code_transmit = TRUE;
+ sprintf(pomstr,"%s/%s",REMOTE_PATH,msg.param.pstr);
+ strcat(pomstr,".pcd");
+ lnk->CodeFile = fopen(pomstr,"wb");
+ if ( lnk->CodeFile == NULL) { write_at_console("Cannot open file\n");
+ lnk->code_transmit=FALSE;}
+ lnk->CodeSize=msg.param.pword[1];
+ psock = socket(AF_INET, SOCK_STREAM, 0);
+ bzero(&svr, sizeof(svr));
+ svr.sin_family = AF_INET;
+ svr.sin_port = htons(CODEPORT1);
+ svr.sin_addr.s_addr = inet_addr(lnk->addr);
+ j = connect(psock, (struct sockaddr*)&svr, sizeof(svr));
+ if ( j==0)
+ {
+ //fcntl(psock, F_SETFL,O_NONBLOCK | fcntl(psock, F_GETFL,0));
+ sz=0;
+ while (sz<lnk->CodeSize)
+ {
+ rd = read(psock,&proto,sizeof(proto));
+ rdbt = fwrite(&proto,sizeof(unsigned char),rd,lnk->CodeFile);
+ sz=sz+rd;
+ }
+ close(psock);
+ fclose(lnk->CodeFile);
+ }
+ break;
+
+ case NET_CONNECT:
+ sprintf(pomstr,"Node: %d Addr: %s",msg.param.pword[1],
+ lnk->addr);
+ lnk->node_number = msg.param.pword[1];
+ write_at_console(pomstr);
+ send_accept_info(lnk);
+ break;
+ case NET_ACCEPT:
+ sprintf(pomstr,"Node: %d Addr: %s",msg.param.pword[1],
+ lnk->addr);
+ lnk->node_number = msg.param.pword[1];
+ write_at_console(pomstr);
+ break;
+ case NET_DISCONNECT:
+ sprintf(pomstr,"Node: %d disconnected",msg.param.pword[1]);
+ write_at_console(pomstr);
+ ::close(lnk->sock);
+ Links.remove(lnk);
+ delete(lnk);
+ break;
+ case NET_PROPAGATE:
+ if (msg.param.pword[1] == MSG_VLP) send_to_kernel(&msg);
+ else if (msg.param.pword[1] == MSG_INT) send_to_int(&msg);
+ break;
+
+ } /* end switch */
+
+ }
+ } /* nr > 0 */
+
+} /* end if used */
+}
+
+
+
+void NETMOD::remote_messages()
+{
+ int max;
+ fd_set rset,wset;
+ struct timeval tout={0,0};
+ NETlink *pomlink;
+
+ FD_ZERO(&rset);FD_ZERO(&wset);
+ max=0;
+
+ pomlink = Links.first();
+ while (pomlink!=NULL)
+ {
+ if (pomlink->connected)
+ {
+ FD_SET(pomlink->sock,&rset);
+ if (max<pomlink->sock) max=pomlink->sock;
+ }
+ pomlink=Links.next();
+ }
+
+ if (select(max+1,&rset,&wset,0,(struct timeval *)&tout)>0)
+ {
+ pomlink=Links.first();
+ while (pomlink!=NULL)
+ {
+ if (FD_ISSET(pomlink->sock,&rset)) get_message(pomlink);
+ pomlink=Links.next();
+ }
+ }
+
+}
+
+void NETMOD::propagate_msg(MESSAGE *msg)
+{
+ char ss[255];
+ NETlink *pomlink;
+
+ pomlink = findNETlink(msg->param.pword[4]);
+ if ((pomlink!=NULL)&&(pomlink->connected))
+ send_to_node(pomlink,msg);
+ else {
+ if (msg->param.pword[1]==MSG_INT)
+ {
+ send_to_int(msg);
+ }
+ else
+ {
+ sprintf(ss,"Not connected to Node %d",msg->param.pword[4]);
+ write_at_console(ss);
+ }
+ }
+
+}
+
+
+void NETMOD::connect_seq(char *a)
+{
+ NETlink *pom;
+ struct sockaddr_in svr;
+ int j,on;
+
+
+ pom=Links.first();
+ while (pom!=NULL)
+ {
+ if (strcmp(pom->addr,a)==0) return;
+ pom=Links.next();
+ }
+ pom = new NETlink;
+ strcpy(pom->addr,a);
+ pom->connected = FALSE;
+ pom->sock = socket(AF_INET, SOCK_STREAM, 0);
+ bzero(&svr, sizeof(svr));
+ svr.sin_family = AF_INET;
+ svr.sin_port = htons(LOGPORT);
+ svr.sin_addr.s_addr = inet_addr(pom->addr);
+ j = connect(pom->sock, (struct sockaddr*)&svr, sizeof(svr));
+ if ( j==0)
+ { pom->connected = TRUE;
+ fcntl(pom->sock, F_SETFL,O_NONBLOCK | fcntl(pom->sock,
+ F_GETFL,0));
+ on=1;
+ setsockopt(pom->sock,IPPROTO_TCP,TCP_NODELAY,(char*)&on,sizeof(on));
+ send_connect_info(pom);
+ Links.append(pom);
+ }
+ else write_at_console("Connection failed");
+}
+
+void NETMOD::check_links()
+{
+
+int j=1;
+struct sockaddr_in svr;
+NETlink *pomlink;
+
+/* connect to all other nodes */
+if (!all_connected)
+{
+ pomlink=Links.first();
+ while (pomlink!=NULL)
+ {
+ if ( !(pomlink->connected) )
+ {
+ bzero(&svr, sizeof(svr));
+ svr.sin_family = AF_INET;
+ svr.sin_port = htons(LOGPORT);
+ svr.sin_addr.s_addr = inet_addr(pomlink->addr);
+
+ j = connect(pomlink->sock, (struct sockaddr*)&svr, sizeof(svr));
+ if ( j==0)
+ { pomlink->connected = TRUE;
+ fcntl(pomlink->sock, F_SETFL,O_NONBLOCK | fcntl(pomlink->sock,
+ F_GETFL,0));
+ send_connect_info(pomlink);
+
+ }
+ if (errno == ECONNREFUSED)
+ sock_reopen(pomlink);
+ } // not connected
+ pomlink=Links.next();
+ } //while
+
+}//if
+all_connected=TRUE;
+pomlink=Links.first();
+while(pomlink!=NULL)
+{
+ if (pomlink->connected==FALSE) {all_connected=FALSE;break;}
+ pomlink=Links.next();
+}
+
+}
+
+void NETMOD::sock_reopen(NETlink *lnk)
+{
+ int on=1;
+
+ close(lnk->sock);
+ lnk->sock = socket(AF_INET, SOCK_STREAM, 0);
+ fcntl(lnk->sock, F_SETFL,O_NONBLOCK | fcntl(lnk->sock,
+ F_GETFL,0));
+ setsockopt(lnk->sock,IPPROTO_TCP,TCP_NODELAY,(char*)&on,sizeof(on));
+}
+
+
+// **************** Acknowledges *************************
+
+void NETMOD::send_connect_info(NETlink *lnk)
+{
+ MESSAGE m;
+
+ m.param.pword[0] = NET_CONNECT;
+ m.param.pword[1] = MyNode;
+ m.msg_type = MSG_NET;
+// msg2netmsg(&m);
+ if (lnk->sock)
+ write(lnk->sock,&m,sizeof(MESSAGE));
+}
+
+void NETMOD::send_accept_info(NETlink *lnk)
+{
+ MESSAGE m;
+
+ m.param.pword[0] = NET_ACCEPT;
+ m.param.pword[1] = MyNode;
+ m.msg_type = MSG_NET;
+// msg2netmsg(&m);
+ if (lnk->sock)
+ write(lnk->sock,&m,sizeof(MESSAGE));
+}
+
+void NETMOD::send_code_ack(NETlink *lnk)
+{
+MESSAGE m;
+
+ m.param.pword[0] = NET_CODESTREAM_OK;
+ m.msg_type = MSG_NET;
+// msg2netmsg(&m);
+ if (lnk->sock)
+ write(lnk->sock,&m,sizeof(MESSAGE));
+}
+
+
+void NETMOD::send_to_all(MESSAGE *msg)
+{
+ NETlink *pomlink;
+ pomlink=Links.first();
+ while (pomlink!=NULL)
+ {
+ write(pomlink->sock,msg,sizeof(MESSAGE));
+ pomlink=Links.next();
+ }
+}
+
+
+
+
+void NETMOD::run()
+{
+ while(1)
+ {
+ accept_connection();
+ get_internal();
+ remote_messages();
+ }
+}
+
+void NETMOD::exit_sequence()
+{
+ NETlink *pomlink;
+
+ ::close(kernel_sock);
+ ::close(listen_sock);
+ unlink(kername);
+ pomlink = Links.first();
+ while (pomlink!=NULL)
+ {
+ ::close(pomlink->sock);
+ pomlink=Links.next();
+ }
+ exit(0);
+}
+
+void NETMOD::disconnect_seq()
+{
+ MESSAGE m;
+ NETlink *p;
+
+ bzero(&m,sizeof(MESSAGE));
+ m.msg_type = MSG_NET;
+ m.param.pword[0] = NET_DISCONNECT;
+ m.param.pword[1] = MyNode;
+
+ p=Links.first();
+ while(p!=NULL)
+ {
+ send_to_node(p,&m);
+ p=Links.next();
+ }
+ p=Links.first();
+ while(p!=NULL)
+ {
+ ::close(p->sock);
+ p=Links.next();
+ }
+ Links.clear();
+}
+
+NETlink *NETMOD::findNETlink(int node)
+{
+ NETlink *pomlink;
+ pomlink=Links.first();
+ while(pomlink!=NULL)
+ {
+ if (pomlink->node_number == node) return(pomlink);
+ pomlink=Links.next();
+ }
+ return(pomlink);
+}
+
+INTlink *NETMOD::findINTlink(int id)
+{
+ INTlink *pomlink;
+ pomlink=Interpreters.first();
+ while(pomlink!=NULL)
+ {
+ if (pomlink->ID == id) return(pomlink);
+ pomlink=Interpreters.next();
+ }
+ return(pomlink);
+}
+
+
+/* ---------------- Sending code to a remote node -------------- */
+
+void NETMOD::transmit_file(int ton, char *fname, int fromINT)
+{
+ FILE *f;
+ MESSAGE msg;
+ char fn[80];
+ char b[255];
+ unsigned char buffer[FILE_BUFFER_SIZE];
+ protdescr proto;
+ int i,tsock,sock;
+ unsigned int sz;
+ NETlink *outlink;
+ struct sockaddr_in svr;
+ fd_set rset,wset;
+
+
+// **************** CCD FILE
+
+ strcpy(fn,fname);
+ strcat(fn,".ccd");
+ f = fopen(fn,"rb");
+ if (f!=NULL)
+ {
+ fseek(f,0,SEEK_END);
+ msg.param.pword[1] = ftell(f);
+ fclose(f);
+ f = fopen(fn,"rb");
+
+ strcpy(b,rindex(fname,'/'));
+ for(i=0;i<strlen(b);i++)
+ b[i] = b[i+1];
+ msg.param.pword[0] = NET_CCD_START;
+ strcpy(msg.param.pstr,b);
+
+ outlink = findNETlink(ton);
+ if (outlink==NULL) exit(1);
+ bzero(&svr,sizeof(svr));
+ sock = socket(AF_INET,SOCK_STREAM,0);
+ svr.sin_family = AF_INET;
+ svr.sin_addr.s_addr = INADDR_ANY;
+ svr.sin_port = htons(CODEPORT);
+ bind(sock, (struct sockaddr*)&svr, sizeof(svr));
+ listen(sock,5);
+ send_to_node(outlink, &msg);
+ sz=sizeof(svr);
+ FD_ZERO(&rset);FD_ZERO(&wset);
+ FD_SET(sock,&rset);
+ if (select(sock+1,&rset,&wset,0,0))
+ if (FD_ISSET(sock,&rset))
+ tsock = accept(sock, (struct sockaddr*)&svr,&sz );
+ if (tsock>0)
+ {
+ close(sock);
+ while (!feof(f))
+ {
+ i = fread(&buffer,1,sizeof(buffer),f);
+ write(tsock,&buffer,i);
+ FD_ZERO(&rset);FD_ZERO(&wset);
+ FD_SET(tsock,&wset);
+ select(tsock+1,&rset,&wset,0,0);
+ }
+ close(tsock);
+ }
+ fclose(f);
+ } // f!=NULL
+ else
+ {
+ sprintf(b,"Cannot open file to send %s\n",fname);
+ write_at_console(b);
+ }
+
+
+// *************** PCD FILE
+
+ strcpy(fn,fname);
+ strcat(fn,".pcd");
+ f = fopen(fn,"r");
+ if (f!=NULL)
+ {
+ fseek(f,0,SEEK_END);
+ msg.param.pword[1] = ftell(f);
+ fclose(f);
+ f = fopen(fn,"rb");
+
+ strcpy(b,rindex(fname,'/'));
+ for(i=0;i<strlen(b);i++)
+ b[i] = b[i+1];
+ msg.param.pword[0] = NET_PCD_START;
+ strcpy(msg.param.pstr,b);
+
+ outlink = findNETlink(ton);
+ if (outlink==NULL) exit(1);
+ bzero(&svr,sizeof(svr));
+ sock = socket(AF_INET,SOCK_STREAM,0);
+ svr.sin_family = AF_INET;
+ svr.sin_addr.s_addr = INADDR_ANY;
+ svr.sin_port = htons(CODEPORT1);
+ bind(sock, (struct sockaddr*)&svr, sizeof(svr));
+ listen(sock,5);
+ send_to_node(outlink, &msg);
+ sz=sizeof(svr);
+ FD_ZERO(&rset);FD_ZERO(&wset);
+ FD_SET(sock,&rset);
+ if (select(sock+1,&rset,&wset,0,0))
+ if (FD_ISSET(sock,&rset))
+ tsock = accept(sock, (struct sockaddr*)&svr,&sz );
+ if (tsock>0)
+ {
+ close(sock);
+ while (!feof(f))
+ {
+ i = fread(&proto,1,sizeof(proto),f);
+ write(tsock,&proto,i);
+ FD_ZERO(&rset);FD_ZERO(&wset);
+ FD_SET(tsock,&wset);
+ select(tsock+1,&rset,&wset,0,0);
+ }
+ close(tsock);
+ }
+ fclose(f);
+ } // f!=NULL
+ else
+ {
+ sprintf(b,"Cannot open file to send %s\n",fname);
+ write_at_console(b);
+ }
+
+
+ msg.msg_type = MSG_NET;
+ msg.param.pword[0] = NET_TRANSMITTED;
+ msg.param.pword[1] = fromINT;
+ send_to_kernel(&msg);
+
+
+}
+
+
+
+void NETMOD::conn_info(int sk)
+{
+ NETlink *pom;
+ MESSAGE m;
+ int k=0;
+ char poms[255];
+
+ m.msg_type = MSG_NET;
+ m.param.pword[0] = NET_INFO;
+ strcpy(m.param.pstr,"");
+ pom=Links.first();
+ while (pom!=NULL)
+ {
+ sprintf(poms,"%d=%s;",pom->node_number,pom->addr);
+ strcat(m.param.pstr,poms);
+ k++;
+ if (k==12)
+ {
+ m.param.pword[1]=12;
+ write(sk,&m,sizeof(MESSAGE));
+ k=0;
+ }
+ pom=Links.next();
+ }
+ if (k>0)
+ {
+ m.param.pword[1]=k;
+ write(sk,&m,sizeof(MESSAGE));
+ }
+ m.msg_type = MSG_NET;
+ m.param.pword[0] = NET_INFO_END;
+ write(sk,&m,sizeof(MESSAGE));
+}
+
+int main(int argc,char **argv)
+{
+ NETMOD netter(argv[1]);
+ netter.run();
+ return 0;
+}
--- /dev/null
+
+INCDIR = $(QINC)
+CFLAGS = -O2 -fno-strength-reduce -Wall -W -I/usr/X11R6/include
+LIBCFLAGS = -fPIC
+YACCCFLAGS = -Wno-unused -Wno-parentheses
+LFLAGS = -L$(QLIB) -lqt
+CC = g++
+MOC = $(MOCDIR)/moc
+SHELL = /bin/sh
+
+
+####### Files
+
+SOURCES = lognet.cpp
+OBJECTS = lognet.o
+SRCMETA = lognet.moc
+TARGET = lognet
+
+####### Implicit rules
+
+.SUFFIXES: .cpp
+
+.cpp.o:
+ $(CC) -c $(CFLAGS) -I$(INCDIR) $<
+
+####### Build rules
+
+all: $(TARGET)
+
+$(TARGET): $(SRCMETA) $(OBJECTS)
+ $(CC) $(OBJECTS) -o $(TARGET) $(LFLAGS) -lm
+
+depend:
+ @makedepend -I$(INCDIR) $(SOURCES) 2> /dev/null
+
+showfiles:
+ @echo $(SOURCES) $(HEADERS) Makefile
+
+clean:
+ -rm -f *.o *.bak *~ *% #*
+ -rm -f $(SRCMETA) $(TARGET)
+
+####### Meta objects
+
+lognet.moc: lognet.cpp
+ $(MOC) lognet.cpp -o lognet.moc
+
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
--- /dev/null
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <errno.h>
+#include <netdb.h>
--- /dev/null
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <sys/un.h>
+#include <errno.h>
--- /dev/null
+### Includes for QT library
+QINC=/usr/lib/qt-1.45/include
+
+### QT library directory
+QLIB=/usr/lib/qt-1.45/lib
+
+### moc compiler directory
+MOCDIR=/usr/lib/qt-1.45/bin
+
+### Install directory
+INSTALLDIR=/usr/local/vlp
+
+INCDIR = $(QINC)
+CFLAGS = -O2 -fno-strength-reduce -Wall -W -I/usr/X11R6/include
+LIBCFLAGS = -fPIC
+YACCCFLAGS = -Wno-unused -Wno-parentheses
+LFLAGS = -L$(QLIB) -lqt
+CC = g++
+MOC = $(MOCDIR)/moc
+SHELL = /bin/sh
+
+####### Files
+
+SOURCES = prep.cpp
+OBJECTS = prep.o
+SRCMETA = prep.moc
+TARGET = logcomp
+
+####### Implicit rules
+
+.SUFFIXES: .cpp
+
+.cpp.o:
+ $(CC) -c $(CFLAGS) -I$(INCDIR) $<
+
+####### Build rules
+
+all: $(TARGET)
+
+$(TARGET): $(SRCMETA) $(OBJECTS)
+ $(CC) $(OBJECTS) -o $(TARGET) $(LFLAGS) -lm
+
+depend:
+ @makedepend -I$(INCDIR) $(SOURCES) 2> /dev/null
+
+showfiles:
+ @echo $(SOURCES) $(HEADERS) Makefile
+
+clean:
+ -rm -f *.o *.bak *~ *% #*
+ -rm -f $(SRCMETA) $(TARGET)
+
+####### Meta objects
+
+prep.moc: prep.cpp
+ $(MOC) prep.cpp -o prep.moc
+
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
--- /dev/null
+
+INCDIR = $(QINC)
+CFLAGS = -O2 -fno-strength-reduce -Wall -W -I/usr/X11R6/include
+LIBCFLAGS = -fPIC
+YACCCFLAGS = -Wno-unused -Wno-parentheses
+LFLAGS = -L$(QLIB) -lqt
+CC = g++
+MOC = $(MOCDIR)/moc
+SHELL = /bin/sh
+
+####### Files
+
+SOURCES = prep.cpp
+OBJECTS = prep.o
+SRCMETA = prep.moc
+TARGET = logcomp
+
+####### Implicit rules
+
+.SUFFIXES: .cpp
+
+.cpp.o:
+ $(CC) -c $(CFLAGS) -I$(INCDIR) $<
+
+####### Build rules
+
+all: $(TARGET)
+
+$(TARGET): $(SRCMETA) $(OBJECTS)
+ $(CC) $(OBJECTS) -o $(TARGET) $(LFLAGS) -lm
+
+depend:
+ @makedepend -I$(INCDIR) $(SOURCES) 2> /dev/null
+
+showfiles:
+ @echo $(SOURCES) $(HEADERS) Makefile
+
+clean:
+ -rm -f *.o *.bak *~ *% #*
+ -rm -f $(SRCMETA) $(TARGET)
+
+####### Meta objects
+
+prep.moc: prep.cpp
+ $(MOC) prep.cpp -o prep.moc
+
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
--- /dev/null
+
+#include <qlist.h>
+#include <qstring.h>
+#include <stdio.h>
+#include <qfile.h>
+#include <qtstream.h>
+#include <string.h>
+#include <qdir.h>
+#include <unistd.h>
+#include <stdlib.h>
+
+class IncFile
+{
+public:
+ char filename[255];
+ int start, len;
+ IncFile(char *s,int st) {strcpy(filename,s);start=st;len=0;};
+};
+
+QList<IncFile> inc;
+
+IncFile *findTrueLine(int ln, int *trueline)
+{
+ IncFile *pom,*pom1;
+ QList<IncFile> pl;
+ int c1=0,c2=0;
+
+
+if (inc.isEmpty()) { *trueline=ln;return(NULL);}
+pl.clear();
+pom=inc.first();
+if (pom->start>ln) {*trueline=ln;return(NULL);}
+
+while ( (pom!=NULL) && (ln>pom->start))
+ {
+
+ if (ln<pom->start+pom->len) {*trueline=ln-pom->start;
+ return(pom);}
+ pl.append(pom);
+ pom=inc.next();
+ }
+
+ if (pom != NULL)
+ {
+ pom1=pl.first();c1=0;
+ while (pom1!=NULL) { c1+=pom1->len;pom1=pl.next(); }
+ *trueline=ln-c1; return(NULL);
+ }
+ else
+ {
+ pom1=inc.first();c1=0;
+ while (pom1!=NULL) { c1+=pom1->len;pom1=inc.next(); }
+ *trueline=ln-c1; return(NULL);
+ }
+ return(NULL);
+}
+
+int main(int argc,char **argv)
+{
+ char homedir[255];
+ char mydir[255],ss[255],fname[255];
+ QString poms,poms1,poms2;
+
+ int currentline=1;
+ int i,j,line,tline;
+
+
+
+ inc.clear();
+ poms.sprintf("%s",argv[1]);
+ i=poms.findRev('/',poms.length()-1,FALSE);
+
+
+//******* get home directory
+ if (i!=-1)
+ {
+ poms1=poms.left(i+1);
+ strcpy(homedir,poms1.data());
+ }
+ else strcpy(homedir,"");
+
+ poms.sprintf("%s",argv[0]);
+ i=poms.findRev('/',poms.length()-1,FALSE);
+ if (i!=-1) poms1=poms.left(i);
+ else poms1.sprintf(".");
+ strcpy(mydir,poms1.data());
+
+ poms.sprintf("%s",argv[1]);
+ i=poms.findRev(".log",poms.length()-1,FALSE);
+ poms1=poms.left(i);
+ strcpy(fname,poms1.data());
+
+
+// ********************
+
+ poms.sprintf("%s/.cmp00",mydir);
+ poms1.sprintf("%s/cmp01.log",mydir);
+ unlink(poms.data());
+ unlink(poms1.data());
+
+ QFile compfile(poms1.data());
+ QFile srcfile(argv[1]);
+
+
+ if (!compfile.open(IO_WriteOnly))
+ {fprintf(stdout,"Cannot open temp file to write %s\n",poms1.data());exit(1);}
+
+ if (!srcfile.open(IO_ReadOnly))
+ {fprintf(stdout,"Cannot open file\n");exit(1);}
+
+ QTextStream comps(&compfile);
+ QTextStream src(&srcfile);
+
+
+ while (!src.eof())
+ {
+ poms = src.readLine();
+ i=poms.find("#include");
+ if (i!=-1)
+ { // get include file
+ i=poms.find('"');
+ if (i!=-1) j=poms.find('"',i+1);
+ if ((i!=-1) && (j!=-1))
+ {
+ IncFile *p;
+ poms1=poms.mid(i+1,j-i-1);
+ p=new IncFile(poms1.data(),currentline);
+ poms2.sprintf("%s%s",homedir,poms1.data());
+ QFile pomf(poms2.data());
+ if (!pomf.open(IO_ReadOnly))
+ {
+ fprintf(stdout,"Cannot open include file: %s\n",poms2.data());
+ exit(1);
+ }
+ QTextStream pomstream(&pomf);
+ while (!pomstream.eof())
+ {
+ poms1=pomstream.readLine();
+ comps<<poms1.data();
+ comps<<"\n";
+ p->len++;
+ currentline++;
+ }
+ pomf.close();
+ inc.append(p);
+ }
+ }
+ else
+ {
+ comps<<poms.data();
+ comps<<"\n";
+ }
+
+ currentline++;
+ }// eof
+
+
+ srcfile.close();
+ compfile.close();
+
+ poms.sprintf("%s/cmp01.lcd",mydir);
+ unlink(poms.data());
+
+ sprintf(ss,"%s/loglan %s/cmp01 > %s/.cmp00",mydir,mydir,mydir);
+ if (system(ss)==-1)
+ {
+ fprintf(stdout,"Cannot execute compiler\n");
+ exit(1);
+ }
+
+
+ poms1.sprintf("%s.lcd",fname);
+
+ if (QFile::exists(poms.data()))
+ {
+ rename(poms.data(),poms1.data());
+ unlink(poms.data());
+ fprintf(stdout,"Compile ok\n");
+ sprintf(ss,"%s/gen %s",mydir,fname);
+ if (system(ss)==-1)
+ {
+ fprintf(stdout,"Cannot execute generator\n");
+ exit(1);
+ }
+ poms.sprintf("%s.ccd",fname);
+ if (QFile::exists(poms.data())) {unlink(poms1.data());}
+ }
+ else
+{
+ fprintf(stdout,"Errors\n");
+
+ poms.sprintf("%s/.cmp00",mydir);
+ QFile err(poms.data());
+
+ if (!err.open(IO_ReadOnly))
+ { fprintf(stdout,"Cannot open error file\n");
+ exit(1);
+ }
+ QTextStream errstream(&err);
+ IncFile *fl;
+
+ poms=errstream.readLine();
+ i=poms.find("LOGLAN-82");
+ while( (!errstream.eof()) && (i==-1))
+ {
+ poms=errstream.readLine();
+ i=poms.find("LOGLAN-82");
+ } // ***
+
+ while (!errstream.eof())
+ {
+ poms=errstream.readLine();
+ i=poms.find("ERROR");
+ if (i!=-1)
+ {
+ i=i-2;
+ j=poms.findRev(' ',i);
+ poms1=poms.mid(j+1,i-j);
+ line=poms1.toInt();
+ fl = findTrueLine(line,&tline);
+ poms2=poms.right(poms.length()-i-1);
+ if (fl!=NULL) fprintf(stdout,"%s: ",fl->filename);
+ fprintf(stdout,"%d %s\n",tline,poms2.data());
+ }
+ }
+ err.close();
+} // errors
+
+ poms.sprintf("%s/cmp01.log",mydir);
+ unlink(poms.data());
+ poms.sprintf("%s/.cmp00",mydir);
+ unlink(poms.data());
+
+return(0);
+}
projects / vlp.git / commitdiff
