[Protium] Master Class #1 (Part 2)

Demonstration - Oblique Strategies

"The Oblique Strategies are a deck of cards. Up until 1996, they were quite easy to describe. They measured about 2-3/4" x 3-3/4". They came in a small black box which said "OBLIQUE STRATEGIES" on one of the top's long sides and "BRIAN ENO/PETER SCHMIDT" on the other side. The cards were solid black on one side, and had the aphorisms printed in a 10-point sans serif face on the other.

...

The deck itself had its origins in the discovery by Brian Eno that both he and his friend Peter Schmidt ... tended to keep a set of basic working principles which guided them through the kinds of moments of pressure — either working through a heavy painting session or watching the clock tick while you're running up a big buck studio bill. Both Schmidt and Eno realized that the pressures of time tended to steer them away from the ways of thinking they found most productive when the pressure was off. The Strategies were, then, a way to remind themselves of those habits of thinking — to jog the mind."         
-- Oblique Strategies

A web-based installation of Oblique Strategies is supplied in the standard Protium install. Using the "Internet Information Services" snap-in, create a virtual directory pointing to C:\protium\Code\prx\os. Specify its default as index.prx, call it 'os', and share the C:\protium\Code\prx\os directory (Microsoft Access is picky about being able to write to databases even when only reading.)

Further information on setting up IIS can be found in the Protium document "C:\protium\bin\plugins\Configuring Windows IIS 5 to use with Protium and Isis.html"

The Protium code in the index.prx file is as follows:

<@ DEFKEYLIT>__Transput|__HTMLTransput</@> <@ SAYPRO></@> <@ SAYDOC> <@ SAYDHD> <@ SAYDTT>Oblique strategies</@> </@> <@ SAYDBD> <@ DEFDBFLIT>os</@> <@ DEFRSTCAP>select * from os where cardid = <@ SAYRANLIT>100</@></@> <@ SAYDPR>Oblique strategy: <@ SAYFLD>message</@></@> </@> </@>

The above code (indented only to more clearly demonstrate document structure) outputs a different strategy each time the page is refreshed. The syllables translate as follows:

<@ DEFKEYLIT>__Transput|__HTMLTransput</@>	define the Transput as HTML
<@ SAYPRO>	output a document prologue. (What is output by the PRO syllable depends on the Transput defined, as is the case for all document related syllables.)
<@ SAYDOC>	Enclose a document.
<@ SAYDHD>	Enclose a document header, in the context of an existing document.
<@ SAYDTT>Oblique strategies</@>	set the document title, in the context of an existing document body and header.
<@ SAYDBD></@>	enclose a document body, in the context of an existing document.
<@ DEFDBFLIT>os</@>	opens this data source, by default a JET/MSAccess database.
<@ DEFRSTCAP>select * from os where cardid = <@ SAYRANLIT>100</@></@>	Open record source defined by captured output.
<@ SAYRANLIT>100</@>	return a random number between 1 and 100.
<@ SAYDPR></@>	enclose a document paragraph, in the context of the existing document.
<@ SAYFLD>message</@>	print the contents of the field called 'message' which, in this context, is part of the 'os' recordset.

Note that the code chooses a strategy based on a random number between 1 and 100. But what if there are more than 100 strategies? Wouldn't it be better if the actual number of records could be found and that used as the basis for the RAN syllable? Two ways of handling this requirement are described below:

<@ DEFKEYLIT>__Transput|__HTMLTransput</@> <@ SAYPRO></@> <@ SAYDOC> <@ SAYDHD> <@ SAYDTT>Oblique strategies</@> </@> <@ SAYDBD> <@ DEFDBFLIT>os</@> <@ DEFRSTLIT>os</@> <@ LETVARSZERST>upper|___</@> <@ DEFRSTCAP>select * from os where cardid = <@ SAYRANVAR>upper</@></@> <@ SAYDPR>Oblique strategy: <@ SAYFLD>message</@></@> </@> </@>

The changed syllables translate as follows:

<@ DEFRSTLIT>os</@>	Select every record in the database.
<@ LETVARSZERST>upper|___</@>	assign to the variable 'upper' the size of the default (marked by three underscores) recordset.
<@ RSTCAP>select * from os where cardid = <@ SAYRANVAR>upper</@></@>	Select a new recordset, capturing the output from RAN but using the variable 'upper' to specify the limit.

<@ DEFKEYLIT>__Transput|__HTMLTransput</@> <@ SAYPRO></@> <@ SAYDOC> <@ SAYDHD> <@ SAYDTT>Oblique strategies</@> </@> <@ SAYDBD> <@ DEFDBFLIT>os</@> <@ DEFRSTLIT>os</@> <@ ACTMOVRANRST></@> <@ SAYDPR>Oblique strategy: <@ SAYFLD>message</@></@> </@> </@>

Rather than get the number of records, simply ...

<@ ACTMOVRANRST></@>

move the record pointer to a random place in the recordset.

This demonstrates the power of idiomatic Protium: short, sweet and to the point.

Questions and Answers

I can't see a main() anywhere. Where's the start?

Protium implements a single-pass code evaluation model. This is quite unlike most other languages which implement double-pass code evaluation: first pass to discover and make a map; second pass to evaluate.

Protium starts at the beginning of a named file, and builds its awareness of context from there. Because of this approach, we may never examine code we aren't interested in.

I keep using the same construction over and over again. Is there a way of abbreviating Protium words?

What you can do is create a compound operator (a concept borrowed from OPS-3). These are defined using the KOP syllable. If you wanted to define LVK as a shorthand for LETVARKEY, for example, then you would code

<@ DEFKOPLIT>LVK|LETVARKEY</@>

Thereafter you would be able to use the abbreviated form, replacing code like

<@ LETVARKEY>MyGuid|__GUID</@>

with

<@ LVK>MyGuid|__GUID</@>

There are other ways of doing this, including UDS (user-defined syllable) and BLK (code block), but this is by far the simplest.

*** End of Part 2 ***

© Copyright Bruce M. Axtens, 2008

[Protium] Master Class #1 (Part 1)

Protium is ...

Protium is essentially, and at heart, a way of finding data in a myriad of locations in a homologous manner, manipulating it in a myriad of ways, and then delivering it to a myriad of displays, in a myriad of [human] languages. A concomitant of that is that data be current, so this also involves updating old data, which means that a similar potential is there for making changes to data.

But the overriding maxim is for a direct equivalence of task to operator at the conceptual level. This means that high-level / low-level language distinctions don't enter in: branching is a single operator, but so is "work out the utility matrix for this complex set of possibilities"; the iteration syllable is at the same level as that of add and of unique-sort.

Influences

"I had as a goal the economy and power of APL (minus the cryptic nature) while having the manipulation power of SNOBOL, the one-for-one power of multimedia-instruction-set assembler (e.g. QUEXAL), the task oriented nature of NODAL, the reality representation characteristics of ATLAS, and the data ordering capabilities of the 'lost languages' (Simscript, Dectab, dBase etc.), [such that] the data is available in a way that ordinary programming languages don't permit.

"The other thing I took from NODAL was JOSS's implicit mixing of code and data, which is much saner than LISP's, and also the way that there was an implicit hierachy of data.

"I also borrowed some control structures from RPG, temporary constructions from Miranda, generators from Icon, multiple outcomes from COMIT and compound operators from OPS-3.

"I rejected the naive form of IO (which bedevilled Algol and Fortran). I think the ability to display is the least-used functionality of programming, only touched on in screenwiping and SOAP.

"The idea of assignment [in most programming languages] is generally also naive - for instance the fact that it is a function has been overblown in functional languages, but ignored elsewhere. So [I implemented] scaling and multiple returns (present in LYaPAS in 1964), multiple assigns (common in FORTRAN, APL and the original BASIC), multiple functional transforms (common in any DSP language, e.g. Faust) as well as the closer knitting of data and code (from FORTRAN and dBase).

"The final point to note is that the entirety of Protium works with a SNOBOL-/COMIT-style success/failure flag, converted to a success / failure / don't-know ternary system. Any operation will set this, but it can be qualified (success, found, quantity more than zero, test type, pattern match, etc.)

"Essentially, the idea was to revisit the nature of the programming task, and learn from where the bounds had been stretched; to try to get a thought-to-line-of-code transference capability, rather than the reductive, ALGOL-ish, 'see-how-small-I-can-get-the-core' approach."

        -- Diarmuid Pigott, personal correspondence, 9 January 2007.

How to Program in Protium

The overall Protium approach to programming is to work out what you want to do, then work out what it is that that would be in Protium terms. Sometimes this is very similar to the conventional way (most of the code examples are conventional in that way to secure familiarity). Sometimes it involves a simple task that is unfamiliar in those terms.

Unlike most other programming languages, Protium does not force the programmer to work in either a top-down / decompositional or bottom-up / compositional way. Either approach can be taken. The art of Protium is in the discovery of the idiomatic form which best describes the solution to the problem.

