VS Pascal Example

The following VS Pascal program, called CSLPASC PASCAL, calls DMSERP, the CSL routine in VMLIB that accesses the extract/replace function. This particular call (1) extracts the access mode of the first read/only CMS disk and then (2) gets the access mode of the next CMS minidisk that is both read/only and is an extension of the S-disk.

CSLPASC PASCAL contains the following:

 PROGRAM CSLPASC(OUTPUT);
 
 (* This sample VS Pascal application program calls              *)
 (* Extract/Replace, via DMSCSL, to obtain the access mode of    *)
 (* the first read/only CMS disk and of the next CMS minidisk    *)
 (* that is both read/only and an extension of the S-disk.       *)
 
 TYPE
      fstring2  = packed array(.1..2.) of char;
      fstring4  = packed array(.1..4.) of char;
      fstring8  = packed array(.1..8.) of char;
      fstring20 = packed array(.1..20.) of char;
 
 (* PROCA calls Extract/Replace via DMSCSL with one search      *)
 (* argument (15 parameters).                                   *)
 
 PROCEDURE PROCA (const P0: fstring8;  var P1: integer;
                  const P2: fstring8;  const P3: integer;
                  const P4: fstring20; var P5: char;
                  var P6: integer;     var P7: integer;
                  const P8: fstring8;  const P9: fstring4;
                  var P10: integer;    const P11: fstring20;
                  const P12: char;     const P13: integer;
                  const P14: integer;  const P15: fstring2);
 
    PROCEDURE DMSCSL (const P0: fstring8;  var P1: integer;
                      const P2: fstring8;  const P3: integer;
                      const P4: fstring20; var P5: char;
                      var P6: integer;     var P7: integer;
                      const P8: fstring8;  const P9: fstring4;
                      var P10: integer;    const P11: fstring20;
                      const P12: char;     const P13: integer;
                      const P14: integer;  const P15: fstring2);
              FORTRAN;
    BEGIN;
      DMSCSL (P0, P1, P2, P3, P4, P5, P6, P7, P8,
              P9, P10, P11, P12, P13, P14, P15);
    END;
  (* PROCB calls Extract/Replace via DMSCSL with two search      *)
 (* arguments (20 parameters).                                  *)
 
 PROCEDURE PROCB (const P0: fstring8;   var P1: integer;
                  const P2: fstring8;   const P3: integer;
                  const P4: fstring20;  var P5: char;
                  var P6: integer;      var P7: integer;
                  const P8: fstring8;   const P9: fstring4;
                  var P10: integer;     const P11: fstring20;
                  const P12: char;      const P13: integer;
                  const P14: integer;   const P15: fstring2;
                  const P16: fstring20; const P17: char;
                  const P18: integer;   const P19: integer;
                  const P20: fstring2);
 
    PROCEDURE DMSCSL (const P0: fstring8;   var P1: integer;
                      const P2: fstring8;   const P3: integer;
                      const P4: fstring20;  var P5: char;
                      var P6: integer;      var P7: integer;
                      const P8: fstring8;   const P9: fstring4;
                      var P10: integer;     const P11: fstring20;
                      const P12: char;      const P13: integer;
                      const P14: integer;   const P15: fstring2;
                      const P16: fstring20; const P17: char;
                      const P18: integer;   const P19: integer;
                      const P20: fstring2);
              FORTRAN;
    BEGIN;
      DMSCSL (P0, P1, P2, P3, P4, P5, P6, P7,
              P8, P9, P10, P11, P12, P13, P14,
              P15, P16, P17, P18, P19, P20);
    END;
 
 VAR
     RTNNAME:   FSTRING8;  (* CSL routine being called          *)
     RETCODE:   INTEGER;   (* return code from Extract/Replace  *)
     FUNCT:     FSTRING8;  (* Extract/Replace function          *)
     NUMARGS:   INTEGER;   (* number of search arguments        *)
     INFONAME:  FSTRING20; (* information name                  *)
     BUFFER:    CHAR;      (* contains value that was extracted *)
     DATATYP:   INTEGER;   (* data type of data extracted       *)
     BUFLEN:    INTEGER;   (* buffer length/length of ext. data *)
     FLAGS:     FSTRING8;  (* flags                             *)
     SRCHTYP:   FSTRING4;  (* logical type of search            *)
     TOKEN:     INTEGER;   (* internal bookkeeper               *)
     SARGNAM1:  FSTRING20; (* first search argument name        *)
     SARGVAL1:  CHAR;      (* first search argument value       *)
     SARGNAM2:  FSTRING20; (* second search argument name       *)
     SARGVAL2:  CHAR;      (* second search argument value      *)
     SVALTYP1:  INTEGER;   (* search argument value data type   *)
     SVALTYP2:  INTEGER;   (* search argument value data type   *)
     SVALLEN1:  INTEGER;   (* search argument value data length *)
     SARGTYP:   FSTRING2;  (* comparison type                   *)
 
 BEGIN
 
     RTNNAME  := 'DMSERP  ';
     FUNCT    := 'EXTRACT ';
     NUMARGS  := 1;
     INFONAME := 'ACCESS_MODE';
     BUFFER   := ' ';
     BUFLEN   := 1;
     SRCHTYP  := 'AND';
     FLAGS    := '00000000';
     SARGNAM1 := 'CMS_READ_ONLY_DISK';
     SARGVAL1 := '1';
     SARGNAM2 := 'ACCESS_MODE_EXTEND';
     SARGVAL2 := 'S';
     SVALTYP1 := 9;
     SVALTYP2 := 32;
     SVALLEN1 := 1;
     SARGTYP  := 'EQ';
 
     PROCA (RTNNAME, RETCODE, FUNCT, NUMARGS,
           INFONAME, BUFFER, DATATYP, BUFLEN,
           FLAGS, SRCHTYP, TOKEN, SARGNAM1,
           SARGVAL1, SVALTYP1, SVALLEN1, SARGTYP);
 
 (* Display results from first call to Extract/Replace          *)
 
     WRITELN ('RETCODE = ', RETCODE);
     WRITELN ('BUFFER  = ', BUFFER);
     WRITELN ('DATATYP = ', DATATYP);
     WRITELN ('BUFLEN  = ', BUFLEN);
 
     NUMARGS := 2;
     FLAGS    := '11000000';
     PROCB (RTNNAME, RETCODE, FUNCT, NUMARGS,
           INFONAME, BUFFER, DATATYP, BUFLEN,
           FLAGS, SRCHTYP, TOKEN, SARGNAM1,
           SARGVAL1, SVALTYP1, SVALLEN1, SARGTYP,
           SARGNAM2, 'S', SVALTYP2, SVALLEN1, SARGTYP);
 
 (* Display results from second call to Extract/Replace         *)
 
     WRITELN;
     WRITELN ('RETCODE = ', RETCODE);
     WRITELN ('BUFFER  = ', BUFFER);
     WRITELN ('DATATYP = ', DATATYP);
     WRITELN ('BUFLEN  = ', BUFLEN);
 
 END.
After executing the above program, here is what would be displayed on your terminal (assuming that the B disk is the first minidisk accessed as read/only, and the Y disk is the first read/only minidisk accessed after the B-disk and as an extension of the S-disk):
   RETCODE  =          0
   BUFFER   = B
   DATATYP  =         32
   BUFLEN   =          1
 
   RETCODE  =          0
   BUFFER   = Y
   DATATYP  =         32
   BUFLEN   =          1
Keep the following notes in mind when coding a VS Pascal program with a call to a CSL routine:
  • Declare DMSCSL as a FORTRAN routine.
  • Parameters should be passed as variables by reference, rather than passing them as literals and constants.
  • If you call DMSCSL several times with parameter lists that are defined differently or have different numbers of parameters, declare internal procedures to call different formats of DMSCSL.
  • Hexadecimal values are displayed as character or integer, depending on how the variable is declared. To display the values as hexadecimal, use an integer parameter and call the function ITOHS with the integer.
  • You cannot use an undeclared variable in a call to DMSCSL.