KACCT    CSECT                                                          00001000
         LCLA  &LMCMD                                                   00002000
         LCLB  &FILE,&D4C,&PUNCH,&PTEMP,&MSG,&SMSG                      00003000
         LCLC  &ADEST,&PCUU,&MCMD                                       00004000
         PRINT NOGEN                                                    00005000
         FSCBD                                                          00006000
         REGEQU                                                         00007000
         NUCON                                                          00008000
         EJECT                                                          00009000
* KACCT - Kermit Accounting Exit                                        00010000
*                                                                       00011000
* ENTRY CONDITIONS                                                      00012000
*   R0  =  Send/receive indicator                                       00013000
*          0 - Send file transfer                                       00014000
*          4 - Receive file transfer                                    00015000
*   R1  -> Parameter list (see DSECT "KSTATS")                          00016000
*   R2  -> 8-byte string giving communication line                      00017000
*   R14 =  Return address                                               00018000
*   R15 =  Entry point address                                          00019000
*                                                                       00020000
* EXIT CONDITIONS                                                       00021000
*   An account record is created and sent or stored.                    00022000
*                                                                       00023000
* OPTIONS                                                               00024000
*   The account record can be sent in one of five ways, determined      00025000
*   by the values of the conditional assembly symbols &FILE, &D4C,      00026000
*   &PUNCH, &MSG, and &SMSG.  These are Boolean flags, but only one     00027000
*   should be set to 1.  They are checked in that order, and the 1st    00028000
*   flag set determines the action.                                     00029000
*                                                                       00030000
*   &FILE  - Record is appended to file "KERMIT DATA A"                 00031000
*   &D4C   - Record written to CP account spool file via diagnose       00032000
*            4C function 10 (needs ACCT option in VM directory)         00033000
*   &PUNCH - Record is punched to the virtual reader of user &ADEST,    00034000
*            using the punch at address &PCUU                           00035000
*   &MSG   - Record is hexified and sent via CP MSG to user &ADEST      00036000
*   &SMSG  - Record is hexified and sent via CP SMSG to user &ADEST     00037000
*                                                                       00038000
* NOTES                                                                 00039000
* 1) The field "PAKCNT" from Kermit is the number of packets trans-     00040000
*    mitted (if transfer direction is send) or received (if direction   00041000
*    is receive).  The total number of packets exchanged would be twice 00042000
*    this number, to account for ACK/NAK packets and responses.         00043000
* 2) If a C0 account record is cut (&D4C = 1), the parameter list       00044000
*    "BUFFER" must not cross a page boundary.  It may be necessary to   00045000
*    load this exit routine before Kermit to ensure this.  It is also   00046000
*    necessary to enable account records for the virtual machine,       00047000
*    either via the CP directory or by installing a CP mod.             00048000
* 3) If &PUNCH = 1 is specified, the device address &PCUU and the       00049000
*    userid &ADEST must be specified as well.  Unless &PTEMP is also    00050000
*    specified as 1, the designated device is assumed to exist and be   00051000
*    ready.  In that case, the punch is closed after each record, but   00052000
*    the punch may be spooled "CONT" to avoid single-card punch files.  00053000
*    If &PTEMP is set to 1, the device &PCUU is assumed NOT to exist,   00054000
*    and the program creates one temporarily to punch the single card   00055000
*    and then detaches it immediately.                                  00056000
* 4) When records are written to 'KERMIT DATA A' (&FILE = 1), the disk  00057000
*    file is closed after each record, but the disk directory may still 00058000
*    not be updated if there are other pending output files on the "A"  00059000
*    disk.                                                              00060000
* 5) The same symbol &ADEST is used for the accounting server for the   00061000
*    MSG and SMSG options, as well as the PUNCH option.                 00062000
         EJECT                                                          00063000
*             I N S T A L L A T I O N   C H A N G E S                   00064000
*+--------------------+                                                 00065000
*|COMPUTATION CENTER  |                                                 00066000
*|UNIVERSITY OF TEXAS |                                                 00067000
*|AUSTIN, TEXAS 78712 |                                                 00068000
*+--------------------+                                                 00069000
*   Written by Gary Bjerke - 89/4/20                                    00070000
*   PTEMP code added - Andre Pirard -                                   00071000
*   MSG,SMSG code added - John Chandler - 90/12/7                       00072000
         SPACE 2                                                        00073000
* -- DISPOSE RECORDS TO CP ACCOUNT FILE                                 00074000
&D4C     SETB  0                                                        00075000
         SPACE ,                                                        00076000
