ICPD
          IDENT  ICPD,ICPD
          SST    FL 
          ABS 
          ENTRY  ICPD 
          ENTRY  ENDCPD 
          ENTRY  RFL= 
          ENTRY  SSJ= 
          SYSCOM B1 
*COMMENT  ICPD - INITIATE *CPD* EXECUTION.
          TITLE  ICPD - INITIATE *CPD* EXECUTION. 
 ICPD     SPACE  4,10 
***       ICPD - INITIATE *CPD* EXECUTION.
* 
*         S. L. KSANDER.     78/12/13.
          SPACE  4,10 
***       *ICPD* PROCESSES PARAMETERS AND DEFINES A DATA
*         FILE FOR *CPD*.  AFTER AN EOF IS WRITTEN ON THE 
*         DATA FILE, IT IS REWOUND AND *CPD* ACTIVATED. 
          SPACE  4,15 
***       CONTROL STATEMENT CALL. 
* 
* 
*         ICPD(P1,P2 ... PN)
* 
*         WHERE PN IS ANY OF THE FOLLOWING. 
* 
*         OPTIONS    DEFAULT     PARAMETER
* 
*         FL = NNNN  (5)         FAST LOOP TIME. (MILLISECONDS) 
*         ML = NNNN  (100)       MEDIUM LOOP TIME. (MILLISECONDS) 
*         SL = NNNN  (1000)      SLOW LOOP TIME.  (MILLISECONDS)
*         FW = NNNN  (5)         DATA BLOCK SAMPLE TIME. (SECONDS)
*         FN = XXXX  (SAMPLE)    SAMPLE DATA FILE.
* 
*         M=XXX      (WRITE)     SAMPLE DATA FILE MODE. 
*                                W = WRITE MODE 
*                                WRITE = WRITE MODE 
*                                A = APPEND MODE
*                                APPEND = APPEND MODE 
*                                M = MODIFY MODE
*                                MODIFY = MODIFY MODE 
* 
*         IF THE SAMPLE DATA FILE IS ATTACHED IN APPEND OR MODIFY 
*         MODE, THEN THE FILE MAY BE ACCESSED IN READ-ALLOW-MODIFY
*         MODE WHILE *CPD* IS STILL ACTIVE.  THE ADVANTAGE OF 
*         SPECIFYING WRITE MODE IS TO REDUCE SYSTEM OVERHEAD WHEN 
*         *CPD* WRITES DATA TO THE SAMPLE FILE.  THE SAMPLE DATA
*         FILE CAN NOT BE ACCESSED WHILE *CPD* IS ACTIVE IF WRITE 
*         MODE IS SPECIFIED.
* 
*         IF A LOOP TIME IS SET TO ZERO, NO SAMPLES FOR THAT
*         LOOP WILL BE TAKEN.  IF THE DATA BLOCK SAMPLE TIME IS 
*         SET TO ZERO, THE ONLY TIME THE DATA FILE WILL BE WRITTEN
*         IS WHEN THE SAMPLING INTERVAL IS TERMINATED.
* 
*         ALL NUMERIC DATA SHOULD LIE WITHIN THE RANGE 0-7777B. 
          SPACE  4,10 
***       *ENDCPD* WILL TERMINATE THE ACTIVE COPY OF *CPD*. 
          SPACE  4,10 
