VAX/VMS系统中Ada83的字符IO

Question

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

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

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

琼斯在3.7.1节的“Ada in Action”一书中有一个诱人的暗示，但我一直未能找到文本中提到的清单，或DEC语言参考手册中任何可能直接有用的内容。我相信我很久以前就在FORTRAN和PASCAL做过这件事了，但是我的一生都记不起是怎么回事！

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

谢谢

Answer 1

首先，请注意，我完全没有使用VAX/VMS的经验，也没有访问VAX系统的权限。尽管如此，书中的第3.7.5款提供了一些关于(缺失)代码工作方式的详细信息。使用此描述(以及VAX运行时参考手册第8.6节或OpenVMS系统运行时参考手册第7.7节(参见这里)中的一些信息)，我试图(或多或少地)重构VMS包的某些部分(即它可能是怎样的)。结果如下所示。我不知道它是否会编译，但这似乎是一个继续调查的好起点。

更新(4-7-2021)

出于兴趣，我进一步研究了一下，似乎QIO和QIOW实际上代表了名为"Queue I/O (wait)“的系统服务。这些服务在最近的一些VMS文档中进行了描述：

• OpenVMS系统服务参考手册(见这里)。
• OpenVMS I/O用户参考手册(见这里)。

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