IDENT CPU.CPM
ENTRY CPM=
*COMMENT CPUREL - CONTROL POINT MANAGER PROCESSOR.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
TITLE CPU.CPM - CONTROL POINT MANAGER PROCESSOR.
*CALL COMCCPM
END
IDENT CPU.ECS
ENTRY REC=
ENTRY WEC=
*COMMENT CPUREL - ECS INTERPRETIVE MODE MACRO PROCESSORS.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
TITLE CPU.ECS - ECS INTERPRETIVE MODE MACRO PROCESSORS.
*CALL COMCECM
*CALL COMCECS
END
IDENT CPU.LFM
ENTRY LFM=
*COMMENT CPUREL - LOCAL FILE MANAGER PROCESSOR.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
TITLE CPU.LFM - LOCAL FILE MANAGER PROCESSOR.
*CALL COMCLFM
END
IDENT CPU.OVL
ENTRY OVL=
*COMMENT CPUREL - OVERLAY LOAD PROCESSOR.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
TITLE CPU.OVL - OVERLAY LOAD PROCESSOR.
*CALL COMCOVL
END
IDENT CPU.PFM
ENTRY PFM=
*COMMENT CPUREL - PERMANENT FILE PROCESSOR.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
TITLE CPU.PFM - PERMANENT FILE PROCESSOR.
*CALL COMCPFM
END
IDENT PF
SST
ENTRY PF
SYSCOM B1
TITLE PF - PERMANENT FILE REQUEST PROCESSOR.
*COMMENT CPUREL - PERMANENT FILE REQUEST PROCESSOR.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
SPACE 4,20
*** PF - PERMANENT FILE REQUEST PROCESSOR.
*
* S. M. HATCH. 78/04/27. (RAYTHEON)
* D. W. BOSTROM. 80/05/30.
SPACE 4,10
*** *PF* PROVIDES AN INTERFACE TO *NOS* PERMANENT FILE COMMANDS
* FOR PROGRAMS WRITTEN IN HIGHER LEVEL LANGUAGES. THE USE
* OF KEYWORDS ALLOWS THE USER TO OMIT THOSE PARAMETERS WHICH
* ARE NOT NEEDED.
SPACE 4,10
*** CALLING SEQUENCE.
*
* *FORTRAN* CALL -
*
* CALL PF(REQ,LFN,PFN,KEY(1),OPT(1),...,KEY(N),OPT(N))
*
* *SYMPL* CALL -
*
* PF(REQ,LFN,PFN,KEY(1),OPT(1),...,KEY(N),OPT(N),0);
*
* IT IS REQUIRED THAT THE LAST PARAMETER IN A *SYMPL*
* CALL BE A ZERO, IN ORDER TO TERMINATE THE PARAMETER
* LIST PROPERLY. (THIS IS NOT MANDATORY IF THE *SYMPL*
* PROGRAM EITHER CONTAINS A *CONTROL FTNCALL*, OR IS
* COMPILED WITH THE *F* OPTION.)
*
*
* THE PARAMETERS CONSIST OF ORDER DEPENDENT MANDATORY
* PARAMETERS, FOLLOWED OPTIONALLY BY ORDER INDEPENDENT
* KEYWORD PAIRED PARAMETER STRINGS. KEYWORDS AND ALL
* OTHER DISPLAY CODE PARAMETERS ARE REQUIRED TO BE LEFT
* JUSTIFIED WITH ZERO OR BLANK FILL, OR ELSE IN *FTN5*
* CHARACTER FORMAT. OPTIONAL KEYWORD PAIRS CONSIST OF
* A KEYWORD FOLLOWED BY THE VALUE TO BE ASSOCIATED WITH
* THIS KEYWORD.
*
* MANDATORY ORDER DEPENDENT PARAMETERS.
*
* REQ - PERMANENT FILE REQUEST.
* THE FOLLOWING *PFM* REQUESTS ARE SUPPORTED -
* *APPEND*, *ATTACH*, *CHANGE*, *DEFINE*, *GET*,
* *PERMIT*, *PURGE*, *REPLACE*, AND *SAVE*.
*
* LFN - LOCAL FILE NAME OR *FORTRAN* UNIT NUMBER.
* IF *LFN* IS NONZERO AND THE UPPER 42 BITS ARE
* ZERO, THEN THE LOWER 18 BITS ARE ASSUMED TO
* CONTAIN AN INTEGER. THIS INTEGER IS CONVERTED
* TO DISPLAY CODE AND PREFIXED WITH THE CHARACTERS
* "TAPE" TO YIELD A *FORTRAN* FILE NAME.
* IF *LFN* EQUALS ZERO OR IS ALL BLANKS, THEN
* *LFN* = *PFN* IS ASSUMED.
*
* PFN - PERMANENT FILE NAME.
* IF *PFN* EQUALS ZERO OR IS ALL BLANKS, THEN
* *PFN* = *LFN* IS ASSUMED.
*
* OPTIONAL KEYWORD PARAMETERS.
*
* THE FOLLOWING PARAMETERS ARE SIMILAR IN MEANING TO
* THE CORRESPONDING OPTIONS ON *NOS* PERMANENT FILE
* CONTROL CARDS AND MACROS.
*
* "AC" - ALTERNATE CATLIST PERMISSION.
* "BR" - BACKUP REQUIREMENT.
* "CT" - FILE CATEGORY.
* "M" - FILE OR USER PERMISSION MODE.
* "PN" - PACK NAME.
* "PR" - PREFERRED RESIDENCE.
* "PW" - PASSWORD.
* "R" - RESIDENCE DEVICE TYPE.
* "RT" - REAL-TIME MODE.
* "S" - SIZE IN PRU-S, IN DISPLAY CODE. DECIMAL IS
* ASSUMED UNLESS A *B* POST RADIX IS USED TO
* INDICATE OCTAL.
* "UN" - USER NUMBER.
* "XD" - EXPIRATION DATE.
* "XT" - EXPIRATION TERM.
*
* THE FOLLOWING PARAMETERS DO NOT DIRECTLY CORRESPOND
* TO ANY OPTIONS ON *NOS* PERMANENT FILE CONTROL CARDS
* OR MACROS.
*
* "EL" - ERROR MESSAGE LENGTH.
* NUMBER OF CHARACTERS TO BE RETURNED TO THE
* ERROR MESSAGE BUFFER SPECIFIED BY THE *EM*
* PARAMETER. IF THE BUFFER SPECIFIED BY *EM* IS
* A *FTN5* VARIABLE, THE VALUE USED FOR *EL* IS
* THE LENGTH OF THAT VARIABLE, AND THE *EL*
* PARAMETER IS IGNORED; OTHERWISE, THE DEFAULT
* FOR *EL* IS 10.
* "EM" - ERROR MESSAGE RETURN ADDRESS.
* THE BUFFER TO WHICH THE *PFM* ERROR MESSAGE
* WILL BE RETURNED. THE NUMBER OF CHARACTERS
* RETURNED IS DETERMINED BY THE VALUE USED FOR
* THE *EL* PARAMETER.
* "IP" - SETS THE INTERLOCK PROCESSING BIT IN THE FET.
* "IUP" - IGNORE UNNEEDED PARAMETERS.
* "NA" - INHIBITS ROLLOUT IF DIRECT FILE BUSY, AND
* PREVENTS ABORT ON ERROR CONDITIONS.
* "NF" - OPTIONAL MEANS OF SPECIFYING NEW FILE NAME
* ON *CHANGE* REQUEST. (SEE EXAMPLE BELOW.)
* "NONE" - USED TO NULLIFY SPECIFIC KEYWORDS.
* "OF" - OPTIONAL MEANS OF SPECIFYING OLD FILE NAME
* ON *CHANGE* REQUEST. (SEE EXAMPLE BELOW.)
* "RC" - RETURNS ERROR CODE IN INTEGER FORMAT AND
* PREVENTS ABORT ON ERROR CONDITIONS.
* "RRC" - RETURNS ERROR CODE IN REAL FORMAT AND
* PREVENTS ABORT ON ERROR CONDITIONS.
* "SR" - SPECIAL *PFM* REQUEST.
* = "CE" - CLEAR FILE ERROR CODE (*CHANGE*).
* = "CP" - RESET CHARGE/PROJECT NUMBERS
* (*CHANGE*).
* = "MR" - MASTER DEVICE RESIDENCE (*DEFINE*).
* = "IE" - IGNORE ERROR IDLE STATUS (ALL).
* VALID ONLY FOR *SSJ=* JOBS.
* = "FA" - FORCE FAST ATTACH OF FILE (*ATTACH*).
* VALID ONLY FOR *SSJ=* JOBS.
* = "NF" - FORCE NON-FAST ATTACH FILE (*ATTACH*).
* "SS" - SUBSYSTEM MODE OF INDIRECT FILE.
* "UC" - USER CONTROL WORD (59 BITS).
* "UP" - SETS THE USER PROCESSING BIT IN THE FET.
*
* EXAMPLES.
*
* CALL PF("GET",1,"PFILE","UN","USERNO","PW","STRING7")
* CALL PF ("DEFINE","LFILE","PFILE","CT","PU","M","W");
*
* SPECIAL FORMATS ARE USED FOR THE *CHANGE*, *PERMIT*,
* AND *PURGE* REQUESTS, E.G. -
*
* CALL PF ("CHANGE","NEWPFN","OLDPFN","BR","MD")
* CALL PF ("PERMIT","PFN","UN","USERNAM","M","R")
* CALL PF ("PURGE","PFN","RC",ERRCODE)
*
* NOTES.
*
* A KEYWORD VALUE PARAMETER IS REQUIRED TO FOLLOW EVERY
* KEYWORD, ALTHOUGH THE VALUES FOLLOWING SOME KEYWORDS,
* SUCH AS *NA* AND *RT*, ARE IGNORED.
*
* BEFORE ISSUING A *SAVE*, *REPLACE*, OR *APPEND* REQUEST
* THE USER MUST ENSURE THAT THE APPROPRIATE *CIO* BUFFER
* IS FLUSHED.
SPACE 4,10
*** ERROR PROCESSING.
*
* THE COMBINATION OF *RC*/*RRC* AND *NA* PARAMETERS USED
* DETERMINES THE TYPE OF ERROR PROCESSING DONE.
*
* 1. IF NEITHER *NA* NOR *RC*/*RRC* ARE SPECIFIED AND
* AN ERROR IS DETECTED BY PF OR *PFM*, THE ERROR
* MESSAGE IS WRITTEN TO THE USER-S DAYFILE AND THE
* PROGRAM IS ABORTED.
*
* 2. IF THE KEYWORD *RC*/*RRC* IS SPECIFIED AND AN
* ERROR OCCURS, THE *PFM* ERROR CODE IS PLACED
* IN THE APPROPRIATE RETURN CODE PARAMETER(S). A
* ZERO VALUE INDICATES SUCCESSFUL COMPLETION, AND
* A NEGATIVE VALUE IMPLIES A CALL ARGUMENT ERROR.
*
* 3. IF THE KEYWORD *NA* IS SPECIFIED AND THE *PFM*
* FUNCTION FAILS, CONTROL RETURNS TO THE CALLING
* PROGRAM, AFTER PLACING THE PF ERROR CODE IN THE
* *RC*/*RRC* PARAMETER (IF SPECIFIED) OR ISSUING
* A DAYFILE MESSAGE.
*
* 4. IF *NA* IS NOT SPECIFIED, AN *ATTACH* REQUEST FOR
* A DIRECT ACCESS FILE WHICH IS CURRENTLY BUSY WILL
* CAUSE THE JOB TO BE ROLLED OUT UNTIL THE FILE
* BECOMES AVAILABLE.
SPACE 4,10
*** DAYFILE MESSAGES.
*
* * PF NO.-1 INVALID PARAMETER - UNPAIRED.*
* A KEYWORD NOT FOLLOWED BY A KEYWORD VALUE WAS
* ENCOUNTERED.
*
* * PF NO.-1 INVALID PARAMETER - XXXXXXX.*
* AN INVALID KEYWORD OR KEYWORD VALUE WAS ENCOUNTERED.
*
* * PF NO.-XX CCCC...CCCC.*
* ERROR CODE AND MESSAGE RETURNED BY *PFM*.
SPACE 4,10
TITLE MACRO DEFINITIONS.
* COMMON DECKS.
*CALL COMCMAC
*CALL COMSMSP
*CALL COMSPFM
PVALID SPACE 4,10
** PVALID - GENERATE EQUIVALENCES FOR PARAMETER VALIDATION.
*
* SYM PVALID (REQ1,REQ2,...,REQN)
*
* ENTRY *SYM* = SYMBOL TO REPRESENT VALID USES OF A
* PARAMETER.
* *REQ* = A *PFM* REQUEST FOR WHICH THE PARAMETER
* IS VALID. THE SYMBOL *CC_REQ* MUST BE
* DEFINED IN *COMSPFM*.
*
* NOTE THE VALUE OF *SYM* IS GENERATED BY SETTING A BIT
* CORRESPONDING TO EACH REQUEST SPECIFIED.
PURGMAC PVALID
MACRO PVALID,SYM,REQ
MACREF PVALID
SYM SET 0
IRP REQ
REQ DECMIC CC_REQ-1
SYM SET SYM+1S"REQ"
PVALID ENDM
SPACE 4,10
ECHO 1,SYM=(CLLF,CLNA,CLNO,CLPF,CLPN,CLRC,CLRS,CLEM,CLIU)
SYM PVALID (SV,GT,PG,PM,RP,AP,DF,AT,CG)
CLAC PVALID (SV,DF,CG)
CLBR PVALID (SV,DF,CG)
CLCT PVALID (SV,DF,CG)
CLIP PVALID (SV,GT,PG,PM,RP,AP,DF,AT,CG)
CLMD PVALID (SV,RP,DF,AT,CG,PM)
CLNF PVALID (CG)
CLOF PVALID (CG)
CLPR PVALID (SV,DF,CG)
CLPW PVALID (SV,GT,PG,RP,AP,DF,AT,CG)
CLRT PVALID (GT,AP,AT)
CLSP PVALID (DF)
CLSR PVALID (SV,GT,PG,PM,RP,AP,DF,AT,CG)
CLSS PVALID (SV,RP,CG)
CLUC PVALID (SV,GT,RP,CG,DF,AT)
CLUN PVALID (GT,PG,RP,AP,AT,PM)
CLUP PVALID (SV,GT,PG,PM,RP,AP,DF,AT,CG)
CLXD PVALID (SV,PM,DF,CG)
CLXT PVALID (SV,PM,DF,CG)
TREQ TITLE TABLE DEFINITIONS.
TREQ SPACE 4,10
** TREQ - TABLE OF PERMANENT FILE REQUEST CODES.
*
*T 42/7LCOMMAND,18/CODE
TREQ BSS 0
VFD 42/0LSAVE,18/CCSV SAVE
VFD 42/0LGET,18/CCGT GET
VFD 42/0LPURGE,18/CCPG PURGE
VFD 42/0LPERMIT,18/CCPM PERMIT
VFD 42/0LREPLACE,18/CCRP REPLACE
VFD 42/0LAPPEND,18/CCAP APPEND
VFD 42/0LDEFINE,18/CCDF DEFINE
VFD 42/0LATTACH,18/CCAT ATTACH
VFD 42/0LCHANGE,18/CCCG CHANGE
TREQL CON 0
TOPT SPACE 4,10
** TOPT - TABLE OF PERMANENT FILE ACCESS OPTIONS.
*
*T 12/OPTION,12/VALID,6/WORD,6/LBIT,6/LENGTH,18/TABLE
*
* OPTION = PF OPTION IN DISPLAY CODE. FOR KEYWORDS LONGER
* THAN TWO CHARACTERS, ONLY THE FIRST TWO
* CHARACTERS ARE USED.
* VALID = FIELD INDICATING VALID USES OF THIS PARAMETER,
* DEFINED USING THE *PVALID* MACRO.
* WORD = WORD IN *FET* CONTAINING THE FIELD TO BE SET.
* LBIT = LOWER BIT OF THE FIELD IN THE *FET*.
* LENGTH = LENGTH OF THE *FET* FIELD IN BITS.
* TABLE = ADDRESS OF TABLE, IF ANY, GIVING PERMISSABLE
* VALUES FOR THIS OPTION.
* = 0, INDICATES THAT THE VALUE SPECIFIED IS NOT
* VALIDATED BY PF.
* = 1, INDICATES THAT THE VALUE IS TO BE CONVERTED
* FROM DISPLAY CODE TO BINARY.
* = 2, INDICATES THAT THE VALUE SPECIFIED FOR THIS
* OPTION IS IGNORED.
* = 3, INDICATES THAT ENTIRE PARAMETER DESCRIPTION FOR
* PARAMETER IS SAVED, TO BE PROCESSED INDIVIDUALLY.
* = 4, INDICATES THAT THE VALUE SPECIFIED FOR THIS
* OPTION IS A RETURN ADDRESS.
* = NEGATIVE VALUE, INDICATES THAT THIS IS THE
* COMPLEMENT OF AN ADDRESS FOR A SPECIAL
* VALIDATION ROUTINE.
TOPT BSS 0
VFD 12/0LAC,12/CLAC,6/CFAP,6/46,6/02,18/TBAC
VFD 12/0LBR,12/CLBR,6/CFBR,6/54,6/03,18/TBRQ
VFD 12/0LCT,12/CLCT,6/CFCT,6/06,6/06,18/TCAT
VFD 12/0LEL,12/CLEM,6/CFEL,6/00,6/18,18/1
VFD 12/0LEM,12/CLEM,6/CFEM,6/00,6/18,18/3
VFD 12/0LIP,12/CLIP,6/0001,6/42,6/01,18/2
VFD 12/0LIU,12/CLIU,6/CFIU,6/00,6/60,18/4
VFD 12/0LLF,12/CLLF,6/CFSN,6/18,6/42,18/0
VFD 12/0LM,012/CLMD,6/CFMD,6/00,6/06,18/TMOD
VFD 12/0LNA,12/CLNA,6/CFNA,6/00,6/60,18/2
VFD 12/0LNF,12/CLNF,6/CFNF,6/18,6/42,18/0
VFD 12/0LNO,12/CLNO,6/CFNO,6/00,6/60,18/2
VFD 12/0LOF,12/CLOF,6/CFSN,6/18,6/42,18/0
VFD 12/0LPF,12/CLPF,6/CFPN,6/18,6/42,18/0
VFD 12/0LPN,12/CLPN,6/CFPK,6/18,6/42,18/0
VFD 12/0LPR,12/CLPR,6/CFPR,6/57,6/03,18/TPRS
VFD 12/0LPW,12/CLPW,6/CFPW,6/18,6/42,18/0
VFD 12/0LR,012/CLRS,6/0001,6/48,6/12,18/-PRD
VFD 12/0LRC,12/CLRC,6/CFRC,6/00,6/60,18/4
VFD 12/0LRR,12/CLRC,6/CFRR,6/00,6/60,18/4
VFD 12/0LRT,12/CLRT,6/0001,6/43,6/01,18/2
VFD 12/0LS,012/CLSP,6/CFOU,6/00,6/24,18/1
VFD 12/0LSR,12/CLSR,6/CFCT,6/12,6/06,18/TSRQ
VFD 12/0LSS,12/CLSS,6/CFSS,6/48,6/06,18/TSUB
VFD 12/0LUC,12/CLUC,6/CFCW,6/00,6/60,18/4
VFD 12/0LUN,12/CLUN,6/CFOU,6/18,6/42,18/0
VFD 12/0LUP,12/CLUP,6/0001,6/45,6/01,18/2
VFD 12/0LXD,12/CLXD,6/CFNF,6/0,6/18,18/-PXD
VFD 12/0LXT,12/CLXT,6/CFNF,6/0,6/18,18/-PXT
VFD 60/0
TBAC SPACE 4,10
** TBAC - TABLE OF ALTERNATE CATLIST PERMISSIONS.
*
*T 42/PERMISSION,18/CODE
TBAC BSS 0
VFD 42/0LN,18/ACNO ALTERNATE CATLIST NOT PERMITTED
VFD 42/0LY,18/ACYS ALTERNATE CATLIST PERMITTED
VFD 60/0
TBRQ SPACE 4,10
** TBRQ - TABLE OF BACKUP REQUIREMENT TYPES.
*
*T 42/REQUIREMENT,18/CODE
TBRQ BSS 0
VFD 42/0LN,018/BRNO NO BACKUP REQUIRED
VFD 42/0LY,018/BRAL BACKUP ALWAYS REQUIRED
VFD 42/0LMD,18/BRMD MEDIA DEPENDENT
VFD 60/0
TCAT SPACE 4,10
** TCAT - TABLE OF PERMANENT FILE CATEGORY TYPES.
*
*T 42/CATEGORY,18/CODE
TCAT BSS 0
VFD 42/0LPRIVATE,18/FCPR+40B PRIVATE
VFD 42/0LSPRIV,0018/FCSP+40B SEMI-PRIVATE
VFD 42/0LPUBLIC,018/FCPB+40B PUBLIC
VFD 42/0LP,00000018/FCPR+40B PRIVATE
VFD 42/0LS,00000018/FCSP+40B SEMI-PRIVATE
VFD 42/0LPU,0000018/FCPB+40B PUBLIC
VFD 60/0
TMOD SPACE 4,10
** TMOD - TABLE OF PERMANENT FILE PERMISSION TYPES.
*
*T 42/ACCESS,18/CODE
TMOD BSS 0
VFD 42/0LWRITE,0018/PTWR+40B WRITE
VFD 42/0LREAD,00018/PTRD+40B READ
VFD 42/0LAPPEND,018/PTAP+40B APPEND
VFD 42/0LEXECUTE,18/PTEX+40B EXECUTE
VFD 42/0LNULL,00018/PTNU+40B NULL
VFD 42/0LMODIFY,018/PTMD+40B MODIFY
VFD 42/0LREADMD,018/PTRM+40B READ ALLOW MODIFY
VFD 42/0LREADAP,018/PTRA+40B READ ALLOW APPEND
VFD 42/0LUPDATE,018/PTUP+40B UPDATE
VFD 42/0LREADUP,018/PTRU+40B READ ALLOW UPDATE
VFD 42/0LW,00000018/PTWR+40B WRITE
VFD 42/0LR,00000018/PTRD+40B READ
VFD 42/0LA,00000018/PTAP+40B APPEND
VFD 42/0LE,00000018/PTEX+40B EXECUTE
VFD 42/0LN,00000018/PTNU+40B NULL
VFD 42/0LM,00000018/PTMD+40B MODIFY
VFD 42/0LRM,0000018/PTRM+40B READ ALLOW MODIFY
VFD 42/0LRA,0000018/PTRA+40B READ ALLOW APPEND
VFD 42/0LU,00000018/PTUP+40B UPDATE
VFD 42/0LRU,0000018/PTRU+40B READ ALLOW UPDATE
VFD 60/0
TPRS SPACE 4,10
** TPRS - TABLE OF PREFERRED RESIDENCE TYPES.
*
*T 42/PREFERENCE,18/CODE
TPRS BSS 0
VFD 42/0LL,18/RSLK LOCKED TO DISK RESIDENCE
VFD 42/0LD,18/RSDS DISK RESIDENCE PREFERRED
VFD 42/0LM,18/RSMS CARTRIDGE ALTERNATE STORAGE PREFERRED
VFD 42/0LN,18/RSNP NO PREFERENCE
VFD 42/0LT,18/RSTP TAPE ALTERNATE STORAGE PREFERRED
VFD 60/0
TRES SPACE 4,10
** TRES - TABLE OF PERMANENCE FILE RESIDENCE TYPES.
*
*T 42/DEVICE,18/CODE
TBLM SPACE 4,10
** TBLM - DEFINE MACRO TO PRODUCE *TRES* TABLE.
PURGMAC TBLM
TBLM MACRO EQ
VFD 42/0L_EQ,18/2R_EQ
TBLM ENDM
LIST G
TRES TBL "MSEQ"
VFD 60/0
LIST -G
TSRQ SPACE 4,10
** TSRQ - TABLE OF SPECIAL REQUEST TYPES.
*
*T 42/REQUEST,18/CODE
TSRQ BSS 0
VFD 42/0LCE,18/SRCE CLEAR ERROR STATUS
VFD 42/0LMR,18/SRMR FORCE MASTER DEVICE RESIDENCY
VFD 42/0LIE,18/SRIE IGNORE ERROR IDLE STATUS (*SSJ=*)
VFD 42/0LCP,18/SRCP RESET CHARGE/PROJECT NUMBERS
VFD 42/0LFA,18/SRFA FORCE FAST ATTACH OF FILE (*SSJ=*)
VFD 42/0LNF,18/SRNF FORCE NON-FAST ATTACH OF FILE
VFD 60/0
TSUB SPACE 4,10
** TSUB - TABLE OF PERMANENT FILE SUBSYSTEM TYPES.
*
*T 42/SUBSYSTEM,18/CODE
TSUB BSS 0
VFD 42/0LNULL,00018/40B+0 NULL
VFD 42/0LBASIC,0018/40B+1 BASIC
VFD 42/0LFORTRAN,18/40B+2 FTN5
VFD 42/0LFTNTS,0018/40B+3 FTNTS
VFD 42/0LEXECUTE,18/40B+4 EXECUTE
VFD 42/0LBATCH,0018/40B+5 BATCH
VFD 60/0
SPACE 4,10
* CONSTANTS AND DATA STORAGE.
FET FILEB FET,CFLM,(FET=CFLM),(EPR)
XRCW BSS 1 ADDRESS TO RETURN USER CONTROL WORD
XRRC BSS 1 ADDRESS TO RETURN INTEGER ERROR CODE
XRRR BSS 1 ADDRESS TO RETURN REAL ERROR CODE
XRNA BSS 1 *NA* FLAG
XRIU BSS 1 IGNORE PARAMETERS RETURN ADDRESS
XREL BSS 1 ERROR MESSAGE LENGTH
XREM BSS 1 *EM* PARAMETER VALUE DESCRIPTOR
PFEC BSS 1 ADDRESS OF *PFM* ERROR CODE MESSAGES
PFMA BSS 4 ADDRESS TO RETURN *PFM* ERROR MESSAGES
NONE BSS 1 UNUSED *NONE* PARAMETER VALUE
ICTR BSS 1 IGNORED PARAMETERS COUNTER
EADR BSS 1 ERROR ADDRESS FOR IGNORED PARAMETER
CFCW EQU XRCW-FET
CFRC EQU XRRC-FET
CFRR EQU XRRR-FET
CFNA EQU XRNA-FET
CFIU EQU XRIU-FET
CFEL EQU XREL-FET
CFEM EQU XREM-FET
CFNO EQU NONE-FET
ERRNZ PTWR CODE ASSUMES *PTWR* EQUALS ZERO
ERRNZ FCPR CODE ASSUMES *FCPR* EQUALS ZERO
FET1 BSS 0 DEFAULT VALUES FOR FET+1
VFD 15/0,1/1 ERROR PROCESSING BIT
VFD 20/0,6/CFLM-5 FET LENGTH
VFD 18/FET FIRST
APLIST VFD 42/0,18/*+1S17 ADDRESS OF THE FORMAL PARAMETER LIST
TEMPA0 VFD 42/0,18/*+1S17 CONTENTS OF A0 FROM CALLING ROUTINE
ACCESS CON 0 CURRENT PERMANENT FILE REQUEST CODE
TEVENT CON 0 ROLLOUT ON TIME/EVENT DEPENDENCIES
OPTION CON 0 CURRENT OPTIONS PF *FET* CONFIGURATION
BLANKS DATA 10R
XDATE BSS 1 CURRENT DATE
XFLAG CON 0 *XD* AND *XT* PARAMETER FLAG
PF TITLE MAIN ROUTINE.
PF SPACE 4,10
** PF - MAIN ROUTINE FOR *NOS* PERMANENT FILE ACCESS.
*
* ENTRY (A1) = FWA OF FORMAL PARAMETER LIST.
*
* USES ALL (A0 PRESERVED).
*
* CALLS COD= CONVERT BINARY TO OCTAL DISPLAY.
* DXB= CONVERT DISPLAY CODE TO BINARY.
* GETFIT. GET PROGRAM *FIT* ADDRESS.
* LCP LOAD CHARACTER PARAMETER.
* ZFN ZERO FILE NAME.
*
* MACROS ABORT, MESSAGE, ROLLOUT, SYSTEM.
TRACE VFD 42/0LPF,18/PF
PF EQ *+1S17 ENTRY/EXIT
** PRE - PRESET INITIAL CONDITIONS AND STORAGE AREAS.
PRE SB1 1 INITIALIZE (B1) AS ONE
SX6 A0
SX7 A1
SA6 TEMPA0 PRESERVE (A0) FOR EXIT
SA7 APLIST
SA0 A1 SET FWA APLIST POINTER
BX6 X6-X6
SA6 XFLAG INITIALIZE *XD*/*XT* FLAG
SA6 ICTR INITIALIZE UNUSED PARAMETER COUNTER
SA6 XRIU INITIALIZE *IUP* FLAG
SA6 XRRC INITIALIZE *RC* PARAMETER
SA6 XRRR INITIALIZE *RRC* PARAMETER
SA6 XREL INITIALIZE *EL* PARAMETER
SA6 FET+CFSN
SB2 FET+2
SB3 NONE
PRE1 SA6 B2 CLEAR *FET*/MESSAGE AREA
SB2 B2+B1
NE B2,B3,PRE1 IF NOT COMPLETLY CLEAR
SA1 BLANKS
BX6 X1
SA6 PFMA BLANK FILL ERROR MESSAGE AREA
SA6 A6+B1
SA6 A6+B1
SA6 A6+B1
SX6 PFMA
SA6 FET+CFPW SET ADDRESS OF MESSAGE
SA1 FET1 RESET SECOND WORD OF FET
BX6 X1
SA6 FET+1
** REQ - PROCESS PERMANENT FILE REQUEST.
REQ SA1 A0
RJ LCP CHECK *PFM* REQUEST TYPE
RJ ZFN ZERO FILL ALPHANUMERIC
MX0 42
BX1 X6
SA2 TREQ
REQ1 ZR X2,PCE IF NOT A VALID REQUEST
BX3 X2-X1
BX3 X0*X3
BX6 -X0*X2
SA2 A2+B1
NZ X3,REQ1 IF NOT THIS TABLE ENTRY
SA6 ACCESS
SX1 X6-CCAT
ZR X1,REQ2 IF *ATTACH* REQUEST
SX1 X6-CCDF
ZR X1,REQ2 IF *DEFINE* REQUEST
SX1 X6-CCSV
ZR X1,REQ2 IF *SAVE* REQUEST
SX1 X6-CCPM
ZR X1,REQ2 IF *PERMIT* REQUEST
SX1 X6-CCRP
NZ X1,REQ3 IF NOT *REPLACE* REQUEST
REQ2 SX7 PTRD USE DEFAULT OF READ MODE
SA7 FET+CFMD
REQ3 SX1 X6-CCPG
ZR X1,PFN IF *PURGE* REQUEST
SX1 X6-CCPM
ZR X1,PFN IF *PERMIT* REQUEST
SX1 X6-CCCG
NZ X1,LFN IF NOT *CHANGE* REQUEST
MX6 42 DO NOT CHANGE PASSWORD UNLESS SPECIFIED
SA1 FET+CFPW
BX6 X6+X1
SA6 A1
SA0 A0+B1
SA1 A0
ZR X1,PCE IF NO NEW NAME DECLARED
RJ LCP
RJ ZFN ZERO FILL NEW FILE NAME
SA6 FET+CFNF
EQ PFN PROCESS PERMANENT FILE NAME PARAMETER
** LFN - PROCESS LOCAL FILE NAME/UNIT DESIGNATOR.
LFN SA0 A0+B1 GET LOCAL FILE PARAMETER
SA1 A0
ZR X1,PCE IF LFN WAS NOT DECLARED
RJ LCP
ZR X1,PFN IF LFN NOT PROGRAM FILE
MX0 42
BX2 X0*X1
NZ X2,LFN1 IF NAME DESIGNATED FILE
SA1 A0
MX0 1
BX1 X0+X1
+ RJ =YGETFIT. GET PROGRAM *FIT* ADDRESS
- VFD 12/0,18/TRACE
SA1 X1
MX0 42
BX1 X0*X1
LFN1 RJ ZFN DELETE BLANKS FROM NAME
SX1 B1
BX7 X6+X1
SA7 FET SET *FET* STATUS NOT BUSY
** PFN - PROCESS PERMANENT FILE NAME PARAMETER.
PFN SA0 A0+B1 GET PERMANENT FILE NAME
SA1 A0
ZR X1,PRO IF NO PFN SPECIFICATION
RJ LCP
RJ ZFN ZERO FILL ALPHANUMERIC
SA1 FET+CFPN
BX7 X6+X1
SA7 A1
** OPT - PROCESS OPTIONAL PARAMETERS.
OPT SA0 A0+B1
SA1 A0
ZR X1,PRO IF END OF USER OPTIONS
RJ LCP
ZR X1,PRO IF END OF USER OPTIONS
RJ ZFN
MX0 12
SA2 TOPT-1
OPT1 SA2 A2+B1
ZR X2,PCE IF NOT A VALID OPTION
BX3 X6-X2
BX3 X0*X3
NZ X3,OPT1 IF NO TABLE COMPARISION
SB2 X2
BX6 X2
SA6 OPTION
SA3 ACCESS
SB3 X3-24D
LX3 X2,-B3
PL X3,CIP IF NOT VALID KEYWORD
SA0 A0+B1
SA1 A0
ZR X1,PCE IF NOT PROPERLY PAIRED
SB4 2
NE B2,B4,OPT2 IF KEYWORD DATA NOT IGNORED
SX6 B1
EQ OPT4 IGNORE KEYWORD DATA
OPT2 BX6 X1
SB4 B4+B4
EQ B2,B4,OPT4 IF RETURN CODE ADDRESS
SB4 B4-B1
EQ B2,B4,OPT7 IF OPTION IS TYPE 3
RJ LCP
RJ ZFN ZERO FILL ALPHANUMERIC
NG B2,OPT2.1 IF SPECIAL PROCESSOR REQUIRED
ZR B2,OPT4 IF KEYWORD DATA OPTION
NE B1,B2,OPT3 IF TABLE SEARCH OPTION
SB7 B1
BX5 X6
RJ =XDXB= DISPLAY CODE TO BINARY
EQ OPT4 SET FIELD IN *FET*
OPT2.1 SB2 -B2
JP B2 JUMP TO SPECIAL COMMAND PROCESSOR
OPT3 SA1 B2
MX0 42
ZR X1,PCE IF NOT PROPERLY PAIRED
BX3 X6-X1
BX3 X0*X3
SB2 B2+B1
NZ X3,OPT3 IF NOT THIS TABLE ITEM
SX6 X1
OPT4 SA2 OPTION *FET* CONFIGURATION DATA
SB2 X2
AX2 18
MX0 -6
BX3 -X0*X2
SB3 X3 (B3) = LENGTH OF FIELD
AX2 6
BX3 -X0*X2
SB4 X3 (B4) = LOWER BIT OF FIELD
AX2 6
BX2 -X0*X2
SA2 FET+X2
NZ B2,OPT5 IF NOT LEFT JUSTIFIED
LX6 B3,X6
OPT5 SB2 B3-59 MERGE OPTION IN FIELD
MX4 0
EQ B1,B2,OPT6 IF LENGTH .EQ. 60
MX4 1
AX4 -B2 GENERATE MASK
OPT6 LX4 B4
LX6 B4
BX2 X4*X2
BX6 -X4*X6
BX6 X2+X6
SA6 A2
EQ OPT CHECK FOR NEXT OPTION
OPT7 SA2 OPTION GET FET OFFSET
AX2 30
MX0 -6
BX2 -X0*X2
SA6 FET+X2 STORE VARIABLE DESCRIPTOR WORD
EQ OPT CHECK FOR NEXT OPTION
WFA ROLLOUT TEVENT WAIT FOR FILE AVAILABILITY
** PRO - PROCESS THE PERMANENT FILE REQUEST.
PRO SA1 ICTR CHECK UNUSED PARAMETERS COUNT
ZR X1,PRO0 IF NO UNUSED PARAMETERS
SA1 XRIU
NZ X1,PRO0 IF IGNORING UNUSED PARAMETERS
SA1 EADR
EQ PCE PROCESS INVALID PARAMETER ERROR
PRO0 SA2 FET+CFSN
SA3 FET+CFPN
MX0 42
BX2 X0*X2
SA1 ACCESS FETCH REQUEST FUNCTION
NZ X2,PRO1 IF LOCAL NAME DECLARED
BX6 X0*X3 ASSUME *LFN* = *PFN*
SA6 A2
PRO1 SX2 X1-CCCG
ZR X2,PRO1.1 IF *CHANGE* COMMAND
SX2 X1-CCPM
ZR X2,PRO1.1 IF *PERMIT* COMMAND
SA2 FET+CFNF
MX6 -18
BX2 -X6*X2 EXTRACT EXPIRATION DATE
ZR X2,PRO1.1 IF NO EXPIRATION DATE
SA2 FET+CFPW
BX2 X6*X2 EXTRACT PASSWORD
ZR X2,PCE IF EXPIRATION DATE BUT NO PASSWORD
PRO1.1 SA2 XRCW CHECK FOR *UCW* OPTION
ZR X2,PRO3 IF NO USER CONTROL WORD
SX6 X1-CCSV
ZR X6,PRO2 IF SAVE *UCW* FUNCTION
SX6 X1-CCDF
NZ X6,PRO3 IF NOT *DEFINE* FUNCTION
PRO2 SA3 X2
SA6 A2 CLEAR ADDRESS OF *UCW*
MX6 1
BX6 X6+X3
SA6 FET+CFUC
PRO3 LX1 6
SYSTEM PFM,RECALL,FET,X1
SA1 XRCW
ZR X1,END IF NO USER CONTROL WORD
SA2 FET+CFUC
BX6 X2
NG X1,PRO4 IF ECS/LCM ADDRESS
SA6 X1
EQ END NOT ECS/LCM ADDRESS
PRO4 WX6 X1
** END - PROCESS ERRORS AND/OR EXIT PF ROUTINE.
END SA1 FET CHECK REQUEST COMPLETION
LX1 60-10
MX0 -8
BX6 -X0*X1
END0 SB2 X6-/ERRMSG/FBS
SA2 XRNA
NZ B2,END1 IF DIRECT FILE NOT BUSY
ZR X2,WFA IF NO *NA* OPTION PRESENT
END1 SA3 XRRC
ZR X3,END3 IF NO *RC* RETURN ADDRESS
NG X3,END2 IF ECS/LCM ADDRESS
SA6 X3
EQ END3 NOT ECS/LCM ADDRESS
END2 WX6 X3
END3 SA4 XRRR
ZR X4,END5 IF NO *RRC* RETURN ADDRESS
PX6 X6
NX6 X6
NG X4,END4 IF ECS/LCM ADDRESS
SA6 X4
EQ END5 NOT ECS/LCM ADDRESS
END4 WX6 X4
END5 ZR X6,END8 IF FUNCTION SUCCESSFUL
BX7 X3+X4
NG X6,END6 IF DETECTED CALL ERRORS
NZ X7,END8 IF RETURN CODES PRESENT
BX1 X6
RJ =XCOD= BINARY TO OCTAL DISPLAY
SA1 PCEA
MX0 42
BX1 X0*X1
BX6 -X0*X6
BX6 X1+X6
SA6 PFEC
SA1 A6
END6 MESSAGE A1,3,R USER-S DAYFILE MESSAGE
SA1 XRNA
NZ X1,END8 IF *NA* SPECIFIED
SA1 XREM
ZR X1,END7 IF *EM* PARAMETER NOT SPECIFIED
RJ MCM MOVE *PFM* ERROR MESSAGE INTO *EM*
END7 ABORT
END8 SA1 XRIU CHECK *IUP*
ZR X1,END9 IF NOT IGNORING UNUSED PARAMETERS
SA2 ICTR RETURN IGNORED PARAMETER COUNT
BX6 X2
SA6 X1
END9 SA1 XREM
ZR X1,END10 IF *EM* NOT SPECIFIED
RJ MCM MOVE *PFM* ERROR MESSAGE INTO *EM*
END10 SA2 TEMPA0 RESTORE (A0) ON ENTRY
SA0 X2
EQ PF EXIT
TITLE SUBROUTINES.
CIP SPACE 4,15
** CIP - COUNT IGNORED PARAMETERS.
*
* ENTRY (X1) = PARAMETER IGNORED (IN DISPLAY CODE).
* (A0) = ADDRESS OF CURRENT PARAMETER.
*
* EXIT (X1) = NEXT PARAMETER VALUE.
* (ICTR) INCREMENTED.
* TO *OPT* TO CHECK FOR NEXT OPTION.
* TO *PCE* IF END OF PARAMETER LIST.
*
* USES X - 1, 6.
* A - 0, 1, 6.
CIP BSS 0 ENTRY
BX6 X1 SAVE PARAMETER
SA6 EADR
SA1 ICTR REPLACE NEW VALUE
SX6 X1+B1 INCREMENT COUNTER
SA6 A1
SA0 A0+B1
SA1 A0 GET NEXT PARAMETER VALUE
ZR X1,PCE IF AT END OF PARAMETER LIST
EQ OPT CHECK FOR NEXT OPTION
LCP SPACE 4,10
** LCP - LOAD CHARACTER PARAMETER.
*
* ENTRY (X1) = PARAMETER ADDRESS.
* (B1) = 1.
*
* EXIT (X1) = PARAMETER VALUE. IF THE PARAMETER IS *FTN5*
* TYPE CHARACTER DATA, IT IS LEFT JUSTIFIED WITH
* ZERO FILL.
*
* USES X - 0, 1, 2, 3.
* A - 1, 3.
* B - 4, 5, 6.
LCP EQ *+1S17 ENTRY/EXIT
LX1 30 EXTRACT CHARACTER LENGTH
SB4 X1
ZR B4,LCP6 IF NOT *FTN5* CHARACTER DATA
LX1 6 EXTRACT CHARACTER POSITION
MX0 -6
BX3 -X0*X1
LX1 24 GET FIRST WORD OF PARAMETER
MX0 -25
LX0 -1
BX1 -X0*X1
NG X1,LCP1 IF ECS/LCM ADDRESS
SA2 X1
EQ LCP2 NOT ECS/LCM ADDRESS
LCP1 RX2 X1
LCP2 SB6 X3 (B6) = CHARACTER POSITION
SX0 B1 INCREMENT PARAMETER ADDRESS
IX1 X1+X0
MX0 0
ZR B6,LCP3 IF POSITION .EQ. ZERO
SB5 B6+B6 CALCULATE BIT POSITION OF STRING
SB6 B5+B5
SB6 B5+B6 (B6) = BIT POSITION
MX0 1 EXTRACT STRING FROM FIRST WORD
SB5 B6-B1
AX0 B5
BX2 -X0*X2
LX2 B6
LCP3 NG X1,LCP4 IF ECS/LCM ADDRESS
SA1 X1
EQ LCP5 NOT ECS/LCM ADDRESS
LCP4 RX1 X1
LCP5 BX1 X0*X1 EXTRACT STRING FROM SECOND WORD
LX1 B6
BX1 X1+X2 MERGE STRINGS
SB5 10
GE B4,B5,LCP IF LENGTH .GE. 10, RETURN
SB5 B4+B4 CALCULATE BIT LENGTH OF STRING
SB6 B5+B5
SB6 B5+B6
SB6 B6-B1 (B6) = BIT LENGTH - 1
MX2 1 ZERO FILL PARAMETER
AX2 B6
BX1 X2*X1
EQ LCP RETURN
LCP6 LX1 -30
NG X1,LCP7 IF ECS/LCM ADDRESS
SA1 X1
EQ LCP RETURN
LCP7 RX1 X1
EQ LCP RETURN
MCM SPACE 4,15
** MCM - MOVE CHARACTER MESSAGE.
*
* ENTRY (X1) = FTN5 DESCRIPTOR OF VARIABLE TO RECEIVE MESSAGE.
* BITS 47-30 = VARIABLE LENGTH, IN CHARACTERS.
* VALUE IS ZERO IF NOT CHARACTER VARIABLE.
* BITS 27-24 = BEGINNING CHARACTER POSITION,
* 0 BEING LEFTMOST CHARACTER.
* BITS 23-0 = FIRST WORD ADDRESS OF VARIABLE.
*
*
* EXIT MESSAGE MOVED TO VARIABLE.
*
* USES X - ALL.
* A - 2, 3, 4, 6.
* B - 5, 6, 7.
MCM EQ *+1S17 ENTRY/EXIT
SA2 X1 VALUE OF VARIABLE
LX1 30
SB5 X1 CHARACTER LENGTH OF VARIABLE
GT B5,B0,MCM1 IF CHARACTER LENGTH PRESENT
SA3 XREL GET CHARACTER LENGTH (*EL* PARAMETER)
SX0 B0 SET BEGINNING CHARACTER POSITION (BCP)
SB5 X3
NZ X3,MCM2 IF CHARACTER LENGTH SPECIFIED
SB5 10 SET DEFAULT CHARACTER LENGTH
EQ MCM2 CONTINUE
MCM1 LX1 6
MX0 -6
BX0 -X0*X1 BEGINNING CHARACTER POSITION
MCM2 SA3 PFMA GET *PFM* MESSAGE
SA1 BLANKS
BX1 X1-X3
ZR X1,MCM IF BLANK MESSAGE
SB6 40 MAXIMUM MESSAGE LENGTH
GT B6,B5,MCM3 IF NOT TOO LONG
SB5 B6 RESET LENGTH TO MAXIMUM
MCM3 SB6 X0 CALCULATE BIT POSITION (6*BCP)
SB7 B6+B6
SB6 B7+B7
SB6 B6+B7 BIT POSITON
SB7 60
SB6 B7-B6 SHIFT COUNT FOR MASK
SB7 B0 BCP FOR *PFM* MESSAGE
MX1 6
LX0 B6,X1 POSITION MASK FOR DESTINATION WORD
BX6 X2 ORIGINAL VALUE OF VARIABLE
SA4 BLANKS
BX4 X4*X1 SET BLANK CHARACTER
MCM4 BX5 X1*X3 GET NEW CHARACTER
BX7 X5
NZ X7,MCM5 IF NOT 00 CHARACTER
BX5 X4 REPLACE WITH BLANK
MCM5 BX6 -X0*X6 REMOVE OLD CHARACTER
LX5 B6,X5 POSITION SOURCE CHARACTER
BX6 X5+X6 ADD CHARACTER TO DESTINATION WORD
SB5 B5-B1
ZR B5,MCM9 IF DONE
LX1 -6
LX4 -6 POSITION MASKS FOR NEXT CHARACTER
NG X1,MCM7 IF END OF SOURCE WORD
MCM6 LX0 -6
NG X0,MCM8 IF END OF DESTINATION WORD
EQ MCM4 CONTINUE WITH NEXT CHARACTER
MCM7 SA3 A3+B1 FETCH NEXT SOURCE WORD
EQ MCM6 CHECK DESTINATION WORD
MCM8 SA6 A2 REPLACE UPDATED DESTINATION WORD
SA2 A2+B1 GET NEXT DESTINATION WORD
BX6 X2
EQ MCM4 CONTINUE WITH NEXT CHARACTER
MCM9 SA6 A2 REPLACE LAST DESTINATION WORD
EQ MCM RETURN
PCE SPACE 4,10
** PCE - PROCESS CALL ERROR.
*
* ENTRY (A0) = ADDRESS OF CURRENT POSITION IN PARAMETER
* LIST.
* (X1) = 0, PARAMETER NAME NOT PROVIDED.
* = NONZERO VALUE, ASSUMED TO BE THE CURRENT
* PARAMETER IN DISPLAY CODE.
*
* EXIT (X6) = -1.
* (A1) = ADDRESS OF ERROR MESSAGE.
*
* USES X - 1, 6, 7.
* A - 1, 7.
* B - NONE.
PCE NZ X1,PCE2 IF PARAMETER NAME PROVIDED
SA1 A0
ZR X1,PCE1 IF END OF PARAMETER LIST
SA1 X1
NZ X1,PCE2 IF NONZERO PARAMETER
PCE1 SA1 PCEB
PCE2 MX6 59
BX7 X1
SA7 PCEB
SA1 PCEA
EQ END0 PROCESS USER CALL ERROR
PCEA DATA 30H PF NO.-1 INVALID PARAMETER -
PCEB DATA 10H UNPAIRED.
DATA 0
PRD SPACE 4,15
** PRD - PROCESS RESIDENCE DEFINITION.
*
* ENTRY (X6) = *R* PARAMETER.
*
* EXIT TO *OPT4*.
* (X6) = VALIDATED PARAMETER.
* UNIT COUNT (IF SPECIFIED) SET INTO FET+CFPK.
*
* ERROR TO *PCE* IF ERROR ENCOUNTERED.
*
* USES X - 0, 2, 3, 6, 7.
* A - 2, 3, 7.
PRD BSS 0 ENTRY
SA2 TRES-1 TABLE OF DEVICE TYPES
MX0 -6 CONVERT UNIT COUNT
LX0 42
BX3 -X0*X6
ZR X3,PRD1 IF NO UNIT COUNT SPECIFIED
LX0 -6
BX2 -X0*X6
NZ X2,PCE IF UNIT COUNT TOO LONG
LX3 -42
SX2 X3-1R1
NG X2,PCE IF INCORRECT UNIT COUNT
SX3 X3-1R9
PL X3,PCE IF INCORRECT UNIT COUNT
SA3 FET+CFPK SET UNIT COUNT INTO FET
SX2 X2+B1
MX0 42
BX3 X0*X3
BX7 X3+X2
SA7 A3+
* SEARCH FOR DEVICE TYPE IN TABLE.
PRD1 SA2 A2+B1
MX0 12
ZR X2,PCE IF DEVICE TYPE NOT FOUND IN TABLE
BX3 X6-X2
BX3 X0*X3
NZ X3,PRD1 IF NOT THIS TABLE ITEM
SX6 X2
EQ OPT4 PUT ENTRY INTO FET
PXD SPACE 4,15
** PXD - PROCESS EXPIRATION DATE.
*
* ENTRY (X6) = *XD* PARAMETER.
* (XFLAG) = NON-ZERO IF *XD* OR *XT* ALREADY USED.
*
* EXIT TO *OPT4*.
* (X6) = VALIDATED PARAMETER.
*
* ERROR TO *PCE* IF ERROR ENCOUNTERED.
*
* USES X - 1, 2, 4, 6, 7.
* A - 2, 7.
* B - NONE.
*
* CALLS VDT.
*
* MACROS NONE.
PXD BSS 0 ENTRY
SA2 XFLAG
NZ X2,PCE IF *XD* OR *XT* ALREADY SPECIFIED
SX7 B1
SA7 A2 SET PARAMETER SPECIFIED
BX1 X6
LX6 6
SX4 X6-1R*
NZ X4,PXD1 IF NOT ASTERISK
SX6 7777B SET NO EXPIRATION DATE
EQ OPT4 PUT ENTRY IN FET
PXD1 SX2 B0
RJ VDT CONVERT DATE
NG X1,PXD2 IF DATE BEFORE TODAY
NG X6,PXD2 IF ERROR IN CONVERSION
EQ OPT4 PUT ENTRY IN FET
PXD2 BX1 X1-X1
EQ PCE PROCESS ERROR
PXT SPACE 4,20
** PXT - PROCESS EXPIRATION TERM.
*
* ENTRY (X6) = *XT* PARAMETER.
* (XFLAG) = NON-ZERO IF *XD* OR *XT* ALREADY USED.
*
* EXIT TO *OPT4*.
* (X6) = VALIDATED *XT* PARAMETER.
*
* ERROR TO *PCE* IF ERROR ENCOUNTERED.
*
* USES X - 1, 2, 4, 5, 6, 7.
* A - 2, 7.
* B - 2, 7.
*
* CALLS =XDXB=.
*
* MACROS PDATE.
PXT BSS 0 ENTRY
SA2 XFLAG
NZ X2,PCE IF *XD* OR *XT* ALREADY SPECIFIED
SX7 B1
SA7 A2 SET PARAMETER SPECIFIED
BX5 X6
LX6 6
SX4 X6-1R*
NZ X4,PXT1 IF NOT ASTERISK
SX6 7777B NO EXPIRATION DATE
EQ OPT4 PUT ENTRY IN FET
PXT1 SX2 X6-1R0
NZ X2,PXT2 IF NOT IMMEDIATE EXPIRATION
PDATE XDATE GET CURRENT DATE
SA2 XDATE
AX2 18
BX6 X2
EQ OPT4 PUT ENTRY IN FET
PXT2 SB7 B1
RJ =XDXB= CONVERT TO BINARY
NZ X4,PXT3 IF ERROR IN CONVERSION
SB2 X6-7777B
GT B2,PXT3 IF EXPIRATION TERM IS TOO LARGE
EQ OPT4 PUT ENTRY IN FET
PXT3 BX1 X1-X1
EQ PCE PROCESS ERROR
ZFN SPACE 4,10
** ZFN - DELETE TRAILING BLANKS FROM WORD.
*
* ENTRY (X1) = WORD TO DELETE BLANKS FROM (LEFT JUSTIFIED).
*
* EXIT (X6) = WORD WITH TRAILING BLANKS DELETED.
*
* USES X - 0, 2, 3, 6.
ZFN EQ *+1S17 ENTRY/EXIT
SX0 1R BLANK CHARACTER
MX2 -6
BX6 X1
ZFN1 BX3 -X2*X6
ZR X3,ZFN2 IF ZERO CHARACTER
BX3 X3-X0 CHECK FOR BLANK
NZ X3,ZFN IF NOT *00* OR * *
ZFN2 BX6 X2*X6 CLEAR BLANK
LX2 6
LX0 6
NZ X6,ZFN1 IF NOT END OF WORD
EQ ZFN RETURN
SPACE 4,10
* COMMON DECKS.
*CALL COMCDXB
*CALL COMCVDT
SPACE 4,10
END
IDENT GETPAGE
ENTRY GETPAGE
SYSCOM B1
TITLE GETPAGE - GET PAGE PARAMETERS.
*COMMENT CPUREL - GET PAGE PARAMETERS.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
*CALL COMCMAC
GETPAGE SPACE 4,10
*** GETPAGE - GET PAGE PARAMETERS.
*
* A. SKJOLDEBRAND. 82/11/21.
SPACE 4,10
*** *GETPAGE* PROVIDES AN INTERFACE TO ALLOW GETTING THE
* JOB AND SYSTEM PAGE PARAMETERS FOR PROGRAMS
* WRITTEN IN HIGHER LEVEL LANGUAGES.
SPACE 4,30
*** COMMAND FORMAT.
*
* FORTRAN CALL -
*
* CALL GETPAGE(ARRAY)
*
* SYMPL CALL -
*
* GETPAGE(ARRAY);
*
*
* ENTRY (ARRAY) = A 6 WORD ARRAY TO RECEIVE THE RESPONSE.
*
* EXIT (ARRAY) = PAGE PARAMETERS (RIGHT JUSTIFIED).
* ARRAY(1) = JOB PRINT DENSITY ( 6 OR 8 ).
* ARRAY(2) = JOB PAGE SIZE ( 16 - 255 ).
* ARRAY(3) = JOB PAGE WIDTH ( 40 - 255 ).
* ARRAY(4) = SYSTEM PRINT DENSITY (6 OR 8).
* ARRAY(5) = SYSTEM PAGE SIZE (16-255).
* ARRAY(6) = SYSTEM PAGE WIDTH (40-255).
GETPAGE BSS 0
GPG SUBR ENTRY/EXIT
SB1 1
SB7 X1 SAVE PARAMETER BLOCK
GETPAGE GPGA GET PAGE PARAMETERS
SB2 B1
SA1 GPGA GET JOB PAGE PARAMETERS
GPG1 MX0 -4
LX1 0-28 POSITION PRINT DENSITY
BX6 -X0*X1
SA6 B7 SET PRINT DENSITY RESPONSE
MX0 -8
LX1 8 POSITION PAGE SIZE
BX6 -X0*X1
SA6 A6+B1 SET PAGE SIZE RESPONSE
LX1 8 POSITION PAGE WIDTH
BX6 -X0*X1
SA6 A6+B1 SET PAGE WIDTH RESPONSE
ZR B2,GPGX IF END OF PARAMETERS
SB2 B2-B1
SA1 A1+B1
SB7 A6+B1
EQ GPG1 GET SYSTEM PAGE PARAMETERS
GPGA BSS 2 *GETPAGE* RESPONSE BLOCK
SPACE 4,10
END
IDENT SETPAGE
ENTRY SETPAGE
SYSCOM B1
TITLE SETPAGE - SET PAGE PARAMETERS.
*COMMENT CPUREL - SET PAGE PARAMETERS.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
*CALL COMCMAC
SETPAGE SPACE 4,10
*** SETPAGE - SET PAGE PARAMETERS.
*
* A. SKJOLDEBRAND. 82/11/21.
SPACE 4,10
*** *SETPAGE* PROVIDES AN INTERFACE TO ALLOW SETTING THE JOB
* PAGE PARAMETERS FOR PROGRAMS WRITTEN IN HIGHER LEVEL
* LANGUAGES.
SPACE 4,30
*** COMMAND FORMAT.
*
* FORTRAN CALL -
*
* CALL SETPAGE(ARRAY)
*
* SYMPL CALL -
*
* SETPAGE(ARRAY);
*
*
* ENTRY (ARRAY) = PAGE PARAMETERS (RIGHT JUSTIFIED).
* ARRAY(1) = JOB PRINT DENSITY ( 6 OR 8 ).
* ARRAY(2) = JOB PAGE SIZE ( 16 - 255 ).
* ARRAY(3) = JOB PAGE WIDTH ( 40 - 255 ).
*
* IF ARRAY(N) .LT. 0 CURRENT JOB VALUES WILL BE USED.
*
* EXIT PAGE SIZE PARAMETERS SET FOR JOB.
SETPAGE BSS 0
SPG SUBR ENTRY/EXIT
SB1 1
SB7 X1+ SAVE PARAMETER BLOCK ADDRESS
GETPAGE SPGA GET CURRENT JOB VALUES
SA3 SPGA
RJ MPP MERGE USER AND CURRENT JOB VALUES
SPG1 SA6 SPGA
SETPAGE A6
EQ SPGX RETURN
SPGA BSS 2 RESPONSE BLOCK
MPP SPACE 4,15 *GETPAGE*/*SETPAGE*
** MPP - MERGE PAGE PARAMETERS.
*
* ENTRY (X3) = CURRENT JOB PAGE PARAMETERS.
* (B7) = ADDRESS OF USER LIST OF PAGE PARAMETERS.
*
* EXIT (X6) = *SETPAGE* REQUEST WORD.
*
* USES X - 0, 1, 2, 3, 6.
* A - 1, 2.
MPP SUBR ENTRY/EXIT
MX0 -4 MASK FOR PRINT DENSITY
LX3 0-28
SA1 B7 GET USER PRINT DENSITY
PL X1,MPP1 IF USER VALUE SPECIFIED
BX1 -X0*X3 USE CURRENT JOB PRINT DENSITY
MPP1 LX1 8
SA2 A1+B1 GET PAGE SIZE PARAMETER
LX3 8
MX0 -8
PL X2,MPP2 IF USER VALUE SPECIFIED
BX2 -X0*X3 USE CURRENT JOB PAGE SIZE
MPP2 BX6 X1+X2 MERGE PRINT DENSITY AND PAGE SIZE
LX3 8
SA1 A2+B1 GET PAGE WIDTH PARAMETER
LX6 8
PL X1,MPP3 IF USER VALUE SPECIFIED
BX1 -X0*X3 USE CURRENT JOB PAGE WIDTH
MPP3 BX6 X1+X6 ADD IN PAGE WIDTH
LX6 12D POSITION *SETPAGE* PARAMETER BLOCK
EQ MPPX RETURN
SPACE 4,10
END