***       CONTROL STATEMENT CALL. 
* 
*         ENDCPD. 
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
* 
* 
*         * ICPD COMPLETE.* 
*                INFORMATIVE MESSAGE INDICATING SYSTEM MONITORING BY
*                *CPD* AS BEEN INITIATED. 
* 
*         * ENDCPD COMPLETE.* 
*                INFORMATIVE MESSAGE INDICATING THAT *ENDCPD* IS
*                FINISHED.
* 
*         * ARGUMENT ERROR.*
*                ARGUMENT CRACKING HAS DETECTED AN ERRONEOUS OR 
*                UNDEFINED ARGUMENT.
* 
*         * FILE NOT FOUND.*
*                AN ERROR WAS ENCOUNTERED WHEN ATTEMPTING TO DEFINE THE 
*                SAMPLE FILE, POSSIBLY BECAUSE AN INACCESSIBLE DEVICE 
*                WAS ENCOUNTERED. 
* 
*         * FORMAT ERROR IN TIME PARAMETER.*
*                THE VALUES SPECIFIED FOR THE LOOP OPERATION TIMES
*                DO NOT CONFORM TO STANDARD NUMERIC FORMAT. 
*                (DIGITS 0 - 9 WITH OPTIONAL POST-RADIX *D* OR *B*) 
*                DEFAULT BASE IS DECIMAL.  ALL NUMERIC VALUES 
*                SHOULD LIE WITHIN THE RANGE 0-7777B. 
* 
*         * UNABLE TO ATTACH SAMPLE FILE.*
*                AN ERROR WAS DETECTED WHEN ATTEMPTING TO ATTACH THE
*                SAMPLE FILE, POSSIBLY DUE TO ENCOUNTERING AN I/O 
*                ERROR OR AN INACCESSIBLE DEVICE. 
* 
*         * UNABLE TO RETURN SAMPLE FILE.*
*                AN ERROR WAS DETECTED WHEN ATTEMPTING TO RETURN THE
*                SAMPLE FILE, POSSIBLY DUE TO ENCOUNTERING AN 
*                INACCESSIBLE DEVICE. 
* 
*         + *CPD* ALREADY ACTIVE.+
*                A REQUEST TO INITIALIZE *CPD* WAS ISSUED WHILE *CPD* 
*                WAS ALREADY ACTIVE IN A PP.
* 
*         + *CPD* NOT ACTIVE.+
*                AN INFORMATIVE MESSAGE INDICATING THAT *ENDCPD*
*                WAS CALLED WHEN *CPD* WAS NOT ACTIVE.
* 
*         + *CPD* SAMPLE FILE IN USE.+
*                AN ERROR WAS ENCOUNTERED WHEN ATTEMPTING TO ENTER
*                SAMPLE AS A LOCAL FAST ATTACH FILE.
          SPACE  4,10 
*         COMMON DECKS. 
  
  
*CALL     COMCMAC 
*CALL     COMCCMD 
*CALL     COMSLFM 
*CALL     COMSPFM 
*CALL     COMSSFM 
          TITLE  *ICPD* PROCESSOR.
 ICPD     SPACE  4,10 
**        MAIN PROGRAM. 
  
  
          ORG    110B 
  
 ICPD     SB1    1
  
*         PROCESS COMMAND PARAMETERS. 
  
          SA1    ACTR 
          SA4    ARGR        ADDRESS FIRST ARGUMENT 
          SB4    X1+         ARGUMENT COUNT 
          SB5    TARG 
          RJ     ARG
          ZR     X1,ICP2     IF NO ERROR
 ICP1     SX5    =C* ARGUMENT ERROR.* 
          EQ     ICP9        ISSUE MESSAGE AND ABORT
  
*         CHECK FOR *CPD* ALREADY ACTIVE IN A PP. 
  
 ICP2     SYSTEM RSB,R,PPCR  READ *PPCP*
          SYSTEM RSB,R,PPUR  READ *PPUL*
          SA1    PPCB 
          MX0    -12
          BX5    -X0*X1      FWA OF PP COMMUNICATION AREA 
          SA2    PPUB 
          LX2    -24
          BX4    -X0*X2      GET NUMBER OF PP-S 
          LX4    3
          IX3    X5+X4       IR ADDRESS OF LAST PP + 1
          SB2    X5          CURRENT PP IR ADDRESS
          SB3    X3          IR ADDRESS OF LAST PP + 1
          SX5    =C+ *CPD* ALREADY ACTIVE.+ 
 ICP2.1   SA1    PIRR        GET *RSB* REQUEST
          SX2    B2 
          MX0    42 
          LX0    18 
          BX3    X0*X1       CLEAR OLD ADDRESS
          LX2    18 
          BX6    X3+X2       PUT NEW ADDRESS IN REQUEST 
          SA6    A1 
          SA2    RSBB        GET *RSB* BUFFER FORMAT
          BX6    X2 
          SA6    PIRB        SET UP FORMAT FOR *RSB*
          SYSTEM RSB,R,PIRR  READ PP INPUT REGISTER 
          SA1    PIRB 
          MX0    18 
          BX2    X0*X1       GET PP NAME
          LX2    18 
          SX3    X2-3RCPD 
          ZR     X3,ICP9     IF *CPD* ACTIVE IN THIS PP 
          SB2    B2+8 
          LT     B2,B3,ICP2.1  IF MORE PP-S TO CHECK
  
