Oppolzer - Informatik / Stanford Pascal Compiler

Home       Lebenslauf       Schwerpunkte       Kenntnisse       Seminare       Kunden       Projekte       Produkte       Blog       Stanford Pascal       Kontakt

The Stanford Pascal Compiler / Evolution Steps

Back to Compiler main page

Call CMS commands from PASCAL programs

To enable the snapshot module PASSNAP to show variables from modules, too, it is necessary to open files using CMS FILEDEF commands which are issued at runtime (command built from Pascal variables).

I recall that at the Stuttgart University installation in 1984 and 1985 (a 4331 and a 3083 running VM/CMS), there was an external subroutine called CMSX, which could be called from Pascal VS (see documentation) and could call CMS commands.

So I analyzed some programs which I found on the PLI minidisk of the Hercules VM distribution and looked how a CMS command can be called. In fact, this turned out to be pretty simple; the CMS command has to be "tokenized" and then the SVC 202 (X'CA') has to be called.

I did the tokenization in Pascal, put the routine CMSX in the library module PASSTRX (where we have MEMSET and MEMCPY already) and called the ASSEMBLER function $PASSYS in PASMONN to do the SVC call. BTW: $PASSYS was called $PASSTOR before; it did the basic GETMAINs and FREEMAINs for the ALLOC and FREE function, but it was better to rename it to $PASSYS, because it does all kind of system related stuff, not only storage management.

This is the CMSX procedure in PASSTRX: 



   function $PASSYS ( FUNCCODE : INTEGER ; X : CHARPTR ) : CHARPTR ;

   (****************************************************)
   (*  ist in PASMONN.ASS implementiert und            *)
   (*  realisiert Basis-Storage-Dienste wie            *)
   (*  GETMAIN und FREEMAIN                            *)
   (****************************************************)


      EXTERNAL ;


   procedure CMSX ( CMD : CHARPTR ; var RETCODE : INTEGER ) ;

      const CMDEND = '#' ;

      var CMSCMD : CHAR128 ;
          CP : CHARPTR ;
          CPT : CHARPTR ;
          TOK : TOKEN ;
          I : INTEGER ;

      begin (* CMSX *)
        CP := CMD ;
        CPT := ADDR ( CMSCMD ) ;
        CMSCMD := ' ' ;
        repeat

        /*********************/
        /* blanks ueberlesen */
        /*********************/

          while ( CP -> = ' ' ) and ( CP -> <> CMDEND ) and
                ( CP -> <> CHR ( 0 ) ) do
            CP := PTRADD ( CP , 1 ) ;

        /**********************************/
        /* wenn nichts mehr da, dann raus */
        /**********************************/

          if ( CP -> = CMDEND ) or ( CP -> = CHR ( 0 ) ) then
            break ;

        /******************************************/
        /* wenn klammer auf, dann separates token */
        /******************************************/

          if CP -> = '(' then
            begin
              TOK := '(' ;
              CP := PTRADD ( CP , 1 ) ;
            end (* then *)

        /*************************************************/
        /* andernfalls token, bis trennzeichen erscheint */
        /*************************************************/

          else
            begin
              I := 0 ;
              TOK := ' ' ;
              while ( CP -> <> ' ' ) and ( CP -> <> '(' ) and
                    ( CP -> <> CMDEND ) and
                    ( CP -> <> CHR ( 0 ) ) do
                begin
                  if I < SIZEOF ( TOKEN ) then
                    begin
                      I := I + 1 ;
                      TOK [ I ] := CP -> ;
                    end (* then *) ;
                  CP := PTRADD ( CP , 1 ) ;
                end (* while *)
            end (* else *) ;

        /************************************************/
        /* token in cmscmd uebertragen, wenn noch platz */
        /************************************************/

          if PTRDIFF ( CPT , ADDR ( CMSCMD ) ) <
             SIZEOF ( CMSCMD ) - 8
          then
            begin
              MEMCPY ( CPT , ADDR ( TOK ) , SIZEOF ( TOKEN ) ) ;
              CPT := PTRADD ( CPT , SIZEOF ( TOKEN ) ) ;
            end (* then *)
        until FALSE ;

        /************************************************/
        /* Ende-Kennung dahinter                        */
        /************************************************/

        MEMSET ( CPT , CHR ( 255 ) , 8 ) ;

        /************************************************/
        /* CMS-Kommando aufrufen via $PASSYS / 11      */
        /************************************************/

        if FALSE then
          WRITELN ( 'test cmsx: <' , CMSCMD , '>' ) ;
        RETCODE := PTR2INT ( $PASSYS ( 11 , ADDR ( CMSCMD ) ) ) ;
        if FALSE then
          WRITELN ( 'test cmsx: retcode = ' , RETCODE ) ;
      end (* CMSX *) ;

and here are some CMSX sample calls (the commands must be terminated by '#' or CHR (0)): 



   CMSCMD := 'FILEDEF TESTFILE DISK TESTFILE INPUT '
             '(RECFM F LRECL 80 #' ;
   WRITELN ( CMSCMD ) ;
   CMSX ( ADDR ( CMSCMD ) , RC ) ;
   WRITELN ( '... liefert RC = ' , RC : 1 ) ;
   CMSCMD := 'STATE XXXX YYYY A#' ;
   WRITELN ( CMSCMD ) ;
   CMSX ( ADDR ( CMSCMD ) , RC ) ;
   WRITELN ( '... liefert RC = ' , RC : 1 ) ;
   CMSCMD := 'STATE TESTDBG LISTING A#' ;
   WRITELN ( CMSCMD ) ;
   CMSX ( ADDR ( CMSCMD ) , RC ) ;
   WRITELN ( '... liefert RC = ' , RC : 1 ) ;

Back to Compiler main page