MODULE PPL$CRESPINLOCK ( ADDRESSING_MODE ( EXTERNAL = GENERAL ), IDENT = 'V57-001' ) = BEGIN ! ! COPYRIGHT (c) 1986 BY ! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ! ! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ! TRANSFERRED. ! ! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ! CORPORATION. ! ! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. ! !++ ! FACILITY: ! PPL ( Parallel Processing Library ) ! ! ABSTRACT: ! ! ! ENVIRONMENT: ! ! !-- ! !++ ! ! AUTHOR: Catherine M. Fariz, CREATION DATE: (13-OCT-86) ! ! ! MODIFIED BY: ! ! Catherine M. Fariz, (13-OCT-86): VERSION 00 ! ! 01-000 - Original version ! ! 01-001 To corrct access violation for null params. CMF 19-JAN-1987 ! ! 01-002 To correct ident. CMF 26-JAN-1987 ! ! 01-003 To correct idnet to match cms res. number. CMF 26-JAN-1987 ! ! 01-004 To allow a null spin lock name. This will CMF 12-MAR-1987 ! allow users to aviod playing with name strings. ! ! 01-005 Correct param order. Now that the name is CMF 13_MAR-1987 ! optional, it sould not appear first. ! ! 01-006 Fix to allow creating anonymous objects. DLR 13-AUG-1987 ! ! V50-001 Fix for PPL$Name_Lookup returning PPL$_Normal instead of ! SS$_Normal WWS 6-Jul-1988 ! ! V50-002 Updated routine comments to reflect correct completion codes ! WWS 6-Jul-1988 ! ! V51-001 Replaced uses of CTX[CTX_L_PPLSECT_ADR] by PPL$$GL_PPLSECT ! WWS 9-Sep-1988 ! ! V53-001 Added stub for PPL$Read_Spin_Lock WWS 22-Mar-1989 ! ! V53-001 PPL$Read_Spin_Lock added HPO 21-APR-1989 ! ! V53-002 additions for ppl$delete_spin_lock HPO 30-JUN-1989 ! signal PPL$_BADLOGIC instead of returning it ! ! V53-003 Removed local declaration of ctx PJC 14-Aug-1989 ! ! V53-004 Added ppl$$condition_handler to ppl$create_ PJC 30-Nov-1989 ! spin_lock. ! ! V57-001 EVMS/Alpha Port PJC 12-Nov-1991 !-- ! ! ! TABLE OF CONTENTS: ! ! ! INCLUDE FILES: ! library 'rtlstarle'; ! System symbols library 'sys$library:xport'; undeclare %quote $descriptor; ! Clear up conflict library 'obj$:ppllib'; require 'rtlin:rtlpsect'; ! Define DECLARE_PSECTS macro ! ! FORWARD ROUTINE ! forward routine ppl$create_spin_lock, ppl$read_spin_lock; ! ! MACROS: ! ! ! EQUATED SYMBOLS: ! ! ! PSECT DECLARATIONS ! declare_psects (ppl); ! Declare psect ! ! OWN STORAGE: ! ! ! LINKAGES ! LINKAGE JSB_R0_R01 = JSB(REGISTER=0;REGISTER=0,REGISTER=1); ! ! EXTERNAL REFERENCES: ! external ppl$$gl_pplsect : ref pplsect_block, ppl$$gl_context : ref ctx_block; ! ! EXTERNAL ROUTINE ! external routine ppl$$name_lookup, ppl$$condition_handler, str$analyze_sdesc_r1 : jsb_r0_r01; %SBTTL 'ROUTINE: PPL$CREATE_SPIN_LOCK - Creates the Spin Lock Block' ! GLOBAL ROUTINE PPL$CREATE_SPIN_LOCK ( lock_id : ref vector [1], lock_name : ref $bblock ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! Creates and initializes a simple lock (a spin lock), returning ! the identifier which must be used to get and free the lock. ! The lock is initialized to 0 (not set). ! ! This form of lock is recommended for use only in a dedicated ! parallel processing environment (versus a general time-sharing ! environment), and only when fairness is not important. ! ! Should a lock of the specified name already exist, then the id ! of the lock will be returned. If the name already exists but ! the types are different, then the error status PPL$_INCOMPEXI ! will be returned. ! ! If the name supplied is null, then a new lock will be created. ! It will be the users responsibility to see that this lock ID ! is made available to other processes in the application that ! need to access it. ! ! CALLING SEQUENCE: ! ! condition-value = PPL$CREATE_SPIN_LOCK ( lock-id, [ lock-name ] ) ! ! FORMAL ARGUMENTS: ! ! LOCK-ID ! VMS USAGE : identifier ! TYPE : longword ( unsigned ) ! ACCESS : write only ! MECHANISM : by reference ! ! The user's handle on the allocated lock. This identifier must ! be used when setting or freeing the lock. ! ! LOCK-NAME ! VMS USAGE : char_string ! TYPE : character string ! ACCESS : read only ! MECHANISM : by descriptor ! ! The name of the lock as determined by the user. ! ! IMPLICIT INPUTS: ! ! The PPL$ global section and Name/Identifier List. ! ! IMPLICIT OUTPUTS: ! ! The PPL$ Name/Identifier List and the lock structure. ! ! COMPLETION CODES: ! ! PPL$_ELEALREXI An element of the same name already exists. ! ! PPL$_INCOMPEXI An incompatible kind of element with the same ! name already exists. ! ! PPL$_INVARG Invalid argument(s). ! ! ??? PPL$_INVELENAM Invalid element name, illegal character string. ! ! PPL$_INSVIRMEM Insufficient memory available for element creation. ! ! PPL$_NORMAL Normal successful completion. ! ! PPL$_NOSUCHNAME No element with the specified NAME exists. ! ! PPL$_WRONUMARG Wrong number of arguments. ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN ! ppl$create_spin_lock builtin actualcount, nullparameter; literal min_args = 1, ! Min number of arguments allowed. max_args = 2; ! Max Number of arguments allowed. local proto : slb_block, ! Proto type SLB block sem_block : ref slb_block, ! Spin Lock block sem_name : ref $bblock [dsc$c_s_bln], ! The semaphore name semname_desc: $bblock [dsc$c_s_bln], ! Semaphore name descriptor eid : unsigned long, ! Element ID status : unsigned long, ! Status ast_status : unsigned volatile long, top_flag : unsigned volatile long, mutex_flag : unsigned volatile long, mutex : unsigned volatile long; enable ! handler variables are initially zero from volatile def. ppl$$condition_handler(ast_status, top_flag, mutex_flag, mutex); !+ ! Validate parameters. !- if ( actualcount () gtr max_args ) then return ppl$_wronumarg; if ( actualcount () lss min_args ) then return ppl$_wronumarg; if nullparameter ( lock_id ) then return ppl$_invarg; !+ ! Init the prototype. !- ch$fill (0, slb_s_bln, proto[base_]); proto[csb_l_type] = ppl$k_spin_lock; proto[csb_w_csmax] = 1; !+ ! Validate the Lock Name Descriptor. !- sem_name = 0; if not nullparameter ( lock_name ) then ( semname_desc[dsc$b_dtype] = dsc$k_dtype_t; semname_desc[dsc$b_class] = dsc$k_class_s; str$analyze_sdesc_r1 ( lock_name[base_]; semname_desc[dsc$w_length], semname_desc[dsc$a_pointer] ); sem_name = semname_desc[base_]; ); verify_init_; !+ ! Need to determine if there is already an element with the same name ! in existance within the Name/ID structure. If not and there is sufficient ! memory, then the element block will be created for us. !- status = ppl$$name_lookup ( sem_name[base_], sem_block, slb_s_bln, proto); if not .status then return .status; !Presumably, we got PPL$_INSVIRMEM if .status eql ppl$_normal then ! I.e., .STATUS NEQ PPL$_CREATED ( !Something already existed -- check that it is a spin lock. if .sem_block[csb_l_type] neq ppl$k_spin_lock then return ppl$_incompexi; status = ppl$_elealrexi; ) else status = ppl$_normal; !+ ! Ensure that the EID is correctly initialized before we return. !- eid = .sem_block - ppl$$gl_pplsect[base_]; if .sem_block[csb_l_eid] neq .eid then begin if .sem_block[csb_l_eid] eql 0 then sem_block[csb_l_eid] = .eid else ppl_signal_(ppl$_badlogic); end; lock_id[0] = .eid; return .status; end; ! End of Routine PPL$CREATE_SPIN_LOCK %SBTTL 'ROUTINE: PPL$READ_SPIN_LOCK - Read the Spin Lock State' global routine ppl$read_spin_lock !++ ! FUNCTIONAL DESCRIPTION: ! ! PPL$READ_SPIN_LOCK - Read a Spin Lock State ! ! The Read a Spin Lock State routine returns the current state of the ! specified spin lock. The state can be seized or not_seized. ! ! ! FORMAL PARAMETERS: ! ( lock_id : ref vector [1], seized : ref vector [1] ) = ! ! lock-id ! VMS Usage: identifier ! type: longword (unsigned) ! access: read only ! mechanism: by reference ! ! Identifier of the specified lock. The lock-id argument is the ! address of an unsigned longword containing the identifier. ! ! ! seized ! VMS Usage: longword_unsigned ! type: longword (unsigned) ! access: write only ! mechanism: by reference ! ! Receives the state of the specified lock. The seized argument is ! the address of an unsigned longword that receives the spin lock ! state. This argument returns a value of true if the current state ! of the spin lock is seized, and returns a value of false if the ! current state of the spin lock is not_seized. ! ! ! IMPLICIT INPUTS: ! ! The Spin Lock Block. ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! COMPLETION CODES: ! ! PPL$_INVELEID Invalid element identifier. ! ! PPL$_INVELETYP Invalid element type for specified operation. ! ! PPL$_NORMAL Normal successful completion. ! ! PPL$_WRONUMARG Wrong number of arguments. ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN !ppl$read_spin_lock BUILTIN actualcount; LITERAL max_args = 2; LOCAL sem_block : ref csb_block, ! Spin Lock block status; ! Status !+ ! Validate number of parameters passed. !- if ( actualcount () neq max_args ) then return ppl$_wronumarg; !+ ! Validate the ID. !- if (ppl$$gl_context[base_] eql 0) then return ppl$_noinit; sem_block = .lock_id[0] + ppl$$gl_pplsect[base_]; if ( .sem_block[csb_l_eid] neq .lock_id[0] ) then return ppl$_inveleid; !+ ! Make sure we have the ID of a spin lock. !- if ( .sem_block[csb_l_type] neq ppl$k_spin_lock ) then return ppl$_inveletyp; !+ ! Acquire the spin lock's current state !- interlock_(sem_block[csb_v_lock]); IF (.sem_block[csb_v_delete] neq 0) THEN RETURN PPL$_INVELEID; seized[0] = .sem_block[csb_w_csval]; return ppl$_normal; END; ! End of Routine PPL$READ_SPIN_LOCK END ! End of module PPL$CRESPINLOCK ELUDOM