*         IF *CPD* NOT ACTIVE, MAKE SURE DATA FILE WAS NOT LEFT ACTIVE. 
  
          SA1    F           CLEAR COMPLETE BIT 
          SX6    B1 
          BX6    -X6*X1 
          SA6    A1 
          SYSTEM SFM,R,A6,SCDF*100B  SET *CPD* DROP FLAG
  
*         INITIALIZE DATA FILE. 
  
          RETURN F
          DEFINE F
          RJ     CES         CHECK ERROR STATUS 
          MX0    42 
          SX6    B1 
          ZR     X1,ICP3     IF NO ERROR - FILE DEFINED 
          SX1    X1-/ERRMSG/FAP 
          SX5    =C* FILE NOT FOUND.* 
          NZ     X1,ICP9     IF FILE NOT FOUND
          SA6    ICPA 
 ICP3     SA1    TMDE-1      SET FILE MODE
          SA2    M
 ICP4     SA1    A1+B1       GET NEXT ENTRY 
          ZR     X1,ICP1     IF INVALID MODE SPECIFIED
          BX3    X1-X2
          BX3    X0*X3
          BX6    -X0*X1 
          NZ     X3,ICP4     IF NO MATCH
          SA6    MODE 
          ATTACH F,,,,MODE
          RJ     CES         CHECK ERROR STATUS 
          SX5    =C* UNABLE TO ATTACH SAMPLE FILE.* 
          NZ     X1,ICP9     IF ERROR IN FILE ATTACH
          SA1    ICPA 
          ZR     X1,ICP6     IF NEW FILE USED 
          SA1    F           CHECK FILE SIZE
          SX6    FIPBL*10000B+1 
          MX7    42 
          BX7    X7*X1
          BX6    X6+X7
          SA6    FBLK 
          FILINFO  FBLK 
          SA1    FBLK+3 
          MX7    24 
          BX7    X7*X1
          ZR     X7,ICP6     IF EMPTY SAMPLE FILE 
          SKIPEI F,R
          WRITEF F,R
  
*         PROCESS LOOP TIME PARAMETERS. 
  
 ICP6     SB7    B1+         SET DEFAULT BASE TO DECIMAL
          SA5    FW          SET FIRST ARGUMENT 
          SX6    B0+         CLEAR PARAMETER ACCUMULATOR
          SA6    F+5
 ICP7     MX0    42          CONVERT DISPLAY TO BINARY
          BX5    X0*X5
          RJ     DXB
          ZR     X4,ICP10    IF NO ERROR
 ICP8     SX5    =C* FORMAT ERROR IN TIME PARAMETER.* 
 ICP9     MESSAGE  X5 
          ABORT 
  
 ICP10    MX0    -12
          SA1    A6          SET PARAMETER WORD 
          BX3    X0*X6
          NZ     X3,ICP8     IF OVERFLOW
          BX6    -X0*X6 
          LX1    12 
          BX6    X6+X1       MERGE THIS ARGUMENT
          SA6    A6+         RESET ARGUMENT 
          SA5    A5+B1
          NZ     X5,ICP7     IF TABLE NOT COMPLETED 
  
*         CALL *CPD*. 
  
          SA1    MODE        MERGE MODE IN *CPD* FET
          SA3    F+8
          BX6    X1+X3
          SA6    A3 
          SYSTEM SFM,R,F,ECFF*100B  ENTER *CPD* SAMPLE FILE 
          SX5    =C* CPD SAMPLE FILE IN USE.* 
          RJ     CES         CHECK ERROR STATUS 
          NZ     X1,ICP9     IF SAMPLE FILE IN USE
          MESSAGE  (=C* ICPD COMPLETE.*),3
          ENDRUN
  
  
 ICPA     CON    0           NEW FILE FLAG
 FBLK     BSS    FIPBL       FILINFO DATA BLOCK 
 MODE     CON    0           DATA FILE MODE 
 PIRB     VFD    1/1,23/0,18/1,18/0   PP INPUT REGISTER 
 PIRR     VFD    12/0,12/1,18/0,18/PIRB      *RSB* REQUEST FOR PP IR
 PPCB     VFD    1/1,23/0,18/1,18/0   FWA OF PP COMMUNICATION AREA
 PPCR     VFD    12/0,12/1,18/PPCP,18/PPCB   *RSB* REQUEST FOR *PPCP* 
 PPUB     VFD    1/1,23/0,18/1,18/0   NUMBER OF PPS 
 PPUR     VFD    12/0,12/1,18/PPUL,18/PPUB   *RSB* REQUEST FOR *PPUL* 
 RSBB     VFD    1/1,23/0,18/1,18/0   *RSB* BUFFER FORMAT 
          TITLE  *ENDCPD* PROCESSOR.
 ENDCPD   SPACE  4,10 
