











                     Using DEC VAX Software From Pascal


                           John S. Heffernan
                           RCA/Automated Systems Division



Using DEC VAX Software From Pascal                                Page 1


               ABSTRACT

               The VAX/VMS operating system is supplied with utilities

               that casual users may not be aware of.  It is not always

               clear how to use these utilities from a high level

               language such as VAX Pascal.  This paper explores the use

               of LIB$TPARSE, the librarian, RMS, the CLI callback, and

               the set message utility from a Pascal program.  Examples

               and hints are shown.  The use of these utilities can save

               program  development  time  and  produce  better  quality
          software.
Using DEC VAX Software From Pascal                                Page 2


          1.0  INTRODUCTION



               VAX/VMS is supplied with utility  software  that  can  be
          used   for  user  applications.   By  using  already  existing
          software, code need not be rewritten.   Also,  this  code  has
          been  tested  and  is of generally high quality.  The run time
          library (RTL), system  services,  command  language  interface
          routines,  lib$tparse,  RMS  (record management services), the
          set message utility, and edit/FDL (file  definition  language)
          can  all  be used from a Pascal environment.  This paper shows
          how these  routines  are  defined  from  Pascal,  some  common
          errors,  and  examples  of  their  use.  The intent is to help
          Pascal and other HLL (high level language) users who  want  to
          start using these routines without starting from scratch.



          2.0  VARYING LENGTH STRINGS

               VAX-11 Pascal version 2.0 is equipped with the VARYING OF
          CHAR  type.   While  this type is convenient to use, there are
          some problems in using this type  with  the  utility  software
          mentioned   above.    Specifically,   this   class  of  string
          (DSC$K_CLASS_VS) does not work with the librarian utilities or
          with  the  OTS ( language independent support) part of the run
          time library.  Any problems mentioned in this paper have  been
          SPRed  and  I  have  either received an acceptable response or
          have not received a response yet.  The RTL user's guide states
          that  OTS  only  accepts  DSC$K_CLASS_S  strings.  There is an
          error in the RTL reference manual that says that  the  ots$cvt
          string  parameter form is x.  The manual should read x1.  This
          means that %STDESCR is used not %DESCR.  If you  like  to  use
          varying  length  strings, a conversion routine is useful.  One
          example of such a routine is shown in the RMS  examples.   Its
          name  is  cvt_vstring_fstring.   It  converts a varying length
          string to a fixed length string.  The LIB$  part  of  the  run
          time  library handles VARYING OF CHAR strings correctly.  This
          software handles VARYING OF  CHAR  strings  correctly  because
          lib$analyze_sdesc   is  called  for  passed  strings.   System
          services do not accept VARYING OF CHAR since  DSK$_CLASS_S  is
          assumed.   You can pass the body of the VARYING OF CHAR string
          to OTS or system services.  However, the string must be padded
          with  blanks.   This  paper  does  not discuss system services
          since the topic is covered in the Pascal  documentation.   Our
          site  has  not  had  any problems calling system services from
          Pascal.    It   certainly   is   much    easier    with    the
          sys$library:starlet.pas  file  that  came  with version two of
          Pascal.  This file is an environment file for system  services
          and  RMS.   Additionally,  the  constants  in  starlet.olb are
          defined.  Hopefully, in the future,  sys$library:rtl.pas  will
          be  provided  so  that  all  of  the  run time library will be
          defines in an environment file.
Using DEC VAX Software From Pascal                                Page 3


               Another  problem  one  faces   is   constructing   string
          descriptors  from  Pascal.   For example, many data structures
          call for the address of  a  string  and  the  string's  length
          inside  a  data  structure.  For example, lib$tparse takes the
          address and length of the string to be parsed  as  part  of  a
          data  structure known as the parameter block.  One easy way to
          handle this is to assign the address part of the record to  be
          the  result  of the ADDRESS function.  This part of the record
          must be declared with the UNSAFE  attribute  since  the  types
          will not match.  If you use a VARYING OF CHAR string, then add
          2 to the address since the two bytes of the length  field  are
          not part of the string itself.  The lib$tparse example in this
          paper shows these operations.  When you want to assign a value
          to  an  RMS  data structure such as a FAB from Pascal, inherit
          sys$library:starlet.pas.  Again, you must supply addresses  of
          variables.   However,  in  this case, the user can not declare
          the record field UNSAFE.  The solution  is  use  the  typecast
          operator.   Simply  typecast  the assignment as UNSIGNED.  The
          RMS examples  later  in  the  paper  clarify  this  operation.
          Alternatively, pointers may be used in these structures.



          3.0  RMS



               Many times, your program may want to access RMS  features
          not  supported by the PASCAL run time support procedures.  RMS
          uses four kinds of record blocks in its  I/O  operations  that
          your  program  can  access.   The  FAB ( file attribute block)
          contains file  wide  information  such  as  the  filename  and
          organization.   A  RAB  (  record  attribute  block)  contains
          information related to each record  stream  connected  to  the
          FAB.   The  NAM  block  contains extended filename information
          (used  in  file  name  parsing  operations).   Finally,   XABs
          (eXtended  Attribute  Blocks)  provide  additional information
          that is not contained in  the  FAB.   For  example,  keys  are
          defined   in  XABs.   also,  file  protection  information  is
          contained in the XAB$PRO block.

               We had a case where a privileged program running  from  a
          system  management  utility  created  a  file  for a user that
          collected mail messages from another computer system.  We  did
          not  want  these  mail files to have the [1,4] UIC.  There are
          three ways that can  be  used  to  access  RMS  features  from
          PASCAL.   The  first method is to use the user open feature of
          the OPEN statement.  In this case,  the  user  open  procedure
          takes the FAB, RAB, and file variables as parameters.  The run
          time support routine for OPEN  passes  Pascal's  FAB  and  RAB
          which are initialized for you.  In the user open function, you
          can modify or read FAB, RAB, XAB, and NAM fields.  This method
          does  restrict  the  user  to one record stream per FAB.  This
          method is documented with an  example  in  the  VAX-11  Pascal
          User's Guide.  Another example is shown in appendix A.
