!++ ! !************************************************************************* ! * ! © Copyright 2005 Hewlett-Packard Development Company, L.P. * ! * ! Confidential computer software. Valid license from HP required for * ! possession, use or copying. Consistent with FAR 12.211 and 12.212, * ! Commercial Computer Software, Computer Software Documentation, and * ! Technical Data for Commercial Items are licensed to the U.S. * ! Government under vendor's standard commercial license. * ! * !************************************************************************* ! !-- !++ ! Facility: ! LSE: Language Sensitive Editor ! ! Abstract: ! This module contains the TPU procedures that generate appropriate DEFINE ! TOKEN and DEFINE PLACEHOLDER commands from information provided by DEFINE ! ROUTINE and DEFINE PARAMETER commands. Most of the routines exported from ! this module have names of the form LSE$PKG_EXPAND_ROUT_language or ! LSE$PKG_EXPAND_PARM_language; the former is used to expand routines, while ! the latter is used to expand parameters. These routines are suitable for ! most typical packages, and are defined here for all of the languages that ! ship with LSE. In addition, there are a handful of routines of the form ! LSE$SYS_EXPAND_..., which are used to expand keyword style calls; Bliss and ! Pascal use such routines for their keyword system service calls. ! ! The LSE$$PACKLOOKUP module (PACKLOOKUP.B32) is responsible for invoking ! the TPU PROCEDURES in this module whenever a package item needs to be ! expanded. ! ! Author: ! Gary Feldman (based on previous work done by Joanna Chen) ! Joe Wild ! Glenn J. Joyce, Techincal Languages and Environments ! John G. Ward ! Diana Carroll, Techincal Languages and Environments ! ! Creation Date: 4-Nov-85 ! ! Modification History: ! X1.2 GAF 15-Oct-85 Added topic parameter to ss_call ! X1.2-1 GAF 17-Oct-85 Added return_value parameter to ss_call ! X2.0 GAF 15-Apr-86 Made consistent with current package specs. ! X2.0-1 GAF 4-Aug-86 Changed lse$$ada_gen_call so that it puts out ! an explicit semicolon to close the routine ! call ! X2.0-2 GAF 20-Aug-86 Change naming convention ! Now use TPU variables for all parameter passing ! from LSE ! X2.0-3 GHL 27-Aug-86 Change LANGUAGE to LSE$$PKG_ROUT_LANG in ! LSE$SS_ROUTINE. Drop parameters on call ! to LSE$GENERATE_PARAM and parameters on declaration ! of LSE$SS_PARAM. ! X2.0-4 GAF 28-Oct-86 Make sure template bodies are lower case, so that ! the user's expand case setting is used. ! X2.0-5 GAF 28-Oct-86 Rename various procedures to conform to standards: ! All procedures are now named LSE$fac_..., where ! fac represents a subfacility that is either ! PKG (for packages, in general), or SYS, (for ! system service routines) ! X2.0-6 GAF 29-Oct-86 Fixed LSE$PKG_DEFINE_TOKEN so that it puts quotes ! around the topic string ! X2.0-7 JPW 17-Dec-86 Changed lse$pkg_expand_rout_ada to capitalize ! routine and parameter names, and to truncate names ! by 1 letter if they conflict with an Ada keyword. ! Now looks for routine names that are prefixed by ! "STARLET." ! X2.0-8 GJJ 18-Dec-86 Fixed LSE$PKG_EXPAND_ROUT_ADA so the expanded ! routine names are STARLET.XXX instead of ! STARLET.STARLET.XXX. ! X2.0-9 JPW 10-Feb-87 Fixed LSE$PKG_EXPAND_PARAM_ADA to expand the ! parameter in uppercase. ! X2.0-10 JPW 5-Mar-87 Changed LSE$PKG_GEN_ROUTINE_BODY to put parameters ! below the routine name one tab in. ! X2.0-11 JPW 13-Mar-87 Made LSE$PKG_EXPAND_ROUT_PASCAL and ! LSE$PKG_EXPAND_PARM_PASCAL to call ! LSE$SYS_EXPAND_ROUT_PASCAL and ! LSE$SYS_EXPAND_PARM_PASCAL for the RTL packages. ! X2.0-12 JPW 20-Mar-87 Add "&" to continue Basic routines. Fix up padding ! to pad to 6 characters and always put a space before ! => or := for keyword parameters. Truncate routine ! and parameter names that conflict with Ada keywords. ! Add underscores to routine parameter names that ! conflict with Pascal keywords. ! X2.1 JPW 13-Jul-87 Fix LSE$PKG_EXPAND_ROUT_BLISS to not add empty ! parentheses to the end of routines with no ! parameters. ! X2.1-1 JPW 22-Jul-87 Remove .v, .r, and .d from keyword names for PASCAL ! and BLISS. Reformat PASCAL routines and add to ! the terminal parameter placeholder message. ! X2.2 JGW 01-Nov-87 Added the routines LSE$PKG_EXPAND_ROUT_MACRO and ! LSE$PKG_EXPAND_PARM_MACRO for VAX MACRO support. ! X2.2-1 JPW 02-Nov-87 Added closing quotes to all LSE$DO_COMMAND strings ! in routines: LSE$PKG_GEN_ROUTINE_BODY, ! LSE$PKG_EXPAND_ROUT_ADA, LSE$PKG_EXPAND_ROUT_COBOL, ! and LSE$SYS_EXPAND_ROUT_PASCAL. ! X2.2-2 JPW 11-Nov-87 Added routine LSE$PKG_DEFINE_MACRO_TOKEN to handle ! adding tokens for $name form of calls that we ! want to expand to a menu. ! X3.0 JPW 16-Dec-87 Merge in TPU clean layering changes. ! X3.0-1 JPW 6-Jan-88 Change the $name_G form of macro calls to be on one ! line. Changed back to put on two lines, but easy ! to change to one line. Changed BLISS routine ! expansion to expand $FAO as a nonkeyword call. ! (Merged in from LSEX2.2, X2.2-3) ! X2.2-3 JPW 6-Dec-88 Change the $name_G form of macro calls to be on one ! line. Changed back to put on two lines, but easy ! to change to one line. Changed BLISS routine ! expansion to expand $FAO as a nonkeyword call. ! X2.2-4 JPW 12-Feb-88 Change to use list placeholders for list parmaters. ! Added /TRAILING="," for keyword parameters. ! X3.0-2 JPW 3-Mar-88 Merged in above 2.2 fixes. ! X2.2-5 JPW 21-Mar-88 Fix the COBOL list parameters to allow required ! ones. ! X2.3 JPW 20-Apr-88 Merge in fix from V2.2 to the COBOL list paramters. ! X3.0-3 DEC 15-Sep-89 Change so that routines are expanded in mixed case ! if they were definded that way, in all languages ! except Ada and Macro. (Still converts all to ! lower case if defined in all upper.) ! X3.0-4 AVH 18-Apr-91 Add HH for many routines. ! X3.0-5 SBL 10-May-91 In EXPAND_ROUT_FORTRAN, insert a tab before the ! routine name and uppercase the name if defined ! in all lowercase. ! X3.0-6 DAS 16-May-91 Made STREAM_LF ! X3.2 SBL 30-Oct-91 Check in LSE$$PKG_IS_LIST_PARM to see if current ! routine has a list parameter ! X4.0 DEC 02-Dec-91 Change all placeholder/token generation routines ! to use new grammar. ! X4.0-1 DEC 10-Jan-92 Change lse_set_token_placeholder to ..._inherit, ! replace missing declarations ! X4.0-2 WC3 03-Mar-92 One call to lse_set_placeholder_menu_line didn't ! have all the parameters specified so it prompted ! X4.0-3 WC3 08-May-92 Added missing local declarations ! X4.2 RAM 29-Aug-94 Added hyperhelp fields to lse$pkg_define_token. ! X4.3-1 RAM 22-Dec-95 Remove hyperhelp fields to lse$pkg_define_token. ! X4.3-2 RAM 14-Mar-95 Comment out hyperhelp call. ! 4.5-1 CJH 03-Sep-96 DECset V12.2 Support for DEC Fortran 90. ! 4.5-1 CJH 28-Oct-96 Fix for LSE_XBUGS 2205 (missing CXX support) !-- !++ ! Module directory: ! ! LSE$$PKG_CONTAINS_LIST_PARM ! LSE$$PKG_IS_ROUT_LIST_PARM ! LSE$$PKG_IS_LIST_PARM ! LSE$PKG_DEFINE_TOKEN ! LSE$PKG_DEFINE_PARAMETER ! LSE$PKG_REMOVE_MECH ! LSE$PKG_GEN_ROUTINE_BODY ! LSE$PKG_GET_PARAM ! LSE$PKG_REORDER_PARAMS ! LSE$PKG_PAD_NAME ! LSE$PKG_DEFINE_MACRO_TOKEN ! LSE$PKG_EXPAND_ROUT_ADA ! LSE$PKG_EXPAND_PARM_ADA ! LSE$PKG_EXPAND_ROUT_ADA95 ! LSE$PKG_EXPAND_PARM_ADA95 ! LSE$PKG_EXPAND_ROUT_BASIC ! LSE$PKG_EXPAND_PARM_BASIC ! LSE$PKG_EXPAND_ROUT_BLISS ! LSE$SYS_EXPAND_ROUT_BLISS ! LSE$PKG_EXPAND_PARM_BLISS ! LSE$PKG_EXPAND_ROUT_C ! LSE$PKG_EXPAND_PARM_C ! LSE$PKG_EXPAND_ROUT_CXX ! LSE$PKG_EXPAND_PARM_CXX ! LSE$PKG_EXPAND_ROUT_COBOL ! LSE$PKG_EXPAND_PARM_COBOL ! LSE$PKG_EXPAND_ROUT_FORTRAN ! LSE$PKG_EXPAND_PARM_FORTRAN ! LSE$PKG_EXPAND_ROUT_F90 ! LSE$PKG_EXPAND_PARM_F90 ! LSE$PKG_EXPAND_ROUT_MACRO ! LSE$PKG_EXPAND_PARM_MACRO ! LSE$PKG_EXPAND_ROUT_PASCAL ! LSE$SYS_EXPAND_ROUT_PASCAL ! LSE$PKG_EXPAND_PARM_PASCAL ! LSE$PKG_EXPAND_ROUT_PLI ! LSE$PKG_EXPAND_PARM_PLI ! !-- PROCEDURE lse$$pkg_contains_list_parm(proc_name) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure returns TRUE (1) if the procedure contains a list ! parameter, FALSE (0) otherwise. ! ! FORMAL PARAMETERS: ! ! proc_name ! The name of the procedure without quotes ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! None !-- LOCAL local_name; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$pkg_contains_list_parm"); ENDON_ERROR; local_name := proc_name; CHANGE_CASE (local_name, UPPER); IF (local_name = "LIB$MATCH_COND") THEN RETURN (1); ELSE IF (local_name = "LIB$SYS_FAO") THEN RETURN (1); ELSE IF (local_name = "LIB$SIGNAL") THEN RETURN (1); ELSE IF (local_name = "LIB$STOP") THEN RETURN (1); ELSE IF (local_name = "STR$CONCAT") THEN RETURN (1); ELSE IF (local_name = "SYS$FAO") THEN RETURN (1); ELSE IF (local_name = "$FAO") THEN RETURN (1); ELSE RETURN (0); ENDIF; ENDIF; ENDIF; ENDIF; ENDIF; ENDIF; ENDIF; ENDPROCEDURE; PROCEDURE lse$$pkg_is_rout_list_parm(proc_name) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure returns TRUE (1) if the procedure contains a list ! parameter, FALSE (0) otherwise ! ! FORMAL PARAMETERS: ! ! proc_name ! The name of the procedure with quotes. ! ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! None !-- ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$pkg_is_rout_list_parm"); ENDON_ERROR; IF (lse$$pkg_contains_list_parm(proc_name) = 1) AND (LSE$PKG_ROUT_PARM = '') THEN RETURN (1); ELSE RETURN (0); ENDIF; ENDPROCEDURE; PROCEDURE lse$$pkg_is_list_parm(parm_name) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure returns TRUE (1) if the parameter is a list ! parameter, FALSE (0) otherwise. ! ! FORMAL PARAMETERS: ! ! parm_name ! The name of the parameter without quotes and with passing mechanism. ! ! IMPLICIT INPUTS: ! ! LSE$PKG_ROUT_NAME ! The name of the current routine being expanded ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! None !-- LOCAL proc_name, local_name, mech; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$pkg_is_list_parm"); ENDON_ERROR; local_name := parm_name; ! Remove quotes from procedure name and see if this routine has ! list parameters ! proc_name := lse$$remove_quotes(LSE$PKG_ROUT_NAME); IF (lse$$pkg_contains_list_parm(proc_name) = 0) THEN RETURN (0); ENDIF; CHANGE_CASE (local_name, UPPER); ! test with mechanism to make unique for SYS$FAO IF (local_name = "P1.V") THEN RETURN (1); ENDIF; ! Remove passing mechanism .x suffix (x = v, d, or r). local_name := lse$pkg_remove_mech (local_name, mech); IF (local_name = "COMPARE_CONDITION_VALUE") THEN RETURN (1); ELSE IF (local_name = "DIRECTIVE_ARGUMENT") THEN RETURN (1); ELSE IF (local_name = "SOURCE_STRING") THEN RETURN (1); ELSE IF (local_name = "FAO_ARGUMENT") THEN RETURN (1); ELSE RETURN (0); ENDIF; ENDIF; ENDIF; ENDIF; ENDPROCEDURE; PROCEDURE lse$pkg_define_token !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates lse DEFINE TOKEN commands for routines. ! «TBS» ! ! DESCRIPTION: ! This routine generates lse DEFINE TOKEN commands for routines. ! It issues only the DEFINE TOKEN token-name, with qualifiers, and ! leaves the editor in a state ready to process the definition of ! the body of the token. This procedure is suitable for being ! called from any procedure that needs to define a token from a ! routine definition; the calling procedure is responsible for ! defining the body of the routine and issuing the closing END ! DEFINE command. ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end ! !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! LSE$PKG_ROUT_NAME ! The name of the routine to be defined. ! ! LSE$PKG_ROUT_LANG ! The name of the language for which to define the routine ! ! LSE$PKG_ROUT_DESC ! The description string for the routine ! ! LSE$PKG_ROUT_TOP ! The topic string for the routine ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A token is defined. ! ! MODIFICATION HISTORY: !-- LOCAL proc_name; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_define_token"); ENDON_ERROR; ! Remove quotes proc_name := lse$$remove_quotes(LSE$PKG_ROUT_NAME); ! Generate the token lse_new_token (proc_name, 'terminal', LSE$PKG_ROUT_LANG); ! Set description if LSE$PKG_ROUT_DESC <> '' then lse_set_token_description (LSE$PKG_ROUT_DESC, proc_name, LSE$PKG_ROUT_LANG); endif; ! Set the help topic if LSE$PKG_ROUT_TOP <> '' then lse_set_token_help_topic (LSE$PKG_ROUT_TOP, proc_name, LSE$PKG_ROUT_LANG); endif; ! Set the book if LSE$PKG_ROUT_BOOK <> '' then !-Hyperhelp ! lse_set_token_book (LSE$PKG_ROUT_BOOK, proc_name, ! LSE$PKG_ROUT_LANG); !-Hyperhelp endif; ! Set the book if LSE$PKG_ROUT_BOOKREFERENCE <> '' then !-Hyperhelp ! lse_set_token_reference (LSE$PKG_ROUT_BOOKREFERENCE, proc_name, ! LSE$PKG_ROUT_LANG); !-Hyperhelp endif; ENDPROCEDURE; PROCEDURE lse$pkg_define_parameter() !doc_begin ! ! ONE LINE DEFINITION: ! This procedure issues a standard DEFINE PARAMETER command for the ! parameter currently being expanded. ! «TBS» ! ! DESCRIPTION: ! This procedure generates a placeholder for the ! parameter currently being expanded. This routine is suitable for being ! called from any procedure that needs to define a placeholder from a ! parameter. And qualifiers on the placeholder should be set ! after creation by the calling routine. ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! (none) ! ! IMPLICIT INPUTS: ! ! LSE$PKG_PARA_NAME ! the name of the placeholder to define ! ! LSE$PKG_PARA_LANG ! the language for which to define the placeholder ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A new placeholder is defined. !-- LOCAL plac_name, mech; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_define_parameter"); ENDON_ERROR; ! Force to lower case plac_name := lse$$remove_quotes(LSE$PKG_PARA_NAME); CHANGE_CASE (plac_name, LOWER); lse_new_placeholder(plac_name, 'terminal', LSE$PKG_PARA_LANG); plac_name := lse$pkg_remove_mech (plac_name, mech); lse_set_placeholder_terminal_line( "The actual data you want to pass to parameter " + plac_name); ! Do a body line for the passing mechanism. IF mech = 'V' THEN lse_set_placeholder_terminal_line( "The parameter is passed by value."); ELSE IF mech = 'R' THEN lse_set_placeholder_terminal_line( "The parameter is passed by reference."); ELSE IF mech = 'D' THEN lse_set_placeholder_terminal_line( "The parameter is passed by descriptor."); ENDIF; ENDIF; ENDIF; lse_set_placeholder_terminal_line(""); lse_set_placeholder_terminal_line( "If online help for this routine is available on your system, it may"); lse_set_placeholder_terminal_line( "be accessed by positioning the cursor on the name of the routine and"); lse_set_placeholder_terminal_line( "pressing HELP IND (default key binding PF1-PF2)."); ENDPROCEDURE PROCEDURE lse$pkg_remove_mech(param_name, mech_char) !doc_begin ! ! ONE LINE DEFINITION: ! This procedure removes a suffix from a parameter name of the form ! name.suffix or name_suffix. ! «TBS» ! ! DESCRIPTION: ! This procedure removes a suffix from a parameter name of the form ! name.suffix or name_suffix. The suffix must be either v, d, or r and ! indicates that the parameter is passed by value, descriptor, or ! reference, respectively. ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! param_name ! the name of the parameter ! ! mech_char ! set to the suffix character removed from param_name (uppercase) ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! None !-- LOCAL param_length, mech_suffix, mech_separator; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_remove_mech"); ENDON_ERROR; mech_char := ''; param_length := LENGTH (param_name) ; IF param_length < 2 THEN RETURN (param_name) ENDIF; ! Get last character from param_name. mech_suffix := SUBSTR(param_name, param_length, 1); ! Get second to last character from param_name. mech_separator := SUBSTR(param_name, param_length - 1, 1); CHANGE_CASE (mech_suffix, UPPER); IF ((mech_suffix = 'V') OR (mech_suffix = 'D') OR (mech_suffix = 'R')) AND ((mech_separator = '_') OR (mech_separator = '.')) THEN mech_char := mech_suffix; RETURN ( SUBSTR (param_name, 1, param_length - 2) ) ; ENDIF; RETURN (param_name); ENDPROCEDURE PROCEDURE lse$pkg_gen_routine_body(lreq, rreq, lopt, ropt, open_call, close_call, separator, empty_parms, intermediate, continuation, single_line, list_plch) !doc_begin ! ! ONE LINE DEFINITION: ! This procedure generates a standard routine body, and is suitable for ! being called for generating bodies for most languages. ! «TBS» ! ! DESCRIPTION: ! This procedure generates a standard routine body, and is suitable for being ! called for generating bodies for most languages. This must be called after ! a suitable NEW TOKEN has been executed (such as by lse$pkg_define_token). ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! lreq ! Usually the left delimiters of required placeholders in the language. ! However, if intermediate is non-empty, then this should be empty. ! ! rreq ! The right delimiters of required placeholders in the language. ! ! lopt ! Usually the left delimiters of optional placeholder in the language. ! In some cases (e. g. C) this needs to be the left delimiter string for ! an optional parameter; in the case of C, this means a doubled ! left required placeholder strings. ! ! ropt ! Usually the right delimiters of optional placeholder in the language. ! In some cases (e. g. C) this needs to be the right delimiter string ! for an optional parameter; in the case of C, this means the string ! '@} | 0@}', since requires some value in every parameter position and ! hence can't use optional placeholders here. Furthermore, in the ! case where intermediate is non-empty, this should be a string ! consisting of the right required placeholder delimiter followed by ! the right optional placeholder delimiter. ! ! open_call ! The string used to open a procedure call in the language. This is ! almost always a '('. ! ! close_call ! The string used to close a procedure call in the language. This is ! almost always a ')'. ! ! separator ! The string used to separate parameters from each other. This is ! almost always a ','. ! ! empty_parameters ! The string that constitutes the entire parameter list for the case ! of a procedure call with no parameters. This is almost always ! either empty (i. e. '') or '()'. ! ! intermediate ! This is used for generating keyword style routine calls, and is ! the string that will be put in between the keyword and its parameter. ! Typically this consists of some sort of assignment operator followed ! by the left required placeholder delimiter of the langauge. For ! example, for keyword routines in Bliss this will be '= {~'. ! ! When we generate each parameter for a keyword style call, we put ! out the following: ! the parameter name padded to at least 6 characters, ! followed by the intermediate string, followed by the parameter ! name, followed by the appropriate right placeholder delimiter. ! ! Continuation ! This is used for languages that need a continuation character to signal ! that a routine continues on the next line. e.g., Basic uses the'&' ! character for this. ! ! single_line ! If set to TRUE, put 1st parameter on same line as routine. Otherwise, ! put the paramter on the following line. ! ! list_plch ! If set to TRUE, make list parameters list placeholders. Otherwise, ! define as regular placeholder. ! ! IMPLICIT INPUTS: ! ! LSE$PKG_ROUT_NAME ! The name of the routine to be defined. ! ! LSE$PKG_ROUT_PARM ! The list of parameters of the routine, separated by spaces ! ! LSE$PKG_ROUT_OPT ! A list of flags, in one to one correspondence with the list of ! parameters. Each flag can be either O, indicating optional, or ! R, indicating required. Each flag is separated from the next by a ! space. ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! The body of the token definition corresponding to the routine is defined. !-- LOCAL proc_name, body_line, cur_option, cur_param, param_name, keyword_param, case_test_name, mech; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_gen_routine_body"); ENDON_ERROR; ! Remove quotes from procedure name proc_name := lse$$remove_quotes(LSE$PKG_ROUT_NAME); case_test_name := proc_name; change_case(case_test_name,UPPER); if (case_test_name = proc_name) then change_case(proc_name,lower); endif; if LSE$PKG_ROUT_PARM = '' then lse_set_token_body_line(proc_name + empty_parms, '', '', '', ''); else ! ** process parameters ** body_line := proc_name + open_call; IF single_line = 1 THEN body_line := body_line + ' '; ! put on same line ELSE lse_set_token_body_line(body_line + continuation, '', '', '', ''); body_line := ASCII(9); ENDIF; IF intermediate <> "" THEN ! We have a keyword style call, in which case we must move a ! required parameter to the beginning of the list. lse$pkg_reorder_params (LSE$PKG_ROUT_PARM, LSE$PKG_ROUT_OPT) ENDIF; ! Loop through each parameter loop exitif lse$pkg_get_param (cur_param, cur_option, LSE$PKG_ROUT_PARM, LSE$PKG_ROUT_OPT) = 0; IF intermediate = "" THEN if cur_option = "O" then ! optional parameter body_line := body_line + lopt + cur_param + ropt; else ! required parameter body_line := body_line + lreq + cur_param + rreq; endif; ELSE keyword_param := lse$pkg_remove_mech(cur_param, mech); lse$pkg_pad_name (keyword_param, param_name); IF cur_option = "O" THEN ! optional parameter body_line := body_line + lopt + param_name + ' ' + intermediate + cur_param + ropt ELSE ! required parameter body_line := body_line + lreq + param_name + ' ' + intermediate + cur_param + rreq ENDIF; ENDIF; ! use list placeholders for list parameters. IF (list_plch = 1) THEN IF (lse$$pkg_is_list_parm(cur_param) = 1) THEN body_line := body_line + '...'; ENDIF; ENDIF; ! if last line, close off the call if LSE$PKG_ROUT_PARM = '' then body_line := body_line + close_call; else ! ** add a line separator to the parameter line body_line := body_line + separator; endif ; change_case (body_line,lower); lse_set_token_body_line(body_line, '', '', '', ''); body_line := ASCII(9); endloop; endif; ! parameter string is/isnot empty ENDPROCEDURE PROCEDURE lse$pkg_get_param (param, option, param_line, option_line) !doc_begin ! ! ONE LINE DEFINITION: ! Returns the first parameter and option from the given parameter ! lists and option line, removing them from the lists ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! param ! On exit, this will be the first parameter from the param line. ! ! option ! On exit, this will be the first option field from the option line. ! ! param_line ! A list of parameters for a routine, as in LSE$PKG_ROUT_PARM. On exit, ! the first parameter from the list will have been removed. ! ! option_line ! A list of option flags for a routine's parameter list, as in ! LSE$PKG_ROUT_OPT. On exit, the first option from the list will have ! been removed. ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! param_line and option_line are changed as indicated above !-- LOCAL blank_idx ; ! ** location of blanks in parameter lines ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_get_param "); ENDON_ERROR; ! Locate a parameter in param_line. blank_idx := INDEX (param_line, ASCII(13)+ASCII(10) ); ! Return if no more parameters. IF blank_idx <= 1 THEN param_line := '' ; RETURN (0) ; ENDIF ; ! Get parameter, stripping off the outside set of quotes. param := SUBSTR (param_line, 2, blank_idx - 3) ; ! Remove parameter from param_line. param_line := SUBSTR (param_line, blank_idx + 2, LENGTH(param_line) ) ; ! Get option and remove from option_line. option := SUBSTR (option_line, 1, 1) ; option_line := SUBSTR (option_line, 3, LENGTH(option_line) ) ; RETURN (1) ; ENDPROCEDURE PROCEDURE lse$pkg_reorder_params (param_line, option_line) !doc_begin ! ! ONE LINE DEFINITION: ! This routine finds the first required parameter in the given parameter ! line, and moves it to the beginning of the line; it also moves the ! corresponding option to the beginning of the given option line. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! param_line ! A list of parameters, as for LSE$PKG_ROUT_PARM. On exit, we ! insure that the first parameter in the list will be a required ! parameter. ! ! option_line ! The list of option flags corresponding to the parameters. On exit, ! the option flag corresponding to the parameter that was moved is ! also moved. ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! param_line and option_line are rearranged as indicated above. !-- local req_idx, ! ** index into option_line of first required param new_param_line, ! ** new line with required param in front new_option_line,! ** new option line with required param in front param, ! ** parameter returned by lse$pkg_get_param option, ! ** option returned by get_option req_pos, ! ** the required param is the req_posth parameter i ; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_reorder_params "); ENDON_ERROR; req_idx := index (option_line, "R") ; if (req_idx = 1) or (req_idx = 0) then return (0) endif; req_pos := (req_idx-1) / 2 ; ! ** append optionals to new line i := 0 ; new_param_line := '' ; new_option_line := '' ; loop exitif (i = req_pos) ; lse$pkg_get_param (param, option, param_line, option_line) ; new_param_line := new_param_line + '"' + param + '"' + " " + ascii(10); new_option_line := new_option_line + option + "0" ; i := i + 1 ; endloop ; ! ** insert required into line and append rest of line lse$pkg_get_param (param, option, param_line, option_line) ; param_line := '"' + param + '"' + " " + ascii(10) + new_param_line + param_line ; option_line := option + " " + new_option_line + option_line + ' ' ; ENDPROCEDURE PROCEDURE lse$pkg_pad_name (cur_param, p_keyword) !doc_begin ! ! ONE LINE DEFINITION: ! Pads a parameter name so that it is at least 6 characters long. ! «TBS» ! ! DESCRIPTION: ! Pads a parameter name so that it is at least 6 characters long. This ! is for use by keyword style routine calls, so that the intermediate ! assignment operations, which separates the keyword from the parameter value, ! line up properly. ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FUNCTIONAL DESCRIPTION: ! ! ! FORMAL PARAMETERS: ! ! cur_param ! The parameter name to be padded ! ! p_keyword ! The result of padding the parameter name. ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! p_keyword is set as indicated above !-- LOCAL len, !* the length of cur_param i ; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_pad_name "); ENDON_ERROR; p_keyword := cur_param; ! Pad the p_keyword so it's 6 letters long. ! This tends to make the keyword calls to system services look ! better. len := LENGTH (p_keyword) ; IF len < 6 THEN i := 0 ; LOOP EXITIF i = 6 - len ; p_keyword := p_keyword + " " ; i := i + 1 ; ENDLOOP ; ENDIF ; ENDPROCEDURE PROCEDURE lse$pkg_define_macro_token !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates lse DEFINE TOKEN commands for Macro routines. ! «TBS» ! ! DESCRIPTION: ! This routine generates lse DEFINE TOKEN commands for Macro routines. It ! defines a special sequence of a token and two placeholders. This routine ! is then used to define the argument list form routines which is in the ! form $name. The other types of routine calls in are in form $name_G and ! $name_S. This routine will allow the $name form expansion to expand to a ! menu to force displaying the menu, instead of substituting the template for ! the $name if it were declared a simple token. ! ! This routine defines $name token as a placeholder with the routine ! description. It then defines a menu placeholder for the placeholder just ! defined for the token. The menu will consist of $name, $name_G, and ! $name_S. And finally, the $name template is defined as placeholder to be ! selected from the menu. ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! LSE$PKG_ROUT_NAME ! The name of the routine to be defined. ! ! LSE$PKG_ROUT_LANG ! The name of the language for which to define the routine ! ! LSE$PKG_ROUT_DESC ! The description string for the routine ! ! LSE$PKG_ROUT_TOP ! The topic string for the routine ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! MODIFICATION HISTORY: !-- LOCAL proc_name; ! name of routine, with trailing underscore removed ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_define_macro_token"); ENDON_ERROR; !+ ! Remove the quotes from the procedure name !- proc_name := lse$$remove_quotes(LSE$PKG_ROUT_NAME); ! Generate TOKEN lse_new_token(proc_name, 'alias', LSE$PKG_ROUT_LANG); lse_set_token_inherit(proc_name + '_MENU', proc_name); ! Generate the menu placeholder for the token lse_new_placeholder(proc_name + '_MENU', 'menu', LSE$PKG_ROUT_LANG); lse_set_placeholder_description(LSE$PKG_ROUT_DESC, proc_name + '_MENU', LSE$PKG_ROUT_LANG); lse_set_placeholder_help_topic(LSE$PKG_ROUT_TOP, proc_name + '_MENU', LSE$PKG_ROUT_LANG); lse_set_placeholder_menu_line(proc_name, '', 'placeholder', '', 'add'); lse_set_placeholder_menu_line(proc_name + '_S', '', 'token', '', 'add'); lse_set_placeholder_menu_line(proc_name + '_G', '', 'token', '', 'add'); lse_new_placeholder(proc_name, 'nonterminal', LSE$PKG_ROUT_LANG); lse_set_placeholder_description(LSE$PKG_ROUT_DESC); lse_set_placeholder_help_topic(LSE$PKG_ROUT_TOP); ENDPROCEDURE; PROCEDURE lse$pkg_expand_rout_ada !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates an Ada token definition from a routine definition. ! «TBS» ! ! DESCRIPTION: ! This routine generates an Ada token definition from a routine definition. ! Note that by default, we use keyword style calls in Ada. Hence this ! routine is suitable for all Ada packages, including starlet. ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! LSE$PKG_ROUT_NAME ! The name of the routine to be defined. ! ! LSE$PKG_ROUT_PARM ! The list of parameters of the routine, separated by spaces ! ! LSE$PKG_ROUT_OPT ! A list of flags, in one to one correspondence with the list of ! parameters. Each flag can be either O, indicating optional, or ! R, indicating required. Each flag is separated from the next by a ! space. ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! An LSE Token definition is issued. ! !-- LOCAL body_line, current_option, current_param, param_name, proc_name, padded_key; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_rout_ada"); ENDON_ERROR; lse$pkg_define_token; ! Remove quotes from procedure name and upper case name proc_name := lse$$remove_quotes(LSE$PKG_ROUT_NAME); change_case (proc_name, upper); ! if the routine name conflicts with a Ada keyword, remove the last letter IF proc_name = "STARLET.EXIT" THEN proc_name := substr(proc_name, 1, length(proc_name) - 1) ENDIF; ! ** form first line of body ** body_line := proc_name + ' ('; change_case (body_line, upper); ! Force routine name to be upper case IF LSE$PKG_ROUT_PARM = "" THEN body_line := body_line + ');'; lse_set_token_body_line(body_line, '', '', '', ''); return ENDIF; lse_set_token_body_line(body_line, '', '', '', ''); ! ** process parameters ** lse$pkg_reorder_params (LSE$PKG_ROUT_PARM, LSE$PKG_ROUT_OPT) ; loop exitif lse$pkg_get_param (current_param, current_option, LSE$PKG_ROUT_PARM, LSE$PKG_ROUT_OPT) = 0 ; ! if the parameter name conflicts with the Ada keywords, remove ! the last letter. IF (current_param = "ENTRY") OR (current_param = "TYPE") THEN param_name := substr(current_param, 1, length(current_param)-1); ELSE param_name := current_param ENDIF; ! ** isolate a param and option and delete them from param_line ! ** padding with blanks so it fills 6 characters, the maximum ! ** length of system services param names for formatting lse$pkg_pad_name (param_name, padded_key) ; ! Force paramter names to be upper and the placeholders to be lower change_case(padded_key, upper); change_case(current_param, lower); ! ** form a command line for the current parameter body_line := ASCII(9); if current_option = "O" then ! ** optional parameter body_line := body_line + '[' + padded_key + " => {" + current_param + '}]' else ! ** required parameter body_line := body_line + padded_key + " => {" + current_param + "}" endif ; IF LSE$PKG_ROUT_PARM = "" THEN body_line := body_line + ');'; else body_line := body_line + ","; endif; lse_set_token_body_line(body_line, '', '', '', ''); endloop ; ENDPROCEDURE PROCEDURE lse$pkg_expand_parm_ada !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates an Ada placeholder definition from a given parameter. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! LSE$PKG_PARA_NAME ! The name of the parameter. ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A placeholder definition is issued. !-- LOCAL body_line, name_noquote, padded_key, keyword_name; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_parm_ada"); ENDON_ERROR; lse$pkg_define_parameter; lse_set_placeholder_separator(","); name_noquote := lse$$remove_quotes( LSE$PKG_PARA_NAME ); ! if the parameter name conflicts with the Ada keywords, remove ! the last letter. IF (name_noquote = "ENTRY") OR (name_noquote = "TYPE") THEN keyword_name := substr(name_noquote, 1, length(name_noquote)-1); ELSE keyword_name := name_noquote; ENDIF; lse$pkg_pad_name (keyword_name, padded_key) ; ! Force paramter names to be upper and the placeholders to be lower change_case(padded_key, upper); change_case(name_noquote, lower); ! ** form the name of the template lse_new_placeholder(padded_key + ' => {' + name_noquote + '}', 'nonterminal', 'ada'); lse_set_placeholder_separator(","); lse_set_placeholder_trailing(","); ! ** form the body of the template body_line := padded_key + ' => {' + name_noquote + '}'; lse_set_placeholder_body_line(body_line, '', '', '', ''); ENDPROCEDURE PROCEDURE lse$pkg_expand_rout_ada95 lse$pkg_expand_rout_ada(); ENDPROCEDURE PROCEDURE lse$pkg_expand_parm_ada95 !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates an Ada placeholder definition from a given parameter. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! LSE$PKG_PARA_NAME ! The name of the parameter. ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A placeholder definition is issued. !-- LOCAL body_line, name_noquote, padded_key, keyword_name; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_parm_ada95"); ENDON_ERROR; lse$pkg_define_parameter; lse_set_placeholder_separator(","); name_noquote := lse$$remove_quotes( LSE$PKG_PARA_NAME ); ! if the parameter name conflicts with the Ada keywords, remove ! the last letter. IF (name_noquote = "ENTRY") OR (name_noquote = "TYPE") THEN keyword_name := substr(name_noquote, 1, length(name_noquote)-1); ELSE keyword_name := name_noquote; ENDIF; lse$pkg_pad_name (keyword_name, padded_key) ; ! Force paramter names to be upper and the placeholders to be lower change_case(padded_key, upper); change_case(name_noquote, lower); ! ** form the name of the template lse_new_placeholder(padded_key + ' => {' + name_noquote + '}', 'nonterminal', 'ada95'); lse_set_placeholder_separator(","); lse_set_placeholder_trailing(","); ! ** form the body of the template body_line := padded_key + ' => {' + name_noquote + '}'; lse_set_placeholder_body_line(body_line, '', '', '', ''); ENDPROCEDURE PROCEDURE lse$pkg_expand_rout_basic !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates a token definition for BASIC from a routine ! definition. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A token definition is issued. !-- ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_rout_basic"); ENDON_ERROR; lse$pkg_define_token; lse$pkg_gen_routine_body ('{', '}', '[', ']', ' (', ')', ', &', '', '', ' &', 0, 1); ENDPROCEDURE PROCEDURE lse$pkg_expand_parm_basic !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates a BASIC placeholder definition from a parameter ! definition. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A placeholder definition is issued. !-- ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_parm_basic"); ENDON_ERROR; lse$pkg_define_parameter; ! Change the separator for list parameters so list parameters work IF (lse$$pkg_is_list_parm(lse$$remove_quotes(LSE$PKG_PARA_NAME)) = 1) THEN lse_set_placeholder_separator(", &"); ELSE lse_set_placeholder_separator(" &"); ENDIF; ENDPROCEDURE PROCEDURE lse$pkg_expand_rout_bliss !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates a Bliss token definition from a parameter ! definition. The style of the routine call is positional. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A token definition is issued. !-- ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_rout_bliss"); ENDON_ERROR; lse$pkg_define_token; lse$pkg_gen_routine_body ('{~', '~}', '[~', '~]', ' (', ')', ', ', '() ', '','', 0, 1); ENDPROCEDURE; PROCEDURE lse$sys_expand_rout_bliss !doc_begin ! ! ONE LINE DEFINITION: ! Generates the DEFINE TOKEN command from ROUTINE information for BLISS ! System Services, using keyword macro syntax. ! $FAO is a special case that is expanded in the nonkeyword form. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end ! ! lse$$bliss_ss_call ! !++ ! FUNCTIONAL DESCRIPTION: ! ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A token definition is issued. !-- LOCAL proc_name; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$sys_expand_rout_bliss"); ENDON_ERROR; lse$pkg_define_token; ! Remove quotes from procedure name and upper case name proc_name := lse$$remove_quotes(LSE$PKG_ROUT_NAME); change_case (proc_name, upper); ! Don't expand in the keyword form if contains a list parameter. IF (lse$$pkg_contains_list_parm(proc_name) = 1) THEN ! expand in nonkeyword form. lse$pkg_gen_routine_body ('{~', '~}', '[~', '~]', ' (', ')', ', ', '() ', '','', 0, 1); ELSE ! expand in keyword form. lse$pkg_gen_routine_body ( '', '~}', '[~', '~}~]', ' (', ')', ',', '', '= {~', '', 0, 0); ENDIF; ENDPROCEDURE; PROCEDURE lse$pkg_expand_parm_bliss !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates appropriate Bliss placeholder definitions ! from a parameter definition, using keyword macro syntax. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! LSE$PKG_PARA_NAME ! the name of the placeholder to define ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! Two placeholder definitions are issued. !-- LOCAL name_noquote, padded_key, keyword_name, mech; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_parm_bliss"); ENDON_ERROR; lse$pkg_define_parameter; ! Strip the quotes off the name name_noquote := lse$$remove_quotes(LSE$PKG_PARA_NAME); ! Change the separator for list parameters so list parameters work IF (lse$$pkg_is_list_parm(name_noquote) = 1) THEN lse_set_placeholder_separator(","); ENDIF; ! Define a placeholder in the form "name = {~name~}" ! Remove passing mechanism .r,.d, or .v suffix keyword_name := lse$pkg_remove_mech (name_noquote, mech); lse$pkg_pad_name (keyword_name, padded_key); ! form the name of the template CHANGE_CASE (name_noquote, LOWER); lse_new_placeholder(padded_key + ' = {~' + name_noquote + '~}', 'nonterminal', 'bliss'); lse_set_placeholder_separator(","); lse_set_placeholder_trailing(","); lse_set_placeholder_body_line(padded_key + ' = {~' + name_noquote + '~}', '','', '', ''); ENDPROCEDURE; PROCEDURE lse$pkg_expand_rout_c !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates a C token definition from a routine definition. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A token definition is issued. !-- ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_rout_c"); ENDON_ERROR; lse$pkg_define_token; lse$pkg_gen_routine_body ( '{@', '@}', '{@{@', '@} | 0@}', ' (', ')', ', ', '() ', '', '', 0, 1); ENDPROCEDURE; PROCEDURE lse$pkg_expand_parm_c !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates C placeholder definitions from parameter definitions. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! LSE$PKG_PARA_NAME ! the name of the placeholder to define ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! Two parameter definitions are issued. !-- LOCAL body_line, plac_name; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_parm_c"); ENDON_ERROR; lse$pkg_define_parameter; !** strip the quotes off the name plac_name := lse$$remove_quotes(LSE$PKG_PARA_NAME); ! Change the separator for list parameters so list parameters work IF (lse$$pkg_is_list_parm(plac_name) = 1) THEN lse_set_placeholder_separator(","); ENDIF; !* form the name of the template change_case (plac_name, lower); lse_new_placeholder("{@" + plac_name + "@} | 0", 'menu', 'c'); ! Add separator for optional list parameters IF (lse$$pkg_is_list_parm(plac_name) = 1) THEN lse_set_placeholder_separator(","); ENDIF; body_line := '{@' + plac_name + '@}' ; lse_set_placeholder_menu_line(body_line, '', '', '', '') ; lse_set_placeholder_menu_line('0', '', '', '', '') ; ENDPROCEDURE; PROCEDURE lse$pkg_expand_rout_cxx !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates a CXX token definition from a routine definition. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A token definition is issued. !-- ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE,"lse$pkg_expand_rout_cxx"); ENDON_ERROR; lse$pkg_define_token; lse$pkg_gen_routine_body ( '{@', '@}', '{@{@', '@} | 0@}', ' (', ')', ', ', '() ', '', '', 0, 1); ENDPROCEDURE; PROCEDURE lse$pkg_expand_parm_cxx !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates CXX placeholder definitions from parameter definitions. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! LSE$PKG_PARA_NAME ! the name of the placeholder to define ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! Two parameter definitions are issued. !-- LOCAL body_line, plac_name; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_parm_cxx"); ENDON_ERROR; lse$pkg_define_parameter; !** strip the quotes off the name plac_name := lse$$remove_quotes(LSE$PKG_PARA_NAME); ! Change the separator for list parameters so list parameters work IF (lse$$pkg_is_list_parm(plac_name) = 1) THEN lse_set_placeholder_separator(","); ENDIF; !* form the name of the template change_case (plac_name, lower); lse_new_placeholder("{@" + plac_name + "@} | 0", 'menu', 'c'); ! Add separator for optional list parameters IF (lse$$pkg_is_list_parm(plac_name) = 1) THEN lse_set_placeholder_separator(","); ENDIF; body_line := '{@' + plac_name + '@}' ; lse_set_placeholder_menu_line(body_line, '', '', '', '') ; lse_set_placeholder_menu_line('0', '', '', '', '') ; ENDPROCEDURE; PROCEDURE lse$pkg_expand_rout_cobol !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates a Cobol token definition from a routine definition. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! LSE$PKG_ROUT_NAME ! The name of the routine to be defined. ! ! LSE$PKG_ROUT_PARM ! The list of parameters of the routine, separated by spaces ! ! LSE$PKG_ROUT_OPT ! A list of flags, in one to one correspondence with the list of ! parameters. Each flag can be either O, indicating optional, or ! R, indicating required. Each flag is separated from the next by a ! space. ! ! LSE$PKG_ROUT_MECH ! A list of flags, in one to one correspondence with the list of ! parameters. Each flag can be either D, indicating by descriptor, ! R, indicating by reference, V, indicating by value, or U, indicating ! unknown. ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A token definition is issued. !-- LOCAL body_line, cur_option, cur_param, cur_pass_mech, proc_name, case_test_name, unproc_mechs; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_rout_cobol"); ENDON_ERROR; lse$pkg_define_token; ! Remove quotes from procedure name proc_name := lse$$remove_quotes(LSE$PKG_ROUT_NAME); case_test_name := proc_name; change_case(case_test_name,UPPER); if (case_test_name = proc_name) then change_case(proc_name,lower); endif; ! ** form first line of call body_line := 'CALL "' + proc_name + '"' ; if LSE$PKG_ROUT_PARM <> "" then body_line := body_line + " USING " ; endif ; lse_set_token_body_line(body_line, '', '', '', ''); ! ** process parameters ** ! ** initially all passing mechanisms unprocessed unproc_mechs := LSE$PKG_ROUT_MECH ; ! ** add a body line for each parameter, ending when no more ! ** params (no more blanks in line) loop exitif lse$pkg_get_param (cur_param, cur_option, LSE$PKG_ROUT_PARM, LSE$PKG_ROUT_OPT) = 0 ; change_case (cur_param, lower); cur_pass_mech := substr (unproc_mechs, 1, 1) ; case substr(unproc_mechs, 1, 1) from 'D' to 'V' ['D'] : cur_pass_mech := 'BY DESCRIPTOR ' ; ['R'] : cur_pass_mech := 'BY REFERENCE ' ; ['V'] : cur_pass_mech := 'BY VALUE ' ; ['U'] : cur_pass_mech := 'UNKNOWN ' ; endcase ; unproc_mechs := substr (unproc_mechs, 3, LENGTH(unproc_mechs)) ; ! ** form the parameter reference body_line := ASCII(9); IF (lse$$pkg_is_list_parm(cur_param) = 1) THEN IF cur_option = "O" THEN ! ** optional parameter body_line := body_line + "[" + cur_pass_mech + "{" + cur_param + '}]...'; ELSE body_line := body_line + "{" + cur_pass_mech + "{" + cur_param + '}}...'; ENDIF; ELSE IF cur_option = "O" THEN ! ** optional parameter body_line := body_line + '{' + cur_pass_mech + '{' + cur_param + '} | OMITTED}' ELSE ! ** required parameter body_line := body_line + cur_pass_mech + "{" + cur_param + '}'; ENDIF; ENDIF; lse_set_token_body_line(body_line, '', '', '', ''); endloop ; lse_set_token_body_line(ASCII(9) + '[GIVING {function-res}]', '', '', '', ''); ENDPROCEDURE; PROCEDURE lse$pkg_expand_parm_cobol !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates a set of Cobol placeholder definitions ! from a parameter definition. ! «TBS» ! ! DESCRIPTION: ! This routine generates a set of Cobol placeholder definitions from a ! parameter definition. Since we cannot tell all the different ways ! that a parameter will be used, we define placeholders for all ! possiblities: all three calling mechanisms, both required and optional, ! for a total of six placeholder definitions. ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! LSE$PKG_PARA_NAME ! the name of the placeholder to define ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A set of placeholder definitions are issued. !-- LOCAL current_passing_mechanism, name_noquote; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_parm_cobol"); ENDON_ERROR; !** strip the quotes off the name name_noquote := lse$$remove_quotes( LSE$PKG_PARA_NAME ); change_case (name_noquote, lower); !* define 3 placedholders, one for each calling mechanism lse$pkg_define_parameter; lse_new_placeholder("BY DESCRIPTOR {" + name_noquote + "} | OMITTED", "menu", "cobol"); lse_set_placeholder_menu_line("BY DESCRIPTOR {" + name_noquote + '}', '', '', '', ''); lse_set_placeholder_menu_line('OMITTED', '', '', '', ''); lse_new_placeholder('BY REFERENCE {' + name_noquote + '} | OMITTED', 'menu', 'cobol'); lse_set_placeholder_menu_line("BY REFERENCE {" + name_noquote + '}', '','','',''); lse_set_placeholder_menu_line("OMITTED", '', '', '', ''); lse_new_placeholder("BY VALUE {"+ name_noquote + '} | OMITTED', 'menu', 'cobol'); lse_set_placeholder_menu_line('BY VALUE {' + name_noquote + '}', '', '', '', ''); lse_set_placeholder_menu_line("OMITTED", '', '', '', ''); ! Define placeholders for required list parameters. IF (lse$$pkg_is_list_parm(name_noquote) = 1) THEN !* define 3 placedholders, one for each calling mechanism lse_new_placeholder('BY DESCRIPTOR {' + name_noquote + '}', 'menu', 'cobol'); lse_set_placeholder_menu_line('BY DESCRIPTOR {' + name_noquote + '}', '', '', '', ''); lse_new_placeholder('BY REFERENCE {' + name_noquote + '}', 'menu', 'cobol'); lse_set_placeholder_menu_line('BY REFERENCE {' + name_noquote + '}', '', '', '', ''); lse_new_placeholder('BY VALUE {' + name_noquote + '}', 'menu', 'cobol'); lse_set_placeholder_menu_line('BY VALUE {' + name_noquote + '}', '', '', '', ''); ENDIF; ENDPROCEDURE; PROCEDURE lse$pkg_expand_rout_fortran !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates a Fortran token definition from a routine definition. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! LSE$PKG_ROUT_NAME ! The name of the routine to be defined. ! ! LSE$PKG_ROUT_PARM ! The list of parameters of the routine, separated by spaces ! ! LSE$PKG_ROUT_OPT ! A list of flags, in one to one correspondence with the list of ! parameters. Each flag can be either O, indicating optional, or ! R, indicating required. Each flag is separated from the next by a ! space. ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A token definition is issued. !-- LOCAL body_line, current_option, case_test_name, current_param, proc_name; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_rout_fortran"); ENDON_ERROR; lse$pkg_define_token; ! Remove quotes from procedure name ! Upcase if all lower-case proc_name := lse$$remove_quotes(LSE$PKG_ROUT_NAME); case_test_name := proc_name; change_case(case_test_name,lower); if (case_test_name = proc_name) then change_case(proc_name,UPPER); endif; ! ** form first line of call ! Insert leading tab body_line := ' ' + proc_name + ' ('; ! ** syntax without parameters if LSE$PKG_ROUT_PARM = "" then body_line := body_line + ')' ; lse_set_token_body_line(body_line, '', '', '', ''); else ! ** process first line lse_set_token_body_line(body_line, '', '', '', ''); ! ** process first parameter body_line := ' 1 ' ; lse$pkg_get_param (current_param, current_option, LSE$PKG_ROUT_PARM, LSE$PKG_ROUT_OPT) ; change_case (current_param, lower); if current_option = 'O' then body_line := body_line + '[' + current_param + ']' ; else body_line := body_line + '{' + current_param + '}' ; endif ; ! use list placeholders for list parameters. IF (lse$$pkg_is_list_parm(current_param) = 1) THEN body_line := body_line + '...'; ENDIF; ! ** process other parameters ** ! ** add a body line for each parameter, ending when no more ! ** params (no more blanks in line) loop exitif lse$pkg_get_param (current_param, current_option, LSE$PKG_ROUT_PARM, LSE$PKG_ROUT_OPT) = 0 ; change_case (current_param, lower); ! ** add a comma to previous line and process body_line := body_line + ', ' ; lse_set_token_body_line(body_line, '', '', '', ''); ! ** form the command line for current parameter body_line := ' 1 ' ; if current_option = "O" then ! ** optional parameter body_line := body_line + '[' + current_param + ']' ; else ! ** required parameter body_line := body_line + "{" + current_param + '}' endif ; ! use list placeholders for list parameters. IF (lse$$pkg_is_list_parm(current_param) = 1) THEN body_line := body_line + '...'; ENDIF; endloop ; ! ** finish the call body_line := body_line + ')' ; lse_set_token_body_line(body_line, '','','',''); endif ; ! ** param syntax ENDPROCEDURE; PROCEDURE lse$pkg_expand_parm_fortran !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates a Fortran placeholder definition from a parameter ! definition. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A placeholder definition is issued. !-- ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_parm_fortran"); ENDON_ERROR; lse$pkg_define_parameter; ! Change the separator for list parameters so list parameters work IF (lse$$pkg_is_list_parm( lse$$remove_quotes(LSE$PKG_PARA_NAME)) = 1) THEN lse_set_placeholder_separator(','); ENDIF; ENDPROCEDURE; PROCEDURE lse$pkg_expand_rout_f90 !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates a Fortran 90 token definition from a routine ! definition. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! LSE$PKG_ROUT_NAME ! The name of the routine to be defined. ! ! LSE$PKG_ROUT_PARM ! The list of parameters of the routine, separated by spaces ! ! LSE$PKG_ROUT_OPT ! A list of flags, in one to one correspondence with the list of ! parameters. Each flag can be either O, indicating optional, or ! R, indicating required. Each flag is separated from the next by a ! space. ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A token definition is issued. !-- LOCAL body_line, current_option, case_test_name, current_param, proc_name; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_rout_f90"); ENDON_ERROR; lse$pkg_define_token; ! Remove quotes from procedure name ! Upcase if all lower-case proc_name := lse$$remove_quotes(LSE$PKG_ROUT_NAME); case_test_name := proc_name; change_case(case_test_name,lower); if (case_test_name = proc_name) then change_case(proc_name,UPPER); endif; ! ** form first line of call body_line := proc_name + ' ('; ! ** syntax without parameters if LSE$PKG_ROUT_PARM = "" then body_line := body_line + ')' ; lse_set_token_body_line(body_line, '', '', '', ''); else ! ** process first line body_line := body_line + ' &'; lse_set_token_body_line(body_line, '', '', '', ''); ! ** process first parameter lse$pkg_get_param (current_param, current_option, LSE$PKG_ROUT_PARM, LSE$PKG_ROUT_OPT) ; change_case (current_param, lower); if current_option = 'O' then body_line := ' [' + current_param + ']' ; else body_line := ' {' + current_param + '}' ; endif ; ! use list placeholders for list parameters. IF (lse$$pkg_is_list_parm(current_param) = 1) THEN body_line := body_line + '...'; ENDIF; ! ** process other parameters ** ! ** add a body line for each parameter, ending when no more ! ** params (no more blanks in line) loop exitif lse$pkg_get_param (current_param, current_option, LSE$PKG_ROUT_PARM, LSE$PKG_ROUT_OPT) = 0 ; change_case (current_param, lower); ! ** add a comma to previous line and process body_line := body_line + ', &' ; lse_set_token_body_line(body_line, '', '', '', ''); ! ** form the command line for current parameter body_line := ' ' ; if current_option = "O" then ! ** optional parameter body_line := body_line + '[' + current_param + ']' ; else ! ** required parameter body_line := body_line + "{" + current_param + '}' endif ; ! use list placeholders for list parameters. IF (lse$$pkg_is_list_parm(current_param) = 1) THEN body_line := body_line + '...'; ENDIF; endloop ; ! ** finish the call body_line := body_line + ')' ; lse_set_token_body_line(body_line, '','','',''); endif ; ! ** param syntax ENDPROCEDURE; PROCEDURE lse$pkg_expand_parm_f90 !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates a Fortran placeholder definition from a parameter ! definition. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A placeholder definition is issued. !-- ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_parm_f90"); ENDON_ERROR; lse$pkg_define_parameter; ! Change the separator for list parameters so list parameters work IF (lse$$pkg_is_list_parm( lse$$remove_quotes(LSE$PKG_PARA_NAME)) = 1) THEN lse_set_placeholder_separator(','); ENDIF; ENDPROCEDURE; PROCEDURE lse$pkg_expand_rout_macro !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates a VAX MACRO token definition from a routine ! definition. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A token definition is issued. !-- LOCAL keyword_param, body_line, mech, cur_option, cur_param, param_name, proc_name, case_test_name, routine_suffix; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_rout_macro"); ENDON_ERROR; !+ ! If the token is of the form $name, ! process to include special menu placeholder, otherwise process as ! the $name_G and $name_S forms as normal. !- proc_name := lse$$remove_quotes(LSE$PKG_ROUT_NAME); case_test_name := proc_name; change_case(case_test_name,UPPER); if (case_test_name = proc_name) then change_case(proc_name,lower); endif; if length(LSE$PKG_ROUT_NAME) >= 4 then routine_suffix := substr (LSE$PKG_ROUT_NAME,length(LSE$PKG_ROUT_NAME) - 2, 2) else routine_suffix := 'XX'; ! no suffix endif; ! Force to uppercase for comparison CHANGE_CASE (routine_suffix, UPPER); if (routine_suffix = '_S') then lse$pkg_define_token; ! Process as $name_S lse$pkg_gen_routine_body ('', '}', '[~', '}~]', '', '', ', -', '', '= {', ' -', 0, 0); else if (routine_suffix = '_G') then lse$pkg_define_token; ! Process as $name_G on one line lse$pkg_gen_routine_body ('', '}', '[~', '}~]', '', '', ', -', '', '= {', ' -', 0, 0); else lse$pkg_define_macro_token; ! Process as $name ! process the body lines on the placeholder just generated if LSE$PKG_ROUT_PARM = '' then ! Special case when there are no parameters lse_set_placeholder_body_line(proc_name, '', '', '', ''); else ! line 1: procedure name + continuation character lse_set_placeholder_body_line(proc_name + " -", '', '', '', ''); body_line := ASCII(9); ! Loop through each parameter loop exitif lse$pkg_get_param (cur_param, cur_option, LSE$PKG_ROUT_PARM, LSE$PKG_ROUT_OPT) = 0; keyword_param := lse$pkg_remove_mech(cur_param, mech); lse$pkg_pad_name (keyword_param, param_name); IF cur_option = "O" THEN ! optional parameter body_line := body_line + '[~' + param_name + ' = {' + cur_param + '}~]'; ELSE ! required parameter body_line := body_line + param_name + ' = {' + cur_param + '}'; ENDIF; ! if last line, close off the call if LSE$PKG_ROUT_PARM <> '' then body_line := body_line + ', -'; endif ; change_case (body_line,lower); lse_set_placeholder_body_line(body_line, '', '', '', ''); body_line := ASCII(9); endloop; endif; endif; endif; ENDPROCEDURE; PROCEDURE lse$pkg_expand_parm_macro !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates a VAX MACRO placeholder definition from a parameter ! definition, using keyword macro syntax. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! LSE$PKG_PARA_NAME ! the name of the placeholder to define ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! Two placeholder definitions are issued. !-- LOCAL body_line, name_noquote, padded_key, keyword_name, mech; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_parm_macro"); ENDON_ERROR; ! Define a placeholder for the parameter lse$pkg_define_parameter; ! Define a placeholder in the form "name = {name}" ! Strip the quotes off the name name_noquote := lse$$remove_quotes( LSE$PKG_PARA_NAME ); ! Remove passing mechanism .r,.d, or .v suffix keyword_name := lse$pkg_remove_mech (name_noquote, mech); lse$pkg_pad_name (keyword_name, padded_key); ! form the name of the template body_line := padded_key + ' = {' + name_noquote + '}'; lse_new_placeholder( body_line, 'nonterminal', 'macro'); lse_set_placeholder_separator(", -"); lse_set_placeholder_trailing(", -"); ! Define the body CHANGE_CASE (body_line, LOWER); lse_set_placeholder_body_line(body_line, '','','',''); ENDPROCEDURE; PROCEDURE lse$pkg_expand_rout_pascal !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates a Pascal token definition from a routine ! definition. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A token definition is issued. !-- ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_rout_pascal"); ENDON_ERROR; lse$sys_expand_rout_pascal; ENDPROCEDURE; PROCEDURE lse$sys_expand_rout_pascal !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates a Pascal token definition from a parameter ! definition, using keyword syntax. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! LSE$PKG_ROUT_NAME ! The name of the routine to be defined. ! ! LSE$PKG_ROUT_PARM ! The list of parameters of the routine, separated by spaces. ! ! LSE$PKG_ROUT_OPT ! A list of flags, in one to one correspondence with the list of ! parameters. Each flag can be either O, indicating optional, or ! R, indicating required. Each flag is separated from the next by a ! space. ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A token definition is issued. !-- LOCAL body_line, proc_name, cur_param, cur_option, param_name, keyword_param, case_test_name, mech; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$sys_expand_rout_pascal"); ENDON_ERROR; ! Generate the token. lse$pkg_define_token; ! Remove quotes from procedure name. proc_name := lse$$remove_quotes(LSE$PKG_ROUT_NAME); ! Format the call with the procedure name in lowercase (unless the name ! is in mixed case, in which case, leave it alone). case_test_name := proc_name; change_case(case_test_name,UPPER); if (case_test_name = proc_name) then change_case(proc_name,lower); endif; IF LSE$PKG_ROUT_PARM = '' THEN ! The call consists of just the procedure name lse_set_token_body_line(proc_name, '', '', '', ''); ELSE ! The call has parameters ! Form the first line of the call. ! First line is just the procedure name and open parenthesis. lse_set_token_body_line(proc_name + ' (', '', '', '', ''); ! Move a required parameter to the beginning of the list. ! This avoids a problem in erasing a comma after first ! parameter if it is optional. lse$pkg_reorder_params (LSE$PKG_ROUT_PARM, LSE$PKG_ROUT_OPT); ! Loop for each parameter. LOOP EXITIF lse$pkg_get_param (cur_param, cur_option, LSE$PKG_ROUT_PARM, LSE$PKG_ROUT_OPT) = 0; ! Remove passing mechanism .x suffix (x = v, d, or r). keyword_param := lse$pkg_remove_mech (cur_param, mech); ! Modify parameter names that conflict with Pascal keywords. IF keyword_param = "TYPE" THEN keyword_param := keyword_param + '_'; ENDIF; lse$pkg_pad_name (keyword_param, param_name); ! Form the template line for the parameter. body_line := ASCII(9); ! tab ! If routine contains a list parameter, make it nonkeyword IF (lse$$pkg_contains_list_parm(proc_name) = 1) THEN IF cur_option = "O" THEN ! optional parameter body_line := body_line + '%[' + cur_param + ']%'; ELSE ! required parameter body_line := body_line + '%{' + cur_param + '}%'; ENDIF; ! use list placeholders for list parameters. IF (lse$$pkg_is_list_parm(cur_param) = 1) THEN body_line := body_line + '...'; ENDIF; ELSE IF cur_option = "O" THEN ! optional parameter body_line := body_line + '%[' + param_name + ' := %{' + cur_param + '}%]%' ELSE ! required parameter body_line := body_line + param_name + ' := %{' + cur_param + '}%' ENDIF; ENDIF; IF LSE$PKG_ROUT_PARM = '' THEN ! No more parameters ! Complete the call statement. body_line := body_line + ')'; ELSE ! Add a separator after the parameter. body_line := body_line + ','; ENDIF ; ! Make the line lower case. CHANGE_CASE (body_line,LOWER); ! Add the line to the token definition. lse_set_token_body_line(body_line, '','','',''); ENDLOOP; ENDIF; ! parameter string is/isn't empty ENDPROCEDURE; PROCEDURE lse$pkg_expand_parm_pascal !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates Pascal placeholder definitions from a parameter ! definition, for keyword syntax. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! LSE$PKG_PARA_NAME ! the name of the placeholder to define ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! Two placeholder definitions are issued. !-- LOCAL name_noquote, padded_key, keyword_name, mech, plac_name; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_parm_pascal"); ENDON_ERROR; lse$pkg_define_parameter; name_noquote := lse$$remove_quotes(LSE$PKG_PARA_NAME); ! Change the separator for list parameters so list parameters work IF (lse$$pkg_is_list_parm(name_noquote) = 1) THEN lse_set_placeholder_separator(','); ENDIF; ! Define a placeholder of the form "name := %{name}%". ! This is done in case the parameter is optional. ! Remove passing mechanism .x suffix (x = v, d, or r). keyword_name := lse$pkg_remove_mech (name_noquote, mech); ! Modify parameter names that conflict with Pascal keywords IF keyword_name = 'TYPE' THEN keyword_name := keyword_name + '_'; ENDIF; lse$pkg_pad_name (keyword_name, padded_key) ; ! Generate the PLACEHOLDER. plac_name := padded_key + ' := %{' + name_noquote + '}%'; change_case(plac_name, lower); lse_new_placeholder(plac_name, 'nonterminal', 'pascal'); lse_set_placeholder_separator(","); lse_set_placeholder_trailing(","); ! Do the body lse_set_placeholder_body_line(plac_name, '', '', '', ''); ENDPROCEDURE; PROCEDURE lse$pkg_expand_rout_pli !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates a PL/I token definition from a routine definition. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A token definition is issued. !-- ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_rout_pli"); ENDON_ERROR; lse$pkg_define_token; lse$pkg_gen_routine_body ('{', '}', '[', ']', ' (', ')', ', ','() ', '', '', 0, 1); ENDPROCEDURE; PROCEDURE lse$pkg_expand_parm_pli !doc_begin ! ! ONE LINE DEFINITION: ! This routine generates a PL/I placeholder definition from a ! parameter definition. ! «TBS» ! ! DESCRIPTION: ! «TBS» ! ! RELATED COMMANDS: ! «TBS» ! ! EXAMPLE: ! «TBS» ! ! CATEGORY: ! «TBS» ! !doc_end !++ ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A placeholder definition is issued. !-- ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$pkg_expand_parm_pli"); ENDON_ERROR; lse$pkg_define_parameter; ! Change the separator for list parameters so list parameters work IF (lse$$pkg_is_list_parm(LSE$$REMOVE_QUOTES(LSE$PKG_PARA_NAME)) = 1) THEN lse_set_placeholder_separator(","); ENDIF; ENDPROCEDURE; !++ ! FUNCTIONAL DESCRIPTION: ! ! This section of code defines the global TPU variables that we will be ! using by assigning the null string to each of them. This is a hack to get ! around the fact that TPU has no global variable definition facility. ! These statements apparently have to be in the same compilation as the ! procedures listed above, otherwise TPU won't bind the above uses of these ! variables correctly. ! ! Eventually, TPU will have a VARIABLE declaration; when that happens, this ! section should be changed to a set of variable declarations at the ! beginning of the file. ! ! SIDE EFFECTS: ! ! None !-- LSE$PKG_PARA_NAME := ""; ! Name of parameter being defined LSE$PKG_PARA_LANG := ""; ! Language for parameter being defined LSE$PKG_ROUT_NAME := ""; ! Name of routine being defined LSE$PKG_ROUT_LANG := ""; ! Language for routine being defined LSE$PKG_ROUT_desc := "" ; ! Description string for routine being defined LSE$PKG_ROUT_top := "" ; ! Topic string for routine being defined LSE$PKG_ROUT_pack := "" ; ! Package name for routine being defined LSE$PKG_ROUT_parm := "" ; ! Parameter list for routine being defined LSE$PKG_ROUT_opt := "" ; ! [NO]OPTIONAL flags for routine being defined LSE$PKG_ROUT_mech := "" ; ! mechanism flags for routine being defined LSE$PKG_ROUT_BOOK := "" ; ! Book manual LSE$PKG_ROUT_BOOKREFERENCE := "" ; ! Book reference tag ! End of TPU source file for package support