To start, please note that I have no experience at all with VAX/VMS and I don't have access to a VAX system. That said, section 3.7.5 of the book provides quite some details on the workings of the (missing) code. Using this description (and some info from the VAX Ada Run-Time Reference Manual, section 8.6, or the Run-Time Reference Manual for OpenVMS Systems, section 7.7, see here) I attempted to (more-or-less) reconstruct some part of the the VMS package (i.e. how it might've looked like). The result is shown below. I have no idea whether it even compiles, but it seems a nice starting point from which to continue the investigation.
Update (4-jul-2021)
Out of interest, I digged in a little bit further and it seems that QIO and QIOW actually stand for system services named "Queue I/O (wait)". These services are described in some more recent VMS documents:
- OpenVMS System Services Reference Manual (see here).
- OpenVMS I/O User's Reference Manual (see here).
The first manual describes the parameters for $QIO and $QIOW while the second manual describes terminal specific driver functions which are likely needed here (see chapter 5 and appendix A.5).
Based on these documents, it seems that you need to use use $QIO and $QIOW in combination with a functions IO_READVBLK and IO_WRITEVBLK. I'm not sure this is actually correct, but it at least seems plausible. I added this to the code below.
disk2/dec/vmss.ada (reconstruction attempt)
package VMS is
VMS_IO_ERROR : exception;
task INPUT is
entry Ready (RDY : out BOOLEAN);
-- Returns true if a new character is available.
entry Get (CH : out CHARACTER);
-- Blocks until a new character is available.
private
entry KeyPush;
-- The AST service routine.
pragma AST_ENTRY (KeyPush);
end INPUT;
package OUTPUT is
procedure Put (CH : CHARACTER);
-- Writes a character to the terminal.
end OUTPUT;
end VMS;
disk2/dec/vmsb.ada (reconstruction attempt)
package body VMS is
task body INPUT is separate;
package body OUTPUT is separate;
end VMS;
disk2/dec/vmsbi.ada (reconstruction attempt)
with SYSTEM; use SYSTEM; -- To make "or" visible.
with STARLET;
with CONDITION_HANDLING;
separate (VMS)
task body INPUT is
ASG_STATUS : CONDITION_HANDLING.COND_VALUE_TYPE;
QIO_STATUS : CONDITION_HANDLING.COND_VALUE_TYPE;
CHANNEL : STARLET.CHANNEL_TYPE;
TERM_DEV : constant STARLET.DEVICE_NAME_TYPE := "SYS$COMMAND";
-- ??? Not sure if "SYS$COMMAND" is a valid device definition.
QIO_IOSB : STARLET.IOSB_TYPE;
pragma VOLATILE (QIO_IOSB);
NEW_DATA : BOOLEAN;
KEYINPUT : STRING (1 .. 1) := (1 => '?');
begin
STARLET.ASSIGN (
STATUS => ASG_STATUS,
DEVNAM => TERM_DEV,
CHAN => CHANNEL);
if not CONDITION_HANDLING.SUCCESS (ASG_STATUS) then
CONDITION_HANDLING.STOP (ASG_STATUS);
raise VMS_IO_ERROR;
end if;
NEW_DATA := FALSE;
loop
STARLET.QIO (
STATUS => QIO_STATUS,
CHAN => CHANNEL,
FUNC => STARLET.IO_READVBLK or STARLET.IO_M_NOECHO or STARLET.IO_M_NOFILTR,
IOSB => QIO_IOSB,
ASTADR => INPUT.KeyPush'AST_ENTRY,
P1 => SYSTEM.TO_UNSIGNED_LONGWORD (KEYINPUT'ADDRESS), -- Address of the buffer.
P2 => 1); -- Length of the buffer.
if not CONDITION_HANDLING.SUCCESS (QIO_STATUS) then
CONDITION_HANDLING.STOP (QIO_STATUS);
raise VMS_IO_ERROR;
end if;
-- Buffer input.
L1 : while not NEW_DATA loop
select
accept KeyPush do
NEW_DATA := TRUE;
end KeyPush;
or
accept Ready (RDY : out BOOLEAN) do
RDY := FALSE;
end Ready;
or
terminate;
end select;
end loop L1;
-- Buffer output.
L2 : while NEW_DATA loop
select
accept Get (CH : out CHARACTER) do
CH := KEYINPUT (1);
NEW_DATA := FALSE;
end Get;
or
accept Ready (RDY : out BOOLEAN) do
RDY := TRUE;
end Ready;
or
terminate;
end select;
end loop L2;
end loop;
end INPUT;
disk2/dec/vmsbo.ada (reconstruction attempt)
with SYSTEM;
with STARLET;
with CONDITION_HANDLING;
separate (VMS)
package body OUTPUT is
CHANNEL : STARLET.CHANNEL_TYPE;
TERM_DEV : constant STARLET.DEVICE_NAME_TYPE := "SYS$OUTPUT";
-- ??? Not sure if "SYS$OUTPUT" is a valid device definition.
procedure Put (CH : CHARACTER) is
QIO_STATUS : CONDITION_HANDLING.COND_VALUE_TYPE;
QIO_IOSB : STARLET.IOSB_TYPE;
pragma VOLATILE (QIO_IOSB);
BUFFER : STRING (1 .. 1) := (1 => CH);
begin
STARLET.QIOW (
STATUS => QIO_STATUS,
CHAN => CHANNEL,
FUNC => STARLET.IO_WRITEVBLK,
IOSB => QIO_IOSB, -- Not sure if this is actually needed here.
P1 => SYSTEM.TO_UNSIGNED_LONGWORD (BUFFER'ADDRESS), -- Address of the buffer.
P2 => 1); -- Length of the buffer.
if not CONDITION_HANDLING.SUCCESS (QIO_STATUS) then
CONDITION_HANDLING.STOP (QIO_STATUS);
raise VMS_IO_ERROR;
end if;
end Put;
begin
declare
ASG_STATUS : CONDITION_HANDLING.COND_VALUE_TYPE;
begin
STARLET.ASSIGN (
STATUS => ASG_STATUS,
DEVNAM => TERM_DEV,
CHAN => CHANNEL);
if not CONDITION_HANDLING.SUCCESS (ASG_STATUS) then
CONDITION_HANDLING.STOP (ASG_STATUS);
raise VMS_IO_ERROR;
end if;
end;
end OUTPUT;
main.ada
with VMS;
with TEXT_IO;
procedure MAIN is
CH : CHARACTER := '?';
begin
while CH /= 'q' loop
VMS.INPUT.Get (CH);
TEXT_IO.PUT (CH); -- Might be convenient for debugging.
VMS.OUTPUT.Put (CH);
end loop;
end MAIN;