Using DEC VAX Software From Pascal                                Page 4


               Perhaps the most convenient way to generally use RMS from
          Pascal  is  to use the RMS macros in a MACRO32 module external
          to your Pascal routine.   The  RMS  macros  handle  statically
          initialized fields and correct storage allocation.  Also, your
          program has complete control over all I/O operations (you must
          use  all  RMS I/O).  In this method, declare the RMS structure
          to be  external  of  type  FAB$TYPE,  RAB$TYPE,  NAM$TYPE,  or
          XAB$TYPE.  An example of this method is shown in appendix B.

               Finally, if one refuses for ideological reasons to invoke
          the  MACRO32  assembler,  you  can  program completely Pascal.
          However, the user is  responsible  for  initializing  all  the
          normally  statically  initialized  fields  and  the no default
          values for fields should be assumed.  The same program without
          using  MACRO32  is shown below.  The technique here is to look
          up the statically initialized  fields  in  the  RMS  reference
          manual  and  to  fill them in at run time with the appropriate
          value.  This method is shown in appendix C.

               Finally,  we  present  a  few  warnings  about  RMS  data
          structures.    The   programmer  must  ensure  that  RMS  data
          structures are statically allocated.  This is because RMS must
          access  the  structures across function calls.  If you declare
          the  structures  in  the  main  module,  they  are  statically
          allocated.   If  access  violations  or  RMS$FAB  occur, it is
          likely that the structure was allocated space  on  the  stack.
          When using user open, the $connect service must be called.  In
          the other methods, you must close the file.  Otherwise,  image
          rundown  will  try  to  close the file and will not be able to
          find the FAB and a RMS$_IFI error occurs.  Note  that  in  the
          above  examples  that  if  your  process  does not have system
          privilege, you can not create a file with a different UIC.



          4.0  EDIT/FDL



               Edit/FDL is a useful utility for defining files  for  the
          HLL  programmer.  This is especially true for defining indexed
          files.  This utility  provides  access  to  RMS  features  not
          accessible  through the run time system such as key data types
          other than ordinal types and PACKED ARRAY OF CHAR.  The method
          is to:

           o  Use edit/FDL to create a description  file.   I  find  the
              design  option easy to use since the FDL editor guides you
              through a series of questions.

           o  Use create/FDL to create the empty data file.

           o  Define the file in Pascal as a file of your  basic  record
              type.  The KEY attribute defines keys in the file.
Using DEC VAX Software From Pascal                                Page 5


          The only trouble I  experienced  was  assuming  that  edit/FDL
          filled in the correct key positions.  RMS supports overlapping
          keys so you can get odd results if the key  positions  do  not
          match.    Also,   beware  when  testing  status  results  that
          PAS$K_EOF is frequently a normal condition so that you have to
          be  careful  about  not signaling it.  One other result that I
          did not quite expect is that RESETK fills the file buffer.  In
          conclusion,  there are many ways to access RMS features in the
          HLL environment and the process is easier than one might first
          expect.



          5.0  HELP LIBRARIAN



               If you run  interactive  VAX  utilities  frequently,  you
          notice  that  almost all the help facilities are the same.  In
          designing a  DBMS  system,  I  decided  to  try  and  use  the
          librarian to handle an interactive help facility.  This method
          is extremely simple and saves a great deal of  coding  effort.
          Basically,  the method is to create and edit your help file in
          accordance with the instructions in  the  Utilities  Reference
          manual.   The source is then run through the librarian utility
          to create a .hlb  file.   In  the  image,  declare  the  three
          librarian  routines  needed  for  help  libraries.   They  are
          lbr$ini_control, lbr$_open, and lbr$output_help.  In my  case,
          I  handled  my  own  errors  and there is a problem in getting
          values of the librarian status codes.  I could not  find  them
          in either starlet.mlb or lib.mlb.  The only place I could find
          them was in the shareable image sys$library:lbrshr.exe.  So  I
          used  analyze/image  and  EDT to create an include file.  This
          file is shown in appendix D.

               There  are  a  few  problems  with  the  completion  code
          documentation.   One is that RMS errors may be returned to the
          user.  Also, lbr$insvmem does not exist and SS$NORMAL  may  be
          returned.  The function definitions are shown below.

          FUNCTION lbr$ini_control ( %REF libraryindex : UNSIGNED ;
                                     %REF func         : UNSIGNED ;
                                     %REF lbrtype      : UNSIGNED ;
                                     %IMMED namblk     : UNSIGNED )
                                  : INTEGER ; EXTERN ;

          FUNCTION lbr$open  ( %REF     libraryindex   : UNSIGNED     ;
                               %STDESCR filename       : filenametype ;
                               %IMMED   createoptions  : UNSIGNED     ;
                               %IMMED   dns            : UNSIGNED     ;
                               %IMMED   rlfna          : UNSIGNED     ;
                               %STDESCR rns            : filenametype ;
                               %REF     rnslen         : UNSIGNED       )
                           : INTEGER ; EXTERN ;

Using DEC VAX Software From Pascal                                Page 6


          FUNCTION lbr$output_help (  %IMMED     outputroutine : UNSIGNED ;
                                      %REF       outputwidth   : UNSIGNED ;
                                      %STDESCR   linedesc      : helplinetype ;
                                      %STDESCR   libraryname   : filenametype ;
                                      %REF       flags         : UNSIGNED ;
                                      %IMMED     inputroutine  : UNSIGNED )
                                   : INTEGER ; EXTERN ;


               Note that all the strings must be of type PACKED ARRAY OF
          CHAR.   The  libraryindex  variable must be a global variable.
          It is important to pass the input and  output  routines  using
          %IMMED  in  the  actual  function  call since the compiler may
          otherwise confuse the entry point and the result  of  function
          causing  an  access  violation.   Shown  in  appendix  D  is a
          complete example.

               In conclusion, once I got  around  the  VARYING  OF  CHAR
          problem,  I  found  the librarian easy to use.  One nice thing
          about it is that the help text itself is  not  hardwired  into
          code,  but  easily  accessible in a file.  Also, the prompting
          and wildcarding capabilities are nice features that would take
          considerable effort to implement yourself.



          6.0  LIB$TPARSE



               Lib$tparse is a general purpose DFA parser.  It  is  well
          documented   in  appendix  A  of  the  RTL  reference  manual.
          However, the manual is unclear as to whether it  can  be  used
          from  an HLL.  It turns that it can be used fairly easily from
          Pascal.  The state table must be defined in MACRO32 and linked
          in.  There are two methods to use lib$tparse from Pascal.  The
          first is to declare the parameter block to be of type tpa$type
          since  $TPADEF  is  part  of starlet.pas.  Declare it with the
          EXTERNAL attribute and define it  in  a  MACRO32  PSECT.   The
          tpa$l_field must be set to tpa$k_count0.

               Another formulation is to define the parameter  block  in
          Pascal.  This record is shown below.
             tokentype        = PACKED ARRAY [1..100] OF CHAR;
             stringptrtype    = ^tokentype ;
             TPARSEBLOCKTYPE  =  RECORD
                      BLOCKLENGTH        :  [LONG, pos(0) ]   INTEGER ; 
                      BLANKS             :  [BIT,  pos(32)]   BOOLEAN ;
                      ABBREV             :  [BIT,  pos(33)]   BOOLEAN ;
                      ABBRFM             :  [BIT,  pos(34)]   BOOLEAN ;
                      AMBIG              :  [BIT,  pos(48)]   BOOLEAN ;
                      MCOUNT             :  [BYTE, pos(56)]   1..255  ;
                      STRINGCNT          :  [LONG, POS(64)]   INTEGER ;
                      STRINGPTR          :  [LONG, POS(96),VOLATILE,UNSAFE] UNSIGNED;
                      TOKENCNT           :  [LONG, POS(128)]  INTEGER ;
