.lt Using DEC VAX Software From Pascal John S. Heffernan RCA/Automated Systems Division .el .page .number page 1 .lm 10 .rm 72 .ap .sp 1 .title Using DEC VAX Software From Pascal .require "abstract.rno" .page .hl 1 Introduction .bl 2 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. .hl 1 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. 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. .hl 1 RMS .bl 2 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. 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. .hl 1 Edit/FDL .bl 2 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: .list "o" .le;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. .le;Use create/FDL to create the empty data file. .le;Define the file in Pascal as a file of your basic record type. The KEY attribute defines keys in the file. .els 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. .hl 1 Help Librarian .bl 2 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. .require "lbrfun.req" 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. .hl 1 Lib$tparse .bl 2 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. .require "tblock.req" 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. .hl 1 Set Command .bl 2 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 .list "o" .le;The CLI does the parsing for you. .le;The CLI does the error reporting for you. .le;The programmer can supply default values. .le;The programmer can force the user to supply values. .le;The command is defined in one file. .els The method for the HLL programmer is shown below. .list .le;Edit your command definition file. .le;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). .le;Inside the image, check the command entered with cli$get__value and cli$present. .els A sample Pascal program that uses the CLI interface routines in appendix F. .hl 1 Set Message .bl 2 The set message utility is also useful to the Pascal programmer in writing error handlers. The method used is as follows. .list "o" .le;Use your favorite editor to create and edit your message source file. .le;Compile the message source file with the set message command. .le;Write a "little program" that takes the message output file and outputs an environment file that defines all the message constants. .le;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. .els The error handler is shown in appendix G. .hl 1 Conclusion .bl 2 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 RMS Example Using User Open First, common definitions used in all three examples are shown. .sp 1 .lt { 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; {-------------------------------------------------------------} [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 } 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. .el .sp 1 .appendix RMS Example Using External Blocks From MACRO-32 For the same example, the MACRO32 module is shown below. .sp 1 .lt .TITLE RMSSTORAGE .PSECT DATA,WRT,NOEXE FAB:: $FAB XAB:: $XABPRO .END .el The corresponding Pascal routine is shown below. The common definitions used in the first example are omitted. .lt [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 } 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. .el .sp 1 .appendix RMS Example Without Using MACRO 32 .sp 1 .lt [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: ' ; 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. .el .sp 1 .appendix Help Librarian Example .sp 1 .lt 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' ; 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' ; .el .sp 1 Below is a module that initializes the help facility. .sp 1 .lt [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 ) 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. .el .sp 1 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. .sp 1 .lt [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 ; 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. .el Below is a module that initializes the help facility. .lt [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 ) 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. .el .sp 1 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. .sp 1 .lt [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 ; 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. .el .sp 1 .appendix TPARSE Example .lt [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 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. .el .sp 1 .appendix CLI Example .sp 1 .lt 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') 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. .el .sp 1 The constants were generated from the $CLIMSGDEF macro. The .cld (command language definition ) file for the above image is: .sp 1 .lt DEFINE VERB CLIDES IMAGE USR$DISK:[heffernan.decus]clides.EXE PARAMETER P1,LABEL=FILESPEC,PROMPT="File: " , VALUE (REQUIRED ) .el .sp 1 .appendix Set Message Example .sp 1 .lt [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 ); 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. .el