|
DataMuseum.dkPresents historical artifacts from the history of: IBM System/3 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about IBM System/3 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 10668 (0x29ac)
Types: s3xseg
Names: »S$E090«
└─⟦d0bc1a931⟧ Bits:30009189 5704-sc1.V08.ccp
└─⟦64693a1c9⟧
└─⟦this⟧ »S$E090«
MACRO 00010000
$E090 00020000
GBLB &NDF,&NOM,&NRUF,&NPBY 00030000
TEXT 00040000
* R-05,C-00 CHANGE LEVEL 00040100
TITLE '$E090 - PROCESS SATISFIED ACCEPT INPUT' 00050000
*********************************************************************** 00060000
* * 00070000
* TITLE: 'CMACI' * 00080000
* * 00090000
* FUNCTION: SATISFY ACCEPT OPERATION AFTER AN INVITE OP ENDS. * 00100000
* * 00110000
* OPERATION: * 00120000
* . SET FIELDS IN ACCEPT PARAMETER LIST TO REFLECT DATA RECEIVED.* 00130000
* . IF DFF TERMINAL, QUEUE ACCEPT REQUEST FOR $CC4DF AND EXIT. * 00140000
* . MOVE DATA TO THE ACCEPT RECORD AREA. * 00150000
* . FREEMAIN INVITE GETMAIN AREAS. * 00160000
* . EXIT TO CMPAII TO POST ACCEPT COMPLETE. * 00170000
* * 00180000
* INPUT: XR1 -> ACCEPT PARAMETER LIST ADDRESS. * 00190000
* * 00190100
* OUTPUT: OUTPUT WILL BE THE DATA IN THE USER RECORD AREA. * 00200000
* * 00200100
* EXTERNAL ROUTINES USED: * 00200200
* CMMVRT - CM MOVE ROUTINE INTERFACE. * 00200300
* $CC4FR - CM FREEMAIN AREAS ASSOCIATED WITH PL. * 00200400
* * 00200500
* EXITS-NORMAL: TO CMPAII TO POST ACCEPT SATISFIED. * 00200600
* * 00210000
*********************************************************************** 00220000
SPACE 2 00230000
CMACI EQU * ACCEPT INPUT SATISFIED 00240000
SPACE 1 00250000
*********************************************************************** 00260000
* SET UP USER RECORD AREA 00270000
*********************************************************************** 00280000
SPACE 00290000
L PLTUBA(,PL),XR2 LOAD POINTER TO THE TUB 00300000
SPACE 00310000
* BEGIN TO PLUG USER'S ACCEPT INPUT PARM LIST 00320000
SPACE 00330000
TBN TUBAT2(,XR2),TUBIMI IS THIS A PROGRAM REQUEST? 00340000
JF CMNOPR BRANCH IF NOT 00350000
SLC PLEFFL(2,PL),PL$RTC(,PL) DECR DATA LENGTH PROGRAM NAME 00360000
* * LENGTH IN ACCEPT PL. 00370000
AIF (&NRUF).T0200 00370600
TBN TUBCHR(,XR2),TUBLNE BSCA LINE, AND WB 00371800
TBF TUBSCS(,XR2),TUBRUF * NOT RUF, AND WB 00372400
L TUBTCB(,XR2),XR2 XR2-> TCB OWNING THIS TUB. WB 00373000
TBN TCBDMG(,XR2),TCBRUF * PROGRAM SUPPORT RUF ? WB 00373600
L PLTUBA(,PL),XR2 XR2-> TUB. WB 00374200
JF CMNOPR NO-GO HANDLE AS NORMAL. WB 00374800
L TUBPL@(,XR2),XR2 XR2-> INVITE PARM LIST. WB 00375400
MVI PLRTC-1(,PL),RCOK RETURN CODE = 0002; NON-RUF WB 00376000
MVI PLRTC(,PL),RCXEOT * FOR A RUF PROGRAM. WB 00376600
J CMBGPG GO MOVE THE DATA. WB 00377200
.T0200 ANOP 00378400
CMNOPR EQU * * LOCAL 00380000
L TUBPL@(,XR2),XR2 POINT TO 'INVITE' PARM LIST 00390000
MVC PLRTC(2,PL),PLRTC(,XR2) MOVE RETURN CODE FROM INV PARM 00400000
* XR1 POINTS TO 'ACCEPT' PARM LIST AND XR2 POINTS TO 'INVITE'. 00410000
SPACE 00420000
* DETERMINE IF OPERATION WAS SUCCESSFUL OR NOT 00430000
SPACE 00440000
CLI PLRTC(,XR2),RCXEDT CHECK AGAINST HIGHEST RETURN FOR 00450000
* WHICH DATA ACCOMPANIES THE PL. 00460000
JNH CMBGPG DATA WITH PARAMETER LIST. 00470000
SPACE 1 00480000
*------------------------------------------------------------------* 00490000
* NO DATA WITH INVITE PARAMETER LIST * 00500000
*------------------------------------------------------------------* 00510000
SPACE 1 00520000
* ZERO INPUT LENGTH - $CC4MX WILL BLANK USERS REC AREA IF PLEFFL=0. 00590000
SPACE 00600000
SLC PLEFFL(2,XR2),PLEFFL(,XR2) ZERO EFFECTIVE INPUT LENGTH 00620000
AIF (&NDF).D0100 00630000
MVI PL$OPC(,XR1),BRNOP NOOP THE BRANCH TO DFF FB 00640000
.D0100 ANOP 00650000
SPACE 00660000
*------------------------------------------------------------------* 00670000
* DATA WITH INVITE PARAMETER LIST * 00680000
*------------------------------------------------------------------* 00690000
SPACE 1 00700000
CMBGPG EQU * BEGIN TO PLUG USER PARM LIST 00710000
MVC #CMMVL+MVLTOL,PLINL(2,PL) MOVE TARGET LENGTH TO MOVE LIST 00720000
MVC PLEFFL(2,PL),PLEFFL(,XR2) MOVE INVITE EFFL LENGTH TO ACEPT 00730000
L PLTUBA(,XR1),XR1 POINT TO THE TUB 00740000
L TUBTCB(,XR1),XR1 POINT TO THE USER'S TCB 00750000
L TCBWK(,XR1),XR1 POINT TO USER'S RECORD AREA 00760000
LA 6(,XR1),XR1 BUMP XR1 TO 1ST BYTE OF DATA 00770000
ST #CMMVL+MVLTOA,XR1 STORE ADDRESS IN MOVE LIST 00780000
SPACE 00790000
AIF (&NDF).D0130 00800000
L CMSPL,PL RESTORE POINTER TO PARM LIST FB 00810000
L PLTUBA(,PL),XR2 POINT TO THE TUB FB 00820000
TBN TUBTA1(,XR2),TASDFF IS THIS A DFF TERMINAL? FB 00830000
L TUBPL@(,XR2),XR2 RESTORE INVITE PARM LIST PTR FB 00840000
JF CMNMAP BRANCH IF NO DFF FB 00850000
SPACE 00860000
MVC CMBRCH+1,PL$OPC(1,XR1) SET CONDITION CODE IN BRANCH FB 00870000
CMBRCH B CMDFFQ Q QUEUE UP REQUEST FOR DFF FB 00880000
SPACE 00890000
.D0130 ANOP 00900000
L CMSPL,PL RESTORE ACCEPT PL ADDRESS 00910000
L PLTUBA(,PL),XR2 POINT TO THE TUB 00920000
AIF (&NDF).D0140 00940000
CLI PL$OPC(,PL),BR97 WAS DFF CALLED? FB 00950000
AIF (&NRUF).T0200 00950500
JNE CMNLOD NO-GO LOAD REG, CHECK EFFL. FWB 00951000
TBN TUBAT2(,XR2),TUBIMI DATA WITH PROGRAM REQUEST ? FWB 00951500
JF CMBPAI NO-GO POST RESULTS. FWB 00952000
L TUBPL@(,XR2),XR2 XR2-> INVITE PARM LIST. FWB 00952500
L PLRECA(,XR2),XR1 XR1-> DATA RECORD. FWB 00953000
A X$FFFF,XR1 XR1-> LAST BYTE GETMAIN PL. FWB 00953500
MVC CMMOVE+2,PL$RTC(1,XR2) SET UP LEN. FOR GM PL MOVE. FWB 00954000
CMMOVE EQU * BUMP GETMAIN PARM LIST UP FWB 00954500
MVC #(,XR1),0(4,XR1) * TO DFF DATA AREA. FWB 00955000
ALC PLRECA(,XR2),PL$RTC(2,XR2) BUMP RECORD @ PAST PRMNAME. FWB 00955500
CMBPAI EQU * * FWB 00956000
B CMPAII GO POST RESULTS OF OPERATION.FWB 00956500
SPACE 00957000
CMNLOD EQU * * FWB 00957500
L PLTUBA(,PL),XR2 XR2-> TUB. FWB 00958000
AGO .T0400 00958500
.T0200 BE CMPAII YES-GO POST RESULTS TO USER. FB 00959000
.T0400 ANOP 00959500
.D0140 ANOP 00980000
L TUBPL@(,XR2),XR2 XR2-> INVITE PARM LIST. 00982000
CMNMAP EQU * * 00984000
CLC PLINL(2,PL),PLEFFL(,XR2) DOES INVITE HAVE MORE DATA 00990000
* * THAN ACCEPT WANTS ? 01000000
JNL CMGTRA NO - CAN RETURN ALL INVITE DATA. 01010000
SPACE 01020000
* HAVE ACCEPT INPUT WHOSE INPUT LENGTH IS LESS THAN THE EFFECTIVE 01030000
* LENGTH OF THE INVITE, THEREFORE SET ACCEPT EFFECTIVE LENGTH TO ITS 01040000
* REQUESTED LENGTH, AND TRUNCATE DATA. 01050000
SPACE 01060000
SBN PLRTC(,PL),RCXDTR SET DATA TRUNCATED BIT IN RT COD 01070000
MVC PLEFFL(2,PL),PLINL(,PL) SET ACCEPT EFFL TO REQ'D LENGTH 01080000
SPACE 01090000
CMGTRA EQU * * LOCAL 01100000
SPACE 1 01110000
*********************************************************************** 01120000
* MOVE DATA FROM INVITE HOLD BUFFER TO USER RECORD AREA 01130000
*********************************************************************** 01140000
SPACE 01150000
MVC #CMMVL+MVLFRA(2),PLRECA(,XR2) MOVE IN SOURCE ADDR FOR MOVE 01160000
SPACE 01170000
L PLTUBA(,XR2),XR1 POINT TO THE TUB 01180000
TBN TUBAT2(,XR1),TUBIMI IS PROGRAM NAME SITTING IN SOURC 01190000
* FILED AREA 01200000
JF CMDOIT JUMP IF NO PROGRAM NAME IN AREA 01210000
SPACE 01220000
* BUMP THE SOURCE RECORD AREA ADDRESS PAST THE PROGRAM NAME 01230000
* THE AMOUNT TO BUMP THE ADRESS BY RESIDES IN PL$RTC OF THE INVITE 01240000
* PARAMETER LIST. 01250000
SPACE 01260000
ALC #CMMVL+MVLFRA(2),PL$RTC(,XR2) BUMP ADDR PAST PROGRAM NAME 01270000
SPACE 01280000
CMDOIT EQU * DO THE MOVE NOW 01290000
* ----START---------------------------- @26 01291000
CLI PLRTC(,XR2),RCXEDT RETURN CODE > THREE AND 01292000
TBN TUBTA1(,XR1),TASDFF THIS A DFF TERMINAL ? 01293000
JC CMNOBK,TRUAHI YES-DON'T BLANK USER'S REC AREA 01294000
* ----END------------------------------ @26 01295000
MVI #CMMVL+MVLTYP,SWAPTO SET TRANSLATE ON FOR MOVE 01300000
LA 0(,XR2),XR1 POINT TO INVITE PARAMETER LIST 01310000
SPACE 1 01320000
* MOVE DATA - FROM LENGTH IS SET FROM PLEFFL OF INVITE PARAMETER LIST 01330000
* IF ZERO (NO DATA), THE ACCEPT RECORD AREA WILL BE 01340000
* BLANKED. 01350000
SPACE 1 01360000
B CMMVRT BR TO MOVE AND CLEAR ROUTINE 01370000
SPACE 2 01380000
*********************************************************************** 01390000
* FREEMAIN THE INVITE INPUT HOLD BUFFER 01400000
*********************************************************************** 01410000
SPACE 01420000
CMNOBK EQU * * LOCAL 01425000
L CMSPL,XR1 RESTORE PARAMETER LIST POINTER 01430000
L PLTUBA(,XR1),XR2 RESTORE TUB POINTER 01440000
SBF TUBAT2(,XR2),TUBIMI SET IMPLICIT INVITE BIT OFF 01450000
TBN TUBAT1(,XR2),TUBKNM IS CONSOLE PGM REQ DATA ? 01460000
JF CMNOKN NO - BYPASS RESET OF CONSOLE 01470000
SBF $AMFLG,$AMPF9 YES- RESET PF9 FOR CONSOLE 01480000
CMNOKN EQU * * LOCAL 01490000
L TUBPL@(,XR2),PL POINT TO INVITE PARM LIST 01500000
SPACE 1 01510000
B $CC4FR FREE INVITE GETMAINED AREAS 01520000
SPACE 1 01530000
SBN CMSWIT,CMTPRQ SET BIT SO ACCEPT PL WILL BE 01540000
* * POSTED 01550000
TITLE '$E090/CMPAII----DETERMINE-IF-POST-NEEDED' 01560000
*********************************************************************** 01570000
* * 01580000
* NAME--CMPAII * 01590000
* * 01600000
* TITLE--DETERMINE IF POST IS NEEDED * 01610000
* * 01620000
* FUNCTION--POST CALLER THAT THE IO REQUEST NEEDED TO ACCOMPLISH * 01630000
* HIS REQUEST HAS BEEN SCHEDULED AND THEN CHECK FOR * 01640000
* DTF TO BE RESCHEDULED AFTER OLT FAILED. * 01650000
* * 01660000
* ENTRY POINTS- CMPAII -POST REQUESTOR IF TP SCHEDULED * 01670000
* CMRQBF -CHECK FOR MORE WORK TO BE PERFORMED * 01680000
* * 01680100
* EXITS-NORMAL: * 01680200
* TO CMMTBY - IF MLTA DTF TO START AFTER OLT. * 01680300
* TO CMOPND - CHECK FOR MORE WORK. * 01680400
* * 01680500
******************************************************************** 01690000
SPACE 01700000
CMPAII EQU * DETERMINE IS POST NEEDED 01710000
TBN CMSWIT,CMTPRQ WAS TP REQUEST SCHEDULED 01720000
JF CMTSRQ JUMP IF NOT ON 01730000
SPACE 01740000
L CMNWPL,PL ORIGINAL PL TO BE POSTED 01750000
* 01750200
* BUSY PRINTER SUPPORT 01750400
* 01750600
AIF (&NPBY).NBY06 BUSY PRINTER SUPPORTED 01750800
L PLTUBA(,PL),XR2 XR2-----> TUB 01751000
TBN TUBAT4(,XR2),TUBWAT THIS A BUSY PRINTER OPERATION? 01751200
JT CMRQBF YES - SKIP POST AT THIS TIME 01751400
.NBY06 ANOP 01751600
* --------------------------------------@16 01752000
TBN PLOPM(,PL),OPDISC DISCONNECT OPERATION ? 01754000
JT CMDISC YES - POST 01756000
* --------------------------------------@16 01758000
TBF PL$OPM(,PL),OPNOW IS IT WAIT OP 01760000
JT CMRQBF IF WAIT OP, SKIP POST 01770000
SPACE 01780000
******************************************************************** 01790000
* PUT NO WAIT, INVITE OR PUT DISCONNECT - POST SCHEDULED * 01800000
******************************************************************** 01810000
CMDISC EQU * * LOCAL 01815000
SPACE 01820000
LA PLECB(,PL),XR1 ADDRESS OF ECB FOR REQUEST 01830000
SVC 0 POST $CC4II OR $CC4IS 01840000
DC AL1(POSTRB) * THAT NO WAIT OP SCHEDULED 01850000
SPACE 2 01860000
******************************************************************** 01870000
* DETERMINE IF OLT FAILED, IF SO RESCHEDULE LINE. * 01880000
* (ENTER HERE WHEN NO POST NEEDED - AFTER STOP INVITE) * 01890000
******************************************************************** 01910000
SPACE 01920000
CMRQBF EQU * * 01930000
SBF CMSWIT,CMTPRQ TURN OFF TP REQUEST SWITCH 01940000
CMTSRQ EQU * * LOCAL 01950000
AIF (&NOM).M0580 01960000
TBN CMSWIT,CMNOST DID ONLINE TEST START FAIL M 01970000
SBF CMSWIT,CMNOST SET OFF ONLINE TEST NOT STARTEDM 01980000
BT CMMTBY BRANCH IF OLT START FAILED M 01990000
.M0580 ANOP 02000000
B CMOPND CHECK FOR MORE WORK 02010000
MEND 02020000