Using DEC VAX Software From Pascal                                Page 7


                      TOKENPTR           :  [LONG, POS(160)]  stringptrtype ;
                      CHAR               :  [BYTE, POS(192)]  1..255  ;
                      NUMBER             :  [LONG, POS(224)]  INTEGER ; 
                      PARAM              :  [LONG, POS(256)]  INTEGER ;
                  END      ;


               Shown in appendix E is an example of a module  that  uses
          the   above  definition.   Note  that  lib$tparse  can  return
          SS$_INSFARG.  This routine is especially  useful  from  Pascal
          lacks   powerful   string  manipulation  facilities.   In  one
          application, I had 11 pages of state table.   This  amount  of
          commands  would  have  been  very tedious to deal with without
          this facility.  The !label subroutine feature  of  lib$tparse,
          which  allows commonly seen expressions to be only coded once,
          saves additional time and  space.   Note  that  the  <  and  >
          characters  must  be  represented by their ASCII numbers.  The
          parameter block should be a global  variable  so  that  action
          routines  can  access  parameters  that  can be defined in the
          state table.



          7.0  SET COMMAND



               The set command utility is straight forward to  use.   It
          provides  a nice means of extending DCL for your installation.
          Using  the  command  language  interface  utilities  has   the
          advantages of

           o  The CLI does the parsing for you.

           o  The CLI does the error reporting for you.

           o  The programmer can supply default values.

           o  The programmer can force the user to supply values.

           o  The command is defined in one file.


               The method for the HLL programmer is shown below.

          1.  Edit your command definition file.

          2.  Invoke the set command command to put the command in  your
              process P1 space (if this is an installation wide utility,
              see your system manager).

          3.  Inside  the  image,  check  the   command   entered   with
              cli$get_value and cli$present.

          A sample Pascal program that uses the CLI  interface  routines
Using DEC VAX Software From Pascal                                Page 8


          in appendix F.



          8.0  SET MESSAGE



               The set message utility is  also  useful  to  the  Pascal
          programmer  in  writing error handlers.  The method used is as
          follows.

           o  Use your favorite editor to create and edit  your  message
              source file.

           o  Compile the message  source  file  with  the  set  message
              command.

           o  Write a "little program" that  takes  the  message  output
              file  and outputs an environment file that defines all the
              message constants.

           o  Write an error handler  that  calls  lib$signal  with  the
              symbolic  constant  passed to it.  You may want to include
              as a parameter an optional string  so  that  filenames  or
              tokens can be seen by the user.


               The error handler is shown in appendix G.



          9.0  CONCLUSION



               We have seen how to use many common VAX utilities from  a
          high  level language environment.  The general technique is to
          define the functions  that  make  up  the  utility  correctly,
          generate  any  constants that are needed, set up the arguments
          to be passed, call the  function,  and  check  the  function's
          return status.  In some cases, files are processed before your
          software  is  invoked.   An  example  is  the  help  librarian
          formatting  your  .hlb  file.   Using these utilities can save
          time and effort.   Furthermore,  your  programs  may  be  more
          consistent  with the rest of the VAX software and may look and
          work better.












                               APPENDIX A

                      RMS EXAMPLE USING USER OPEN



First, common definitions used in all three examples are shown.  .sp 1

{ Common definitions used by all three RMS examples }
CONST    
   maxvstring = 100 ;
   maxfstring = 100 ;
TYPE
   fstring     = PACKED ARRAY [1..maxfstring] OF CHAR ;
   vstring     = VARYING [maxvstring] OF CHAR ;
   $UBYTE      = [BYTE] 0..255   ;
   $UWORD      = [WORD] 0..65355 ;
FUNCTION lib$stop (%IMMED rstatus : INTEGER  ) : INTEGER ; EXTERN ;

FUNCTION lib$get_input (%DESCR instring : vstring ;
                        %DESCR ptstring : vstring ;
                        %REF   inlen    : $UWORD ) 
                   : INTEGER ; EXTERN ;

FUNCTION ots$cvt_to_l (%STDESCR ffstrg  : fstring ;
                       %REF   answer    : $UWORD  ;
                       %IMMED anssize   : INTEGER ;
                       %IMMED flags     : INTEGER  ) 
                   : INTEGER ; EXTERN ;

{-------------------------------------------------------------}

PROCEDURE cvt_vstring_fstring  (    varstr : vstring ;
                                VAR fixstr : fstring ) ;

VAR
   index    : INTEGER ;

BEGIN
   FOR index := 1 TO varstr.length DO
      fixstr[index] :=varstr.body[index] ;
   IF varstr.length < maxfstring THEN 
      FOR index := (varstr.length + 1) TO maxfstring DO
            fixstr[index] := ' ' ;
END;

RMS EXAMPLE USING USER OPEN                                     Page A-2



{-------------------------------------------------------------}

[INHERIT ('sys$library:starlet.pen')]

PROGRAM  createwithuic ( INPUT, OUTPUT,nfile ) ;
{ This program uses RMS and the Pascal user open function to create
  a file with a UIC different from the process }
  
VAR
   instring   : vstring   ;
   pstring    : vstring   ;
   fnstring   : vstring   ;
   otsstring  : fstring   ;
   rstatus    : INTEGER   ;
   xab        : xab$type  ;
   inlen      : $UWORD    ;
   octalnum   : $UWORD    ;
   nfile      : TEXT      ;


FUNCTION user_open ( VAR fab : fab$type ;
                     VAR rab : rab$type ;
                     VAR   f : TEXT ) : INTEGER ;
BEGIN
{ Get filename from sys$input }
   pstring  := 'Enter the file to be created:  ' ;
   rstatus  := lib$get_input (fnstring, pstring , inlen ) ;
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop ( rstatus ) ;
{ Put into the FAB }
   fab.fab$l_fna  := (ADDRESS (fnstring)) :: UNSIGNED ; 
   fab.fab$l_fna  := fab.fab$l_fna + 2 ;
   fab.fab$b_fns  := fnstring.length  ; 
   fab.fab$l_xab  := (ADDRESS (xab)) :: UNSIGNED ;
   xab.xab$b_bln  := xab$c_prolen ; { specify the length of XAB}
   xab.xab$b_cod  := xab$c_pro    ; { specify the type of XAB }
{ Get member number }
   pstring  := 'Enter the member (octal ) number of the UIC:  ' ;
   rstatus  := lib$get_input (instring, pstring , inlen ) ;
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop ( rstatus ) ;
{ Convert the string to octal } 
   cvt_vstring_fstring (instring, otsstring ) ;
   rstatus := ots$cvt_to_l ( otsstring, octalnum, 2,1 ) ;
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop ( rstatus ) ;
{ Put in xabpro member field }
   xab.xab$w_mbm := octalnum ;
{ Get group number }
   pstring  := 'Enter the group (octal ) number of the UIC:  ' ;
   rstatus  := lib$get_input (instring, pstring , inlen ) ;
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop ( rstatus ) ;
{ Convert the string to octal } 
RMS EXAMPLE USING USER OPEN                                     Page A-3


   cvt_vstring_fstring (instring, otsstring ) ;
   rstatus := ots$cvt_to_l ( otsstring, octalnum, 2,1 ) ;
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop ( rstatus ) ;
{ Put in xabpro group field }
   xab.xab$w_grp := octalnum ;
   rstatus := $create(fab) ;
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop(rstatus ) ;
   $connect(rab) ; { This is required }
   user_open := rstatus ;
