first working web server example

flash/administra/admflash.spin

@@ -2482,6 +2482,21 @@ DAT
 
   strNVRAMFile byte  "nvram.sav",0                      'contains the 56 bytes of NVRAM, if RTC is not available
 
+PRI lan_txflush | handleidx
+''funktionsgruppe               : lan
+''funktion                      : Warten, bis Sendepuffer geleert ist
+''eingabe                       : -
+''ausgabe                       : -
+''busprotokoll                  : [070][get.handleidx][put.ok]
+''                              : handleidx - lfd. Nr. der Verbindung
+''                              : ok        - Sendepuffer leer (Wert egal)
+
+  handleidx := bus_getchar
+
+  sock.flush(sockhandle[handleidx])
+
+  bus_putchar(TRUE)
+
 PRI lan_start | hiveid, hivestr, strpos, macpos, i, a
 ''funktionsgruppe               : lan
 ''funktion                      : Netzwerk starten
@@ -2586,20 +2601,34 @@ PRI lan_connect | ipaddr, remoteport, handle, handleidx, i
 PRI lan_listen | port, handle, handleidx, i
 ''funktionsgruppe               : lan
 ''funktion                      : Port für eingehende TCP-Verbindung öffnen
+''                                bei bereits bestehendem Socket nur handleidx zurücksenden
 ''eingabe                       : -
 ''ausgabe                       : -
-''busprotokoll                  : [074][sub_getword.port][put.handleidx]
+''busprotokoll                  : [074][get.handleidx][sub_getword.port][put.handleidx]
+''                              : handleidx  - lfd. Nr. der bestehenden Verbindung ($FF wenn neu)
 ''                              : port       - zu öffnende Portnummer
 ''                              : handleidx  - lfd. Nr. der Verbindung (index des kompletten handle)
 
+  handleidx := bus_getchar
   port := sub_getword
 
-    'freien Pufferabschnitt suchen
+  if handleidx <> $FF                         'bestehender (kein neuer) Socket
+    if sock.isValidHandle(sockhandle[handleidx]) 'Socket gültig
+      bus_putchar(handleidx)                     'alten handleidx zurücksenden
+      return
+
   i := 0
-  repeat sock#sNumSockets
+  if handleidx == $FF    'neue Verbindung
-    if bufidx[i] == $FF  '0xFF: nicht zugewiesen
+    repeat sock#sNumSockets
-      quit
+    'freien Pufferabschnitt suchen
-    i++
+      if bufidx[i] == $FF  '0xFF: nicht zugewiesen
+        quit
+      i++
+  else                   'bereits aufgebaute, abgebrochende Verbindung
+    repeat sock#sNumSockets
+      if bufidx[i] == handleidx  'zum Handle gehörender Buffer
+        quit
+      i++
 
   ifnot (handle := sock.listen(port, @bufmain[i*rxlen], rxlen, @buftx[i*txlen], txlen)) == -102
     handleidx := handle.byte[0]         'extract the handle index from the lower 8 bits
@@ -2642,9 +2671,10 @@ PRI lan_close | handleidx, i
   'reservierten Pufferabschnitt freigeben
   i := 0
   repeat sock#sNumSockets
-    if bufidx[i++] == handleidx  '0xFF: nicht zugewiesen
+    if bufidx[i] == handleidx  '0xFF: nicht zugewiesen
-      bufidx[i++] := $FF
+      bufidx[i] := $FF
       quit
+    i++
 
 
 PRI lan_rxtime | handleidx, timeout, t, rxbyte

lib/glob-con.spin

@@ -204,7 +204,8 @@ A_BLT           = %00000000_00000000_00001000_00000000
         a_DCF_GetYear      '77
 
 '       ----------------------------------------------  LAN-FUNKTIONEN
-#81,    a_lanStart                                      'Start Network
+#80,    a_lanTXFlush                                    'Warten, bis Sendepuffer geleert ist
+        a_lanStart                                      'Start Network
         a_lanStop                                       'Stop Network
         a_lanConnect                                    'ausgehende TCP-Verbindung öffnen
         a_lanListen                                     'auf eingehende TCP-Verbindung lauschen

lib/reg-ios.spin

@@ -1036,6 +1036,19 @@ PUB rtcTest: available                                  'Test if RTC Chip is ava
 
 CON ''------------------------------------------------- LAN_FUNKTIONEN
 
