ada - VAX/VMS 系统上 Ada83 的字符 IO

Question

另一个复古计算类型的问题......

我希望有人会记得如何使用 Ada83 (v3.0A) 从 VMS 下的终端进行直接字符 IO。

不幸的是，Ada 的这个旧版本没有在 TEXT_IO 包中实现 GET_IMMEDIATE。

Jones 的书“Ada in Action”的第 3.7.1 节中有一个诱人的提示，但我无法找到该文本引用的 list ，或者 DEC 语言引用手册中可能有帮助的任何内容直接地。我确定我很久以前就用 FORTRAN 和 PASCAL 做过这个，但我想不起来是怎么做到的了!

我知道我可以通过升级甚至切换到 Linux 并使用 GNAT 编译器让自己的生活更轻松，但一半的乐趣在于弄清楚这些东西是如何工作的(或者在这种情况下曾经工作过)。

谢谢

Answer 1

首先，请注意，我完全没有使用 VAX/VMS 的经验，而且我无法访问 VAX 系统。也就是说，section 3.7.5本书的部分提供了有关(缺失的)代码工作原理的相当多的细节。使用此描述(以及 VAX Ada 运行时引用手册第 8.6 节或 OpenVMS 系统运行时引用手册第 7.7 节中的一些信息，请参阅 here)我试图(或多或少)重建VMS 包的某些部分(即它可能 的样子)。结果如下所示。我什至不知道它是否可以编译，但这似乎是继续调查的一个很好的起点。

更新(2021 年 7 月 4 日)

出于兴趣，我进一步深入挖掘，似乎 QIO 和 QIOW 实际上代表名为“Queue I/O (wait)”的系统服务.这些服务在最近的一些 VMS 文档中有描述:

• OpenVMS 系统服务引用手册(参见 here)。
• OpenVMS I/O 用户引用手册(参见 here)。

第一本手册描述了 $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;

ma​​in.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;