END ;
{------------------------------------------------------------------}
{Main program }
BEGIN
   OPEN ( nfile, HISTORY := new , USER_ACTION := user_open ) ;
   CLOSE (nfile ) ;
END.












                               APPENDIX B

            RMS EXAMPLE USING EXTERNAL BLOCKS FROM MACRO-32



For the same example, the MACRO32 module is shown below.

        .TITLE RMSSTORAGE 
        .PSECT DATA,WRT,NOEXE

FAB::   $FAB
XAB::   $XABPRO
        .END
The corresponding Pascal routine is shown below.  The common definitions
used in the first example are omitted.

[INHERIT ('sys$library:starlet.pen')]

PROGRAM  createwithuic ( INPUT, OUTPUT) ;
{ This program creates a file with a different UIC from the process 
using RMS.  The FAB and RAB are defined using an external MACRO32 
module}
  
VAR
   instring   : vstring   ;
   pstring    : vstring   ;
   fnstring   : vstring   ;
   otsstring  : fstring   ;
   rstatus    : INTEGER   ;
   fab        : [EXTERNAL] fab$type ;
   xab        : [EXTERNAL] xab$type ;
   inlen      : $UWORD    ;
   octalnum   : $UWORD    ;
   nfile      : TEXT      ;

{-------------------------------------------------------------}
{ Main program }

BEGIN
{ Get filename from sys$input }
   pstring  := 'Enter the file to be created:  ' ;
   rstatus  := lib$get_input (fnstring, pstring , inlen ) ;
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop ( rstatus ) ;
{ Put into the FAB }
RMS EXAMPLE USING EXTERNAL BLOCKS FROM MACRO-32                 Page B-2


   fab.fab$l_fna  := (ADDRESS (fnstring)) :: UNSIGNED ; 
   fab.fab$l_fna  := fab.fab$l_fna + 2 ;
   fab.fab$b_fns  := fnstring.length  ; 
   fab.fab$l_xab  := (ADDRESS (xab)) :: UNSIGNED ;
{ Get member number }
   pstring  := 'Enter the member (octal ) number of the UIC:  ' ;
   rstatus  := lib$get_input (instring, pstring , inlen ) ;
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop ( rstatus ) ;
{ Convert the string to octal } 
   cvt_vstring_fstring (instring, otsstring ) ;
   rstatus := ots$cvt_to_l ( otsstring, octalnum, 2,1 ) ;
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop ( rstatus ) ;
{ Put in xabpro member field }
   xab.xab$w_mbm := octalnum ;
{ Get group number }
   pstring  := 'Enter the group (octal ) number of the UIC:  ' ;
   rstatus  := lib$get_input (instring, pstring , inlen ) ;
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop ( rstatus ) ;
{ Convert the string to octal } 
   cvt_vstring_fstring (instring, otsstring ) ;
   rstatus := ots$cvt_to_l ( otsstring, octalnum, 2,1 ) ;
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop ( rstatus ) ;
{ Put in xabpro group field }
   xab.xab$w_grp := octalnum ;
   rstatus := $create(fab) ;
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop(rstatus ) ;
   $close(fab) ; { The file must be closed }
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop(rstatus ) ;
END ;
END.













                               APPENDIX C

                   RMS EXAMPLE WITHOUT USING MACRO 32




[INHERIT ('sys$library:starlet.pen')]

PROGRAM  createwithuic ( INPUT, OUTPUT) ;
{ This program creates a file with a different UIC from the process 
using RMS.  No MACRO32 code is used.}
  
VAR
   instring   : vstring   ;
   pstring    : vstring   ;
   fnstring   : vstring   ;
   otsstring  : fstring   ;
   rstatus    : INTEGER   ;
   fab        : fab$type  ;
   xab        : xab$type  ;
   inlen      : $UWORD    ;
   octalnum   : $UWORD    ;
   nfile      : TEXT      ;

{-------------------------------------------------------------}
{ Main program }

BEGIN
{ Get filename from sys$input }
   pstring  := 'Enter the file to be created:  ' ;
   rstatus  := lib$get_input (fnstring, pstring , inlen ) ;
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop ( rstatus ) ;
{ Put into the FAB }
   fab.fab$l_fna  := (ADDRESS (fnstring)) :: UNSIGNED ; 
   fab.fab$l_fna  := fab.fab$l_fna + 2 ;
   fab.fab$b_fns  := fnstring.length  ; 
   fab.fab$l_xab  := (ADDRESS (xab)) :: UNSIGNED ;
{ Fill in static fields }
   fab.fab$b_bid  := fab$c_bid ;
   fab.fab$b_bln  := fab$c_bln ;
   xab.xab$b_bln  := xab$c_prolen ;
   xab.xab$b_cod  := xab$c_pro    ;
{ Get member number }
   pstring  := 'Enter the member (octal ) number of the UIC:  ' ;
RMS EXAMPLE WITHOUT USING MACRO 32                              Page C-2


   rstatus  := lib$get_input (instring, pstring , inlen ) ;
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop ( rstatus ) ;
{ Convert the string to octal } 
   cvt_vstring_fstring (instring, otsstring ) ;
   rstatus := ots$cvt_to_l ( otsstring, octalnum, 2,1 ) ;
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop ( rstatus ) ;
{ Put in xabpro member field }
   xab.xab$w_mbm := octalnum ;
{ Get group number }
   pstring  := 'Enter the group (octal ) number of the UIC:  ' ;
   rstatus  := lib$get_input (instring, pstring , inlen ) ;
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop ( rstatus ) ;
{ Convert the string to octal } 
   cvt_vstring_fstring (instring, otsstring ) ;
   rstatus := ots$cvt_to_l ( otsstring, octalnum, 2,1 ) ;
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop ( rstatus ) ;
{ Put in xabpro group field }
   xab.xab$w_grp := octalnum ;
   rstatus := $create(fab) ;
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop(rstatus ) ;
   $close(fab) ; { Required }
   IF NOT ODD (rstatus) THEN 
      rstatus := lib$stop(rstatus ) ;