+PUB lan_txflush(handleidx)
+''funktionsgruppe               : lan
+''funktion                      : Warten, bis Sendepuffer geleert ist
+''eingabe                       : -
+''ausgabe                       : -
+''busprotokoll                  : [070][put.handleidx][get.ok]
+''                              : handleidx - lfd. Nr. der Verbindung
+''                              : ok        - Sendepuffer leer (Wert egal)
+
+  bus_putchar1(gc#a_lanTXFlush)
+  bus_putchar1(handleidx)
+  bus_getchar1
+
 PUB lanstart                                            'LAN starten
 ''funktionsgruppe               : lan
 ''funktion                      : Netzwerk starten
@@ -1075,16 +1088,18 @@ PUB lan_connect(ipaddr, remoteport): handleidx
   bus_putword1(remoteport)
   handleidx := bus_getchar1
 
-PUB lan_listen(port): handleidx
+PUB lan_listen(oldhandleidx, port): handleidx
 ''funktionsgruppe               : lan
 ''funktion                      : Port für eingehende TCP-Verbindung öffnen
 ''eingabe                       : -
 ''ausgabe                       : -
-''busprotokoll                  : [074][sub_putword.port][get.handleidx]
+''busprotokoll                  : [074][put.handleidx][sub_putword.port][get.handleidx]
-''                              : port       - zu öffnende Portnummer
+''                              : oldhandleidx  - lfd. Nr. der bestehenden Verbindung ($FF wenn neu)
-''                              : handleidx  - lfd. Nr. der Verbindung (index des kompletten handle)
+''                              : port          - zu öffnende Portnummer
+''                              : handleidx     - lfd. Nr. der Verbindung (index des kompletten handle)
 
   bus_putchar1(gc#a_lanListen)
+  bus_putchar1(oldhandleidx)
   bus_putword1(port)
   handleidx := bus_getchar1
 

system/regnatix/websrv.spin

@@ -33,42 +33,262 @@ Notizen         :
 OBJ
         ios: "reg-ios"
         gc : "glob-con"
+        str: "glob-string"
+        num: "glob-numbers"
 
 CON
 
 _CLKMODE     = XTAL1 + PLL16X
 _XINFREQ     = 5_000_000
 
+#define __DEBUG
+
 VAR
 
+  byte    handleidx          'Handle web connection
+
+  byte reqstr[32]            ' request string
+  byte webbuff[128]          ' incoming header buffer
+
+  long cog, random_value
 
 PUB main
 
+  rr_start
+
   ios.start
   ifnot (ios.admgetspec & gc#A_LAN)
-    ios.sddmset(ios#DM_USER)                            'u-marker setzen
+    ios.sddmset(ios#DM_USER)                              'u-marker setzen
-    ios.sddmact(ios#DM_SYSTEM)                          's-marker aktivieren
+    ios.sddmact(ios#DM_SYSTEM)                            's-marker aktivieren
-    ios.admload(string("admnet.adm"))                   'versuche, admnet zu laden
+    ios.admload(string("admnet.adm"))                     'versuche, admnet zu laden
-    ios.sddmact(ios#DM_USER)                            'u-marker aktivieren
+    ios.sddmact(ios#DM_USER)                              'u-marker aktivieren
-    ifnot (ios.admgetspec & gc#A_LAN)                   'wenn Laden fehlgeschlagen
+    ifnot (ios.admgetspec & gc#A_LAN)                     'wenn Laden fehlgeschlagen
       ios.print(@strNoNetwork)
-      ios.stop                                          'Ende
+      ios.stop                                            'Ende
   ios.printnl
 
+  ios.lanstart                                            'LAN-Treiber initialisieren (eigene IP-Adresse usw. setzen)
+  handleidx := $FF
+
+#ifdef __DEBUG
+  ios.print(@strWaitConnection)
+#endif
+  repeat
+    if (handleidx := ios.lan_listen(handleidx,80)) == $FF 'Empfangs-Socket auf Port 80 öffnen
+      ios.print(@strErrorNoSock)
+      quit
+    if ios.lan_isconnected(handleidx)                     'bei bestehender Verbindung...
+#ifdef __DEBUG
+      ios.print(@strConnected)
+#endif
+      if webThread == 0
+        ios.lan_txflush(handleidx)
+      ios.lan_close(handleidx)
+      handleidx := $FF
 
   ios.stop
 
+PRI webThread | i, j, uri, args
+
+  if webReadLine == 0                               ' read the first header, quit if it is empty
+    return 0
+
+  bytemove(@reqstr, @webbuff, 32)                   ' copy the header to a temporary request string for later processing
+
+  ' obtain get arguments
+  if (i := indexOf(@reqstr, string(".cgi?"))) <> -1 ' was the request for a *.cgi script with arguments?
+    args := @reqstr[i + 5]                          ' extract the argument
+    if (j := indexOf(args, string("="))) <> -1      ' find the end of the argument
+      byte[args][j] := 0                            ' string termination
+
+  ' read the rest of the headers
+  repeat until webReadLine == 0                     ' read the rest of the headers, throwing them away
+
+  sendStr(string("HTTP/1.0 200 OK",13,10,13,10))                            ' print the HTTP header
+
+  if indexOf(@reqstr, string("ajax.js")) <> -1                              ' ajax.js
+    sendStr(@ajaxjs)
+  elseif indexOf(@reqstr, string("rand.cgi")) <> -1                         ' rand.cgi
+    sendStr(str.trimCharacters(num.ToStr(long[rr_random_ptr], num#DEC)))
+  elseif indexOf(@reqstr, string("img.bin")) <> -1                          ' img.bin
+    ios.lan_txdata(handleidx, 0, 32768)
+  else
+    ' default page
+    sendStr(string("<html><body><script language=javascript src=ajax.js></script><b>It Works!<br><br>Random Number:</b><div id=a></div><script language=javascript>ajax('rand.cgi', 'a', 10);</script></body></html>"))
+
+  return 0
+
+PRI webReadLine | i, ch
+  repeat i from 0 to 126
+    ch := ios.lan_rxtime(handleidx, 500)
+    if ch == 13
+      ch := ios.lan_rxtime(handleidx, 500)
+    if ch == -1 or ch == 10
+      quit
+    webbuff[i] := ch
+
+  webbuff[i] := 0
+
+  return i
+
+PRI sendStr (strSend) : error
+
+#ifdef __DEBUG
+  ios.print(string(" > "))
+  ios.print(strSend)
+  ios.printnl
+#endif
+  error := ios.lan_txdata(handleidx, strSend, strsize(strSend))
+
+PRI indexOf(haystack, needle) | i, j
+  '' Searches for a 'needle' inside a 'haystack'
+  '' Returns starting index of 'needle' inside 'haystack'
+
+  repeat i from 0 to strsize(haystack) - strsize(needle)
+    repeat j from 0 to strsize(needle) - 1
+      if byte[haystack][i + j] <> byte[needle][j]
+        quit
+    if j == strsize(needle)
+      return i
+
+  return -1
+
+DAT
+{{
+┌───────────────────────────────────────────┬────────────────┬────────────────────────┬───────────────┐
+│ Real Random v1.2                          │ by Chip Gracey │ (C)2007 Parallax, Inc. │ 23 March 2007 │
+├───────────────────────────────────────────┴────────────────┴────────────────────────┴───────────────┤
+│                                                                                                     │
+│ This object generates real random numbers by stimulating and tracking CTR PLL jitter. It requires   │
+│ one cog and at least 20MHz.                                                                         │
+│                                                                                                     │
+├─────────────────────────────────────────────────────────────────────────────────────────────────────┤
+│ Background and Detail:                                                                              │
+│                                                                                                     │
+│ A real random number is impossible to generate within a closed digital system. This is because      │
+│ there are no reliably-random states within such a system at power-up, and after power-up, it        │
+│ behaves deterministically. Random values can only be 'earned' by measuring something outside of the │
+│ digital system.                                                                                     │
+│                                                                                                     │
+│ In your programming, you might have used 'var?' to generate a pseudo-random sequence, but found the │
+│ same pattern playing every time you ran your program. You might have then used 'cnt' to 'randomly'  │
+│ seed the 'var'. As long as you kept downloading to RAM, you saw consistently 'random' results. At   │
+│ some point, you probably downloaded to EEPROM to set your project free. But what happened nearly    │
+│ every time you powered it up? You were probably dismayed to discover the same sequence playing each │
+│ time! The problem was that 'cnt' was always powering-up with the same initial value and you were    │
+│ then sampling it at a constant offset. This can make you wonder, "Where's the end to this madness?  │
+│ And will I ever find true randomness?".                                                             │
+│                                                                                                     │
+│ In order to have real random numbers, either some external random signal must be input, or some     │
+│ analog system must be used to generate random noise which can be measured. We're in luck here,      │
+│ because it turns out that the Propeller does have sufficiently-analog subsystems which can be       │
+│ exploited for this purpose -- each cog's CTR PLLs. These can be exercised internally to good        │
+│ effect, without any I/O activity.                                                                   │
+│                                                                                                     │
+│ This object sets up a cog's CTRA PLL to run at the main clock's frequency. It then uses a pseudo-   │
+│ random sequencer to modulate the PLL's target phase. The PLL responds by speeding up and slowing    │
+│ down in a an endless effort to lock. This results in very unpredictable frequency jitter which is   │
+│ fed back into the sequencer to keep the bit salad tossing. The final output is a truly-random       │
+│ 32-bit unbiased value that is fully updated every ~100us, with new bits rotated in every ~3us. This │
+│ value can be sampled by your application whenever a random number is needed.                        │
+│                                                                                                     │
+├─────────────────────────────────────────────────────────────────────────────────────────────────────┤
+│ Revision History                                                        v1.0 released 21 March 2007 │
+│                                                                                                     │
+│ v1.1  Bias removal has been added to ensure true randomness. Released 22 March 2007.                │
+│ v1.2  Assembly code made more efficient. Documentation improved. Released 23 March 2007.            │
+│                                                                                                     │
+└─────────────────────────────────────────────────────────────────────────────────────────────────────┘
+
+}}
+PUB rr_start : okay
+
+'' Start real random driver - starts a cog
+'' returns false if no cog available
+
+  'Reset driver
+  rr_stop
+
+  'Launch real random cog
+  return cog := cognew(@entry, @random_value) + 1
+
+  'allow 5ms to launch and randomize
+  waitcnt(clkfreq / 200 + cnt)
+
+PUB rr_stop
+
+'' Stop real random driver - frees a cog
+
+  'If already running, stop real random cog
+  if cog
+    cogstop(cog~ -  1)
+
+
+PUB rr_random_ptr : ptr
+
+'' Returns the address of the long which receives the random value
+''
+'' A random bit is rotated into the long every ~3us, resuling in a
+'' new long every ~100us, on average, at 80MHz. You may want to double
+'' these times, though, to be sure that you are getting new bits. The
+'' timing uncertainty comes from the unbiasing algorithm which throws
+'' away identical bit pairs, and only outputs the different ones.
+
+  return @random_value
+
+DAT
+
+' ┌─────────────────────────┐
+' │  Real Random Generator  │
+' └─────────────────────────┘
+
+                        org
+
+entry                   movi    ctra,#%00001_111        'set ctra to internal pll mode, select x16 tap
+                        movi    frqa,#$020              'set frqa to system clock frequency / 16
+                        movi    vcfg,#$040              'set vcfg to discrete output, but without pins
+                        mov     vscl,#70                'set vscl to 70 pixel clocks per waitvid
+
+:twobits                waitvid 0,0                     'wait for next 70-pixel mark ± jitter time
+                        test    phsa,#%10111    wc      'pseudo-randomly sequence phase to induce jitter
+                        rcr     phsa,#1                 '(c holds random bit #1)
+                        add     phsa,cnt                'mix PLL jitter back into phase
+
+                        rcl     par,#1          wz, nr  'transfer c into nz (par shadow register = 0)
+                        wrlong  _random_value,par       'write random value back to spin variable
+
+                        waitvid 0,0                     'wait for next 70-pixel mark ± jitter time
+                        test    phsa,#%10111    wc      'pseudo-randomly sequence phase to induce jitter
+                        rcr     phsa,#1                 '(c holds random bit #2)
+                        add     phsa,cnt                'mix PLL jitter back into phase
+
+        if_z_eq_c       rcl     _random_value,#1        'only allow different bits (removes bias)
+                        jmp     #:twobits               'get next two bits
+
+
+_random_value           res     1
+
+DAT
+ajaxjs  byte  "var ajaxBusy=false;function ajax(a,b,c){if(ajaxBusy){return}ajaxBusy=true;var d;try{d=new XMLHttpRequest()}catch(e){d=new ActiveXObject('Microsoft.XMLHTTP')}var f=function(){if(d.readyState==4){if(b){document.getElementById(b).innerHTML=d.responseText}ajaxBusy=false;if(c>0){setTimeout('ajax(\''+a+'\',\''+b+'\','+c+')',c)}}};d.open('GET',a+'?'+(new Date()).getTime(),true);d.onreadystatechange=f;d.send(null)}"
+        byte  0
+
 DAT ' Locale
 
 #ifdef __LANG_EN
   'locale: english
 
-  strNoNetwork     byte 13,"Administra doesn't provide network functions!",13,"Please load admnet.",13,0
+  strNoNetwork      byte 13,"Administra doesn't provide network functions!",13,"Please load admnet.",13,0
+  strWaitConnection byte "Waiting for client connection...",13,0
+  strConnected      byte "Client connected...",13,0
+  strErrorNoSock    byte "No free socket.",13,0
 
 #else
   'default locale: german
 
-  strNoNetwork     byte 13,"Administra stellt keine Netzwerk-Funktionen zur Verfügung!",13,"Bitte admnet laden.",13,0
+  strNoNetwork      byte 13,"Administra stellt keine Netzwerk-Funktionen zur Verfügung!",13,"Bitte admnet laden.",13,0
+  strWaitConnection byte "Warte auf Client-Verbindung...",13,0
+  strConnected      byte "Client verbunden...",13,0
+  strErrorNoSock    byte "Kein Socket frei...",13,0
 
 #endif