**        ENDCPD - MAIN PROGRAM.
  
  
 ENDCPD   SB1    1
          SA1    ACTR 
          SB4    X1 
          ZR     B4,ECP1     IF NO ARGUMENTS
          MESSAGE  (=C* ARGUMENT ERROR.*) 
          ABORT 
  
 ECP1     SA1    F           CLEAR COMPLETE BIT 
          SX6    B1 
          BX6    -X6*X1 
          SA6    A1 
          SYSTEM SFM,R,A6,SCDF*100B  SET *CPD* DROP FLAG
          RJ     CES         CHECK ERROR FLAG 
          ZR     X1,ECP2     IF NO ERROR
          SX1    X1-/ERR/CNF
          NZ     X1,ECP2     IF ACTIVE COPY OF *CPD* FOUND
          MESSAGE  (=C+ *CPD* NOT ACTIVE.+) 
 ECP2     RETURN F,R
          SX5    =C* ENDCPD COMPLETE.*
 ECP3     MESSAGE  X5,3 
          ENDRUN
          TITLE  SUBROUTINES. 
 CES      SPACE  4,10 
**        CES - CHECK FET ERROR STATUS. 
* 
*         ENTRY  (F) = FILE FET TO CHECK. 
* 
*         EXIT   (X1) = FET ERROR STATUS. 
  
  
 CES      SUBR               ENTRY/EXIT 
          SA1    F           CHECK ERROR STATUS 
          MX0    -8 
          LX1    0-10 
          BX1    -X0*X1 
          EQ     CESX        RETURN 
          TITLE  DATA DEFINITIONS.
          SPACE  4,10 
*         FETS/BUFFERS. 
  
  
 F        BSS    0
 SAMPLE   FILEB  BUF,1,FET=15D,EPR  DATA FILE 
  
  
 BUF      EQU    *           DATA FILE BUFFER 
          SPACE  4,10 
*         ARGUMENT VALUE TABLE. (ORDER DEPENDENT) 
  
 FW       DATA   0L5
 SL       DATA   0L1000 
 ML       DATA   0L100
 FL       DATA   0L5
          CON    0
  
 M        DATA   0LW         SAMPLE DATA FILE MODE
 TARG     SPACE  4,10 
*         TARG - TABLE OF ARGUMENTS.
  
  
 TARG     BSS    0
 FL       ARG    FL,FL,400B  FAST LOOP TIME 
 ML       ARG    ML,ML,400B  MEDIUM LOOP TIME 
 SL       ARG    SL,SL,400B  SLOW LOOP TIME 
 FW       ARG    FW,FW,400B  FILE WRITE TIME
 FN       ARG    F+8,F+8,400B  DATA FILE NAME 
 M        ARG    M,M,400B    SAMPLE DATAFILE MODE 
          ARG                END OF TABLE 
          SPACE  4,10 
**        TMDE - TABLE OF FILE MODES. 
  
  
 TMDE     BSS    0
          VFD    42/0LWRITE,18/PTWR 
          VFD    42/0LW,18/PTWR 
          VFD    42/0LAPPEND,18/PTAP
          VFD    42/0LA,18/PTAP 
          VFD    42/0LMODIFY,18/PTMD
          VFD    42/0LM,18/PTMD 
          CON    0
          SPACE  4,10 
*         COMMON DECKS. 
  
  
*CALL     COMCARG 
*CALL     COMCCIO 
*CALL     COMCDXB 
*CALL     COMCLFM 
*CALL     COMCPFM 
*CALL     COMCSYS 
          SPACE  4,10 
          USE    LITERALS 
  
  
 SSJ=     EQU    0
 RFL=     EQU    *+10        ENSURE FWA+5 OF LAST MESSAGE .GT. FL 
          SPACE  4
          END 
