From: Rafał Długołęcki Date: Fri, 28 Jun 2013 08:41:24 +0000 (+0200) Subject: Added upstream version. X-Git-Tag: initial-upstream X-Git-Url: https://git.dlugolecki.net.pl/?p=vlp.git;a=commitdiff_plain;h=9db87b545def5d31a64608f2eb082d915ad5efa4 Added upstream version. --- 9db87b545def5d31a64608f2eb082d915ad5efa4 diff --git a/CHANGES b/CHANGES new file mode 100644 index 0000000..33e4815 --- /dev/null +++ b/CHANGES @@ -0,0 +1,61 @@ +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! diff --git a/Dir b/Dir new file mode 100644 index 0000000..dd5c850 --- /dev/null +++ b/Dir @@ -0,0 +1,11 @@ +### 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 diff --git a/INSTALL b/INSTALL new file mode 100644 index 0000000..51765f9 --- /dev/null +++ b/INSTALL @@ -0,0 +1,42 @@ +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 !!! + + + + diff --git a/InstallVLP.html b/InstallVLP.html new file mode 100644 index 0000000..feedcaf --- /dev/null +++ b/InstallVLP.html @@ -0,0 +1,70 @@ + + + + installation of VLP + + + + +

Installing VLP - Virtual Loglan Processor
+

Pre-requisite:

+ Prior to compile and run Virtual LOGLAN Processor you should install + the QT library qt-1.45.(You may consult the +file "inst/LICENSE.QT" for more informations about the QT.
+If your system does not contain the library qt-1.45 (nowadays most systems +contains a newer, yet incompatible version of qt library)
+Read the file
+ installQT.html
+ and follow the instructions contained there.
+
+
+ +

Installation:

Create an empty directory e.g.
+ /usr/local/vlp.build
Put the file
+ vlp26.tgz
+in this directory.
Extract the files executing e.g
+ gunzip vlp26.tgz
+ tar -xvf vlp26.tar
First, you MUST edit the file "Dir" + and set the proper directories:
+QINC - directory where the QT library includes are stored, usually, /usr/lib/qt-1.45/include
+ QLIB - directory where you have your QT library, usually, /usr/lib/qt-1.45/lib
+ MOCDIR - QT library has a special compiler named "moc", write +the directory where this compiler is stored, usually, /usr/lib/qt-1.45/bin
+ INSTALLDIR - directory where the Virtual LOGLAN Processor will be + installed e.g.
+ /usr/local/vlp.
Next, run the following:
+ ./configure
+ to configure source files,
execute
+ make
+ to build VLP and
execute
+ make install
+ to install Virtual LOGLAN Processor.
Now you should configure your "vlp.cfg" file which is stored in the + instalation directory.
+Assure that the variable node_number has different value on each computer +you installed VLP.
+This is required to identify the nodes of virtual distributed Loglan +multiprocessor.
WARNING! Variable "homedir" should point to the directory where you + have program "logker" installed. This MUST be a full path !!!
+ something like
+ /usr/local/vlp
If everything went smoothly and your VLP works correctly you may wish +to delete the directory
+ /usr/local/vlp.build
+

+
+ + + diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..c726cd1 --- /dev/null +++ b/Makefile @@ -0,0 +1,74 @@ +### 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/* diff --git a/configure b/configure new file mode 100755 index 0000000..4dc55f9 --- /dev/null +++ b/configure @@ -0,0 +1,11 @@ +#!/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 diff --git a/doc/ansi.html b/doc/ansi.html new file mode 100644 index 0000000..a68f0e8 --- /dev/null +++ b/doc/ansi.html @@ -0,0 +1,24 @@ + + + + +Class ANSI
+Class ANSI implements simple operations in the text mode. +

unit GotoXY:procedure(x,y:integer)
+Moves the text cursor to the position (x,y) +
unit SetColor:procedure(color:integer)
+Sets the foreground color for text writing. +
unit SetBackground:procedure(color:integer)
+Sets the background color for text writing. +
unit Bold:procedure
+Sets the font to bold font. +
unit Normal:procedure
+Sets the font to normal font. +
unit Clear:procedure
+Clears terminal. +

+Return to Index + + diff --git a/doc/gui.html b/doc/gui.html new file mode 100644 index 0000000..b5b1da1 --- /dev/null +++ b/doc/gui.html @@ -0,0 +1,12 @@ + + + + class GUI - Graphic User Interface +

+ + + diff --git a/doc/gui1.html b/doc/gui1.html new file mode 100644 index 0000000..095b343 --- /dev/null +++ b/doc/gui1.html @@ -0,0 +1,92 @@ + + + +GUI procedures and functions

unit GUI_Clear:procedure;
+Clears the screen. +
+
unit GUI_ClearArea:procedure(x1,y1,w,h:integer);
+Clears a rectangular area.
+(x1,y1) - left corner of the rectangle
+w - rect width
+h - rect height
+
unit GUI_Point:procedure(x,y,col:integer);
+Draws a point at (x,y) with the color col.
+
unit GUI_Move:procedure(x,y:integer);
+Moves the graphic cursor to the position (x,y).
+
unit GUI_Line:procedure(x1,y1,x2,y2,col:integer); +Draws a line from (x1,y1) to (x2,y2) with the color col.
+
unit GUI_LineTo:procedure(x,y,col:integer); +Draws a line from actual position of the graphic cursor to the point +(x,y) with the color col.
+
unit GUI_Rect:procedure(x1,y1,x2,y2,fcol,icol:integer);
+Draws a rectangle.
+(x1,y1) - left corner
+(x2,y2) - right corner
+fcol - frame color
+icol - interior color
+
unit GUI_Ellipse:procedure(x,y,a,b,sa,ea,fcol,icol:integer);
+Draws an ellipse.
+(x,y) - center point
+a - horizontal radius
+b - vertical radius
+sa - start angle (in degrees)
+ea - end angle
+fcol - frame color
+icol - interior color
+
unit GUI_WriteInt:procedure(x,y,i,fcol,bcol:integer);
+Writes integer i at position (x,y).
+fcol - foreground color
+bcol - background color
+
unit GUI_WriteChar:procedure(x,y:integer;c:char;fcol,bcol:integer);
+Writes character c at position (x,y).
+fcol - foreground color
+bcol - background color
+
unit GUI_WriteReal:procedure(x,y:integer;r:real;fcol,bcol:integer);
+Writes real r at position (x,y).
+fcol - foreground color
+bcol - background color
+
unit GUI_WriteText:procedure(x,y:integer;t:array_of char;fcol,bcol:integer);
+Writes text t at position (x,y).
+fcol - foreground color
+bcol - background color
+
unit GUI_ReadText:function(x,y,fcol,bcol:integer):array_of char;
+Reads text at position (x,y).
+fcol - foreground color
+bcol - background color
+
unit GUI_ReadInt:function(x,y,fcol,bcol:integer):integer;
+Reads integer at position (x,y).
+fcol - foreground color
+bcol - background color
+
unit GUI_ReadChar:function(x,y,fcol,bcol:integer):char;
+Reads character at position (x,y).
+fcol - foreground color
+bcol - background color
+
unit GUI_ReadReal:function(x,y,fcol,bcol:integer):real;
+Reads real at position (x,y).
+fcol - foreground color
+bcol - background color
+
unit GUI_PutImgFile:procedure(x,y:integer;fname:string);
+Loads the image from file fname (it could be .BMP, .GIF, .XPM file) +and puts it at position (x,y).
+
unit GUI_GetImg:function(x,y,w,h:integer):array_of integer;
+Gets the contents of the screen from position (x,y) and stores them in the array.
+w - width of the image
+h - height of the image
+
unit GUI_PutImg:procedure(x,y:integer;map:array_of integer);
+Puts an image from map at the position (x,y).
+
unit GUI_KillImg:procedure(map:array_of integer);
+Destroys an image from map. (This is a proper procedure to delete +a map stored by GUI_GetImg!)
+
unit GUI_MousePressed:MOUSE procedure(INOUT x,y,btn:integer);
+Checks if the mouse button was pressed.
+(x,y) - mouse pointer position after press
+btn - number of the mouse button: 0 - none, 1 - left, 2 - middle, 3 - right
+
unit GUI_KeyPressed:function:integer;
+Checks if the key was pressed. Returns the same value as the inkey +procedure. +
+ Return to Index + + diff --git a/doc/gui2.html b/doc/gui2.html new file mode 100644 index 0000000..45f3b2b --- /dev/null +++ b/doc/gui2.html @@ -0,0 +1,22 @@ + + + + GUI constants and variables +
+Colors:
+
```
+ 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;
+
```
+ Variables: +
- cursor_x - X position of the graphic cursor +
- cursor_y - Y position of the graphic cursor +
+
+ Return to Index + + diff --git a/doc/iiuwgraph.html b/doc/iiuwgraph.html new file mode 100644 index 0000000..746cd8c --- /dev/null +++ b/doc/iiuwgraph.html @@ -0,0 +1,29 @@ + + + + + + +class IIUWGRAPH: +
- +inkey
+unit INKEY:function:integer; +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: +
```
+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
+
```
+ + + diff --git a/doc/index.html b/doc/index.html new file mode 100644 index 0000000..7ed99a7 --- /dev/null +++ b/doc/index.html @@ -0,0 +1,28 @@ + + + + + + +LOGLAN Help Index +
- +Virtual Processor User Guide
- +Language reference
- +class MACHINE
- +class ANSI
- +class IIUWGRAPH
- + class GUI +
+ + + diff --git a/doc/langg.html b/doc/langg.html new file mode 100644 index 0000000..3b7b3b7 --- /dev/null +++ b/doc/langg.html @@ -0,0 +1,13 @@ + + + + + + + +
Sorry, documentation and help are strictly under construction +!!! +
+
Return to Index + + diff --git a/doc/machine.html b/doc/machine.html new file mode 100644 index 0000000..4ebad20 --- /dev/null +++ b/doc/machine.html @@ -0,0 +1,37 @@ + + + + + Class MACHINE
+
+Class Machine is the set of functions designed to +give informations about Virtual LOGLAN Machine. +
- unit LocalNode:function:integer
  +Returns the ID of local Virtual Processor. +
- unit NodesNum:function:integer
  +Returns the number of Virtual Processors actually available +in the Machine.
  +Warning! The local VLP is not counted, so function returns +0 if there are no other Processors. +
- unit NodeExists:function(node:integer):boolean
  +Returns TRUE if the Virtual Processor with the ID equal to the +node is connected to the Machine. +
- unit MachineInfo:function:NodeInfo
  +This function returns full information about all connected Virtual +Processors. Information is given as a list of NodeInfo +structures.
  +The NodeInfo structure is defined in the class Machine +as follow: +
```
+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;
+
```
  +
+
+Return to Index + + diff --git a/doc/userg.html b/doc/userg.html new file mode 100644 index 0000000..3b7b3b7 --- /dev/null +++ b/doc/userg.html @@ -0,0 +1,13 @@ + + + + + + + +
Sorry, documentation and help are strictly under construction +!!! +
+
Return to Index + + diff --git a/edit/Makefile b/edit/Makefile new file mode 100644 index 0000000..bbc6227 --- /dev/null +++ b/edit/Makefile @@ -0,0 +1,66 @@ +### 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 diff --git a/edit/editor.cpp b/edit/editor.cpp new file mode 100644 index 0000000..f7ef820 --- /dev/null +++ b/edit/editor.cpp @@ -0,0 +1,596 @@ + + +#include
+#include
+#include
+#include
+#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#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;itext()); + e->getCursorPosition(&cx,&cy); + + txt.sprintf("UNIT %s : %s( );\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;linenumLines();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;linenumLines();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(); +} + diff --git a/edit/editor.h b/edit/editor.h new file mode 100644 index 0000000..beb90f8 --- /dev/null +++ b/edit/editor.h @@ -0,0 +1,99 @@ + +#ifndef QWERTY_H +#define QWERTY_H + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + + +#define COMP_MODE 1 +#define GEN_MODE 2 +#define ALL_MODE 3 + + + +typedef struct FuncEntry +{ + char name[255],filename[255]; +}; + +typedef struct CategoryEntry +{ + QList 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 diff --git a/edit/mfile b/edit/mfile new file mode 100644 index 0000000..5639ab2 --- /dev/null +++ b/edit/mfile @@ -0,0 +1,55 @@ +####### +####### 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 diff --git a/examp/BinA.log b/examp/BinA.log new file mode 100644 index 0000000..112a29b Binary files /dev/null and b/examp/BinA.log differ diff --git a/examp/ale.log b/examp/ale.log new file mode 100644 index 0000000..108695f Binary files /dev/null and b/examp/ale.log differ diff --git a/examp/anon.log b/examp/anon.log new file mode 100644 index 0000000..b885c1e Binary files /dev/null and b/examp/anon.log differ diff --git a/examp/ansitest.log b/examp/ansitest.log new file mode 100644 index 0000000..647cc8e Binary files /dev/null and b/examp/ansitest.log differ diff --git a/examp/arrnon.log b/examp/arrnon.log new file mode 100644 index 0000000..cd6b0ab Binary files /dev/null and b/examp/arrnon.log differ diff --git a/examp/asyg.log b/examp/asyg.log new file mode 100644 index 0000000..c0058c5 Binary files /dev/null and b/examp/asyg.log differ diff --git a/examp/azero.log b/examp/azero.log new file mode 100644 index 0000000..4e74fbe Binary files /dev/null and b/examp/azero.log differ diff --git a/examp/classes/ansi.inc b/examp/classes/ansi.inc new file mode 100644 index 0000000..7bd0cd3 Binary files /dev/null and b/examp/classes/ansi.inc differ diff --git a/examp/classes/gui.inc b/examp/classes/gui.inc new file mode 100644 index 0000000..f407596 Binary files /dev/null and b/examp/classes/gui.inc differ diff --git a/examp/classes/machine.inc b/examp/classes/machine.inc new file mode 100644 index 0000000..7c6e5a3 Binary files /dev/null and b/examp/classes/machine.inc differ diff --git a/examp/drugi.log b/examp/drugi.log new file mode 100644 index 0000000..327ace7 Binary files /dev/null and b/examp/drugi.log differ diff --git a/examp/first.log b/examp/first.log new file mode 100644 index 0000000..ee5a32f Binary files /dev/null and b/examp/first.log differ diff --git a/examp/five.log b/examp/five.log new file mode 100644 index 0000000..f7c3ce7 Binary files /dev/null and b/examp/five.log differ diff --git a/examp/geometria.log b/examp/geometria.log new file mode 100644 index 0000000..547792e --- /dev/null +++ b/examp/geometria.log @@ -0,0 +1,780 @@ + 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.x0 and jnone 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).yTab(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; + + + + \ No newline at end of file diff --git a/examp/graf.dta b/examp/graf.dta new file mode 100644 index 0000000..9152317 Binary files /dev/null and b/examp/graf.dta differ diff --git a/examp/graf.txt b/examp/graf.txt new file mode 100644 index 0000000..064058b --- /dev/null +++ b/examp/graf.txt @@ -0,0 +1,119 @@ + H E L P - D O C U M E N T A T I O N +( do programu GRAF.log kwiecien/maj 97) + + +CONTENTS + + 0. AIMS + 1. THE STATIC STRUCTURE OF THE PROGRAM + 2. DATA STRUCTURES + 2.1 LISTS + 2.2 QUEUES + 2.3 STACKS + 2.4 GRAPH + + 3. ALGORITHMES + 3.1 Search algorithmes + 3.2 + + + 4. MAIN PROCEDURES AND FUNCTIONS + 4.1 + 4.2 + + 5. MENU STRUCTURE + + 6. USER MANUAL + 6.1 System Configuration + 6.2 Files used by the program: + c:/loglan95/graf.txt + c:/loglan95/graf.dta + + + +AD.0 + + The aim of the program was to show the possibility to reuse + the procedure Traverse twice in two different environments: + Stacks and Queues. + + Traverse+Stacks => Depth First Search + Traverse+Queues => Breadth First Search + + The restriction imposed was: + TO NOT DUPLICATE THE TEXT OF TRAVERSE! + +AD.1 + + The static structure of the program: + + program GRAF; + begin pref mouse block + begin pref IIUWGRAPH block + (* DECLARATIONS*) + unit LISTE: class; end liste; + unit STRUCTURE: class ; end STRUCTURE; + unit QUEUES : STRUCTURE class; end QUEUES; + unit STACKS : STRUCTURE class; end STACKS; + unit BST : QUEUES procedure; end BST; + unit DFS : STQCKS procedure; end DFS; + unit GRAPH : class; + (* graph is represented as an + Array of LISTE *) + end GRAPH; + unit MENU : coroutine; end menu; + begin (* main program *) + (*CREATION of the menu-OPTIONS *) + attach(main_menu) + end + end + end GRAF; + + + AD 5. + + Type Menu is implemented as a coroutine which have as attributes + (a) the list of possible options and + (b) a sub_menu + This imply that the different menus form an arbre; + It is fixed, in this implementation, that the first option is always + a step to the previous menu. + Menu was generated in the main program; The structure of it is as follows: + + + main menu + + / ! + graph algorithms help + / / ! ) + clear import modify create next prev reset + / ! + file memory add_node add_arc del_arc save print getmap + + + + algorithmes + / ! + search path + + + 6 + AD 6.1 + + Before executing the program make sure that an appropriate + driver was selected. + In order to do so execute a batch file + exec + (Do not forget to leave Norton Commander!) + The ecran dimention is 640x480. + + The auxiliary files + graf.txt + graf.dta + graf1.dta etc + are supposed to be in c:/loglan95/ + This can be obiously changed bz programer (in the text of the program). + + The is supposed to be QWERTZ. + + \ No newline at end of file diff --git a/examp/graf1.dta b/examp/graf1.dta new file mode 100644 index 0000000..a477884 Binary files /dev/null and b/examp/graf1.dta differ diff --git a/examp/graf2.dta b/examp/graf2.dta new file mode 100644 index 0000000..ca7acc9 Binary files /dev/null and b/examp/graf2.dta differ diff --git a/examp/graf96.log b/examp/graf96.log new file mode 100644 index 0000000..286a13c --- /dev/null +++ b/examp/graf96.log @@ -0,0 +1,1995 @@ + +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:= (yyStrMinY+10 and xx<(MinX+574)); + more:= (yyStrMinY+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 ywrnY+15 and y0 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.xnone 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; + + + + + + + + (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*) + (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*) + \ No newline at end of file diff --git a/examp/guitest.log b/examp/guitest.log new file mode 100644 index 0000000..7e5aefc Binary files /dev/null and b/examp/guitest.log differ diff --git a/examp/illdet.log b/examp/illdet.log new file mode 100644 index 0000000..108695f Binary files /dev/null and b/examp/illdet.log differ diff --git a/examp/illkill.log b/examp/illkill.log new file mode 100644 index 0000000..8486909 Binary files /dev/null and b/examp/illkill.log differ diff --git a/examp/lift4.log b/examp/lift4.log new file mode 100644 index 0000000..693187c --- /dev/null +++ b/examp/lift4.log @@ -0,0 +1,892 @@ + + + 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=(zz; + 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; + + + \ No newline at end of file diff --git a/examp/lift5.log b/examp/lift5.log new file mode 100644 index 0000000..434644f --- /dev/null +++ b/examp/lift5.log @@ -0,0 +1,900 @@ + + + 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=(zz; + 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; + + + + + \ No newline at end of file diff --git a/examp/logo.bmp b/examp/logo.bmp new file mode 100644 index 0000000..9584118 Binary files /dev/null and b/examp/logo.bmp differ diff --git a/examp/mtest.log b/examp/mtest.log new file mode 100644 index 0000000..e84c53d --- /dev/null +++ b/examp/mtest.log @@ -0,0 +1,35 @@ +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. diff --git a/examp/piszczyt.log b/examp/piszczyt.log new file mode 100644 index 0000000..2457566 --- /dev/null +++ b/examp/piszczyt.log @@ -0,0 +1,431 @@ + + 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 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; + \ No newline at end of file diff --git a/examp/reftonone.log b/examp/reftonone.log new file mode 100644 index 0000000..ab57ac7 Binary files /dev/null and b/examp/reftonone.log differ diff --git a/examp/remote.log b/examp/remote.log new file mode 100644 index 0000000..ae54717 Binary files /dev/null and b/examp/remote.log differ diff --git a/examp/rozdzPun1.log b/examp/rozdzPun1.log new file mode 100644 index 0000000..014a80d --- /dev/null +++ b/examp/rozdzPun1.log @@ -0,0 +1,840 @@ + 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.x0 and jnone 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; + + + + \ No newline at end of file diff --git a/examp/spooler.log b/examp/spooler.log new file mode 100644 index 0000000..86a0b96 Binary files /dev/null and b/examp/spooler.log differ diff --git a/examp/taktto1.log b/examp/taktto1.log new file mode 100644 index 0000000..bfed293 Binary files /dev/null and b/examp/taktto1.log differ diff --git a/examp/teststring.log b/examp/teststring.log new file mode 100644 index 0000000..269e46a Binary files /dev/null and b/examp/teststring.log differ diff --git a/examp/trzeci.log b/examp/trzeci.log new file mode 100644 index 0000000..c91878d Binary files /dev/null and b/examp/trzeci.log differ diff --git a/graph/Makefile b/graph/Makefile new file mode 100644 index 0000000..1d8b044 --- /dev/null +++ b/graph/Makefile @@ -0,0 +1,59 @@ +### 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 + + diff --git a/graph/loggraph.cpp b/graph/loggraph.cpp new file mode 100644 index 0000000..438a369 --- /dev/null +++ b/graph/loggraph.cpp @@ -0,0 +1,1176 @@ +// +// Qt Example Application: drawdemo +// +// Demonstrates the painter and the printer. +// + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include "../head/genint1.h" +#include "../head/comm.h" +#include "socu.h" +#include +#include +#include +#include +#include +#include +#include +#include +#include + + + +#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 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 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(); +} diff --git a/graph/mfile b/graph/mfile new file mode 100644 index 0000000..4eb710d --- /dev/null +++ b/graph/mfile @@ -0,0 +1,48 @@ + +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 + + diff --git a/graph/socu.h b/graph/socu.h new file mode 100644 index 0000000..0ed2797 --- /dev/null +++ b/graph/socu.h @@ -0,0 +1,4 @@ +#include +#include +#include +#include diff --git a/head/comm.h b/head/comm.h new file mode 100644 index 0000000..44cb6be --- /dev/null +++ b/head/comm.h @@ -0,0 +1,248 @@ +/* Communication structures */ + + +// REDHAT DEPENDENT !!! +#include + +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); + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/head/genint1.h b/head/genint1.h new file mode 100644 index 0000000..66890fb --- /dev/null +++ b/head/genint1.h @@ -0,0 +1,177 @@ +/* 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; + + diff --git a/help/Makefile b/help/Makefile new file mode 100644 index 0000000..fa6c8ea --- /dev/null +++ b/help/Makefile @@ -0,0 +1,59 @@ +### 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. diff --git a/help/help.cpp b/help/help.cpp new file mode 100644 index 0000000..1b3cb3c --- /dev/null +++ b/help/help.cpp @@ -0,0 +1,567 @@ + + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + + +#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 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(); +} diff --git a/help/mfile b/help/mfile new file mode 100644 index 0000000..afe9e72 --- /dev/null +++ b/help/mfile @@ -0,0 +1,48 @@ + +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. diff --git a/inst/INSTALL b/inst/INSTALL new file mode 100644 index 0000000..b24fd50 --- /dev/null +++ b/inst/INSTALL @@ -0,0 +1,10 @@ +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 diff --git a/inst/LICENSE.GNU b/inst/LICENSE.GNU new file mode 100644 index 0000000..01d5a2d --- /dev/null +++ b/inst/LICENSE.GNU @@ -0,0 +1,347 @@ +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. +------------------------------------------------------------------------ diff --git a/inst/LICENSE.QT b/inst/LICENSE.QT new file mode 100644 index 0000000..9d9a0f3 --- /dev/null +++ b/inst/LICENSE.QT @@ -0,0 +1,70 @@ + 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. diff --git a/inst/close.bmp b/inst/close.bmp new file mode 100644 index 0000000..4c8c544 Binary files /dev/null and b/inst/close.bmp differ diff --git a/inst/gen b/inst/gen new file mode 100755 index 0000000..c732501 Binary files /dev/null and b/inst/gen differ diff --git a/inst/loglan b/inst/loglan new file mode 100755 index 0000000..c8c63ba Binary files /dev/null and b/inst/loglan differ diff --git a/inst/logo.bmp b/inst/logo.bmp new file mode 100644 index 0000000..9584118 Binary files /dev/null and b/inst/logo.bmp differ diff --git a/installQT.html b/installQT.html new file mode 100644 index 0000000..dcfab35 --- /dev/null +++ b/installQT.html @@ -0,0 +1,47 @@ + + + + Installation of OLD qt-1.45 library + + + + +
Installation of old library qt1.45
+ 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.
+ It is relatively easy to install the library by yourself. +
+
+
Take the following files:
+ +
+
compat-libstdc++ ....rpm
+
qt1x-1.45-16.i386.rpm
+
qt1x-1.45-devel-16.i386.rpm
+ +
+ or similar versions, they may differ as indicated by the number +16, 17, ...
+
+
install them in this order :
+ +
+
rpm -Uvh compat-libstdc++-6.2-2.9.0.16.i386.rpm
+
rpm -Uvh qt1x-1.45-16.i386.rpm
+
rpm -Uvh qt1x-devel-1.45-16.i386.rpm
+ +
+ Do not worry if a message of eventual conflicts appear.
+
+
The library qt1.45 is installed in the following directory /usr/lib/qt-1.45
+
+ +
+Now you are ready to install VLP 2.6 - Virtual Loglan Processor version of +1996.
+
+
+ + + diff --git a/int/Makefile b/int/Makefile new file mode 100644 index 0000000..703d0e3 --- /dev/null +++ b/int/Makefile @@ -0,0 +1,69 @@ +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 diff --git a/int/cint.c b/int/cint.c new file mode 100644 index 0000000..b81996c --- /dev/null +++ b/int/cint.c @@ -0,0 +1,689 @@ + + +#include "depend.h" +#include "genint.h" +#include "int.h" +#include "process.h" +#include "intproto.h" +#include "socu.h" +#include +#include +#include +#include +#include +#include +#include + + +#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 (maxDirSet0) + { + 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 */ + diff --git a/int/compact.c b/int/compact.c new file mode 100644 index 0000000..9ebf56e --- /dev/null +++ b/int/compact.c @@ -0,0 +1,763 @@ +/* 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 + + +#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 */ + 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 */ + 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 */ + + diff --git a/int/control.c b/int/control.c new file mode 100644 index 0000000..314fcce --- /dev/null +++ b/int/control.c @@ -0,0 +1,421 @@ +/* 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; +} + + diff --git a/int/depend.h b/int/depend.h new file mode 100644 index 0000000..e6a7b72 --- /dev/null +++ b/int/depend.h @@ -0,0 +1,173 @@ +/* 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 +#include +#include +#include +#include + + +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 + +#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 + + diff --git a/int/eventque.h b/int/eventque.h new file mode 100644 index 0000000..517d2c1 --- /dev/null +++ b/int/eventque.h @@ -0,0 +1,144 @@ +/** + ** 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 */ + + diff --git a/int/execute.c b/int/execute.c new file mode 100644 index 0000000..f1fe9e9 --- /dev/null +++ b/int/execute.c @@ -0,0 +1,611 @@ +/* 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 + + +/* 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; + } +} + + diff --git a/int/fileio.c b/int/fileio.c new file mode 100644 index 0000000..f809124 --- /dev/null +++ b/int/fileio.c @@ -0,0 +1,356 @@ +/* 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 + +/* 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 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 */ + diff --git a/int/genint.h b/int/genint.h new file mode 100644 index 0000000..fc3fd93 --- /dev/null +++ b/int/genint.h @@ -0,0 +1,47 @@ +/* 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 */ + diff --git a/int/genint1.h b/int/genint1.h new file mode 100644 index 0000000..97396c9 --- /dev/null +++ b/int/genint1.h @@ -0,0 +1,169 @@ +/* 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; + + diff --git a/int/handler.c b/int/handler.c new file mode 100644 index 0000000..7b17627 --- /dev/null +++ b/int/handler.c @@ -0,0 +1,225 @@ +#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 */ diff --git a/int/int.h b/int/int.h new file mode 100644 index 0000000..3dee15f --- /dev/null +++ b/int/int.h @@ -0,0 +1,182 @@ +#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]; diff --git a/int/intdt.c b/int/intdt.c new file mode 100644 index 0000000..86470b2 --- /dev/null +++ b/int/intdt.c @@ -0,0 +1,96 @@ +#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 */ diff --git a/int/intproto.h b/int/intproto.h new file mode 100644 index 0000000..0886780 --- /dev/null +++ b/int/intproto.h @@ -0,0 +1,206 @@ +#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 + diff --git a/int/memory.c b/int/memory.c new file mode 100644 index 0000000..b25e76b --- /dev/null +++ b/int/memory.c @@ -0,0 +1,225 @@ +#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 */ diff --git a/int/nonstand.c b/int/nonstand.c new file mode 100644 index 0000000..37fee55 --- /dev/null +++ b/int/nonstand.c @@ -0,0 +1,456 @@ +#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 ((scappetite, &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 */ diff --git a/int/procaddr.c b/int/procaddr.c new file mode 100644 index 0000000..ab020da --- /dev/null +++ b/int/procaddr.c @@ -0,0 +1,212 @@ +#include "depend.h" +#include "genint.h" +#include "int.h" +#include "process.h" +#include "intproto.h" + +#include + +#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; ihash_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; ihash_size; i++ ) thisp->hash[i]=0; + for( i=0; iaddr ); + 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 ) ); +} + diff --git a/int/process.c b/int/process.c new file mode 100644 index 0000000..2ff8706 --- /dev/null +++ b/int/process.c @@ -0,0 +1,652 @@ +#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 + + +/* 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 +# 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 +} +*/ + diff --git a/int/process.h b/int/process.h new file mode 100644 index 0000000..79435a0 --- /dev/null +++ b/int/process.h @@ -0,0 +1,131 @@ +#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 + diff --git a/int/queue.c b/int/queue.c new file mode 100644 index 0000000..35ae2fd --- /dev/null +++ b/int/queue.c @@ -0,0 +1,112 @@ +#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 */ diff --git a/int/queue.h b/int/queue.h new file mode 100644 index 0000000..7682c00 --- /dev/null +++ b/int/queue.h @@ -0,0 +1,40 @@ +/* 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)) diff --git a/int/rpcall.c b/int/rpcall.c new file mode 100644 index 0000000..2fd562c --- /dev/null +++ b/int/rpcall.c @@ -0,0 +1,265 @@ +#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); +} + + diff --git a/int/runsys.c b/int/runsys.c new file mode 100644 index 0000000..d4047fb --- /dev/null +++ b/int/runsys.c @@ -0,0 +1,297 @@ + /* 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); +} + + diff --git a/int/socu.h b/int/socu.h new file mode 100644 index 0000000..0ed2797 --- /dev/null +++ b/int/socu.h @@ -0,0 +1,4 @@ +#include +#include +#include +#include diff --git a/int/standard.c b/int/standard.c new file mode 100644 index 0000000..74a67d7 --- /dev/null +++ b/int/standard.c @@ -0,0 +1,459 @@ + /* 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 +#include + +/* 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); +} + + diff --git a/int/typchk.c b/int/typchk.c new file mode 100644 index 0000000..fac9ff8 --- /dev/null +++ b/int/typchk.c @@ -0,0 +1,383 @@ + /* 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); + } + } + } + } +} + diff --git a/int/util.c b/int/util.c new file mode 100644 index 0000000..39b4087 --- /dev/null +++ b/int/util.c @@ -0,0 +1,176 @@ + /* 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 + +/* 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; + } +} + + **************************************************************/ + diff --git a/kernel/Makefile b/kernel/Makefile new file mode 100644 index 0000000..fddca61 --- /dev/null +++ b/kernel/Makefile @@ -0,0 +1,59 @@ +### 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 + + diff --git a/kernel/kernel.cpp b/kernel/kernel.cpp new file mode 100644 index 0000000..a1ebed7 --- /dev/null +++ b/kernel/kernel.cpp @@ -0,0 +1,1306 @@ +/************************************************************** + + 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 +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include +#include +#include +#include + +#include "../head/genint1.h" +#include "../head/comm.h" +#include "socu.h" +#include + +#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 Interpreters; + QList 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;icount();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;iRInstances[i]=-1; + + strcpy(b,rindex(ss,'/')); + for(i=0;iID = 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;iRInstances[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;isetStyle(WindowsStyle); + QKernel draw; + app->setMainWidget( &draw); + draw.show(); + draw.InitMessage(); + return app->exec(); +} diff --git a/kernel/mfile b/kernel/mfile new file mode 100644 index 0000000..8ad1f7f --- /dev/null +++ b/kernel/mfile @@ -0,0 +1,48 @@ + +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 + + diff --git a/kernel/socu.h b/kernel/socu.h new file mode 100644 index 0000000..0ed2797 --- /dev/null +++ b/kernel/socu.h @@ -0,0 +1,4 @@ +#include +#include +#include +#include diff --git a/lgconfig/Makefile b/lgconfig/Makefile new file mode 100644 index 0000000..7e43db5 --- /dev/null +++ b/lgconfig/Makefile @@ -0,0 +1,60 @@ +### 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. diff --git a/lgconfig/lgconfig.cpp b/lgconfig/lgconfig.cpp new file mode 100644 index 0000000..5f75fa7 --- /dev/null +++ b/lgconfig/lgconfig.cpp @@ -0,0 +1,323 @@ + + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + + +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 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;iaddr); + 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(); +} diff --git a/lgconfig/mfile b/lgconfig/mfile new file mode 100644 index 0000000..d6289a9 --- /dev/null +++ b/lgconfig/mfile @@ -0,0 +1,49 @@ +##### 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. diff --git a/mfile b/mfile new file mode 100644 index 0000000..78f3990 --- /dev/null +++ b/mfile @@ -0,0 +1,63 @@ + + +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/* diff --git a/net/Makefile b/net/Makefile new file mode 100644 index 0000000..5c27ece --- /dev/null +++ b/net/Makefile @@ -0,0 +1,60 @@ +### 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. diff --git a/net/lognet.cpp b/net/lognet.cpp new file mode 100644 index 0000000..2fd8348 --- /dev/null +++ b/net/lognet.cpp @@ -0,0 +1,1013 @@ +#include "../head/genint1.h" +#include "../head/comm.h" + +#include +#include +#include +#include +#include +#include + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#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 Interpreters; // List of the Interpeter slots + QList 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 (nrsetsock) 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 (szCodeSize) + { + 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 (szCodeSize) + { + 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 (maxsock) 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;i0) + { + 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;i0) + { + 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; +} diff --git a/net/mfile b/net/mfile new file mode 100644 index 0000000..715aa6d --- /dev/null +++ b/net/mfile @@ -0,0 +1,49 @@ + +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. diff --git a/net/soct.h b/net/soct.h new file mode 100644 index 0000000..21bd3a1 --- /dev/null +++ b/net/soct.h @@ -0,0 +1,6 @@ +#include +#include +#include +#include +#include +#include diff --git a/net/socu.h b/net/socu.h new file mode 100644 index 0000000..0ed2797 --- /dev/null +++ b/net/socu.h @@ -0,0 +1,4 @@ +#include +#include +#include +#include diff --git a/preproc/Makefile b/preproc/Makefile new file mode 100644 index 0000000..bd5621b --- /dev/null +++ b/preproc/Makefile @@ -0,0 +1,59 @@ +### 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. diff --git a/preproc/mfile b/preproc/mfile new file mode 100644 index 0000000..c8bc68c --- /dev/null +++ b/preproc/mfile @@ -0,0 +1,48 @@ + +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. diff --git a/preproc/prep.cpp b/preproc/prep.cpp new file mode 100644 index 0000000..c362103 --- /dev/null +++ b/preproc/prep.cpp @@ -0,0 +1,235 @@ + +#include +#include +#include +#include +#include +#include +#include +#include +#include + +class IncFile +{ +public: + char filename[255]; + int start, len; + IncFile(char *s,int st) {strcpy(filename,s);start=st;len=0;}; +}; + +QList inc; + +IncFile *findTrueLine(int ln, int *trueline) +{ + IncFile *pom,*pom1; + QList 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 (lnstart+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<len++; + currentline++; + } + pomf.close(); + inc.append(p); + } + } + else + { + comps< %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); +}

Installing VLP - Virtual Loglan Processor +

Pre-requisite:

Installation:

Installation of old library qt1.45

Installing VLP - Virtual Loglan Processor
+