END ;
END.












                               APPENDIX D

                         HELP LIBRARIAN EXAMPLE




 LBR$_NORMAL      =  %X'00268001'  ; 
 LBR$_KEYINDEX    =  %X'00268009'  ; 
 LBR$_KEYINS      =  %X'00268011'  ; 
 LBR$_OLDLIBRARY  =  %X'00268019'  ; 
 LBR$_NOHISTORY   =  %X'00268403'  ; 
 LBR$_EMPTYHIST   =  %X'0026840B'  ; 
 LBR$_HDRTRUNC    =  %X'00268800'  ; 
 LBR$_NOUPDHIST   =  %X'00268808'  ; 
 LBR$_NULIDX      =  %X'00268810'  ; 
 LBR$_OLDMISMCH   =  %X'00268818'  ; 
 LBR$_RECTRUNC    =  %X'00268820'  ; 
 LBR$_STILLKEYS   =  %X'00268828'  ; 
 LBR$_TYPMISMCH   =  %X'00268830'  ; 
 LBR$_NOMTCHFOU   =  %X'00268838'  ; 
 LBR$_ERRCLOSE    =  %X'00268840'  ; 
 LBR$_ENDTOPIC    =  %X'00268848'  ; 
 LBR$_ALLWRNGBLK  =  %X'00269002'  ; 
 LBR$_DUPKEY      =  %X'0026900A'  ; 
 LBR$_ILLCTL      =  %X'00269012'  ; 
 LBR$_ILLCREOPT   =  %X'0026901A'  ; 
 LBR$_ILLIDXNUM   =  %X'00269022'  ; 
 LBR$_ILLFMT      =  %X'0026902A'  ; 
 LBR$_ILLFUNC     =  %X'00269032'  ; 
 LBR$_ILLOP       =  %X'0026903A'  ; 
 LBR$_ILLTYP      =  %X'00269042'  ; 
 LBR$_INVKEY      =  %X'0026904A'  ; 
 LBR$_INVNAM      =  %X'00269052'  ; 
 LBR$_INVRFA      =  %X'0026905A'  ; 
 LBR$_KEYNOTFND   =  %X'00269062'  ; 
 LBR$_LIBNOTOPN   =  %X'0026906A'  ; 
 LBR$_LKPNOTDON   =  %X'00269072'  ; 
 LBR$_LIBOPN      =  %X'0026907A'  ; 
 LBR$_NOFILNAM    =  %X'00269082'  ; 
 LBR$_NOHLPTXT    =  %X'0026908A'  ; 
 LBR$_NOTHLPLIB   =  %X'00269092'  ; 
 LBR$_RECLNG      =  %X'0026909A'  ; 
 LBR$_REFCNTZERO  =  %X'002690A2'  ; 
 LBR$_RFAPASTEOF  =  %X'002690AA'  ; 
 LBR$_TOOMNYLIB   =  %X'002690B2'  ; 
HELP LIBRARIAN EXAMPLE                                          Page D-2


 LBR$_UPDURTRAV   =  %X'002690BA'  ; 
 LBR$_BADPARAM    =  %X'002690C2'  ; 
 LBR$_INTRNLERR   =  %X'002690CA'  ; 
 LBR$_WRITEERR    =  %X'002690D2'  ; 
 LBR$_ILLOUTROU   =  %X'002690DA'  ; 
 LBR$_ILLOUTWID   =  %X'002690E2'  ; 
 LBR$_ILLINROU    =  %X'002690EA'  ; 
 LBR$_TOOMNYARG   =  %X'002690F2'  ; 
 LBR$_USRINPERR   =  %X'002690FA'  ; 
 LBR$GL_CONTROL   =  %X'00000200'  ; 
 LBR$GL_RMSSTV    =  %X'00000204'  ; 


     Below is a module that initializes the help facility.
[INHERIT ('defs.pen','sys$library:starlet.pen')]
MODULE inithelpdef  ;
{
 FUNCTIONAL DESCRIPTION:
    This routine initializes the help facility.  
 INPUTS:  none
 OUTPUTS: none
 IMPLICIT INPUTS:  the lbr status codes and function definitions are inherited
 IMPLICIT OUTPUTS: lbrindex : a global longword written by lib$ini_control 
 COMPLETION CODES: normal
 SIDE EFFECTS: the help file is opened
 CALLING SEQUENCE: retstatus := inithelp ;
}
FUNCTION inithelp : INTEGER ;

VAR
   lbrstatus     : INTEGER ;
   lbrfunction   : INTEGER ;
   lbrtype       : INTEGER ;
   lbrfilename   : filenametype ;
   rnsfilename   : filenametype ; { expanded file name if open error }
   rnslength     : UNSIGNED     ; { length of above }

BEGIN
   lbrtype       := lbr$c_typ_hlp ; {Defined in starlet }
   lbrfunction   := lbr$c_read    ; {Defined in starlet }
   lbrstatus     := lbr$ini_control ( lbrindex , lbrfunction,lbrtype,0 ) ;
   IF lbrstatus = lbr$_normal THEN
      inithelp := normal 
   ELSE IF lbrstatus =  lbr$_illfunc   THEN
      errorexit ('Inithelp-Fatal-Illegal function', fatal )
   ELSE IF lbrstatus =  lbr$_illtyp    THEN
      errorexit ('Inithelp-Fatal-Illegal library type', fatal )
   ELSE IF lbrstatus =  lbr$_toomnylib THEN
      errorexit ('Inithelp-Fatal-Too many indices ', fatal ) 
   ELSE 
      errorexit ('Inithelp-Fatal-Unknown return status from lbr$ini_control' ,
                  fatal ) ;
   lbrfilename := 
    'dbms$help:dbms.hlb                                                    ' ; 
   lbrstatus   := lbr$open ( lbrindex , lbrfilename, 0, 0, 0, rnsfilename,
HELP LIBRARIAN EXAMPLE                                          Page D-3


                             rnslength  ) ;   

   IF lbrstatus = lbr$_normal THEN
      inithelp := normal 
   ELSE IF lbrstatus =  lbr$_errclose     THEN
      errorexit ('Inithelp-Fatal-Library illegally closed', fatal )
   ELSE IF lbrstatus =  lbr$_oldlibrary   THEN
      errorexit ('Inithelp-Fatal-Version one library detected',fatal )
   ELSE IF lbrstatus =  lbr$_illcreopt    THEN
      errorexit ('Inithelp-Fatal-Illegal create options', fatal )
   ELSE IF lbrstatus =  lbr$_illctl       THEN
      errorexit ('Inithelp-Fatal-Illegal index ', fatal )
   ELSE IF lbrstatus =  lbr$_illfmt       THEN
      errorexit ('Inithelp-Fatal-Illegal library format', fatal )
   ELSE IF lbrstatus =  lbr$_illfunc      THEN
      errorexit ('Inithelp-Fatal-Illegal function specified', fatal )
{  The code below is not defined in the image but is documented -
   ELSE IF lbrstatus =  lbr$_insvirmem    THEN
      errorexit ('Inithelp-Fatal-Insufficient virtual memory', fatal)
}
   ELSE IF lbrstatus =  lbr$_libopn       THEN
      errorexit ('Inithelp-Fatal-Library already open', fatal )
   ELSE IF lbrstatus =  lbr$_nofilnam     THEN
      errorexit ('Inithelp-Fatal-No file name as specified', fatal )
   ELSE IF lbrstatus =  lbr$_oldmismch    THEN
      errorexit ('Inithelp-Fatal-Function conflicts with old library', fatal)
   ELSE IF lbrstatus =  lbr$_typmismch    THEN
      errorexit ('Inithelp-Fatal-Library type mismatch', fatal )
   ELSE IF lbrstatus =  rms$_flk          THEN
      errorexit ('Inithelp-Fatal-RMS file locked error ', fatal)
   ELSE
      BEGIN     
         writeln ( 'status is ', hex(lbrstatus )); 
         errorexit ('Inithelp-Fatal-Unknown return status from lbr$open' ,
                  fatal ) ;
      END 