Workflow in Protium programming is simply this: work out what data you need to solve a problem, then extract it and present it. When there is need to extract data according to a criterion, it is specified in two stages, first the data source, then the record source, in the following hierarchy: Data Source -> Record Source -> Record -> Field -> Subfield. Any number of Data Sources can be open at one time, and any number of Record Sources, but a Record Source will always be subordinate to its Data Source.

Protium supports a number of ways of addressing and participating in memory. Memory is untyped. It is a simple tuple of name => value (read name implies value) which can be late-bind typed using 'typifiers', but is inherently capable of any interpretation. There is one global memory space, but it is lexically divided (using namespaces) to make the equivalents of local, static etc. Memory is synthetic, in that it will create a variable (or a structure) on being first called — variables do not need to be declared nor the type of their content specified.

Protium relies heavily on the concept of aliases: when any complex computational task is invoked the operation is aliased, so that you can switch back to it at any time. Anything can be aliased: branching, looping, switching, creation and use of structures, and interaction with data. These aliases, also known as workareas, have two components: a type and a name.

Alias names can be invoked internally, so a field called 'ChinaCollection => DateOfPurchase' will automatically invoke the aliased workspace called ChinaCollection to fulfil the data request. This means that some very powerful manipulations are possible - such as the much-used scatter/gather (borrowed from FoxPro) to swap data between aliased workspaces.

Implicit in all of this is the idea that, where possible, everything should be invokable with one operator, so DCT (dictionary) without a name is the dictionary currently in scope, and of course implicit in the entire thing is a hierarchy of context - the field is always (unless specified) invoked in the context of the current record or the current recordset (or query or view) of the current database. It is this dependence on context - Protium's context-aware, rather than context-free, grammar - which trips up the beginning Protium programmer. That and the lack of appropriate casting of numerics - all comparisons in Protium are lexical (i.e. 'a' is less than 'c'; 5 is greater than 45000), so comparison syllables must bear an explicit number-cast syllable when a numeric comparison is required.

Conventions

Protium respects the following naming conventions with respect to the file type:

Extension	Meaning
.p	a Protium script in plain text format
.pr	a Protium script in rich text format (RTF)
.pre	a ProtiumWeb script (plain text, HTML or rich text)
.prx	a Protium executable project (plain text, HTML or rich text)
.plb	a Protium library (plain text, HTML or rich text)

The code in a .pre or .prx file can favour HTML (the <BODY>text</BODY> approach) or favour Protium (the <@ SAYDBDLIT>text</@> approach). In the latter it is possible to write <@ DBD>text</@> as Protium will disambiguate where possible, making 'slang' forms possible .

Generally we make two files per website, a default.prx and an index.prx, but of course it could be set up to look for an index.pre, if necessary.

*** End of Part One ***

© Copyright Bruce M. Axtens, 2008

[FORTRAN] Making a DLL for VB6

As a break from trying to figure out how to get a pattern matching library DLLified (and UTF-32 sensitive), my boss gave me something else to do, something on the one hand similar (wrap something in a DLL) and on the other quite different (wrap two knapsack algorithms done in Fortran 90).

The knapsack code is derived from

Algorithm 4.9, Donald Kreher and Douglas Stinson, Combinatorial Algorithms, CRC Press, 1999, page 125.

and was downloaded from FORTRAN Source Codes, specifically, the COMBO library. Many thanks to John Burkardt for making this resources available.

The files used from the COMBO library were knapsack_01.f90, knapsack_rational.f90, knapsack_reorder.f90, rvec_backtrack.f90 and r_swap.f90, and were compiled using Compaq Visual Fortran.

Seeing as CVF is no longer available (except perhaps on eBay) you might get away with the Intel® Fortran Compiler for Windows, SilverFrost's FTN95 or g95.

Don't try it with Watcom Fortran, however, because that only does Fortran 77. Mind you, if the algorithms you're wrapping are F77 ones from NIST's 'Dictionary of Algorithms and Data Structures' or Steven Skiena's The Stony Brook Algorithm Repository you may do okay with the Watcom offering or even GNU's g77.

I really like Fortran. I remember writing some VAX-11 FORTRAN back in 1983 (along with a bit more VAX-11 COBOL) and found it quite powerful and expressive. I know that there's been a fairly widespread pooh-pooh-ing of Fortran in recent years, but I try not to be influenced by peer-group pressure, preferring to actually see for myself whether a language is any good or not.

Okay, off the soap box and down to the code. I'm not going to bother posting all the COMBO code, just what I wrote to wrap it.

These are the three exposed routines and have essentially the same framework: a subroutine header, two declarations controlling symbol names and method of access, the call to the COMBO routine, the return and the end of subroutine. Really, really, simple. Gobsmackingly simple, compared to some other languages I could mention. Rather embarrasing really ... so little to show.

If you're wondering why I explicitly state that the parameters are being passed by reference (!dec$ attributes reference ...), it's because a side effect of specifying "stdcall" is that it forces the passing mechanism into pass-by-value, and in this case, quite a few of the parameters are being modified by the subroutine.

!BOAL0.f90 !FUNCTIONS/SUBROUTINES exported from BOAL0.dll: !stdcall forces all parameters to pass-by-value, !thus the 'attributes reference' declaration subroutine Knapsack01( n, mass_limit, p, w, x, mass, profit ) !DEC$ ATTRIBUTES DLLEXPORT, STDCALL, ALIAS : "Knapsack01" :: Knapsack01 !dec$ attributes reference :: n, mass_limit, p, w, x, mass, profit call knapsack_01 ( n, mass_limit, p, w, x, mass, profit ) return end subroutine Knapsack01 subroutine KnapsackRational ( n, mass_limit, p, w, x, mass, profit ) !DEC$ ATTRIBUTES DLLEXPORT, STDCALL, ALIAS : "KnapsackRational" :: KnapsackRational !dec$ attributes reference :: n, mass_limit, p, w, x, mass, profit call knapsack_rational ( n, mass_limit, p, w, x, mass, profit ) return end subroutine KnapsackRational subroutine KnapsackReorder ( n, p, w ) !DEC$ ATTRIBUTES DLLEXPORT, STDCALL, ALIAS : "KnapsackReorder" :: KnapsackReorder !dec$ attributes reference :: n, p, w call knapsack_reorder ( n, p, w ) return end subroutine KnapsackReorder

The other routines are linked in during the compile and I end up with a nice little .DLL.

Okay, so maybe there's something more to show on the VB6 side.

First off, the declares. VB6 defaults to pass-by-reference, thus the missing "ByRef" ahead of each parameter.

Declare Sub KnapsackReorder Lib "BOAL0.dll" (n As Integer, p As Single, w As Single) Declare Sub Knapsack01 Lib "BOAL0.dll" (n As Integer, mass_limit As Single, p As Single, w As Single, x As Single, mass As Single, profit As Single) Declare Sub KnapsackRational Lib "BOAL0.dll" (n As Integer, mass_limit As Single, p As Single, w As Single, x As Single, mass As Single, profit As Single)

Next the test code which is derived from TEST094 and TEST095 found inside COMBO's combo_prb.f90.

Do note that the floating point variables are defined here as Single. This seems to be the best match to an undecorated Fortran REAL. Maybe if I'd tweaked the COMBO code to REAL*8, I could have used Double on the VB6 side.

Sub main() Dim i As Integer Dim mass As Single Const mass_limit As Single = 26# Dim p(4) As Single Dim profit As Single Dim w(4) As Single Dim x(4) As Single Const n As Integer = 4 p(0) = 24# p(1) = 13# p(2) = 23# p(3) = 15# p(4) = 16# w(0) = 12# w(1) = 7# w(2) = 11# w(3) = 8# w(4) = 9# Debug.Print " " Debug.Print "TEST094" Debug.Print " KNAPSACK_REORDER reorders the knapsack data." Debug.Print " KNAPSACK_01 solves the 0/1 knapsack problem." Debug.Print " " Debug.Print "Object", "Profit", "Mass", "Profit Density" Debug.Print " " For i = 0 To n Debug.Print i, p(i), w(i), p(i) / w(i) Next KnapsackReorder n, p(0), w(0) Debug.Print " " Debug.Print " After reordering by Profit Density:" Debug.Print " " Debug.Print "Object", "Profit", "Mass", "Profit Density" Debug.Print " " For i = 0 To n Debug.Print i, p(i), w(i), p(i) / w(i) Next Debug.Print " " Debug.Print " Total mass restriction is " & mass_limit Knapsack01 n, mass_limit, p(0), w(0), x(0), mass, profit Debug.Print " " Debug.Print "Object", "Density", "Choice", "Profit", "Mass" Debug.Print " " For i = 0 To n Debug.Print i, p(i) / w(i), x(i), x(i) * p(i), x(i) * w(i) Next Debug.Print " " Debug.Print " Total:", , , profit, mass '-- p(0) = 24# p(1) = 13# p(2) = 23# p(3) = 15# p(4) = 16# w(0) = 12# w(1) = 7# w(2) = 11# w(3) = 8# w(4) = 9# Debug.Print " " Debug.Print "TEST094" Debug.Print " KNAPSACK_REORDER reorders the knapsack data." Debug.Print " KNAPSACK_RATIONAL solves the rational knapsack problem." Debug.Print " " Debug.Print "Object", "Profit", "Mass", "Profit Density" Debug.Print " " For i = 0 To n Debug.Print i, p(i), w(i), p(i) / w(i) Next KnapsackReorder n, p(0), w(0) Debug.Print " " Debug.Print " After reordering by Profit Density:" Debug.Print " " Debug.Print "Object", "Profit", "Mass", "Profit Density" Debug.Print " " For i = 0 To n Debug.Print i, p(i), w(i), p(i) / w(i) Next Debug.Print " " Debug.Print " Total mass restriction is " & mass_limit KnapsackRational n, mass_limit, p(0), w(0), x(0), mass, profit Debug.Print " " Debug.Print "Object", "Density", "Choice", "Profit", "Mass" Debug.Print " " For i = 0 To n Debug.Print i, p(i) / w(i), x(i), x(i) * p(i), x(i) * w(i) Next Debug.Print " " Debug.Print " Total:", , , profit, mass End Sub

