Character IO for Ada83 on a VAX/VMS system

Question

Another retro computing type question...

I'm hoping that someone out there will remember how to do direct character IO from the terminal under VMS using Ada83 (v3.0A).

Unfortunately this old version of Ada does not implement GET_IMMEDIATE in the TEXT_IO package.

There is a tantalising hint in Jones' book 'Ada in Action' at section 3.7.1 but I've not been able to find the listings that the text refers to, or anything in the DEC Language Reference Manual that might help directly. I'm sure I did this in FORTRAN and PASCAL a long time ago but can't for the life of me remember how!

I know I could make life easier for myself by upgrading, or even switching to Linux and using the GNAT compiler but half the fun is figuring out how stuff works (or in this case used to work).

Thanks

Answer 1

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;