END;
END.
An example of the actual use of the librarian  to  output  the  help  is
shown  below.  I prefer the prompting mode which keeps you in help until
you want to get out.
[INHERIT ('defs.pen','sys$library:starlet.pen')]
MODULE puthelpdef ;
{
 FUNCTIONAL DESCRIPTION:
    This routine is an action routine that invokes a display help
    utility.  The routine must strip the leading help token from the 
    string before passing it on to lbr$output_help.
 INPUTS:  none
 OUTPUTS: none 
 IMPLICIT INPUTS:  commandbuffer : the line the user entered.
                   the logical name dbms$help must point to the help file
 IMPLICIT OUTPUTS: terminal displays of help text from the help file
                   fatal errors encountered by the librarian may be signaled
 COMPLETION CODES: normal
HELP LIBRARIAN EXAMPLE                                          Page D-4


                   badargs if filename length is out of range
 SIDE EFFECTS: none
 CALLING SEQUENCE: called by lib$tparse automatically.  The address of this 
   routine is specified in the state table and control passes to it when the
   help token is detected.
}
FUNCTION puthelp  : INTEGER ;

VAR
   helpline     : helplinetype ;
   lbrstatus    : INTEGER ;
   outputwidth  : INTEGER ;
   flags        : UNSIGNED ;
   filename     : filenametype ;
   index        : INTEGER ;

BEGIN
   outputwidth  := 80 ;
   helpline     := commandbuffer.body ;
   flags        := hlp$m_prompt ; { Defined by starlet }
   filename     :=
'dbms$help:dbms.hlb                                                    ' ;
   helpline     := nullhelpline ;
   FOR index := 1 to commandbuffer.length DO
      helpline[index] := commandbuffer.body[index] ;
{ remove help token }
   helpline[1]  := ' ' ;
   IF helpline[2] = 'E' THEN 
      BEGIN
         helpline[2] := ' ' ;
         IF helpline[3] = 'L' THEN
            BEGIN
               helpline[3] := ' ' ;
               IF helpline[4] = 'P' THEN
                  helpline[4] := ' ' ;
            END;
      END;
   lbrstatus    := lbr$output_help ( %IMMED lib$put_output  , outputwidth,
                                     helpline, filename , flags ,
                                     %IMMED lib$get_input   ) ;
   IF ((lbrstatus = lbr$_normal) OR (lbrstatus = SS$_NORMAL )) THEN
      puthelp := normal 
   ELSE IF lbrstatus =  lbr$_illinrou  THEN 
      errorexit ( 'Puthelp-Fatal-Illegal input routine', fatal )
   ELSE IF lbrstatus =  lbr$_illoutrou THEN 
      errorexit ( 'Puthelp-Fatal-Illegal output routine', fatal)
   ELSE IF lbrstatus =  lbr$_toomnyarg THEN 
      errorexit ( 'Puthelp-Fatal-Too many arguments', fatal )
   ELSE 
      BEGIN
         writeln   ( 'Lbr$output_help status is ', hex(lbrstatus)) ;
         lib$signal (lbrstatus ) ;
         errorexit ( 'Puthelp-Fatal-Unknown return status from lbr$output_help',
                     fatal )
      END ;
HELP LIBRARIAN EXAMPLE                                          Page D-5


END;
END.

     Below is a module that initializes the help facility.
[INHERIT ('defs.pen','sys$library:starlet.pen')]
MODULE inithelpdef  ;
{
 FUNCTIONAL DESCRIPTION:
    This routine initializes the help facility.  
 INPUTS:  none
 OUTPUTS: none
 IMPLICIT INPUTS:  the lbr status codes and function definitions are inherited
 IMPLICIT OUTPUTS: lbrindex : a global longword written by lib$ini_control 
 COMPLETION CODES: normal
 SIDE EFFECTS: the help file is opened
 CALLING SEQUENCE: retstatus := inithelp ;
}
FUNCTION inithelp : INTEGER ;

VAR
   lbrstatus     : INTEGER ;
   lbrfunction   : INTEGER ;
   lbrtype       : INTEGER ;
   lbrfilename   : filenametype ;
   rnsfilename   : filenametype ; { expanded file name if open error }
   rnslength     : UNSIGNED     ; { length of above }

BEGIN
   lbrtype       := lbr$c_typ_hlp ; {Defined in starlet }
   lbrfunction   := lbr$c_read    ; {Defined in starlet }
   lbrstatus     := lbr$ini_control ( lbrindex , lbrfunction,lbrtype,0 ) ;
   IF lbrstatus = lbr$_normal THEN
      inithelp := normal 
   ELSE IF lbrstatus =  lbr$_illfunc   THEN
      errorexit ('Inithelp-Fatal-Illegal function', fatal )
   ELSE IF lbrstatus =  lbr$_illtyp    THEN
      errorexit ('Inithelp-Fatal-Illegal library type', fatal )
   ELSE IF lbrstatus =  lbr$_toomnylib THEN
      errorexit ('Inithelp-Fatal-Too many indices ', fatal ) 
   ELSE 
      errorexit ('Inithelp-Fatal-Unknown return status from lbr$ini_control' ,
                  fatal ) ;
   lbrfilename := 
    'dbms$help:dbms.hlb                                                    ' ; 
   lbrstatus   := lbr$open ( lbrindex , lbrfilename, 0, 0, 0, rnsfilename,
                             rnslength  ) ;   

   IF lbrstatus = lbr$_normal THEN
      inithelp := normal 
   ELSE IF lbrstatus =  lbr$_errclose     THEN
      errorexit ('Inithelp-Fatal-Library illegally closed', fatal )
   ELSE IF lbrstatus =  lbr$_oldlibrary   THEN
      errorexit ('Inithelp-Fatal-Version one library detected',fatal )
   ELSE IF lbrstatus =  lbr$_illcreopt    THEN
      errorexit ('Inithelp-Fatal-Illegal create options', fatal )
