'------------------------------------------------------------------------------------
' WebCat / Ethernut 1.3F   -   Atmega128 and RTL8019AS   -    ARP - UDP - PING - HTML
'------------------------------------------------------------------------------------
'
' SDRVL-card with DS1337
'
'
' january 2007 - Ben Zijlstra - Netherlands - http://members.home.nl/bzijlstra

' history:
'
'02-01-2006 tested it with Bascom-AVR 1.11.81
'05-01-2006 some adaptions of the UDP part
'10-01-2006 extra comments
'23-12-2006 SD-R-V-L card add-on
'
' Lockbits:
' Lockbit 54   : 11
' Lockbit 32   : 11
' Lockbit 10   : 11

' Fusebits:
' Fusebit 7    : 0
' Fusebit 6    : 0
' Fusebit 98   : 11
' Fusebit DCBA : 1111

' Fusebits High
' Fusebits E   : 1
' Fusebits F   : 1 change on the original WebCat = JTAG disabled
' Fusebits G   : 0
' Fusebits H   : 0
' Fusebits I   : 0
' Fusebits KL  : 01
' Fusebits M   : 1

' Fusebits Extended
' Fusebits P   : 1
' Fusebits Q   : 1

'SDRVL-add-on
'Beeper PORTB.4

'SD-card:
'DAT3/CD/CS.1  PORTB.0
'CLK.5 PORTB.1
'CMD/DI/MOSI.2 PORTB.2
'DAT0/DO/MISO.7 PORTB.3

'Video TXD     - 9600,N,8,1

'ARP-request werkt. Wordt toegepast bij het opzoeken van het MAC-address van de gateway

$regfile "m128def.dat"
$crystal = 14745600
$baud = 9600

$waitstate                                                  'XRAM wait state
$xa                                                         'External Access enabled
$default Xram

$hwstack = 256
$swstack = 256
$framesize = 256

'memory map:
'
'$0000-$0FFF Internal Ram Atnmega128
'$1000-$7FFF external SRAM
'$8300-$831F RTL8019as

' In the EEPROM:
'
' 00 = .0 - 0 if LCD present (4 x 20)
' 00 = .1
' 00 = .2
' 00 = .3
' 00 = .4
' 00 = .5
' 00 = .6
' 00 = .7
' 01 = IP-number msb
' 02 = IP-number
' 03 = IP-number
' 04 = IP-number lsb
' 05 = MAC-address
' 06 = MAC-address
' 07 = MAC-address
' 08 = MAC-address
' 09 = MAC-address
' 10 = MAC-address
' 11 = Portnumber
' 12 = Portnumber
' 13 = GW-IP-number msb
' 14 = GW-IP-number
' 15 = GW-IP-number
' 16 = GW-IP-number lsb

' MAC-address of Gateway is fetched everytime the WebCat starts

' 23 = Length URL-refresh string
' 24 = start of URL-refresh string
' .... upto end of URL-refresh string

'SD-Card Connection as following
'MMC    M128/M103
'1      MMC_CS PORTB.0
'2      MOSI PORTB.2
'3      GND
'4      +3.3V
'5      CLOCK PORTB.1
'6      GND
'7      MISO, PORTB.3

' you can vary MMC_CS on HW-SPI and all pins on SOFT-SPI, check settings


Config Lcd = 20 * 4
Config Lcdpin = Pin , Db4 = Portd.4 , Db5 = Portd.5 , Db6 = Portd.6 , Db7 = Portd.7 , E = Portd.3 , Rs = Portd.2       'controleren

Config Int5 = Falling

Config Sda = Portd.1
Config Scl = Portd.0

Config Clock = User

Config Date = Mdy , Separator = -

$lib "AVR-DOS.Lbx"
$lib "MMC.Lbx"                                              ' link driver library

' Bit definiton for FileSystemStatus

Dfilesystemstatusfat Alias 0 : Const Dfilesystemstatusfat = 0       ' 0 = FAT16, 1 = FAT32
Dfilesystemsubdir Alias 1 : Const Dfilesystemsubdir = 1     ' 0 = Root-Directory, 1 = Sub-Directory
Const Dmfilesystemsubdir =(2 ^ Dfilesystemsubdir)           ' not used yet
Const Dmfilesystemdirincluster =(2 ^ Dfilesystemstatusfat + 2 ^ Dfilesystemsubdir)       ' not used yet
Dfatsecondupdate Alias 7 : Const Dfatsecondupdate = 7       ' Bit-position for parameter of

' Bit definitions for FileMode (Similar to DOS File Attribut)
Dreadonly Alias 0 : Const Dreadonly = 0
'Const cpFileReadOnly = &H21             ' Archiv and read-only Bit set
Const Cpfilewrite = &H20                                    ' Archiv Bit set

' Error Codes

' Group Number is upper nibble of Error-Code
' Group 0 (0-15): No Error or File End Information
Const Cpnoerror = 0
Const Cpendoffile = 1

' Group 1 (17-31): File System Init
Const Cpnombr = 17
Const Cpnopbr = 18
Const Cpfilesystemnotsupported = 19
Const Cpsectorsizenotsupported = 20
Const Cpsectorsperclusternotsupported = 21
Const Cpcountofclustersnotsupported = 22

' Group 2 (32-47): FAT - Error
Const Cpnonextcluster = 33
Const Cpnofreecluster = 34
Const Cpclustererror = 35
' Group 3 (49-63): Directory Error
Const Cpnofreedirentry = 49
Const Cpfileexists = 50
Const Cpfiledeletenotallowed = 51
Const Cpsubdirectorynotempty = 52
Const Cpsubdirectoryerror = 53
Const Cpnotasubdirectory = 54
' Group 4 (65-79): File Handle
Const Cpnofreefilenumber = 65
Const Cpfilenotfound = 66
Const Cpfilenumbernotfound = 67
Const Cpfileopennohandle = 68
Const Cpfileopenhandleinuse = 69
Const Cpfileopenshareconflict = 70
Const Cpfileinuse = 71
Const Cpfilereadonly = 72
Const Cpfilenowildcardallowed = 73
Const Cpfilenumberinvalid = 74                              ' Zero is not allowed

' Group 7 (97-127): other errors
Const Cpfilepositionerror = 97
Const Cpfileaccesserror = 98
Const Cpinvalidfileposition = 99
Const Cpfilesizetogreat = 100

Const Cpdrivererrorstart = &HC0

' Range 224 to 255 is reserved for Driver

' Other Constants
' File Open Mode /  stored in File-handle return-value of Fileattr(FN#, [1])
Const Cpfileopeninput = 1                                   ' Read
Const Cpfileopenoutput = 2                                  ' Write sequential
'Const cpFileOpenRandom = 4              ' not in use yet
Const Cpfileopenappend = 8                                  ' Write sequential; first set Pointer to end
Const Cpfileopenbinary = 32                                 ' Read and Write; Pointer can be changed by user

' permission Masks for file access routine regarding to the file open mode
Const Cfilewrite_mode = &B00101010                          ' Binary, Append, Output
Const Cfileread_mode = &B00100001                           ' Binary, Input
Const Cfileseekset_mode = &B00100000                        ' Binary
Const Cfileinputline = &B00100001                           ' Binary, Input
Const Cfileput_mode = &B00100000                            ' Binary
Const Cfileget_mode = &B00100000                            ' Binary

' Directory attributs in FAT16/32
Const Cpfileopenallowed = &B00100001                        ' Read Only and Archiv may be set
Const Cpfiledeleteallowed = &B00100000
Const Cpfilesearchallowed = &B00111101                      ' Do no search hidden Files
' Bit 0 = Read Only
' Bit 1 = Hidden
' Bit 2 = System
' Bit 3 = Volume ID
' Bit 4 = Directory
' Bit 5 = Archiv
' Long File name has Bit 0+1+2+3 set
                                                             ' Update second FAT in gbFileSystemStatus

' Bit Definitions for BufferStatus (FAT, DIR, File)

Deof Alias 1 : Const Deof = 1 : Const Dmeof =(2 ^ Deof)
Deofinsector Alias 2 : Const Deofinsector = 2 : Const Dmeofinsector =(2 ^ Deofinsector)
Dwritepending Alias 3 : Const Dwritepending = 3 : Const Dmwritepending =(2 ^ Dwritepending)
Dfatsector Alias 4 : Const Dfatsector = 4 : Const Dmfatsector =(2 ^ Dfatsector)       ' For Writing Sector back (FATNumber times)
Dfileempty Alias 5 : Const Dfileempty = 5 : Const Dmfileempty =(2 ^ Dfileempty)

' New feature for reduce saving
Dfatdirwritepending Alias 6 : Const Dfatdirwritepending = 6 : Const Dmfatdirwritepending =(2 ^ Dfatdirwritepending)
Dfatdirsaveatend Alias 7 : Const Dfatdirsaveatend = 7 : Const Dmfatdirsaveatend =(2 ^ Dfatdirsaveatend)
Dfatdirsaveanyway Alias 0 : Const Dfatdirsaveanyway = 0 : Const Dmfatdirsaveanyway =(2 ^ Dfatdirsaveanyway)

Declare Sub Write_rtl8019as(byval Regaddr As Byte , Byval Regdata As Byte)
Declare Sub Read_rtl8019as(byval Regaddr As Byte)
Declare Sub Init_rtl8019as
Declare Sub Getpacket
Declare Sub Overrun
Declare Sub Arp
Declare Sub Icmp
Declare Sub Udp_receive
Declare Sub Udp_send
Declare Sub Write_dest_mac
Declare Sub Setipaddrs
Declare Sub Icmp_checksum
Declare Sub Echopacket
Declare Sub Packetshape
Declare Sub Ip_header_checksum
Declare Sub General_part_checksum(byval Val1 As Byte , Byval Val2 As Word)
Declare Sub Udp_checksum
Declare Sub Tcp
Declare Sub Http
Declare Sub Tcp_checksum
Declare Sub Send_tcp_packet
Declare Sub Setup_packet
Declare Sub Assemble_ack
Declare Sub Tcpseqtomyseq
Declare Sub Configure
Declare Sub Default_message
Declare Sub Read_ip
Declare Sub Print_ip
Declare Sub Read_mac
Declare Sub Print_mac
Declare Sub Arp_request
Declare Sub Arp_reply
Declare Sub Print_gwip
Declare Sub Read_gwip

'AVR-DOS
Declare Sub Avr_dos
Declare Sub Docommand()
Declare Sub Extracttoken()
Declare Function Getnexttokenstr(byval Pblen_max As Byte ) As String
Declare Function Getnexttokenlong(byval Plmin As Long , Byval Plmax As Long ) As Long
Declare Sub Printparametererrorl(plparamlow As Long , Plparamhigh As Long)
Declare Sub Printparametercounterror(byval Psparm_anzahl As String)
Declare Sub Getinput(byval Pbbyte As Byte)
Declare Sub Printprompt()
Declare Function Getlongfrombuffer(pbsramarray As Byte , Byval Pbpos As Word) As Long
Declare Function Getwordfrombuffer(pbsramarray As Byte , Byval Pbpos As Word) As Word
Declare Sub Sramdump(pwsrampointer As Word , Byval Pwlength As Word , Plbase As Long)
Declare Sub Eramdump(pwerampointer As Word , Byval Pwlength As Word )
Declare Sub Printdoserror()
Declare Sub Directory(pstr1 As String)
Declare Sub Directory1(pstr1 As String , Pdays As Word)
Declare Sub Delete(pstr1 As String)
Declare Function Printfile(psname As String) As Byte
Declare Function Dumpfile(psname As String) As Byte
Declare Sub Printfileinfo(pbfilenr As Byte)
Declare Sub Printdriveerror()
Declare Sub Printdirinfo()
Declare Sub Printfatinfo()
Declare Sub Printfilesysteminfo()
Declare Sub Typewildcard(pstr1 As String)

'RTC and I2c
Declare Sub Sync_ds1337
Declare Sub Sync_avrdos
Declare Sub Ntp
Declare Sub Getdatetime
Declare Sub Setdate
Declare Sub Settime
Declare Sub Show_i2c

' ========== Start of user definable range =====================================

' you can use HW-SPI of the AVR (recommended) or a driver build in Soft-SPI, if
' the HW-SPI of the AVR is occupied by an other SPI-Device with different settings

' Declare here you SPI-Mode
' using HW-SPI:     cMMC_Soft = 0
' not using HW_SPI: cMMC_Soft = 1

Const Cmmc_soft = 0

#if Cmmc_soft = 0

' --------- Start of Section for HW-SPI ----------------------------------------

   ' define Chip-Select Pin
   Config Pinb.0 = Output                                   ' define here Pin for CS of MMC/SD Card
   Mmc_cs Alias Portb.0
   Set Mmc_cs

   ' Define here SS Pin of HW-SPI of the CPU (f.e. Pinb.0 on M128)
   ' If an other Pin than SS is used for MMC_SS, SS must be set to OUTPUT and high for proper work of SPI
   ' otherwise AVR starts SPI-SLAVE if SS-Pin is INPUT and goes to LOW
   Config Pinb.0 = Output                                   ' define here Pin of SPI SS
   Spi_ss Alias Portb.0
   Set Spi_ss                                               ' Set SPI-SS to Output and High por Proper work of
                                                            ' SPI as Master

   ' HW-SPI is configured to highest Speed
   Config Spi = Hard , Interrupt = Off , Data Order = Msb , Master = Yes , Polarity = High , Phase = 1 , Clockrate = 4 , Noss = 1
'   Spsr = 1                                       ' Double speed on ATMega128
   Spiinit                                                  ' Init SPI

' --------- End of Section for HW-SPI ------------------------------------------

#else                                                       ' Config here SPI pins, if not using HW SPI

' --------- Start of Section for Soft-SPI --------------------------------------

   ' Chip Select Pin  => Pin 1 of MMC/SD
   Config Pinb.0 = Output
   Mmc_cs Alias Portb.0
   Set Mmc_cs

   ' MOSI - Pin  => Pin 2 of MMC/SD
   Config Pinb.2 = Output
   Set Pinb.2
   Mmc_portmosi Alias Portb
   Bmmc_mosi Alias 2

   ' MISO - Pin  => Pin 7 of MMC/SD
   Config Pinb.3 = Input
   Mmc_portmiso Alias Pinb
   Bmmc_miso Alias 3

   ' SCK - Pin  => Pin 1 of MMC/SD
   Config Pinb.1 = Output
   Set Pinb.1
   Mmc_portsck Alias Portb
   Bmmc_sck Alias 1

' --------- End of Section for Soft-SPI ----------------------------------------

#endif

Waitms 1                                                    ' Wait some time before initialising MMC/SD

Const Debug = 0                                             ' put 1 for debug, 0 for no debug
Const Msg_initfail = "Init failed"
Const Dcrval = &H58
Const Txstart = &H40
Const Rxstart = &H46
Const Rxstop = &H60
Const Imrval = &H11
Const Tcrval = &H00

'IP protocol types
'icmp
Const Prot_icmp = &H01
'tcp
Const Prot_tcp = &H06
'udp
Const Prot_udp = &H11

Const Synflag = 0
Const Finflag = 1

'NIC_CR page 0/1/2/3 (ps1=x, ps0=x) x = depending on page
'
Const Nic_cr = &H00
'
Const Nic_cr_stp = &B0000_0001                              'stop command - Power up default
Const Nic_cr_sta = &B0000_0010                              'start command
Const Nic_cr_txp = &B0000_0100                              'transmit a packet
Const Nic_cr_rd0 = &B0000_1000                              'remote read
Const Nic_cr_rd1 = &B0001_0000                              'remote write
Const Nic_cr_rd2 = &B0010_0000                              'abort/complete remote DMA
Const Nic_cr_ps0 = &B0100_0000                              'register page 0
Const Nic_cr_ps1 = &B1000_0000                              'register page 1

Const Nic_rdmaport = &H10                                   'all pages
Const Nic_rstport = &H18                                    'all pages

'NIC_PSTART page 0 (ps1=0, ps0=0)
'
Const Nic_pstart = &H01
'

'NIC_PSTOP page 0 (ps1=0, ps0=0)
'
Const Nic_pstop = &H02
'

'NIC_BNRY page 0 (ps1=0, ps0=0)
'
Const Nic_bnry = &H03
'

'NIC_TPSR page 0 (ps1=0, ps0=0)
'
Const Nic_tpsr = &H04
'

'NIC_TBCR0 page 0 (ps1=0, ps0=0)
'
Const Nic_tbcr0 = &H05
'

'NIC_TBCR1 page 0 (ps1=0, ps0=0)
'
Const Nic_tbcr1 = &H06
'

'NIC_ISR page 0 (ps1=0, ps0=0)
'
Const Nic_isr = &H07
'
Const Nic_rdc = &B0100_0000


'NIC_RSAR0 page 0 (ps1=0, ps0=0)
'
Const Nic_rsar0 = &H08
'

'NIC_RSAR1 page 0 (ps1=0, ps0=0)
'
Const Nic_rsar1 = &H09
'

'NIC_rbcr0 page 0 (ps1=0, ps0=0)
'
Const Nic_rbcr0 = &H0A
'

'NIC_rbcr0 page 0 (ps1=0, ps0=0)
'
Const Nic_rbcr1 = &H0B
'

'NIC_rcr page 0 (ps1=0, ps0=0) receive configuration register
'
Const Nic_rcr = &H0C
'

'NIC_tcr page 0 (ps1=0, ps0=0) transmit configuration register
'
Const Nic_tcr = &H0D
'

'NIC_DCR page 0 (ps1=0, ps0=0)
'
Const Nic_dcr = &H0E
'

'NIC_IMR page 0 (ps1=0, ps0=0) interrupt mask register
'
Const Nic_imr = &H0F
'


'NIC_CURR page 1 (ps1=0, ps0=1)
'
Const Nic_curr = &H07
'

'NIC_9346CR page 3 (ps1=1, ps0=1)
'
Const Nic_9346cr = &H01
'
Const Nic_9346cr_eem1 = &B1000_0000
Const Nic_9346cr_eem0 = &B0100_0000
Const Nic_config2_bselb = &B0010_0000


'NIC_CONFIG2 page 3 (ps1=1, ps0=1)
'
Const Nic_config2 = &H05


'NIC_CONFIG3 page 3 (ps1=1, ps0=1)
'
Const Nic_config3 = &H06

'SD/MMC
Const Cperrdrivereset = 225                                 ' Error response Byte at Reset command
Const Cperrdriveinit = 226                                  ' Error response Byte at Init Command
Const Cperrdrivereadcommand = 227                           ' Error response Byte at Read Command
Const Cperrdrivewritecommand = 228                          ' Error response Byte at Write Command
Const Cperrdrivereadresponse = 229                          ' No Data response Byte from MMC at Read
Const Cperrdrivewriteresponse = 230                         ' No Data response Byte from MMC at Write
Const Cperrdrive = 231
Const Cperrdrivenotsupported = 232                          ' return code for DriveGetIdentity, not supported yet

' Constants and variables for File System Interpreter (Shell)
Const Cpno = 0                                              '
Const Cpyes = 1
Const Cptoken_max = 10                                      ' Count of Tokens in USER-Input
Const Cpstrsep = ","                                        ' Blank: Separator between tokens
Const Cpcinput_len = 80                                     ' max. length of user-Input

' Config File-System for Version 5.5:

' === User Settings ============================================================

' Count of file-handles, each file-handle needs 524 Bytes of SRAM
Const Cfilehandles = 2                                      ' [default = 2]

' Handling of FAT-Buffer in SRAM:
' 0 = FAT- and DIR-Buffer is handled in one SRAM buffer with 561 bytes
' 1 = FAT- and DIR-Buffer is handled in separate SRAM buffers with 1078 bytes
' Parameter 1 increased speed of file-handling
Const Csepfathandle = 1                                     ' [default = 1]

' Handling of pending FAT and Directory information of open files
' 0 = FAT and Directory Information is updated every time a data sector of the file is updated
' 1 = FAT and Directory Information is only updated at FLUSH and SAVE command
' Parameter 1 increases writing speed of data significantly
Const Cfatdirsaveatend = 1                                  ' [default = 1]


