Trailing-Edge
-
PDP-10 Archives
-
BB-L054E-RK
-
apxpsi.b36
There is 1 other file named apxpsi.b36 in the archive. Click here to see a list.
MODULE APXPSI (
LANGUAGE(BLISS36),
ENTRY (
PS_INIT
)
) =
BEGIN
!
! COPYRIGHT (c) 1981, 1982 BY
! Digital Equipment Corporation, Maynard, MA.
!
! 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: Autopatch Exec Product Specific Initialization Routines
!
! ABSTRACT:
!
! This module contains routines that will be executed during
! SELECT processing. It also contains a table, INI_LIST,
! that is keyed by product code to a specific routine.
! During SELECT processing, the routine PS_INIT will be
! called after the product descriptor is set up. If INI_LIST
! contains an entry for the product being SELECTed, a
! dispatch is made to the associated routine. If there is no
! entry in the table, PS_INIT returns. This enables optional
! product-specific processing (e.g. renaming files or
! altering the description as obtained from the Product
! Description File) to be done automatically when the product
! is SELECTed.
!
! When routines are added to this module, a corresponding
! entry must be made in INI_LIST.
!
!
! ENVIRONMENT: TOPS-20 / TOPS-10
!
! AUTHOR: Donald R. Brandt, CREATION DATE: 5 February 1981
!
! MODIFIED BY:
!
! Revision history follows
!
!--
!
! Edit History for APXPSI
!
! 067 by ESB on 4-May-82
! Remove original product specific code for DBMS. Add new routines
! for COBOL-20-V12B and DBMS-20-V6.
!
! 073 by ESB on 13-Jul-82
! Add component 68274 to product specific initialization routine
! for COBOL.
!
! 104 by HAH on 11-JUL-83
! Change DBMS product specific initialization to accomodate FORTRAN-20-V7.
!
! 105 by HAH on 5-AUG-83
! Add product specific initialization for FORTRAN-20-V7.
! Remove product specific initialization for DBMS-20-V6.
!
! 111 by RBW on 29-AUG-83
! Prompt user about multiseg-compiler usage and perform necessary
! processing (TOPS10 only). This is accomplished by including
! macros from file PSIMAC.L36.
!
! 117 by RBW on 8-DEC-83
! Add routine DEC2V3_INI to do product specific initialization for
! DECNET-20-V3.
GLOBAL BIND EDTPSI = %O'117' ; ! Edit level of this module
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
PS_INIT,
CHANGE_NAME:NOVALUE, ! [117] for DECNET-20-V3
DEC2V3_INI, ! [117] for DECNET-20-V3
CBL12B_INI, ! For COBOL-20-V12B
FTN207_INI ; ! [105] For FORTRAN-20-V7
! [105] DB20V6_INI ; ! For DBMS-20-V6
!
! INCLUDE FILES:
!
LIBRARY 'BLI:TENDEF' ; !PDP-10 Definitions
LIBRARY 'BLI:MONSYM' ; !TOPS-20 Monitor Symbols
LIBRARY 'APEX' ; !APEX definitions
LIBRARY 'BLSPAR' ; !BLISS parser macros
! REQUIRE 'DEBUG.R36' ; !Debugging macros
LIBRARY 'DEBUG' ;
LIBRARY 'PSIMAC' ; !Product specific macros [111]
!
! EXTERNAL REFERENCES:
!
GLOBAL BIND EDTAPX = APEX_EDT ; ! Edit level of APEX.R36
!
! The BLISS interface routines to the GALAXY library
! These are defined in BLSGLX.B36
!
EXTERNAL ROUTINE $PARSE ; ![117]
EXTERNAL ROUTINE $PRFLD ; ![117]
EXTERNAL ROUTINE $FMT$FD ; ![117]
EXTERNAL ROUTINE $K_SOUT ; !String output routine
EXTERNAL ROUTINE $M_GMEM ; !Memory allocation routine
EXTERNAL ROUTINE $M_RMEM ; !Memory deallocation routine
EXTERNAL ROUTINE $FMT$NUM ; !Format number
!
! APEX support routines
!
EXTERNAL ROUTINE GET_YES_NO ; !Get YES or NO response
EXTERNAL ROUTINE GET_VALUE ; !Get item value from TBLUK table
EXTERNAL ROUTINE T_DELETE ; !Delete entry in a table
EXTERNAL ROUTINE T_ENTER ; !Make entry in a table
EXTERNAL ROUTINE T_LOOKUP ; !Lookup entry in a table
!
! EQUATED SYMBOLS:
!
!
! Define parameter values for compilation
!
LITERAL
INI_LIST_SZ = 3 ;![117]2=>3 ! Size of TBLUK portion of INI_LIST
! (does not include header)
!
! Make forward reference for tables
! note allocation is # entries + 1
!
FORWARD
INI_TBLUK: VECTOR[ini_list_sz + 1] ;
!
! OWN STORAGE:
!
!
! INI_LIST contains entries for those products requiring
! specialized processing during the standard SELECT
! processing. Entries in INI_LIST have a key that is the
! product code and a value that is the address of a dispatch
! routine. Entries must be in alpha order by key, and these
! keys must correspond to the product codes given in the
! Product Description File.
!
OWN
INI_LIST: DTABLE$$(INI_TBLUK), ! Initialization Dispatch List
INI_TBLUK: $KEYTAB((
('CBL12B',CBL12B_INI),
! [105] ('DB20V6',DB20V6_INI))) ;
('DEC2V3',DEC2V3_INI), ![117]
('FTN207',FTN207_INI))) ; ![105]
GLOBAL ROUTINE PS_INIT(product) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Here to determine if additional processing is required for
! a particular product when the product is SELECTed.
!
! FORMAL PARAMETERS:
!
! product:
! the address of the product descriptor (PRODUCT$$)
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no entry is in the table for this product.
! (See below)
!
! SIDE EFFECTS:
!
! If the product has an entry in the table, control transfers
! to the specified routine, and the value returned will be
! the value of that routine.
!
!--
BEGIN
LOCAL
dispatch ;
MAP
product: REF PRODUCT$$ ;
$TRACE('Beginning','PS_INIT') ;
CK_DATATYPE(product,PRODUCT) ;
IF T_LOOKUP(ini_list,.product[PROD_CODE],dispatch)
THEN
RETURN (.dispatch) (.product)
ELSE
RETURN true ;
END ; !End of PS_INIT
ROUTINE DEC2V3_INI(product) =
! This routine created with edit 117
!
!++
! FUNCTIONAL DESCRIPTION:
!
! Here to do product specific initialization for DECNET-20-V3.
!
! FORMAL PARAMETERS:
!
! product:
! the address of the product descriptor (PRODUCT$$)
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if operation not completed successfully.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN
BIND
prompt = CH$ASCIZ(cr_lf,'What is your DECNET front-end node name? ');
LOCAL
err_msg,
err_flg,
type,
text,
count,
out_list: REF TABLE$$,
cur_file: REF FILE$$,
bak_file: REF FILE$$,
new_file: REF FILE$$,
comp_list: REF TABLE$$,
component: REF COMPONENT$$ ;
MAP
product: REF PRODUCT$$ ;
$pdb (node_ini,
pnode,
confrm);
OWN
node_ini: $init (next = pnode),
pnode: $field (next = confrm,
help = 'node name'),
confrm: $confirm();
$TRACE('Beginning','DEC2V3_INI') ;
CK_DATATYPE(product,PRODUCT) ;
comp_list = .product[PROD_COMP_LIST] ;
CK_DATATYPE(comp_list,TABLE) ;
IF T_LOOKUP(.comp_list,uplit('MCB'),component)
THEN
BEGIN
CK_DATATYPE(component,COMPONENT);
out_list = .component[comp_out_list] ;
CK_DATATYPE(out_list,TABLE);
IF T_LOOKUP(.out_list,UPLIT('MCB-SYS'),cur_file)
THEN
BEGIN
CK_DATATYPE(cur_file,FILE);
bak_file = .cur_file[FILE_BACKUP];
CK_DATATYPE(bak_file,FILE);
new_file = .cur_file[FILE_NEWEST];
CK_DATATYPE(new_file,FILE);
END
ELSE
RETURN $ERROR(F$MFP,
UPLIT(%ASCIZ'MCB-SYS file missing from '),
.product[PROD_NAME],
UPLIT(%ASCIZ'''s PDF'));
END
ELSE
RETURN $ERROR(F$MCD,
UPLIT(%ASCIZ'MCB component missing from '),.product[PROD_NAME]);
WHILE NOT $parse(node_ini,prompt,0,err_msg,err_flg) DO
tty(.err_msg);
$PRFLD(type,text,count);
change_name(.cur_file[FILE_FD], .text);
change_name(.bak_file[FILE_FD], .text);
change_name(.new_file[FILE_FD], .text);
TTY(('[Checking files for your components of '),
.product[PROD_NAME],(']')) ;
RETURN true
END ; !End of DEC2V3_INI
ROUTINE CHANGE_NAME(fd, name): NOVALUE = !This routine created in edit 117
!NOTE*** This routine is TOPS-20 specific!! It must be rewritten if DECNET is
!autopatched for TOPS-10!!!! (The FD on TOPS-10 is SIXBIT, not a string)
BEGIN
%IF %SWITCHES(TOPS20)
%THEN
LOCAL
len;
len = MIN(6,CH$DIFF(CH$FIND_CH(80,CH$PTR(.name),0),CH$PTR(.name)));
CH$COPY(
4,CH$PTR(.fd+1),
.len,ch$ptr(.name),
4,ch$ptr(uplit('.SYS')),
0,9+.len,CH$PTR(.FD+1));
.fd = (CH$ALLOCATION(.len+9)+1) ^ 18;
%ELSE
$ERROR(F$DNA,UPLIT(
'DECNET for TOPS-10 is not yet autopatchable(internal error)'))
%FI
END; !End of CHANGE_NAME
ROUTINE FTN207_INI(product) =
! This routine created with edit 105
!
!++
! FUNCTIONAL DESCRIPTION:
!
! Here to do product specific initialization for FORTRAN-20-V7.
!
! FORMAL PARAMETERS:
!
! product:
! the address of the product descriptor (PRODUCT$$)
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if operation not completed successfully.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN
LOCAL
comp_list: REF TABLE$$,
component: REF COMPONENT$$ ;
MAP
product: REF PRODUCT$$ ;
$TRACE('Beginning','FTN207_INI') ;
CK_DATATYPE(product,PRODUCT) ;
comp_list = .product[PROD_COMP_LIST] ;
CK_DATATYPE(comp_list,TABLE) ;
!
! Delete components of DBMS if it is not used with FORTRAN
!
IF NOT GET_YES_NO(S('Are you using Fortran V7 with DBMS V6? '),S('NO'))
THEN
BEGIN
IF NOT T_DELETE(.comp_list,S('DBMSF'))
THEN
RETURN false ;
END ;
TTY(('[Checking files for your components of '),
.product[PROD_NAME],(']')) ;
RETURN true
END ; !End of DB20V6_INI
! This routine eliminated by edit 105
!
%(
ROUTINE DB20V6_INI(product) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Here to do product specific initialization for DBMS-20-V6.
!
! FORMAL PARAMETERS:
!
! product:
! the address of the product descriptor (PRODUCT$$)
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if operation not completed successfully.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN
LOCAL
comp_list: REF TABLE$$,
component: REF COMPONENT$$ ;
MAP
product: REF PRODUCT$$ ;
$TRACE('Beginning','DB20V6_INI') ;
CK_DATATYPE(product,PRODUCT) ;
comp_list = .product[PROD_COMP_LIST] ;
CK_DATATYPE(comp_list,TABLE) ;
!
! Delete components of Fortran if it is not used with DBMS
!
IF GET_YES_NO(S('Are you using Fortran with DBMS V6? '),S('NO'))
THEN
BEGIN
IF GET_YES_NO(S('Are you using Fortran V7? '),S('YES'))
THEN
IF NOT T_DELETE(.comp_list,S('FORLIB'))
THEN
RETURN false ;
END
ELSE
BEGIN
IF NOT T_DELETE(.comp_list,S('FORLIB'))
THEN
RETURN false ;
IF NOT T_DELETE(.comp_list,S('DBMSF'))
THEN
RETURN false ;
IF NOT T_DELETE(.comp_list,S('FORDML'))
THEN
RETURN false ;
END ; )%
%( IF NOT GET_YES_NO(S('Are you using COBOL-68 V12B with DBMS V6? '),S('NO'))
THEN
BEGIN
IF NOT T_DELETE(.comp_list,S('LIBL68'))
THEN
RETURN false ;
END ;
IF NOT GET_YES_NO(S('Are you using COBOL-74 V12B with DBMS V6? '),S('NO'))
THEN
BEGIN
IF NOT T_DELETE(.comp_list,S('LIBL74'))
THEN
RETURN false ;
END ;
)%
%( TTY(('[Checking files for your components of '),
.product[PROD_NAME],(']')) ;
RETURN true
END ; !End of DB20V6_INI )%
ROUTINE CBL12B_INI(product) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Here to do product specific initialization for COBOL-20-V12B
!
! FORMAL PARAMETERS:
!
! product:
! the address of the product descriptor (PRODUCT$$)
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if operation not completed successfully.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN %( Routine CBL12B_INI )%
LOCAL
C68274, ! [111]
c68, ! Local storage for answers to questions
c74,
neither, comp_list: REF TABLE$$,
component: REF COMPONENT$$ ;
MULTI_SEG_FLAGS; ! [111]
MAP
product: REF PRODUCT$$ ;
$TRACE('Beginning','CBL12B_INI') ;
CK_DATATYPE(product,PRODUCT) ;
comp_list = .product[PROD_COMP_LIST] ;
CK_DATATYPE(comp_list,TABLE) ;
!
! Find out which COBOL, 68 or 74 or both. If the user says NO to both,
! then ask again.
!
C68274 = FALSE; ! [111]
neither = true ; ! Init to true so we ask at least once
WHILE .neither DO
BEGIN
INIT_M_FLAGS; ! [111]
C68 = C74 = FALSE; ! [111]
IF GET_YES_NO(S('Do you want to build COBOL-68? '),S('NO'))
THEN
BEGIN
MULTI_SEG_QUESTION(M68); ! [111]
c68 = true
END
ELSE
c68 = false ;
IF GET_YES_NO(S('Do you want to build COBOL-74? '),S('NO'))
THEN
BEGIN
MULTI_SEG_QUESTION(M74); ! [111]
c74 = true
END
ELSE
c74 = false ;
IF (.c68 OR .c74)
THEN
neither = false
ELSE
BEGIN
TTY((cr_lf,'%You must build COBOL-68 or COBOL-74 or both.',cr_lf)) ;
neither = true
END ;
END ;
!
! Process COBOL-68. If answer was NO, then delete all COBOL-68 components.
!
IF NOT .c68
THEN
DEL_CBL('68'); ! [111]
TST_M_AND_DEL(M68,'CBLM68'); ! [111]
!
! Process COBOL-74. If answer was NO, then delete all COBOL-74 components.
!
IF NOT .c74
THEN
DEL_CBL('74'); ! [111]
TST_M_AND_DEL(M74,'CBLM74'); ! [111]
IF GET_YES_NO(S('Are you using 68274 with COBOL? '),S('NO'))
THEN
BEGIN
MULTI_SEG_QUESTION(M68274); ! [111]
C68274 = TRUE; ! [111]
END; ! [111]
IF NOT .C68274 ! [111]
THEN
IF NOT T_DELETE(.COMP_LIST,S('68274'))
THEN RETURN 0;
TST_M_AND_DEL(M68274,'68M74'); ! [111]
TTY(('[Checking files for your components of '),
.product[PROD_NAME],(']')) ;
RETURN true
END ; %( Routine CBL12B_INI )%
END
ELUDOM