Hmm ... nothing much amazing there either. But that's how it was with wrapping the Fortran. Simple and powerful at the same time. So far as I'm concerned, if we ever have to rewrite Protium, Fortran's going to be very near the top of the list.

© Copyright Bruce M. Axtens., 2007

[Visual BASIC 6] BOOST (v2)

I revisited BOOST this week. A friend had pointed out to me some time back that /P: and /L: were a bit of a pain when one wanted to speed something up quickly, or kill it quickly. So this version changes the command line handling.

This version also demonstrates how to kill a process. In fact it kills every process of the same name. I wish I'd had this a couple of years ago when I was doing stuff with Excel -- I'd end up with multiple Excel sessions which I would then have to kill off one-by-one through the Task Manager. (I eventually ended up installing Cygwin so that I could script the process.)

If you remember the original VBScript of BOOST and the first VB6 version, you'll see some similarities.

I've given up on using setsubsys in favour of using VBAdvance (which is now freeware) to handle the compile-to-console-app process. I'm still compressing the app using UPX.

First a few constants and the declarations, found on vb.mvps.org, for doing console I/O.

Option Explicit Const KILL_PROCESS = 0 '0 Const LOW_PRIORITY = 64 '1 Const BELOWNORMAL_PRIORITY = 16384 '2 Const NORMAL_PRIORITY = 32 '3 Const ABOVENORMAL_PRIORITY = 32768 '4 Const HIGH_PRIORITY = 256 '5 Const REALTIME_PRIORITY = 128 '6 Private Declare Function GetStdOutHandle Lib "kernel32" _ Alias "GetStdHandle" _ (Optional ByVal HandleType As Long = -11) As Long Private Declare Function WriteFile Lib "kernel32" _ (ByVal hFile As Long, _ ByVal lpBuffer As String, _ ByVal cToWrite As Long, _ ByRef cWritten As Long, _ Optional ByVal lpOverlapped As Long) As Long 'To keep things simple, wrap these two APIs in a single helper function like so: Private Function ConsoleWrite(sText As String) As Long WriteFile GetStdOutHandle, ByVal sText, Len(sText), ConsoleWrite End Function

Next, a few supporting functions. First off the rank, is an invocation syntax display. Notice that priority can now be specified either by a number (0 to kill, 1-6 for low to realtime) or by name (kill, low, belownormal, normal, abovenormal, high, realtime).

Sub Syntax() ConsoleWrite ("Syntax:" & vbNewLine & _ vbTab & "Boost {processname} {runlevel}" & vbNewLine & _ "Run level as number:" & vbNewLine & _ vbTab & "0 = KILL_PROCESS" & vbNewLine & _ vbTab & "1 = LOW_PRIORITY" & vbNewLine & _ vbTab & "2 = BELOWNORMAL_PRIORITY" & vbNewLine & _ vbTab & "3 = NORMAL_PRIORITY" & vbNewLine & _ vbTab & "4 = ABOVENORMAL_PRIORITY" & vbNewLine & _ vbTab & "5 = HIGH_PRIORITY" & vbNewLine & _ vbTab & "6 = REALTIME_PRIORITY" & vbNewLine & vbNewLine & vbNewLine & _ "Run level as text:" & vbNewLine & _ vbTab & "kill = KILL_PROCESS" & vbNewLine & _ vbTab & "low = LOW_PRIORITY" & vbNewLine & _ vbTab & "belownormal = BELOWNORMAL_PRIORITY" & vbNewLine & _ vbTab & "normal = NORMAL_PRIORITY" & vbNewLine & _ vbTab & "abovenormal = ABOVENORMAL_PRIORITY" & vbNewLine & _ vbTab & "high = HIGH_PRIORITY" & vbNewLine & _ vbTab & "realtime = REALTIME_PRIORITY" & vbNewLine) End Sub

Second, the command line parser. This splits on space and tab and is based on code found at microsoft.public.vb.winapi

Function GetCommandLine(Optional MaxArgs) As Variant 'Declare variables. Dim C As String Dim CmdLine As String Dim CmdLnLen As Integer Dim InArg As Boolean Dim i As Integer Dim NumArgs As Integer Dim ArgArray As Variant 'See if MaxArgs was provided. If IsMissing(MaxArgs) Then MaxArgs = 10 'Make array of the correct size. ReDim ArgArray(MaxArgs - 1) NumArgs = 0: InArg = False 'Get command line arguments. CmdLine = Command() CmdLnLen = Len(CmdLine) 'Go thru command line one character 'at a time. For i = 1 To CmdLnLen C = Mid(CmdLine, i, 1) 'Test for space or tab. If (C <> " " And C <> vbTab) Then 'Neither space nor tab. 'Test if already in argument. If Not InArg Then 'New argument begins. 'Test for too many arguments. If NumArgs = MaxArgs Then Exit For NumArgs = NumArgs + 1 InArg = True End If 'Concatenate character to current argument. ArgArray(NumArgs - 1) = ArgArray(NumArgs - 1) & C Else 'Found a space or tab. 'Set InArg flag to False. InArg = False End If Next i 'Resize array just enough to hold arguments. ReDim Preserve ArgArray(NumArgs - 1) 'Return Array in Function name. GetCommandLine = ArgArray '() End Function

Third, the two routines which wrap the WMI functions to set priority and to kill process. The latter was found at tek-tips. If I remember correctly, the places in each routine where it says

sComputer = "."

could, in fact, have some other computer's name. If you had sufficient privilege you could be tweaking or killing a process on someone else's machine.

Function SetPriority(sProcess As String, nPriority As Integer) As Boolean Dim sComputer As String Dim oWMIService As Object Dim cProcesses As Object Dim oProcess As Object Dim bDone As Boolean bDone = False sComputer = "." Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\cimv2") On Error Resume Next Set cProcesses = oWMIService.ExecQuery _ ("Select * from Win32_Process Where Name = '" & sProcess & "'") For Each oProcess In cProcesses oProcess.SetPriority (nPriority) If Err.Number <> 0 Then GoTo DoNext End If bDone = True DoNext: Next On Error GoTo 0 SetPriority = bDone End Function Function KillProcess(sProcess As String) As Integer Dim oWMIService As Object Dim sComputer As String Dim oProcess As Object Dim nDone As Integer nDone = 0 sComputer = "." 'this computer Set oWMIService = GetObject("winmgmts:") For Each oProcess In oWMIService.InstancesOf("Win32_process") If LCase(oProcess.Name) = LCase(sProcess) Then oProcess.Terminate nDone = nDone + 1 End If Next KillProcess = nDone End Function

Finally, the Main subroutine. Notice the additions to the priorities collection. Note also the change in the way the command line is handled.

Because there's no .Exists method on Collections, the .Item call is wrapped in an 'On Error' so that a non-existent item situation is caught appropriately.