* -- DISPOSE RECORDS TO CMS FILE                                        00077000
&FILE    SETB  0                                                        00078000
         SPACE ,                                                        00079000
* -- DISPOSE RECORDS TO A VIRTUAL READER                                00080000
&PUNCH   SETB  1             Default - use virtual punch                00081000
&PTEMP   SETB  1             Default - do it quietly                    00082000
&ADEST   SETC  'KERMACCT'    Spool to server machine                    00083000
&PCUU    SETC  '07D'         Use x'07d' for punch address               00084000
* -- Dispose records via CP MSG                                         00085000
&MSG     SETB  0                                                        00086000
* -- Dispose records via CP SMSG                                        00087000
&SMSG    SETB  0                                                        00088000
&MCMD    SETC  'SMSG &ADEST '                                           00089000
         AIF   (NOT &MSG).MSG2                                          00090000
&MCMD    SETC  'MSG &ADEST '                                            00091000
.MSG2    ANOP                                                           00092000
&LMCMD   SETA  K'&MCMD                                                  00093000
         EJECT                                                          00094000
KACCT    CSECT                                                          00095000
         STM   R14,R12,12(R13)                                          00096000
         LR    R12,R15                                                  00097000
         USING KACCT,R12                                                00098000
         LR    R11,R1              | R11 -> KERMIT STATISTICS PACKAGE   00099000
         USING KSTATS,R11                                               00100000
         SPACE ,                                                        00101000
* -- OBTAIN REAL ADDRESS OF CONSOLE, OR VTAM LUNAME                     00102000
         MVC   QDEVNO,0(R2)  Save Kermit line number                    00103000
         LM    R2,R5,QCONREGS      | R2/R5 SET UP FOR DIAG8             00104000
         CLI   QDEVNO,C' '   Other than console?                        00105000
         BE    *+8           No, just query console                     00106000
          LA   R2,QDEV       Yes, query that device                     00107000
         DIAG  R2,R4,X'8'          | "CP Q CONSOLE"                     00108000
         CLC   =C'DISCONNECT',DISC | DISCONNECTED?                      00109000
         BE    DEVDISC             | OKAY, INDICATE THAT FACT           00110000
         MVC   DEVID,DEV           | ELSE INSERT CUU/LUNAME IN RECORD   00111000
         B     INIT                                                     00112000
DEVDISC  DS    0H                                                       00113000
         MVC   DEVID,DISC          | FLAG "DISCONNECT" IN RECORD        00114000
         SPACE ,                                                        00115000
* -- INITIALIZE ACCOUNT RECORD                                          00116000
INIT     EQU   *                                                        00117000
         MVI   FLAG,C'K'            | "KERMIT" RECORD FLAG              00118000
         MVC   $TOUTOT($SL1),TOUTOT | SAVE FIRST PART OF STATS          00119000
         MVC   $PAKCNT($SL2),PAKCNT | SAVE SECOND PART OF STATS         00120000
         SPACE ,                                                        00121000
* -- PROCESS SEND/RECEIVE DEPENDENT DATA                                00122000
         MVC   #FILES,NSENT+2      | RECORD NUMBER OF FILES SENT        00123000
         MVI   TYPE,C'S'           | ASSUME "SEND" DIRECTION            00124000
         LTR   R0,R0               | IS IT RECEIVE?                     00125000
         BZ    GETDATM             | NO, A SEND ...                     00126000
         MVI   TYPE,C'R'           | INDICATE "RECEIVE" DIRECTION       00127000
         SPACE ,                                                        00128000
* -- GET DATE AND TIME                                                  00129000
GETDATM  EQU   *                                                        00130000
         LA    R2,DIAGC            | R2 -> AVAILABLE 4-DWORD BUFFER     00131000
         DIAG  R2,R2,X'C'          | GET DATE AND TIME                  00132000
         SPACE ,                                                        00133000
* -- CONVERT DATE AND TIME TO PACKED DECIMAL IN ACCOUNT RECORD          00134000
         LM    R1,R2,=A(MMDDYY,DATE) | R1/R2 -> DATE/OUTPUT FIELDS      00135000
         BAL   R10,PACKIT            | CONVERT THE DATA                 00136000
         LM    R1,R2,=A(HHMMSS,TIME) | R1/R2 -> TIME/OUTPUT FIELDS      00137000
         BAL   R10,PACKIT            | CONVERT THE DATA                 00138000
         SPACE ,                                                        00139000
