🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

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
#4016
Author: wyle Mitchell Wyle
Date: Tue, 26 Jan 1988 10:54
870 lines
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