HELP LIBRARIAN EXAMPLE                                          Page D-6


   ELSE IF lbrstatus =  lbr$_illctl       THEN
      errorexit ('Inithelp-Fatal-Illegal index ', fatal )
   ELSE IF lbrstatus =  lbr$_illfmt       THEN
      errorexit ('Inithelp-Fatal-Illegal library format', fatal )
   ELSE IF lbrstatus =  lbr$_illfunc      THEN
      errorexit ('Inithelp-Fatal-Illegal function specified', fatal )
{  The code below is not defined in the image but is documented -
   ELSE IF lbrstatus =  lbr$_insvirmem    THEN
      errorexit ('Inithelp-Fatal-Insufficient virtual memory', fatal)
}
   ELSE IF lbrstatus =  lbr$_libopn       THEN
      errorexit ('Inithelp-Fatal-Library already open', fatal )
   ELSE IF lbrstatus =  lbr$_nofilnam     THEN
      errorexit ('Inithelp-Fatal-No file name as specified', fatal )
   ELSE IF lbrstatus =  lbr$_oldmismch    THEN
      errorexit ('Inithelp-Fatal-Function conflicts with old library', fatal)
   ELSE IF lbrstatus =  lbr$_typmismch    THEN
      errorexit ('Inithelp-Fatal-Library type mismatch', fatal )
   ELSE IF lbrstatus =  rms$_flk          THEN
      errorexit ('Inithelp-Fatal-RMS file locked error ', fatal)
   ELSE
      BEGIN     
         writeln ( 'status is ', hex(lbrstatus )); 
         errorexit ('Inithelp-Fatal-Unknown return status from lbr$open' ,
                  fatal ) ;
      END 
END;
END.
An example of the actual use of the librarian  to  output  the  help  is
shown  below.  I prefer the prompting mode which keeps you in help until
you want to get out.
[INHERIT ('defs.pen','sys$library:starlet.pen')]
MODULE puthelpdef ;
{
 FUNCTIONAL DESCRIPTION:
    This routine is an action routine that invokes a display help
    utility.  The routine must strip the leading help token from the 
    string before passing it on to lbr$output_help.
 INPUTS:  none
 OUTPUTS: none 
 IMPLICIT INPUTS:  commandbuffer : the line the user entered.
                   the logical name dbms$help must point to the help file
 IMPLICIT OUTPUTS: terminal displays of help text from the help file
                   fatal errors encountered by the librarian may be signaled
 COMPLETION CODES: normal
                   badargs if filename length is out of range
 SIDE EFFECTS: none
 CALLING SEQUENCE: called by lib$tparse automatically.  The address of this 
   routine is specified in the state table and control passes to it when the
   help token is detected.
}
FUNCTION puthelp  : INTEGER ;

VAR
   helpline     : helplinetype ;
HELP LIBRARIAN EXAMPLE                                          Page D-7


   lbrstatus    : INTEGER ;
   outputwidth  : INTEGER ;
   flags        : UNSIGNED ;
   filename     : filenametype ;
   index        : INTEGER ;

BEGIN
   outputwidth  := 80 ;
   helpline     := commandbuffer.body ;
   flags        := hlp$m_prompt ; { Defined by starlet }
   filename     :=
'dbms$help:dbms.hlb                                                    ' ;
   helpline     := nullhelpline ;
   FOR index := 1 to commandbuffer.length DO
      helpline[index] := commandbuffer.body[index] ;
{ remove help token }
   helpline[1]  := ' ' ;
   IF helpline[2] = 'E' THEN 
      BEGIN
         helpline[2] := ' ' ;
         IF helpline[3] = 'L' THEN
            BEGIN
               helpline[3] := ' ' ;
               IF helpline[4] = 'P' THEN
                  helpline[4] := ' ' ;
            END;
      END;
   lbrstatus    := lbr$output_help ( %IMMED lib$put_output  , outputwidth,
                                     helpline, filename , flags ,
                                     %IMMED lib$get_input   ) ;
   IF ((lbrstatus = lbr$_normal) OR (lbrstatus = SS$_NORMAL )) THEN
      puthelp := normal 
   ELSE IF lbrstatus =  lbr$_illinrou  THEN 
      errorexit ( 'Puthelp-Fatal-Illegal input routine', fatal )
   ELSE IF lbrstatus =  lbr$_illoutrou THEN 
      errorexit ( 'Puthelp-Fatal-Illegal output routine', fatal)
   ELSE IF lbrstatus =  lbr$_toomnyarg THEN 
      errorexit ( 'Puthelp-Fatal-Too many arguments', fatal )
   ELSE 
      BEGIN
         writeln   ( 'Lbr$output_help status is ', hex(lbrstatus)) ;
         lib$signal (lbrstatus ) ;
         errorexit ( 'Puthelp-Fatal-Unknown return status from lbr$output_help',
                     fatal )
      END ;
END;
END.












                               APPENDIX E

                             TPARSE EXAMPLE



[INHERIT ('defs.pen','sys$library:starlet.pen')]
MODULE parsecommanddef ;
{
 DATE OF LAST MOD: 10/23/83 Move the command block to a global area
                            so that action routines can access it.
 FUNCTIONAL DESCRIPTION:  
   This routine parses a command line and calls an action routine on 
   the expression recognized if such a call is indicated in the parse 
   tables.
 INPUTS:  commandbuffer : a non null string entered by the user
 OUTPUTS: an error message if a parse error detected
          returnststatus = normal - no errors
                         = syntaxerror - a syntax error was detected
                         = other - passed back from action routines
 IMPLICIT INPUTS: parsing table ( link with command.obj) defined by the
                  two globals keytable and statetable
                  tparseblock : the tparse data structure
                  token       : filled in by lib$tparse
 IMPLICIT OUTPUTS: none
 SIDE EFFECTS:  from action routines
 CALLING SEQUENCE:  returnstatus := parsecommand ( commandbuffer ) ;
}
FUNCTION parsecommand ( commandbuffer : commandbuffertype ) : INTEGER ;
CONST
   nulltoken = 
'                                                                      ';
VAR  
   retstatus     : INTEGER                ;
   statetable    : [EXTERNAL] INTEGER     ;
   keytable      : [EXTERNAL] INTEGER     ;
   workingstring : commandbuffertype      ;
   printstatus   : INTEGER                ;

FUNCTION  lib$tparse ( %REF tparseblock : tparseblocktype ;
                       %REF statetbl    : INTEGER         ;
                       %REF keytbl      : INTEGER         )  
                       : INTEGER ; EXTERN ;

BEGIN
   IF commandbuffer.length <> 0 THEN
TPARSE EXAMPLE                                                  Page E-2


   BEGIN
      token                   := nulltoken    ;
      workingstring           := commandbuffer;
      tparseblock.blocklength := tpa$k_count0 ;
      tparseblock.blanks      := FALSE        ;
      tparseblock.abbrfm      := FALSE        ;
      tparseblock.abbrev      := TRUE         ;
      tparseblock.mcount      := 0            ;
      tparseblock.stringcnt   := commandbuffer.length ;
      tparseblock.stringptr   := (ADDRESS(workingstring))   ;
      tparseblock.stringptr   := tparseblock.stringptr + 2 ;
      retstatus := lib$tparse ( tparseblock , statetable, keytable ) ;
      IF  retstatus =  ss$_normal         THEN 
         parsecommand := normal 
      ELSE IF retstatus  = lib$_syntaxerr THEN
         BEGIN
            token := tparseblock.tokenptr^ ;
            IF tparseblock.ambig        THEN
               write('Ambiguous keyword detected') 
            ELSE
               write('Syntax error detected') ;
            printstatus := printstr ( token, tparseblock.tokencnt );
            writeln ;
            IF printstatus <> normal THEN
               BEGIN
                  writeln ;
                  errorexit('Parsecommand-Fatal-Error printing token ', fatal) ;
               END ;
            parsecommand := normal {Error handled - dont signal }         
         END  
      ELSE IF retstatus  = lib$_invtype   THEN 
        errorexit('Parsecommand-Fatal-Invalid state table entry ', fatal)
      ELSE IF retstatus  = ss$_insfarg    THEN 
         errorexit('Parsecommand-Fatal-Insufficient arguments', fatal )
      ELSE IF retstatus  = exit THEN
         parsecommand := exit 
      ELSE
         errorexit('Parsecommand-Fatal-Unknown status ', fatal ) ;
   END 
   ELSE
      parsecommand := normal ;   