Sub Main() Dim sLevel As String Dim nLevel As Integer Dim sProcess As String Dim sCommand As String Dim nInstances As Integer Dim dPriorities As New Collection dPriorities.Add Item:=KILL_PROCESS, Key:="kill" dPriorities.Add Item:=LOW_PRIORITY, Key:="low" dPriorities.Add Item:=BELOWNORMAL_PRIORITY, Key:="belownormal" dPriorities.Add Item:=NORMAL_PRIORITY, Key:="normal" dPriorities.Add Item:=ABOVENORMAL_PRIORITY, Key:="abovenormal" dPriorities.Add Item:=HIGH_PRIORITY, Key:="high" dPriorities.Add Item:=REALTIME_PRIORITY, Key:="realtime" dPriorities.Add Item:=KILL_PROCESS, Key:="0" dPriorities.Add Item:=LOW_PRIORITY, Key:="1" dPriorities.Add Item:=BELOWNORMAL_PRIORITY, Key:="2" dPriorities.Add Item:=NORMAL_PRIORITY, Key:="3" dPriorities.Add Item:=ABOVENORMAL_PRIORITY, Key:="4" dPriorities.Add Item:=HIGH_PRIORITY, Key:="5" dPriorities.Add Item:=REALTIME_PRIORITY, Key:="6" Dim aArgs As Variant If Command() = "" Then Syntax End End If aArgs = GetCommandLine(2) sProcess = aArgs(0) sLevel = aArgs(1) If sProcess = "" Or sLevel = "" Then Syntax End End If On Error Resume Next nLevel = dPriorities.Item(sLevel) If Err.Number = 5 Then ConsoleWrite "Invalid selection of runlevel." & vbNewLine Syntax End End If On Error GoTo 0 If nLevel = 0 Then nInstances = KillProcess(sProcess) If nInstances = 0 Then ConsoleWrite "No instances of " & sProcess & " found to kill" & vbNewLine Else ConsoleWrite nInstances & " " & IIf(nInstances > 1, "instances", "instance") & " of " & sProcess & " killed." & vbNewLine End If Else ConsoleWrite sProcess & IIf(SetPriority(sProcess, nLevel), _ " boosted", " NOT boosted") & _ " to priority " & sLevel & " (" & nLevel & ")." & vbNewLine End If End Sub

What's next with this thing? I suppose one could explore the possibility of influencing the lives of applications on other computers:

BOOST Skype.exe kill /C:GUEST_01

There's also the fact that the commandline parser doesn't properly handle double-quoted names. If an .exe had a space it its name, you wouldn't be able use BOOST on it.

Finally, here's a short batch file (killall.bat) I use for killing applications en masse. It was originally designed to get around the 'typing the /P and /L' issue, but I'm so used to using it now ...

@echo off :loop if %1@==@ goto done c:\bin\boost %1 kill shift goto loop :done

An example invocation:

killall excel.exe outlook.exe

© Copyright Bruce M. Axtens, 2007

[Programming] Okay, Ignorance is Bliss ...

If by Ignorance you mean an implementation of the Bliss programming language, then yes, Ignorance is Bliss.

After two and half weeks of Ada, I had to have a break. I wandered over to the Retrocomputing Museum and downloaded the Ignorance source code. While I was at it I also downloaded the source for CUPL, the Cornell University Programming Language. Interestingly, the same interpreter also works for CORC, the CORnell Compiler. The man behind the website, Eric Raymond, has the following, less than flattering, words to describe CUPL:

"Another hideous old design, CUPL — Cornell University Programming Language. It looks something like a really archaic BASIC with linear-algebra builtins."

And what's wrong with BASIC and linear algebra? (That was a rhetorical question.)

I've been able to get CUPL to work, but haven't had any success with Ignorance. Or, for that matter, with JOSS.

To find out more about these languages, HOPL is your friend: Bliss, CUPL and JOSS.

as is Wikipedia: Bliss, CORC (CUPL precursor) and JOSS.

© Copyright Bruce M. Axtens., 2007

[Ada (GNAT)] Who said, "Ignorance is bliss"?

Ignorance isn't bliss. For the past two days I've been trying to do what I expect an Ada freak could do in 2 minutes. It's been a very frustrating, sleep-depriving process.

After trying to do amazing things with GNAT.Spitbol, I'm now trying to do the same to Dr. Dmitry A. Kazakov's match library. And, as usual, it has not been an easy journey.

UTF-32 aside for now, I've been trying this week simply to make the Matching and Pattern packages available to the Windows programmer via the DLL mechanism.

At this point, all I have is a wrapper for the match() function.

I really hope there is an easier way of doing this. As I've said a few times before, I'm a newbie when it comes to Ada but have been forced to jump into the deep end of the pool. Please, if you know a better way, tell me!!

Oh, and I should point out that, though it seems I'm passing the right stuff to match(), in its current form the VB6 code keeps receiving an error code from the Matching package. It may be because I'm not declaring the pattern properly.

Okay, to the code. First up, the BOS.ADS spec file:

--bos.ads with GNAT.Spitbol; use GNAT.Spitbol; with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; with Win32; use Win32; package BOS is procedure Initialize_API; procedure Finalize_API; function pmatch( pLength : Win32.LONG; pString : Win32.LONG; pPointer : Win32.LONG; pPattern : Win32.LONG ) return Win32.LONG; private pragma Export (DLL, Initialize_API ); pragma Export (DLL, Finalize_API ); pragma Export (DLL, pmatch ); end BOS;

Next, the body (BOS.ADB). There are lots of Put calls in here for debugging. These are what appear if you run the VB6 code as a console app.

-- BOS.ADB with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Strings.Bounded; use Ada.Strings.Bounded; with Ada.Text_IO; use Ada.Text_IO; with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; with System; with Unchecked_Conversion; with Win32; use Win32; with Win32.Winbase; use Win32.Winbase; with Matching; use Matching; with Patterns; use PAtterns; package body BOS is type VBLong is record L : Win32.LONG; end record; type PointerToVBLong is access VBLong; type Access_Int is access Interfaces.C.int; function Long_To_Pointer is new Unchecked_Conversion (Win32.LONG, PointerToVBLong ); function Long_To_Access_Int is new Unchecked_Conversion (Win32.LONG, Access_Int ); function Long_To_CharsPtr is new Unchecked_Conversion (Win32.LONG, chars_ptr ); PVBLong : PointerToVBLong; PVBString : chars_ptr; function pmatch( pLength : Win32.LONG; pString : Win32.LONG; pPointer : Win32.LONG; pPattern : Win32.LONG ) return Win32.LONG is iLength : Interfaces.C.int; piPointer : Access_Int; uString : unBounded_String; uPattern : unBounded_String; res : StatusCode; begin PVBLong := Long_to_Pointer( pLength ); iLength := Interfaces.C.int( PVBLong.all.L ); Put( "iLength=" ); Put( Integer(iLength), 10, 10 ); Put_Line( "" ); piPointer := Long_To_Access_Int( pPointer ); Put( "@piPointer=" ); Put( Integer( piPointer.all ), 10, 10); Put_Line( "" ); piPointer.all := 1; Set_unBounded_String( uString, Value( Long_To_CharsPtr( pString ) ) ); Set_unBounded_String( uPattern, Value( Long_To_CharsPtr( pPattern ) ) ); Put_Line( "String=" & To_String( uString ) ); Put_Line( "Pattern=" & To_String( uPattern ) ); res := match( iLength, To_C( To_String( uString ) ), piPointer, To_C( To_String( uPattern ) ) ); Put( "@piPointer=" ); Put( Integer( piPointer.all ), 10, 10); Put_Line( "" ); Put( "@res=" ); Put( Integer( res ), 10, 10); Put_Line( "" ); return Win32.LONG( res ); end pmatch; procedure Initialize_API is procedure Adainit; pragma Import (C, Adainit); begin Adainit; end Initialize_API; procedure Finalize_API is procedure Adafinal; pragma Import (C, Adafinal); begin Adafinal; end Finalize_API; end BOS;

For the sake of completeness, BOS.DEF, BUILD.GPR and BUILD.BAT. Note that in BUILD.BAT, I specify match\match.o as an object file for gnatlink.

EXPORTS initialize_api finalize_api pmatch

project Build is for Source_Dirs use ( "./", "./match", "c:\mingw\lib\gcc\mingw32\4.2.1\**" ); for Object_Dir use "debug"; for Exec_Dir use "debug"; for Main use ("bos"); type Style_Type is ("debug", "release"); Style : Style_Type := external ("STYLE", "debug"); case Style is when "debug" => for Object_Dir use "debug"; when "release" => for Object_Dir use "release"; for Exec_Dir use "."; end case; package Builder is case Style is when "debug" => for Default_Switches ("Ada") use ("-g"); when others => null; end case; end Builder; package Binder is case Style is when "debug" => for Default_Switches ("Ada") use ("-E"); when others => null; end case; end Binder; package Compiler is case Style is when "debug" => for Default_Switches ("Ada") use ( "-s", "-gnato", "-fstack-check", "-g", "-gnat05"); --gnata when "release" => for Default_Switches ("Ada") use ("-O2", "-fno-strict-aliasing", "-gnato", "-gnat05"); end case; end Compiler; end Build;

@echo off setlocal SET C_INCLUDE_PATH=C:\MinGW\lib\gcc\mingw32\4.2.1 set target=%1 if %1@==@ set target=debug if not %1@==debug@ if not %1@==release@ set target=debug echo Building %target% version of dll c:\mingw\bin\gnat make -Pbuild -XSTYLE=%target% -LC:\MinGW\lib\gcc\mingw32\4.2.1\win32ada if errorlevel 1 goto done c:\mingw\bin\gnatbind -n -x %target%\bos.ali -IC:\MinGW\lib\gcc\mingw32\4.2.1\stdarg -IC:\MinGW\lib\gcc\mingw32\4.2.1\win32ada if errorlevel 1 goto done c:\mingw\bin\gnatlink -g -mdll -s -o %target%\bos.dll %target%\bos.ali -Xlinker --base-file=%target%\bos.base match\match.o if errorlevel 1 goto done c:\mingw\bin\dlltool --dllname bos.dll --base-file %target%\bos.base --output-exp %target%\bos.exp --def bos.def if errorlevel 1 goto done c:\mingw\bin\gnatlink -g -mdll -s -o %target%\bos.dll %target%\bos.ali -Xlinker --base-file=%target%\bos.base %target%\bos.exp --enable-stdcall-fixup match\match.o if errorlevel 1 goto done if %target%==release upx -9 %target%\bos.dll :done