* -- INSERT LOGON USERID IN ACCOUNT RECORD                              00140000
         LA    R2,DIAG0            | R2 -> DIAG0 DATA BUFFER            00141000
         LA    R4,24               | NEED ONLY 24 BYTES                 00142000
         DIAG  R2,R4,X'0'          | ... LAST 8 BYTES IS USERID         00143000
         SPACE ,                                                        00144000
         AIF   (NOT &FILE).D4C                                          00145000
* -- SAVE RECORD IN ACCOUNT DATA FILE                                   00146000
         FSWRITE FSCB=OUTFILE      | WRITE RECORD TO DATA FILE          00147000
         FSCLOSE FSCB=(R1)         | CHECKPOINT CLOSE                   00148000
         AGO   .EXIT                                                    00149000
.D4C     AIF   (NOT &D4C).PUNCH                                         00150000
         LA    R2,BUFFER+8         | R2 -> ACCOUNT DATA BUFFER          00151000
         LA    R4,X'10'            | R4 = "C0" ACCOUNT RECORD FUNCTION  00152000
         LA    R5,BUFFERL-8        | R5 = ACCOUNT DATA LENGTH           00153000
         DIAG  R2,R4,X'4C'         | CUT C0 ACCOUNT RECORD              00154000
         AGO   .EXIT                                                    00155000
.PUNCH   AIF   (NOT &PUNCH).SMSG                                        00156000
         AIF   (NOT &PTEMP).NODFP                                       00157000
         LA    R2,DFPUN      R2 -> "DEFINE PUNCH" command               00158000
         LA    R4,DFPUNL     R4 = Length of CP command                  00159000
         DIAG  R2,R4,X'8'    Define punch                               00160000
         LTR   R4,R4                                                    00161000
         BNZ   NODF          Failed, cannot send record                 00162000
.NODFP   ANOP                                                           00163000
         LA    R2,SPPUN            | R2 -> "SPOOL PUNCH" COMMAND        00164000
         LA    R4,L'SPPUN          | R4 = LENGTH OF CP COMMAND          00165000
         DIAG  R2,R4,X'8'          | SPOOL PUNCH TO TARGET USER         00166000
         LTR   R4,R4                                                    00167000
         BNZ   NOSP                                                     00168000
         LA    R2,PUNCCWS          | R2 -> PUNCH CCWS                   00169000
         USING NUCON,0                                                  00170000
         DMSEXS ST,R2,CAW          | SET CHANNEL ADDRESS WORD           00171000
         DROP  0                                                        00172000
         SIO   X'&PCUU'            | PUNCH THE ACCOUNT BUFFER           00173000
         BC    2,*-4                                                    00174000
         TIO   X'&PCUU'            | CLEAR ANY PENDING STATUS ON PUNCH  00175000
         BC    2,*-4                                                    00176000
         AIF   (&PTEMP).DETP                                            00177000
         LA    R2,CLPUN            | R2 -> "CLOSE PUNCH" COMMAND        00178000
         LA    R4,CLPUNL           | R4 = LENGTH OF COMMAND             00179000
         DIAG  R2,R4,X'8'          | CLOSE SPOOL FILE                   00180000
.DETP    ANOP                                                           00181000
NOSP     DS    0H                                                       00182000
         AIF   (NOT &PTEMP).DONEP                                       00183000
         LA    R2,DTPUN      R2 -> "DETACH PUNCH" command               00184000
         LA    R4,L'DTPUN    R4 = Length of CP command                  00185000
         DIAG  R2,R4,X'8'    Detach it                                  00186000
NODF     DS    0H                                                       00187000
.DONEP   ANOP                                                           00188000
         B     KEXIT                                                    00189000
         SPACE ,                                                        00190000
* -- WORK AREA FOR PUNCH DISPOSITION                                    00191000
PUNCCWS  CCW   X'01',BUFFER,X'60',BUFFERL                               00192000
         CCW   X'03',*,X'20',1                                          00193000
DFPUN    EQU   *                                                        00194000
         DC    C'SET IMSG OFF',X'15'   Kermit changes IMSG each time    00195000
         DC    C'DEFINE PUNCH &PCUU'                                    00196000
DFPUNL   EQU   *-DFPUN                                                  00197000
SPPUN    DC    C'SPOOL &PCUU TO &ADEST CLASS K DEST KERMACCT'           00198000
CLPUN    DC    C'CLOSE &PCUU NAME KERMIT ACCT'                          00199000
CLPUNL     EQU *-CLPUN                                                  00200000
DTPUN    DC    C'DETACH &PCUU'                                          00201000
         DS    0H                                                       00202000
         AGO   .EXIT                                                    00203000
