Thread View: comp.lang.modula2
1 messages
1 total messages
Started by wyle Mitchell Wyle
Tue, 26 Jan 1988 10:54
brain 2 of 3
Author: wyle Mitchell Wyle
Date: Tue, 26 Jan 1988 10:54
Date: Tue, 26 Jan 1988 10:54
870 lines
51986 bytes
51986 bytes
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create:
# BrainStruct.mod
# BrainStruct.def
# BrainErrors.mod
# This archive created: Tue Aug 4 07:16:13 1987
export PATH; PATH=/bin:/usr/bin:$PATH
if test -f 'BrainStruct.mod'
then
echo shar: "will not over-write existing file 'BrainStruct.mod'"
else
cat << \SHAR_EOF > 'BrainStruct.mod'
(***************************************************************************************)
(* *)
IMPLEMENTATION MODULE BrainStruct;
(* *)
(* PROJECT : Neuron Model *)
(* PURPOSE : Base of a future IR-System *)
(* AUTHOR : D. Stieger IIIc/8 (Semesterarbeit) *)
(* DATE : 27.5.1987 *)
(* ASSISTANT : M. Wyle / Prof. Frei *)
(* RELEASE : 1.1 *)
(* *)
(* UPDATES : none *)
(* *)
(***************************************************************************************)
FROM SYSTEM IMPORT TSIZE; (* calculate size of a type *)
FROM Storage IMPORT ALLOCATE, DEALLOCATE; (* memory handling *)
FROM BrainErrors IMPORT Error, Errors, (* Error - handling *)
Warning, Prompt;
FROM BrainDefinitions IMPORT lowPotential, highPotential, Diff, maxCard;
(* ------------------------------ D E F I N I T I O N S ------------------------------
TYPE ObjectType = (system,global,local,connect); (* available object-types *)
IOTypes = (in, out, normal); (* I/O functions of cell *)
TeachTypes = (Active, Passive, Teacher); (* system behaviour *)
IORegister = ARRAY [0..1] OF INTEGER; (* I/O alternating register *)
ObjectPtr = POINTER TO Object; (* obejcts like system, cells ... *)
Object = RECORD
CASE ObjectId : ObjectType OF
(* S Y S T E M *)
system : SystemName : CARDINAL; (* INDEX *)
SubSystem : ObjectPtr; (* pointer to sub-system *)
UpSystem : ObjectPtr; (* pointer to upper syst.*)
NextSystem : ObjectPtr; (* pointer to neighbour *)
Teacher : TeachTypes; (* behaviour of system *)
Cells, I, O : ObjectPtr; (* pointer to cells *)
CellTypes : ObjectPtr; (* pointer to celltypes *)
TeachLink : ObjectPtr| (* link same properties *)
(* C E L L - T Y P E S *)
global : CellName : CARDINAL; (* INDEX *)
FirePotential : INTEGER; (* global FirePotential *)
Threshold : INTEGER; (* global Threshold *)
SpActivity : CARDINAL; (* spontaneous activity *)
Analog : BOOLEAN; (* analogous output *)
NextType : ObjectPtr; (* pointer to next type *)
Repolarization: CARDINAL | (* repol at each tick *)
(* C E L L S *)
local : Syst : ObjectPtr; (* embedding system *)
Sensitivity : CARDINAL; (* sensitivity in %. *)
Potential : IORegister; (* actual potential *)
ThresholdLoc : INTEGER; (* local threshold *)
IOTyp : IOType; (* I/O - function of cell*)
Type : ObjectPtr; (* type of cell *)
Connection : ObjectPtr; (* pointer to connections*)
NextCell : ObjectPtr| (* pointer to nect cell *)
(*******************************************************)
(* for local dummy-cells only 'NextCell' is defined *)
(* and 'Type' is then NIL *)
(*******************************************************)
(* C O N N E C T I O N S *)
connect: ConnectCell : ObjectPtr; (* connected cell *)
NextConnection: ObjectPtr; (* pointer to next conn. *)
LastConnection: ObjectPtr; (* pointer to last conn. *)
Transmission; : INTEGER (* transmission [%.] *)
SourceCell : ObjectPtr; (* source cell (speed up)*)
Relevancy : CARDINAL (* 0 .. maxCard *)
(* 0 ~ not relevant *)
END (* CASE *)
END; (* RECORD *)
----------------------------------------------------------------------------------- *)
CONST noName = 0; (* unnamed object *)
(* ------------------------------ P R O C E D U R E S -------------------------------- *)
PROCEDURE InitSystem (name: CARDINAL; teachType : TeachTypes);
VAR newObj : ObjectPtr; (* new system *)
BEGIN
ALLOCATE (newObj, TSIZE (Object)); (* reserve memory space *)
WITH newObj^ DO (* initialize new object *)
ObjectId := system; (* declare object as system *)
SystemName := name; (* set name of system *)
SubSystem := NIL; (* no subsystems yet *)
NextSystem := NIL; (* no right neighbour yet *)
UpSystem := LastSystem; (* store pointer to upper system *)
Teacher := teachType; (* store system behaviour *)
Cells := NIL; (* no cells in that system yet *)
I := NIL; (* no input cells yet *)
O := NIL; (* no output cells yet *)
CellTypes := NIL (* no cell type yet *)
END; (* WITH *)
IF newObj^.Teacher = Active THEN (* link teaching - lists *)
newObj^.TeachLink := FirstActive;
FirstActive := newObj
ELSIF newObj^.Teacher = Teacher THEN
newObj^.TeachLink := FirstTeacher;
FirstTeacher := newObj
END;
IF FirstSystem = NIL THEN (* insert first system *)
FirstSystem := newObj; LastSystem := FirstSystem
ELSE
IF LastSystem^.SubSystem = NIL THEN (* open first subsystem *)
LastSystem^.SubSystem := newObj; (* append to last system *)
LastSystem := LastSystem^.SubSystem
ELSE
LastSystem := LastSystem^.SubSystem;
IF Diff (LastSystem^.SystemName, name) = 0 THEN Error (2) END;
WHILE LastSystem^.NextSystem <> NIL DO
LastSystem := LastSystem^.NextSystem;
IF Diff (LastSystem^.SystemName, name) = 0 THEN Error (2) END
END; (* WHILE *)
LastSystem^.NextSystem := newObj; (* append to last system *)
LastSystem := LastSystem^.NextSystem
END
END
END InitSystem;
PROCEDURE DefineCell (name : CARDINAL; (* specify new cell type for system *)
potential : INTEGER; (* global FirePotential *)
Thresh : INTEGER; (* global Threshold *)
Spontan : CARDINAL; (* spontaneous activity *)
Analogous : BOOLEAN; (* analogous output *)
Repol : CARDINAL); (* repolarization at each tick [%.] *)
VAR newCell : ObjectPtr; (* new cell *)
local : ObjectPtr; (* local pointer for cell-check *)
BEGIN
ALLOCATE (newCell, TSIZE (Object)); (* reserve memory space *)
WITH newCell^ DO
ObjectId := global; (* define object as global cell *)
CellName := name; (* store cell - name *)
FirePotential := potential; (* store potential *)
Threshold := Thresh; (* store threshold *)
SpActivity := Spontan; (* store spontaneous activity 0..100 *)
Analog := Analogous; (* store flag TRUE/FALSE *)
NextType := NIL; (* last type for that moment *)
Repolarization := Repol (* repolarization at each tick *)
END; (* WITH *)
IF (Spontan < 0) OR (Spontan > 1000) THEN Error (3) END;
IF (FirstSystem<>NIL) AND (LastSystem<>NIL) THEN(* insert cell into system *)
IF LastSystem^.CellTypes = NIL THEN (* first cell - type of system *)
LastSystem^.CellTypes := newCell (* append it at 1st position *)
ELSE (* insert next cell type *)
local := LastSystem^.CellTypes;
IF Diff (local^.CellName, name) = 0 THEN Error (2) END;
WHILE local^.NextType <> NIL DO
local := local^.NextType;
IF Diff (local^.CellName, name) = 0 THEN Error (2) END
END;
local^.NextType := newCell (* append it at last position *)
END
ELSE Error (1) END (* system not yet initialized *)
END DefineCell;
PROCEDURE CreateCell (Nr : CARDINAL; (* CellNumber *)
IOType : IOTypes; (* in, out, normal *)
CellType : CARDINAL); (* INDEX to cell-name *)
VAR newCell : ObjectPtr; (* new cell *)
localC : ObjectPtr; (* local pointer for cell-check *)
newLocal : ObjectPtr; (* local sub-cells *)
counter : CARDINAL; (* cell counter (identifies Nr) *)
i : CARDINAL; (* local counter *)
globalC : ObjectPtr; (* pointer to global cell *)
typeFound : BOOLEAN; (* flag if requested type exists *)
UpSystem : ObjectPtr; (* searchpath for upper declarations *)
BEGIN
ALLOCATE (newCell, TSIZE (Object)); (* reserve memort space *)
WITH newCell^ DO
ObjectId := local; (* define object as local cell *)
Syst := LastSystem; (* store pointer to embedding system *)
Sensitivity := 1000; (* default sensitivity = 1000 %. *)
Potential [0]:= lowPotential; (* no potential *)
Potential [1]:= lowPotential; (* no potential *)
Connection := NIL; (* still no connections *)
NextCell := NIL; (* supposed to be last cell *)
IOTyp := IOType;
Type := newCell (* points to itself, mark that init *)
END; (* WITH *)
IF (FirstSystem<>NIL) AND (LastSystem<>NIL) THEN(* insert cell into system *)
CASE IOType OF
in : IF LastSystem^.I = NIL THEN (* no cells of that type in system *)
FOR i := 1 TO Nr-1 DO (* insert n-1 dummy-cells *)
ALLOCATE (newLocal, TSIZE (Object));
newLocal^.ObjectId := local; (* define object as a local cell *)
newLocal^.Type := NIL; (* new cell has no specified type *)
IF LastSystem^.I = NIL THEN LastSystem^.I := newLocal
ELSE localC^.NextCell := newLocal END;
localC := newLocal
END; (* FOR *)
IF Nr > 1 THEN localC^.NextCell := newCell
ELSE LastSystem^.I := newCell
END
ELSE (* insert next cell in system *)
localC := LastSystem^.I; counter := 1;
WHILE (counter<Nr) AND (localC^.NextCell<>NIL) DO
INC (counter); localC := localC^.NextCell
END;
IF counter < Nr THEN (* nor enough cells in system *)
FOR i := counter TO Nr-2 DO (* insert missing dummy-cells *)
ALLOCATE (newLocal, TSIZE (Object));
newLocal^.ObjectId := local; (* define object as a local cell *)
newLocal^.Type := NIL; (* new cell has no specified type *)
localC^.NextCell := newLocal;
localC := newLocal
END; (* FOR *)
localC^.NextCell := newCell
ELSE (* redefine dummy - cell *)
newCell^.NextCell := localC^.NextCell;
IF localC^.Type <> NIL THEN Error (4) END;
localC^ := newCell^;
DEALLOCATE (newCell, TSIZE (Object)); newCell := localC
END
END
| out : IF LastSystem^.O = NIL THEN (* no cells of that type in system *)
FOR i := 1 TO Nr-1 DO (* insert n-1 dummy-cells *)
ALLOCATE (newLocal, TSIZE (Object));
newLocal^.ObjectId := local; (* define object as a local cell *)
newLocal^.Type := NIL; (* new cell has no specified type *)
IF LastSystem^.O = NIL THEN LastSystem^.O := newLocal
ELSE localC^.NextCell := newLocal END;
localC := newLocal
END; (* FOR *)
IF Nr > 1 THEN localC^.NextCell := newCell
ELSE LastSystem^.O := newCell
END
ELSE (* insert next cell in system *)
localC := LastSystem^.O; counter := 1;
WHILE (counter<Nr) AND (localC^.NextCell<>NIL) DO
INC (counter); localC := localC^.NextCell
END;
IF counter < Nr THEN (* nor enough cells in system *)
FOR i := counter TO Nr-2 DO (* insert missing dummy-cells *)
ALLOCATE (newLocal, TSIZE (Object));
newLocal^.ObjectId := local; (* define object as a local cell *)
newLocal^.Type := NIL; (* new cell has no specified type *)
localC^.NextCell := newLocal;
localC := newLocal
END; (* FOR *)
localC^.NextCell := newCell
ELSE (* redefine dummy - cell *)
newCell^.NextCell := localC^.NextCell;
IF localC^.Type <> NIL THEN Error (4) END;
localC^ := newCell^;
DEALLOCATE (newCell, TSIZE (Object)); newCell := localC
END
END
| normal : IF LastSystem^.Cells = NIL THEN (* no cells of that type in system *)
FOR i := 1 TO Nr-1 DO (* insert n-1 dummy-cells *)
ALLOCATE (newLocal, TSIZE (Object));
newLocal^.ObjectId := local; (* define object as a local cell *)
newLocal^.Type := NIL; (* new cell has no specified type *)
IF LastSystem^.Cells = NIL THEN LastSystem^.Cells:= newLocal
ELSE localC^.NextCell := newLocal END;
localC := newLocal
END; (* FOR *)
IF Nr > 1 THEN localC^.NextCell := newCell
ELSE LastSystem^.Cells := newCell
END
ELSE (* insert next cell in system *)
localC := LastSystem^.Cells; counter := 1;
WHILE (counter<Nr) AND (localC^.NextCell<>NIL) DO
INC (counter); localC := localC^.NextCell
END;
IF counter < Nr THEN (* nor enough cells in system *)
FOR i := counter TO Nr-2 DO (* insert missing dummy-cells *)
ALLOCATE (newLocal, TSIZE (Object));
newLocal^.ObjectId := local; (* define object as a local cell *)
newLocal^.Type := NIL; (* new cell has no specified type *)
localC^.NextCell := newLocal;
localC := newLocal
END; (* FOR *)
localC^.NextCell := newCell
ELSE (* redefine dummy - cell *)
newCell^.NextCell := localC^.NextCell;
IF localC^.Type <> NIL THEN Error (4) END;
localC^ := newCell^;
DEALLOCATE (newCell, TSIZE (Object)); newCell := localC
END
END
END; (* CASE *)
(* Actual cell = 'newCell' *)
(* Search CellType for this Cell and create link *)
UpSystem := LastSystem;
typeFound := FALSE; (* type not yet found *)
WHILE (UpSystem<>NIL) AND NOT typeFound DO
globalC := UpSystem^.CellTypes; (* get first cell type *)
WHILE (globalC<>NIL) AND NOT typeFound DO
IF Diff (globalC^.CellName,CellType) = 0 THEN typeFound := TRUE
ELSE globalC := globalC^.NextType
END
END; (* WHILE *)
IF NOT typeFound THEN UpSystem := UpSystem^.UpSystem END
END; (* WHILE *)
IF typeFound THEN newCell^.ThresholdLoc := globalC^.Threshold;
newCell^.Type := globalC
ELSE Error (5) (* type not found error *)
END
ELSE Error (1) END (* system not yet initialized *)
END CreateCell;
PROCEDURE ConnectCell (From : CARDINAL; FromType : IOTypes;
To : CARDINAL; ToType : IOTypes;
Transmission : INTEGER);
VAR newConn : ObjectPtr; (* new connection *)
from, to : ObjectPtr; (* pointer to cells *)
PROCEDURE Search (Cell : ObjectPtr; Nr : CARDINAL):ObjectPtr;
VAR actualCell : CARDINAL; (* pointer to actual cell *)
BEGIN
actualCell := 1;
WHILE (actualCell < Nr) AND (Cell <> NIL) DO
INC (actualCell); Cell := Cell^.NextCell
END;
IF actualCell = Nr THEN RETURN Cell ELSE RETURN NIL END
END Search;
BEGIN
IF (FirstSystem<>NIL) AND (LastSystem<>NIL) THEN
ALLOCATE (newConn, TSIZE (Object)); (* reserve memory space *)
newConn^.ObjectId := connect; (* identify object as connection *)
newConn^.Relevancy := maxCard; (* connection has maximal relevancy *)
IF FromType = in THEN from := Search (LastSystem^.I , From)
ELSIF FromType = out THEN from := Search (LastSystem^.O , From)
ELSE from := Search (LastSystem^.Cells, From) END;
IF ToType = in THEN to := Search (LastSystem^.I , To )
ELSIF ToType = out THEN to := Search (LastSystem^.O , To )
ELSE to := Search (LastSystem^.Cells, To ) END;
newConn^.Transmission := Transmission; (* Store actual transmission *)
newConn^.ConnectCell := to;
newConn^.SourceCell := from;
newConn^.LastConnection := NIL;
IF from = NIL THEN Error (6) END; (* source cell does not exist *)
IF to = NIL THEN Error (7) END; (* destination cell does not exist *)
IF (from<>NIL) AND (to<>NIL) THEN (* make connection *)
IF (from^.Type = NIL) OR (to^.Type = NIL) THEN
IF (from^.Type = NIL) THEN Error (6) END;
IF (to^.Type = NIL) THEN Error (7) END;
DEALLOCATE (newConn, TSIZE (Object)) (* release reserved memory space *)
ELSE
IF from^.Connection <> NIL THEN from^.Connection^.LastConnection := newConn END;
newConn^.NextConnection := from^.Connection;
from^.Connection := newConn
END
ELSE DEALLOCATE (newConn, TSIZE (Object)) END (* release reserved memory space *)
ELSE Error (1) END (* system not yet initialized *)
END ConnectCell;
PROCEDURE CreateDirect (VAR cell : ObjectPtr; last, type, syst : ObjectPtr);
BEGIN
IF last^.NextCell <> NIL THEN HALT END;
ALLOCATE (cell, TSIZE (Object)); (* reserve memort space *)
WITH cell^ DO
ObjectId := local; (* define object as local cell *)
Syst := syst; (* store pointer to embedding system *)
Sensitivity := 1000; (* default sensitivity = 1000 %. *)
Potential [0]:= lowPotential; (* no potential *)
Potential [1]:= lowPotential; (* no potential *)
ThresholdLoc := type^.Threshold; (* default threshold *)
Connection := NIL; (* still no connections *)
NextCell := NIL; (* supposed to be last cell *)
IOTyp := last^.IOTyp;
Type := type (* points to itself, mark that init *)
END; (* WITH *)
last^.NextCell := cell
END CreateDirect;
PROCEDURE ConnectDirect (cell1,cell2 : ObjectPtr; Transmission : INTEGER);
VAR newConn : ObjectPtr;
BEGIN
ALLOCATE (newConn, TSIZE (Object)); (* reserve memory space *)
newConn^.ObjectId := connect; (* identify object as connection *)
newConn^.Relevancy := maxCard; (* connection has maximal relevancy *)
newConn^.SourceCell := cell1;
newConn^.ConnectCell := cell2;
newConn^.Transmission := Transmission;
newConn^.LastConnection := NIL;
IF cell1^.Connection <> NIL THEN cell1^.Connection^.LastConnection := newConn END;
newConn^.NextConnection := cell1^.Connection;
cell1^.Connection := newConn
END ConnectDirect;
PROCEDURE ConnectSystem (name1 : CARDINAL; (* name of first system *)
(* name = 0 means outer system *)
IOType1 : IOTypes; (* cell - type *)
Nr1 : CARDINAL; (* cell - number *)
name2 : CARDINAL; (* name of second system *)
(* name = 0 means outer system *)
IOType2 : IOTypes; (* cell - type *)
Nr2 : CARDINAL; (* cell - number *)
Transmission : INTEGER);
VAR newConn : ObjectPtr; (* new connection *)
from, to : ObjectPtr; (* pointer to cells *)
localSys : ObjectPtr; (* connection of source cells *)
found : BOOLEAN; (* flag if subsystem has been found *)
PROCEDURE Search (Cell : ObjectPtr; Nr : CARDINAL):ObjectPtr;
VAR actualCell : CARDINAL; (* pointer to actual cell *)
BEGIN
actualCell := 1;
WHILE (actualCell < Nr) AND (Cell <> NIL) DO
INC (actualCell); Cell := Cell^.NextCell
END;
IF actualCell = Nr THEN RETURN Cell ELSE RETURN NIL END
END Search;
BEGIN
IF (FirstSystem<>NIL) AND (LastSystem<>NIL) THEN
IF (name1 > 0) OR (name2 > 0) THEN
ALLOCATE (newConn, TSIZE (Object)); (* reserve memory space *)
newConn^.ObjectId := connect; (* identify object as connection *)
newConn^.Relevancy := maxCard; (* connection has maximal relevancy *)
newConn^.Transmission := Transmission; (* store actual transmission [%] *)
from := NIL; (* initialize source not found *)
to := NIL; (* initialize destination not found *)
IF name1 = 0 THEN (* FROM GLOBAL SYSTEM *)
IF IOType1 = in THEN from := Search (LastSystem^.I , Nr1)
ELSIF IOType1 = out THEN from := Search (LastSystem^.O , Nr1)
ELSE from := Search (LastSystem^.Cells, Nr1) END
ELSE (* name # 0 *)
localSys := LastSystem^.SubSystem;
IF localSys <> NIL THEN (* System has subsystems *)
found := FALSE;
WHILE (localSys <> NIL) AND NOT found DO
IF Diff (name1,localSys^.SystemName) = 0 THEN
found := TRUE;
IF IOType1 = in THEN from := Search (localSys^.I , Nr1)
ELSIF IOType1 = out THEN from := Search (localSys^.O , Nr1)
ELSE from := Search (localSys^.Cells, Nr1) END
ELSE localSys := localSys^.NextSystem END
END
ELSE Error (26) END; (* system has no subsystems *)
END;
IF name2 = 0 THEN (* FROM GLOBAL SYSTEM *)
IF IOType2 = in THEN to := Search (LastSystem^.I , Nr2)
ELSIF IOType2 = out THEN to := Search (LastSystem^.O , Nr2)
ELSE to := Search (LastSystem^.Cells, Nr2) END
ELSE (* name # 0 *)
localSys := LastSystem^.SubSystem;
IF localSys <> NIL THEN (* System has subsystems *)
found := FALSE;
WHILE (localSys <> NIL) AND NOT found DO
IF Diff (name2,localSys^.SystemName) = 0 THEN
found := TRUE;
IF IOType2 = in THEN to := Search (localSys^.I , Nr2)
ELSIF IOType2 = out THEN to := Search (localSys^.O , Nr2)
ELSE to := Search (localSys^.Cells, Nr2) END
ELSE localSys := localSys^.NextSystem END
END
ELSE Error (26) END; (* system has no subsystems *)
END;
newConn^.ConnectCell := to;
newConn^.SourceCell := from;
newConn^.LastConnection := NIL;
IF from = NIL THEN Error (6) END; (* source cell does not exist *)
IF to = NIL THEN Error (7) END; (* destination cell does not exist *)
IF (from<>NIL) AND (to<>NIL) THEN (* make connection *)
IF (from^.Type = NIL) OR (to^.Type = NIL) THEN
IF (from^.Type = NIL) THEN Error (6) END;
IF (to^.Type = NIL) THEN Error (7) END;
DEALLOCATE (newConn, TSIZE (Object)) (* release reserved memory space *)
ELSE
IF from^.Connection <> NIL THEN from^.Connection^.LastConnection := newConn END;
newConn^.NextConnection := from^.Connection;
from^.Connection := newConn
END
ELSE DEALLOCATE (newConn, TSIZE (Object)) (* release reserved memory space *)
END
ELSE ConnectCell (Nr1, IOType1, Nr2, IOType2, Transmission) END
ELSE Error (1) END (* system not yet initialized *)
END ConnectSystem;
PROCEDURE RemoveConnection (conn : ObjectPtr);
BEGIN
IF conn^.LastConnection = NIL THEN
conn^.SourceCell^.Connection := conn^.NextConnection
ELSE
conn^.LastConnection^.NextConnection := conn^.NextConnection
END;
IF conn^.NextConnection <> NIL THEN
conn^.NextConnection^.LastConnection := conn^.LastConnection
END;
DEALLOCATE (conn, TSIZE (Object));
END RemoveConnection;
PROCEDURE CloseSystem; (* close last system *)
BEGIN
IF LastSystem <> NIL THEN
IF LastSystem^.I = NIL THEN Warning (2) END;
IF LastSystem^.O = NIL THEN Warning (3) END;
IF (LastSystem^.CellTypes= NIL) AND (LastSystem^.UpSystem=NIL) THEN Warning (4) END;
LastSystem := LastSystem^.UpSystem; (* return one level *)
ELSE Error (1) END (* system not yet initialized *)
END CloseSystem;
(* ------------------------------ M A I N ---------------------------------------------*)
BEGIN
FirstSystem := NIL; (* no systems yet implemented *)
LastSystem := NIL;
FirstTeacher := NIL;
FirstActive := NIL
END BrainStruct.
SHAR_EOF
fi
if test -f 'BrainStruct.def'
then
echo shar: "will not over-write existing file 'BrainStruct.def'"
else
cat << \SHAR_EOF > 'BrainStruct.def'
(***************************************************************************************)
(* *)
DEFINITION MODULE BrainStruct;
(* *)
(* PROJECT : Neuron Model *)
(* PURPOSE : Base of a future IR-System *)
(* AUTHOR : D. Stieger IIIc/8 (Semesterarbeit) *)
(* DATE : 27.5.1987 *)
(* ASSISTANT : M. Wyle / Prof. Frei *)
(* RELEASE : 1.1 *)
(* *)
(* UPDATES : none *)
(* *)
(***************************************************************************************)
(* ------------------------------ D E F I N I T I O N S ------------------------------ *)
TYPE ObjectType = (system,global,local,connect); (* available object-types *)
IOTypes = (in, out, normal); (* I/O functions of cell *)
TeachTypes = (Active, Passive, Teacher); (* system behaviour *)
IORegister = ARRAY [0..1] OF INTEGER; (* I/O alternating register *)
ObjectPtr = POINTER TO Object; (* obejcts like system, cells ... *)
Object = RECORD
CASE ObjectId : ObjectType OF
(* S Y S T E M *)
system : SystemName : CARDINAL; (* INDEX *)
SubSystem : ObjectPtr; (* pointer to sub-system *)
UpSystem : ObjectPtr; (* pointer to upper syst.*)
NextSystem : ObjectPtr; (* pointer to neighbour *)
Teacher : TeachTypes; (* behaviour of system *)
Cells, I, O : ObjectPtr; (* pointer to cells *)
CellTypes : ObjectPtr; (* pointer to celltypes *)
TeachLink : ObjectPtr| (* link same properties *)
(* C E L L - T Y P E S *)
global : CellName : CARDINAL; (* INDEX *)
FirePotential : INTEGER; (* global FirePotential *)
Threshold : INTEGER; (* global Threshold *)
SpActivity : CARDINAL; (* spontaneous activity *)
Analog : BOOLEAN; (* analogous output *)
NextType : ObjectPtr; (* pointer to next type *)
Repolarization: CARDINAL | (* repol at each tick *)
(* C E L L S *)
local : Syst : ObjectPtr; (* embedding system *)
Sensitivity : CARDINAL; (* sensitivity in %. *)
Potential : IORegister; (* actual potential *)
ThresholdLoc : INTEGER; (* local threshold *)
IOTyp : IOTypes; (* I/O - function of cell*)
Type : ObjectPtr; (* type of cell *)
Connection : ObjectPtr; (* pointer to connections*)
NextCell : ObjectPtr| (* pointer to nect cell *)
(* C O N N E C T I O N S *)
connect: ConnectCell : ObjectPtr; (* connected cell *)
NextConnection: ObjectPtr; (* pointer to next conn. *)
LastConnection: ObjectPtr; (* pointer to last conn. *)
Transmission : INTEGER; (* transmission [%.] *)
SourceCell : ObjectPtr; (* source cell (speed up)*)
Relevancy : CARDINAL (* 0 .. maxCard *)
END (* CASE *)
END; (* RECORD *)
VAR FirstSystem : ObjectPtr; (* uppermost system *)
LastSystem : ObjectPtr; (* actual system (last inserted) *)
FirstTeacher : ObjectPtr; (* list for teacher - modules *)
FirstActive : ObjectPtr; (* list for active modules *)
(* ------------------------------ P R O C E D U R E S -------------------------------- *)
PROCEDURE InitSystem (name: CARDINAL; teachType : TeachTypes);
(* open a new system *)
PROCEDURE DefineCell (name : CARDINAL; (* specify new cell type for system *)
potential : INTEGER; (* global FirePotential *)
Thresh : INTEGER; (* global Threshold *)
Spontan : CARDINAL; (* spontaneous activity *)
Analogous : BOOLEAN; (* analogous output *)
Repol : CARDINAL); (* repolarization at each tick [%.] *)
PROCEDURE CreateCell (Nr : CARDINAL; (* CellNumber *)
IOType : IOTypes; (* in, out, normal *)
CellType : CARDINAL); (* INDEX to cell-name *)
PROCEDURE ConnectCell (From : CARDINAL; FromType : IOTypes;
To : CARDINAL; ToType : IOTypes;
Transmission : INTEGER);
PROCEDURE ConnectSystem (name1 : CARDINAL; (* name of first system *)
(* name = 0 means outer system *)
IOType1 : IOTypes; (* cell - type *)
Nr1 : CARDINAL; (* cell - number *)
name2 : CARDINAL; (* name of second system *)
(* name = 0 means outer system *)
IOType2 : IOTypes; (* cell - type *)
Nr2 : CARDINAL; (* cell - number *)
Transmission : INTEGER);
PROCEDURE CloseSystem; (* close last system *)
(***************************************************************************************)
(* FAST ROUTINES FOR EXECUTION PART ONLY *)
(***************************************************************************************)
(* ----------------------------------------------------------------------------------- *)
(* ---------------------------- DIRECT CREATION OF CELLS ----------------------------- *)
(* ----------------------------------------------------------------------------------- *)
PROCEDURE CreateDirect (VAR cell : ObjectPtr; last, type, syst : ObjectPtr);
(* VAR cell : new cell to be created *)
(* last : cell just before new cell (NextCell must be NIL) *)
(* type : celltype of new cell *)
(* syst : embedding system of new cell *)
(* ----------------------------------------------------------------------------------- *)
(* ---------------------------- DIRECT CONNECTION OF CELLS --------------------------- *)
(* ----------------------------------------------------------------------------------- *)
PROCEDURE ConnectDirect (cell1, cell2 : ObjectPtr; Transmission : INTEGER);
(* VAR cell1, cell2 : pointers to cells to be connected *)
(* Transmission : capacity of new connection *)
(* ----------------------------------------------------------------------------------- *)
(* ---------------------------- REMOVE CONNECTIONS ----------------------------------- *)
(* ----------------------------------------------------------------------------------- *)
PROCEDURE RemoveConnection (conn : ObjectPtr);
(* VAR conn : pointer to connection to be removed *)
END BrainStruct.
SHAR_EOF
fi
if test -f 'BrainErrors.mod'
then
echo shar: "will not over-write existing file 'BrainErrors.mod'"
else
cat << \SHAR_EOF > 'BrainErrors.mod'
(***************************************************************************************)
(* *)
IMPLEMENTATION MODULE BrainErrors;
(* *)
(* PROJECT : Neuron Model *)
(* PURPOSE : Base of a future IR-System *)
(* AUTHOR : D. Stieger IIIc/8 (Semesterarbeit) *)
(* DATE : 27.5.1987 *)
(* ASSISTANT : M. Wyle / Prof. Frei *)
(* RELEASE : 1.1 *)
(* *)
(* UPDATES : none *)
(* *)
(***************************************************************************************)
IMPORT Text; (* text file - handling *)
FROM Files IMPORT File, FileState; (* source - file *)
FROM SimpleIO IMPORT WriteString, WriteLn; (* I/O on actual shell *)
VAR state : FileState; (* state of log-file *)
log : File; (* log - file *)
(* ------------------------------ P R O C E D U R E S -------------------------------- *)
PROCEDURE Error (n : CARDINAL); (* mark error with number 'n' *)
BEGIN
INC (Errors); (* report error in counter *)
WriteString (' <<< ERROR : ');
Text.WriteString (log, '<<< ERROR : ', state);
CASE n OF
1 : WriteString ( 'system not initialized' );
Text.WriteString (log,'system not initialized', state) |
2 : WriteString ( 'same name already defined on this system level' );
Text.WriteString (log,'same name already defined on this system level', state)|
3 : WriteString ( 'parameter out of range ==> 0..1000 %.' );
Text.WriteString (log,'parameter out of range ==> 0..1000 %.', state)|
4 : WriteString ( 'cell with same number was already declared' );
Text.WriteString (log,'cell with same number was already declared', state)|
5 : WriteString ( 'requested cell-type is not yet declared' );
Text.WriteString (log,'requested cell-type is not yet declared', state)|
6 : WriteString ( 'source-cell does not exist' );
Text.WriteString (log,'source-cell does not exist', state)|
7 : WriteString ( 'destination-cell does not exist' );
Text.WriteString (log,'destination-cell does not exist', state)|
8 : WriteString ( 'PARSER : semicolon expected' );
Text.WriteString (log,'PARSER : semicolon expected', state)|
9 : WriteString ( 'PARSER : identifier expected' );
Text.WriteString (log,'PARSER : identifier expected', state)|
10 : WriteString ( 'PARSER : SYSTEM expected' );
Text.WriteString (log,'PARSER : SYSTEM expected', state)|
11 : WriteString ( 'PARSER : period expected' );
Text.WriteString (log,'PARSER : period expected', state)|
12 : WriteString ( 'PARSER : END expected' );
Text.WriteString (log,'PARSER : END expected', state)|
13 : WriteString ( 'PARSER : GLOBAL expected' );
Text.WriteString (log,'PARSER : GLOBAL expected', state)|
14 : WriteString ( 'PARSER : number expected' );
Text.WriteString (log,'PARSER : number expected', state)|
15 : WriteString ( 'PARSER : positive number expected' );
Text.WriteString (log,'PARSER : positive number expected', state)|
16 : WriteString ( 'PARSER : TRUE/FALSE expected' );
Text.WriteString (log,'PARSER : TRUE/FALSE expected', state)|
17 : WriteString ( 'PARSER : equal expected' );
Text.WriteString (log,'PARSER : equal expected', state)|
18 : WriteString ( 'PARSER : colon expected' );
Text.WriteString (log,'PARSER : colon expected', state)|
19 : WriteString ( 'PARSER : cell enumeration starts with 1' );
Text.WriteString (log,'PARSER : cell enumeration starts with 1', state)|
20 : WriteString ( 'PARSER : invalid list' );
Text.WriteString (log,'PARSER : invalid list', state)|
21 : WriteString ( 'PARSER : step-width must be greater than zero' );
Text.WriteString (log,'PARSER : step-width must be greater than zero', state)|
22 : WriteString ( 'PARSER : WITH expected' );
Text.WriteString (log,'PARSER : WITH expected', state)|
23 : WriteString ( 'PARSER : ACTIVE/PASSIVE/TEACHER expected' );
Text.WriteString (log,'PARSER : ACTIVE/PASSIVE/TEACHER expected', state)|
24 : WriteString ( 'PARSER : number between 0 and 1000 expected' );
Text.WriteString (log,'PARSER : number between 0 and 1000 expected', state)|
25 : WriteString ( 'PARSER : right paranthesis expected' );
Text.WriteString (log,'PARSER : right paranthesis expected', state)|
26 : WriteString ( 'PARSER : system has no sub-systems for connection' );
Text.WriteString (log,'PARSER : system has no sub-systems for connection', state)|
27 : WriteString ( 'PARSER : number of cells does not correspond' );
Text.WriteString (log,'PARSER : number of cells does not correspond', state)|
31 : WriteString ( 'SCANNER : maximal number of digits exceeded' );
Text.WriteString (log,'SCANNER : maximal number of digits exceeded', state)|
32 : WriteString ( 'SCANNER : overflow, not a cardinal' );
Text.WriteString (log,'SCANNER : overflow, not a cardinal', state)|
41 : WriteString ( 'EXEC : activity is out of range' );
Text.WriteString (log,'EXEC : activity is out of range', state)|
42 : WriteString ( 'EXEC : no systems are generated' );
Text.WriteString (log,'EXEC : no systems are generated', state)|
43 : WriteString ( 'EXEC : no processing, because of errors' );
Text.WriteString (log,'EXEC : no processing, because of errors', state)|
44 : WriteString ( 'EXEC : input array to short declared' );
Text.WriteString (log,'EXEC : input array to short declared', state)|
45 : WriteString ( 'EXEC : input-length does not match' );
Text.WriteString (log,'EXEC : input-length does not match', state)|
46 : WriteString ( 'EXEC : output array to short declared' );
Text.WriteString (log,'EXEC : output array to short declared', state)|
47 : WriteString ( 'EXEC : output-length does not match' );
Text.WriteString (log,'EXEC : output-length does not match', state)|
48 : WriteString ( 'EXEC : internal structure is destroyed' );
Text.WriteString (log,'EXEC : internal structure is destroyed', state)|
ELSE WriteString ( 'unknown error (ring up M. Wyle)' );
Text.WriteString (log,'unknown error (ring up M. Wyle)', state)
END; (* CASE *)
WriteString (' >>>'); WriteLn ();
Text.WriteString (log, '>>>', state); Text.WriteLn (log, state)
END Error;
PROCEDURE Warning (n : CARDINAL); (* mark warning with number 'n' *)
BEGIN
WriteString (' <<< WARNING : ');
Text.WriteString (log, '<<< WARNING : ', state);
CASE n OF
1 : WriteString ( 'there are no cells in that system' );
Text.WriteString (log,'there are no cells in that system', state) |
2 : WriteString ( 'there are no input-cells in that system' );
Text.WriteString (log,'there are no input-cells in that system', state)|
3 : WriteString ( 'there are no output-cells in that system' );
Text.WriteString (log,'there are no output-cells in that system', state)|
4 : WriteString ( 'there are no cell-types in that system' );
Text.WriteString (log,'there are no cell-types in that system', state)|
ELSE WriteString ( 'unknown warning (ring up M. Wyle)' );
Text.WriteString (log,'unknown warning (ring up M. Wyle)', state)
END; (* CASE *)
WriteString (' >>>'); WriteLn ();
Text.WriteString (log, '>>>', state); Text.WriteLn (log, state)
END Warning;
PROCEDURE Prompt (msg : ARRAY OF CHAR); (* write unspecified prompt *)
BEGIN
WriteString (' <<< MESSAGE : '); WriteString (msg); WriteString (' >>>'); WriteLn ();
Text.WriteString (log, '<<< MESSAGE : ', state);
Text.WriteString (log, msg, state);
Text.WriteString (log, '>>>', state); Text.WriteLn (log, state)
END Prompt;
PROCEDURE Init (VAR logFile : File); (* specify log - File *)
BEGIN
log := logFile
END Init;
(* ------------------------------ M A I N -------------------------------------------- *)
BEGIN (* MAIN *)
Errors := 0;
END BrainErrors.
SHAR_EOF
fi
exit 0
# End of shell archive
--
-Mitchell F. Wyle wyle@ethz.uucp
Institut fuer Informatik wyle%ifi.ethz.ch@relay.cs.net
ETH Zentrum
8092 Zuerich, Switzerland +41 1 256-5237
Thread Navigation
This is a paginated view of messages in the thread with full content displayed inline.
Messages are displayed in chronological order, with the original post highlighted in green.
Use pagination controls to navigate through all messages in large threads.
Back to All Threads