[Euphoria] Decimal to Binary

Having solved the Binary Digits task in mLite and FBSL, I thought I'd have a go in OpenEuphoria. Kudos to David Craig of Rapid Deployment Software for the original implementation and to the subsequent team of heroes for a very powerful Windows/Linux/Mac programming (interpreted and/or compiled) language.

The code below, expressed in v4.1.0 form, follows the FBSL fairly closely.

include std/math.e 
include std/convert.e

function Bin(integer n, sequence s = "")
  if n > 0 then
   return Bin(floor(n/2),(mod(n,2) + #30) & s)
  end if
  if length(s) = 0 then
   return to_integer("0")
  end if
  return to_integer(s)
end function

printf(1, "%d\n", Bin(0))
printf(1, "%d\n", Bin(5))
printf(1, "%d\n", Bin(50))
printf(1, "%d\n", Bin(9000))

There's already an Euphoria solution to the task. Some enterprising soul might want to check which of the two solutions is the faster.

© Copyright Bruce M. Axtens, 2015

[Open Source] Github and Bitbucket

The blog's been very quiet lately. Too quiet. But I've been busy.

I got started on Github, but the only thing I have there is a failed attempt at building a JSON library for the Euphoria programming language.

Most of the more recent stuff is happening on Bitbucket where I have various implementations (javascript v1 and javascript v2 (minimal), euphoria, vb6, php, and c#) of Steve Skiena's integer bignums library and a few other bits and bobs, namely:

• A port of Oscar Brain's Rexx Parse in VB6 to C#,
• a unit test mechanism for the Peloton programming language, and
• SLE, an assembler style stack language for calculating the Ackermann function.

All projects are in varying stages of completeness, and looking for users and improvers.


© Copyright Bruce M. Axtens, 2013

[Euphoria] Structured Access, part 2

I knew I had it somewhere. Okay, these implement the following: BYTE, BYTES, WORD, DWORD, QWORD, ASCIIZ and PSTRING. You can pull the data one chunk at a time as per the last posting or else pull a whole set all at once.

The file versions don't work and I'm not sure why, and as I said before, I don't have the time to do anything about it.

By the way, this was written before Euphoria 2.5. In fact, possibly before 2.4 so the code may need some tweaking.

mread is like the getmem of the previous posting. memread takes a sequences of reads. I will eventually post an example (if I can find one).

(Since writing part 1, I've been in touch with CChris from Euphoria Standard Library who has taken over the development of getmem. It's great to be able to give something back to the Euphoria community after all these years (I've been using it since version 1.5).)

-- tools for structures, based on earlier work in misctool.e
--
-- memload procedure. Initialises memBlock to contents of passed
--      sequence.
-- memread function. Reads memBlock according to parameters and
--      returns as sequence
-- memfree procedure. Frees allocated memory.

-- fmemload procedure. Like memload but sets up for direct file
--      access.
-- fmemread function. Reads file according to parameters.
-- fmemfree procedure. Close file.

include machine.e
include file.e
include get.e

atom memBlock
integer memAllocated

integer fileNumber
integer fileAllocated
integer fileLength

memAllocated = 0
fileAllocated = 1

function mread( integer offset, sequence typ )
        sequence conv
        object result
        integer i
        if equal( typ, "BYTE" ) then
                result = peek( memBlock + offset )

        elsif equal( typ, "WORD" ) then
                conv = peek( { memBlock + offset, 2 } ) & { 0, 0 }
                result = bytes_to_int( conv )

        elsif equal( typ, "DWORD" ) then
                conv = peek( { memBlock + offset, 4 } )
                result = bytes_to_int( conv )

        elsif equal( typ, "QWORD" ) then
                result = peek( { memBlock + offset, 8 } )

        elsif equal( typ, "ASCIIZ" ) then
                i = 0
                result = {}
                while 1 = 1 do
                        conv = peek( memBlock + offset + i )
                        if conv = #00 then
                                exit
                        end if
                        result &= conv
                        i = i + 1
                end while

        elsif equal( typ[ 1 .. 5], "BYTES" ) then
                i = typ[ 6 ]
                result = peek( { memBlock + offset, i } )

        elsif equal( typ, "PSTRING" ) then
                i = peek( { memBlock + offset, 1 } )
                result = peek( { memBlock + offset + 1, i } )
        end if
        return result
end function

function fpeek( object access )
        integer seke
        object result
        result = -1
        if atom( access ) then -- byte at offset
                if access <= fileLength then
                        seke = seek( fileNumber, access )
                        if seke = 0 then
                                result = getc( fileNumber )
                        end if
                end if
        else -- sequence of offset and length
                if ( access[ 1 ] + access[ 2 ] ) <= fileLength then
                        seke = seek( fileNumber, access[ 1 ] )
                        if seke = 0 then
                                result = get_bytes( fileNumber, access[ 2 ] )
                        end if
                end if
        end if
        return result
end function

function fmread( integer offset, sequence typ )
        sequence conv
        object result
        integer i
        if equal( typ, "BYTE" ) then
                result = fpeek(  offset )

        elsif equal( typ, "WORD" ) then
                conv = fpeek( {  offset, 2 } ) & { 0, 0 }
                result = bytes_to_int( conv )

        elsif equal( typ, "DWORD" ) then
                conv = fpeek( {  offset, 4 } )
                result = bytes_to_int( conv )

        elsif equal( typ, "QWORD" ) then
                result = fpeek( {  offset, 8 } )

        elsif equal( typ, "ASCIIZ" ) then
                i = 0
                result = {}
                while 1 = 1 do
                        conv = fpeek(  offset + i )
                        if conv = #00 then
                                exit
                        end if
                        result &= conv
                        i = i + 1
                end while

        elsif equal( typ[ 1 .. 5], "BYTES" ) then
                i = typ[ 6 ]
                result = fpeek( {  offset, i } )

        elsif equal( typ, "PSTRING" ) then
                i = fpeek( {  offset, 1 } )
                result = fpeek( {  offset + 1, i } )
        end if
        return result
end function

global procedure memload( sequence data )
        memBlock = allocate( length( data ) + 1 )
        poke( memBlock, data )
        memAllocated = 1
end procedure

global procedure memfree()
        if memAllocated = 1 then
                free( memBlock )
        end if
end procedure

global function memread( sequence offsetTypes )
        object result
        result = -1
        if memAllocated = 1 then
                result = repeat( {}, length( offsetTypes ) )
                for i = 1 to length( offsetTypes ) do
                        result[ i ] = mread( offsetTypes[ i ][ 1 ], offsetTypes[ i ][ 2 ] )
                end for
        end if
        return result
end function

global procedure fmemload( sequence file )
        integer res
        fileNumber = open( file, "rb" )
        if fileNumber != -1 then
                fileAllocated = 1
                res = seek( fileNumber, -1 )
                if res = 0 then
                        fileLength = where( fileNumber )
                else
                        fileLength = 0
                end if
        end if
end procedure

global procedure fmemfree()
        if fileAllocated = 1 then
                close( fileNumber )
        end if
end procedure

global function fmemread( sequence offsetTypes )
        object result
        result = -1
        if fileAllocated = 1 then
                result = repeat( {}, length( offsetTypes ) )
                for i = 1 to length( offsetTypes ) do
                        result[ i ] = fmread( offsetTypes[ i ][ 1 ], offsetTypes[ i ][ 2 ] )
                end for
        end if
        return result
end function

[Euphoria] Structured Access

Late last century, in a developing part of the world, I tried writing a diskette cataloguer. It worked okay, once I'd figured out how to do all the gymnastics necessary for BIOS calls. In the process I wrote a function to access memory in a structured way. Brilliant as Euphoria sequences are, they are just that: sequences. There's little in the way of structure, unless you apply some of your own.

I've reproduced the function in its entirety below. Essentially, the code takes data from memory in a structure way, that is, in terms of BYTE, BYTES, WORD, DWORD or ASCIIZ.

An attempt was made to make the functions applicable to files. Those routines don't work, and I haven't taken the time to find out why. Good as Euphoria is, there's no Mac OS X version (so I can't use it at home) and there's no opportunity to use it at work -- Euphoria's not in the SOE. If you're interested in looking at the code, write.

global function getmem( atom addr, integer offset, sequence typ )
        sequence conv
        object result
        integer i
        if equal( typ, "BYTE" ) then
                result = peek( addr + offset )
        elsif equal( typ, "WORD" ) then
                conv = peek( { addr + offset, 2 } ) & { 0, 0 }
                result = bytes_to_int( conv )
        elsif equal( typ, "DWORD" ) then
                conv = peek( { addr + offset, 4 } )
                result = bytes_to_int( conv )
        elsif equal( typ, "ASCIIZ" ) then
                i = 0
                result = {}
                while 1 = 1 do
                        conv = peek( addr + offset + i )
                        if conv = #00 then
                                exit
                        end if
                        result &= conv
                        i = i + 1
                end while
        elsif equal( typ[ 1 .. 5], "BYTES" ) then
                i = typ[ 6 ]
                result = peek( { addr + offset, i } )
        end if
        return result

end function

As an example of how to use getmen, below is the code for GetDriveParameterTable

global constant GDPT_DRIVE = 1,
                GDPT_UNIT = 2,
                GDPT_BYTES_PER_SECTOR = 3,
                GDPT_SECTORS_PER_CLUSTER_MINUS_1 = 4,
                GDPT_SECTORS_PER_CLUSTER_MULITPLIER = 5 ,
                GDPT_BOOT_SECTORS = 6,
                GDPT_FAT_COPIES = 7,
                GDPT_ROOT_DIRECTORY_ENTRIES = 8,
                GDPT_FIRST_DATA_SECTOR = 9,
                GDPT_TOTAL_CLUSTERS_PLUS_1 = 10,
                GDPT_NUMBER_SECTORS_PER_FAT = 11,
                GDPT_FIRST_ROOT_SECTOR = 12,
                GDPT_PTR_DEVICE_DRIVER_HEADER = 13,
                GDPT_MEDIA_DESCRIPTOR_BYTE = 14,
                GDPT_DISK_ACCESSED_BYTE = 15,
                GDPT_PTR_NEXT_DRIVE_PARAMETER_TABLE = 16,
                GDPT_FIRST_FREE_CLUSTER = 17,
                GDPT_NUMBER_FREE_CLUSTERS = 18

global function GetDriveParameterTable( integer logicalDrive )
        sequence r
        atom DPT
        integer drive
        integer unit
        integer bytesPerSector
        integer sectorsPerClusterMinus1
        integer sectorsPerClusterMulitplier
        integer bootSectors
        integer FATcopies
        integer rootDirectoryEntries
        integer firstDataSector
        integer totalClustersPlus1
        integer numberSectorsPerFAT
        integer firstRootSector
        atom ptrDeviceDriverHeader
        integer mediaDescriptorByte
        integer diskAccessedByte
        atom ptrNextDriveParameterTable
        integer numberFreeClusters
        integer firstFreeCluster
        
        r = repeat( 0, 10 )
        r[ REG_AX ] = #3200 --#1F00
        r[ REG_DX ] = logicalDrive
        r = dos_interrupt( #21, r )
        if lobyte( r[ REG_AX ] ) != 255 then
                DPT = r[ REG_DS ] * 16 + r[ REG_BX ]
                
                drive = getmem( DPT, #00, "BYTE" ) 
                unit  = getmem( DPT, #01, "BYTE" ) 
                bytesPerSector = getmem( DPT, #02, "WORD" )
                sectorsPerClusterMinus1 = getmem( DPT, #04, "BYTE" )
                sectorsPerClusterMulitplier = getmem( DPT, #05, "BYTE" )
                bootSectors = getmem( DPT, #06, "WORD" )
                FATcopies = getmem( DPT, #08, "BYTE" )
                rootDirectoryEntries = getmem( DPT, #09, "WORD" )
                firstDataSector = getmem( DPT, #0B, "WORD" )
                totalClustersPlus1 = getmem( DPT, #0D, "WORD" )
                numberSectorsPerFAT = getmem( DPT, #0F, "WORD" )
                firstRootSector = getmem( DPT, #11, "WORD" )
                ptrDeviceDriverHeader = getmem( DPT, #13, "DWORD" )
                mediaDescriptorByte = getmem( DPT, #17, "BYTE" )
                diskAccessedByte = getmem( DPT, #18, "BYTE" )
                ptrNextDriveParameterTable = getmem( DPT, #19, "DWORD" )
                firstFreeCluster = getmem( DPT, #1D, "WORD" )
                numberFreeClusters = getmem( DPT, #1F, "WORD" )
                return { drive, 
                        unit, 
                        bytesPerSector, 
                        sectorsPerClusterMinus1, 
                        sectorsPerClusterMulitplier, 
                        bootSectors, 
                        FATcopies, 
                        rootDirectoryEntries, 
                        firstDataSector, 
                        totalClustersPlus1, 
                        numberSectorsPerFAT, 
                        firstRootSector, 
                        ptrDeviceDriverHeader, 
                        mediaDescriptorByte, 
                        diskAccessedByte, 
                        ptrNextDriveParameterTable, 
                        firstFreeCluster, 
                        numberFreeClusters } 
        else
                return -1
        end if
end function

As an example of the BYTES parameter:

global function GetDiskLabels( integer drive )
        sequence r
        atom addr
        object result


        addr = allocate_low( 25 )
        r = repeat( 0, 10 )

        r[ REG_AX ] = #6900
        r[ REG_BX ] = drive
        r[ REG_DS ] = floor( addr / 16 )
        r[ REG_DX ] = remainder( addr, 16 )

        r = dos_interrupt( #21, r )

        if not Carry( r ) then
                result = { getmem( addr, #00, "WORD" ),
                           getmem( addr, #02, "DWORD" ),
                           getmem( addr, #06, "BYTES" & 11 ),
                           getmem( addr, #11, "BYTES" & 8 )
                         }
        else
                result = -1

        end if

        free_low( addr )

        return result

end function

The ASCIIZ parameter is like the BYTES except it keeps working its way through memory until it encounters a binary zero and then returns everything up to that point.

From memory I remember writing a version of getmem() which received a sequence of BYTE, WORD, etc. specifications and returned the resulting sequence of results. When I find it I'll post it.

Enjoy.

[EOC] End of Contract

I've got one more week and then I'm unemployed again.

I feel down. I wish there was something "cutting edge" I could do. Everything I can think of is diametrically opposed to the cutting edge, being either the blunt bit at the back of the knife or the even blunter bit on top of the chisel handle.

Who cares about MetaCard? Who cares about S*BOL but a few diehard fanatics (who are mostly older and greyer than me)? Who cares about Clipper or xHarbour but a few South Americans into retro memorabilia? As for VBScript, this is just one of thousands of websites and I'm a relative newcomer to a tool that's been around for very long time.

Eventually I'll have posted all my MoonRock BASIC, Fitted Software Tools Modula-2, Turbo Pascal 5 and Euphoria code. Whooptie do. Even if I finish my CCNA, learn Haskell, and write Kiwi CatTools equivalents ... who cares?

[Cygwin] using Cygwin to make .cmd files. Eeeww...

Actually the whole thing is a bizarre mix of Cygwin, Win2k CMD and Euphoria. When I get some more time I'll go into the issue a little more deeply. Here's the line that the title refers to:
find . -name "*.dly" -exec basename {} .dly \; | gawk '{ print "call fix DLY" $1 }' | unix2dos >fixdly.cmd