.SMSG    AIF   (NOT &SMSG AND NOT &MSG).EXIT                            00204000
         LA    R2,BUFFER+BUFFERL   End of stuff to hexify               00205000
         LA    R3,BUFFERL-16(,R2)  End of extended buffer               00206000
         LA    R4,(BUFFERL-16)/4   Words to hexify                      00207000
SMSGLP   SH    R2,=H'4'      Work backwards to avoid overlap            00208000
         SH    R3,=H'8'                                                 00209000
         UNPK  UPBUF,0(5,R2) Hexify                                     00210000
         MVC   0(8,R3),UPKBUF                                           00211000
         TR    0(8,R3),TRHEX                                            00212000
         BCT   R4,SMSGLP                                                00213000
         MVC   CPMSG(&LMCMD),=C'&MCMD'                                  00214000
         LA    R2,CPMSG      R2 -> MSG command (includes buffer)        00215000
         LA    R4,LCPMSG     R4 = length of command                     00216000
         ICM   R4,8,=X'40'   Catch reply, if any                        00217000
         LA    R3,UPKBUF                                                00218000
         LA    R5,1          Tiny length for reply buffer               00219000
         DIAG  R2,R4,X'8'    Send msg, if possible                      00220000
*        B     KEXIT                                                    00221000
.EXIT    ANOP                                                           00222000
         SPACE ,                                                        00223000
* -- COMMON EXIT TO CALLER                                              00224000
KEXIT    EQU   *                                                        00225000
         LM    R14,R12,12(R13)                                          00226000
         SLR   R15,R15             | SET RETURN CODE = 0                00227000
         BR    R14                                                      00228000
         SPACE ,                                                        00229000
*---------------------------------------------------------------------* 00230000
* PACKIT   - CONVERT MM/DD/YY OR HH:MM:SS TO 4-BYTE PACKED DECIMAL    * 00231000
*                                                                     * 00232000
* ENTRY CONDITIONS:                                                   * 00233000
*   R1 -> HH:MM:SS OR MM/DD/YY                                        * 00234000
*   R2 -> 4-BYTE OUTPUT FIELD                                         * 00235000
*   R10 = RETURN ADDRESS                                              * 00236000
*---------------------------------------------------------------------* 00237000
PACKIT   EQU   *                                                        00238000
         MVC   2(2,R1),3(R1)       | SLIDE SECOND FIELD LEFT 1 BYTE     00239000
         MVC   4(2,R1),6(R1)       | SLIDE THIRD FIELD LEFT 1 BYTE      00240000
         PACK  0(4,R2),0(6,R1)     | CONVERT TO PACKED IN OUTPUT FIELD  00241000
         BR    R10                                                      00242000
         EJECT                                                          00243000
*---------------------------------------------------------------------* 00244000
*                    W O R K I N G   S T O R A G E                    * 00245000
*---------------------------------------------------------------------* 00246000
         AIF   (NOT &FILE).FSCBZ                                        00247000
* -- FSCB FOR ACCOUNT DATA FILE                                         00248000
OUTFILE  FSCB  'KERMIT DATA A',BUFFER=BUFFER,NOREC=1,RECFM=F            00249000
         ORG   OUTFILE+(FSCBSIZE-FSCBD)                                 00250000
         DC    A(BUFFERL)          | FORCIBLY INSERT BUFFER LENGTH      00251000
         ORG   ,                   | RESET LOCATION COUNTER             00252000
.FSCBZ   ANOP                                                           00253000
         SPACE ,                                                        00254000
