'==============================================================================
' BASCOM - ASM Interface routines
'==============================================================================


Declare Function GetAttr(psFileName as String) as Byte
Function GetAttr(psFileName as String) as Byte
$EXTERNAL _GetAttr
   loadadr psFileName , X
   loadadr GetAttr , Z
   !Call _GetAttr
End FUNCTION


Declare Function GetAttr0() as Byte
Function GetAttr0() as Byte
$EXTERNAL _GetAttr
   loadadr GetAttr0 , Z
   !Call _GetAttr0
End FUNCTION


Declare Function FileByteInput(byval pbFileNumber as Byte) as Byte

Function FileByteInput(byval pbFileNumber as Byte) as Byte
$EXTERNAL _FileByteInput
   loadadr pbFileNumber , X
   ld r24, X
   !Call _FileByteInput
   loadadr FileByteInput , X
   st X, r24
End Function


Declare Function FileByteOutput(byval pbFileNumber as Byte , pbVariable as Byte) as Byte


Function FileByteOutput(byval pbFileNumber as Byte , pbVariable as Byte) as Byte
$EXTERNAL _FileByteOutput
   loadadr pbFileNumber , X
   ld r24, X
   loadadr pbVariable , X
   ld r25, X
   !Call _FileByteOutput
   loadadr FileByteOutput , X
   st X, r25                            ' error code
End Function



'*******************************************************************************
' functions for the Test - Interpreter but for other use as well
'*******************************************************************************


' Declaration of Functions
Declare Sub SRAMDump(pwSRAMPointer as Word , byVal pwLength as Word , plBase as Long)

Declare Sub PrintDOSError()
' Print DOS Error Number
Sub PRINTDOSERROR()
   if gbDOSError > 0 then
      print "DOS Error: " ; gbDOSError
   end if
End Sub


Declare Sub Directory(pStr1 as String)
' 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 lFileName;
      lByte1 = 14 - len(lFileName)
      print spc(lByte1);
      lByte1 = getattr0()
      lLong1 = filelen()
      Print FileDate() ; " " ; FileTime() ; " " ; bin(lByte1) ; " " ; lLong1
      incr lwCounter : lFileSizeSum = lFileSizeSum + lLong1
      lFileName = Dir()
   WEnd
   print lwCounter ; " File(s) found with " ; lFileSizeSum ; " Byte(s)"
End Sub


Declare Sub Directory1(pStr1 as String , pDays as Word)

' 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 lByte1 as Byte , lLong1 as Long
   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 "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 lFileName ; FileDate() ; " " ; FileTime() ; " " ; filelen()
         incr lwCounter : lFileSizeSum = FileLen() + lFileSizeSum
      end if
      lFileName = Dir()
   WEnd
   print 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 , _GetFileBufferStatus , _FileBuffer2X
$EXTERNAL _LoadNextFileSector , _CloseFileHandle , _ClearDOSError,

   !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  _GetFileBufferStatus_Y        ' Someting to read?
   sbrc r24, dEOF                       ' End of File?
   rjmp _PrintFile3
   !call _FileBuffer2X
   !call _SendString0                   ' X at sector-buffer basis
   !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 PrintFileB(psName as String) as Byte
' Print File Byte by Byte
Function PrintFileB(psName as String) as Byte
$EXTERNAL _GetFreeFileNumber , _NormFileName , _OpenFile , _GetFileBufferStatus , _FileReadByte , _CloseFileHandle
   !call _GetFreeFileNumber             ' to get free file# in r24
   brcs _PrintFileBEnd                  ' Error?; if C-set
   push r24                             ' File#
   loadadr psName , X
   !call _NormFileName                  ' Z-> Normalized Name
   pop r24
   ldi r25, cpFileOpenInput             ' Read only and archiv-bit allowed
   !call _OpenFile                      ' Search file and set File-handle and load first sector
   brcs _PrintFileBEnd                  ' Error?; if C-set
   sbiw yl, 2                           ' If Openfile OK! then (Y-2), (Y-1) -> Filehandle
_PrintFileB2:
   !call  _GetFileBufferStatus_Y        ' Someting to read?
   sbrc r24, dEOF                       ' End of File?
   rjmp _PrintFileB3
   !call _FileReadByte
   !call _SendChar0
   rjmp _PrintFileB2
_PrintFileB3:
   !call _CloseFileHandle_Y
   adiw yl, 2
   clr r25                              ' Restore Y
_PrintFileBEnd:
   loadadr PrintFileB , X
   st X, r25
End Function



dim gWord1 as Word
Dim lDumpBase as Long
Declare Function DumpFile(psName as String) as Byte

Function DumpFile(psName as String) as Byte
   lDumpBase = 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  _GetFileBufferStatus_Y        ' Someting to read?
   sbrc r24, dEOF                       ' End of File?
   rjmp _DumpFile3
   !call _FileBuffer2X
   loadadr gWord1 , Z
   st Z+, xl
   st Z+, xh
   SRAMDump gWord1 , 512 , lDumpBase
   !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