wyle@solaris.ifi.ethz.ch@relay.cs.net (Mitchell Wyle) (01/26/88)
This is part 1 of a neural networks simulator in modula-2. It
runs on all versions of the Sun modula-2 compiler, but I haven't
tried to port it anywhere else.
The enclosed "toy" problem to test the language and simulator is
a system which accepts trigrams (3-letter combinations) and learns
to decide if the trigram is part of the name of a fruit, a flower,
or unknown.
Enjoy, and please send comments, corrections, flames, etc to:
wyle@ethz.uucp (or faster:) wyle%ifi.ethz.ch@relay.cs.net
===========================cut here==============================
#! /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:
# Brain.txt
# BrainDefinitions.def
# TestParser.mod
# Brain.tst
# BrainExec.mod
# This archive created: Tue Aug 4 07:15:30 1987
export PATH; PATH=/bin:/usr/bin:$PATH
if test -f 'Brain.txt'
then
echo shar: "will not over-write existing file 'Brain.txt'"
else
cat << \SHAR_EOF > 'Brain.txt'
SYSTEM Trigrams IS PASSIVE;
DEFINE CELL Input GLOBAL
FirePotential = 850
Threshold = 300
SpActivity = 0
Analog = FALSE
Repolarization= 800
END;
Output GLOBAL
FirePotential = 850
Threshold = 300
Analog = TRUE
Repolarization= 800
END;
(*------------------------------------------------------------------------*)
SYSTEM Decoder IS ACTIVE;
DEFINE CELL Trigramdecoder GLOBAL
FirePotential = 850
Threshold = 400
SpActivity = 0
Analog = FALSE
Repolarization= 1000
END;
CREATE INPUT CELL 1.. 24 : Input;
CREATE OUTPUT CELL 1.. 24 : Trigramdecoder
CONNECT INPUT CELL 1.. 24 PARALLEL WITH OUTPUT CELL 1.. 24
END; (* Decoder *)
(*------------------------------------------------------------------------*)
(* Following cells are created on the level of the Trigram - System *)
CREATE INPUT CELL 1.. 24 : Input (* INPUTS FOR TRIGRAMS *)
CREATE INPUT CELL 25.. 72 : Input (* INPUTS FOR TEACHER *)
CREATE OUTPUT CELL 1.. 48 : Output
(*------------------------------------------------------------------------*)
SYSTEM Teacher IS TEACHER;
DEFINE CELL TeachField GLOBAL
FirePotential = 800
Threshold = 350
SpActivity = 0
Analog = TRUE
Repolarization= 800
END;
CREATE INPUT CELL 1.. 48 : Input;
CREATE OUTPUT CELL 1.. 48 : TeachField
CONNECT INPUT CELL 1.. 48 PARALLEL WITH OUTPUT CELL 1..48
END; (* Teacher *)
(*------------------------------------------------------------------------*)
CONNECT SYSTEM INPUT 1..24 PARALLEL WITH SYSTEM Decoder 1..24
CONNECT SYSTEM INPUT 25..72 PARALLEL WITH SYSTEM Teacher 1..48
CONNECT SYSTEM Teacher 1..48 PARALLEL WITH SYSTEM OUTPUT 1..48
END; (* Trigrams *)
SHAR_EOF
fi
if test -f 'BrainDefinitions.def'
then
echo shar: "will not over-write existing file 'BrainDefinitions.def'"
else
cat << \SHAR_EOF > 'BrainDefinitions.def'
(***************************************************************************************)
(* *)
DEFINITION MODULE BrainDefinitions;
(* *)
(* PROJECT : Neuron Model *)
(* PURPOSE : Base of a future IR-System *)
(* AUTHOR : D. Stieger IIIc/8 (Semesterarbeit) *)
(* DATE : 6.6.1987 *)
(* ASSISTANT : M. Wyle / Prof. Frei *)
(* RELEASE : 1.1 *)
(* *)
(* UPDATES : completely retyped 25.6.87 D.Stieger *)
(* *)
(***************************************************************************************)
CONST NUL = 0C; (* string delimiter *)
clr = 14C; (* clear screen *)
cr = 15C; (* carriage return *)
lastASCII = 177C; (* last ascii-character *)
maxCard = 65535; (* gratest cardinal number *)
bufLen = 10000; (* length og identifier - buffer *)
maxKey = 25; (* maximal number of key-words *)
maxErrors = 50; (* maximal number of errors allowed*)
(* ----------------------------------------------------------------------------------- *)
DefaultFirePotential = +850; (* [100uV] *)
DefaultThreshold = +400; (* [100uV] *)
DefaultSpActivity = 0; (* [%. ] *)
DefaultAnalog = FALSE;
DefaultRepolarization = 100; (* [%. ] *)
lowPotential = -400; (* [100uV] *) (* low potential in system *)
highPotential = +800; (* [100uV] *) (* high potential in system *)
maxPotential =+1500; (* [100uv] *) (* maximal cell potential *)
(*********************************************************************************)
(* the Sensitivity of each cell varies from 1000-Range ... 1000+Range [%.] *)
(* the adaptation speed (asymptotic) depends from Fact *)
SensitivityRange = 0; (* [ %. ] *)
SensitivityFact = 0; (* [ %. ] *)
(* *)
(*********************************************************************************)
connectionRate = 10; (* [%.] *) (* probability of connection *)
transmAmount = 85; (* [%.] *) (* transmission changes / clock *)
connectionRelevIncr = 20; (* unit *) (* maxCard ~ maximal Relevancy *)
connectionThreshold = 65000; (* unit *) (* low bound => del connection *)
transmThreshold = 50; (* [%.] *) (* low bound => del connection *)
(* ----------------------------------------------------------------------------------- *)
VAR buf : ARRAY [0..bufLen-1] OF CHAR; (* identifier - list *)
clock : CARDINAL; (* VALUES [0,1], system clock *)
(* ----------------------------------------------------------------------------------- *)
PROCEDURE Diff (u, v : CARDINAL):INTEGER; (* comparison of identifiers *)
END BrainDefinitions.
SHAR_EOF
fi
if test -f 'TestParser.mod'
then
echo shar: "will not over-write existing file 'TestParser.mod'"
else
cat << \SHAR_EOF > 'TestParser.mod'
MODULE TestParser;
IMPORT SimpleIO;
FROM Files IMPORT File, Open, FileState, Reset, Close, ReadWriteMode,
BinTextMode, Create, Rewrite, ReplaceMode;
FROM Text IMPORT WriteChar, ReadString, ReadLn, WriteLn, WriteString;
FROM BrainParser IMPORT InitParser, Parse, CloseParser;
FROM BrainExec IMPORT Input, Output, Tick, Activity, Save, teaching;
VAR source : File;
test : File;
log : File;
out : File;
state : FileState;
I, O : ARRAY [0.. 9] OF CHAR; (* 3T 6I = 9*8Bit *)
Ib,Ob : ARRAY [0..71] OF INTEGER;
i : CARDINAL;
BEGIN
Open (source, 'Brain.txt', textMode, readOnly, state);
Open (test , 'Brain.tst', textMode, readOnly, state);
Create (log , 'Brain.log', textMode, replace , state);
Open (log , 'Brain.log', textMode, readWrite, state);
Create (out , 'Brain.out', textMode, replace , state);
Open (out , 'Brain.out', textMode, readWrite, state);
InitParser (source, log);
Parse;
CloseParser;
Activity (500,500);
REPEAT
ReadString (test, I, state); ReadLn (test, state);
WriteString (log, I, state); WriteLn (log, state);
IF (I[0] <> '.') THEN
FOR i := 0 TO 8 DO
IF ORD(I[i])>127 THEN Ib[i*8+0]:=800; I[i]:= CHR(ORD(I[i])-128) ELSE Ib[i*8+0]:=0 END;
IF ORD(I[i])> 63 THEN Ib[i*8+1]:=800; I[i]:= CHR(ORD(I[i])- 64) ELSE Ib[i*8+1]:=0 END;
IF ORD(I[i])> 31 THEN Ib[i*8+2]:=800; I[i]:= CHR(ORD(I[i])- 32) ELSE Ib[i*8+2]:=0 END;
IF ORD(I[i])> 15 THEN Ib[i*8+3]:=800; I[i]:= CHR(ORD(I[i])- 16) ELSE Ib[i*8+3]:=0 END;
IF ORD(I[i])> 7 THEN Ib[i*8+4]:=800; I[i]:= CHR(ORD(I[i])- 8) ELSE Ib[i*8+4]:=0 END;
IF ORD(I[i])> 3 THEN Ib[i*8+5]:=800; I[i]:= CHR(ORD(I[i])- 4) ELSE Ib[i*8+5]:=0 END;
IF ORD(I[i])> 1 THEN Ib[i*8+6]:=800; I[i]:= CHR(ORD(I[i])- 2) ELSE Ib[i*8+6]:=0 END;
IF ORD(I[i])> 0 THEN Ib[i*8+7]:=800; I[i]:= CHR(ORD(I[i])- 1) ELSE Ib[i*8+7]:=0 END
END;
Input (Ib, 72); Tick; Output (Ob, 48);
FOR i := 0 TO 5 DO
O[i] := 0C;
IF Ob [i*8+0]>0 THEN O[i] := CHR (ORD(O[i])+128) END;
IF Ob [i*8+0]>0 THEN WriteChar (log,'1',state) ELSE WriteChar (log,'0',state) END;
IF Ob [i*8+1]>0 THEN O[i] := CHR (ORD(O[i])+ 64) END;
IF Ob [i*8+1]>0 THEN WriteChar (log,'1',state) ELSE WriteChar (log,'0',state) END;
IF Ob [i*8+2]>0 THEN O[i] := CHR (ORD(O[i])+ 32) END;
IF Ob [i*8+2]>0 THEN WriteChar (log,'1',state) ELSE WriteChar (log,'0',state) END;
IF Ob [i*8+3]>0 THEN O[i] := CHR (ORD(O[i])+ 16) END;
IF Ob [i*8+3]>0 THEN WriteChar (log,'1',state) ELSE WriteChar (log,'0',state) END;
IF Ob [i*8+4]>0 THEN O[i] := CHR (ORD(O[i])+ 8) END;
IF Ob [i*8+4]>0 THEN WriteChar (log,'1',state) ELSE WriteChar (log,'0',state) END;
IF Ob [i*8+5]>0 THEN O[i] := CHR (ORD(O[i])+ 4) END;
IF Ob [i*8+5]>0 THEN WriteChar (log,'1',state) ELSE WriteChar (log,'0',state) END;
IF Ob [i*8+6]>0 THEN O[i] := CHR (ORD(O[i])+ 2) END;
IF Ob [i*8+6]>0 THEN WriteChar (log,'1',state) ELSE WriteChar (log,'0',state) END;
IF Ob [i*8+7]>0 THEN O[i] := CHR (ORD(O[i])+ 1) END;
IF Ob [i*8+7]>0 THEN WriteChar (log,'1',state) ELSE WriteChar (log,'0',state) END;
IF O[i] < 'A' THEN O[i] := '.' END;
IF O[i] > 'Z' THEN O[i] := '.' END;
WriteChar (log,',', state)
END; WriteChar (log,' ', state);
FOR i := 0 TO 5 DO WriteChar (log, O[i], state) END;
WriteLn (log, state)
END
UNTIL I [0] = '.';
teaching := FALSE;
WriteLn (log, state);
WriteLn (log, state);
REPEAT
ReadString (test, I, state); ReadLn (test, state);
WriteString (log, I, state); WriteLn (log, state);
IF (I[0] <> '.') THEN
FOR i := 0 TO 8 DO
IF i > 2 THEN I[i] := 0C END;
IF ORD(I[i])>127 THEN Ib[i*8+0]:=800; I[i]:= CHR(ORD(I[i])-128) ELSE Ib[i*8+0]:=0 END;
IF ORD(I[i])> 63 THEN Ib[i*8+1]:=800; I[i]:= CHR(ORD(I[i])- 64) ELSE Ib[i*8+1]:=0 END;
IF ORD(I[i])> 31 THEN Ib[i*8+2]:=800; I[i]:= CHR(ORD(I[i])- 32) ELSE Ib[i*8+2]:=0 END;
IF ORD(I[i])> 15 THEN Ib[i*8+3]:=800; I[i]:= CHR(ORD(I[i])- 16) ELSE Ib[i*8+3]:=0 END;
IF ORD(I[i])> 7 THEN Ib[i*8+4]:=800; I[i]:= CHR(ORD(I[i])- 8) ELSE Ib[i*8+4]:=0 END;
IF ORD(I[i])> 3 THEN Ib[i*8+5]:=800; I[i]:= CHR(ORD(I[i])- 4) ELSE Ib[i*8+5]:=0 END;
IF ORD(I[i])> 1 THEN Ib[i*8+6]:=800; I[i]:= CHR(ORD(I[i])- 2) ELSE Ib[i*8+6]:=0 END;
IF ORD(I[i])> 0 THEN Ib[i*8+7]:=800; I[i]:= CHR(ORD(I[i])- 1) ELSE Ib[i*8+7]:=0 END
END;
Input (Ib, 72); Tick; Output (Ob, 48);
FOR i := 0 TO 5 DO
O[i] := 0C;
IF Ob [i*8+0]>0 THEN O[i] := CHR (ORD(O[i])+128) END;
IF Ob [i*8+0]>0 THEN WriteChar (log,'1',state) ELSE WriteChar (log,'0',state) END;
IF Ob [i*8+1]>0 THEN O[i] := CHR (ORD(O[i])+ 64) END;
IF Ob [i*8+1]>0 THEN WriteChar (log,'1',state) ELSE WriteChar (log,'0',state) END;
IF Ob [i*8+2]>0 THEN O[i] := CHR (ORD(O[i])+ 32) END;
IF Ob [i*8+2]>0 THEN WriteChar (log,'1',state) ELSE WriteChar (log,'0',state) END;
IF Ob [i*8+3]>0 THEN O[i] := CHR (ORD(O[i])+ 16) END;
IF Ob [i*8+3]>0 THEN WriteChar (log,'1',state) ELSE WriteChar (log,'0',state) END;
IF Ob [i*8+4]>0 THEN O[i] := CHR (ORD(O[i])+ 8) END;
IF Ob [i*8+4]>0 THEN WriteChar (log,'1',state) ELSE WriteChar (log,'0',state) END;
IF Ob [i*8+5]>0 THEN O[i] := CHR (ORD(O[i])+ 4) END;
IF Ob [i*8+5]>0 THEN WriteChar (log,'1',state) ELSE WriteChar (log,'0',state) END;
IF Ob [i*8+6]>0 THEN O[i] := CHR (ORD(O[i])+ 2) END;
IF Ob [i*8+6]>0 THEN WriteChar (log,'1',state) ELSE WriteChar (log,'0',state) END;
IF Ob [i*8+7]>0 THEN O[i] := CHR (ORD(O[i])+ 1) END;
IF Ob [i*8+7]>0 THEN WriteChar (log,'1',state) ELSE WriteChar (log,'0',state) END;
IF O[i] < 'A' THEN O[i] := '.' END;
IF O[i] > 'Z' THEN O[i] := '.' END;
WriteChar (log,',', state)
END; WriteChar (log,' ', state);
FOR i := 0 TO 5 DO WriteChar (log, O[i], state) END;
WriteLn (log, state)
END
UNTIL I [0] = '.';
Save (out);
Close (source, state);
Close (test , state);
Close (log, state);
Close (out, state)
END TestParser.
SHAR_EOF
fi
if test -f 'Brain.tst'
then
echo shar: "will not over-write existing file 'Brain.tst'"
else
cat << \SHAR_EOF > 'Brain.tst'
EMPTY
BANFRUIT
ANAFRUIT
NANFRUIT
ANEFRUIT
BANFRUIT
ANAFRUIT
NANFRUIT
ANEFRUIT
ROSFLOWER
OSEFLOWER
ROSFLOWER
OSEFLOWER
BANFRUIT
ANAFRUIT
NANFRUIT
ANEFRUIT
ROSFLOWER
OSEFLOWER
ROSFLOWER
OSEFLOWER
BANFRUIT
ANAFRUIT
NANFRUIT
ANEFRUIT
ROSFLOWER
OSEFLOWER
BANFRUIT
ANAFRUIT
NANFRUIT
ANEFRUIT
APPFRUIT
PPLFRUIT
PLEFRUIT
APPFRUIT
PPLFRUIT
PLEFRUIT
BANFRUIT
ANAFRUIT
NANFRUIT
ANEFRUIT
BANFRUIT
ANAFRUIT
NANFRUIT
ANEFRUIT
BANFRUIT
ANAFRUIT
NANFRUIT
ANEFRUIT
APPFRUIT
PPLFRUIT
PLEFRUIT
.......................
ROS
OSE
BAN
ANA
NAN
ANE
APP
PPL
PLE
BAN
ANA
NAN
ANE
ROS
OSE
ROS
OSE
BAN
ANA
NAN
ANE
........................
........................
SHAR_EOF
fi
if test -f 'BrainExec.mod'
then
echo shar: "will not over-write existing file 'BrainExec.mod'"
else
cat << \SHAR_EOF > 'BrainExec.mod'
(***************************************************************************************)
(* *)
IMPLEMENTATION MODULE BrainExec;
(* *)
(* PROJECT : Neuron Model *)
(* PURPOSE : Base of a future IR-System *)
(* AUTHOR : D. Stieger IIIc/8 (Semesterarbeit) *)
(* DATE : 18.6.1987 *)
(* ASSISTANT : M. Wyle / Prof. Frei *)
(* RELEASE : 1.1 *)
(* *)
(* UPDATES : completely retyped 24.6.87 (D.Stieger) *)
(* *)
(***************************************************************************************)
IMPORT Text;
IMPORT SimpleIO;
FROM SYSTEM IMPORT (* CALL *) CCALL, (* C-Library *)
(* PROC *) TSIZE;
FROM Storage IMPORT (* PROC *) ALLOCATE;
FROM NumberIO IMPORT (* PROC *) WriteCard, WriteInt;
FROM BrainDefinitions IMPORT (* CONS *) lowPotential, highPotential, maxPotential,
SensitivityRange, SensitivityFact, maxCard,
connectionRate, transmAmount,
connectionRelevIncr, connectionThreshold,
transmThreshold,
(* VARS *) clock, buf, bufLen;
FROM BrainStruct IMPORT (* TYPE *) ObjectPtr, Object, IOTypes, TeachTypes,
(* VARS *) FirstSystem, LastSystem,
FirstTeacher, FirstActive,
(* PROC *) ConnectDirect, RemoveConnection, CreateDirect;
FROM BrainErrors IMPORT (* VARS *) Errors,
(* PROC *) Error;
FROM Files IMPORT (* TYPE *) File, FileState;
(*-------------------------------------------------------------------------------------*)
CONST trace = FALSE; (* trace firing (debugging help) *)
TYPE activeListPtr = POINTER TO activeList;
activeList = RECORD
cell : ObjectPtr;
next : activeListPtr;
isLast : BOOLEAN
END;
VAR analogActivity : CARDINAL; (* system activity *)
digitalActivity : CARDINAL;
objectPtr : ObjectPtr; (* pointer to actual object *)
activeCellPtr : activeListPtr; (* list of active cells *)
lastActiveCellPtr : activeListPtr; (* last inserted cell *)
invClock : CARDINAL; (* inverted clock *)
InputFlag : BOOLEAN; (* flag if input has been performed *)
InitFlag : BOOLEAN; (* system - initialization *)
(*-------------------------------------------------------------------------------------*)
(***************************************************************************************)
(* *)
(* N A V I G A T I O N - F U N C T I O N S *)
(* *)
(***************************************************************************************)
PROCEDURE GetOutestSystem (VAR s : ObjectPtr):BOOLEAN;
BEGIN s := FirstSystem; RETURN s <> NIL END GetOutestSystem;
PROCEDURE GetSubSystem (s1 : ObjectPtr; VAR s2 : ObjectPtr):BOOLEAN;
BEGIN s2 := s1^.SubSystem; RETURN s2 <> NIL END GetSubSystem;
PROCEDURE GetUpSystem (s1 : ObjectPtr; VAR s2 : ObjectPtr):BOOLEAN;
BEGIN s2 := s1^.UpSystem; RETURN s2 <> NIL END GetUpSystem;
PROCEDURE GetNextSystem (s1 : ObjectPtr; VAR s2 : ObjectPtr):BOOLEAN;
BEGIN s2 := s1^.NextSystem; RETURN s2 <> NIL END GetNextSystem;
PROCEDURE Get1stInputCell (s : ObjectPtr; VAR c : ObjectPtr):BOOLEAN;
BEGIN c := s^.I; RETURN c <> NIL END Get1stInputCell;
PROCEDURE Get1stOutputCell (s : ObjectPtr; VAR c : ObjectPtr):BOOLEAN;
BEGIN c := s^.O; RETURN c <> NIL END Get1stOutputCell;
PROCEDURE Get1stNormalCell (s : ObjectPtr; VAR c : ObjectPtr):BOOLEAN;
BEGIN c := s^.Cells; RETURN c <> NIL END Get1stNormalCell;
PROCEDURE GetNextCell (c1 : ObjectPtr; VAR c2 : ObjectPtr):BOOLEAN;
BEGIN c2 := c1^.NextCell; RETURN c2 <> NIL END GetNextCell;
PROCEDURE Get1stPositiveOutputCell (s : ObjectPtr; VAR c : ObjectPtr):BOOLEAN;
VAR cOld : ObjectPtr;
BEGIN
IF Get1stOutputCell (s, c) THEN
REPEAT
cOld := c;
IF c^.Potential [clock] >= c^.ThresholdLoc THEN RETURN TRUE END
UNTIL NOT GetNextCell (cOld, c)
END;
RETURN FALSE
END Get1stPositiveOutputCell;
PROCEDURE GetNextPositiveOutputCell (c1 : ObjectPtr; VAR c2 : ObjectPtr):BOOLEAN;
VAR cOld : ObjectPtr;
BEGIN
IF GetNextCell (c1, c2) THEN
REPEAT
cOld := c2;
IF c2^.Potential [clock] >= c2^.ThresholdLoc THEN RETURN TRUE END
UNTIL NOT GetNextCell (cOld, c2)
END;
RETURN FALSE
END GetNextPositiveOutputCell;
PROCEDURE Get1stConnection (c : ObjectPtr; VAR co : ObjectPtr):BOOLEAN;
BEGIN co := c^.Connection; RETURN co <> NIL END Get1stConnection;
PROCEDURE GetNextConnection (co1 : ObjectPtr; VAR co2 : ObjectPtr):BOOLEAN;
BEGIN co2 := co1^.NextConnection; RETURN co2 <> NIL END GetNextConnection;
PROCEDURE Get1stType (s : ObjectPtr; VAR t : ObjectPtr):BOOLEAN;
BEGIN t := s^.CellTypes; RETURN t <> NIL END Get1stType;
PROCEDURE GetNextType (t1 : ObjectPtr; VAR t2 : ObjectPtr):BOOLEAN;
BEGIN t2 := t1^.NextType; RETURN t2 <> NIL END GetNextType;
(*-------------------------------------------------------------------------------------*)
PROCEDURE Random (n : CARDINAL):CARDINAL;
BEGIN
RETURN CARDINAL (ABS (CCALL ("random"))) MOD n
END Random;
PROCEDURE Per1000 (n, f: INTEGER):INTEGER;
VAR i, fact, sign, result : INTEGER;
BEGIN
IF n = 0 THEN RETURN 0 END;
sign := 1; IF n < 0 THEN sign := -1 END;
n := ABS (n); fact := 1000; result := 0;
WHILE f <> 0 DO
i := f MOD 10;
result := result + ((i*n) DIV fact);
f := f DIV 10;
fact := fact DIV 10
END;
RETURN result*sign
END Per1000;
PROCEDURE Input (x : ARRAY OF INTEGER; length : INTEGER);
VAR count, local : INTEGER;
systemPtr, cellPtr, cellPtrOld : ObjectPtr;
BEGIN
InputFlag := TRUE; (* input executed for that step *)
invClock := (clock+1) MOD 2;
IF length-1 <= INTEGER(HIGH (x)) THEN
count := 0;
IF GetOutestSystem (systemPtr) THEN
IF Get1stInputCell (systemPtr, cellPtr) THEN
REPEAT
cellPtrOld := cellPtr;
IF InitFlag THEN
cellPtr^.Potential [invClock] := lowPotential + x[count]
ELSE
local := cellPtr^.Potential [clock]-lowPotential;
local := Per1000 (local, 1000 - INTEGER(cellPtr^.Type^.Repolarization));
cellPtr^.Potential [invClock] := lowPotential + local + x[count]
END; INC (count)
UNTIL NOT GetNextCell (cellPtrOld, cellPtr) OR (count > length)
END
ELSE Error (42) END; (* no systems are generated *)
IF count <> length THEN Error (45) END (* input-length does not match *)
ELSE Error (44) END (* input array to short declared *)
END Input;
PROCEDURE Output (VAR x : ARRAY OF INTEGER; length : INTEGER);
VAR count, local : INTEGER;
systemPtr, cellPtr, cellPtrOld : ObjectPtr;
BEGIN
invClock := (clock+1) MOD 2;
IF length-1 <= INTEGER(HIGH (x)) THEN
count := 0;
IF GetOutestSystem (systemPtr) THEN
IF Get1stOutputCell (systemPtr, cellPtr) THEN
REPEAT
cellPtrOld := cellPtr;
IF InitFlag THEN
x[count] := lowPotential
ELSE
x[count] := cellPtr^.Potential [clock]
END; INC (count)
UNTIL NOT GetNextCell (cellPtrOld, cellPtr) OR (count > length)
END
ELSE Error (42) END; (* no systems are generated *)
IF count <> length THEN Error (47) END (* output-length does not match *)
ELSE Error (46) END (* output array to short declared *)
END Output;
PROCEDURE Tick; (* calculate one clock cycle *)
(***************************************************************************************)
(* *)
(* EXECUTION OF BRAIN *)
(* ------------------ *)
(* *)
(* Phase 1 : Set 2nd register component to zero ( invClock ) *)
(* Phase 2 : Teach & Learn *)
(* Phase 3 : Firing. Add potentials to 2nd positions ( Sum Clock => invClock ) *)
(* Phase 4 : Swap clock ( clock := invClock ) *)
(* *)
(***************************************************************************************)
(*----------------------------------- P H A S E 1 ------------------------------------*)
PROCEDURE Reset (systemPtr : ObjectPtr);
VAR oldCellPtr , newCellPtr : ObjectPtr;
subSystemPtr, nextSystemPtr : ObjectPtr;
PROCEDURE ResetCell (cellPtr : ObjectPtr);
VAR oldCellPtr : ObjectPtr;
local : INTEGER;
BEGIN
REPEAT
oldCellPtr := cellPtr;
IF InitFlag THEN
cellPtr^.Potential [invClock] := lowPotential
ELSE
local := cellPtr^.Potential [clock]-lowPotential;
local := Per1000 (local, 1000 - INTEGER(cellPtr^.Type^.Repolarization));
cellPtr^.Potential [invClock] := lowPotential + local
END
UNTIL NOT GetNextCell (oldCellPtr, cellPtr)
END ResetCell;
BEGIN
IF (systemPtr <> FirstSystem) OR NOT InputFlag THEN
IF Get1stInputCell (systemPtr,newCellPtr) THEN ResetCell (newCellPtr) END
END;
IF Get1stOutputCell (systemPtr, newCellPtr) THEN ResetCell (newCellPtr) END;
IF Get1stNormalCell (systemPtr, newCellPtr) THEN ResetCell (newCellPtr) END;
IF GetSubSystem (systemPtr, subSystemPtr ) THEN Reset (subSystemPtr ) END;
IF GetNextSystem (systemPtr, nextSystemPtr) THEN Reset (nextSystemPtr) END
END Reset;
(*----------------------------------- P H A S E 2 ------------------------------------*)
PROCEDURE Learn (systemPtr : ObjectPtr);
(*************************************************************************************)
(* In this section connections from active to teach systems are performed *)
(*************************************************************************************)
VAR a,t : ObjectPtr; (* active system(s), teaching system(s) *)
aOut, OldAOut : ObjectPtr; (* active system out-cell *)
tOut, OldTOut : ObjectPtr; (* teacher-system out-cell *)
tIn : ObjectPtr; (* input-cells after teacher *)
conn : ObjectPtr; (* connection *)
tOutConn : ObjectPtr; (* connections from teacher *)
OldTOutConn : ObjectPtr;
factor : INTEGER; (* psitive or negative weight *)
transmFact : INTEGER; (* actual sign of transmission *)
newTransm : INTEGER; (* new value of transmission *)
first, last : activeListPtr; (* pointers to active cells *)
count : CARDINAL; (* number of active cells per system *)
PROCEDURE Connected (c1,c2 : ObjectPtr; VAR conn : ObjectPtr):BOOLEAN;
VAR oldConn : ObjectPtr;
BEGIN
IF Get1stConnection (c1, conn) THEN
REPEAT
oldConn := conn;
IF conn^.ConnectCell = c2 THEN RETURN TRUE END
UNTIL NOT GetNextConnection (oldConn, conn)
END;
RETURN FALSE
END Connected;
PROCEDURE Perceptron (first, last : activeListPtr);
VAR search : ObjectPtr; (* first possible decoded *)
Check : activeListPtr; (* first pointer to ceck cell *)
check : ObjectPtr; (* first check cell *)
conn : ObjectPtr; (* connections of first check cell *)
found : BOOLEAN; (* flag if decoder exists *)
new : ObjectPtr; (* new output cell *)
PROCEDURE Append;
VAR search : ObjectPtr; (* first possible decoded *)
connect: activeListPtr; (* cell to be connected *)
teach : ObjectPtr; (* teacher - cells *)
teachS : ObjectPtr; (* teacher systems *)
teachC : ObjectPtr; (* active teacher connections *)
streng : CARDINAL;
BEGIN
(*******************************************************************************)
(* create new output cell *)
(*******************************************************************************)
search := last^.cell;
WHILE search^.NextCell <> NIL DO search := search^.NextCell END;
CreateDirect (new ,search , search^.Type, search^.Syst);
connect := first;
(* conjunctive Inputs, disjunctive Outputs *)
LOOP
streng := 1000 DIV count;
IF (1000 MOD count) # 0 THEN INC (streng) END;
ConnectDirect (connect^.cell, new, streng);
IF connect = last THEN EXIT ELSE connect:= connect^.next END
END; (* LOOP *)
teachS := FirstTeacher;
WHILE teachS <> NIL DO
IF teachS^.UpSystem = new^.Syst^.UpSystem THEN
teach := teachS^.O;
WHILE teach <> NIL DO
IF teach^.Potential [clock] >= teach^.ThresholdLoc THEN
teachC := teach^.Connection;
WHILE teachC <> NIL DO
ConnectDirect (new, teachC^.ConnectCell, 1000);
teachC := teachC^.NextConnection
END (* WHILE *)
END;
teach := teach^.NextCell
END
END;
teachS := teachS^.TeachLink
END (* WHILE *)
END Append;
BEGIN
(*********************************************************************************)
(* Check if decoder is already realized with this configuration of cells *)
(*********************************************************************************)
search := last^.cell^.NextCell;
IF search = NIL THEN Append
ELSE
REPEAT
found := FALSE; Check := first; check := Check^.cell;
conn := check^.Connection;
LOOP
IF conn = NIL THEN found := FALSE; EXIT END;
IF conn^.ConnectCell = search THEN
IF Check = last THEN found := TRUE; EXIT END;
Check := Check^.next; check := Check^.cell
ELSE
conn := conn^.NextConnection
END
END; (* LOOP *)
IF found THEN search := NIL ELSE search := search^.NextCell END
UNTIL search = NIL;
IF NOT found THEN Append END
END
END Perceptron;
BEGIN
a := FirstActive;
IF a <> NIL THEN (* there are active systems around *)
(* --------------- Perform functions on active systems --------------------------- *)
REPEAT
t := FirstTeacher;
IF (t <> NIL) AND teaching THEN (* relations between active and teacher *)
(* -------------------- visit active cells ----------------------------------- *)
IF digitalActivity > Random (1000) THEN
first := activeCellPtr; last := first;
count := 1;
WHILE (last <> NIL) DO
IF (last^.next # NIL) & NOT last^.isLast &
(last^.next^.cell^.Syst = last^.cell^.Syst) THEN
last := last^.next; INC (count)
ELSE
IF count > 1 THEN Perceptron (first,last) END;
IF last^.isLast THEN
last := NIL
ELSE
last := last^.next; first := last; count := 1
END
END
END; (* WHILE *)
lastActiveCellPtr := NIL
END;
(* ---------------------- New connections ------------------------------------ *)
REPEAT
IF a^.UpSystem = t^.UpSystem THEN
IF Get1stOutputCell (a,aOut) THEN
REPEAT
OldAOut := aOut;
IF Get1stOutputCell (t, tOut) THEN
REPEAT
OldTOut := tOut;
IF Random (1000) < analogActivity THEN
IF Get1stConnection (tOut, tOutConn) THEN
REPEAT
OldTOutConn := tOutConn;
IF Random (1000) < connectionRate THEN
tIn := tOutConn^.ConnectCell;
IF (tIn^.Syst^.UpSystem = t^.UpSystem) OR
(tIn^.Syst = t^.UpSystem) THEN
factor := +1; transmFact := +1;
IF tIn^.Potential [clock] > tIn^.ThresholdLoc THEN
factor := -factor
END;
IF aOut^.Potential [clock] > aOut^.ThresholdLoc THEN
factor := -factor
END;
IF Connected (aOut, tIn, conn) THEN
IF conn^.Transmission < 0 THEN transmFact := -1 END;
newTransm := ABS (conn^.Transmission);
newTransm := (Per1000 (1000-newTransm, transmAmount) * factor +
newTransm) * transmFact;
conn^.Transmission := newTransm;
IF conn^.Relevancy > 0 THEN DEC (conn^.Relevancy) END;
IF (conn^.Relevancy < connectionThreshold) OR
(ABS(newTransm) < transmThreshold) THEN
RemoveConnection (conn)
END
ELSE
ConnectDirect (aOut,tIn,transmAmount*factor)
END
END
END
UNTIL NOT GetNextConnection (OldTOutConn, tOutConn)
END
END;
UNTIL NOT GetNextCell (OldTOut, tOut)
END
UNTIL NOT GetNextCell (OldAOut, aOut)
END
END;
t := t^.TeachLink
UNTIL t = NIL
END;
a := a^.TeachLink
UNTIL a = NIL
END
END Learn;
(*----------------------------------- P H A S E 3 ------------------------------------*)
PROCEDURE Fire (systemPtr : ObjectPtr);
VAR oldCellPtr , newCellPtr : ObjectPtr;
subSystemPtr, nextSystemPtr : ObjectPtr;
connection , newConnection : ObjectPtr;
PROCEDURE FireCell (cellPtr : ObjectPtr);
VAR oldCellPtr : ObjectPtr;
local : INTEGER;
ISens : INTEGER;
count : CARDINAL;
PROCEDURE Signum (x:INTEGER):INTEGER;
BEGIN
IF x >= 0 THEN RETURN 1 ELSE RETURN -1 END
END Signum;
PROCEDURE Trace;
VAR i : CARDINAL;
BEGIN
FOR i := 1 TO ORD(buf [systemPtr^.SystemName])-1 DO
SimpleIO.WriteChar (buf [systemPtr^.SystemName+i])
END;
CASE cellPtr^.IOTyp OF
in : SimpleIO.WriteString (' INPUT ') |
out : SimpleIO.WriteString (' OUTPUT') |
ELSE SimpleIO.WriteString (' NORMAL')
END;
SimpleIO.WriteString (' CELL ');
SimpleIO.WriteCard (count, 5);
SimpleIO.WriteString (' : POTENTIAL := ');
SimpleIO.WriteInt (cellPtr^.Potential [clock], 5);
SimpleIO.WriteLn
END Trace;
PROCEDURE InsertToList (c : ObjectPtr);
VAR new : activeListPtr;
BEGIN
IF activeCellPtr = NIL THEN
ALLOCATE (new, TSIZE (activeList));
activeCellPtr := new; new^.next := NIL
ELSE
IF lastActiveCellPtr = NIL THEN
new := activeCellPtr
ELSE
lastActiveCellPtr^.isLast := FALSE;
IF lastActiveCellPtr^.next = NIL THEN
ALLOCATE (new, TSIZE (activeList));
lastActiveCellPtr^.next := new; new^.next := NIL
ELSE new := lastActiveCellPtr^.next END
END
END;
new^.cell := c; new^.isLast := TRUE; lastActiveCellPtr := new
END InsertToList;
BEGIN
count := 1;
REPEAT
oldCellPtr := cellPtr;
ISens := INTEGER (cellPtr^.Sensitivity);
IF trace THEN Trace END;
(* Spontaneous activity *)
IF cellPtr^.Type^.SpActivity > Random (100) THEN
cellPtr^.Potential [clock] := cellPtr^.ThresholdLoc
END;
(* -------------------- *)
IF (cellPtr^.Potential [clock] >= cellPtr^.ThresholdLoc) OR cellPtr^.Analog THEN
IF (cellPtr^.Potential [clock] >= cellPtr^.ThresholdLoc) AND
(cellPtr^.IOTyp = out) AND (systemPtr^.Teacher = Active) THEN
InsertToList (cellPtr)
END;
IF Get1stConnection (cellPtr, newConnection) THEN
REPEAT
connection := newConnection;
WITH cellPtr^ DO
connection^.ConnectCell^.Potential [invClock] :=
connection^.ConnectCell^.Potential [invClock] +
Per1000 (Per1000 (Type^.FirePotential, connection^.Transmission), INTEGER (Sensitivity));
IF connection^.ConnectCell^.Potential [invClock] > maxPotential THEN
connection^.ConnectCell^.Potential [invClock] := maxPotential
ELSIF connection^.ConnectCell^.Potential [invClock] < -maxPotential THEN
connection^.ConnectCell^.Potential [invClock] := -maxPotential
END;
(* relevancy update *)
IF connection^.Relevancy < maxCard-connectionRelevIncr THEN
INC (connection^.Relevancy,connectionRelevIncr)
END
END (* WITH *)
UNTIL NOT GetNextConnection (connection, newConnection)
END;
cellPtr^.Potential [clock] := lowPotential;
(*****************************************************************************)
(* Manipulate : Transmission - Rate *)
(* ThresholdLoc *)
(* Sensibility *)
(*****************************************************************************)
(* ------------------------ S E N S I B I L I T Y -------------------------- *)
WITH cellPtr^ DO
Sensitivity := CARDINAL(ISens + Signum (ISens-1000) *
Per1000 (SensitivityRange - ABS (ISens-1000), SensitivityFact));
END; (* WITH *)
(*************************** END OF MANIPULATIONS ****************************)
ELSE
(*****************************************************************************)
(* Manipulate : Transmission - Rate in negative sense *)
(* ThresholdLoc in negative sense *)
(* Sensibility in negative sense *)
(*****************************************************************************)
(* ------------------------ S E N S I B I L I T Y -------------------------- *)
WITH cellPtr^ DO
Sensitivity := CARDINAL(ISens - Signum (ISens-1000) *
Per1000 (ABS (ISens-1000), SensitivityFact));
END; (* WITH *)
(*************************** END OF MANIPULATIONS ****************************)
END; (* IF *)
INC (count)
UNTIL NOT GetNextCell (oldCellPtr, cellPtr)
END FireCell;
BEGIN
IF Get1stInputCell (systemPtr, newCellPtr) THEN FireCell (newCellPtr) END;
IF Get1stOutputCell (systemPtr, newCellPtr) THEN FireCell (newCellPtr) END;
IF Get1stNormalCell (systemPtr, newCellPtr) THEN FireCell (newCellPtr) END;
IF GetSubSystem (systemPtr, subSystemPtr ) THEN Fire (subSystemPtr ) END;
IF GetNextSystem (systemPtr, nextSystemPtr) THEN Fire (nextSystemPtr) END
END Fire;
BEGIN
IF Errors = 0 THEN
invClock := (clock+1) MOD 2;
IF GetOutestSystem (objectPtr) THEN
Reset (objectPtr); (* execute phase 1 *)
Learn (objectPtr); (* execute phase 2 *)
Fire (objectPtr); (* execute phase 3 *)
clock := invClock (* execute phase 4 *)
ELSE Error (42) END; InitFlag := FALSE
ELSE Error (43) END;
InputFlag := FALSE
END Tick;
(***************************************************************************************)
(* *)
(* D E C O M P I L E R *)
(* *)
(***************************************************************************************)
PROCEDURE Save (VAR Out : File); (* save structure *)
VAR state : FileState; (* state of output file *)
length : CARDINAL; (* length of strings *)
i : CARDINAL; (* index variable *)
sys, cell: ObjectPtr;
sysNew : ObjectPtr;
sysLevel : CARDINAL; (* recursive level *)
PROCEDURE System (sys : ObjectPtr);
VAR sysNew : ObjectPtr;
type, typeNew : ObjectPtr;
PROCEDURE length (x : CARDINAL):CARDINAL;
BEGIN
IF x < 10 THEN RETURN 2 END;
IF x < 100 THEN RETURN 3 END;
IF x < 1000 THEN RETURN 4 END;
RETURN 6
END length;
PROCEDURE Shift (level : CARDINAL);
BEGIN
WHILE level > 1 DO Text.WriteString (Out, ' ', state); DEC (level) END
END Shift;
PROCEDURE WriteString (str : ARRAY OF CHAR);
BEGIN
Shift (sysLevel); Text.WriteString (Out,str,state)
END WriteString;
PROCEDURE A_is_Father_Of_B (a,b : ObjectPtr):BOOLEAN;
VAR as,aso : ObjectPtr;
BEGIN
IF GetSubSystem (a,as) THEN
REPEAT
aso := as;
IF b = as THEN RETURN TRUE END
UNTIL NOT GetNextSystem (aso,as);
RETURN FALSE
ELSE RETURN FALSE END
END A_is_Father_Of_B;
PROCEDURE CellOut (cell : ObjectPtr; t : IOTypes);
VAR oldCell : ObjectPtr;
counter, from : CARDINAL;
BEGIN
counter := 1; from := 0;
REPEAT
oldCell := cell;
IF cell^.Type <> NIL THEN
IF from = 0 THEN
WriteString ('CREATE ');
CASE t OF
in : Text.WriteString (Out, 'INPUT ' , state) |
out : Text.WriteString (Out, 'OUTPUT ', state) |
ELSE ;
END;
WriteCard (Out, counter,length (counter),state);
END;
IF (cell^.NextCell <> NIL) AND (cell^.Type = cell^.NextCell^.Type) THEN
from := counter
ELSE
IF from <> 0 THEN
Text.WriteString (Out, ' .. ', state);
WriteCard (Out, counter,length (counter),state)
END;
from := 0
END;
IF from = 0 THEN
Text.WriteString (Out, ' : ', state);
FOR i := 1 TO ORD (buf[cell^.Type^.CellName])-1 DO
Text.WriteChar (Out, buf[cell^.Type^.CellName+i], state)
END;
Text.WriteLn (Out, state);
END
END;
INC (counter)
UNTIL NOT GetNextCell (oldCell, cell)
END CellOut;
PROCEDURE NrOfCell (c : ObjectPtr):CARDINAL;
VAR CompareCell : ObjectPtr;
oldCompareCell : ObjectPtr;
count : CARDINAL;
exist : BOOLEAN;
BEGIN
count := 1;
CASE c^.IOTyp OF
in : exist := Get1stInputCell (c^.Syst, CompareCell) |
out : exist := Get1stOutputCell (c^.Syst, CompareCell) |
ELSE exist := Get1stNormalCell (c^.Syst, CompareCell)
END; (* CASE *)
IF exist THEN
REPEAT
oldCompareCell := CompareCell;
IF c = CompareCell THEN RETURN count END;
INC (count)
UNTIL NOT GetNextCell (oldCompareCell, CompareCell)
ELSE Error (48) END;
RETURN 0
END NrOfCell;
PROCEDURE CellConn (cell : ObjectPtr; t : IOTypes);
VAR oldCell : ObjectPtr;
oldConnection : ObjectPtr;
connection : ObjectPtr;
counter : CARDINAL;
otherSyst : ObjectPtr;
BEGIN
counter := 1;
REPEAT
oldCell := cell;
IF (cell^.Type <> NIL) AND Get1stConnection (cell, connection) THEN
REPEAT
oldConnection := connection;
IF cell^.Syst = connection^.ConnectCell^.Syst THEN
(****************************************************)
(* CONNECTION WITHIN SYSTEM *)
(****************************************************)
WriteString ('CONNECT ');
CASE t OF
in : Text.WriteString (Out, 'INPUT ' , state) |
out : Text.WriteString (Out, 'OUTPUT ', state) |
ELSE ;
END;
WriteCard (Out, counter,length (counter) ,state);
Text.WriteString (Out, ' (' , state);
WriteInt (Out, connection^.Transmission ,4,state);
Text.WriteString (Out, ' ) WITH ' , state);
CASE connection^.ConnectCell^.IOTyp OF
in : Text.WriteString (Out, 'INPUT ' , state) |
out : Text.WriteString (Out, 'OUTPUT ', state) |
ELSE ;
END;
WriteCard (Out, NrOfCell (connection^.ConnectCell),6,state);
Text.WriteLn (Out, state)
ELSE
(****************************************************)
(* CONNECTION WITH OTHER SYSTEM *)
(* if the 2nd system isn't actual system then the *)
(* connection must be made later in 1 system above *)
(****************************************************)
IF A_is_Father_Of_B (cell^.Syst,connection^.ConnectCell^.Syst) THEN
(****************************************************)
(* cell is part of system *)
(****************************************************)
WriteString ('CONNECT SYSTEM ');
CASE t OF
in : Text.WriteString (Out, 'INPUT ' , state) |
out : Text.WriteString (Out, 'OUTPUT ', state) |
ELSE ;
END;
WriteCard (Out, counter,length (counter) ,state);
Text.WriteString (Out, ' (' , state);
WriteInt (Out, connection^.Transmission ,4,state);
Text.WriteString (Out, ' ) WITH SYSTEM ' , state);
otherSyst := connection^.ConnectCell^.Syst;
FOR i := 1 TO ORD (buf[otherSyst^.SystemName])-1 DO
Text.WriteChar (Out, buf[otherSyst^.SystemName+i], state)
END;
WriteCard (Out, NrOfCell (connection^.ConnectCell),6,state);
Text.WriteLn (Out, state)
END;
END
UNTIL NOT GetNextConnection (oldConnection, connection)
END;
INC (counter)
UNTIL NOT GetNextCell (oldCell, cell)
END CellConn;
PROCEDURE OtherConn (s : ObjectPtr);
(***********************************************************************************)
(* CHECK IF CELLS IN THIS SYSTEM ARE CONNECTED WITH CELLS OF OTHER SYSTEMS *)
(* WITH HIGHER OR SAME LEVEL *)
(* *)
(* CONSTRUCTS : CONNECT SYSTEM name .... WITH SYSTEM name / IOType *)
(***********************************************************************************)
VAR oldS : ObjectPtr;
cell : ObjectPtr;
PROCEDURE LowCellConn (c : ObjectPtr; t : IOTypes);
VAR connection : ObjectPtr;
oldConnection : ObjectPtr;
oldC : ObjectPtr;
otherSyst : ObjectPtr;
BEGIN
REPEAT
oldC := c;
IF (c^.Type <> NIL) AND Get1stConnection (c, connection) THEN
REPEAT
oldConnection := connection;
IF c^.Syst <> connection^.ConnectCell^.Syst THEN
IF NOT A_is_Father_Of_B (c^.Syst, connection^.ConnectCell^.Syst) THEN
WriteString ('CONNECT SYSTEM ');
FOR i := 1 TO ORD (buf[c^.Syst^.SystemName])-1 DO
Text.WriteChar (Out, buf[c^.Syst^.SystemName+i], state)
END;
WriteCard (Out, NrOfCell (c),6,state);
Text.WriteString (Out, ' (' , state);
WriteInt (Out, connection^.Transmission ,4,state);
Text.WriteString (Out, ' ) WITH SYSTEM ' , state);
(***********************************)
(* a is either son or brother of b *)
(***********************************)
IF c^.Syst^.UpSystem = connection^.ConnectCell^.Syst THEN
(*********************)
(* a is son of b *)
(*********************)
CASE connection^.ConnectCell^.IOTyp OF
in : Text.WriteString (Out, 'INPUT ' , state) |
out : Text.WriteString (Out, 'OUTPUT ', state) |
ELSE ;
END;
ELSE
(*********************)
(* a is brother of b *)
(*********************)
otherSyst := connection^.ConnectCell^.Syst;
FOR i := 1 TO ORD (buf[otherSyst^.SystemName])-1 DO
Text.WriteChar (Out, buf[otherSyst^.SystemName+i], state)
END;
END;
WriteCard (Out, NrOfCell (connection^.ConnectCell),6,state);
Text.WriteLn (Out, state)
END
END
UNTIL NOT GetNextConnection (oldConnection, connection)
END
UNTIL NOT GetNextCell (oldC, c)
END LowCellConn;
BEGIN
REPEAT
oldS := s;
IF Get1stInputCell (s, cell) THEN LowCellConn (cell, in ) END;
IF Get1stOutputCell (s, cell) THEN LowCellConn (cell, out ) END;
IF Get1stNormalCell (s, cell) THEN LowCellConn (cell, normal) END;
UNTIL NOT GetNextSystem (oldS, s)
END OtherConn;
BEGIN
INC (sysLevel);
WriteString ('MODULE ');
FOR i := 1 TO ORD (buf[sys^.SystemName])-1 DO
Text.WriteChar (Out, buf[sys^.SystemName+i], state)
END;
Text.WriteString (Out, ' IS ', state);
CASE sys^.Teacher OF
Active : Text.WriteString (Out, ' ACTIVE', state) |
Passive : Text.WriteString (Out, ' PASSIVE', state) |
Teacher : Text.WriteString (Out, ' TEACHER', state) |
ELSE Text.WriteChar (Out, '?', state)
END; (* CASE *)
Text.WriteLn (Out, state);
IF Get1stType (sys, typeNew) THEN
REPEAT
type := typeNew;
WriteString ('DEFINE ');
FOR i := 1 TO ORD (buf[type^.CellName])-1 DO
Text.WriteChar (Out, buf[type^.CellName+i], state)
END;
Text.WriteString (Out, ' GLOBAL', state);
Text.WriteString (Out, ' FirePotential =', state);
WriteInt (Out, type^.FirePotential,4,state);
Text.WriteString (Out, ' Threshold =', state);
WriteInt (Out, type^.Threshold,4,state);
Text.WriteString (Out, ' SpActivity =', state);
WriteCard (Out, type^.SpActivity,length(type^.SpActivity),state);
Text.WriteString (Out, ' Repolarization =', state);
WriteInt (Out, type^.Repolarization,4,state);
Text.WriteString (Out, ' Analog = ', state);
IF type^.Analog THEN
Text.WriteString (Out, 'TRUE', state)
ELSE
Text.WriteString (Out, 'FALSE', state)
END;
Text.WriteString (Out, ' END', state); Text.WriteLn (Out, state);
UNTIL NOT GetNextType (type, typeNew);
END;
IF Get1stInputCell (sys, cell) THEN CellOut (cell, in ) END;
IF Get1stOutputCell (sys, cell) THEN CellOut (cell, out ) END;
IF Get1stNormalCell (sys, cell) THEN CellOut (cell, normal) END;
IF GetSubSystem (sys, sysNew) THEN System (sysNew) END;
IF Get1stInputCell (sys, cell) THEN CellConn (cell, in ) END;
IF Get1stOutputCell (sys, cell) THEN CellConn (cell, out ) END;
IF Get1stNormalCell (sys, cell) THEN CellConn (cell, normal) END;
IF GetSubSystem (sys, sysNew) THEN OtherConn (sysNew) END;
WriteString ('END'); Text.WriteLn (Out, state); Text.WriteLn (Out, state);
DEC (sysLevel);
IF GetNextSystem (sys, sysNew) THEN System (sysNew) END;
END System;
BEGIN
sysLevel := 0;
IF Errors = 0 THEN
IF GetOutestSystem (sysNew) THEN
REPEAT
sys := sysNew; System (sys)
UNTIL NOT GetNextSystem (sys, sysNew)
ELSE Error (42) END
ELSE Error (43) END
END Save;
PROCEDURE Activity (actA, actD: CARDINAL); (* specify system activity *)
(***************************************************************************************)
(* Range : 0..100 % *)
(* 0 = no system activity (no new connections are created) *)
(* 100 = full system activity *)
(* *)
(* actA : analogous Activity *)
(* actD : digital Activity *)
(* *)
(***************************************************************************************)
BEGIN
IF (actA < 0) OR (actA > 1000) THEN Error (41) ELSE analogActivity := actA END;
IF (actD < 0) OR (actD > 1000) THEN Error (41) ELSE digitalActivity := actD END
END Activity;
(*----------------------------------- M A I N -----------------------------------------*)
BEGIN
analogActivity := 1000; (* full system activity *)
digitalActivity := 1000;
teaching := TRUE; (* teach - function required *)
InputFlag := FALSE; (* no Input was made *)
InitFlag := TRUE; (* system must be initialized *)
activeCellPtr := NIL; (* no members in list *)
lastActiveCellPtr := NIL;
END BrainExec.
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