|
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: 2032 (0x7f0)
Types: s3xseg
Names: »S$PUTB«
└─⟦34f897e8c⟧ Bits:30009186 5702-sc1.V16.scp
└─⟦e1bdf435f⟧
└─⟦this⟧ »S$PUTB«
MACRO 00010000
&ID $PUTB &DTF-,&REJECT-,&OPC-N 00020000
TABLE &OPC 00420000
N TABDF UT 00430000
EOB TABDF EB 00440000
EOF TABDF EF 00450000
EOW TABDF EW 00460000
TABDF '''OPC' 00470000
TEXT 00480000
* BSCA PUT LINKAGE RELEASE-7 D 00490000
SPACE 00500000
AIF (T'&ID EQ '').A 00510000
&ID EQU * 00520000
.A AIF (T'&DTF EQ '').G 00530000
LA &DTF,$DTF LOAD XR2 WITH DTF ADDR. 00540000
.G CLI $BDCMP(,$DTF),$BCREQ LAST OP DONE ? 00550000
JE $E1&SYSNDX NO-GO POST REQUEST IGNORED. 00560000
TBN $BDATR(,$DTF),$BCOPN OPENED ? 00570000
TBN $BDATT(,$DTF),$BCOUT PUT FILE ? 00580000
JF $E2&SYSNDX NO-GO POST PERM'T ERROR. 00590000
TBN $BDATT(,$DTF),$BCCNV CONVERSATIONAL 00600000
CLI $BDCMP(,$DTF),$BCCRP REPLY PENDING ? 00610000
JC $E3&SYSNDX,$TRU+$HI+$LO YES-GO POST INVALID CALL. 00620000
AIF (&OPC NE 'EF').H 00630000
TBN $BDOPC(,$DTF),$BOPUT PREVIOUS OP A PUT ? 00640000
JF $E1&SYSNDX NO-GO POST REQUEST IQNORED. 00650000
.H MVI $BDOPC(,$DTF),$BOP&OPC SET REQUESTED PUT OPERATION. 00660000
MVI $BDCMP(,$DTF),$BCREQ SET TO OP ACCEPTED. 00670000
AIF (&OPC EQ 'EF').J 00680000
B $$BSMS GO TO BSCA DATA MANAGEMENT. 00690000
ST $S1&SYSNDX+3,$BBAC1 SAVE XR1. 00700000
L $BDIOB(,$DTF),$IOB LOAD IOB ADDR IN XR1. 00710000
CLI $BICMP(,$IOB),$BCCAL Q INVALID CALL POSTED IN IOB? 00720000
$S1&SYSNDX LA *-*,$BBAC1 RESTORE XR1. 00730000
JE $E3&SYSNDX YES-GO TO POST INVALID REQUEST. 00740000
.J J $XT&SYSNDX GO EXIT. 00750000
$E1&SYSNDX MVI $BDCMP(,$DTF),$BCIGN SET REQUEST IGNORED. 00760000
J $RJ&SYSNDX GO EXIT. 00770000
$E2&SYSNDX MVI $BDCMP(,$DTF),$BCUER SET USER ERROR. 00780000
J $RJ&SYSNDX GO EXIT. 00790000
$E3&SYSNDX MVI $BDCMP(,$DTF),$BCCAL SET INVALID CALL. 00800000
$RJ&SYSNDX EQU * 00810000
AIF (T'&REJECT EQ '').N 00820000
B &REJECT GO HANDLE REJECTED COMMAND. 00830000
.N ANOP 00840000
$XT&SYSNDX EQU * 00850000
MEND 00860000