Блог

Из интереса я углубился немного дальше, и кажется, что QIO и QIOW на самом деле стоят системные службы с именем «Очередь ввода-вывода (ожидание)». Эти службы описаны в некоторых более поздних документах виртуальных машин:

• Справочное руководство по системным службам OpenVMS (см. Здесь).
• Справочное руководство пользователя ввода-вывода OpenVMS (см. Здесь).

В первом руководстве описываются параметры $QIO и $QIOW , в то время как во втором руководстве описываются функции драйвера терминала, которые, вероятно, потребуются здесь (см. главу 5 и приложение A. 5).

Основываясь на этих документах, кажется, что вам нужно использовать использование $QIO и $QIOW в сочетании с функциями IO_READVBLK и IO_WRITEVBLK . Я не уверен, что это на самом деле правильно, но это, по крайней мере, кажется правдоподобным. Я добавил это в приведенный ниже код.

disk2/dec/vmss.ada (попытка восстановления)

 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 (попытка восстановления)

 package body VMS is

   task body INPUT is separate;

   package body OUTPUT is separate;

end VMS;
 

disk2/dec/vmsbi.ada (попытка восстановления)

 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 (попытка восстановления)

 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;