' Surrounding String with Quotation Marks at the Command WRITE
' 0 = No Surrounding of strings with quotation.marks
' 1 = Surrounding of strings with quotation.marks (f.E. "Text")
Const Ctextquotationmarks = 1                               ' [default = 1]


' Write second FAT. Windows accepts a not updated second FAT
' PC-Command: chkdsk /f corrects the second FAT, it overwrites the
' second FAT with the first FAT
' set this parameter to 0 for high speed continuing saving data
' 0 = Second FAT is not updated
' 1 = Second FAT is updated if exist
Const Cfatsecondupdate = 1                                  ' [default = 1]


' Character to separate ASCII Values in WRITE - statement (and INPUT)
' Normally a comma (,) is used. but it can be changed to other values, f.E.
' to TAB (ASCII-Code 9) if EXCEL Files with Tab separated values should be
' written or read. This parameter works for WRITE and INPUT
' Parameter value is the ASSCII-Code of the separator
' 44 = comma [default]
' 9 = TAB                                                  ' [default = 44]
Const Cvariableseparator = 44
' File Handle Block
Const Co_filenumber = 0
Const Co_filemode = 1
Const Co_filedirentry = 2 : Const Co_filedirentry_2 = 3
Const Co_filedirsectornumber = 4
Const Co_filefirstcluster = 8
Const Co_filesize = 12
Const Co_fileposition = 16
Const Co_filesectornumber = 20
Const Co_filebufferstatus = 24
Const Co_filebuffer = 25
Const C_filehandlesize = Co_filebuffer + 513                ' incl. one Additional Byte for 00 as string terminator
                                                             ' for direct text reading from File-buffer
Const C_filehandlesize_m = 65536 - C_filehandlesize         ' for use with add immediate word with subi, sbci
                                                             ' = minus c_FileHandleSize in Word-Format

Const C_filehandlessize = C_filehandlesize * Cfilehandles

 'address of ds1347
 Const Ds1337w = &HD0                                       ' Addresses of Ds1337 clock
 Const Ds1337r = &HD1


Dim Regaddr As Byte
Dim Regdata As Byte
'Ethernet header layout
Dim Byte_read As Byte
Dim Whulp0 As Word
Dim Hulp1 As Byte
Dim Hulp2 As Word
Dim Hulp3 As Word
Dim Hulp4 As Byte
Dim Mymac(6) As Byte
Dim Gwmac(6) As Byte
Dim Data_l As Byte
Dim Data_h As Byte
Dim Bhulp0 As Byte
Dim I As Integer
Dim T As Byte
Dim Txlen As Word
Dim I_header_length As Word
Dim I_odd As Byte
Dim I_chksum32 As Long

Dim Rxlen As Word
Dim Val1 As Byte
Dim Val2 As Word                                            ' up to 65535 characters
Dim Val3 As Byte
Dim Val4 As Byte
Dim I_x As Word
Dim I_checksum16 As Word

Dim Tempstring As String * 20
Dim Dsp_present As Byte
Dim Idletime As Long
Dim Resend As Byte

Dim Tcp_fin As Sram Bit
Dim Tcp_syn As Sram Bit
Dim Tcp_rst As Sram Bit
Dim Tcp_psh As Sram Bit
Dim Tcp_ack As Sram Bit
Dim Tcp_urg As Sram Bit
Dim Tcpdatalen_in As Word
Dim Tcpdatalen_out As Word
Dim Ip_packet_len As Word
Dim Flags As Byte
Dim Msg_temp As String * 55
Dim Y As Word
Dim Tempstring1 As String * 1
Dim Expected_ack As Long

Dim Mymacs(6) As String * 3
Dim Ippart(4) As String * 4

'variables with overlays
Dim Myip(4) As Byte
Dim My_ip As Long At Myip Overlay

Dim Pageheader(4) As Byte
Dim T_enetpacketlenl As Byte At Pageheader + 2 Overlay
Dim T_enetpacketlenh As Byte At Pageheader + 3 Overlay

Dim Result16 As Word
Dim Result16h As Byte At Result16 + 1 Overlay
Dim Result16l As Byte At Result16 Overlay

Dim Hulp5 As Word
Dim Hulp5h As Byte At Hulp5 + 1 Overlay
Dim Hulp5l As Byte At Hulp5 Overlay

Dim Hulp6 As Word
Dim Hulp6h As Byte At Hulp6 + 1 Overlay
Dim Hulp6l As Byte At Hulp6 Overlay

Dim I_value16 As Word
Dim I_value16h As Byte At I_value16 + 1 Overlay
Dim I_value16l As Byte At I_value16 Overlay

'ARP-request
Dim Gwip(4) As Byte
Dim Arpreqip As Long At Gwip Overlay

'for NTP-routine
Dim S(4) As Byte
Dim L1 As Long At S Overlay                                 ' Overlay a long variable to receive-string
' with overlay you need no transfer from the byte-array to a long-variable
Dim L2 As Long

Dim Packet(1500) As Byte
'Ethernet packet destination
Dim T_enetpacketdest0 As Byte At Packet Overlay
Dim T_enetpacketdest1 As Byte At Packet + &H01 Overlay
Dim T_enetpacketdest2 As Byte At Packet + &H02 Overlay
Dim T_enetpacketdest3 As Byte At Packet + &H03 Overlay
Dim T_enetpacketdest4 As Byte At Packet + &H04 Overlay
Dim T_enetpacketdest5 As Byte At Packet + &H05 Overlay
'Ethernet packet source
Dim T_enetpacketsrc0 As Byte At Packet + &H06 Overlay
Dim T_enetpacketsrc1 As Byte At Packet + &H07 Overlay
Dim T_enetpacketsrc2 As Byte At Packet + &H08 Overlay
Dim T_enetpacketsrc3 As Byte At Packet + &H09 Overlay
Dim T_enetpacketsrc4 As Byte At Packet + &H0A Overlay
Dim T_enetpacketsrc5 As Byte At Packet + &H0B Overlay
'Ethernet packet type
Dim T_enetpackettype As Word At Packet + &H0C Overlay
Dim T_arp_hwtype1 As Byte At Packet + &H0F Overlay
'Arp
Dim T_arp_prttype1 As Byte At Packet + &H11 Overlay
Dim T_arp_hwlen As Byte At Packet + &H12 Overlay
Dim T_arp_prlen As Byte At Packet + &H13 Overlay
Dim T_arp_op1 As Byte At Packet + &H15 Overlay
'arp source ip address
Dim T_arp_sipaddr0 As Byte At Packet + &H1C Overlay
Dim T_arp_sipaddr1 As Byte At Packet + &H1D Overlay
Dim T_arp_sipaddr2 As Byte At Packet + &H1E Overlay
Dim T_arp_sipaddr3 As Byte At Packet + &H1F Overlay
'arp target IP address
Dim T_arp_tipaddr As Long At Packet + &H26 Overlay
'IP header layout IP version and header length
Dim T_ip_vers_len As Byte At Packet + &H0E Overlay

Dim T_arp_hwtype0 As Byte At Packet + &H0E Overlay
'Arp
Dim T_arp_prttype0 As Byte At Packet + &H10 Overlay
Dim T_arp_op0 As Byte At Packet + &H14 Overlay
'arp source mac address
Dim T_arp_src_enetpacket0 As Byte At Packet + &H16 Overlay
Dim T_arp_src_enetpacket1 As Byte At Packet + &H17 Overlay
Dim T_arp_src_enetpacket2 As Byte At Packet + &H18 Overlay
Dim T_arp_src_enetpacket3 As Byte At Packet + &H19 Overlay
Dim T_arp_src_enetpacket4 As Byte At Packet + &H1A Overlay
Dim T_arp_src_enetpacket5 As Byte At Packet + &H1B Overlay
'arp source mac address
Dim T_arp_dest_enetpacket0 As Byte At Packet + &H20 Overlay
Dim T_arp_dest_enetpacket1 As Byte At Packet + &H21 Overlay
Dim T_arp_dest_enetpacket2 As Byte At Packet + &H22 Overlay
Dim T_arp_dest_enetpacket3 As Byte At Packet + &H23 Overlay
Dim T_arp_dest_enetpacket4 As Byte At Packet + &H24 Overlay
Dim T_arp_dest_enetpacket5 As Byte At Packet + &H25 Overlay
Dim T_tos As Byte At Packet + &H0F Overlay
'packet length
Dim T_ip_pktlen0 As Byte At Packet + &H10 Overlay
Dim T_ip_pktlen1 As Byte At Packet + &H11 Overlay

Dim T_id0 As Byte At Packet + &H12 Overlay
Dim T_id1 As Byte At Packet + &H13 Overlay
Dim T_flags As Byte At Packet + &H14 Overlay
Dim T_offset As Byte At Packet + &H15 Overlay
Dim T_ttl As Byte At Packet + &H16 Overlay

'protocol (ICMP=1, TCP=6, UDP=11)
Dim T_ip_proto As Byte At Packet + &H17 Overlay

'header checksum
Dim T_ip_hdr_cksum0 As Byte At Packet + &H18 Overlay
Dim T_ip_hdr_cksum1 As Byte At Packet + &H19 Overlay
Dim T_ip_hdr_cksum As Word At Packet + &H18 Overlay
'IP address of source
Dim T_ip_srcaddr0 As Byte At Packet + &H1A Overlay
Dim T_ip_srcaddr1 As Byte At Packet + &H1B Overlay
Dim T_ip_srcaddr2 As Byte At Packet + &H1C Overlay
Dim T_ip_srcaddr3 As Byte At Packet + &H1D Overlay

Dim T_ip_srcaddr As Long At Packet + &H1A Overlay

'IP address of destination
Dim T_ip_destaddr0 As Byte At Packet + &H1E Overlay
Dim T_ip_destaddr1 As Byte At Packet + &H1F Overlay
Dim T_ip_destaddr2 As Byte At Packet + &H20 Overlay
Dim T_ip_destaddr3 As Byte At Packet + &H21 Overlay

Dim T_ip_destaddr As Long At Packet + &H1E Overlay

Dim T_icmp_type As Byte At Packet + &H22 Overlay
Dim T_icmp_code As Byte At Packet + &H23 Overlay
Dim T_icmp_cksum0 As Byte At Packet + &H24 Overlay
Dim T_icmp_cksum1 As Byte At Packet + &H25 Overlay
Dim T_icmp_cksum As Word At Packet + &H24 Overlay

Dim Tcp_srcporth As Byte At Packet + &H22 Overlay
Dim Tcp_srcportl As Byte At Packet + &H23 Overlay

Dim Tcp_destporth As Byte At Packet + &H24 Overlay
Dim Tcp_destportl As Byte At Packet + &H25 Overlay

Dim Tcp_seqnum3 As Byte At Packet + &H26 Overlay
Dim Tcp_seqnum2 As Byte At Packet + &H27 Overlay
Dim Tcp_seqnum1 As Byte At Packet + &H28 Overlay
Dim Tcp_seqnum0 As Byte At Packet + &H29 Overlay

Dim Tcp_acknum3 As Byte At Packet + &H2A Overlay
Dim Tcp_acknum2 As Byte At Packet + &H2B Overlay
Dim Tcp_acknum1 As Byte At Packet + &H2C Overlay
Dim Tcp_acknum0 As Byte At Packet + &H2D Overlay

Dim Tcp_hdr As Byte At Packet + &H2E Overlay
Dim Tcp_flags As Byte At Packet + &H2F Overlay
Dim Tcp_cksumh As Byte At Packet + &H32 Overlay
Dim Tcp_cksuml As Byte At Packet + &H33 Overlay
Dim Tcp_cksum As Word At Packet + &H32 Overlay
'UDP header
Dim T_udp_srcport0 As Byte At Packet + &H22 Overlay
Dim T_udp_srcport1 As Byte At Packet + &H23 Overlay

Dim T_udp_srcport As Word At Packet + &H22 Overlay

Dim T_udp_destport0 As Byte At Packet + &H24 Overlay
Dim T_udp_destport1 As Byte At Packet + &H25 Overlay

Dim T_udp_destport As Word At Packet + &H24 Overlay

Dim T_udp_len0 As Byte At Packet + &H26 Overlay
Dim T_udp_len1 As Byte At Packet + &H27 Overlay
Dim T_udp_chksum0 As Byte At Packet + &H28 Overlay
Dim T_udp_chksum1 As Byte At Packet + &H29 Overlay
Dim T_udp_data As Byte At Packet + &H2A Overlay

Dim T_udp_data1 As Byte At Packet + &H2B Overlay
Dim T_udp_data2 As Byte At Packet + &H2C Overlay
Dim T_udp_data3 As Byte At Packet + &H2D Overlay
Dim T_udp_data4 As Byte At Packet + &H2E Overlay
Dim T_udp_data5 As Byte At Packet + &H2F Overlay
Dim T_udp_data6 As Byte At Packet + &H30 Overlay
Dim T_udp_data7 As Byte At Packet + &H31 Overlay
Dim T_udp_data8 As Byte At Packet + &H32 Overlay
Dim T_udp_data9 As Byte At Packet + &H33 Overlay
Dim T_udp_data10 As Byte At Packet + &H34 Overlay
Dim T_udp_data11 As Byte At Packet + &H35 Overlay
Dim T_udp_data12 As Byte At Packet + &H36 Overlay
Dim T_udp_data13 As Byte At Packet + &H37 Overlay
Dim T_udp_data14 As Byte At Packet + &H38 Overlay
Dim T_udp_data15 As Byte At Packet + &H39 Overlay
Dim T_udp_data16 As Byte At Packet + &H3A Overlay
Dim T_udp_data17 As Byte At Packet + &H3B Overlay
Dim T_udp_data18 As Byte At Packet + &H3C Overlay
Dim T_udp_data19 As Byte At Packet + &H3D Overlay
Dim T_udp_data20 As Byte At Packet + &H3E Overlay
Dim T_udp_data21 As Byte At Packet + &H3F Overlay
Dim T_udp_data22 As Byte At Packet + &H40 Overlay
Dim T_udp_data23 As Byte At Packet + &H41 Overlay
Dim T_udp_data24 As Byte At Packet + &H42 Overlay
Dim T_udp_data25 As Byte At Packet + &H43 Overlay
Dim T_udp_data26 As Byte At Packet + &H44 Overlay
Dim T_udp_data27 As Byte At Packet + &H45 Overlay
Dim T_udp_data28 As Byte At Packet + &H46 Overlay
Dim T_udp_data29 As Byte At Packet + &H47 Overlay
Dim T_udp_data30 As Byte At Packet + &H48 Overlay
Dim T_udp_data31 As Byte At Packet + &H49 Overlay
Dim T_udp_data32 As Byte At Packet + &H4A Overlay


Dim Client_seqnum As Long
Dim Client_seqnum0 As Byte At Client_seqnum Overlay
Dim Client_seqnum1 As Byte At Client_seqnum + 1 Overlay
Dim Client_seqnum2 As Byte At Client_seqnum + 2 Overlay
Dim Client_seqnum3 As Byte At Client_seqnum + 3 Overlay

Dim Incoming_ack As Long
Dim Incoming_ack0 As Byte At Incoming_ack Overlay
Dim Incoming_ack1 As Byte At Incoming_ack + 1 Overlay
Dim Incoming_ack2 As Byte At Incoming_ack + 2 Overlay
Dim Incoming_ack3 As Byte At Incoming_ack + 3 Overlay

Dim My_seqnum As Long
Dim My_seqnum0 As Byte At My_seqnum Overlay
Dim My_seqnum1 As Byte At My_seqnum + 1 Overlay
Dim My_seqnum2 As Byte At My_seqnum + 2 Overlay
Dim My_seqnum3 As Byte At My_seqnum + 3 Overlay

'
Dim Tempword As Word
Dim Tempwordh As Byte At Tempword + 1 Overlay
Dim Tempwordl As Byte At Tempword Overlay

'AVR-DOS
Dim Transferbuffer_write As Word
Dim Erampointer As Word
Dim Abinterpreterbuffer(512) As Byte
Dim Gstestline As String * 100
'Dim Gstestline64 As String * 64 At Gstestline Overlay
Dim Gstoken As String * 100
Dim Gspcinput As String * 100                               ' holds user-input
Dim Gbposstrparts(cptoken_max) As Byte                      ' for analysing user-input
Dim Gblenstrparts(cptoken_max) As Byte                      '
Dim Gbcnttoken As Byte                                      ' found tokens in user-input
Dim Gbtoken_actual As Byte                                  ' actual handled token of user-input
Dim Gbpcinputerror As Byte                                  ' holds error-code during analysing user-input
Dim Gbpcinputpointer As Byte                                ' string-pointer during user-input
Dim Gldumpbase As Long
Dim Gwtemp1 As Word
'Dim Gbtemp1 As Byte
Dim Gword1 As Word
Dim Bsec As Byte , Bmin As Byte , Bhour As Byte , Bday As Byte , Bmonth As Byte , Byear As Byte
Dim Gbinp As Byte                                           ' holds user input
Dim Gbdriveerror As Byte                                    ' General Driver Error register
Dim Gbdriveerrorreg As Byte                                 ' Driver load Error-Register of HD in case of error
Dim Gbdrivestatusreg As Byte                                ' Driver load Status-Register of HD on case of error
Dim Gbdrivedebug As Byte

' === Variables for AVR-DOS ====================================================

' FileSystem Basis Informationen
'Dim Gldrivesectors As Long
Dim Gbdoserror As Byte

' Master Boot Record
Dim Gbfilesystem As Byte
' Partition Boot Record
Dim Gbfilesystemstatus As Byte
Dim Glfatfirstsector As Long
Dim Gbnumberoffats As Byte
Dim Glsectorsperfat As Long
Dim Glrootfirstsector As Long
Dim Gwrootentries As Word
Dim Gldatafirstsector As Long
Dim Gbsectorspercluster As Byte
Dim Glmaxclusternumber As Long
Dim Gllastsearchedcluster As Long
' Additional info
Dim Glfs_temp1 As Long
' Block für Directory Handling
Dim Gldirfirstsectornumber As Long
Dim Gwfreedirentry As Word
Dim Glfreedirsectornumber As Long
Dim Gsdir0tempfilename As String * 11
Dim Gwdir0entry As Word                                     ' Keep together with next, otherwise change _DIR
Dim Gldir0sectornumber As Long
Dim Gstempfilename As String * 11
Dim Gwdirentry As Word
Dim Gldirsectornumber As Long
Dim Gbdirbufferstatus As Byte
Dim Gbdirbuffer(512) As Byte
Dim Berrorcode As Byte
Const C_filesystemsramsize1 = 594
#if Csepfathandle = 1
    Dim Glfatsectornumber As Long
    Dim Gbfatbufferstatus As Byte
    Dim Gbfatbuffer(512) As Byte
    Const C_filesystemsramsize2 = 517
#else
     Const C_filesystemsramsize2 = 0
#endif

Dim Abfilehandles(c_filehandlessize) As Byte
'Dim Lastdosmem As Byte
$external _mmc
Gbdriveerror = Driveinit()                                  ' Init MMC/SD Card

Const C_filesystemsramsize = C_filesystemsramsize1 + C_filesystemsramsize2 + C_filehandlessize
Const Dmeofall =(2 ^ Deof + 2 ^ Deofinsector)
Const Dmeof_empty =(2 ^ Deof + 2 ^ Deofinsector + 2 ^ Dfileempty)


Const Cp_fatbufferinitstatus =(2 ^ Dfatsector)
Const Cp_dirbufferinitstatus = 0


#if Cfatdirsaveatend = 1
Const Cp_filebufferinitstatus =(2 ^ Dfatdirsaveatend)
#else
Const Cp_filebufferinitstatus = 0
#endif



#if Cfatsecondupdate = 0
   Const Cp_fatsecondupdate =(2 ^ Dfatsecondupdate)
#else
   Const Cp_fatsecondupdate = 0
#endif

Dim Datestr As String * 8
Dim Timestr As String * 8
Dim Syear As String * 2
Dim Smonth As String * 2
Dim Sday As String * 2
Dim Shour As String * 2
Dim Sminute As String * 2
Dim Ssecond As String * 2

Dim Ff As Byte
Dim Conf As Byte

Open "com1:9600,8,N,1" For Random As #1

'Main

Dim W1 As Word
W1 = W1 / W1                                                ' force compiler to implement _div16

'Beeper off
Config Portb.4 = Output
Set Portb.4

