'Cellputer Interface 232 - Host
'This is a final version 2 for ARM Cellputer
'Compatibility code: 2.4
'28.11.08
'PIII version

$regfile = "89c4051.dat"
$crystal = 18432000
$baud = 4800
$large

'chip sygnatures
'North: 1..30
'East:101..130

Dim Armcfg As Long
Dim Armact As Long
Dim D32 As Long
Dim C20 As Long

Dim D16 As Integer

Dim Finish As Byte
Dim A As Byte
Dim L As Byte
Dim L32 As Byte
Dim D8 As Byte
Dim Iio As Byte
Dim Jio As Byte
Dim I As Byte
Dim J As Byte
Dim Blcfg As Byte
Dim Arms As Byte
Dim Alive As Byte
Dim Indx As Byte

'maksymalna liczba ARMów = 30

Declare Sub Blink2(blcfg As Byte)

Declare Sub Send(l32 As Byte)
Declare Sub Rec(l32 As Byte)

Declare Sub Sendpc

Declare Sub Trans_iter
Declare Sub Trans_results

Declare Sub I_live

Declare Sub Soft_reset

Ledin Alias P3.3                                    'red
Ledout Alias P3.4                                   'yellow
En Alias P3.7                                       'enable pin (input)
Dt Alias P1.0                                       'data pin (input/output)
Ck Alias P1.1                                       'clock pin (output)
Wrk Alias P1.2                                      'work signal to power supply (output)
Pr Alias P1.6                                       'preset pin (output)
Q Alias P1.5                                        'output pin (input)

P1 = 255
P3 = 255

Wait 1

'waiting for buffers initialization
For I = 1 To 4
  Reset Ledin
  Waitms 150
  Set Ledin
  Reset Wrk
  Reset Ledout
  Waitms 150
  Set Ledout
  Set Wrk
Next I

Bitwait En , Set

'1.Checking system configuration
Armcfg = 0
For I = 1 To 30
  A = 0

  'checking Northern buffer
  D32 = I
  Call Send(7)
  Waitms 10
  If En = 0 Then
    Reset En
    Call Rec(7)
    If D32 = I Then
      Incr A
    Else
      Call Blink2(1)
    End If
  End If

  'checking Eastern buffer
  Set En
  Bitwait En , Set
  D32 = I + 100
  Armact = D32
  Call Send(7)
  Waitms 10
  If En = 0 Then
    Reset En
    Call Rec(7)
    If D32 = Armact Then
      Incr A
    Else
      Call Blink2(2)
    End If
  End If

  'North and East Buffers ready
  If A = 2 Then Set Armcfg.i

  Set En
  Bitwait En , Set
Next I

Call I_live

'Command 100 : exit identification procedure
D32 = 100
Call Send(7)

Omt:
'2a.Ready for connection
D16 = 15000
Printbin D16

'2b.Waiting for PC connection signal
Reset Ledin
Inputbin A
Set Ledin
Waitms 100

'Verification of PC signal
If A = 65 Then
  Finish = 0
Else
  If A = 130 Then
    Finish = 1
  Else
    For I = 1 To 30
      Wait 1
      Call I_live
    Next I
    Goto Omt
  End If
End If

If Armcfg = 0 Then
  Printbin 255
  Call Blink2(3)
Else
  Arms = 0
  For I = 1 To 30
    If Armcfg.i = 1 Then Incr Arms
  Next I
  Printbin Arms
End If

Call I_live

'Transmitting data from PC to Buffers

'Command 230: Global Data to ARMs via Northern Buffers
D32 = 230
Call Send(7)
Bitwait En , Reset
Reset En

'3.Waiting for PC start signal
Reset Ledin
Inputbin A
Set Ledin
If A = 50 Then
  nop
Else
  Call Blink2(1)
End If

Call I_live

A = 13

'GLOBAL PARAMETERS -> TO ALL NORTHERN BUFFERS AT ONE TIME

'gam fi c beta wT wR GRadius MigrationP 4x(Xmin,Xmax)
'Gray*256+PopSize ExtCopy*256+MaxIterGA DelExtBad 4x(BLength*256+MarkedLSB)
For I = 1 To 23
  Reset Ledin
  Printbin A
  Inputbin D16
  Set Ledin
  D32 = D16
  Call Send(15)
  Waitms 200
Next I

Call I_live

Set En
Reset Ledout
Bitwait En , Set
Set Ledout

'Command SGN: Local Data to ARMs via Northern Buffers

'LOCAL PARAMETERS -> TO INDIVIDUAL SELECTION