Finally, the VB6 code being used to test it all. Please note that I'm using SetSubSys to turn the resulting EXE into a Console application. If you don't do that, the output from Ada's Put() statements will not be made visible.

It's not pretty code, but it does the job. By the way, if you don't do the StrConv, you'll be passing UTF-16 strings.

Declare Sub initialize_api Lib "debug\bos.dll" () Declare Sub finalize_api Lib "debug\bos.dll" () Declare Function pmatch Lib "debug\bos.dll" (ByVal mLength As Long, ByVal mString As Long, ByVal mPointer As Long, ByVal mPattern As Long) As Long Sub Main() Dim s As String Dim r As String s = "12345b" Dim p As String p = "$#:'b'" p = StrConv(p, vbFromUnicode) s = StrConv(s, vbFromUnicode) Dim i As Long Dim j As Long dim k as long i = Lenb(s) j = 0 initialize_api do k = pmatch(VarPtr(i), strptr(s), VarPtr(j), StrPtr(p)) 'msgbox k & " " & j if k <> 0 then exit do loop finalize_api End Sub

© Copyright Bruce M. Axtens., 2007

[Google] AdSense and Analytics

On the suggestion of my eldest, I've added Google Analytics. In the next couple of days I should hear back from Google AdSense and will trial having Google Ads on the page. If it earns, fine. If not, I think I'll give it a miss. "Suck it and see," as my late father would have said.

[Ada (GNAT)] A 32bit GNAT.Spitbol.*

It is said that, "a wise man knows his own turnips." In my case, I've run into some difficulty converting GNAT.Spitbol to UTF-32. The compiler error messages are marvellously helpful, but I'm a newbie to Ada and ... yeah, well, you get the idea.

The source code is up on Box.net, if you feel so inclined as to download it and tell me where I'm going wrong.

[Ada (GNAT/GCC)] VARPTR, GNAT and data "transput"

Okay, have got it figured (soli Deo gloria!)

The following listings demonstrate the passing of a two part Type containing two Singles from VB6 into a GNAT/GCC DLL. Once inside, the elements of the Type are swapped and control returns to VB6. VB6 then displays the results.

As before, the code has been worked out in the context of the afore-posted api project. If you want to play with this, just take the earlier work and tweak it appropriately.

First up, the additions to api.ads:

function SwapSingles ( VarPtr : in Win32.LONG) return Win32.BOOL; ... pragma Export (DLL, SwapSingles );

Next, the additions to api.adb:

with Ada.Exceptions; use Ada.Exceptions; ... type Singles is record Part1 : Float; Part2 : Float; end record; type PointerToSingles is access Singles; function To_PointerToSingles is new Ada.Unchecked_Conversion (Win32.LONG, PointerToSingles ); function SwapSingles ( VarPtr : Win32.LONG) return Win32.BOOL is PSingles : PointerToSingles; FTemp1 : Float; FTemp2 : Float; begin PSingles:= To_PointerToSingles(VarPtr); FTemp1 := PSingles.All.Part1; FTemp2 := PSingles.All.Part2; PSingles.All.Part2 := FTemp1; PSingles.All.Part1 := FTemp2; return Win32.TRUE; exception when Constraint_Error => return Win32.FALSE; end SwapSingles;

API.DEF must also be modified, adding swapsingles to the list of EXPORTS.

Next, some VB code to demonstrate ...

Declare Function SwapSingles Lib "api.dll" (ByVal ptr As Long) As Boolean Type SinglesStruct Part1 as Single Part2 as Single End Type ... Dim Singles As SinglesStruct Singles.Part1 = 123.456 Singles.Part2 = 654.321 Debug.Print "Before:" Debug.Print "Singles.Part1 = " & Singles.Part1 Debug.Print "Singles.Part2 = " & Singles.Part2 If swapsingles(VarPtr(Singles)) = False Then Debug.Print "Constraint Error" Else Debug.Print "After:" Debug.Print "Singles.Part1 = " & Singles.Part1 Debug.Print "Singles.Part2 = " & Singles.Part2 End If

... and part of a sample output.

Before: Singles.Part1 = 123.456 Singles.Part2 = 654.321 After: Singles.Part1 = 654.321 Singles.Part2 = 123.456

The project that all this was part of was done in both GNAT/GCC and ObjectAda 7.2.2. Interestingly, ObjectAda's Float is equivalent to VB6's Double, whereas GNAT/GCC's Float is equivalent to VB6's Single. Does anyone know why?

By the way, regarding "transput", Wikipedia's article on Algol states:

ALGOL 60 as officially defined had no I/O facilities; implementations defined their own in ways that were rarely compatible with each other. In contrast, ALGOL 68 offered an extensive library of transput (ALGOL 68 parlance for Input/Output) facilities.

A extensive library of transput facilities is something you'll find in Protium, too.

© Copyright Bruce M. Axtens, 2007

[Ada (GNAT/GCC)] Passing data with VB6's VARPTR to Ada

In the current project, I've been trying to figure out how to pass data to Ada. Because I'll be passing Long, Double (Float), and two Types to emulate a LongLong and a DoubleDouble, I decided I'd use VB's VarPtr and have Ada sort the mess out on its side.

After the loss of a little hair, the reading of bits of Michael B. Feldman's Software Construction and Data Structures with Ada 95, and with help from Martin Krischik and Simon Wright, I came up with the following.

The code was worked out in the context of the afore-posted api project. If you want to play with this, just take the earlier work and stuff this into it.

First up, the additions to api.ads:

function HandlePointer ( Left : in Win32.LONG) return Win32.LONG; ... pragma Export (DLL, HandlePointer );

Next, the additions to api.adb:

function HandlePointer ( Left : in Win32.LONG) return Win32.LONG is type LongRec is record L : Win32.LONG; end record; type PointerToLongRec is access LongRec; function Conv is new Unchecked_Conversion (Win32.LONG, PointerToLongRec ); PLongRec : PointerToLongRec; begin PLongRec := Conv(Left); return PLongRec.All.L; end HandlePointer;

Next, some VB code to demonstrate ...

Declare Function handlepointer Lib "release\api.dll" (ByVal x As Long) As Long Dim i As Long i = 1001 Debug.Print "i="; i Debug.Print "varptr(i)="; VarPtr(i) Debug.Print "what ada thinks is pointed to by varptr(i)="; handlepointer(VarPtr(i))

... and a sample output.

i= 1001 varptr(i)= 1309644 what ada thinks is pointed to by varptr(i)= 1001

I'm in the process now of working out how to access the LongLong and DoubleDouble Types. Shall keep you posted.

By the way, the return value will eventually be a pointer as well. That'll keep the VB programmer on his toes.

© Copyright Bruce M. Axtens, 2007

[Ada (GNAT/GCC)] Better build automation

Just after I notified comp.lang.ada of my posting re GNAT/GPL, Martin Krischik wrote suggesting I use a .gpr file and gnat make rather than a direct reference to gcc.

After reading a friendly manual, I came up with the following .grp file and a batch file to control it.

I have stayed with the batch file, simply because I can't yet see how to have a multiple-program linkage (gnatlink, dlltool and gnatlink a second time).

First, build.gpr

project Build is for Source_Dirs use ( "./", "c:\mingw\lib\gcc\mingw32\4.2.1\**" ); for Object_Dir use "debug"; for Exec_Dir use "debug"; for Main use ("api"); type Style_Type is ("debug", "release"); Style : Style_Type := external ("STYLE", "debug"); case Style is when "debug" => for Object_Dir use "debug"; when "release" => for Object_Dir use "release"; for Exec_Dir use "."; end case; package Builder is case Style is when "debug" => for Default_Switches ("Ada") use ("-g"); when others => null; end case; end Builder; package Compiler is case Style is when "debug" => for Default_Switches ("Ada") use ( "-s", "-gnata", "-gnato", "-gnatE"); when "release" => for Default_Switches ("Ada") use ("-O2", "-fno-strict-aliasing"); end case; end Compiler; end Build;