Readeeprom Hulp1 , 0                                        ' Should I put something on the LCD?
If Hulp1.0 = 0 Then
   Dsp_present = 0
   Cursor Off
   Cls
   Lcd "www.achatz.nl WebCat"
   Wait 2
   Thirdline
   Lcd "Press a key for"
   Fourthline
   Lcd "configuration"
 Else
   Dsp_present = 1
End If
Call Configure

Call Default_message
Call Init_rtl8019as


Enable Interrupts
Enable Int5
On Int5 Rtl8019as_interrupt
'start the NIC

Bhulp0 = Nic_cr_rd2 Or Nic_cr_sta
Call Write_rtl8019as(nic_cr , Bhulp0)

Idletime = 0
Call Arp_request                                            'for the UDP-send routine MAC-address of Gateway
Print "Gateway MAC-address: ";
Print Hex(gwmac(1)) ; "-" ; Hex(gwmac(2)) ; "-" ; Hex(gwmac(3)) ; "-" ; Hex(gwmac(4)) ; "-" ; Hex(gwmac(5)) ; "-" ; Hex(gwmac(6))
Print

T_udp_data = Asc( "X")
T_udp_data1 = &H0A                                          ' lf
T_udp_data2 = &H0D                                          ' cr
'padding
T_udp_data3 = &H00
T_udp_data4 = &H00
T_udp_data5 = &H00
T_udp_data6 = &H00
T_udp_data7 = &H00
T_udp_data8 = &H00
T_udp_data9 = &H00
T_udp_data10 = &H00
T_udp_data11 = &H00
T_udp_data12 = &H00
T_udp_data13 = &H00
T_udp_data14 = &H00
T_udp_data15 = &H00
T_udp_data16 = &H00
T_udp_data17 = &H00
T_udp_data18 = &H00
T_udp_data19 = &H00
T_udp_data20 = &H00
T_udp_data21 = &H00
T_udp_data22 = &H00
Call Udp_send
Wait 2

Call Avr_dos

Do
If Dsp_present = 0 Then
      'idle-time
      Incr Idletime
      If Idletime > 900000 Then
            Disable Int5
            Cursor Off
            Cls
            Lcd "www.achatz.nl WebCat"
            Thirdline
            Lcd "Idle"
            Enable Int5
            Idletime = 0
      End If
End If
Loop
End


' Routine to handle an interrupt on the RTL8019AS
'
Rtl8019as_interrupt:
   #if Debug = 1
      Print "Interrupt from RTL8019as"
   #endif
   Disable Int5
   'read the interrupt status register
   Call Read_rtl8019as(nic_isr)
   'if the receive buffer has been overrun
   'page 0 - ISR OVW (OVR - receive buffer has been exhausted)
   If Byte_read.4 = 1 Then
      Call Overrun
   End If
   'if the receive buffer holds a good packet
   'page 0 - ISR PRX (PRX - received the packet with no errors)
   If Byte_read.0 = 1 Then
      Call Getpacket
   End If
   'make sure the receive buffer ring is empty. If BNRY = CURR, the buffer is empty
   Call Read_rtl8019as(nic_bnry)
   Data_l = Byte_read

   Bhulp0 = Nic_cr_ps0 Or Nic_cr_rd2
   Bhulp0 = Bhulp0 Or Nic_cr_sta
   'switch to page 1
   Call Write_rtl8019as(nic_cr , Bhulp0)

   Call Read_rtl8019as(nic_curr)
   Data_h = Byte_read

   Bhulp0 = Nic_cr_rd2 Or Nic_cr_sta
   Call Write_rtl8019as(nic_cr , Bhulp0)

   'buffer is not empty, get next packet
   If Data_l <> Data_h Then
      Call Getpacket
   End If

   'reset the interrupts bits
   Call Write_rtl8019as(nic_isr , &HFF)

   Bhulp0 = Nic_cr_rd2 Or Nic_cr_sta
   Call Write_rtl8019as(nic_cr , Bhulp0)
   Enable Int5
Return


' Routine to Write to NIC Control register
'
Sub Write_rtl8019as(regaddr , Regdata)
   Whulp0 = Regaddr + &H8300
   Out Whulp0 , Regdata
End Sub


' Routine to read from NIC Control register
'
Sub Read_rtl8019as(regaddr)
   Whulp0 = Regaddr + &H8300
   Byte_read = Inp(whulp0)
End Sub


' Routine to initialise the RTL8019AS ethernetchip
'
Sub Init_rtl8019as
#if Debug = 1
   Print "Sub Init_RTL8019as"
#endif
Call Read_rtl8019as(nic_rstport)
Call Write_rtl8019as(nic_rstport , Byte_read)
Waitms 10
'check for good soft reset
Call Write_rtl8019as(nic_imr , 0)                           'interrupt mask register
Call Write_rtl8019as(nic_isr , &HFF)
Call Read_rtl8019as(nic_isr)
'page 0 RST
If Byte_read.7 = 0 Then
      Print Msg_initfail
End If

'switch to page 3
Bhulp0 = Nic_cr_rd2 Or Nic_cr_stp
Bhulp0 = Bhulp0 Or Nic_cr_ps0
Bhulp0 = Bhulp0 Or Nic_cr_ps1
Call Write_rtl8019as(nic_cr , Bhulp0)

Bhulp0 = Nic_9346cr_eem0 Or Nic_9346cr_eem1
Call Write_rtl8019as(nic_9346cr , Bhulp0)

Call Write_rtl8019as(nic_config3 , 0)

Call Write_rtl8019as(nic_config2 , Nic_config2_bselb)

Call Write_rtl8019as(nic_9346cr , 0)
Waitms 255

Bhulp0 = Nic_cr_rd2 Or Nic_cr_stp
Call Write_rtl8019as(nic_cr , Bhulp0)
Waitms 2
Call Write_rtl8019as(nic_dcr , Dcrval)                      '58
Call Write_rtl8019as(nic_rbcr0 , &H00)
Call Write_rtl8019as(nic_rbcr1 , &H00)

'0000_0100 packets with broadcast destination address are accepted
Call Write_rtl8019as(nic_rcr , &H04)                        'receive configuration register

Call Write_rtl8019as(nic_tpsr , Txstart)                    '&H40

'0000_0010 internal loopback
Call Write_rtl8019as(nic_tcr , &H02)                        'transmit configuration register

Call Write_rtl8019as(nic_pstart , Rxstart)                  '&H46
Call Write_rtl8019as(nic_bnry , Rxstart)                    '&H46
Call Write_rtl8019as(nic_pstop , Rxstop)
Call Write_rtl8019as(nic_isr , &HFF)

Call Write_rtl8019as(nic_cr , &H61)
Waitms 2
Call Write_rtl8019as(nic_curr , Rxstart)                    '&H46
For Hulp1 = 1 To 6
     Call Write_rtl8019as(hulp1 , Mymac(hulp1))
Next Hulp1

Call Write_rtl8019as(nic_cr , &H21)
Call Write_rtl8019as(nic_dcr , Dcrval)                      '58
Call Write_rtl8019as(nic_cr , &H22)
Call Write_rtl8019as(nic_isr , &HFF)

Call Write_rtl8019as(nic_imr , Imrval)                      'interrupt mask register / 0001_0001

Call Write_rtl8019as(nic_tcr , Tcrval)                      'transmit configuration register / 0000_0000

Bhulp0 = Nic_cr_sta Or Nic_cr_rd2
Call Write_rtl8019as(nic_cr , Bhulp0)

End Sub


' Routine to handle an overrun
'
Sub Overrun
   #if Debug = 1
      Print "Sub Overrun"
   #endif
   Call Read_rtl8019as(nic_cr)
   Data_l = Byte_read
   Call Write_rtl8019as(nic_cr , &H21)
   Waitms 2
   Call Write_rtl8019as(nic_rbcr0 , &H00)
   Call Write_rtl8019as(nic_rbcr1 , &H00)
   Hulp1 = Data_l And &H04
   If Hulp1 <> 0 Then
      Resend = 0
      Else
         If Hulp1 = 0 Then
            Call Read_rtl8019as(nic_isr)
            Data_l = Byte_read
            Hulp1 = Data_l And &H02
            Hulp4 = Data_l And &H08
            Hulp3 = Hulp1 Or Hulp4
               If Hulp3 > 0 Then
                  Resend = 0
                  Else
                  Resend = 1
               End If
         End If
   End If
   Call Write_rtl8019as(nic_tcr , &H02)                     'transmit configuration register

   Bhulp0 = Nic_cr_rd2 Or Nic_cr_sta
   Call Write_rtl8019as(nic_cr , Bhulp0)

   Call Write_rtl8019as(nic_bnry , Rxstart)                 '&H46
   Bhulp0 = Nic_cr_ps0 Or Nic_cr_rd2
   Bhulp0 = Bhulp0 Or Nic_cr_sta
   Call Write_rtl8019as(nic_cr , Bhulp0)

   Call Write_rtl8019as(nic_curr , Rxstart)                 '&H46

   Bhulp0 = Nic_cr_rd2 Or Nic_cr_sta
   Call Write_rtl8019as(nic_cr , Bhulp0)

   '0001_0000 OVW
   Call Write_rtl8019as(nic_isr , &H10)

   Call Write_rtl8019as(nic_tcr , Tcrval)                   'transmit configuration register / 0000_0000
End Sub


' Routine to execute send packet command to retrieve the packet
'
Sub Getpacket
   #if Debug = 1
      Print "Sub Getpacket"
   #endif
   Call Write_rtl8019as(nic_cr , &H1A)
   For I = 0 To 4
      Call Read_rtl8019as(nic_rdmaport)
      Pageheader(i + 1) = Byte_read
   Next I
   'watch it. overlay variables
   Result16h = T_enetpacketlenh
   Result16l = T_enetpacketlenl
   Rxlen = Result16
   Hulp2 = Rxlen + 1
   For I = 1 To Hulp2
      Call Read_rtl8019as(nic_rdmaport)
      'dump any bytes that will overrun the receive buffer
      If I < 1500 Then
         Packet(i + 1) = Byte_read
      End If
   Next I
   Hulp1 = Byte_read And Nic_rdc
   If Hulp1 <> 64 Then
      Call Read_rtl8019as(nic_isr)
   End If

   Call Write_rtl8019as(nic_isr , &HFF)


      ' Routine to process an ARP reply/request
   '
   If T_enetpackettype = &H0608 Then
      If T_arp_hwtype1 = &H01 Then
         If T_arp_prttype1 = &H00 Then
            If T_arp_hwlen = &H06 Then
               If T_arp_prlen = &H04 Then
                  If My_ip = T_arp_tipaddr Then
                     If T_arp_op1 = &H02 Then
                        Call Arp_reply
                     End If
                     If T_arp_op1 = &H01 Then
                        Call Arp
                     End If
                  End If
               End If
            End If
         End If
      End If
   End If


   ' Routine to go ahead with icmp or udp
   '
   If T_enetpackettype = &H0008 Then
         If T_ip_destaddr = My_ip Then
            Select Case T_ip_proto
               Case Prot_icmp : Call Icmp
               Case Prot_tcp : Call Tcp
               Case Prot_udp : Call Udp_receive
            End Select
         End If
   End If

End Sub


' Routine to handle ARP-traffic
'
Sub Arp
   #if Debug = 1
      Print "Sub Arp"
   #endif
   'Start the NIC
   Call Write_rtl8019as(nic_cr , &H22)
   'load beginning page for transmit buffer
   Call Write_rtl8019as(nic_tpsr , Txstart)                 '&H40
   'set start address for remote DMA operation
   Call Write_rtl8019as(nic_rsar0 , &H00)
   Call Write_rtl8019as(nic_rsar1 , &H40)
   'clear the interrupts
   Call Write_rtl8019as(nic_isr , &HFF)
   'load data byte count for remote DMA
   Call Write_rtl8019as(nic_rbcr0 , &H3C)                   '60 dec
   Call Write_rtl8019as(nic_rbcr1 , &H00)
   'do remote write operation
   Call Write_rtl8019as(nic_cr , &H12)
   'write destination MAC address
   Call Write_dest_mac
   'write source address
   For I = 1 To 6
       Call Write_rtl8019as(nic_rdmaport , Mymac(i))
   Next I
   'arp target IP address
   'arp_op1 = packet(&h16)
   Packet(&H16) = &H02
   For I = 1 To 10
      Hulp1 = &H0C + I
      T = Packet(hulp1)
      Call Write_rtl8019as(nic_rdmaport , T)
   Next I
   'write ethernet module mac address
   For I = 1 To 6
      Call Write_rtl8019as(nic_rdmaport , Mymac(i))
   Next I
   'write myip
   For I = 1 To 4
      Call Write_rtl8019as(nic_rdmaport , Myip(i))
   Next I
   'write remote mac address
   Call Write_dest_mac
   'write remote IP address
   Call Write_rtl8019as(nic_rdmaport , T_arp_sipaddr0)
   Call Write_rtl8019as(nic_rdmaport , T_arp_sipaddr1)
   Call Write_rtl8019as(nic_rdmaport , T_arp_sipaddr2)
   Call Write_rtl8019as(nic_rdmaport , T_arp_sipaddr3)
  'write som pad characters to fill out the packet to the minimum length
   For I = 0 To &H11
      Call Write_rtl8019as(nic_rdmaport , &H00)
   Next I
   'make sure the DMA operation has succesfully completed
   Byte_read = 0
   Do
      Hulp1 = Byte_read And Nic_rdc
      Call Read_rtl8019as(nic_isr)
   Loop Until Hulp1 = 0
   'load numbers of bytes to be transmitted
   Call Write_rtl8019as(nic_tbcr0 , &H3C)
   Call Write_rtl8019as(nic_tbcr1 , &H00)
   'send the contents of the transmit buffer onto the network
   Call Write_rtl8019as(nic_cr , &H24)
End Sub


' helper-routine
'
Sub Write_dest_mac
   #if Debug = 1
      Print "Sub Write_dest_mac"
   #endif
   Call Write_rtl8019as(nic_rdmaport , T_enetpacketsrc0)
   Call Write_rtl8019as(nic_rdmaport , T_enetpacketsrc1)
   Call Write_rtl8019as(nic_rdmaport , T_enetpacketsrc2)
   Call Write_rtl8019as(nic_rdmaport , T_enetpacketsrc3)
   Call Write_rtl8019as(nic_rdmaport , T_enetpacketsrc4)
   Call Write_rtl8019as(nic_rdmaport , T_enetpacketsrc5)
End Sub


' PING-routine
'
Sub Icmp
#if Debug = 1
   Print "Sub Icmp"
#endif
If Dsp_present = 0 Then
   Cls
   Lcd "PING"
   Idletime = 0
End If
 'set echo reply
T_icmp_type = &H00
T_icmp_code = &H00
'setup the IP-header
Call Setipaddrs
Call Icmp_checksum
Call Echopacket
End Sub


' Routine to handle the source/destination address
'
Sub Setipaddrs
#if Debug = 1
   Print "Sub Setipaddrs"
#endif
T_ip_destaddr = T_ip_srcaddr
'make ethernet module IP address source address
T_ip_srcaddr = My_ip
Call Packetshape
Call Ip_header_checksum
End Sub


' Routine to echo a complete packet
'
Sub Echopacket
#if Debug = 1
   Print "Sub Echopacket"
#endif
Call Write_rtl8019as(nic_cr , &H22)
Call Write_rtl8019as(nic_tpsr , Txstart)                    '&H40
Call Write_rtl8019as(nic_rsar0 , &H00)
Call Write_rtl8019as(nic_rsar1 , &H40)
Call Write_rtl8019as(nic_isr , &HFF)
Hulp1 = T_enetpacketlenl - 4
Call Write_rtl8019as(nic_rbcr0 , Hulp1)
Call Write_rtl8019as(nic_rbcr1 , T_enetpacketlenh)
Call Write_rtl8019as(nic_cr , &H12)
Result16h = T_enetpacketlenh
Result16l = T_enetpacketlenl
Result16 = Result16 - 4
Txlen = Result16
'write the complete packet to the RTL8019AS from packet(1) to packet(txlen+1)
Hulp2 = Txlen + 1
For I = 1 To Hulp2
Call Write_rtl8019as(nic_rdmaport , Packet(i))
Next I
Byte_read = 0
While Hulp1 <> 0
Hulp1 = Byte_read And Nic_rdc
Call Read_rtl8019as(nic_isr)
Wend
Hulp1 = T_enetpacketlenl - 4
Call Write_rtl8019as(nic_tbcr0 , Hulp1)
Call Write_rtl8019as(nic_tbcr1 , T_enetpacketlenh)
Call Write_rtl8019as(nic_cr , &H24)
End Sub


' Routine to calculate a ICMP-checksum
'
Sub Icmp_checksum
   #if Debug = 1
      Print "Sub Icmp_checksum"
   #endif
   'clear the ICMP checksum
   T_icmp_cksum = &H00
   'calculate the ICMP checksum
   I_header_length = T_ip_pktlen1 - 20
   'I_header_length = I_header_length - 20
   I_odd = I_header_length Mod 2
   '14 for MAC-part
   '20 for IP-header
   'start on 35
   'ip_pktlen = 00 3c (60)
   'icmp-packetlengte = ip_pktlen - ip_header
   I_chksum32 = 0
   'Total packetlength - ip_header - 1
   Hulp6h = T_ip_pktlen0
   Hulp6l = T_ip_pktlen1
   Val1 = 35
   Val2 = Hulp6 + 13
   Call General_part_checksum(val1 , Val2)
   T_icmp_cksum0 = Val3
   T_icmp_cksum1 = Val4
End Sub


' helper-routine
'
Sub Packetshape
#if Debug = 1
   Print "Sub Packetshape"
#endif
'move hardware source address to destination address
T_enetpacketdest0 = T_enetpacketsrc0
T_enetpacketdest1 = T_enetpacketsrc1
T_enetpacketdest2 = T_enetpacketsrc2
T_enetpacketdest3 = T_enetpacketsrc3
T_enetpacketdest4 = T_enetpacketsrc4
T_enetpacketdest5 = T_enetpacketsrc5
' 'Make ethernet module mac address the source address
T_enetpacketsrc0 = Mymac(1)
T_enetpacketsrc1 = Mymac(2)
T_enetpacketsrc2 = Mymac(3)
T_enetpacketsrc3 = Mymac(4)
T_enetpacketsrc4 = Mymac(5)
T_enetpacketsrc5 = Mymac(6)
End Sub


' Routine to calculate a IP-header checksum
'
Sub Ip_header_checksum
   #if Debug = 1
      Print "Sub IP_header_checksum"
   #endif
   Local Ip_x As Byte
   Local Ip_hulp1 As Byte
   Local Ip_chksum32 As Long
   Local Ip_checksum16 As Word
   Local Ip_temp16 As Word
   Local Ip_header_length As Byte
   'calculate the IP header checksum
   T_ip_hdr_cksum = &H00
'   Hdr_chksum = 0
   I_chksum32 = 0
   Ip_header_length = T_ip_vers_len And &H0F
   Ip_header_length = 4 * Ip_header_length

   I_chksum32 = 0
   I_odd = 0

   Val1 = 15
   Val2 = &H0E + Ip_header_length
   Call General_part_checksum(val1 , Val2)
   T_ip_hdr_cksum0 = Val3
   T_ip_hdr_cksum1 = Val4
End Sub


' Overall routine for checksum
'
Sub General_part_checksum(byval Val1 As Byte , Byval Val2 As Word)
   #if Debug = 1
      Print "Sub General_part_checksum"
   #endif
   For I_x = Val1 To Val2 Step 2
      I_value16h = Packet(i_x)
      Hulp3 = I_x + 1
      I_value16l = Packet(hulp3)
      I_chksum32 = I_chksum32 + I_value16
   Next I_x
   If I_odd = 1 Then
      Incr Val2
      I_value16h = Packet(val2)
      I_value16l = 0
      I_chksum32 = I_chksum32 + I_value16
   End If
   I_checksum16 = Highw(i_chksum32)
   I_checksum16 = I_checksum16 + I_chksum32                 ' only 16 lower bits of i_chksum32 is taken...
   I_checksum16 = Not I_checksum16
   Val3 = High(i_checksum16)
   Val4 = Low(i_checksum16)
