[comp.lang.modula2] brain 2 of 3

wyle@solaris.ifi.ethz.ch@relay.cs.net (Mitchell Wyle) (01/26/88)

#! /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