And then, build.bat. Note the call to UPX, which compresses the release version of the .DLL. Note also that the debug and release subdirectories must already exist (though it wouldn't have been difficult to check-for-and-create-if-missing.)

@echo off set target=%1 if %1@==@ set target=debug if not %1@==debug@ if not %1@==release@ set target=debug echo Building %target% version of dll gnat make -Pbuild -XSTYLE=%target% gnatbind -n -x %target%\api.ali -IC:\MinGW\lib\gcc\mingw32\4.2.1\stdarg -IC:\MinGW\lib\gcc\mingw32\4.2.1\win32ada gnatlink -g -mdll -s -o %target%\api.dll %target%\api.ali -Xlinker --base-file=%target%\api.base dlltool --dllname api.dll --base-file %target%\api.base --output-exp %target%\api.exp --def api.def gnatlink -g -mdll -s -o %target%\api.dll %target%\api.ali -Xlinker --base-file=%target%\api.base %target%\api.exp if %target%==release upx -9 %target%\api.dll

Trust that's helpful.

© Copyright Bruce M. Axtens, 2007

[Ada (GNAT/GCC)] Creating DLLs for VB6

And finally, after much prayer and perspiration, the GNAT/GCC version. Again, thanks to Roger Pearse for The Noddy Guide to using ADA code with Visual Basic. I'm sure there was someone else [This space set aside for an attribution.]

First up, api.ads, which declares the functions and exports them.

• function Factorial, which accepts a Win32.LONG and returns a Win32.LONG (I gave up on C.int as it was too small for a Factorial of 16)
• function GetCount, which returns the value of the global Count (another Win32.LONG)
• procedure Mangle, which accepts a Win32.LPWSTR and attempts the same dangerous stuff that Bob6 does in the ObjectAda version.
• function Pattern, which returns a long pointer to some string data
• procedures Initialize_API, and Finalize_API, which I understand are mandatory. (If someone knows better, please tell me.)

with Interfaces.C; use Interfaces; with Win32; use Win32; package API is Count : Win32.LONG := 0; function Factorial (Val : Win32.LONG) return Win32.LONG; function GetCount return Win32.LONG; procedure Mangle( Ptr : Win32.LPWSTR ); function Pattern return Win32.LPWSTR; procedure Initialize_API; procedure Finalize_API; private pragma Export (DLL, Initialize_API); pragma Export (DLL, Finalize_API); --pragma Export (StdCall, Count); pragma Export (DLL, GetCount ); pragma Export (DLL, Factorial ); pragma Export (DLL, Mangle ); pragma Export (DLL, Pattern ); end API;

Next, api.adb, where the declarations are explained.

I'm still working through the issue of what to do with Mangle. Perhaps two routines are needed. The first to ask the DLL how much space is needed, with VB the allocating it, and the second then actually poking the data into the allocated space.

Pattern returns a pointer to the string data. I rediscovered the technique for reading it out and that's in the VB code below. It also seems that, for as long as the DLL is loaded, the data stored in foo is available for transfer.

with Interfaces.C; use Interfaces.C; with Win32; use Win32; with Win32.Winmain; with Win32.Winbase; with System; package body API is function Factorial (Val : Win32.LONG) return Win32.LONG is Fact : Win32.LONG := 1; begin Count := Count + 1; for K in 1 .. Val loop Fact := Fact * K; end loop; return Fact; end Factorial; function GetCount return Win32.LONG is begin return Count; end GetCount; procedure Mangle( Ptr : Win32.LPWSTR ) is lp : Win32.lpwstr; foo : constant Win32.WCHAR_Array := "foo man chew" & Win32.Wide_Nul; begin lp := Win32.Winbase.lstrcpyW( Ptr, Win32.Addr(foo) ); end Mangle; function Pattern return Win32.LPWSTR is foo : constant Win32.WCHAR_Array := "martinet mongoose manticore" & Win32.Wide_Nul; begin return Win32.Addr(foo); end Pattern; procedure Initialize_API is procedure Adainit; pragma Import (C, Adainit); begin Adainit; end Initialize_API; procedure Finalize_API is procedure Adafinal; pragma Import (C, Adafinal); begin Adafinal; end Finalize_API; end API;

api.def lists the symbols exported, and is needed by gnatdll.

EXPORTS factorial mangle initialize_api finalize_api pattern getcount

Now, pulling it all together requires some handwaving on the commandline. From one of the demos I modified the make.bat to look like this:

@echo off REM first built a relocatable Ada DLL echo Build the Ada dll gnat make api -IC:\MinGW\lib\gcc\mingw32\4.2.1\stdarg -IC:\MinGW\lib\gcc\mingw32\4.2.1\win32ada gnatbind -n -x api.ali -IC:\MinGW\lib\gcc\mingw32\4.2.1\stdarg -IC:\MinGW\lib\gcc\mingw32\4.2.1\win32ada gnatlink -g -mdll -s -o api.dll api.ali -Xlinker --base-file=api.base dlltool --dllname api.dll --base-file api.base --output-exp api.exp --def api.def gnatlink -g -mdll -s -o api.dll api.ali -Xlinker --base-file=api.base api.exp

The output from a run of these is as follows:

C:\msys\1.0\home\Bruce>make Build the Ada dll gcc -c -IC:\MinGW\lib\gcc\mingw32\4.2.1\stdarg -IC:\MinGW\lib\gcc\mingw32\4.2.1\win32ada api.adb Warning: resolving _finalize_api by linking to _finalize_api@0 Use --enable-stdcall-fixup to disable these warnings Use --disable-stdcall-fixup to disable these fixups Warning: resolving _getcount by linking to _getcount@0 Warning: resolving _initialize_api by linking to _initialize_api@0 Warning: resolving _mangle by linking to _mangle@4 Warning: resolving _pattern by linking to _pattern@0 Warning: resolving _factorial by linking to _factorial@4 C:\msys\1.0\home\Bruce>

Now the VB code. Take note of a few things:

• Exporting as DLL generates decorated names, but dlltool was able to resolve the decorated ones with the undecorated ones specified in api.def
• For reasons I remember reading somewhere, initialize_api and finalize_api are mandatory, and must be the first and last calls to the DLL
• Seeing as woof woof woof woof is longer than foo man chew, s ends up containing foo man chew f woof
• As mentioned before, I rediscovered some code for getting data from a pointer and put that in. It's the PointerToString function at the bottom.

Declare Sub initialize_api Lib "api.dll" () Declare Function factorial Lib "api.dll" (ByVal x As Long) As Long Declare Function getcount Lib "api.dll" () As Long Declare Function pattern Lib "api.dll" () As Long Declare Sub mangle Lib "api.dll" (ByVal x As Long) Declare Sub finalize_api Lib "api.dll" () ' Declaration of the function which copies the character string Private Declare Function lstrcpy Lib "Kernel32.Dll " Alias "lstrcpyW" (LpszString1 As Any, LpszString2 As Any) As Long ' Declaration of the function which returns the length in the character string Private Declare Function lstrlen Lib "Kernel32.Dll " Alias "lstrlenW" (ByVal lpszString As Long) As Long Sub main() Dim s As String s = "woof woof woof woof" initialize_api Dim i As Long For i = 1 To 16 Debug.Print factorial(i); Next Debug.Print mangle StrPtr(s) Debug.Print Len(s), s Dim ptr As Long ptr = pattern() Debug.Print PointerToString(ptr) finalize_api End Sub ' Converting the pointer to the character string Function PointerToString(lngPointer As Long) As String Dim bytBuffer(255) As Byte ' Copying the character string which the pointer points to byte array lstrcpy bytBuffer(0), ByVal lngPointer ' Cutoff after the null character PointerToString = Left(bytBuffer, lstrlen(lngPointer)) End Function

Finally, a sample run under VB6

1 2 6 24 120 720 5040 40320 362880 3628800 39916800 479001600 1932053504 1278945280 2004310016 2004189184 19 foo man chew f woof martinet mongoose manticore

Next? Well, there's the issue of how to export overloaded functions and procedures. And there's the question of how to pass in complex data types, like records and the like. I'll keep you posted.

(By the way, I'm not doing this merely for the fun of it, but also in pursuit of the fulfillment of my employer's expectations. So more will follow.)

© Copyright Bruce M. Axtens, 2007

[Ada (GNAT/GPL)] Creating DLLs for VB6

As promised, the GNAT/GPL code. Based on Roger Pearse's The Noddy Guide to using ADA code with Visual Basic.

How I ended up with the names api.ads, api.adb and api.def is an artefact from something I was reading. [This space set aside for an attribution.]

First up, api.ads, which declares the functions and exports them.

• function Factorial, which accepts a C.int and returns a C.int
• procedure Mangle, which accepts a Win32.LPWSTR and attempts the same dangerous stuff that Bob6 does in the ObjectAda version. Still working on this one.
• function Pattern, which returns a Win32.LPWSTR
• procedures Initialize_API, and Finalize_API, which I understand are mandatory. (If someone knows better, please tell me.)

with Interfaces.C; use Interfaces; with Win32; use Win32; package API is Count : C.int := 0; function Factorial (Val : C.int) return C.int; procedure Mangle( Ptr : Win32.LPWSTR ); function Pattern return Win32.LPWSTR; procedure Initialize_API; procedure Finalize_API; -- Initialization & Finalization routines. More in the next section. private pragma Export (DLL, Initialize_API); pragma Export (DLL, Finalize_API); --pragma Export (StdCall, Count); pragma Export (DLL, Factorial ); pragma Export (DLL, Mangle ); pragma Export (DLL, Pattern ); end API;

Next, api.adb, where the declarations are explained.

Mangle replaces the incoming string with something of its own. If the incoming string is larger or the same size then everything's more or less okay. (Less in the latter case, but at least it doesn't crash.) However, if the incoming string is shorter, VB truncates up to the length it knows about, and who knows what damage we've done with whatever gets overwritten by the rest of foo.

