home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / archives / deleteme.zip / ikcact.asm < prev    next >
Assembly Source File  |  1992-09-30  |  27KB  |  327 lines

  1. KACCT    CSECT                                                          00001000
  2.          LCLA  &LMCMD                                                   00002000
  3.          LCLB  &FILE,&D4C,&PUNCH,&PTEMP,&MSG,&SMSG                      00003000
  4.          LCLC  &ADEST,&PCUU,&MCMD                                       00004000
  5.          PRINT NOGEN                                                    00005000
  6.          FSCBD                                                          00006000
  7.          REGEQU                                                         00007000
  8.          NUCON                                                          00008000
  9.          EJECT                                                          00009000
  10. * KACCT - Kermit Accounting Exit                                        00010000
  11. *                                                                       00011000
  12. * ENTRY CONDITIONS                                                      00012000
  13. *   R0  =  Send/receive indicator                                       00013000
  14. *          0 - Send file transfer                                       00014000
  15. *          4 - Receive file transfer                                    00015000
  16. *   R1  -> Parameter list (see DSECT "KSTATS")                          00016000
  17. *   R2  -> 8-byte string giving communication line                      00017000
  18. *   R14 =  Return address                                               00018000
  19. *   R15 =  Entry point address                                          00019000
  20. *                                                                       00020000
  21. * EXIT CONDITIONS                                                       00021000
  22. *   An account record is created and sent or stored.                    00022000
  23. *                                                                       00023000
  24. * OPTIONS                                                               00024000
  25. *   The account record can be sent in one of five ways, determined      00025000
  26. *   by the values of the conditional assembly symbols &FILE, &D4C,      00026000
  27. *   &PUNCH, &MSG, and &SMSG.  These are Boolean flags, but only one     00027000
  28. *   should be set to 1.  They are checked in that order, and the 1st    00028000
  29. *   flag set determines the action.                                     00029000
  30. *                                                                       00030000
  31. *   &FILE  - Record is appended to file "KERMIT DATA A"                 00031000
  32. *   &D4C   - Record written to CP account spool file via diagnose       00032000
  33. *            4C function 10 (needs ACCT option in VM directory)         00033000
  34. *   &PUNCH - Record is punched to the virtual reader of user &ADEST,    00034000
  35. *            using the punch at address &PCUU                           00035000
  36. *   &MSG   - Record is hexified and sent via CP MSG to user &ADEST      00036000
  37. *   &SMSG  - Record is hexified and sent via CP SMSG to user &ADEST     00037000
  38. *                                                                       00038000
  39. * NOTES                                                                 00039000
  40. * 1) The field "PAKCNT" from Kermit is the number of packets trans-     00040000
  41. *    mitted (if transfer direction is send) or received (if direction   00041000
  42. *    is receive).  The total number of packets exchanged would be twice 00042000
  43. *    this number, to account for ACK/NAK packets and responses.         00043000
  44. * 2) If a C0 account record is cut (&D4C = 1), the parameter list       00044000
  45. *    "BUFFER" must not cross a page boundary.  It may be necessary to   00045000
  46. *    load this exit routine before Kermit to ensure this.  It is also   00046000
  47. *    necessary to enable account records for the virtual machine,       00047000
  48. *    either via the CP directory or by installing a CP mod.             00048000
  49. * 3) If &PUNCH = 1 is specified, the device address &PCUU and the       00049000
  50. *    userid &ADEST must be specified as well.  Unless &PTEMP is also    00050000
  51. *    specified as 1, the designated device is assumed to exist and be   00051000
  52. *    ready.  In that case, the punch is closed after each record, but   00052000
  53. *    the punch may be spooled "CONT" to avoid single-card punch files.  00053000
  54. *    If &PTEMP is set to 1, the device &PCUU is assumed NOT to exist,   00054000
  55. *    and the program creates one temporarily to punch the single card   00055000
  56. *    and then detaches it immediately.                                  00056000
  57. * 4) When records are written to 'KERMIT DATA A' (&FILE = 1), the disk  00057000
  58. *    file is closed after each record, but the disk directory may still 00058000
  59. *    not be updated if there are other pending output files on the "A"  00059000
  60. *    disk.                                                              00060000
  61. * 5) The same symbol &ADEST is used for the accounting server for the   00061000
  62. *    MSG and SMSG options, as well as the PUNCH option.                 00062000
  63.          EJECT                                                          00063000
  64. *             I N S T A L L A T I O N   C H A N G E S                   00064000
  65. *+--------------------+                                                 00065000
  66. *|COMPUTATION CENTER  |                                                 00066000
  67. *|UNIVERSITY OF TEXAS |                                                 00067000
  68. *|AUSTIN, TEXAS 78712 |                                                 00068000
  69. *+--------------------+                                                 00069000
  70. *   Written by Gary Bjerke - 89/4/20                                    00070000
  71. *   PTEMP code added - Andre Pirard -                                   00071000
  72. *   MSG,SMSG code added - John Chandler - 90/12/7                       00072000
  73.          SPACE 2                                                        00073000
  74. * -- DISPOSE RECORDS TO CP ACCOUNT FILE                                 00074000
  75. &D4C     SETB  0                                                        00075000
  76.          SPACE ,                                                        00076000
  77. * -- DISPOSE RECORDS TO CMS FILE                                        00077000
  78. &FILE    SETB  0                                                        00078000
  79.          SPACE ,                                                        00079000
  80. * -- DISPOSE RECORDS TO A VIRTUAL READER                                00080000
  81. &PUNCH   SETB  1             Default - use virtual punch                00081000
  82. &PTEMP   SETB  1             Default - do it quietly                    00082000
  83. &ADEST   SETC  'KERMACCT'    Spool to server machine                    00083000
  84. &PCUU    SETC  '07D'         Use x'07d' for punch address               00084000
  85. * -- Dispose records via CP MSG                                         00085000
  86. &MSG     SETB  0                                                        00086000
  87. * -- Dispose records via CP SMSG                                        00087000
  88. &SMSG    SETB  0                                                        00088000
  89. &MCMD    SETC  'SMSG &ADEST '                                           00089000
  90.          AIF   (NOT &MSG).MSG2                                          00090000
  91. &MCMD    SETC  'MSG &ADEST '                                            00091000
  92. .MSG2    ANOP                                                           00092000
  93. &LMCMD   SETA  K'&MCMD                                                  00093000
  94.          EJECT                                                          00094000
  95. KACCT    CSECT                                                          00095000
  96.          STM   R14,R12,12(R13)                                          00096000
  97.          LR    R12,R15                                                  00097000
  98.          USING KACCT,R12                                                00098000
  99.          LR    R11,R1              | R11 -> KERMIT STATISTICS PACKAGE   00099000
  100.          USING KSTATS,R11                                               00100000
  101.          SPACE ,                                                        00101000
  102. * -- OBTAIN REAL ADDRESS OF CONSOLE, OR VTAM LUNAME                     00102000
  103.          MVC   QDEVNO,0(R2)  Save Kermit line number                    00103000
  104.          LM    R2,R5,QCONREGS      | R2/R5 SET UP FOR DIAG8             00104000
  105.          CLI   QDEVNO,C' '   Other than console?                        00105000
  106.          BE    *+8           No, just query console                     00106000
  107.           LA   R2,QDEV       Yes, query that device                     00107000
  108.          DIAG  R2,R4,X'8'          | "CP Q CONSOLE"                     00108000
  109.          CLC   =C'DISCONNECT',DISC | DISCONNECTED?                      00109000
  110.          BE    DEVDISC             | OKAY, INDICATE THAT FACT           00110000
  111.          MVC   DEVID,DEV           | ELSE INSERT CUU/LUNAME IN RECORD   00111000
  112.          B     INIT                                                     00112000
  113. DEVDISC  DS    0H                                                       00113000
  114.          MVC   DEVID,DISC          | FLAG "DISCONNECT" IN RECORD        00114000
  115.          SPACE ,                                                        00115000
  116. * -- INITIALIZE ACCOUNT RECORD                                          00116000
  117. INIT     EQU   *                                                        00117000
  118.          MVI   FLAG,C'K'            | "KERMIT" RECORD FLAG              00118000
  119.          MVC   $TOUTOT($SL1),TOUTOT | SAVE FIRST PART OF STATS          00119000
  120.          MVC   $PAKCNT($SL2),PAKCNT | SAVE SECOND PART OF STATS         00120000
  121.          SPACE ,                                                        00121000
  122. * -- PROCESS SEND/RECEIVE DEPENDENT DATA                                00122000
  123.          MVC   #FILES,NSENT+2      | RECORD NUMBER OF FILES SENT        00123000
  124.          MVI   TYPE,C'S'           | ASSUME "SEND" DIRECTION            00124000
  125.          LTR   R0,R0               | IS IT RECEIVE?                     00125000
  126.          BZ    GETDATM             | NO, A SEND ...                     00126000
  127.          MVI   TYPE,C'R'           | INDICATE "RECEIVE" DIRECTION       00127000
  128.          SPACE ,                                                        00128000
  129. * -- GET DATE AND TIME                                                  00129000
  130. GETDATM  EQU   *                                                        00130000
  131.          LA    R2,DIAGC            | R2 -> AVAILABLE 4-DWORD BUFFER     00131000
  132.          DIAG  R2,R2,X'C'          | GET DATE AND TIME                  00132000
  133.          SPACE ,                                                        00133000
  134. * -- CONVERT DATE AND TIME TO PACKED DECIMAL IN ACCOUNT RECORD          00134000
  135.          LM    R1,R2,=A(MMDDYY,DATE) | R1/R2 -> DATE/OUTPUT FIELDS      00135000
  136.          BAL   R10,PACKIT            | CONVERT THE DATA                 00136000
  137.          LM    R1,R2,=A(HHMMSS,TIME) | R1/R2 -> TIME/OUTPUT FIELDS      00137000
  138.          BAL   R10,PACKIT            | CONVERT THE DATA                 00138000
  139.          SPACE ,                                                        00139000
  140. * -- INSERT LOGON USERID IN ACCOUNT RECORD                              00140000
  141.          LA    R2,DIAG0            | R2 -> DIAG0 DATA BUFFER            00141000
  142.          LA    R4,24               | NEED ONLY 24 BYTES                 00142000
  143.          DIAG  R2,R4,X'0'          | ... LAST 8 BYTES IS USERID         00143000
  144.          SPACE ,                                                        00144000
  145.          AIF   (NOT &FILE).D4C                                          00145000
  146. * -- SAVE RECORD IN ACCOUNT DATA FILE                                   00146000
  147.          FSWRITE FSCB=OUTFILE      | WRITE RECORD TO DATA FILE          00147000
  148.          FSCLOSE FSCB=(R1)         | CHECKPOINT CLOSE                   00148000
  149.          AGO   .EXIT                                                    00149000
  150. .D4C     AIF   (NOT &D4C).PUNCH                                         00150000
  151.          LA    R2,BUFFER+8         | R2 -> ACCOUNT DATA BUFFER          00151000
  152.          LA    R4,X'10'            | R4 = "C0" ACCOUNT RECORD FUNCTION  00152000
  153.          LA    R5,BUFFERL-8        | R5 = ACCOUNT DATA LENGTH           00153000
  154.          DIAG  R2,R4,X'4C'         | CUT C0 ACCOUNT RECORD              00154000
  155.          AGO   .EXIT                                                    00155000
  156. .PUNCH   AIF   (NOT &PUNCH).SMSG                                        00156000
  157.          AIF   (NOT &PTEMP).NODFP                                       00157000
  158.          LA    R2,DFPUN      R2 -> "DEFINE PUNCH" command               00158000
  159.          LA    R4,DFPUNL     R4 = Length of CP command                  00159000
  160.          DIAG  R2,R4,X'8'    Define punch                               00160000
  161.          LTR   R4,R4                                                    00161000
  162.          BNZ   NODF          Failed, cannot send record                 00162000
  163. .NODFP   ANOP                                                           00163000
  164.          LA    R2,SPPUN            | R2 -> "SPOOL PUNCH" COMMAND        00164000
  165.          LA    R4,L'SPPUN          | R4 = LENGTH OF CP COMMAND          00165000
  166.          DIAG  R2,R4,X'8'          | SPOOL PUNCH TO TARGET USER         00166000
  167.          LTR   R4,R4                                                    00167000
  168.          BNZ   NOSP                                                     00168000
  169.          LA    R2,PUNCCWS          | R2 -> PUNCH CCWS                   00169000
  170.          USING NUCON,0                                                  00170000
  171.          DMSEXS ST,R2,CAW          | SET CHANNEL ADDRESS WORD           00171000
  172.          DROP  0                                                        00172000
  173.          SIO   X'&PCUU'            | PUNCH THE ACCOUNT BUFFER           00173000
  174.          BC    2,*-4                                                    00174000
  175.          TIO   X'&PCUU'            | CLEAR ANY PENDING STATUS ON PUNCH  00175000
  176.          BC    2,*-4                                                    00176000
  177.          AIF   (&PTEMP).DETP                                            00177000
  178.          LA    R2,CLPUN            | R2 -> "CLOSE PUNCH" COMMAND        00178000
  179.          LA    R4,CLPUNL           | R4 = LENGTH OF COMMAND             00179000
  180.          DIAG  R2,R4,X'8'          | CLOSE SPOOL FILE                   00180000
  181. .DETP    ANOP                                                           00181000
  182. NOSP     DS    0H                                                       00182000
  183.          AIF   (NOT &PTEMP).DONEP                                       00183000
  184.          LA    R2,DTPUN      R2 -> "DETACH PUNCH" command               00184000
  185.          LA    R4,L'DTPUN    R4 = Length of CP command                  00185000
  186.          DIAG  R2,R4,X'8'    Detach it                                  00186000
  187. NODF     DS    0H                                                       00187000
  188. .DONEP   ANOP                                                           00188000
  189.          B     KEXIT                                                    00189000
  190.          SPACE ,                                                        00190000
  191. * -- WORK AREA FOR PUNCH DISPOSITION                                    00191000
  192. PUNCCWS  CCW   X'01',BUFFER,X'60',BUFFERL                               00192000
  193.          CCW   X'03',*,X'20',1                                          00193000
  194. DFPUN    EQU   *                                                        00194000
  195.          DC    C'SET IMSG OFF',X'15'   Kermit changes IMSG each time    00195000
  196.          DC    C'DEFINE PUNCH &PCUU'                                    00196000
  197. DFPUNL   EQU   *-DFPUN                                                  00197000
  198. SPPUN    DC    C'SPOOL &PCUU TO &ADEST CLASS K DEST KERMACCT'           00198000
  199. CLPUN    DC    C'CLOSE &PCUU NAME KERMIT ACCT'                          00199000
  200. CLPUNL     EQU *-CLPUN                                                  00200000
  201. DTPUN    DC    C'DETACH &PCUU'                                          00201000
  202.          DS    0H                                                       00202000
  203.          AGO   .EXIT                                                    00203000
  204. .SMSG    AIF   (NOT &SMSG AND NOT &MSG).EXIT                            00204000
  205.          LA    R2,BUFFER+BUFFERL   End of stuff to hexify               00205000
  206.          LA    R3,BUFFERL-16(,R2)  End of extended buffer               00206000
  207.          LA    R4,(BUFFERL-16)/4   Words to hexify                      00207000
  208. SMSGLP   SH    R2,=H'4'      Work backwards to avoid overlap            00208000
  209.          SH    R3,=H'8'                                                 00209000
  210.          UNPK  UPBUF,0(5,R2) Hexify                                     00210000
  211.          MVC   0(8,R3),UPKBUF                                           00211000
  212.          TR    0(8,R3),TRHEX                                            00212000
  213.          BCT   R4,SMSGLP                                                00213000
  214.          MVC   CPMSG(&LMCMD),=C'&MCMD'                                  00214000
  215.          LA    R2,CPMSG      R2 -> MSG command (includes buffer)        00215000
  216.          LA    R4,LCPMSG     R4 = length of command                     00216000
  217.          ICM   R4,8,=X'40'   Catch reply, if any                        00217000
  218.          LA    R3,UPKBUF                                                00218000
  219.          LA    R5,1          Tiny length for reply buffer               00219000
  220.          DIAG  R2,R4,X'8'    Send msg, if possible                      00220000
  221. *        B     KEXIT                                                    00221000
  222. .EXIT    ANOP                                                           00222000
  223.          SPACE ,                                                        00223000
  224. * -- COMMON EXIT TO CALLER                                              00224000
  225. KEXIT    EQU   *                                                        00225000
  226.          LM    R14,R12,12(R13)                                          00226000
  227.          SLR   R15,R15             | SET RETURN CODE = 0                00227000
  228.          BR    R14                                                      00228000
  229.          SPACE ,                                                        00229000
  230. *---------------------------------------------------------------------* 00230000
  231. * PACKIT   - CONVERT MM/DD/YY OR HH:MM:SS TO 4-BYTE PACKED DECIMAL    * 00231000
  232. *                                                                     * 00232000
  233. * ENTRY CONDITIONS:                                                   * 00233000
  234. *   R1 -> HH:MM:SS OR MM/DD/YY                                        * 00234000
  235. *   R2 -> 4-BYTE OUTPUT FIELD                                         * 00235000
  236. *   R10 = RETURN ADDRESS                                              * 00236000
  237. *---------------------------------------------------------------------* 00237000
  238. PACKIT   EQU   *                                                        00238000
  239.          MVC   2(2,R1),3(R1)       | SLIDE SECOND FIELD LEFT 1 BYTE     00239000
  240.          MVC   4(2,R1),6(R1)       | SLIDE THIRD FIELD LEFT 1 BYTE      00240000
  241.          PACK  0(4,R2),0(6,R1)     | CONVERT TO PACKED IN OUTPUT FIELD  00241000
  242.          BR    R10                                                      00242000
  243.          EJECT                                                          00243000
  244. *---------------------------------------------------------------------* 00244000
  245. *                    W O R K I N G   S T O R A G E                    * 00245000
  246. *---------------------------------------------------------------------* 00246000
  247.          AIF   (NOT &FILE).FSCBZ                                        00247000
  248. * -- FSCB FOR ACCOUNT DATA FILE                                         00248000
  249. OUTFILE  FSCB  'KERMIT DATA A',BUFFER=BUFFER,NOREC=1,RECFM=F            00249000
  250.          ORG   OUTFILE+(FSCBSIZE-FSCBD)                                 00250000
  251.          DC    A(BUFFERL)          | FORCIBLY INSERT BUFFER LENGTH      00251000
  252.          ORG   ,                   | RESET LOCATION COUNTER             00252000
  253. .FSCBZ   ANOP                                                           00253000
  254.          SPACE ,                                                        00254000
  255. * -- REGISTERS FOR "CP Q CONSOLE" VIA DIAGNOSE 8, RESPONSE IN MEMORY    00255000
  256. QCONREGS DC    A(QCON)             | RX   -> "CP Q CONSOLE"             00256000
  257.          DC    A(DIAGC)            | RX+1 -> RESPONSE BUFFER            00257000
  258.          DC    X'40',AL3(L'QCON)   | RY   =  CP COMMAND LENGTH          00258000
  259.          DC    A(BUFFERL+24)       | RY+1 =  RESPONSE BUFFER LENGTH     00259000
  260. QDEV     DC    C'Q V '                                                  00260000
  261. QDEVNO   DC        C'     '  Space for CUU of line                      00261000
  262. QCON     DC    C'Q V CONSOLE'      | CP COMMAND (DIAG8 TARGET)          00262000
  263.          SPACE ,                                                        00263000
  264. * -- DIAGC RESPONSE BUFFER (OVERLAPS DIAG0 RESPONSE BUFFER)             00264000
  265. DIAGC    DS    0D                                                       00265000
  266. MMDDYY     DS  D                   | -- DATE, IN MM/DD/YY FORMAT        00266000
  267. HHMMSS     DS  D                   | -- TIME, IN HH:MM:SS FORMAT        00267000
  268.          SPACE ,                                                        00268000
  269. * -- DIAG0 RESPONSE BUFFER (OVERLAPS ACCOUNT RECORD)                    00269000
  270.          ORG   HHMMSS                                                   00270000
  271. DIAG0    DS    0D                                                       00271000
  272. SYSN       DS  D                   | -- "VM/SP"                         00272000
  273. STIDP      DS  D                   | -- STIDP DATA                      00273000
  274. USERID     DS  D                   | -- LOGON USERID                    00274000
  275.          SPACE ,                                                        00275000
  276. * -- DIAGC BUFFER OVERLAYS FOR USE BY DIAG8                             00276000
  277. DISC     EQU   DIAGC+9,10          | "DISCONNECTED" MESSAGE, MAYBE      00277000
  278. DEV      EQU   DIAGC+12,8          | "GRAF XXX"/"LDEV XXX"/<LUNAME>     00278000
  279.          SPACE ,                                                        00279000
  280. * -- ACCOUNT RECORD                                                     00280000
  281. BUFFER   EQU   USERID,8            | (BUFFER BEGINS WITH LOGON USERID)  00281000
  282. DEVID    DS    CL8                 | CUU OR LUNAME OF CONSOLE           00282000
  283. FLAG     DC    C'K'                | INDICATES KERMIT ACCOUNT DATA      00283000
  284. TYPE     DS    C                   | S/R FOR "SEND"/"RECEIVE"           00284000
  285. #FILES   DS    H                   | NUMBER OF FILES SENT/RECEIVED      00285000
  286. DATE     DS    F                   | DATE IN PACKED FORMAT              00286000
  287. TIME     DS    F                   | TIME IN PACKED FORMAT              00287000
  288. $TOUTOT    DS  2F                  | -- TOTAL BYTES SENT                00288000
  289. $TINTOT    DS  2F                  | -- TOTAL BYTES RECEIVED            00289000
  290. $DSKTOT    DS  2F                  | -- TOTAL BYTES OF DISK I/O         00290000
  291. $SL1       EQU *-$TOUTOT                                                00291000
  292. $PAKCNT    DS  F                   | -- TOTAL PACKETS SENT/RECEIVED     00292000
  293. $RTRCNT    DS  F                   | -- NUMBER OF RETRIES               00293000
  294. $SECTOT    DS  F                   | -- TRANSFER TIME IN SECONDS        00294000
  295. $SL2       EQU *-$PAKCNT                                                00295000
  296. $STATSL    EQU *-$TOUTOT                                                00296000
  297. BUFFERL  EQU   *-BUFFER                                                 00297000
  298.          AIF   (NOT &SMSG AND NOT &MSG).BUFMZ                           00298000
  299.          DS    XL(BUFFERL-16)                                           00299000
  300. CPMSG    EQU   BUFFER-&LMCMD Allow room for "MSG user"                  00300000
  301. LCPMSG   EQU   *-CPMSG                                                  00301000
  302. UPBUF    DS    XL9           Must include a spare                       00302000
  303.          SPACE ,                                                        00303000
  304. TRHEX    EQU   *-C'0'        Hexifying mask                             00304000
  305.          DC    C'0123456789ABCDEF'                                      00305000
  306.          SPACE ,                                                        00306000
  307. .BUFMZ   ANOP                                                           00307000
  308.          SPACE ,                                                        00308000
  309.          LTORG ,                                                        00309000
  310.          SPACE ,                                                        00310000
  311. * -- MAP FOR KERMIT STATISTICS PACKAGE                                  00311000
  312. KSTATS   DSECT                                                          00312000
  313. NSENT    DS  F                     | -- NUMBER OF FILES SENT            00313000
  314. TOUTOT   DS  2F                    | -- TOTAL BYTES SENT                00314000
  315. TINTOT   DS  2F                    | -- TOTAL BYTES RECEIVED            00315000
  316. DSKTOT   DS  2F                    | -- TOTAL BYTES OF DISK I/O         00316000
  317. SSVDSK   DS  2F                    | -- SAVED DISK BYTE COUNT           00317000
  318. PAKCNT   DS  F                     | -- TOTAL NUMBER OF PACKETS MOVED   00318000
  319. RTRCNT   DS  F                     | -- NUMBER OF RETRIES               00319000
  320. SECTOT   DS  F                     | -- TRANSFER TIME IN SECONDS        00320000
  321. CSECTOT  DS  F                     | -- TRANSFER TIME IN CSECS          00321000
  322. RECTRC   DS  F                     | -- RECORD TRUNCATION COUNT         00322000
  323. RECFLD   DS  F                     | -- RECORD FOLDING COUNT            00323000
  324. EMSGL    DS  F                     | -- LENGTH OF MESSAGE               00324000
  325. TINSV    DS  12F                   | -- 3 PROGRESS SNAPSHOTS            00325000
  326.          END                                                            00326000
  327.