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