Pattern returns a pointer to the string data. Not knowing a lot about Ada, I don't know if the contents of foo will still be there by the time VB looks it and reads out.

with Interfaces.C; use Interfaces.C; with Win32; use Win32; with Win32.Winmain; with Win32.Winbase; with System; package body API is function Factorial (Val : C.int) return C.int is Fact : C.int := 1; begin Count := Count + 1; for K in 1 .. Val loop Fact := Fact * K; end loop; return Fact; end Factorial; procedure Mangle( Ptr : Win32.LPWSTR ) is lp : Win32.lpwstr; foo : Wide_String := Wide_String'("foo man chew"); begin lp := Win32.Winbase.lstrcpyW( Ptr, Win32.Addr(foo) ); end Mangle; function Pattern return Win32.LPWSTR is foo : Wide_String := Wide_String'("foo man chew"); begin return Win32.Addr(foo); end Pattern; procedure Initialize_API is procedure Adainit; pragma Import (C, Adainit); begin Adainit; end Initialize_API; procedure Finalize_API is procedure Adafinal; pragma Import (C, Adafinal); begin Adafinal; end Finalize_API; end API;

api.def lists the symbols exported, and is needed by gnatdll.

EXPORTS factorial mangle initialize_api finalize_api pattern

Now, pulling it all together requires some handwaving on the commandline.

gnat make api -Ic:\gnat\2007\include\win32ada gnatdll -e api.def -d api.dll api.ali -Ic:\gnat\2007\lib\win32ada

The output from a run of these is as follows:

C:\Docume...ts\BO_DLL>gnat make api -Ic:\gnat\2007\include\win32ada gcc -c -Ic:\gnat\2007\include\win32ada api.adb gcc -c -I.\ -Ic:\gnat\2007\include\win32ada -I- c:\gnat\2007\include\win32ada\win32.adb gcc -c -I.\ -Ic:\gnat\2007\include\win32ada -I- c:\gnat\2007\include\win32ada\win32-winbase.adb gcc -c -I.\ -Ic:\gnat\2007\include\win32ada -I- c:\gnat\2007\include\win32ada\win32-winmain.adb gcc -c -I.\ -Ic:\gnat\2007\include\win32ada -I- c:\gnat\2007\include\win32ada\stdarg.adb gcc -c -I.\ -Ic:\gnat\2007\include\win32ada -I- c:\gnat\2007\include\win32ada\stdarg-impl.adb gcc -c -I.\ -Ic:\gnat\2007\include\win32ada -I- c:\gnat\2007\include\win32ada\win32-utils.adb gcc -c -I.\ -Ic:\gnat\2007\include\win32ada -I- c:\gnat\2007\include\win32ada\win32-windef.adb gcc -c -I.\ -Ic:\gnat\2007\include\win32ada -I- c:\gnat\2007\include\win32ada\win32-winnt.adb gcc -c -I.\ -Ic:\gnat\2007\include\win32ada -I- c:\gnat\2007\include\win32ada\stdarg-machine.ads C:\Documen...ts\BO_DLL>gnatdll -e api.def -d api.dll api.ali -Ic:\gnat\2007\lib\win32ada Building relocatable DLL... make api.dll and libapi.a Warning: resolving _finalize_api by linking to _finalize_api@0 Use --enable-stdcall-fixup to disable these warnings Use --disable-stdcall-fixup to disable these fixups Warning: resolving _initialize_api by linking to _initialize_api@0 Warning: resolving _mangle by linking to _mangle@4 Warning: resolving _pattern by linking to _pattern@0 Warning: resolving _factorial by linking to _factorial@4 Warning: resolving _finalize_api by linking to _finalize_api@0 Use --enable-stdcall-fixup to disable these warnings Use --disable-stdcall-fixup to disable these fixups Warning: resolving _initialize_api by linking to _initialize_api@0 Warning: resolving _mangle by linking to _mangle@4 Warning: resolving _pattern by linking to _pattern@0 Warning: resolving _factorial by linking to _factorial@4

Now the VB code. Take note of a few things:

• Exporting as DLL generates decorated names, but gnatdll was able to resolve the decorated ones with the undecorated ones specified in api.def
• For reasons I remember reading somewhere, initialize_api and finalize_api are mandatory, and must be the first and last calls to the DLL
• Seeing as woof woof woof woof is longer than foo man chew, s ends up containing foo man chew
  woof

Declare Sub initialize_api Lib "api.dll" () Declare Function factorial Lib "api.dll" (ByVal x As Integer) As Integer Declare Function pattern Lib "api.dll" () As Long Declare Sub mangle Lib "api.dll" (ByVal x As Long) Declare Sub finalize_api Lib "api.dll" () Sub main() Dim s As String s = "woof woof woof woof" initialize_api Debug.Print factorial(3) mangle StrPtr(s) Debug.Print Len(s), s finalize_api End Sub

Next stop is to get this working with "GNAT/GCC MS-Windows MinGW 4.2.1 R0". I would prefer to be working under the GMGPL.

© Copyright Bruce M. Axtens., 2007

[Ada (ObjectAda 7.2.2)] Creating VB6 DLLs

Creating DLLs for use by VB6 seems to be somewhat of a dark art. From what Roger Pearse, in his The Noddy Guide to using ADA code with Visual Basic says, it doesn't appear to be something easily achieved.

So far I've achieved it, to a certain extent, with ObjectAda and GNAT/GPL. The code for the ObjectAda implementation is below. I'll post the GNAT/GPL stuff in the next couple of days, God willing.

BO_DLib.adb, BO_D.adb and BO_D.ads are all based, albeit rather loosely, on sample files in winapi\samples\petzold\ch19\edrlib\

First up, BO_DLib.adb

-- ====================================================================================== -- -- -- -- Converted from Programming Windows 95 / Charles Petzold -- 4th ed. -- -- Chapter 19 EDRLIB.C: Easy Drawing Routine Library Module -- -- -- -- ====================================================================================== -- with BO_B; procedure BO_BLib is begin null; end BO_BLib;

Next, the spec file, BO_D.ads

There are six routines:

• procedure Bob1 calls dobox to show a messagebox.
• function Bob2 returns a long value, 1.
• function Bob3 receives a long and adds 21 to it.
• procedure Bob4 receives a long pointer to a string and passes it to dobox for display.
  I can pass Unicode to it and have it rendered appropriately.
• function Bob5 receives a long pointer to a string and returns a long being the length of the string.
• function Bob6 receives a long pointer to a string and catenates a string to it.
  "Danger, Will Robinson!" ... this is not how to do it and VB complains bitterly.

Okay, there are seven routines, but dobox isn't exported. It takes a pointer to a wide string and passes it to Win32.Winuser.MessageBoxW. I got dobox from a sample file as well.

-- ====================================================================================== -- -- -- -- Converted from Programming Windows 95 / Charles Petzold -- 4th ed. -- -- Chapter 19 EDRLIB.C: Easy Drawing Routine Library Module -- -- -- -- ====================================================================================== -- with Win32.Windef; package BO_B is procedure bob1; function Bob2 return Win32.LONG; function bob3 ( arg : Win32.LONG ) return Win32.LONG; procedure Bob4( Arg : win32.LPCWSTR ); function bob5( Arg : win32.PCWSTR ) return win32.LONG; procedure dobox (msg : Win32.PCWSTR); procedure Bob6( Arg : Win32.LPWSTR ); pragma Export (DLL_Stdcall, Bob1, "Bob1"); pragma export (DLL_Stdcall, Bob2, "Bob2"); pragma export (DLL_Stdcall, Bob3, "Bob3"); pragma Export (DLL_Stdcall, Bob4, "Bob4"); pragma Export (DLL_Stdcall, Bob5, "Bob5"); pragma Export (DLL_Stdcall, Bob6, "Bob6"); end BO_B;

And, finally, BO_D.adb, where the definitions given in BO_D are fleshed out.

