Copyright (c) Digital Equipment Corporation 1995.  All rights reserved.

PRODUCT:  DEC FMS for OpenVMS AXP, Version 2.5
          DEC PL/I for OpenVMS AXP Systems, Version 4.0

OP/SYS:   OpenVMS Alpha, Version 6.1

SOURCE:   Digital Equipment Corporation


SYMPTOM:

When the application built by the attached command procedure is executed,
UAR execution does not appear to run correctly on an Alpha only.

The return of the field completion status in UAR2 does not occur as
it normally would on a VAX.  Instead FMS (via use of FDV$DEBUG logical)
reveals the following error:

        %FDV-E-UAR, UAR returned illegal code

In addition the FDV$GETAL function is terminated.


DIGITAL RESPONSE:

This problem has been reported to Engineering.


WORKAROUND:

Take the PLI Begin / End block out of the UARs.


ANALYSIS:

Extract the attached command procedure and execute it on a Alpha running
FMS 2.5 with PLI 4.0.  Next run the application by typing:

  $ RUN TEST

Then, type '1' into field1 and '2' into field2.

At this point the UAR2 will execute and since the value of '2' was typed
into field2 then the UAR should return a sucessful completion status.
Instead the status:

        %FDV-E-UAR, UAR returned illegal code

is signaled and the FDV$GETAL in the mainline is terminated.

$ create testform.flg
!          FMS Form Description Application Aid
!                     Version V2.5
FORM NAME='TESTFORM'
     AREA_TO_CLEAR=1:23
     WIDTH=CURRENT
     BACKGROUND=CURRENT
     ;
TEXT (3,6) 'FieldA :'
     ;
TEXT (3,21) 'UAR1'
     ;
TEXT (5,6) 'FieldB :'
     ;
TEXT (5,21) 'UAR2'
     ;
TEXT (7,6) 'FieldC :'
     ;
TEXT (7,21) 'UAR1'
     ;
TEXT (9,6) 'FieldD :'
     ;
TEXT (9,21) 'UAR2'
     ;
ATTRIBUTE_DEFAULTS FIELD
     CLEAR_CHARACTER=' '
     NOAUTOTAB BLANK_FILL NOBLINKING NOBOLD NOREVERSE
     NOUNDERLINE NODISPLAY_ONLY ECHO NOFIXED_DECIMAL
     LEFT_JUSTIFIED NOSUPERVISOR_ONLY NOSUPPRESS NOUPPERCASE
     ;
FIELD NAME='FIELDA'  (3,15)
     PICTURE=4'X'
     ACTION_ROUTINE='UAR1'
     CLEAR_CHARACTER='_'
     ;
FIELD NAME='FIELDB'  (5,15)
     PICTURE=4'X'
     ACTION_ROUTINE='UAR2'
     CLEAR_CHARACTER='_'
     ;
FIELD NAME='FIELDC'  (7,15)
     PICTURE=4'X'
     ACTION_ROUTINE='UAR1'
     CLEAR_CHARACTER='_'
     ;
FIELD NAME='FIELDD'  (9,15)
     PICTURE=4'X'
     ACTION_ROUTINE='UAR2'
     CLEAR_CHARACTER='_'
     ;
ORDER BEGIN_WITH = 1
     NAME='FIELDA'
     NAME='FIELDB'
     NAME='FIELDC'
     NAME='FIELDD'
     ;
END_OF_FORM NAME='TESTFORM' ;
$ FMS/TRANSLATE TESTFORM
$ CREATE TEST.PLI
test: proc options (main);
%include 'FMS$EXAMPLES:FDVDEFCAL.PLI';
   dcl terminator                      fixed bin (31),
       buffer                          char (16),
       (fmswork01(3), tca(3))          fixed bin (31)  external,
       (fmsstatus, rmsstatus)          fixed bin (31)  static;
   call fdv$aterm (tca,12,3);
   call fdv$ssrv  (fmsstatus,rmsstatus);
   call fdv$awksp (fmswork01,3000);
   call fdv$swksp (fmswork01);
   call fdv$load  ('TESTFORM');
   call fdv$dispw;
   call fdv$getal (buffer,terminator);
   put skip list ('buffer="' || buffer || '"');
   put skip list ('terminator',terminator);
end test;
uar1: proc returns (fixed bin (31));
%include 'FMS$EXAMPLES:FDVDEFCAL.PLI';
   dcl fname    char(8),
       fvalue   char(4);
   call fdv$retfn (fname);
   call fdv$ret   (fvalue,fname);
   if fvalue = '1'
      then return (fdv$k_uval_suc );
      else return (fdv$k_uval_fail);
end uar1;
uar2: proc returns (fixed bin (31));
%include 'FMS$EXAMPLES:FDVDEFCAL.PLI';
   dcl fname    char(8),
       fvalue   char(4);
   begin;  /* START BEGIN BLOCK */
   call fdv$retfn (fname);
   call fdv$ret   (fvalue,fname);
   if fvalue = '2'
      then return (fdv$k_uval_suc );
      else return (fdv$k_uval_fail);

   end;   /* END BEGIN BLOCK */
end uar2;
$ pli test
$ fms/vector testform.frm/output=testform.vector
$ fms/object testform.frm/output=testform.object
$ link test.obj,testform.vector,testform.object
$ exit

buy online or call 1.800.AT.COMPAQ