END;
END.












                               APPENDIX F

                              CLI EXAMPLE




PROGRAM cliexample ( OUTPUT ) ;

CONST
   CLI$_PRESENT   = %X'0003FD19' ;    { Defined by the $climsgdef macro }
   CLI$_DEFAULTED = %X'0003FD21' ;    { Not in starlet.pas.  Macro/list the }
   CLI$_ABSENT    = %X'000381F0' ;    { following program.           }
   CLI$_NEGATED   = %X'000381F8' ;    {         $climsgdef           }
   CLI$_CONCAT    = %X'0003FD29' ;    {         .end                 }
   SS$_NORMAL     = 1            ;

TYPE
    stringtype = PACKED ARRAY [1..8] OF CHAR ;

FUNCTION cli$present ( %STDESCR string : stringtype ) 
                    : INTEGER ; EXTERN ;

FUNCTION cli$get_value ( %STDESCR string : stringtype ;
                         %STDESCR string1 : stringtype )
                    : INTEGER ; EXTERN ;
VAR
   status : INTEGER ;
   retbuf : stringtype ;
BEGIN
   status := cli$present (%STDESCR('FILESPEC'));
   IF status = cli$_present THEN 
      writeln ('Qualifier present') 
   ELSE IF status =  cli$_defaulted THEN
      writeln('Qualifier defaulted') 
   ELSE IF status = cli$_absent THEN
      writeln('Qualifier absent')
   ELSE IF status = cli$_negated THEN
      writeln('Qualifier negated' ) 
   ELSE 
      writeln('Unknown return from cli$present, value is hex ', 
               hex(status));
   status := cli$get_value(%STDESCR('FILESPEC') ,retbuf ) ;
   writeln('Value is ', retbuf ) ;
   IF status = cli$_concat THEN
      writeln('Value concatenated') 
CLI EXAMPLE                                                     Page F-2


   ELSE IF status = ss$_normal THEN
      writeln('Successful completion')
   ELSE IF status = cli$_absent THEN
      writeln('No value given')
   ELSE 
      writeln('Unknown return from cli$get_value, value is hex ', 
               hex(status)) ;
      
END ;
END. 

     The constants were generated from the $CLIMSGDEF macro.   The  .cld
(command language definition ) file for the above image is:

DEFINE VERB       CLIDES       
       IMAGE     USR$DISK:[heffernan.decus]clides.EXE        
       PARAMETER  P1,LABEL=FILESPEC,PROMPT="File:        " ,
       VALUE  (REQUIRED ) 













                               APPENDIX G

                          SET MESSAGE EXAMPLE



[INHERIT ('SYS$LIBRARY:STARLET.PEN' , 'USR$DISK:[FLED]SGC.PEN' , 
          'USR$DISK:[FLED.ENVIRON]SGCDEFINE.PEN')]
MODULE errorhandler (output);

   {
   PROGRAM: STE Graphic Compiler Error Handler

   AUTHOR:  A. R. Donahue
            
   DATE OF LAST MOD: 01/25/84 A.R.D make actual call to lib$signal.
        Limits the number of FAO args that can be passed to 2.
                        
   FUNCTIONAL DESCRIPTION:  This routine calls LIB$SIGNAL with the 
   condition code passed and optionally one varying string argument.

   INPUTS: condition code of type integer 
           optional 1 to indicate one addtional FAO argument
           a varying string that is the addtional argument

   OUTPUTS:  none

   IMPLICIT INPUTS: The longword condition passed must be an output of the
                    VAX message utility.  This object module created 
                    by the VAX message utility must be linked with the 
                    image.

   IMPLICIT OUTPUTS: none

   COMPLETION CODES:  SGC_S_NORMAL

   SIDE EFFECTS: A message is written to sys$output. 
                 If the error is a fatal error image exit occurs.
                 On all other severity levels control returns.

   CALLING SEQUENCE: 

   Two example calls are illustrated, one passing a string and another 
   without a string being passed.  

   STAT := errorhandler ( ARD_E_BDSYNTAX , 1, VARYING_TYPE );
SET MESSAGE EXAMPLE                                             Page G-2


   STAT := errorhandler ( SGC_E_ERWORD );
   }


[EXTERNAL,ASYNCHRONOUS]FUNCTION LIB$SIGNAL 
              ( %IMMED CONDITION     : INTEGER ; 
                %IMMED FAO_Params    : [LIST,UNSAFE] INTEGER := %IMMED 0 ) 
                                                         : INTEGER ; EXTERN ;
[GLOBAL]FUNCTION errorhandler 
              ( CONDITION         : INTEGER ; 
                NumbFAOParams     : INTEGER := 0 ; 
                FAOParam1         : FAOParamType := ' ' ; 
                FAOParam2         : FAOParamType := ' ' ) : INTEGER ; 
VAR     funstatus : integer;

BEGIN
   { only allow zero to two parameters to be passed}
        IF NumbFAOParams = 0 THEN 
            begin
            funstatus := lib$signal ( condition );
            If funstatus <> ss$_facility then
                errorhandler := funstatus  { pass error status back }
            Else
                errorhandler := sgc_s_normal ;    { pass success status back }
            end
        ELSE IF NumbFAOParams = 1 THEN { 1 parameter has been passed }
            begin
            funstatus := lib$signal ( condition , %IMMED(1),
                                                        %STDESCR FAOParam1) ;
            If funstatus <> ss$_facility then
                errorhandler := funstatus { pass error status back }
            Else
                errorhandler := sgc_s_normal ;    { pass success status back }
            end  
        ELSE IF NumbFAOParams = 2 THEN { 2 parameters have been passed }
            begin
            funstatus := lib$signal ( condition, %IMMED(2), %STDESCR FAOParam1,
                                                           %STDESCR FAOParam2);
            If funstatus <> ss$_facility then
                errorhandler := funstatus { pass error status back }
            Else
                errorhandler := sgc_s_normal ;    { pass success status back }
            end  
        ELSE  { a bad arg has been passed }
            errorhandler := sgc_e_badarg; {pass error status to calling module}
        
END;
END.