-- ====================================================================================== -- -- -- -- Converted from Programming Windows 95 / Charles Petzold -- 4th ed. -- -- Chapter 19 EDRLIB.C: Easy Drawing Routine Library Module -- -- -- -- ====================================================================================== -- with Interfaces.C; with interfaces.C.Strings; use interfaces; with Ada.Unchecked_Conversion; with Interfaces.C.Strings; with System; with Win32.Crt.Direct; with Win32.Crt.Stdlib; with Win32.Winbase; with Win32.Windef; with Win32.Wingdi; with Win32.Winmain; with Win32.Utils; with Win32.Winuser; with win32; use win32; with Win32.windowsx; package body BO_B is procedure bob1 is msg : Win32.PCWSTR; HELLOMSG : constant WCHAR_Array := "Hello" & Wide_Nul; begin Msg := Addr(HELLOMSG); dobox(Msg); end bob1; function Bob2 return Win32.LONG is begin return 1; end bob2; function bob3 ( arg : Win32.LONG ) return Win32.LONG is use type Win32.LONG; sum : Win32.LONG; begin Sum := Arg + 21; return Sum; end Bob3; procedure Bob4( Arg : win32.PCWSTR ) is begin dobox(arg); end Bob4; function Bob5( Arg : win32.PCWSTR ) return win32.LONG is Arguments_Length : constant Win32.LONG := Win32.LONG (Win32.Winbase.lstrlenW (Arg)); begin return Arguments_Length; end Bob5; procedure Bob6( Arg : Win32.LPWSTR ) is H : Wide_String := Wide_String'("doo dah, doo dah"); c : Win32.lpwstr; begin c := win32.winbase.lstrcatW( Arg, Addr(H) ); end Bob6; procedure dobox (msg : Win32.PCWSTR) is IResult : Win32.INT; begin iResult := Win32.Winuser.MessageBoxW(System.Null_Address, Msg, Addr("Title"), 0); end dobox; end BO_B;

Now the VB code. Take note of a few things:

• I declared the functions and procedures as DLL_Stdcall in BO_D.ads so the routines come in decorated, thus the use of Alias in the Declare line. I used Microsoft's Dependency Walker to discover to what extent the names had been mangled.
• A reference to SCRRUN.DLL was added to the project, making possible the use of the FileSystemObject.
• Bob6 barges past the limit set for the string by VB, so things get a bit unstable. I'm still working through how to pass strings back.

Declare Sub Bob1 Lib "bo_blib.dll" Alias "_Bob1@0" () Declare Function Bob2 Lib "bo_blib.dll" Alias "_Bob2@0" () As Long Declare Function Bob3 Lib "bo_blib.dll" Alias "_Bob3@4" (ByVal i As Long) As Long Declare Sub Bob4 Lib "bo_blib.dll" Alias "_Bob4@4" (ByVal ptr As Long) Declare Function Bob5 Lib "bo_blib.dll" Alias "_Bob5@4" (ByVal ptr As Long) As Long Declare Sub Bob6 Lib "bo_blib.dll" Alias "_Bob6@4" (ByVal ptr As Long) Dim oFSO As New Scripting.FileSystemObject Dim oStream As Scripting.TextStream Sub main() Dim s As String Set oStream = oFSO.OpenTextFile("c:\temp\hua.txt", ForReading, False, TristateTrue) s = oStream.ReadLine oStream.Close Bob1 Debug.Print Bob2 Debug.Print Bob3(21) Bob4 (StrPtr(s)) Debug.Print Bob5(StrPtr(s)) Bob6 StrPtr(s) MsgBox s End Sub

By the way, if you think my code sucks, say so. I'm a total newb when it comes to Ada. Critiques are always welcome. King Solomon said, "The wise person accepts instructions." and also "Better is open rebuke than hidden love."

© Copyright Bruce M. Axtens., 2007

[Protium] Splitting

Here's a short script for splitting a file. The file in this case is the perl language data file from the PLEAC website. pleac_perl.data contains sections marked with "# ^^PLEAC^^_" followed by a number. The section applies until the next section is marked. The script splits each section out of pleac_perl.data into pleac_perl_number.p. I'm working through these files and re-expressing the intent of the perl code in Protium.

<@ DEFAREFLE>pleac</@> <@ DEFFLELIT>pleac|C:\Documents and Settings\All Users\Documents\Projects\PLEAC\pleac_perl.data</@> <@ ITEENUFLELIT>pleac| <@ LETVARELTFLE>aLine|...</@> <@ TSTRXPVARLIT>aLine|# \^\^PLEAC\^\^_(\d+\.\d+)</@> <@ IFF><@ LETVARKEY>number|__Reg1</@> <@ ACTSNKLIT>__Off</@> <@ ACTSNKEMMLIT>pleac_perl_&number;.p</@> </@> <@ SAYVAR>aLine</@> </@>

The code may be described as follows:

1. Define a work area, or alias, for the data file, calling it 'pleac'.
2. Open the text file within that work area, using define-file-lit.
3. Start a loop which iterates through an enumeration of the lines of data in the work area.
4. Let a variable contain the data in the current line of the work area.
5. Test whether the regular expression works for the current line.
6. If it does work, let a variable contain the number found, ...
7. ... turn off any output redirection, ...
8. ... and redirect output to the file 'pleac_perl_' + the number found (in the same directory as the script).
9. End of the if.
10. Output the contents of the line.
11. End of the iteration.

Simple ... and way powerful!

© Copyright Bruce M. Axtens, 2007

[Protium] 'Assert' as a User-Defined Syllable (UDS)

From time to time, during development, it helps to have an assert. That is, a means of checking whether you got the answer you were expecting, but without having to write lots of repetitive code in the process. To that end, therefore, I've come up with a UDS, an user defined syllable, which implements the concept (and demonstrates other Protium functionality as well.)

For the sake of clarity, I've put each syllable, or "opcode", in title case. This is not something that must be done; Protium cares not what case or mix of cases the instructions are in.

<@ DefUdsLitLit>ASR|__Transformer|<@ Sao> lhs=<@ LetVarPar>lhs|1</@> rhs=<@ LetVarPar>rhs|2</@> <@ IffNotExmVarVarLit>lhs|rhs| <@ LetResEkmLit>...|Assertion error: '&lhs;' <> '&rhs;'</@> </@> <@ Ign><@ Els> <@ LetResVar>...|lhs</@> </@></@> </@> </@>

A UDS is 'defined', thus the DEF at the beginning. An UDS has 3 parameters: the syllable itself, then the kind of UDS (more about that later), and then the Protium code which is processed each time the syllable is used. In this case, the syllable is ASR, the type is '__Transformer' and the code starts with <@ SAO> (more about SAO later, too).

Parameters may be passed to UDSes, and retrieved using PAR. In this case, the variable lhs is given the value of the first parameter, and the variable rhs the value of the second.

Next comes the test which forms the basis of an assert: does what is contained in lhs equal what is contained in rhs? The fourth line's opcodes implement this test: if not exact-match variable variable literal, with the arguments lhs, rhs and then another Protium instruction which is only evaluated if the test for exact-match fails.

If lhs does not match rhs, an EKM (Expand Macro Key And Memory) of the literal string "Assertion error: '&lhs;' <> '&rhs;'" is performed. lhs and rhs are bracketed by ampersand and comma, with the result that these symbols are replaced with the values of the variables themselves. The result is stored in the RES (the result) of the UDS, which is handed back to the calling code. Next comes a block wrapped in IGN. This is an artefact from the development of ASR. Code inside an IGN is ignored, that is, not executed. IGNs are predominantly used for documentation but can just as easily be used to isolate parts of the code.

<@ LetVarLit>string|Once a jolly swagman camped by a billabong</@> <@ SayAsrCapLit><@ SayActRmdVarLitLitLit>string|23|6|quatter</@>|Once a jolly squatter camped by a billabong</@> <@ LetVarLit>string|Once a jolly swagman camped by a billabong</@> <@ SayAsrCapLit><@ SayActRmdVarLitLitLit>string|23|6|quatter</@>|all your base are belong to us</@>

Here are two invocations of the ASR syllable. The first generates nothing because the actioned RMD, the reverse-mid, actually does convert "Once a jolly swagman camped by a billabong" into "Once a jolly squatter camped by a billabong". The second invocation gives the error message because there's no way that that reverse-mid is going to be able to produce "all your base are belong to us".

Now SAO, aside from being the name of an Arnott's biscuit, also stands for "Suppress All Output". Usually text outside the <@> and </@> of a Protium instruction is echoed to the relevant transput (read input-output device). SAO suppresses that echoing. This explains why you don't see 'lhs=' and 'rhs=' each time ASR is invoked. SAO also suppresses everything output by SAY.

Regarding __Transformer, every syllable opcode belongs to a particular group of syllables and each group has certain specific behaviours. Other groups include __Modifier, __Alternator, __Evaluator and __Locator. Read the friendly manual.

Finally, a word about testing. It was the developer's original design to separate testing from branching, and it was due to pressure from the Protium user community which forced the merging of the two into the form seen in most other programming languages. According to the original design, the test and branch code should have looked like this:

<@ TstNotExmVarVar>lhs|rhs</@> <@ IffLit> <@ LetResEkmLit>...|Assertion error: '&lhs;' <> '&rhs;'</@> </@>

Both ways of doing it work. I'm starting to come round to the idea that the original design is the better one, especially seeing that Protium supports ternary logic (true, false, unknown). More about that some other time.

This article can also be found at Isotopes of Hydrogen on the Protium Blue Forum.

© Copyright Bruce M. Axtens, 2007