(********************************************************************)
(* FLMSRV1S SCLM SERVICE INTERFACE PROCEDURE DEFINITIONS *)
(* *)
(* This member is included by program FLMSRV1 *)
(* *)
(********************************************************************)
(********************************************************************)
(* SCLM START Service Interface *)
(********************************************************************)
PROCEDURE SRVSTART ( VAR appl_id : char8 ;
VAR rc : INTEGER );
FUNCTION FLMLNK ( CONST service : char8 ;
VAR appl_id : char8 ): INTEGER ;
FORTRAN ;
BEGIN
rc := FLMLNK ('START ', appl_id );
END;
(********************************************************************)
(* SCLM INIT Service Interface *)
(********************************************************************)
PROCEDURE SRVINIT ( CONST appl_id : char8 ;
CONST project : char8 ;
CONST project_def : char8 ;
VAR SCLM_id : char8 ;
VAR msg_line : char80 ;
VAR rc : INTEGER ) ;
FUNCTION FLMLNK ( CONST service : char8 ;
CONST appl_id : char8 ;
CONST project : char8 ;
CONST project_def : char8 ;
VAR SCLM_id : char8 ;
VAR msg_line : char80 ) : INTEGER ;
FORTRAN ;
BEGIN
rc := FLMLNK ('INIT ', appl_id, project, project_def, SCLM_id,
msg_line );
END;
(********************************************************************)
(* SCLM FREE Service Interface *)
(********************************************************************)
PROCEDURE SRVFREE ( CONST SCLM_id : char8 ;
VAR msg_line : char80 ;
VAR rc : INTEGER ) ;
FUNCTION FLMLNK ( CONST service : char8 ;
CONST SCLM_id : char8 ;
VAR msg_line : char80 ) : INTEGER ;
FORTRAN ;
BEGIN
rc := FLMLNK ('FREE ', SCLM_id, msg_line );
END;
(********************************************************************)
(* SCLM END Service Interface *)
(********************************************************************)
PROCEDURE SRVEND ( CONST appl_id : char8 ;
VAR msg_line : char80 ;
VAR rc : INTEGER ) ;
FUNCTION FLMLNK ( CONST service : char8 ;
CONST appl_id : char8 ;
VAR msg_line : char80 ) : INTEGER ;
FORTRAN ;
BEGIN
rc := FLMLNK ('END ', appl_id, msg_line );
END;
(********************************************************************)
(* SCLM BUILD Service Interface *)
(********************************************************************)
PROCEDURE SRVBUILD ( CONST SCLM_id : char8 ;
CONST group : char8 ;
CONST pds_type : char8 ;
CONST member : char8 ;
CONST userid : char8 ;
CONST build_scope : char24 ;
CONST build_mode : char24 ;
CONST listing_check : char24 ;
CONST breport_check : char24 ;
CONST prefix_userid : char17 ;
CONST dd_bldmsgs : char8 ;
CONST dd_bldrept : char8 ;
CONST dd_bldlist : char8 ;
CONST dd_bldexit : char8 ;
VAR rc : INTEGER ) ;
FUNCTION FLMLNK ( CONST service : char8 ;
CONST SCLM_id : char8 ;
CONST group : char8 ;
CONST pds_type : char8 ;
CONST member : char8 ;
CONST userid : char8 ;
CONST build_scope : char24 ;
CONST build_mode : char24 ;
CONST listing_check : char24 ;
CONST breport_check : char24 ;
CONST prefix_userid : char17 ;
CONST dd_bldmsgs : char8 ;
CONST dd_bldrept : char8 ;
CONST dd_bldlist : char8 ;
CONST dd_bldexit : char8 ) : INTEGER ;
FORTRAN ;
BEGIN
rc := FLMLNK ( 'BUILD ', SCLM_id, group, pds_type, member, userid,
build_scope, build_mode, listing_check, breport_check,
prefix_userid,
dd_bldmsgs, dd_bldrept, dd_bldlist, dd_bldexit );
END;
(*******************************************************************)
(* SCLM LOCK Service Interface *)
(*******************************************************************)
PROCEDURE SRVLOCK ( CONST SCLM_id : char8 ;
CONST group : char8 ;
CONST pds_type : char8 ;
CONST member : char8 ;
CONST authcode : char8 ;
CONST access_key : char16 ;
CONST userid : char8 ;
VAR found_group : char8 ;
VAR max_prom_group : char8 ;
VAR $acct_info : $acct_info_type ;
VAR $list_info : $list_info_type ;
VAR $msg_array : $msg_array_type ;
VAR rc : INTEGER ) ;
FUNCTION FLMLNK ( CONST service : char8 ;
CONST SCLM_id : char8 ;
CONST group : char8 ;
CONST pds_type : char8 ;
CONST member : char8 ;
CONST authcode : char8 ;
CONST access_key : char16 ;
CONST userid : char8 ;
VAR found_group : char8 ;
VAR max_prom_group : char8 ;
VAR $acct_info : $acct_info_type ;
VAR $list_info : $list_info_type ;
VAR $msg_array : $msg_array_type):
INTEGER ;
FORTRAN ;
BEGIN
rc := FLMLNK ( 'LOCK ', SCLM_id, group, pds_type, member, authcode,
access_key, userid,
found_group, max_prom_group,
$acct_info, $list_info, $msg_array );
END;
(*******************************************************************)
(* SCLM PARSE Service Interface *)
(*******************************************************************)
PROCEDURE SRVPARSE ( CONST SCLM_id : char8 ;
CONST group : char8 ;
CONST pds_type : char8 ;
CONST member : char8 ;
CONST language : char8 ;
CONST error_listings_only : char24 ;
CONST ddname : char8 ;
VAR $stats_info : $stats_info_type ;
VAR $list_info : $list_info_type ;
VAR $msg_array : $msg_array_type ;
VAR rc : INTEGER ) ;
FUNCTION FLMLNK ( CONST service : char8 ;
CONST SCLM_id : char8 ;
CONST group : char8 ;
CONST pds_type : char8 ;
CONST member : char8 ;
CONST language : char8 ;
CONST error_listings_only : char24 ;
CONST ddname : char8 ;
VAR $stats_info : $stats_info_type ;
VAR $list_info : $list_info_type ;
VAR $msg_array : $msg_array_type ):
INTEGER ;
FORTRAN ;
BEGIN
rc := FLMLNK ('PARSE ', SCLM_id, group, pds_type, member, language,
error_listings_only, ddname,
$stats_info, $list_info, $msg_array );
END;
(*******************************************************************)
(* SCLM STORE Service Interface *)
(*******************************************************************)
PROCEDURE SRVSTORE (CONST SCLM_id : char8 ;
CONST group : char8 ;
CONST pds_type : char8 ;
CONST member : char8 ;
CONST access_key : char16 ;
CONST language : char8 ;
CONST userid : char8 ;
CONST sub_drawdown_mode : char24 ;
CONST verify_cc : char24 ;
CONST $stats_info : $stats_info_type ;
CONST $list_info : $list_info_type ;
VAR $msg_array : $msg_array_type ;
VAR rc : INTEGER ) ;
FUNCTION FLMLNK ( CONST service : char8 ;
CONST SCLM_id : char8 ;
CONST group : char8 ;
CONST pds_type : char8 ;
CONST member : char8 ;
CONST access_key : char16 ;
CONST language : char8 ;
CONST userid : char8 ;
CONST sub_drawdown_mode : char24 ;
CONST verify_cc : char24 ;
CONST $stats_info : $stats_info_type ;
CONST $list_info : $list_info_type ;
VAR $msg_array : $msg_array_type) :
INTEGER ;
FORTRAN ;
BEGIN
rc := FLMLNK ('STORE ', SCLM_id, group, pds_type, member,
access_key, language, userid, sub_drawdown_mode,
verify_cc, $stats_info, $list_info, $msg_array );
END;
(********************************************************************)
(* Procedure to print the contents of an SCLM $msg_array. *)
(********************************************************************)
PROCEDURE PUTMSGS ( VAR $msg_array : $msg_array_type );
VAR
indx : INTEGER ;
BEGIN (* Procedure PUTMSGS *)
(* Print message header information. *)
WRITELN ('Message array information...');
(* If the pointer is valid, print the information. *)
IF
$msg_array <> NIL
THEN BEGIN
(* Loop through the list information. *)
indx := 1 ;
WHILE
$msg_array@(.indx.) <> 'END'
DO BEGIN
WRITELN ( $msg_array@(.indx.)) ;
indx := indx + 1 ;
END;
END; (* if $msg_array <> nil *)
(* Reset "$msg_array" to NIL. *)
$msg_array := NIL;
END; (* Procedure PUTMSGS *)
(*******************************************************************)
(* Procedure to copy an accounting record list information array. *)
(*******************************************************************)
PROCEDURE COPYLIST ( CONST $list_info : $list_info_type ;
VAR $list_info_copy : $list_info_type ) ;
VAR
indx : INTEGER ;
BEGIN (* Procedure COPYLIST *)
(* Only perform the copy if the input list is not nil. *)
IF
$list_info <> NIL
THEN BEGIN
(* Allocate storage for the copy list if the caller *)
(* has not yet done this. *)
IF
$list_info_copy = NIL
THEN
NEW ( $list_info_copy );
(* Loop through the list information, copying entry-by-entry. *)
indx := 1 ;
REPEAT
$list_info_copy@(.indx.) := $list_info@(.indx.) ;
indx := indx + 1 ;
UNTIL
($list_info@(.indx-1.).record_kind = 'END ')
OR
(indx > max_list_info_entries) ;
(* Check for overflow condition. *)
IF
indx > max_list_info_entries
THEN BEGIN
WRITELN ('*** ERROR *** List information array overflowed!' );
WRITELN ('*** ERROR *** Increase size of program constant.' );
END;
END; (* if $list_info <> nil *)
END; (* Procedure COPYLIST *)