End Sub


' Routine to handle UDP-traffic
'
Sub Udp_receive
#if Debug = 1
   Print "Sub Udp_receive"
#endif
Local Udp_port As Word
Local Udp_porth As Byte
Local Udp_portl As Byte
Readeeprom Udp_porth , 11
Readeeprom Udp_portl , 12
Udp_port = Udp_porth
Shift Udp_port , Left , 8
Udp_port = Udp_port + Udp_portl

'From within a VB-program
If T_udp_destport = Udp_port Then
       If T_udp_srcport = &H2500 Then                       ' &h0025 NTP protocol
         Call Ntp
         Exit Sub
      End If
      Cursor On
      Select Case T_udp_data
            Case &H00 : Cls
            Case &H01 : Home
            Case &H02 : Lowerline
            Case &H03 : Thirdline
            Case &H04 : Fourthline
            Case Else : Lcd Chr(t_udp_data)
      End Select
      Idletime = 0
      Call Write_rtl8019as(nic_cr , &H22)
      Exit Sub
End If
'echo on PORT 7
If T_udp_destport = &H0700 Then
          If Dsp_present = 0 Then
               Cls
               Lcd "UDP request"
               Idletime = 0
          End If

         'Build The Ip Header
         Call Setipaddrs
         'swap the UDP source and destinations port
         Swap T_udp_srcport0 , T_udp_destport0
         Swap T_udp_srcport1 , T_udp_destport1
         Call Udp_checksum
         Call Write_rtl8019as(nic_cr , &H22)
         Call Echopacket
End If
End Sub


' Routine to calculate the Udp-checksum
'
Sub Udp_checksum
   #if Debug = 1
      Print "Sub Udp_checksum"
   #endif
   T_udp_chksum0 = &H00
   T_udp_chksum1 = &H00
   'checksum TCP header
   I_chksum32 = 0
   I_value16h = T_ip_srcaddr0
   I_value16l = T_ip_srcaddr1
   I_chksum32 = I_chksum32 + I_value16
   I_value16h = T_ip_srcaddr2
   I_value16l = T_ip_srcaddr3
   I_chksum32 = I_chksum32 + I_value16
   I_value16h = T_ip_destaddr0
      I_value16l = T_ip_destaddr1
   I_chksum32 = I_chksum32 + I_value16
   I_value16h = T_ip_destaddr2
   I_value16l = T_ip_destaddr3
   I_chksum32 = I_chksum32 + I_value16
   'proto
   I_chksum32 = I_chksum32 + T_ip_proto
   'packet length
   I_value16h = T_udp_len0
   I_value16l = T_udp_len1
   I_chksum32 = I_chksum32 + I_value16
   I_odd = T_udp_len1 Mod 2
   Result16h = T_udp_len0
   Result16l = T_udp_len1
   'udp_srcport0 = packet(&h23)
   Val1 = &H23
   Val2 = &H23 + Result16
   Val2 = Val2 - 2
   Call General_part_checksum(val1 , Val2)
   T_udp_chksum0 = Val3
   T_udp_chksum1 = Val4
End Sub


' TCP
'
Sub Tcp
#if Debug = 1
   Print "Sub Tcp"
#endif
Local Work As Byte
Work = Tcp_flags
Tcp_fin = Work.0
Tcp_syn = Work.1
Tcp_rst = Work.2
Tcp_psh = Work.3
Tcp_ack = Work.4
Tcp_urg = Work.5

If Tcp_destporth = 0 Then
   Select Case Tcp_destportl
      Case 80 : Call Http
   End Select
End If

End Sub

Sub Http
#if Debug = 1
   Print "HTTP"
   Print
   Print "Destination port low  " ; Tcp_destportl
   Print "Destination port high " ; Tcp_destporth
   Print
   Print "TCPdatalen_in         " ; Tcpdatalen_in
   Print
   Print "Flags:"
   Print "FIN " ; Tcp_fin
   Print "SYN " ; Tcp_syn
   Print "RST " ; Tcp_rst
   Print "PSH " ; Tcp_psh
   Print "ACK " ; Tcp_ack
   Print "URG " ; Tcp_urg
   Print
   Print "Incoming:"
   Print "Tcp_seqnum3 " ; Hex(tcp_seqnum3)
   Print "Tcp_seqnum2 " ; Hex(tcp_seqnum2)
   Print "Tcp_seqnum1 " ; Hex(tcp_seqnum1)
   Print "Tcp_seqnum0 " ; Hex(tcp_seqnum0)
   Print
   Print "Tcp_acknum3 " ; Hex(tcp_acknum3)
   Print "Tcp_acknum2 " ; Hex(tcp_acknum2)
   Print "Tcp_acknum1 " ; Hex(tcp_acknum1)
   Print "Tcp_acknum0 " ; Hex(tcp_acknum0)
#endif
Local Msg_temp2 As String * 10
Local Tempword3 As Word
'Local Z As Word
'Local Ztemp As Word
'Local Tempstring2 As String * 5
Local Templong1 As Long

Result16h = T_ip_pktlen0
Result16l = T_ip_pktlen1
'
' calculate IP header length
' MSN is version (IPv4)
' LSN is length
Hulp1 = T_ip_vers_len And &H0F
Hulp1 = Hulp1 * 4
' calculate TCP header length
' MSN is length / 4
Hulp2 = Tcp_hdr And &HF0
Shift Hulp2 , Right , 4
Hulp2 = Hulp2 * 4
Tcpdatalen_in = Result16 - Hulp1
Tcpdatalen_in = Tcpdatalen_in - Hulp2
   ' If an ACK is received and the destination port address is valid
   ' and no data is in the packet
