Columbia Kermit

home *** CD-ROM | disk | FTP | other *** search

/ Columbia Kermit / kermit.zip / ibm370 / ikcact.asm < prev next >

Wrap

Assembly Source File | 2020-01-01 | 26KB | 327 lines

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