! !++ ! ! TITLE: MACLIB - Bliss-32 Macro Library ! ! VERSION: V015 ! ! FACILITY: B32 - BLISS-32 SUPPORT ! ! ABSTRACT: This module contains general usage Bliss-32 ! macros employing extensive usage of compiler ! lexical processing techniques. ! ! ENVIRONMENT: Valid at all access modes. ! ! AUTHOR: Lost in the mists of time ! ! CREATION DATE: A long time ago ! ! MODIFICATION HISTORY: ! ! V015 Brian K Catlin 27-OCT-1989 ! Added _INIT_QUEUE ! ! V014 Brian K Catlin 24-OCT-1989 ! Added _INCR and _DECR macros ! ! V013 Brian K Catlin 27-SEP-1988 ! Added _KERNEL_CALL and _EXEC_CALL macros ! ! V012 James A. Gray 21-AUG-1986 ! Deletions, changes. ! 1) Removed _SET_IPL macro, supported by _SETIPL in LIBEXT. ! 2) Changed modification history to standard format. ! !-- !+ ! EQUATED SYMBOLS: ! ! QUE_K_FLINK Forward link in a VMS standard queue header. ! QUE_K_BLINK Backward link in a VMS standard queue header. !- LITERAL que_k_flink = 0, que_k_blink = 1; !+ ! TABLE OF CONTENTS ! ! _MATCH Determines whether a lexeme is identical to atleast ! one other lexeme in a list of lexemes. ! _STRING_DESC Declares a string descriptor as a block structure and ! PRESETs the fields. ! _DATA_DESC Declares a data descriptor as a block structure and ! PRESETs the fields. ! _ASSIGN_COUNT Declares LITERALs of ascending value based on a START, ! INCREMENT, and LIST. ! _BIT_VECTOR Declares a BITVECTOR with each element having a name. ! _VECTOR Declares a VECTOR with each element having a name. ! _DEFINE_MESSAGE_MACRO Declares a macro that will check fao_counts ! for SIGNAL expressions. ! _MESSAGES Declares messages for a facility as EXTERNAL and ! calls the _DEFINE_MESSAGE_MACRO macro. ! _QUEUE_HEADER Declares a VMS standard 2 longword queue header and ! initializes it to empty. ! _DESCRIPTOR Declares a standard quadword descriptor with no ! preset attributes. ! _LOCK_CODE Locks a process space virtual address range into a ! process's working set. ! _LOCK_STACK Locks pages of stack space on a specified mode process ! stack. ! _UNLOCK_CODE Unlock process working set pages. ! _FACILITY_PSECT Declares a facility specific set of PSECT names with ! specified attributes. ! _LABEL Declares a label as a longword vector with of 0 ! length. ! ! _KERNEL_CALL Call a routine in KERNEL mode, with optional arguments ! ! _EXEC_CALL Call a routine in EXEC mode, with optional arguments ! ! _INCR Increments a field. ! ! _DECR Decrements a field. ! ! _INIT_QUEUE Initializes a queue header to empty. ! !- %sbttl '_MATCH - ' MACRO _match (key, item) [] = !+ ! ! FUNCTIONAL DESCRIPTION: ! ! This macro recursively matches a given KEY lexeme to each lexeme ! in a lexeme list. If a match occurs then the macro expands to a ! 1 (TRUE). If no match occurs then the macro expands to 0 (FALSE). ! ! By default, lexemes are converted to uppercase unless the caller ! encloses each lexeme in quotes. ! ! FORMAL PARAMETERS: ! ! KEY Lexeme to be matched. ! ITEM List of lexemes to match KEY against. ! ! COMPLETION VALUE: ! ! 0 No match was found. ! 1 Match was found. ! !- !+ ! If KEY is identical to the first argument of the argument list ! then a match has been made. Expand to 1 (TRUE). !- %IF %IDENTICAL (key, item) %THEN 1 %EXITMACRO %ELSE !+ ! If there are no more arguments then no match was found. Exit ! this recursive level with 0 (FALSE). This will be the expansion ! of the entire recursive structure. !- %IF %NULL (%REMAINING) %THEN 0 %EXITMACRO !+ ! If more arguments exist then recursively call _MATCH. !- %ELSE _match (key, %REMAINING) %FI %FI %; %sbttl '_STRING_DESC - ' KEYWORDMACRO _string_desc ( class = s, dtype = t, length = 0, pointer = 0 ) = !+ ! ! FUNCTIONAL DESCRIPTION: ! ! This macro initializes a string descriptor previously declared ! using the PRESET attribute. ! ! The CLASS and DTYPE entries are checked to see if they correspond ! to valid system defined string type codes. If not a compiler ! warning message is given. Macro expansion continues assuming that ! the caller has defined his own string type. ! ! LENGTH and POINTER fields are check to ensure that they are given ! link-time-constant-expressions as actuals. If not, the an error ! is issued, thus terminating all macro expansion. ! ! The default field specifiers define a null static string. ! ! A discussion of descriptors and their fields can be found in the ! "VAX-11 ARCHITECTURE HANDBOOK" starting on page 409. ! ! FORMAL PARAMETERS: ! ! CLASS Single lexeme referring to a string descriptor ! CLASS code. (Defaults to S) ! DTYPE Single lexeme referring to a string descriptor ! DATA TYPE field. (Defaults to T) ! LENGTH Word expression used to initialize the descriptor ! LENGTH field. (Defaults to 0) ! POINTER Address expression used to initialize the descriptor ! POINTER field. (defaults to 0) ! !- !+ ! Declare the string descriptor as a block structure of the appropriate ! size as specified by the CLASS code. !- BLOCK [%NAME ('dsc$k_', class, '_bln'), BYTE] !+ ! Preset the fields. !- PRESET( !+ ! If the CLASS or DTYPE fields do not correspond to system defined ! codes then issue a WARNING. !- %IF _match (class, s, d, vs) %THEN %ELSE %WARN ('_STRING_DESC - ', class, ' not a system defined string', ' descriptor class') %FI [dsc$b_class] = %NAME ('dsc$k_class_', class), %IF _match (dtype, t, nu, nl, nlo, nr, nro, nz, p) %THEN %ELSE %WARN ('_STRING_DESC - ', dtype, ' not a system defined string', ' data type') %FI [dsc$b_dtype] = %NAME ('dsc$k_dtype_', dtype), [dsc$w_length] = length, [dsc$a_pointer] = pointer) ! Close off the PRESET. %; %sbttl '_DATA_DESC - ' KEYWORDMACRO _data_desc ( class = s, dtype = z, length = 0, pointer = 0 ) = !+ ! ! FUNCTIONAL DESCRIPTION: ! ! This macro initializes a data descriptor previously declared ! using the PRESET attribute. ! ! The CLASS and DTYPE entries are checked to see if they correspond ! to valid system defined atomic data type codes. If not a compiler ! warning message is given. Macro expansion continues assuming that ! the caller has defined his own string type. ! ! LENGTH and POINTER fields are check to ensure that they are given ! link-time-constant-expressions as actuals. If not, the an error ! is issued, thus terminating all macro expansion. ! ! The default field specifiers define a null static descriptor of ! unspecified data type. ! ! A discussion of descriptors and their fields can be found in the ! "VAX-11 ARCHITECTURE HANDBOOK" starting on page 409. ! ! FORMAL PARAMETERS: ! ! CLASS Single lexeme referring to a descriptor CLASS code. ! (Defaults to S) ! DTYPE Single lexeme referring to a descriptor DATA TYPE ! field. (Defaults to Z) ! LENGTH Word expression used to initialize the descriptor ! LENGTH field. (Defaults to 0) ! POINTER Address expression used to initialize the descriptor ! POINTER field. (defaults to 0) ! !- !+ ! Declare the data descriptor as a block structure of the appropriate ! size as specified by the CLASS code. !- BLOCK [%NAME ('dsc$k_', class, '_bln'), BYTE] !+ ! Preset the fields. !- PRESET( !+ ! If the CLASS or DTYPE fields do not correspond to system defined ! codes then issue a WARNING. !- %IF _match (class, s, d, vs) %THEN %ELSE %WARN ('_DATA_DESC - ', class, ' not a system defined data', ' descriptor class') %FI [dsc$b_class] = %NAME ('dsc$k_class_', class), %IF _match (dtype, z, bu, wu, lu, qu, ou, b, w, l, q, o, f, d, g, h, fc, dc, gc, hc, cit) %THEN %ELSE %WARN ('_DATA_DESC - ', dtype, ' not a system defined data type') %FI [dsc$b_dtype] = %NAME ('dsc$k_dtype_', dtype), [dsc$w_length] = length, [dsc$a_pointer] = pointer) ! Close off the PRESET. %; %sbttl '_ASSIGN_COUNT - ' MACRO _assign_count (start, increment) [LIST] = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This macro expands to a series of LITERAL declarations. Each iteration ! takes a lexeme from the iterative argument list and assigns a value. ! values start at START and are incremented by INCREMENT for each ! iteration. ! ! FORMAL PARAMETERS: ! ! START START value for LITERAL assignment. ! INCREMENT INCREMENT value for each iteration. ! LIST List of lexemes to be used as the equated symbols. ! !-- LITERAL LIST = start + %COUNT*increment; %; %sbttl '_BIT_VECTOR - ' MACRO _bit_vector [] = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This macro defines a BITVECTOR with each element taking a name from the ! remaining argument list. Name assignments are performed via the ! _ASSIGN_COUNT macro. ! ! Note that this may be the only declaration in any given storage ! declaration. No other attributes on the defined bitvector are ! allowed. ! ! FORMAL PARAMETERS: ! ! List of bitvector elements. ! !-- BITVECTOR [%LENGTH - 1]; _assign_count (0, 1, %REMAINING); %; %sbttl '_VECTOR - ' MACRO _vector [] = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This macro defines a VECTOR with each element taking a name from the ! remaining argument list. Name assignments are performed via the ! _ASSIGN_COUNT macro. ! ! Note that this may be the only declaration in any given storage ! declaration. No other attributes on the defined vector are ! allowed. ! ! FORMAL PARAMETERS: ! ! List of vector elements. ! !-- VECTOR [%LENGTH - 1]; _assign_count (0, 1, %REMAINING); %; %sbttl '_DEFINE_MESSAGE_MACRO - ' MACRO _define_message_macro (macro_name, symbol, fao_count) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This macro is used to declare another macro with the same name as ! the NAME part of a symbol representing a message. The FAO_COUNT is ! also checked. If the wrong number of FAO arguments are specified ! an error message will be given. ! ! The declared macro is to be used in a SIGNAL expression: ! ! SIGNAL ( macro_name ( fao_args ) ); ! ! This macro is defined instead of making it part of the _MESSAGES macro ! due to name binding conflicts between the macro_name and the NAME ! part of the SYMBOL. The statement %NAME (facility, name) makes the ! lexical processor think that "name" is a recursive activation of the ! macro being defined. ! ! FORMAL PARAMETERS: ! ! MACRO_NAME Name of the message macro to be defined. By ! convention this should be the same as the ! NAME part of the message symbol name. The ! macro name defined will have two underscores ! (__) prefixed to the MACRO_NAME. ! SYMBOL A VMS message (condition-code) form name: ! fac_name ! FAO_COUNT Number of signal FAO arguments. ! !-- MACRO %NAME ('__', macro_name) !+ ! Make the macro recursive only if there are some FAO args to be ! used as the recursive arguments. !- %IF fao_count GTRU 0 %THEN [] %FI = !+ ! Build the signal argument list: ! symbol, fao_count, fao_args... !- symbol, fao_count %IF %LENGTH GTRU 0 %THEN , %REMAINING %FI !+ ! If the wrong number of FAO args is specified then give an ! ERROR message. !- %IF %LENGTH NEQ fao_count %THEN %ERRORMACRO ('_MESSAGES - Argument count is ', %LENGTH, ' but should be ', fao_count) %FI %QUOTE %; %; %sbttl '_MESSAGES - ' MACRO _messages (facility) [name, fao_count] = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This macro is used to declare messages for a facility as EXTERNAL ! symbols and call the _DEFINE_MESSAGE_MACRO macro. ! ! FORMAL PARAMETERS: ! ! FACILITY Facility and separator prefix accoring to VMS ! condition-code naming standard: ! fac_ ! NAME Name field of message name. ! FAO_COUNT Number of expected FAO arguments corresponding ! to message defined in a message file with the ! message utility. ! !-- !+ ! Check to see if the message is already defined (as would be the ! case with a shared message) and only declare the message as external ! if it is not already defined. !- %IF NOT %DECLARED (%NAME (facility, name)) %THEN !+ ! Declare the message as EXTERNAL. It should be located in a ! separate message utility file. !- EXTERNAL %NAME (facility, name) : ADDRESSING_MODE (GENERAL); %FI !+ ! Define the actual message macro and check FAO count. !- _define_message_macro (name, %NAME (facility, name), fao_count) %; %sbttl '_QUEUE_HEADER - ' MACRO _queue_header (links) = !+ ! ! FUNCTIONAL DESCRIPTION: ! ! This macro provides an attribute list to bind a name to a standard ! VMS 2 longword queue header. The links will be initialized according ! to the LINKS argument. ! ! CALLING SEQUENCE: ! ! _QUEUE_HEADER ( LINKS.ra.v ) ! ! FORMAL PARAMETERS: ! ! LINKS Value to preset forward and backward links ! to. ! !- VECTOR [2, LONG] %IF NOT %NULL (links) %THEN PRESET( [0] = links, [1] = links) %FI %; %sbttl '_DESCRIPTOR - ' MACRO _descriptor = !+ ! ! FUNCTIONAL DESCRIPTION: ! ! This macro expands to a structure attribute to bind a name to ! a standard quadword descriptor. Now presetting is performed. ! The main purpose of this macro is to provide a quick declaration ! for string formal arguments in routine declarations: ! ROUTINE X ( S : REF _DESCRIPTOR ) = ! . ! . ! . ! ! CALLING SEQUENCE: ! ! _DESCRIPTOR ! ! FORMAL PARAMETERS: ! ! None. ! !- BLOCK [dsc$k_s_bln, BYTE] %; %sbttl '_LOCK_CODE - ' MACRO _lock_code (start_va, end_va) = !+ ! ! FUNCTIONAL DESCRIPTION: ! ! This macro provides an interface to the $LKWSET system service to lock ! a range of virtual addresses in process space. This macro should be ! used only to lock code that is charged against a process's working set ! to allow things such as IPL jumps. ! ! This macro expands to code which will allocate a local quadword, ! insert the address range arguments into it, and pass the quadword off ! to the $LKWSET system service. ! ! END_VA is optional. If it is not specified, only the page specified ! in START_VA will be locked. ! ! This macro may be used in a value context. ! ! CALLING SEQUENCE: ! ! STATUS.wlc.v = _LOCK_CODE ( START_VA.ra.v [, END_VA.ra.v] ) ! ! FORMAL PARAMETERS: ! ! START_VA Virtual address contained in the starting ! page of the range to be locked. ! END_VA Virtual address contained in the ending ! page of the range to be locked. ! ! IMPLICIT INPUTS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION STATUS: ! ! Any return from $LKWSET. ! ! SIDE EFFECTS: ! ! None. ! !- !+ ! Make sure that atleast the START_VA has been specified. If not, ! terminate expansion here with an error. !- %IF %NULL (start_va) %THEN %ERRORMACRO ('_LOCK_CODE - Starting virtual address not specified') %FI !+ ! Start a local block so that the local quadword may be allocated. !- BEGIN !+ ! LOCAL STORAGE: ! ! RANGE_QUAD Quadword containing the range of virtual ! pages to be locked. !- LOCAL __range_quad : VECTOR [2, LONG]; !+ ! Fill in the range quadword. Note that if END_VA is not specified ! then only the START_VA page will be locked. !- __range_quad [0] = start_va; __range_quad [1] = %IF %NULL (end_va) %THEN start_va %ELSE end_va %FI ; !+ ! Lock the specified range of pages and make the return value of ! $LKWSET the value of this inner block. !- $lkwset (inadr = __range_quad) END %; %sbttl '_LOCK_STACK - ' MACRO _lock_stack (stack_pr, start_page_off, end_page_off, range_quad) = !+ ! ! FUNCTIONAL DESCRIPTION: ! ! This macro provides an interface to the $LKWSET system service to lock ! pages of stack space on a specified mode stack. This macro should be ! used only to lock stack space that is charged against a process's ! working set to allow things such as IPL jumps. ! ! The target stack is specified by the privileged register number ! of the corresponding stack pointer. If this argument is not specified ! it defaults to the KERNAL stack. ! ! The range of pages to be locked is determined by the offset arguments. ! These offsets are relative to the current stack page. For example, ! to lock the current stack page on the kernal stack: ! _LOCK_STACK (PR$_KSP,0,0,RETADR) ! To lock the previous page, current page, and next page on the user ! stack: ! _LOCK_STACK (PR$_USP,-1,1,RETADR) ! If an offset argument is not specified, it defaults to 0 (the current ! stack page). ! ! The range of pages locked is returned by the $LKWSET system service ! in the RANGE_QUAD argument. ! ! This macro may be used in a value context. ! ! CALLING SEQUENCE: ! ! STATUS.wlc.v = _LOCK_STACK ( STACK_PR.rlu.v [, START_PAGE_OFF.rlu.v] ! [, END_PAGE_OFF.rlu.v] ! , RANGE_QUAD.wq.r ) ! ! FORMAL PARAMETERS: ! ! STACK_PR Number of the target stack pointer privileged ! register (i.e. PR$_xxx). ! START_PAGE_OFF Offset from the current stack page of the first ! page in the range to be locked. ! END_PAGE_OFF Offset from the current stack page of the last ! page in the range to be locked. ! RANGE_QUAD Address of a quadword where the virtual address ! range locked will be returned. ! ! IMPLICIT INPUTS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION STATUS: ! ! Any return from $LKWSET. ! ! SIDE EFFECTS: ! ! None. ! !- !+ ! Make sure that the RANGE quadword has been specified. This is done ! to ensure that the user is aware that he/she should unlock the stack ! space that will be locked. !- %IF %NULL (range_quad) %THEN %ERRORMACRO ('_LOCK_STACK - Return range quadword not specified') %FI BEGIN !+ ! BUILTINS: ! ! MFPR Move from Privileged Register. !- BUILTIN MFPR; !+ ! LOCAL STORAGE: ! ! STACKPOINTER Holds the contents of stack pointer ! corresponding to the target stack. !- LOCAL __stackpointer; !+ ! LOCAL BINDS: ! ! RANGE_QUAD Make sure that the range quad can be accessed ! as a vector of 2 longwords. !- BIND __range_quad = range_quad : VECTOR [2, LONG]; !+ ! Get the contents of the target stack pointer and determine the ! range from the desired page offsets. If an offset is not specified, ! default to 0 (the current stack page). !- MFPR (stack_pr, __stackpointer); __range_quad [0] = __stackpointer + %IF %NULL (start_page_off) %THEN 0 %ELSE start_page_off*512 %FI ; __range_quad [1] = __stackpointer + %IF %NULL (end_page_off) %THEN 0 %ELSE end_page_off*512 %FI ; !+ ! Lock the pages and return the resultant range. Make the return ! value from $LKWSET the value for this inner block. !- $lkwset (inadr = __range_quad, retadr = range_quad) END %; %sbttl '_UNLOCK_CODE - ' MACRO _unlock_code (start_va, end_va) = !+ ! ! FUNCTIONAL DESCRIPTION: ! ! This macro provides an interface to the $ULWSET system service to ! unlock a range of virtual addresses in process space. This macro ! should be used to undue the _LOCK_CODE and _LOCK_STACK macro functions. ! ! This macro expands to code which will allocate a local quadword, ! insert the address range arguments into it, and pass the quadword off ! to the $ULWSET system service. ! ! END_VA is optional. If it is not specified, only the page specified ! in START_VA will be unlocked. ! ! This macro may be used in a value context. ! ! CALLING SEQUENCE: ! ! STATUS.wlc.v = _UNLOCK_CODE ( START_VA.ra.v [, END_VA.ra.v] ) ! ! FORMAL PARAMETERS: ! ! START_VA Virtual address contained in the starting ! page of the range to be unlocked. ! END_VA Virtual address contained in the ending ! page of the range to be unlocked. ! ! IMPLICIT INPUTS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION STATUS: ! ! Any return from $ULWSET. ! ! SIDE EFFECTS: ! ! None. ! !- !+ ! Make sure that atleast the START_VA has been specified. If not, ! terminate expansion here with an error. !- %IF %NULL (start_va) %THEN %ERRORMACRO ('_UNLOCK_CODE - Starting virtual address not specified') %FI !+ ! Start a local block so that the local quadword may be allocated. !- BEGIN !+ ! LOCAL STORAGE: ! ! RANGE_QUAD Quadword containing the range of virtual ! pages to be unlocked. !- LOCAL __range_quad : VECTOR [2, LONG]; !+ ! Fill in the range quadword. Note that if END_VA is not specified ! then only the START_VA page will be unlocked. !- __range_quad [0] = start_va; __range_quad [1] = %IF %NULL (end_va) %THEN start_va %ELSE end_va %FI ; !+ ! Unlock the specified range of pages and make the return value of ! $ULWSET the value of this inner block. !- $ulwset (inadr = __range_quad) END %; %sbttl '_FACILITY_PSECT - ' MACRO _facility_psect (facility) = !+ ! ! FUNCTIONAL DESCRIPTION: ! ! This macro expands to a PSECT declaration that is used to provide ! specific PSECT names and attributes to all storage related to a ! facility. This macro is provided to encourage a standardized ! PSECT naming convention to facility PSECT arrangement. This will ! facilitate things such a code locking for elevated IPL processing. ! ! The PSECT names are of the form: ! facility_storage-type ! All %REMAINING arguments will be tacked on to each storage type ! PSECT declaration as an attribute list. For example, suppose ! a facility of PIC, non-writable code is contained in a facility ! with the prefix ABC: ! _FACILITY_PSECT (ABC,PIC,NOWRITE); ! This would expand to: ! PSECT ! CODE = ABC_CODE(PIC,NOWRITE), ! GLOBAL = ABC_GLOBAL(PIC,NOWRITE), ! OWN = ABC_OWN(PIC,NOWRITE), ! PLIT = ABC_PLIT(PIC,NOWRITE); ! ! CALLING SEQUENCE: ! ! _FACILITY_PSECT ( FACILITY [,attribute-list] ) ! ! FORMAL PARAMETERS: ! ! FACILITY Prefix of facility name. ! ATTRIBUTE-LIST List of PSECT attributes to be applied to ! each storage type. ! !- !+ ! Make sure that a facility prefix has been specified. !_ %IF %NULL (facility) %THEN %ERRORMACRO ('_FACILITY_PSECT - Facility prefix must be specified') %FI !+ ! Define each storage type to be in PSECT prefix_xxxx with the ! specified PSECT attributes. !- PSECT CODE = %NAME (facility, _code) %IF NOT %NULL (%REMAINING) %THEN ( %REMAINING ) %FI , GLOBAL = %NAME (facility, _global) %IF NOT %NULL (%REMAINING) %THEN (%REMAINING) %FI , OWN = %NAME (facility, _own) %IF NOT %NULL (%REMAINING) %THEN (%REMAINING) %FI , PLIT = %NAME (facility, _plit) %IF NOT %NULL (%REMAINING) %THEN (%REMAINING) %FI %; MACRO _label = !+ ! ! FUNCTIONAL DESCRIPTION: ! ! This macro expands to a structure attribute to bind a name to a ! label. The label is declared as a longword vector of 0 length. ! ! Since the compiler controls allocation within PSECTs, this macro is ! only useful when it is bound to an OWN storage name and is the only ! declaration within a PSECT. ! ! This macro is used in conjuction with PSECT ordering to determine ! the size and position of a particular group of PSECTs. Thus, the ! needed information is available to lock code for such things as ! IPL jumps. ! ! CALLING SEQUENCE: ! ! _LABEL ! ! FORMAL PARAMETERS: ! ! None. ! !- VECTOR [0, LONG] %; !+ ! ! FUNCTIONAL DESCRIPTION: ! ! This macro will allow us to call a routine in kernel mode and pass any number ! of arguments. ! ! An argument block is built and filled in if any arguments are supplied ! ! CALLING SEQUENCE: ! ! _KERNEL_CALL ( ROUTINE [, ARG1] [,ARG2] [,ARG3] ... ) ! ! FORMAL PARAMETERS: ! ! A routine must be specified, and any arguments are optional ! !- MACRO _kernel_call (r) = BEGIN EXTERNAL ROUTINE sys$cmkrnl : ADDRESSING_MODE (GENERAL); LOCAL arg_block : VECTOR [%LENGTH, LONG] INITIAL (%LENGTH - 1 %IF %LENGTH GTR 1 %THEN , %REMAINING %FI ); $cmkrnl (routin = r, arglst = arg_block) END %; !+ ! ! FUNCTIONAL DESCRIPTION: ! ! This macro will allow us to call a routine in exec mode and pass any number ! of arguments. ! ! An argument block is built and filled in if any arguments are supplied ! ! CALLING SEQUENCE: ! ! _EXEC_CALL ( ROUTINE [, ARG1] [,ARG2] [,ARG3] ... ) ! ! FORMAL PARAMETERS: ! ! A routine must be specified, and any arguments are optional ! !- MACRO _exec_call (r) = BEGIN EXTERNAL ROUTINE sys$cmexec : ADDRESSING_MODE (GENERAL); LOCAL arg_block : VECTOR [%LENGTH, LONG] INITIAL (%LENGTH - 1 %IF %LENGTH GTR 1 %THEN , %REMAINING %FI ); $cmexec (routin = r, arglst = arg_block) END %; MACRO _invalid_tb (address) = BEGIN BUILTIN MTPR; %IF %IDENTICAL (address, all) %THEN MTPR (%REF (0), pr$_tbia) %ELSE MTPR(%REF (address), pr$_tbis) %FI ; END %; MACRO _jump (lab) = BEGIN LINKAGE __jump = INTERRUPT; EXTERNAL ROUTINE b32_jump : __jump NOVALUE; b32_jump (lab); END %; MACRO _outf (control, maxlen) [] = BEGIN EXTERNAL ROUTINE cvt_out_format; BIND __control = UPLIT (WORD (%CHARCOUNT (control)), BYTE (dsc$k_dtype_t, dsc$k_class_s), UPLIT (control)); cvt_out_format (__control, ( %IF %NULL (maxlen) %THEN 80 %ELSE maxlen %FI ), %REMAINING) END %; MACRO _enable_mmg = BEGIN BUILTIN MTPR; MTPR (%REF (1), pr$_mapen); END %; MACRO _disable_mmg = BEGIN BUILTIN MTPR; MTPR (%REF (0), pr$_mapen); END %; MACRO _enable_cache = BEGIN BUILTIN MTPR; MTPR (%REF (0), pr$_cadr); END %; MACRO _disable_cache = BEGIN BUILTIN MTPR; MTPR (%REF (1), pr$_cadr); END %; MACRO _ascii (string_arg) = %QUOTE %ASCII string_arg %; MACRO _asciz (string_arg) = %QUOTE %ASCIZ string_arg %; MACRO _ascic (string_arg) = %QUOTE %ASCIC string_arg %; MACRO _ascid (string_arg) = %QUOTE %ASCID string_arg %; MACRO _severity_level (status) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This macro extracts the severity level from the supplied condition code ! and then remaps the severity level such that algabraic comparasions can ! be made. ! ! FORMAL PARAMETERS: ! ! STATUS condition code ! ! IMPLICIT INPUTS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! EXPANSION VALUE: ! ! Returns the severity level of a condition value modified so that a ! binary comparision yields the normal order of importance/severity. ! Undefined (as of the date of the writing of this macro) severity levels ! are included so as to maintain compatability with all future versions ! of VMS. ! ! Severity Original Value Returned Value ! success 1 0 ! infomational 3 1 ! (undefined) 5 2 ! (undefined) 7 3 ! warning 0 4 ! error 2 5 ! severe/fatal 4 6 ! (undefined) 6 7 ! ! SIDE AFFECTS: ! ! None. ! !-- !+ ! Check (at compile time) that the definition of the severity field in ! a condition value is consistant with this macro. That is, that the ! success bit is the low order bit in the severity field. !- %IF ($byteoffset (sts$v_severity) NEQU $byteoffset (sts$v_success)) OR ($bitposition ( sts$v_severity) NEQU $bitposition (sts$v_success)) OR ($fieldwidth (sts$v_success) NEQU 1) %THEN %ERROR ( 'Definition of either STS$V_SEVERITY or STS$V_SUCCESS not compatible with macro expansion' ) %FI BEGIN LOCAL condition_code; !+ ! Make a local copy of the condition value. This is done since in some ! cases the condition value passed will be a constant. !- condition_code = status; !+ ! Convert the passed value into the returned value by right justifying ! the severity field (less the success field) and subtracting the ! success bit (after shifting left by the size of the severity field. !- .condition_code<$bitposition (sts$v_success) + $fieldwidth (sts$v_success), $fieldwidth (sts$v_severity) - $fieldwidth (sts$v_success), 0> + ((1 - .condition_code< $bitposition (sts$v_success), $fieldwidth (sts$v_success), 0>)^($fieldwidth ( sts$v_severity) - $fieldwidth (sts$v_success))) END %; MACRO _bitoff [dum1, off, dum2, dum3] = off %; MACRO _bitname (fac) [suffix] = %NAME (fac, v_, suffix) %; MACRO _minbitoff (fac) = MIN _bitoff _bitname (fac, %REMAINING) %; MACRO _maxbitoff (fac) = MAX _bitoff _bitname (fac, %REMAINING) %; MACRO __bithash (fac) [suffix, value] = [_bitoff _bitname(fac, suffix) ] = value %; MACRO _bithash (slots, alloc) = VECTOR [slots, alloc]PRESET __bithash (%REMAINING) %; MACRO __itemlst [item, length, pointer, size] = [%COUNT, item_w_code] = item, ! [%COUNT, item_w_length] = length, ! [%COUNT, item_a_pointer] = pointer, ! [%COUNT, item_a_size] = size ! %; MACRO _itemlst (slots) = BLOCKVECTOR [slots + 1, item_k_bln, BYTE] ! PRESET __itemlst (%REMAINING, 0, 0, 0, 0) %; MACRO _block [fac] = MACRO %NAME (_, fac) = BLOCK [%NAME (fac, _k_length), BYTE] %QUOTE %; MACRO %NAME (_alloc_, fac) (pointer) = BEGIN EXTERNAL ROUTINE lib$get_vm; lib$get_vm (%REF (%NAME (fac, _k_length)), pointer) END %QUOTE %; MACRO %NAME (_free_, fac) (pointer) = BEGIN EXTERNAL ROUTINE lib$free_vm; lib$free_vm (%REF (%NAME (fac, _k_length)), pointer) END %QUOTE %; %; %sbttl '_PUSH - ' MACRO _push (head, ent) = BEGIN BUILTIN INSQUE; MAP head : _queue_header (); INSQUE (ent, .head [que_k_flink]) END %; %sbttl '_POP - ' MACRO _pop (head, ent) = BEGIN BUILTIN REMQUE; MAP head : _queue_header (); REMQUE (.head [que_k_flink], ent) END %; %sbttl '_IOSB - ' MACRO _iosb = BLOCK [iosb_k_length, BYTE] %; %SBTTL '_INCR - Increments a field' !+ ! Adds one to a field. !- MACRO _incr (dst) = (dst = .dst + 1) %; %SBTTL '_DECR - Decrements a field' !+ ! Subtracts one from a field. !- MACRO _decr (dst) = (dst = .dst - 1) %; %SBTTL '_INIT_QUEUE - Initializes a queue header to empty' !+ ! Initializes a queue header to empty. !- MACRO _init_queue (qhd) = BEGIN BIND qhead = qhd : VECTOR [, LONG]; qhead [0] = qhead [0]; qhead [1] = qhead [0]; END %;