If Tcp_ack = 1 Then
         If Tcpdatalen_in = 0 Then
            Incoming_ack0 = Tcp_acknum0
            Incoming_ack1 = Tcp_acknum1
            Incoming_ack2 = Tcp_acknum2
            Incoming_ack3 = Tcp_acknum3
            If Flags.synflag = 1 Then
               Reset Flags.synflag
               My_seqnum = Incoming_ack
                 Tempword3 = &H37
                 If Dsp_present = 0 Then
                     Cls
                     Lcd "HTTP request"
                      Idletime = 0
                 End If

                 Ff = Freefile()                            ' get file handle
                 Open "index.htm" For Input As #ff          ' we can use a constant for the file too
                 #if Debug = 1
                     Print Lof(#ff) ; " length of file"
                     Print Fileattr(#ff) ; " file mode"     ' should be 1 for input
                 #endif
                 Do
                  Line Input #ff , Msg_temp                 ' read a line
                   ' line input is used to read a line of text from a file
                   #if Debug = 1
                       Print Msg_temp                       ' print on terminal emulator
                   #endif
                    Msg_temp2 = Right(msg_temp , 8)
                    If Msg_temp2 = "endblock" Then
                       Exit Do
                    End If
                    If Msg_temp2 = "get-ipnr" Then
                       Readeeprom Hulp1 , 23
                       If Hulp1 = &HFF Then
                           Msg_temp = "http://" + Str(myip(1))
                           Msg_temp = Msg_temp + "." + Str(myip(2))
                           Msg_temp = Msg_temp + "." + Str(myip(3))
                           Msg_temp = Msg_temp + "." + Str(myip(4))
                           Else
                           Msg_temp = ""

                           For Y = 1 To Hulp1
                               Hulp3 = Y + 23
                               Readeeprom Hulp2 , Hulp3
                               Msg_temp = Msg_temp + Chr(hulp2)
                           Next Y

                       End If
                    End If

                   If Msg_temp2 = "get-info" Then           'no relays' yet
                    '
                    Else
                          Msg_temp = Msg_temp + Chr(13) + Chr(10)
                          For Y = 1 To Len(msg_temp)
                            Tempstring1 = Mid(msg_temp , Y , 1)
                            Packet(tempword3) = Asc(tempstring1)
                            Incr Tempword3
                          Next Y
                    End If
                   Loop Until Eof(ff) <> 0

                   'The EOF() function returns a non-zero number when the end of the file is reached

                   'This way we know that there is no more data we can read

                   Close #ff
                Tcpdatalen_out = Tempword3 - 55             'minus headerlength
               ' expect to get an acknowledgment of the message
               Expected_ack = My_seqnum + Tcpdatalen_out
               ' send the TCP/IP packet
               Call Send_tcp_packet
          End If
     End If
End If


' This code segment processes the incoming SYN from the Tenet client
' and sends back the initial sequence number (ISN) and acknowledges
' the incoming SYN packet
If Tcp_syn = 1 Then
   #if Debug = 1
      Print "Tcp_syn = 1"
   #endif
   Tcpdatalen_in = 1
   Set Flags.synflag
   Call Setup_packet
   Swap Tcp_srcportl , Tcp_destportl
   Swap Tcp_srcporth , Tcp_destporth
   Call Assemble_ack
   Call Tcpseqtomyseq
   Tcp_flags = 0
   Set Tcp_flags.1
   Set Tcp_flags.4
   Call Tcp_checksum
   Call Echopacket
End If

If Tcp_fin = 1 Then
      Set Flags.finflag
      Incr Tcpdatalen_in
      Incoming_ack0 = Tcp_acknum0
      Incoming_ack1 = Tcp_acknum1
      Incoming_ack2 = Tcp_acknum2
      Incoming_ack3 = Tcp_acknum3
      'Call Incomacqtotcpack
      If Incoming_ack <= Expected_ack Then
         Templong1 = Expected_ack - Incoming_ack
         My_seqnum = Expected_ack - Templong1
      End If
      Expected_ack = My_seqnum + Tcpdatalen_out
      Call Send_tcp_packet
End If
End Sub


Sub Tcp_checksum
#if Debug = 1
   Print "Sub Tcp_checksum"
#endif
Local Whulp1 As Word
Local Whulp2 As Word
Local Whulp3 As Word
Local Tempword2 As Word
Tcp_cksum = 0
I_chksum32 = 0
Tempwordh = T_ip_srcaddr0
Tempwordl = T_ip_srcaddr1
I_chksum32 = Tempword
Tempwordh = T_ip_srcaddr2
Tempwordl = T_ip_srcaddr3
I_chksum32 = I_chksum32 + Tempword
Tempwordh = T_ip_destaddr0
Tempwordl = T_ip_destaddr1
I_chksum32 = I_chksum32 + Tempword
Tempwordh = T_ip_destaddr2
Tempwordl = T_ip_destaddr3
I_chksum32 = I_chksum32 + Tempword
I_chksum32 = I_chksum32 + T_ip_proto

Tempwordh = T_ip_pktlen0
Tempwordl = T_ip_pktlen1
Tempword2 = T_ip_vers_len And &H0F
Tempword2 = Tempword2 * 4
I_chksum32 = I_chksum32 + Tempword
I_chksum32 = I_chksum32 - Tempword2


Whulp2 = Tempword - 20
Whulp2 = Whulp2 + &H23
Whulp2 = Whulp2 - 2

Val1 = &H23
Val2 = Whulp2
I_odd = Val2 - Val1
I_odd = I_odd Mod 2

Call General_part_checksum(val1 , Val2)
Tcp_cksumh = Val3
Tcp_cksuml = Val4
End Sub


' Send the TCP-packet, a bit different then echopacket
'
Sub Send_tcp_packet
   #if Debug = 1
      Print "Sub Send_tcp_packet"
   #endif
   Ip_packet_len = 40 + Tcpdatalen_out
   T_ip_pktlen1 = Low(ip_packet_len)
   T_ip_pktlen0 = High(ip_packet_len)
   Call Setup_packet
   Swap Tcp_srcporth , Tcp_destporth
   Swap Tcp_srcportl , Tcp_destportl
   Call Assemble_ack
   Call Tcpseqtomyseq
   Tcp_flags = 0
   'fin_out
   Set Tcp_flags.0                                          ' piggyback FIN onto the page date
   'ack_out
   Set Tcp_flags.4
   If Flags.finflag = 1 Then
      'fin_out
      Set Tcp_flags.0
      'clr_finflag
      Reset Flags.finflag
   End If
   Call Tcp_checksum

   Txlen = Ip_packet_len + 14
   If Txlen < 60 Then
      Txlen = 60
   End If

   Call Write_rtl8019as(nic_cr , &H22)
   Call Write_rtl8019as(nic_tpsr , Txstart)                 '&H40
   Call Write_rtl8019as(nic_rsar0 , &H00)
   Call Write_rtl8019as(nic_rsar1 , &H40)
   Call Write_rtl8019as(nic_isr , &HFF)
   Hulp1 = Low(txlen)
   Call Write_rtl8019as(nic_rbcr0 , Hulp1)
   Hulp1 = High(txlen)
   Call Write_rtl8019as(nic_rbcr1 , Hulp1)
   Call Write_rtl8019as(nic_cr , &H12)

   For I = 1 To Txlen
      Call Write_rtl8019as(nic_rdmaport , Packet(i))
   Next

   'make sure the DMA operation has succesfully completed
   Byte_read = 0
   Do
      Hulp1 = Byte_read And Nic_rdc
      Call Read_rtl8019as(nic_isr)
   Loop Until Hulp1 = 0

   Hulp1 = Low(txlen)
   Call Write_rtl8019as(nic_tbcr0 , Hulp1)
   Hulp1 = High(txlen)
   Call Write_rtl8019as(nic_tbcr1 , Hulp1)
   Call Write_rtl8019as(nic_cr , &H24)

End Sub


Sub Setup_packet
#if Debug = 1
   Print "Sub Setup_packet"
#endif
'Move IP source address to destination address
T_ip_destaddr = T_ip_srcaddr
'Make ethernet module IP address source address
T_ip_srcaddr = My_ip
'Move hardware source address to destinatin address
Call Packetshape
Call Ip_header_checksum
End Sub

Sub Assemble_ack
Client_seqnum0 = Tcp_seqnum0
Client_seqnum1 = Tcp_seqnum1
Client_seqnum2 = Tcp_seqnum2
Client_seqnum3 = Tcp_seqnum3
Client_seqnum = Client_seqnum + Tcpdatalen_in
Tcp_acknum0 = Client_seqnum0
Tcp_acknum1 = Client_seqnum1
Tcp_acknum2 = Client_seqnum2
Tcp_acknum3 = Client_seqnum3
End Sub

Sub Tcpseqtomyseq
#if Debug = 1
   Print "Sub Tcpseqtomyseq"
#endif
Tcp_seqnum0 = My_seqnum0
Tcp_seqnum1 = My_seqnum1
Tcp_seqnum2 = My_seqnum2
Tcp_seqnum3 = My_seqnum3
End Sub


' Routine UDP_send    In this example a UDP-send to a NTP-server and receiving the exact time
'
Sub Udp_send
#if Debug = 1
   Print "Sub UDP_send"
#endif
Disable Int5
T_enetpacketlenl = 66
T_enetpacketlenh = 0
'MAC-header
'Destination hardware address
T_enetpacketdest0 = Gwmac(1)
T_enetpacketdest1 = Gwmac(2)
T_enetpacketdest2 = Gwmac(3)
T_enetpacketdest3 = Gwmac(4)
T_enetpacketdest4 = Gwmac(5)
T_enetpacketdest5 = Gwmac(6)
' source (own source)
T_enetpacketsrc0 = Mymac(1)
T_enetpacketsrc1 = Mymac(2)
T_enetpacketsrc2 = Mymac(3)
T_enetpacketsrc3 = Mymac(4)
T_enetpacketsrc4 = Mymac(5)
T_enetpacketsrc5 = Mymac(6)

T_enetpackettype = &H0008
' fill IP-header
T_ip_vers_len = &H45
T_tos = &H00
T_ip_pktlen0 = &H00
T_ip_pktlen1 = &H30

T_id0 = &H4A
T_id1 = &HA5

T_flags = &H00
T_offset = &H00

T_ttl = &H80
'protocol (ICMP=1, TCP=6, UDP=11)
T_ip_proto = &H11
'header checksum
'T_ip_hdr_cksum0
'T_ip_hdr_cksum1
'IP address of source
T_ip_srcaddr0 = Myip(1)
T_ip_srcaddr1 = Myip(2)
T_ip_srcaddr2 = Myip(3)
T_ip_srcaddr3 = Myip(4)
'IP address of destination                                   'you have to put the IP-number of

T_ip_destaddr0 = 193                                        ' the NTP-server here
T_ip_destaddr1 = 67                                         '193.67.79.202
T_ip_destaddr2 = 79
T_ip_destaddr3 = 202
'UDP-header

T_udp_srcport0 = &H13
T_udp_srcport1 = &H88

T_udp_destport0 = &H00
T_udp_destport1 = &H25

T_udp_len0 = &H00
T_udp_len1 = &H1C
Call Ip_header_checksum
Call Udp_checksum
Call Echopacket
Enable Int5
End Sub


' Routine to convert the LONG from the NTP-server in to date and time
'
Sub Ntp
#if Debug = 1
   Print "Sub Ntp"
#endif
S(1) = T_udp_data
S(2) = T_udp_data1
S(3) = T_udp_data2
S(4) = T_udp_data3
Swap S(1) , S(4) : Swap S(2) , S(3)
L2 = L1 + 1139293696
L2 = L2 + 3600                                              ' offset UTC + 1 hour
Print "Time from NTP-server"
Print #1 , "Date : " ; Date(l2)
Print #1 , "Time : " ; Time(l2)
Print #1 , ""
Cls
Lcd "Date : " ; Date(l2)
Lowerline
Tempstring = Time(l2)
Lcd "Time : " ; Left(tempstring , 5)
'synchronize with NTP-time with RTC DS1337
Call Sync_ds1337
End Sub

Sub Sync_ds1337
Tempstring = Date(l2)
Smonth = Left(tempstring , 2)
_month = Val(smonth)
Sday = Mid(tempstring , 4 , 2)
_day = Val(sday)
Syear = Right(tempstring , 2)
_year = Val(syear)
Tempstring = Time(l2)
Shour = Left(tempstring , 2)
_hour = Val(shour)
Sminute = Mid(tempstring , 4 , 2)
_min = Val(sminute)
Ssecond = Right(tempstring , 2)
_sec = Val(ssecond)
Call Settime
Call Setdate
Call Getdatetime
End Sub


' Routine to get a configuration-screen on the RS232 port
'
Sub Configure
#if Debug = 1
   Print "Sub Configure"
#endif
Local Adr As Word
Local Row As Byte
Local Ipnr As String * 15
Local Dot1 As Byte
Local Dot2 As Byte
Local Dot3 As Byte
Local Dot4 As Byte
Local Dot5 As Byte
Local Iptemp As String * 1
Local Macadr As String * 20
Local Yn As String * 1
Print Chr(&H0c);                                            'On the SDRVL-board CLS
Print "WebCat Atmega128 Loader Version 1.40"
Print
Print "Source written by Ben Zijlstra january 2007"
Print
Print "Present configuration:"
Print
Print "Network:"
Print
Print "IP-number         : ";
Call Read_ip
Call Print_ip
Call Read_mac
Print
Print "MAC-address       : ";
Call Print_mac
'Print Hex(mymac(1)) ; "-" ; Hex(mymac(2)) ; "-" ; Hex(mymac(3)) ; "-" ; Hex(mymac(4)) ; "-" ; Hex(mymac(5)) ; "-" ; Hex(mymac(6))
Print
Print "Gateway IP-number : ";
Call Read_gwip
Call Print_gwip
Print
Print "Press 'y' to get into configuration mode"

Test:
Incr Hulp3
If Hulp3 = 65000 Then
   Incr Hulp1
   Hulp3 = 0
End If
If Hulp1 = 50 Then
   Goto Noresponse
End If
sbis USR,7
rjmp test

Configuremode:
Conf = 1

If Dsp_present = 0 Then
   Cls
   Lcd "Configure-mode"
End If
Print Chr(&H0c) ;
Print "Configure mode:"
Print
Print "Network:"
Print
Print "IP-number: ";
Print
Call Print_ip
Input "Change IP-number (y/n) " , Yn
If Yn = "y" Then
   Print
   Print "Input IP-numbers as decimals, seperated by a dot (like 192.168.1.106)"
   Print
   Input Ipnr
   Hulp1 = Split(ipnr , Ippart(1) , ".")
   Myip(1) = Val(ippart(1))
   Myip(2) = Val(ippart(2))
   Myip(3) = Val(ippart(3))
   Myip(4) = Val(ippart(4))
   Print
   Print "New IP-number: ";
   Call Print_ip
   Print
   Input "Accept IP-number (y/n) " , Yn
   If Yn = "y" Then
      Writeeeprom Myip(1) , 1 : Writeeeprom Myip(2) , 2
      Writeeeprom Myip(3) , 3 : Writeeeprom Myip(4) , 4
    End If
    Print
    Print "IP-number: ";
    Call Read_ip
    Call Print_ip
End If
Print
Print "MAC-address: ";
Print Hex(mymac(1)) ; "-" ; Hex(mymac(2)) ; "-" ; Hex(mymac(3)) ; "-" ; Hex(mymac(4)) ; "-" ; Hex(mymac(5)) ; "-" ; Hex(mymac(6))
Print
Input "Change MAC-address (y/n) " , Yn
If Yn = "y" Then

Mac:
Print
Print "Input MAC-address in hexadecimals, seperated by a - (like 00-34-35-36-37-48)"
Print
Input Macadr
If Len(macadr) <> 17 Then Goto Mac
Hulp1 = Split(macadr , Mymacs(1) , "-")

Mymac(1) = Hexval(mymacs(1))
Mymac(2) = Hexval(mymacs(2))
Mymac(3) = Hexval(mymacs(3))
Mymac(4) = Hexval(mymacs(4))
Mymac(5) = Hexval(mymacs(5))
Mymac(6) = Hexval(mymacs(6))

   Print
   Print "New MAC-address: ";
   Call Print_mac
   Print
   Input "Accept MAC-address (y/n) " , Yn
   If Yn = "y" Then
      Writeeeprom Mymac(1) , 5 : Writeeeprom Mymac(2) , 6
      Writeeeprom Mymac(3) , 7 : Writeeeprom Mymac(4) , 8
      Writeeeprom Mymac(5) , 9 : Writeeeprom Mymac(6) , 10
    End If
    Print
    Print "MAC-address: ";
    Call Read_mac
    Call Print_mac
End If

Print "Gateway: ";
Call Print_gwip
Print
Input "Change Gateway-IP-number (y/n) " , Yn
If Yn = "y" Then
   Print
   Print "Input Gateway-IP-number as decimals, seperated by a dot (like 192.168.1.254)"
   Print
   Input Ipnr
   Hulp1 = Split(ipnr , Ippart(1) , ".")
   Gwip(1) = Val(ippart(1))
   Gwip(2) = Val(ippart(2))
   Gwip(3) = Val(ippart(3))
   Gwip(4) = Val(ippart(4))
   Print
   Print "New Gateway-IP-number: ";
   Call Print_gwip
   Print
   Input "Accept Gateway-IP-number (y/n) " , Yn
   If Yn = "y" Then
      Writeeeprom Gwip(1) , 13 : Writeeeprom Gwip(2) , 14
      Writeeeprom Gwip(3) , 15 : Writeeeprom Gwip(4) , 16
    End If
    Print
    Print "Gateway-IP-number: ";
    Call Read_gwip
    Call Print_gwip
End If
Print


Print
Input "Would you like to use it's own IP-number as refresh-URL (y/n) " , Yn
If Yn = "y" Then
      Hulp1 = 255
      Writeeeprom Hulp1 , 23
   Else
      Print
      Input "Would you like to have another refresh-URL (y/n) " , Yn
      If Yn = "y" Then
        Input "Type the complete refresh URL " , Msg_temp
        Print
        Print "Refresh URL " ; Msg_temp
        Print
        Input "Accept Refresh-URL (y/n) " , Yn
        If Yn = "y" Then
             Hulp2 = Len(msg_temp)
             Writeeeprom Hulp2 , 23                         ' write length of Refresh URL
             For Y = 1 To Hulp2
                Hulp1 = Y + 23
                Tempstring1 = Mid(msg_temp , Y , 1)
                Hulp2 = Asc(tempstring1)
                Writeeeprom Hulp2 , Hulp1
             Next Y
        End If
      End If
End If

Print
Hulp5 = 5000
Writeeeprom Hulp5h , 12                                     ' &h1388 = 5000 dec = 19 high, 136 low.
Writeeeprom Hulp5l , 11

Input "Would you like to change to UDP Portnumber. It's default is 5000 (y/n) " , Yn
If Yn = "y" Then
   Print
   Input "Type the portnumber < 65536 as decimal " , Hulp5
   Print
   Print "Portnumber UDP " ; Hulp5
   Print
   Input "Accept Portnumber UDP (y/n) " , Yn
   If Yn = "y" Then
      Writeeeprom Hulp5h , 12
      Writeeeprom Hulp5l , 11
   End If
End If
Print

Input "Would you like to use a LCD-display? " , Yn
Readeeprom Hulp1 , 0
If Yn = "y" Then
   Dsp_present = 0
   Hulp1.0 = 0
   Writeeeprom Hulp1 , 0
   Print
   Cls
   Lcd "LCD Testmessage"
   Print
   Input "Any key to continue...." , Yn
   Else
   Hulp1.0 = 1
   Writeeeprom Hulp1 , 0
End If

Noresponse:
Conf = 0
If Dsp_present = 0 Then
   Cls
End If
Print Chr(&H0c);
Print "Summary:"
Print
If Dsp_present = 1 Then
   Print "LCD-display        : not used"
   Else
   Print "LCD-display        : used"
   Print
End If
Print
Print "Network:"
Print
Print "URL-refresh        : ";
Readeeprom Hulp1 , 23
If Hulp1 = &HFF Then
      Print "http://" ; Myip(1) ; "." ; Myip(2) ; "." ; Myip(3) ; "." ; Myip(4)
   Else
      Msg_temp = ""
      For Y = 1 To Hulp1
         Hulp3 = Y + 23
         Readeeprom Hulp2 , Hulp3
         Msg_temp = Msg_temp + Chr(hulp2)
      Next Y
      Print Msg_temp
End If
Print
Print "UDP-port           : ";
Readeeprom Hulp5h , 12
Readeeprom Hulp5l , 11
Print Hulp5
Print
Print "IP-number          : " ; Myip(1) ; "." ; Myip(2) ; "." ; Myip(3) ; "." ; Myip(4)
Print
Print "Mac-address        : " ; Hex(mymac(1)) ; "-" ; Hex(mymac(2)) ; "-" ; Hex(mymac(3)) ; "-" ; Hex(mymac(4)) ; "-" ; Hex(mymac(5)) ; "-" ; Hex(mymac(6))
Print
Print "Gateway-IP-number  : " ; Gwip(1) ; "." ; Gwip(2) ; "." ; Gwip(3) ; "." ; Gwip(4)
Print
End Sub


' Routine to read the IP-numbers from the EEPROM
'
Sub Read_ip
   #if Debug = 1
      Print "Sub Read_ip"
   #endif
   Readeeprom Myip(1) , 1 : Readeeprom Myip(2) , 2
   Readeeprom Myip(3) , 3 : Readeeprom Myip(4) , 4
End Sub


' Routine to print the IP-number
'
Sub Print_ip
   #if Debug = 1
      Print "Sub Print_ip"
   #endif
   Print Myip(1) ; "." ; Myip(2) ; "." ; Myip(3) ; "." ; Myip(4)
End Sub


' Routine to read the IP-numbers from the EEPROM
'
Sub Read_gwip
   #if Debug = 1
      Print "Sub Read_gwip"
   #endif
   Readeeprom Gwip(1) , 13 : Readeeprom Gwip(2) , 14
   Readeeprom Gwip(3) , 15 : Readeeprom Gwip(4) , 16
End Sub


' Routine to print the GWIP-number
'
Sub Print_gwip
   #if Debug = 1
      Print "Sub Print_ip"
   #endif
   Print Gwip(1) ; "." ; Gwip(2) ; "." ; Gwip(3) ; "." ; Gwip(4)
End Sub


' Routine to read the MAC-address from the EEPROM
'
Sub Read_mac
   #if Debug = 1
      Print "Sub Read_mac"
   #endif
   Readeeprom Mymac(1) , 5 : Readeeprom Mymac(2) , 6
   Readeeprom Mymac(3) , 7 : Readeeprom Mymac(4) , 8
   Readeeprom Mymac(5) , 9 : Readeeprom Mymac(6) , 10
End Sub


' Routine to print the MAC-address
'
Sub Print_mac
   #if Debug = 1
      Print "Sub Print_mac"
   #endif
   Print Hex(mymac(1)) ; "-" ; Hex(mymac(2)) ; "-" ; Hex(mymac(3)) ; "-" ; Hex(mymac(4)) ; "-" ; Hex(mymac(5)) ; "-" ; Hex(mymac(6))
End Sub


' Routine to send a default-message to the LCD
'
Sub Default_message
#if Debug = 1
   Print "Sub Default_message"
#endif
Call Read_ip
If Dsp_present = 0 Then
   Cursor Off
   Cls
   Lcd "www.achatz.nl WebCat"
   Thirdline
   Lcd "IP: "
   Tempstring = Str(myip(1)) + "." + Str(myip(2)) + "." + Str(myip(3)) + "." + Str(myip(4))
   Lcd Tempstring
   End If
   Wait 2
End Sub


' Routine to get the MAC-address of the gateway
'
Sub Arp_request
#if Debug = 1
    Print "Sub Arp_request"
#endif
   Disable Int5
   'Destination all &hFF
   T_enetpacketdest0 = &HFF
   T_enetpacketdest1 = &HFF
   T_enetpacketdest2 = &HFF
   T_enetpacketdest3 = &HFF
   T_enetpacketdest4 = &HFF
   T_enetpacketdest5 = &HFF
   ' source (own source)
   T_enetpacketsrc0 = Mymac(1)
   T_enetpacketsrc1 = Mymac(2)
   T_enetpacketsrc2 = Mymac(3)
   T_enetpacketsrc3 = Mymac(4)
   T_enetpacketsrc4 = Mymac(5)
   T_enetpacketsrc5 = Mymac(6)
   '
   T_enetpackettype = &H0608                                '&h0806
   T_arp_hwtype0 = &H00                                     '&h0001
   T_arp_hwtype1 = &H01
   'Arp
   T_arp_prttype0 = &H08                                    ' added for ARP-request routine
   T_arp_prttype1 = &H00
   T_arp_hwlen = &H06
   T_arp_prlen = &H04
   T_arp_op0 = &H00                                         ' &h0001
   T_arp_op1 = &H01
   'arp source mac address
   T_arp_src_enetpacket0 = Mymac(1)
   T_arp_src_enetpacket1 = Mymac(2)
   T_arp_src_enetpacket2 = Mymac(3)
   T_arp_src_enetpacket3 = Mymac(4)
   T_arp_src_enetpacket4 = Mymac(5)
   T_arp_src_enetpacket5 = Mymac(6)
   'arp source ip address
   T_arp_sipaddr0 = Myip(1)
   T_arp_sipaddr1 = Myip(2)
   T_arp_sipaddr2 = Myip(3)
   T_arp_sipaddr3 = Myip(4)
   ' arp target mac address
   T_arp_dest_enetpacket0 = &H00
   T_arp_dest_enetpacket1 = &H00
   T_arp_dest_enetpacket2 = &H00
   T_arp_dest_enetpacket3 = &H00
   T_arp_dest_enetpacket4 = &H00
   T_arp_dest_enetpacket5 = &H00
   'arp target IP address
   T_arp_tipaddr = Arpreqip
   T_enetpacketlenl = 64
   T_enetpacketlenh = 0
   Call Echopacket
   Enable Int5
End Sub


Sub Arp_reply
#if Debug = 1
    Print "ARP-reply"
#endif
Gwmac(1) = T_enetpacketsrc0
Gwmac(2) = T_enetpacketsrc1
Gwmac(3) = T_enetpacketsrc2
Gwmac(4) = T_enetpacketsrc3
Gwmac(5) = T_enetpacketsrc4
Gwmac(6) = T_enetpacketsrc5
End Sub


Sub Avr_dos
#if Debug = 1
    Print "Avr-Dos"
#endif
Gbpcinputpointer = 1
Gspcinput = ""
Erampointer = 0

'Init file system
Berrorcode = Initfilesystem(1)
If Berrorcode > 0 Then
   Print "Error: " ; Berrorcode
   Stop
Else
   Print "Filesystem successfully initialized"
End If

Gspcinput = "FS 1"
Docommand
Gbpcinputpointer = 1                                        ' reset for new user-input

Print #1 , ""
Print #1 , "Disksize : " ; Disksize()                       ' show disk size in bytes
Print #1 , ""
Print #1 , "Disk free: " ; Diskfree()                       ' show free space too


'synchronize the time with the DS1337 RTC
Call Getdatetime
Datestr = "00-00-00"
Timestr = "00:00:00"
Syear = Str(_year)
Smonth = Str(_month)
Sday = Str(_day)

Shour = Str(_hour)
Sminute = Str(_min)
Ssecond = Str(_sec)

Datestr = Format(smonth , "00") + "-" + Format(sday , "00") + "-" + Format(syear , "00")
Timestr = Format(shour , "00") + ":" + Format(sminute , "00") + ":" + Format(ssecond , "00")

Gspcinput = "DATE " + Datestr
Docommand
Gbpcinputpointer = 1                                        ' reset for new user-input

Gspcinput = "TIME " + Timestr
Docommand
Gbpcinputpointer = 1                                        ' reset for new user-input

If Conf = 1 Then
   Print #1 , "AVR-DOS: Ready for commands (ESC to Exit)"
   Printprompt
   Do
     Gbinp = Inkey(#1)                                      ' get user input
     If Gbinp <> 0 Then                                     ' something typed in?
         If Gbinp = 27 Then                                 ' use ESC for exit from interpreter
            Exit Do
         End If
          Getinput Gbinp                                    ' give input to interpreter
     End If
   Loop                                                     ' do forever
   Print #1 , "EXIT from AVR-DOS Shell"
End If
Print #1 , ""
Print #1 , "Running..."

End Sub


Sub Getinput(pbbyte As Byte)
   ' stores bytes from user and wait for CR (&H13)
   Select Case Pbbyte
      Case &H0A                                             ' do nothing
      Case &H0D                                             ' Line-end?
         Print #1 , Chr(&H0d) ; Chr(&H0a) ;
         Docommand                                          ' analyse command and execute
         Gbpcinputpointer = 1                               ' reset for new user-input
         Gspcinput = ""
         Printprompt
      Case &H08                                             ' backspace ?
         If Gbpcinputpointer > 1 Then
            Print #1 , Chr(&H08);
            Decr Gbpcinputpointer
         End If
      Case Else                                             ' store user-input
         If Gbpcinputpointer <= Cpcinput_len Then
            Mid(gspcinput , Gbpcinputpointer , 1) = Pbbyte
            Incr Gbpcinputpointer
            Mid(gspcinput , Gbpcinputpointer , 1) = &H00    ' string-terminator
            Print #1 , Chr(pbbyte);                         ' echo back to user
         End If
   End Select
End Sub


Sub Docommand
   ' interpretes the user-input and execute
   ' Local variables
   Local Lbyte1 As Byte , Lbyte2 As Byte , Lbyte3 As Byte , Lbyte4 As Byte , Lbyte5 As Byte , Lbyte6 As Byte
   Local Lint1 As Integer , Lint2 As Integer , Lint3 As Integer , Lint4 As Integer
   Local Lword1 As Word , Lword2 As Word , Lword3 As Word , Lword4 As Word
   Local Llong1 As Long , Llong2 As Long , Llong3 As Long , Llong4 As Long , Llong5 As Long , Llong6 As Long , Llong7 As Long
   Local Lsingle1 As Single
   Local Lbpos As Byte

   Local Lblen As Byte
   Local Lwsrampointer As Word
   Gldumpbase = 0
   Extracttoken                                             ' token analysing
   Gbtoken_actual = 0                                       ' reset to beginn of line (first token)
   Gbpcinputerror = Cpno
   Gwtemp1 = 1
   If Gbcnttoken > 0 Then                                   ' is there any input

      Gstoken = Getnexttokenstr(70)                         ' get first string-token = command
      Gstoken = Ucase(gstoken)                              ' all uppercase
      Lwsrampointer = Varptr(abinterpreterbuffer(1))
                                         ' Pointer to SRAM Buffer
      Select Case Gstoken

         Case "CFI"                                         ' Show CF-Card Information Block
              Print #1 , "Read Card Info"
              Lbyte1 = Drivegetidentity(lwsrampointer)      ' read Info to SRAM
              If Lbyte1 = 0 Then
                  Transferbuffer_write = 0
                  Sramdump Lwsrampointer , 512 , Gldumpbase ' Dump SRAM
                  ' Get Count of Sectors in Compactflash-Card
                  Llong1 = Getlongfrombuffer(abinterpreterbuffer(1) , 120) : Llong2 = Llong1 * 512
                  Print #1 , Llong1 ; " Sectors = " ; Llong2 ; " Bytes"
                  ' Get Buffersize of Compactflash-Card
                  Lword1 = Getwordfrombuffer(abinterpreterbuffer(1) , 42)
                  Llong2 = Lword1 * 512
                  Print #1 , "CF-Buffersize = " ; Lword1 ; " Sectors = " ; Llong2 ; " Bytes"
              Else
                  Printdriveerror
              End If

         Case "CFRESET"                                     ' Reset Compactflash Card
              Lbyte1 = Drivereset()
              If Lbyte1 = 0 Then
                  Print #1 , "OK"
              End If
              Printdriveerror

         Case "CFINIT"                                      ' Reset Compactflash Card
              Lbyte1 = Driveinit()
              If Lbyte1 = 0 Then
                  Print #1 , "OK"
              End If
              Printdriveerror

         Case "CFCHECK"                                     ' Reset Compactflash Card
              Lbyte1 = Drivecheck()
              If Lbyte1 = 0 Then
                  Print #1 , "OK"
              End If
              Printdriveerror


         Case "MBR"                                         ' Show Masterboot record = Sector 0
            Llong1 = 0
            Print #1 , "Read Master Boot Record ... " ;
            Lbyte1 = Drivereadsector(lwsrampointer , Llong1 )       ' read Sector to abInterpreterBuffer
            If Lbyte1 = 0 Then
               Transferbuffer_write = 0
               Print #1 , "done"
               Sramdump Lwsrampointer , 512 , Gldumpbase    ' show abInterpreterBuffer
               Print #1 , " " : Print #1 , "Partition-Table" : Print #1 , " "
               Lword1 = 446                                 ' first partition entry starts at 446
               For Lbyte1 = 1 To 4
                  Lword2 = Lword1 + 1
                  Lbyte2 = Abinterpreterbuffer(lword2)
                  Lbyte2 = Lbyte2 And &B0111111             ' only H00 or H80 is valid
                  If Lbyte2 = 0 Then
                     Lword2 = Lword1 + 8
                     Llong1 = Getlongfrombuffer(abinterpreterbuffer(1) , Lword2)
                     Lword2 = Lword1 + 12
                     Llong2 = Getlongfrombuffer(abinterpreterbuffer(1) , Lword2)
                     Llong3 = Llong1 + Llong2
                     Lword2 = Lword1 + 5
                     Llong4 = Llong2 / 2                    ' KB of partition
                     Lbyte2 = Abinterpreterbuffer(lword2)
                     If Lbyte2 > 0 Then
                        Print #1 , "Partition " ; Lbyte1 ; " " ;
                        Print #1 , "Sector: " ; Llong1 ; " to " ; Llong3 ; " = " ; Llong2 ; " Sectors; " ; " [" ; Llong4 ; " KB]  " ;
                        Print #1 , "File-System Type: " ; Hex(lbyte2)
                     End If
                  End If
                  Lword1 = Lword1 + 16
               Next
            End If
            Printdriveerror


         Case "SD"                                          ' Sector Dump
            If Gbcnttoken = 2 Then
               Llong1 = Getnexttokenlong(0 , 10000000)
               Llong2 = Llong1
            Elseif Gbcnttoken = 3 Then
               Llong1 = Getnexttokenlong(0 , 10000000)
               Llong2 = Getnexttokenlong(llong1 , 10000000)
            Else
                Printparametercounterror "1, 2 "
                Exit Sub
            End If
            If Gbpcinputerror = Cpno Then
               Print #1 , "Dump Sectors from " ; Llong1 ; " to " ; Llong2
               For Llong3 = Llong1 To Llong2
                   Print #1 , "Read Sector: " ; Llong3 ; " ... " ;
                   Lwsrampointer = Varptr(abinterpreterbuffer(1))
                   Lbyte1 = Drivereadsector(lwsrampointer , Llong3)
                   If Lbyte1 <> 0 Then
                      Print #1 , "Error " ; Lbyte1 ; " at sector# " ; Llong3
                      Printdriveerror
                      Exit For
                   End If
                   Print #1 , " done"
                   Transferbuffer_write = 0
                   Gldumpbase = 0
                   Lwsrampointer = Varptr(abinterpreterbuffer(1))
                   Sramdump Lwsrampointer , 512 , Gldumpbase
                   If Abinterpreterbuffer(508) = Asc( ":") Then
                      ' copy sector# to lLong4
                      Loadadr Abinterpreterbuffer(509) , Z
                      Loadadr Llong4 , X
                      !Call _ZXMem4_Copy                    ' copy from Z to X
                      Print #1 , "SWM-Sector# = " ; Llong4

                   End If
               Next
            End If

         Case "MD"                                          ' Memory Dump
              Lword2 = 512
              If Gbcnttoken = 1 Then
              Elseif Gbcnttoken = 2 Then
                 Llong1 = Getnexttokenlong(0 , &HFFFF)
                 Lwsrampointer = Llong1                     ' assign to word
              Elseif Gbcnttoken = 3 Then
                 Llong1 = Getnexttokenlong(0 , &HFFFF)
                 Lwsrampointer = Llong1                     ' assign to word
                 Llong2 = Getnexttokenlong(1 , &HFFFF)
                 Lword2 = Llong2
              Else
                  Printparametercounterror "0, 1, 2 "
              End If
              If Gbpcinputerror = Cpno Then
                 Gldumpbase = Lwsrampointer
                 Sramdump Lwsrampointer , Lword2 , Gldumpbase       ' Show 512 Bytes
              End If

         Case "ED"                                          ' EEPROM Dump
              Lword2 = 256
              If Gbcnttoken = 1 Then
              Elseif Gbcnttoken = 2 Then
                 Llong1 = Getnexttokenlong(0 , &H1000)
                 Lwsrampointer = Llong1                     ' assign to word
              Elseif Gbcnttoken = 3 Then
                 Llong1 = Getnexttokenlong(0 , &H1000)
                 Lwsrampointer = Llong1                     ' assign to word
                 Llong2 = Getnexttokenlong(1 , &H1000)
                 Lword2 = Llong2
              Else
                  Printparametercounterror "0, 1, 2 "
              End If
              If Gbpcinputerror = Cpno Then
                 Gldumpbase = Erampointer
                 Eramdump Erampointer , Lword2              ' Show 512 Bytes
              End If

         Case "SW"                                          ' Sector Write
            If Gbcnttoken = 2 Then
               Llong1 = Getnexttokenlong(0 , 2000000)
               Llong2 = 0
               Llong3 = Llong1 + Llong2
            Elseif Gbcnttoken = 3 Then
               Llong1 = Getnexttokenlong(0 , 2000000)
               Llong2 = Getnexttokenlong(1 , &H7F)
               Llong2 = Llong2 - 1
               Llong3 = Llong1 + Llong2
            Elseif Gbcnttoken = 4 Then
               Llong1 = Getnexttokenlong(0 , 2000000)
               Llong2 = Getnexttokenlong(1 , &H7F)
               Llong2 = Llong2 - 1
               Llong3 = Llong1 + Llong2
               Llong4 = Getnexttokenlong(0 , &HFFFF)
               Lwsrampointer = Llong4
            Else
               Printparametercounterror "2, 3 "
               Exit Sub
            End If
            If Gbpcinputerror = Cpno Then
               Incr Llong2
               Print #1 , "Write " ; Llong2 ; " Sector(s) to " ; Llong1 ; " at CF-Card from " ;
               If Gbcnttoken = 4 Then
                  Print #1 , "SRAM Address " ; Hex(lwsrampointer) ; " ... "
               Else
                  Print #1 , "Transfer-Buffer ... "
               End If
               For Llong2 = Llong1 To Llong3
                  Print #1 , "Write Sector " ; Llong2 ; " from SRAM " ; Hex(lwsrampointer)
                  Lbyte1 = Drivewritesector(lwsrampointer , Llong2)
                  If Lbyte1 <> 0 Then
                     Print #1 , "Error: " ; Lbyte1 ; " at sector " ; Llong2
                     Printdriveerror
                     Exit Sub
                  End If
                  If Gbcnttoken = 4 Then
                     Lwsrampointer = Lwsrampointer + 512
                  End If
               Next
            End If

        Case "SWM"                                          ' Sector Write multiple

            If Gbcnttoken > 2 Then
               Llong1 = Getnexttokenlong(0 , 1000000000)    ' first sector to write
               Llong2 = Getnexttokenlong(1 , 100000)        ' count of sectors to write
               Llong2 = Llong2 - 1
               Llong3 = Llong1 + Llong2
               If Gbcnttoken > 3 Then
                  Llong4 = Getnexttokenlong(0 , 255)        ' starting with byte
                  Lbyte1 = Llong4
               Else
                  Lbyte1 = 0
               End If
            Else
               Printparametercounterror "2, 3 "
               Exit Sub
            End If

            If Gbpcinputerror = Cpno Then
               Lwsrampointer = Varptr(abinterpreterbuffer(1))
               Incr Llong2
               For Llong2 = 1 To 512
                  Abinterpreterbuffer(llong2) = Lbyte1
                  Incr Lbyte1
               Next
               Abinterpreterbuffer(508) = Asc( ":")
               Llong2 = Llong3 - Llong1 : Incr Llong2
               Print #1 , "Write " ; Llong2 ; " Sector(s) to " ; Llong1 ; " at CF-Card;  Starting at " ;
               Print #1 , Time$
               Llong4 = Syssec()
               For Llong2 = Llong1 To Llong3
                  ' Copy Sector# to end of sector
                  Loadadr Abinterpreterbuffer(509) , X
                  Loadadr Llong2 , Z
                  !Call _ZXMem4_Copy                        ' copy from Z to X

                  Lbyte1 = Drivewritesector(lwsrampointer , Llong2)
                  If Lbyte1 <> 0 Then
                     Print #1 , "Error: " ; Lbyte1 ; " at sector " ; Llong2
                     Printdriveerror
                     Exit Sub
                  End If
               Next
               Llong4 = Syssecelapsed(llong4)
               Llong2 = Llong3 - Llong1 : Incr Llong2
               Llong4 = Llong4 * 1000000
               Llong4 = Llong4 / Llong2

               Print #1 , "Ready at " ; Time$
               If Llong4 > 0 Then
                  Print #1 , "Using " ; Llong4 ; " Mikro-Seconds per sector"
               End If
            End If

         Case "SRM"                                         ' Sector Write multiple

            If Gbcnttoken = 3 Then
               Llong1 = Getnexttokenlong(0 , 20000000)      ' first sector to write
               Llong2 = Getnexttokenlong(1 , 100000)        ' count of sectors to write
               Llong2 = Llong2 - 1
               Llong3 = Llong1 + Llong2

            Else
               Printparametercounterror "2 "
               Exit Sub
            End If

            If Gbpcinputerror = Cpno Then
               Lwsrampointer = Varptr(abinterpreterbuffer(1))
               Incr Llong2
               Print #1 , "Read " ; Llong2 ; " Sector(s) to " ; Llong1 ; " at CF-Card;  Starting at " ;
               Print #1 , Time$
               Llong4 = Syssec()
               For Llong2 = Llong1 To Llong3
                  Lbyte1 = Drivereadsector(lwsrampointer , Llong2)
                  If Lbyte1 <> 0 Then
                     Print #1 , "Error: " ; Lbyte1 ; " at sector " ; Llong2
                     Exit Sub
                  End If
               Next
               Llong4 = Syssecelapsed(llong4)
               Llong2 = Llong3 - Llong1 : Incr Llong2
               Llong4 = Llong4 * 1000000
               Llong4 = Llong4 / Llong2

               Print #1 , "Ready at " ; Time$
               If Llong4 > 0 Then
                  Print #1 , "Using " ; Llong4 ; " Mikro-Seconds per sector"
               End If
            End If

         Case "MT"                                          ' Fill Memory with Text
            If Gbcnttoken > 1 Then
               Lbyte1 = Gbposstrparts(2)
               Do
                 Incr Transferbuffer_write
                 Gstoken = Mid(gspcinput , Lbyte1 , 1)
                 Lbyte2 = Asc(gstoken)
                 If Lbyte2 = 0 Then                         ' String Terminator
                    Exit Do
                 End If
                 Abinterpreterbuffer(transferbuffer_write) = Lbyte2
                 Incr Lbyte1
               Loop Until Transferbuffer_write > 511
               Decr Transferbuffer_write                    ' 1 based to 0 based
           End If

         Case "ET"                                          ' Fill Memory with Text
            If Gbcnttoken > 1 Then
               Lbyte1 = Gbposstrparts(2)
               Do
                 Gstoken = Mid(gspcinput , Lbyte1 , 1)
                 Lbyte2 = Asc(gstoken)
                 Writeeeprom Lbyte2 , Erampointer
                 Incr Erampointer
                 If Lbyte2 = 0 Then                         ' String Terminator
                    Exit Do
                 End If
                 Incr Lbyte1
               Loop Until Erampointer > &HFFF
           End If

         Case "MP"                                          ' Memory Pointer for MB and MT
              If Gbcnttoken = 2 Then
                 Llong1 = Getnexttokenlong(0 , 511)
                 If Gbpcinputerror = Cpno Then
                    Transferbuffer_write = Llong1
                 End If
              Else
                  Printparametercounterror "1 "
              End If

         Case "EP"                                          ' Memory Pointer for MB and MT
              If Gbcnttoken = 2 Then
                 Llong1 = Getnexttokenlong(0 , &H1000)
                 If Gbpcinputerror = Cpno Then
                    Erampointer = Llong1
                 End If
              Else
                  Printparametercounterror "1 "
              End If

         Case "MB"                                          'Fill Memory with Same Byte
            If Gbcnttoken > 1 Then
               For Lbyte1 = 2 To Gbcnttoken
                   Llong1 = Getnexttokenlong(0 , 255)
                   If Gbpcinputerror = Cpno Then
                      Incr Transferbuffer_write
                      Lbyte2 = Llong1
                      Abinterpreterbuffer(transferbuffer_write) = Lbyte2
                      If Transferbuffer_write >= 511 Then
                         Exit For
                      End If
                   Else
                      Exit For
                   End If
               Next
            End If

         Case "EB"                                          'Fill Memory with Same Byte
            If Gbcnttoken > 1 Then
               For Lbyte1 = 2 To Gbcnttoken
                   Llong1 = Getnexttokenlong(0 , 255)
                   If Gbpcinputerror = Cpno Then
                      Lbyte2 = Llong1
                      Writeeeprom Lbyte2 , Erampointer
                      Incr Erampointer
                      If Erampointer > &HFFF Then
                         Exit For
                      End If
                   Else
                      Exit For
                   End If
               Next
            End If

         Case "MF"

            Llong2 = Transferbuffer_write : Llong3 = 511
            If Gbcnttoken = 2 Then
               Llong1 = Getnexttokenlong(0 , 255)
            Elseif Gbcnttoken = 3 Then
               Llong1 = Getnexttokenlong(0 , 255)
               Llong2 = Getnexttokenlong(0 , 511)
            Elseif Gbcnttoken = 4 Then
               Llong1 = Getnexttokenlong(0 , 255)
               Llong2 = Getnexttokenlong(0 , 511)
               Llong3 = Getnexttokenlong(llong2 , 511)
            Else
                Printparametercounterror "1, 2, 3 "
                Exit Sub
            End If
            If Gbpcinputerror = Cpno Then
               Lbyte1 = Llong1
               Incr Llong2 : Lword2 = Llong2
               Incr Llong3 : Lword3 = Llong3
               For Lword1 = Lword2 To Lword3
                   Abinterpreterbuffer(lword1) = Lbyte1
               Next
               Transferbuffer_write = Lword1 - 1
            End If

         Case "FS"                                          ' Init File System

            If Gbcnttoken = 2 Then
               Llong1 = Getnexttokenlong(0 , 3)
               Lbyte1 = Llong1
               Lbyte2 = Initfilesystem(lbyte1)
               If Lbyte2 <> 0 Then
                  Print #1 , "Error at file system init"
               Else
                  Printfilesysteminfo
               End If

            Else
               Printparametercounterror "1 "
            End If


         Case "DIR"                                         ' Directory
           If Gbcnttoken = 1 Then
               Gstoken = "*.*"
               Directory Gstoken
           Elseif Gbcnttoken = 2 Then
               Gstoken = Getnexttokenstr(12)
               Gstoken = Trim(gstoken)
               Directory Gstoken
           Else
              Printparametercounterror "0 or 1 "
           End If

          Case "DIRT"                                       ' Directory
           If Gbcnttoken = 1 Then
               Gstoken = "*.*"
               Lword1 = 7
               Directory1 Gstoken , Lword1
           Elseif Gbcnttoken = 3 Then
               Gstoken = Getnexttokenstr(12)
               Gstoken = Trim(gstoken)
               Llong1 = Getnexttokenlong(0 , 1000)
               Lword1 = Llong1
               Directory1 Gstoken , Lword1
           Else
              Printparametercounterror "0 or 1 "
           End If

          Case "DIR$"                                       ' Directory
           If Gbcnttoken = 1 Then
               Gstestline = Dir()
               Print #1 , Gstestline
               Printdoserror
           Elseif Gbcnttoken = 2 Then
               Gstoken = Getnexttokenstr(12)
               Gstoken = Trim(gstoken)
               Gstestline = Dir(gstoken)
               Print Gstestline
               Printdoserror
           Else
              Printparametercounterror "0 or 1 "
           End If

         Case "FILEDATETIMEB"
           If Gbcnttoken = 1 Then
               Bsec = Filedatetime()
               If Gbdoserror = 0 Then
                  Print #1 , Byear ; " " ; Bmonth ; " " ; Bday ; " " ; Bhour ; " " ; Bmin ; " " ; Bsec
               Else
                  Printdoserror
               End If
           Elseif Gbcnttoken = 2 Then
               Gstoken = Getnexttokenstr(12)
               Gstoken = Trim(gstoken)
               Bsec = Filedatetime(gstoken)
               If Gbdoserror = 0 Then
                  Print #1 , Byear ; " " ; Bmonth ; " " ; Bday ; " " ; Bhour ; " " ; Bmin ; " " ; Bsec
               Else
                  Printdoserror
               End If
           Else
              Printparametercounterror "0 or 1 "
           End If

         Case "FILEDATETIMES"
           If Gbcnttoken = 1 Then
               Gstestline = Filedatetime()
               Print #1 , Gstestline
               Printdoserror
           Elseif Gbcnttoken = 2 Then
               Gstoken = Getnexttokenstr(12)
               Gstoken = Trim(gstoken)
               Gstestline = Filedatetime(gstoken)
               Print Gstestline
               Printdoserror
           Else
              Printparametercounterror "0 or 1 "
           End If

         Case "FILELEN"
           If Gbcnttoken = 1 Then
               Llong1 = Filelen()
               Print #1 , Llong1
               Printdoserror
           Elseif Gbcnttoken = 2 Then
               Gstoken = Getnexttokenstr(12)
               Gstoken = Trim(gstoken)
               Llong1 = Filelen(gstoken)
               Print #1 , Llong1
               Printdoserror
           Else
              Printparametercounterror "0 or 1 "
           End If


         Case "GETATTR"
           If Gbcnttoken = 1 Then
'               lByte1 = GetAttr()
               'Print #1 , Bin(lbyte1)   '####
               Printdoserror
           Elseif Gbcnttoken = 2 Then
               Gstoken = Getnexttokenstr(12)
               Gstoken = Trim(gstoken)
               Lbyte1 = Getattr(gstoken)
              ' Print #1 , Bin(lbyte1)     '####
               Printdoserror
           Else
              Printparametercounterror "0 or 1 "
           End If

         Case "TYPE"                                        ' Type ASCII-file (sector by sector)
           If Gbcnttoken = 2 Then
               Gstoken = Getnexttokenstr(12)
               Gstoken = Trim(gstoken)
               'Lbyte1 = Printfile(gstoken)
               Typewildcard Gstoken
               'Printdoserror
           Else
              Printparametercounterror "1 "
           End If

        Case "DUMP"                                         ' Dump file
           If Gbcnttoken = 2 Then
               Gstoken = Getnexttokenstr(12)
               Gstoken = Trim(gstoken)
               Lbyte1 = Dumpfile(gstoken)
               Printdoserror
           Else
              Printparametercounterror "1 "
           End If


         Case "FOO"                                         ' File open for Output
            If Gbcnttoken > 1 Then
               Gstoken = Getnexttokenstr(12)
               Gstoken = Trim(gstoken)
               If Gbcnttoken > 2 Then
                  Llong1 = Getnexttokenlong(1 , 255)
                  Lbyte2 = Llong1
                  Open Gstoken For Output As #lbyte2
               Else
                  Lbyte2 = Freefile()
                  Open Gstoken For Output As #lbyte2
               End If
               If Gbdoserror <> 0 Then
                  Printdoserror
               Else
                  Print #1 , "File# = " ; Lbyte2
               End If
           Else
              Printparametercounterror "1 "
           End If

         Case "FOI"                                         ' File open for Input
            If Gbcnttoken > 1 Then
               Gstoken = Getnexttokenstr(12)
               Gstoken = Trim(gstoken)
               If Gbcnttoken > 2 Then
                  Llong1 = Getnexttokenlong(1 , 255)
                  Lbyte2 = Llong1
                  Open Gstoken For Input As #lbyte2
               Else
                  Lbyte2 = Freefile()
                  Open Gstoken For Input As #lbyte2
               End If
               If Gbdoserror <> 0 Then
                  Printdoserror
               Else
                  Print #1 , "File# = " ; Lbyte2
               End If
           Else
              Printparametercounterror "1 "
           End If

        Case "FOB"                                          ' File open for Binary
            If Gbcnttoken > 1 Then
               Gstoken = Getnexttokenstr(12)
               Gstoken = Trim(gstoken)
               If Gbcnttoken > 2 Then
                  Llong1 = Getnexttokenlong(1 , 255)
                  Lbyte2 = Llong1
                  Open Gstoken For Binary As #lbyte2
               Else
                  Lbyte2 = Freefile()
                  Open Gstoken For Binary As #lbyte2
               End If
               If Gbdoserror <> 0 Then
                  Printdoserror
               Else
                  Print #1 , "File# = " ; Lbyte2
               End If
           Else
              Printparametercounterror "1 "
           End If

        Case "FOA"                                          ' File open for Append
            If Gbcnttoken > 1 Then
               Gstoken = Getnexttokenstr(12)
               Gstoken = Trim(gstoken)
               If Gbcnttoken > 2 Then
                  Llong1 = Getnexttokenlong(1 , 255)
                  Lbyte2 = Llong1
                  Open Gstoken For Append As #lbyte2
               Else
                  Lbyte2 = Freefile()
                  Open Gstoken For Append As #lbyte2
               End If
               If Gbdoserror = 0 Then
                  Print #1 , "File# = " ; Lbyte2
               Else
                  Printdoserror
               End If
            Else
              Printparametercounterror "1 "
            End If

       Case "RL"                                            ' File line input
            If Gbcnttoken = 2 Then
               Llong1 = Getnexttokenlong(1 , 255)           ' file#
               Lbyte1 = Llong1
               If Gbpcinputerror = Cpno Then
                  Line Input #lbyte1 , Gstestline
                  If Gbdoserror <> 0 Then
                     Printdoserror
                  Else
                     Print #1 , Gstestline
                  End If
                End If
            Else
               Printparametercounterror "1 "
            End If

        Case "LOC"                                          ' File Location last read/write
             If Gbcnttoken = 2 Then
                Llong1 = Getnexttokenlong(1 , 255)
                If Gbpcinputerror = Cpno Then
                   Lbyte1 = Llong1
                   Llong2 = Loc(#lbyte1)
                   If Gbdoserror = 0 Then
                      Print #1 , Llong2
                   Else
                      Printdoserror
                   End If
                End If
             End If

        Case "LOF"                                          ' File Length
             If Gbcnttoken = 2 Then
                Llong1 = Getnexttokenlong(1 , 255)
                If Gbpcinputerror = Cpno Then
                   Lbyte1 = Llong1
                   Llong2 = Lof(#lbyte1)
                   If Gbdoserror = 0 Then
                      Print #1 , Llong2
                   Else
                       Printdoserror
                   End If
                End If
             Else
                Printparametercounterror "1 "
             End If

        Case "SEEK"                                         ' next byte position to read/write in file
             If Gbcnttoken = 2 Then
                Llong1 = Getnexttokenlong(1 , 255)
                If Gbpcinputerror = Cpno Then
                   Lbyte1 = Llong1
                   Llong2 = Seek(#lbyte1)
                   If Gbdoserror = 0 Then
                      Print #1 , Llong2
                   Else
                       Printdoserror
                   End If
                End If
             Elseif Gbcnttoken = 3 Then
                Llong1 = Getnexttokenlong(1 , 255)
                Llong2 = Getnexttokenlong(1 , 2000000000)
                If Gbpcinputerror = Cpno Then
                   Lbyte1 = Llong1
                   Seek #lbyte1 , Llong2
                   Printdoserror
                End If
             Else
                Printparametercounterror "1 or 2 "
             End If

         Case "DEL"                                         ' delete file
            If Gbcnttoken = 1 Then
               Gstoken = "*.*"
               Delete Gstoken
           Elseif Gbcnttoken = 2 Then
               Gstoken = Getnexttokenstr(12)
               Gstoken = Trim(gstoken)
               Delete Gstoken
           Else
              Printparametercounterror "0 or 1 "
           End If

         Case "WL"                                          ' Write line to file
            If Gbcnttoken = 3 Then
               Llong1 = Getnexttokenlong(1 , 255)
               Lbyte1 = Llong1
               Gstoken = Getnexttokenstr(70)
               Gstestline = Ltrim(gstoken) : Print #lbyte1 , Gstestline
               Printdoserror
            Else
               Printparametercounterror "1 "
            End If

         Case "WLM"                                         ' write multiple lines to file
            If Gbcnttoken = 5 Then
               Llong1 = Getnexttokenlong(1 , 255)
               Llong2 = Getnexttokenlong(1 , 100000)
               Llong3 = Getnexttokenlong(1 , 1000000)
               Lbyte1 = Llong1
               Gstoken = Getnexttokenstr(70) : Gstoken = Ltrim(gstoken)
               If Gbpcinputerror = Cpno Then
                  For Llong4 = Llong2 To Llong3
                     Gstestline = Gstoken + " "
                     Gstestline = Gstoken + Str(llong4)

                    Print #lbyte1 , Gstestline
                    If Gbdoserror <> 0 Then
                       Printdoserror
                       Exit For
                    End If
                  Next
               End If
            Else
               Printparametercounterror "4 "
            End If

         Case "CLOSE"                                       ' Close file
            If Gbcnttoken = 2 Then
               Llong1 = Getnexttokenlong(1 , 255)
               Lbyte1 = Llong1
               Close #lbyte1
               Printdoserror
            Else
               Printparametercounterror "1 "
            End If

         Case "FLUSH"                                       ' flush file
            Lbyte2 = 0
            If Gbcnttoken = 1 Then
               Flush
            Elseif Gbcnttoken = 2 Then
               Llong1 = Getnexttokenlong(1 , 255)
               Lbyte1 = Llong1
               Flush #lbyte1

            Else
               Printparametercounterror "0 or 1 "
            End If
            Printdoserror

         Case "BSAVE"                                       ' save SRAM to file
            If Gbcnttoken = 4 Then
                Gstoken = Getnexttokenstr(12)               ' Filename
                Llong1 = Getnexttokenlong(0 , &HFFFF)       ' Start
                Llong2 = Getnexttokenlong(1 , &HFFFF)       ' Length
                Lword1 = Llong1 : Lword2 = Llong2
                If Gbpcinputerror = Cpno Then
                    Bsave Gstoken , Lword1 , Lword2
                    Printdoserror
                End If
             Else
               Printparametercounterror "3 "
            End If

        Case "BLOAD"                                        ' load SRAM with file content
            If Gbcnttoken = 3 Then
                Gstoken = Getnexttokenstr(12)               ' Filename
                Llong1 = Getnexttokenlong(0 , &HFFFF)       ' Start
                Lword1 = Llong1
                If Gbpcinputerror = Cpno Then
                    Llong2 = Varptr(gbdoserror)
                    Llong2 = Llong2 + C_filesystemsramsize
                    If Llong2 > Llong1 Then
                        Print #1 , "Command rejected, because it overwrites AVR-DOS in SRAM"
                    Else
                        Bload Gstoken , Lword1
                    End If
                    Printdoserror
                End If
             Else
               Printparametercounterror "2 "
            End If

        Case "FILEATTR"                                     ' File open mode
            If Gbcnttoken = 2 Then
               Llong1 = Getnexttokenlong(1 , 255)
               Lbyte1 = Llong1
               Lbyte2 = Fileattr(lbyte1)
               If Lbyte2 <> 0 Then
                  Print #1 , Lbyte2
               Else
                  Printdoserror
               End If
            Else
               Printparametercounterror "1 "
            End If

        Case "FREEFILE"                                     ' File open mode
            If Gbcnttoken = 1 Then
               Lbyte2 = Freefile()
               If Lbyte2 <> 0 Then
                  Print #1 , Lbyte2
               Else
                  Printdoserror
               End If
            Else
               Printparametercounterror "no "
            End If

        Case "EOF"                                          ' File open mode
            If Gbcnttoken = 2 Then
               Llong1 = Getnexttokenlong(1 , 255)
               Lbyte1 = Llong1
               Lbyte2 = Eof(#lbyte1)
               If Gbdoserror = 0 Then
                  Print #1 , Lbyte2
               Else
                  Printdoserror
               End If
            Else
               Printparametercounterror "1 "
            End If


         Case "PUTL"
            If Gbcnttoken > 2 Then
               Llong1 = Getnexttokenlong(1 , 255)
               Llong2 = Getnexttokenlong( -10000000 , 10000000)
               Lbyte1 = Llong1
               If Gbcnttoken > 3 Then
                  Llong3 = Getnexttokenlong(1 , 10000000)
                  Put #lbyte1 , Llong2 , Llong3
               Else
                  Put #lbyte1 , Llong2
               End If
               Printdoserror
            Else
               Printparametercounterror "2 or 3 "
            End If

         Case "GETL"
            If Gbcnttoken > 1 Then
               Llong1 = Getnexttokenlong(1 , 255)
               Lbyte1 = Llong1
               If Gbcnttoken > 2 Then
                  Llong3 = Getnexttokenlong(1 , 10000000)
                  Get #lbyte1 , Llong2 , Llong3
               Else
                  Get #lbyte1 , Llong2
               End If
               If Gbdoserror <> 0 Then
                  Printdoserror
               Else
                  Print #1 , Llong2
               End If
            Else
               Printparametercounterror "1 or 2 "
            End If


         Case "PUTB"
            If Gbcnttoken > 2 Then
               Llong1 = Getnexttokenlong(1 , 255)
               Llong2 = Getnexttokenlong(0 , 255)
               Lbyte1 = Llong1
               Lbyte3 = Llong2
               If Gbcnttoken > 3 Then
                  Llong3 = Getnexttokenlong(1 , 10000000)
                  Put #lbyte1 , Lbyte3 , Llong3
               Else
                  Put #lbyte1 , Lbyte3
               End If
               Printdoserror
            Else
               Printparametercounterror "2 or 3 "
            End If

         Case "GETB"
            If Gbcnttoken > 1 Then
               Llong1 = Getnexttokenlong(1 , 255)
               Lbyte1 = Llong1
               If Gbcnttoken > 2 Then
                  Llong3 = Getnexttokenlong(1 , 10000000)
                  Get #lbyte1 , Lbyte3 , Llong3
               Else
                  Get #lbyte1 , Lbyte3
               End If
               If Gbdoserror <> 0 Then
                  Printdoserror
               Else
                  Print #1 , Lbyte3
               End If
            Else
               Printparametercounterror "1 or 2 "
            End If

         Case "PUTI"
            If Gbcnttoken > 2 Then
               Llong1 = Getnexttokenlong(1 , 255)
               Llong2 = Getnexttokenlong( -32767 , 32767)
               Lbyte1 = Llong1
               Lint1 = Llong2
               If Gbcnttoken > 3 Then
                  Llong3 = Getnexttokenlong(1 , 10000000)
                  Put #lbyte1 , Lint1 , Llong3
               Else
                  Put #lbyte1 , Lint1
               End If
               Printdoserror
            Else
               Printparametercounterror "2 or 3 "
            End If

         Case "PUTW"
            If Gbcnttoken > 2 Then
               Llong1 = Getnexttokenlong(1 , 255)
               Llong2 = Getnexttokenlong(0 , 65635)
               Lbyte1 = Llong1
               Lword1 = Llong2
               If Gbcnttoken > 3 Then
                  Llong3 = Getnexttokenlong(1 , 10000000)
                  Put #lbyte1 , Lword1 , Llong3
               Else
                  Put #lbyte1 , Lword1
               End If
               Printdoserror
            Else
               Printparametercounterror "2 or 3 "
            End If

         Case "GETI"
            If Gbcnttoken > 1 Then
               Llong1 = Getnexttokenlong(1 , 255)
               Lbyte1 = Llong1
               If Gbcnttoken > 2 Then
                  Llong3 = Getnexttokenlong(1 , 10000000)
                  Get #lbyte1 , Lint1 , Llong3
               Else
                  Get #lbyte1 , Lint1
               End If
               If Gbdoserror <> 0 Then
                  Printdoserror
               Else
                  Print #1 , Lint1
               End If
            Else
               Printparametercounterror "1 or 2 "
            End If

         Case "GETW"
            If Gbcnttoken > 1 Then
               Llong1 = Getnexttokenlong(1 , 255)
               Lbyte1 = Llong1
               If Gbcnttoken > 2 Then
                  Llong3 = Getnexttokenlong(1 , 10000000)
                  Get #lbyte1 , Lword1 , Llong3
               Else
                  Get #lbyte1 , Lword1
               End If
               If Gbdoserror <> 0 Then
                  Printdoserror
               Else
                  Print #1 , Lword1
               End If
            Else
               Printparametercounterror "1 or 2 "
            End If

         Case "PUTS"
            If Gbcnttoken > 2 Then
               Llong1 = Getnexttokenlong(1 , 255)
               Gstoken = Getnexttokenstr(70) : Gstoken = Trim(gstoken) : Lsingle1 = Val(gstoken)
               Lbyte1 = Llong1
               If Gbcnttoken > 3 Then
                  Llong3 = Getnexttokenlong(1 , 10000000)
                  Put #lbyte1 , Lsingle1 , Llong3
               Else
                  Put #lbyte1 , Lsingle1
               End If
               Printdoserror
            Else
               Printparametercounterror "2 or 3 "
            End If

         Case "GETS"
            If Gbcnttoken > 1 Then
               Llong1 = Getnexttokenlong(1 , 255)
               Lbyte1 = Llong1
               If Gbcnttoken > 2 Then
                  Llong3 = Getnexttokenlong(1 , 10000000)
                  Get #lbyte1 , Lsingle1 , Llong3
               Else
                  Get #lbyte1 , Lsingle1
               End If
               If Gbdoserror <> 0 Then
                  Printdoserror
               Else
                  'Print #1 , Lsingle1               '####
               End If
            Else
               Printparametercounterror "1 or 2 "
            End If

         Case "PUTT"
            If Gbcnttoken > 2 Then
               Llong1 = Getnexttokenlong(1 , 255)
               Gstoken = Getnexttokenstr(70) : Gstoken = Trim(gstoken)
               Lbyte1 = Llong1
               If Gbcnttoken > 3 Then
                  Llong3 = Getnexttokenlong(1 , 100000000)
                  Llong4 = Getnexttokenlong(1 , 255)
                  Put #lbyte1 , Gstoken , Llong3 , Llong4
               Else
                  Put #lbyte1 , Gstoken
               End If
               Printdoserror
            Else
               Printparametercounterror "2 or 3 "
            End If

         Case "GETT"
            If Gbcnttoken > 1 Then
               Gstoken = ""
               Llong1 = Getnexttokenlong(1 , 255)
               Lbyte1 = Llong1
               If Gbcnttoken > 2 Then
                  Llong3 = Getnexttokenlong(1 , 100000000)
                  Llong4 = Getnexttokenlong(1 , 255)
                  Get #lbyte1 , Gstoken , Llong3 , Llong4
               Else
                  Get #lbyte1 , Gstoken
               End If
               If Gbdoserror <> 0 Then
                  Printdoserror
               Else
                  Print #1 , Gstoken
               End If
            Else
               Printparametercounterror "1 or 2 "
            End If

         Case "TIME"

            If Gbcnttoken = 1 Then
               Print #1 , Time$
            Elseif Gbcnttoken = 2 Then
               Time$ = Getnexttokenstr(8)
            Else
               Printparametercounterror "0 or 1"
            End If

         Case "DATE"

            If Gbcnttoken = 1 Then
               Print #1 , Date$
            Elseif Gbcnttoken = 2 Then
               Date$ = Getnexttokenstr(8)
            End If


         Case "DISKFREE"

            If Gbcnttoken = 1 Then
               Llong1 = Diskfree()
               Print #1 , Llong1
            End If

         Case "DISKSIZE"
            Llong1 = Disksize()
            Print #1 , Llong1

         Case "FILEINFO"
            If Gbcnttoken = 2 Then
                Llong1 = Getnexttokenlong(1 , 255)
                Lbyte1 = Llong1
                If Gbpcinputerror = Cpno Then
                  Printfileinfo Lbyte1
                End If
            Else
               Printparametercounterror "1"
            End If

         Case "DIRINFO"

            Printdirinfo

         Case "FATINFO"

            Printfatinfo

         Case "FSINFO"
            Printfilesysteminfo

         Case "ERROR"
            Printdoserror
            Print #1 , "Error printed"

         Case "RESET"

            Goto 0

         Case "FIND"                                        ' find line in file, which starts with specified text
            If Gbcnttoken = 2 Then
               Llong1 = Getnexttokenlong(1 , 255)
               Lbyte1 = Llong1
               Lbyte2 = 0
               Lbyte3 = Eof(#lbyte1)
               If Lbyte3 = 0 Then
                  Do
                     Llong1 = Seek(#lbyte1)
                     Line Input #lbyte1 , Gstestline

                     If Mid(gstestline , 1 , 1) = " " Then
                        Lbyte2 = 1
                        Seek #lbyte1 , Llong1
                        Exit Do
                     End If
                  Loop Until Eof(#lbyte1) <> 0
               End If
               If Lbyte2 = 1 Then
                  Print #1 , "Found at position " ; Llong1
               Else
                  Print #1 , "not found"
               End If
               Printdoserror
            Else
               Printparametercounterror "1 "
            End If

        Case "MKDIR"                                        ' File open for Output

            If Gbcnttoken > 1 Then
               Gstoken = Getnexttokenstr(12)
               Gstoken = Trim(gstoken)

               Mkdir Gstoken

               If Gbdoserror <> 0 Then
                  Printdoserror
               End If
           Else
              Printparametercounterror "1 "
           End If

        Case "CHDIR"                                        ' File open for Output

            If Gbcnttoken > 1 Then
               Gstoken = Getnexttokenstr(12)
               Gstoken = Trim(gstoken)

               Chdir Gstoken

               If Gbdoserror <> 0 Then
                  Printdoserror
               End If
           Else
              Printparametercounterror "1 "
           End If


       Case "RMDIR"                                         ' File open for Output

            If Gbcnttoken > 1 Then
               Gstoken = Getnexttokenstr(12)
               Gstoken = Trim(gstoken)

               Rmdir Gstoken

               If Gbdoserror <> 0 Then
                  Printdoserror
               End If
           Else
              Printparametercounterror "1 "
           End If


       Case "NAME"                                          ' File open for Output

            If Gbcnttoken > 2 Then
               Gstoken = Getnexttokenstr(12)
               Gstoken = Trim(gstoken)
               Gstestline = Getnexttokenstr(12)
               Gstestline = Trim(gstestline)

               Name Gstoken As Gstestline

               If Gbdoserror <> 0 Then
                  Printdoserror
               End If
           Else
              Printparametercounterror "1 "
           End If

         Case Else

            Print #1 , "Command '" ; Gspcinput ; "' not recognized"

      End Select

      If Transferbuffer_write > 511 Then
         Transferbuffer_write = 0
      End If

   End If
End Sub


Sub Extracttoken
' Counts the Token in the Input-String: gsPCInput
' following variable and arrays are filled
' cntToken: Cont of Token
' PosStrParts: positions, where the tokens start
' LenStrParts: Count of bytes of each token

   Local Lstrlen As Byte
   Local Lparseend As Byte
   Local Lpos1 As Byte , Lpos2 As Byte
   ' Init arrays with 0
   For Gbcnttoken = 1 To Cptoken_max
      Gbposstrparts(gbcnttoken) = 0 : Gblenstrparts(gbcnttoken) = 0
   Next

   Gbcnttoken = 0
   Gspcinput = Trim(gspcinput)
   Lstrlen = Len(gspcinput)                                 ' how long is string
   If Lstrlen = 0 Then                                      'no Input ?
      Exit Sub
   End If
   Lparseend = 0
   Lpos1 = 0
   For Gbcnttoken = 1 To Cptoken_max
      Incr Lpos1
      If Gbcnttoken = 1 Then
         Lpos2 = Instr(lpos1 , Gspcinput , " ")             ' find next blank
      Else
         Lpos2 = Instr(lpos1 , Gspcinput , Cpstrsep)        ' After command look with strSep
      End If
      If Lpos2 = 0 Then                                     ' no more found?
         Lpos2 = Lstrlen : Incr Lpos2 : Lparseend = 1
      End If
      Gblenstrparts(gbcnttoken) = Lpos2 - Lpos1             ' Lenght of token
      Gbposstrparts(gbcnttoken) = Lpos1
      If Lparseend = 1 Then
         Exit For
      End If
      Lpos1 = Lpos2
   Next
End Sub


Function Getnexttokenstr(byval Pblen_max As Byte ) As String
   ' Returns next String-token from Input
   ' Parameter: pbLen_Max: Limit for string-length
   Local Lbpos As Byte
   Local Lblen As Byte
   Incr Gbtoken_actual                                      ' switch to new/next token
   Lbpos = Gbposstrparts(gbtoken_actual)                    ' at which position in string
   Lblen = Gblenstrparts(gbtoken_actual)                    ' how long
   If Lblen > Pblen_max Then Lblen = Pblen_max              ' to long?
   Getnexttokenstr = Mid(gspcinput , Lbpos , Lblen)         ' return string
End Function


Function Getnexttokenlong(byval Plmin As Long , Byval Plmax As Long ) As Long
   ' returns a Long-Value from next Token and check for inside lower and upper limit
   ' plMin: minimum limit for return-value
   ' plMax: maximum limit for return-value
   Local Lbpos As Byte
   Local Lblen As Byte
   Local Lstoken As String * 12
   Incr Gbtoken_actual                                      ' switch to new/next token
   Lbpos = Gbposstrparts(gbtoken_actual)                    ' at which position in string
   Lblen = Gblenstrparts(gbtoken_actual)                    ' how long
   If Lblen > 12 Then Lblen = 12                            ' to long?
   Lstoken = Mid(gspcinput , Lbpos , Lblen)
   Lstoken = Ltrim(lstoken)
   If Mid(lstoken , 1 , 1) = "$" Then                       ' Is input a HEX vlue?
      Mid(lstoken , 1 , 1) = " "
      Lstoken = Ltrim(lstoken)
      Getnexttokenlong = Hexval(lstoken)
   Else
      Getnexttokenlong = Val(lstoken)
   End If
   Select Case Getnexttokenlong                             ' check for limits
      Case Plmin To Plmax                                   ' within limits, noting to do
      Case Else
         Gbpcinputerror = Cpyes                             ' Set Error Sign
         Print #1 , "    " ;
'         print #1 , Spc(lbPos) ; ' bug in 1.11.7.4 using SPC() in SW-Uart
         Gstestline = Space(lbpos) : Print #1 , Gstestline ;
         Print #1 , "^ " ; "Parameter Error ";
         Printparametererrorl Plmin , Plmax                 ' with wanted limits
   End Select
End Function


Sub Printparametercounterror(byval Psparm_anzahl As String * 10)
   ' User message for wrong count of parameter
   Print #1 , "? " ; Psparm_anzahl ; " " ; "Parameter " ; "expected "
End Sub

Sub Printparametererrorl(plparamlow As Long , Plparamhigh As Long)
   ' Print Limits at wrong Input - value
   Print #1 , " [ " ; Plparamlow ; " ] - [ " ; Plparamhigh ; " ] " ; "expected "
End Sub


Sub Printprompt()
    Print #1 ,
    Print #1 , Hex(transferbuffer_write) ; ">" ;
End Sub


Function Getlongfrombuffer(pbsramarray As Byte , Byval Pbpos As Word) As Long
   ' Extract a Long-Value from a Byte-Array
   ' pbSRAMArray: Byte-array, from which the Long-value should be extracted
   ' pbPos: Position, at which the Long-Value starts (0-based)
   Loadadr Pbsramarray , Z
   Loadadr Pbpos , X
   ld r24, x+
   ld r25, x+
   add zl, r24
   adc zh, r25
   Loadadr Getlongfrombuffer , X
   !Call _ZXMem4_copy
End Function


Function Getwordfrombuffer(pbsramarray As Byte , Byval Pbpos As Word) As Word
   ' Extract a Word-value from a Byte-Array
   ' pbSRAMArray: Byte-array, from which the Word-value should be extracted
   ' pbPos: Position, at which the Word-Value starts (0-based)
   Loadadr Pbsramarray , Z
   Loadadr Pbpos , X
   ld r24, x+
   ld r25, x+
   add zl, r24
   adc zh, r25
   Loadadr Getwordfrombuffer , X
   ldi r24, 2
   !Call _ZXMem_copy
End Function


Sub Sramdump(pwsrampointer As Word , Byval Pwlength As Word , Plbase As Long)
    ' Dump a Part of SRAM to Print-Output #1
    ' pwSRAMPointer: (Word) Variable which holds the address of SRAM to dump
    ' pwLength: (Word) Count of Bytes to be dumped (1-based)
    Local Lsdump As String * 16
    Local Lbyte1 As Byte , Lbyte2 As Byte
    Local Lword1 As Word , Lword2 As Word
    Local Llong1 As Long

    If Pwlength > 0 Then
      Decr Pwlength
      For Lword1 = 0 To Pwlength
         Lword2 = Lword1 Mod 8
         If Lword2 = 0 Then
            If Lword1 > 0 Then
               Print #1 , " " ;
            End If
         End If
         Lword2 = Lword1 Mod 16
         If Lword2 = 0 Then
            If Lword1 > 0 Then
               Print #1 , "  " ; Lsdump
            End If
            Llong1 = Plbase + Lword1
            Print #1 , Hex(llong1) ; "  " ;
            Lsdump = "                "
            Lbyte2 = 1
         End If
         Lbyte1 = Inp(pwsrampointer)
         Incr Pwsrampointer
         Print #1 , Hex(lbyte1) ; " " ;
         If Lbyte1 > 31 Then
            Mid(lsdump , Lbyte2 , 1) = Lbyte1
         Else
             Mid(lsdump , Lbyte2 , 1) = "."
         End If
         Incr Lbyte2
      Next
      Print #1 , "   " ; Lsdump
    End If
    Incr Pwlength
    Plbase = Plbase + Pwlength
End Sub

Sub Eramdump(pwerampointer As Word , Byval Pwlength As Word)
    ' Dump a Part of ERAM to Print-Output #1
    ' pwERAMPointer: (Word) Variable which holds the address of ERAM to dump
    ' pwLength: (Word) Count of Bytes to be dumped (1-based)
    Local Lsdump As String * 16
    Local Lbyte1 As Byte , Lbyte2 As Byte
    Local Lword1 As Word , Lword2 As Word

    If Pwlength > 0 Then
      Decr Pwlength
      For Lword1 = 0 To Pwlength
         Lword2 = Lword1 Mod 8
         If Lword2 = 0 Then
            If Lword1 > 0 Then
               Print #1 , " " ;
            End If
         End If
         Lword2 = Lword1 Mod 16
         If Lword2 = 0 Then
            If Lword1 > 0 Then
               Print #1 , "  " ; Lsdump
            End If
            Print #1 , Hex(lword1) ; "  " ;
            Lsdump = "                "
            Lbyte2 = 1
         End If
         Readeeprom Lbyte1 , Pwerampointer
         Incr Pwerampointer
         Print #1 , Hex(lbyte1) ; " " ;
         If Lbyte1 > 31 Then
            Mid(lsdump , Lbyte2 , 1) = Lbyte1
         Else
             Mid(lsdump , Lbyte2 , 1) = "."
         End If
         Incr Lbyte2
      Next
      Print #1 , "   " ; Lsdump
    End If
End Sub



' -----------------------------------------------------------------------------
' copy Memory from (Z) nach (X)
' counts of bytes in r24
_zxmem4_copy:
   ldi r24, 4
_zxmem_copy:
   ld r25, z+
   st x+, r25
   dec r24
   brne _ZXMem_copy
   ret

 ' Declaration of Functions

' Print DOS Error Number
Sub Printdoserror()
   If Gbdoserror > 0 Then
      Print #1 , "DOS Error: " ; Gbdoserror
   End If
   If Gbdriveerror > 0 Then
      Printdriveerror
   End If
End Sub

Sub Printdriveerror()
   If Gbdriveerror > 0 Then
      Print #1 , "Drive Error: " ; Gbdriveerror
      Print #1 , "Drive Status:" ; Bin(gbdrivestatusreg)
      Print #1 , "Drive Debug: " ; Gbdrivedebug
   End If
End Sub


' Read and print Directory, Filename, Date, Time, Size
' Input Filename in form "name.ext"
Sub Directory(pstr1 As String)
   Local Lfilename As String * 12                           ' hold file name for print
   Local Lwcounter As Word , Lfilesizesum As Long           ' for summary
   Local Lbyte1 As Byte , Llong1 As Long
   Lwcounter = 0 : Lfilesizesum = 0
   Lfilename = Dir(pstr1)
   While Lfilename <> ""
      Print #1 , Lfilename;
      Lbyte1 = 14 - Len(lfilename)
      'print #1 , spc(lByte1); Bug in 1.11.7.4  on soft-uart
      Gstestline = Space(lbyte1) : Print #1 , Gstestline ;

      Llong1 = Filelen()
      Print #1 , Filedate() ; " " ; Filetime() ; " " ;
'      lByte1 = getAttr()
      If Lbyte1.4 = 1 Then
         Print #1 , "Dir"
      Else
         Print #1 , Llong1
      End If
      Incr Lwcounter : Lfilesizesum = Lfilesizesum + Llong1
      Lfilename = Dir()
   Wend
   Print #1 , Lwcounter ; " File(s) found with " ; Lfilesizesum ; " Byte(s)"
End Sub


Sub Delete(pstr1 As String)
   Local Lfilename As String * 12 , Lbyte1 As Byte          ' hold file name for print
   Lfilename = Dir(pstr1)
   While Lfilename <> ""
'      lByte1 = GetAttr()
      If Lbyte1.4 = 0 Then
         Print #1 , "Delete File: " ; Lfilename
         Kill Lfilename
      End If
      Lfilename = Dir()
   Wend
End Sub


Sub Typewildcard(pstr1 As String)
   Local Lfilename As String * 12                           ' hold file name for print
   Local Lbyte1 As Byte , Lbyte2 As Byte
   Lbyte2 = 0
   Lfilename = Dir(pstr1)
   If Lfilename = "" Then
      Print #1 , "No File found for " ; Pstr1
      Exit Sub
   End If
   While Lfilename <> ""
      Print #1 , "File " ; Lfilename ; " is printed ..."
      Lbyte1 = Printfile(lfilename)
      Print #1 , " "
      Lfilename = Dir()
      Incr Lbyte2
   Wend
   Print #1 , Lbyte2 ; " Files printed"
End Sub


' Read and print Directory and show Filename, Date, Time, Size
' for all files matching pStr1 and create/update younger than pDays
Sub Directory1(pstr1 As String , Pdays As Word)
   Local Lfilename As String * 12                           ' hold file name for print
   Local Lwcounter As Word , Lfilesizesum As Long           ' for summary
   Local Lwnow As Word , Lwdays As Word
   Local Lsec As Byte , Lmin As Byte , Lhour As Byte , Lday As Byte , Lmonth As Byte , Lyear As Byte
   Print #1 , "Listing of all Files matching " ; Pstr1 ; " and  create/last update date within " ; Pdays ; " days"
   Lwnow = Sysday()
   Lwcounter = 0 : Lfilesizesum = 0
   Lfilename = Dir(pstr1)
   While Lfilename <> ""
      Lsec = Filedatetime()
      Lwdays = Lwnow - Sysday(lday)                         ' Days between Now and last File Update
      If Lwdays <= Pdays Then                               ' days smaller than desired with parameter
         Print #1 , Lfilename ; Filedate() ; " " ; Filetime() ; " " ; Filelen()
         Incr Lwcounter : Lfilesizesum = Filelen() + Lfilesizesum
      End If
      Lfilename = Dir()
   Wend
   Print #1 , Lwcounter ; " File(s) found with " ; Lfilesizesum ; " Byte(s)"
End Sub


 'Declare Function PrintFile(psName as String) as Byte
' Print File Sector by Sector
Function Printfile(psname As String) As Byte
$external _getfreefilenumber , _normfilename , _openfile , _loadfilebufferstatusyz , _addrfilebuffer2x
$external _loadnextfilesector , _closefilehandle , _cleardoserror
Local Lstr1 As String * 1 , Lstr2 As String * 1
   !call _GetFreeFileNumber                                 ' to get free file# in r24
   brcs _PrintFileEnd                                       ' Error?; if C-set
   push r24                                                 ' File#
   Loadadr Psname , X
   !call _NormFileName                                      ' Result: Z-> Normalized name
   pop r24                                                  ' File#
   ldi r25, cpFileOpenInput                                 ' Read only and archive-bit allowed
   !call _OpenFile                                          ' Search file, set File-handle and load first sector
   brcs _PrintFileEnd                                       ' Error?; if C-set
   sbiw yl, 2                                               ' If Openfile OK! then (Y-2), (Y-1) -> Filehandle
_printfile2:
   !call  _LoadFileBufferStatusYZ                           ' Someting to read?
   sbrc r24, dEOF                                           ' End of File?
   rjmp _PrintFile3
   !call _addrFileBuffer2X                                  ' put String (sector) start now in X
'   !call _SendString0                   ' X at sector-buffer basis
' trick to fool Print #1 to print 512 long string
   st Y+2, xl
   st Y+3, xh
   Print #1 , Lstr1 ;                                       ' Address pointer is shifted one position
                                         ' because of using Y-pointer for AVR-DOS

   !call _LoadNextFileSector_Position
   brcc _PrintFile2                                         ' Loop to print next sector; irregular Error if C-set
_printfile3:
   !call _CloseFileHandle_Y
   adiw yl, 2                                               ' Restore Y
   !call _ClearDOSError
_printfileend:
   Loadadr Printfile , X
   st X, r25                                                ' give Error code back
End Function


'Declare Function DumpFile(psName as String) as Byte

Function Dumpfile(psname As String) As Byte
   Gldumpbase = 0
   !call _GetFreeFileNumber                                 ' to get free file# in r24
   brcs _DumpFileEnd                                        ' Error?; if C-set
   push r24                                                 ' File#
   Loadadr Psname , X
   !call _NormFileName                                      ' Result: Z-> Normalized name
   pop r24                                                  ' File#
   ldi r25, cpFileOpenInput                                 ' Read only and archive-bit allowed
   !call _OpenFile                                          ' Search file, set File-handle and load first sector
   brcs _DumpFileEnd                                        ' Error?; if C-set
   sbiw yl, 2                                               ' If Openfile OK! then (Y-2), (Y-1) -> Filehandle
_dumpfile2:
   !call  _LoadFileBufferStatusYZ                           ' Someting to read?
   sbrc r24, dEOF                                           ' End of File?
   rjmp _DumpFile3
   !call _addrFileBuffer2X
   Loadadr Gword1 , Z
   st Z+, xl
   st Z+, xh
   Sramdump Gword1 , 512 , Gldumpbase
   !call _LoadNextFileSector_Position
   brcc _DumpFile2                                          ' Loop to Dump next sector; irregular Error if C-set
_dumpfile3:
   !call _CloseFileHandle_Y
   adiw yl, 2                                               ' Restore Y
   !call _ClearDOSError
_dumpfileend:
   Loadadr Dumpfile , X
   st X, r25                                                ' give Error code back
End Function


Sub Printfilesysteminfo()
   Print #1 , "File System:         " ; Gbfilesystem
   Print #1 , "File System Status:  " ; Gbfilesystemstatus
   Print #1 , "FAT first Sector:    " ; Glfatfirstsector
   Print #1 , "Number of FATs:      " ; Gbnumberoffats
   Print #1 , "Sectors per FAT:     " ; Glsectorsperfat
   Print #1 , "Root first Sector:   " ; Glrootfirstsector
   Print #1 , "Root Entries:        " ; Gwrootentries
   Print #1 , "Data first Sector:   " ; Gldatafirstsector
   Print #1 , "Sectors per Cluster: " ; Gbsectorspercluster
   Print #1 , "Highest Cluster#:    " ; Glmaxclusternumber
   Print #1 , "Start check Cluster# " ; Gllastsearchedcluster
End Sub

Sub Printdirinfo()
   Local Lwtemp1 As Word , Lltemp1 As Long
    Print #1 , "Dir first Sector#: " ; Gldirfirstsectornumber
    Print #1 , "Free Dir Entry#:   " ; Gwfreedirentry
    Print #1 , "Free Dir Sector#   " ; Glfreedirsectornumber
    Print #1 , "Dir0 File name     " ; Gsdir0tempfilename
    Print #1 , "Dir0 Entry         " ; Gwdir0entry
    Print #1 , "Dir0 Sector#       " ; Gldir0sectornumber
    Print #1 , "File Name          " ; Gstempfilename
    Print #1 , "Dir Entry#         " ; Gwdirentry
    Print #1 , "Dir Sector#        " ; Gldirsectornumber
    Print #1 , "Dir buffer status  " ; Bin(gbdirbufferstatus)
    Lltemp1 = 0
    Lwtemp1 = Varptr(gbdirbuffer(1))
    Sramdump Lwtemp1 , 512 , Lltemp1
End Sub

Sub Printfatinfo()
   Local Lwtemp1 As Word , Lltemp1 As Long
#if Csepfathandle = 1
   Print #1 , "FAT Sector#        " ; Glfatsectornumber
   Print #1 , "FAT buffer status  " ; Bin(gbfatbufferstatus)
   Lwtemp1 = Varptr(gbfatbuffer(1))
   Lltemp1 = 0
   Sramdump Lwtemp1 , 512 , Lltemp1
#else
    Print #1 , "Directory and FAT handled with on buffer"
    Print #1 , "Dir Entry#         " ; Gwdirentry
    Print #1 , "Dir Sector#        " ; Gldirsectornumber
    Print #1 , "Dir buffer status  " ; Bin(gbdirbufferstatus)
    Lltemp1 = 0
    Lwtemp1 = Varptr(gbdirbuffer(1))
    Sramdump Lwtemp1 , 512 , Lltemp1
#endif
End Sub


Sub Printfileinfo(pbfilenr As Byte)
  Local Lltemp1 As Long
  Local Lbfilenumber As Byte
  Local Lbfilemode As Byte
  Local Lwfiledirentry As Word
  Local Llfiledirsectornumber As Long
  Local Llfilefirstcluster As Long
  Local Llfilesize As Long
  Local Llfileposition As Long
  Local Llfilesectornumber As Long
  Local Lbfilebufferstatus As Byte
  Local Lwfilebufferaddress As Word
  Loadadr Pbfilenr , X
  ld r24, X
  !Call _GetFileHandle
  brcc PrintFileInfo1
  rjmp PrintFileInfoError
Printfileinfo1:
   Loadadr Lbfilenumber , X
   ldi r24, 25
   !Call _Mem_Copy
   Loadadr Lwfilebufferaddress , X
   st X+, zl
   st X+, zh
   Print #1 , "Handle#:        " ; Lbfilenumber
   Print #1 , "Open mode:      " ; Bin(lbfilemode)
   Print #1 , "Dir Entry#:     " ; Lwfiledirentry
   Print #1 , "Dir Sector#:    " ; Llfiledirsectornumber
   Print #1 , "First Cluster#: " ; Llfilefirstcluster
   Print #1 , "Size:           " ; Llfilesize
   Print #1 , "Position:       " ; Llfileposition
   Print #1 , "Sector#:        " ; Llfilesectornumber
   Print #1 , "Buffer Status:  " ; Bin(lbfilebufferstatus)
   Lltemp1 = 0
   Sramdump Lwfilebufferaddress , 512 , Lltemp1
   Exit Sub
Printfileinfoerror:
   Print #1 , "No Filehandle for " ; Pbfilenr ; " found"
End Sub


Sub Getdatetime
  I2cstart                                                  ' Generate start code
  I2cwbyte Ds1337w                                          ' send address
  I2cwbyte 0                                                ' start address in 1307

  I2cstart                                                  ' Generate start code
  I2cwbyte Ds1337r                                          ' send address
  I2crbyte _sec , Ack
  I2crbyte _min , Ack                                       ' MINUTES
  I2crbyte _hour , Ack                                      ' Hours
  I2crbyte _day , Ack                                       ' Day of Week  dummy
  I2crbyte _day , Ack                                       ' Day of Month
  I2crbyte _month , Ack                                     ' Month of Year
  I2crbyte _year , Nack                                     ' Year
  I2cstop
  _sec = Makedec(_sec) : _min = Makedec(_min) : _hour = Makedec(_hour)
  _day = Makedec(_day) : _month = Makedec(_month) : _year = Makedec(_year)
End Sub


Sub Setdate
  _day = Makebcd(_day) : _month = Makebcd(_month) : _year = Makebcd(_year)
  I2cstart                                                  ' Generate start code
  I2cwbyte Ds1337w                                          ' send address
  I2cwbyte 4                                                ' starting address in 1337
  I2cwbyte _day                                             ' Send Data to SECONDS
  I2cwbyte _month                                           ' MINUTES
  I2cwbyte _year                                            ' Hours
  I2cstop
End Sub


Sub Settime
  _sec = Makebcd(_sec) : _min = Makebcd(_min) : _hour = Makebcd(_hour)
  I2cstart                                                  ' Generate start code
  I2cwbyte Ds1337w                                          ' send address
  I2cwbyte 0                                                ' starting address in 1337
  I2cwbyte _sec                                             ' Send Data to SECONDS
  I2cwbyte _min                                             ' MINUTES
  I2cwbyte _hour                                            ' Hours
  I2cstop
End Sub


Sub Show_i2c
Local Adr As Word
Local Row As Byte
Local Yn As String * 1
Print Chr(&H0c) ;                                           ' Clear screen
Print "I2c-device locator   1 = no device     0 = device"
Print
Print "       0    2    4    6    8    A    C    E"
Print " 0000 ";
   For Adr = 0 To 254 Step 2
      Row = Adr Mod 16                                      ' addresses
      If Row = 0 And Adr > 0 Then
         Print                                              ' end of line?
         Print " " ; Hex(adr) ; " ";
      End If
      I2cstart                                              ' generate start
      I2cwbyte Adr
      Print " " ; Err ; "   ";                              ' 1 no device, 0 device
      I2cstop
   Next Adr
   Print
Print
Input "Any key to continue...." , Yn
Print
End Sub