For J = 1 To 30

  Call I_live

  'calling individual buffer
  If Armcfg.j = 1 Then
    D32 = J
    Call Send(7)
    Waitms 10
    Bitwait En , Reset
    Reset En

    'CrossP MutationP Alpha Radius Omega BestChosen
    'TSelect*256+NPointsX Strategy*256+TAdvanced LifeLimit
    'Random numbers table
    For I = 1 To 19
      Reset Ledin
      Printbin A
      Inputbin D16
      Set Ledin
      D32 = D16
      Call Send(15)
      Waitms 200
    Next I
  End If

  Set En
  Bitwait En , Set
Next J

Call I_live

'Command 210: exitting data entry loop in Northern Buffers
D32 = 210
Call Send(7)
Bitwait En , Set

'waiting for CRC data
Call I_live

Waitms 250

'Checking system ready
Armact = 0
For I = 1 To 30
  A = 0
  If Armcfg.i = 1 Then
    'checking Northern buffer
    D32 = I
    Call Send(7)
    Waitms 10
    If En = 0 Then
      Reset En
      Call Rec(7)
      If D32 = I Then Incr A
    End If

    'checking Eastern buffer
    Set En
    Bitwait En , Set
    C20 = I + 100
    D32 = C20
    Call Send(7)
    Waitms 10
    If En = 0 Then
      Reset En
      Call Rec(7)
      If D32 = C20 Then
         Incr A
         Waitms 10
         'CRC data
         Call Rec(31)
         Call Sendpc
      End If
    End If

    'North and East Buffers ready
    If A = 2 Then Set Armact.i

    Set En
    Bitwait En , Set
  End If
Next I

Call I_live

'Command 100: exitting identification loop in all Buffers
D32 = 100
Call Send(7)

If Armcfg = Armact Then
  Printbin Arms
Else
  Call Blink2(5)
End If

Wait 1

'presetting Q
Reset Pr
Waitms 10
Set Pr

'command 20: not active flag
C20 = 0
Reset En

'running
Do
  'PC control wants to kill me?
  If Q = 1 Then
    Alive = 1
  Else
    'really or noise only?
    D16 = 10000
    Printbin D16
    'confirmation...
    Inputbin Alive
    Waitms 10
    If Alive = 1 Then
      'presetting Q
      Reset Pr
      Waitms 10
      Set Pr
    End If
  End If

  'No :)
  If Alive = 1 Then
    Call I_live
    For I = 1 To 30
      If Armact.i = 1 Then
        'synchronization
        Set En
        Waitms 20
        Reset En
        Waitms 10
        'asking Eastern buffers
        D32 = I + 100
        Call Send(7)
        Waitms 10
        'komenda
        Call Rec(7)
        A = D32
        If A < 255 Then
          D32 = I * 256
          D16 = A + D32
          'numer procka * 256 + numer komendy
          Printbin D16
          Waitms 10
          Indx = I
          Select Case A
            Case 10 : Call Trans_iter
            Case 20 : Call Trans_results
            Case Else : Call Soft_reset
          End Select
        End If
      End If                                        'I=1..30
    Next I
  Else
    Armact = 0
  End If                                            'Killed
Loop Until Armact = 0

If Finish = 1 Then Reset Wrk
Do
  Wait 1
Loop

End

'IO routines

Sub I_live
  Reset Wrk
  Waitms 100
  Set Wrk
End Sub

Sub Soft_reset
  Reset En
  For Iio = 1 To 10
    Wait 1
    Call I_live
  Next Iio
End Sub

Sub Blink2(blcfg As Byte)
  Do
    For Iio = 1 To Blcfg Step 1
      Reset Ledout
      Reset Ledin
      Waitms 250
      Set Ledout
      Set Ledin
      Waitms 250
    Next Iio
    Wait 2
  Loop
End Sub

Sub Send(l32 As Byte)
    Reset Ledout
    For Iio = 0 To L32
        Dt = D32.iio
        Waitms 1
        Reset Ck
        Waitms 2
        Set Ck
        Waitms 1
    Next Iio
    Set Ledout
    Set Dt
    Waitms 10
End Sub

Sub Rec(l32 As Byte)
    Reset Ledout
    D32 = 0
    Set Dt
    For Iio = 0 To L32
        Waitms 1
        Reset Ck
        Waitms 2
        D32.iio = Dt
        Set Ck
        Waitms 1
    Next Iio
    Set Ledout
    Waitms 10
End Sub

Sub Sendpc
    Reset Ledin
    Printbin D32
    Set Ledin
End Sub

Sub Trans_iter
    'iteracja
    Call Rec(7)
    Call Sendpc
    'NEWS statistics
    'max i avg fitness
    Waitms 10
    Call Rec(31)
    Call Sendpc
End Sub

Sub Trans_results
    'wyniki 4xL32
    For Jio = 1 To 4
      Call Rec(31)
      Call Sendpc
    Next Jio
    If C20.indx = 0 Then
       Set C20.indx
    Else
       Reset Armact.indx
    End If
End Sub