* -- REGISTERS FOR "CP Q CONSOLE" VIA DIAGNOSE 8, RESPONSE IN MEMORY    00255000
QCONREGS DC    A(QCON)             | RX   -> "CP Q CONSOLE"             00256000
         DC    A(DIAGC)            | RX+1 -> RESPONSE BUFFER            00257000
         DC    X'40',AL3(L'QCON)   | RY   =  CP COMMAND LENGTH          00258000
         DC    A(BUFFERL+24)       | RY+1 =  RESPONSE BUFFER LENGTH     00259000
QDEV     DC    C'Q V '                                                  00260000
QDEVNO   DC        C'     '  Space for CUU of line                      00261000
QCON     DC    C'Q V CONSOLE'      | CP COMMAND (DIAG8 TARGET)          00262000
         SPACE ,                                                        00263000
* -- DIAGC RESPONSE BUFFER (OVERLAPS DIAG0 RESPONSE BUFFER)             00264000
DIAGC    DS    0D                                                       00265000
MMDDYY     DS  D                   | -- DATE, IN MM/DD/YY FORMAT        00266000
HHMMSS     DS  D                   | -- TIME, IN HH:MM:SS FORMAT        00267000
         SPACE ,                                                        00268000
* -- DIAG0 RESPONSE BUFFER (OVERLAPS ACCOUNT RECORD)                    00269000
         ORG   HHMMSS                                                   00270000
DIAG0    DS    0D                                                       00271000
SYSN       DS  D                   | -- "VM/SP"                         00272000
STIDP      DS  D                   | -- STIDP DATA                      00273000
USERID     DS  D                   | -- LOGON USERID                    00274000
         SPACE ,                                                        00275000
* -- DIAGC BUFFER OVERLAYS FOR USE BY DIAG8                             00276000
DISC     EQU   DIAGC+9,10          | "DISCONNECTED" MESSAGE, MAYBE      00277000
DEV      EQU   DIAGC+12,8          | "GRAF XXX"/"LDEV XXX"/<LUNAME>     00278000
         SPACE ,                                                        00279000
* -- ACCOUNT RECORD                                                     00280000
BUFFER   EQU   USERID,8            | (BUFFER BEGINS WITH LOGON USERID)  00281000
DEVID    DS    CL8                 | CUU OR LUNAME OF CONSOLE           00282000
FLAG     DC    C'K'                | INDICATES KERMIT ACCOUNT DATA      00283000
TYPE     DS    C                   | S/R FOR "SEND"/"RECEIVE"           00284000
#FILES   DS    H                   | NUMBER OF FILES SENT/RECEIVED      00285000
DATE     DS    F                   | DATE IN PACKED FORMAT              00286000
TIME     DS    F                   | TIME IN PACKED FORMAT              00287000
$TOUTOT    DS  2F                  | -- TOTAL BYTES SENT                00288000
$TINTOT    DS  2F                  | -- TOTAL BYTES RECEIVED            00289000
$DSKTOT    DS  2F                  | -- TOTAL BYTES OF DISK I/O         00290000
$SL1       EQU *-$TOUTOT                                                00291000
$PAKCNT    DS  F                   | -- TOTAL PACKETS SENT/RECEIVED     00292000
$RTRCNT    DS  F                   | -- NUMBER OF RETRIES               00293000
$SECTOT    DS  F                   | -- TRANSFER TIME IN SECONDS        00294000
$SL2       EQU *-$PAKCNT                                                00295000
$STATSL    EQU *-$TOUTOT                                                00296000
BUFFERL  EQU   *-BUFFER                                                 00297000
         AIF   (NOT &SMSG AND NOT &MSG).BUFMZ                           00298000
         DS    XL(BUFFERL-16)                                           00299000
CPMSG    EQU   BUFFER-&LMCMD Allow room for "MSG user"                  00300000
LCPMSG   EQU   *-CPMSG                                                  00301000
UPBUF    DS    XL9           Must include a spare                       00302000
         SPACE ,                                                        00303000
TRHEX    EQU   *-C'0'        Hexifying mask                             00304000
         DC    C'0123456789ABCDEF'                                      00305000
         SPACE ,                                                        00306000
.BUFMZ   ANOP                                                           00307000
         SPACE ,                                                        00308000
         LTORG ,                                                        00309000
         SPACE ,                                                        00310000
* -- MAP FOR KERMIT STATISTICS PACKAGE                                  00311000
KSTATS   DSECT                                                          00312000
NSENT    DS  F                     | -- NUMBER OF FILES SENT            00313000
TOUTOT   DS  2F                    | -- TOTAL BYTES SENT                00314000
TINTOT   DS  2F                    | -- TOTAL BYTES RECEIVED            00315000
DSKTOT   DS  2F                    | -- TOTAL BYTES OF DISK I/O         00316000
SSVDSK   DS  2F                    | -- SAVED DISK BYTE COUNT           00317000
PAKCNT   DS  F                     | -- TOTAL NUMBER OF PACKETS MOVED   00318000
RTRCNT   DS  F                     | -- NUMBER OF RETRIES               00319000
SECTOT   DS  F                     | -- TRANSFER TIME IN SECONDS        00320000
CSECTOT  DS  F                     | -- TRANSFER TIME IN CSECS          00321000
RECTRC   DS  F                     | -- RECORD TRUNCATION COUNT         00322000
RECFLD   DS  F                     | -- RECORD FOLDING COUNT            00323000
EMSGL    DS  F                     | -- LENGTH OF MESSAGE               00324000
TINSV    DS  12F                   | -- 3 PROGRESS SNAPSHOTS            00325000
         END                                                            00326000
