|
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: 3302 (0xce6)
Types: s3xseg
Names: »S$PKBU«
└─⟦34f897e8c⟧ Bits:30009186 5702-sc1.V16.scp
└─⟦e1bdf435f⟧
└─⟦this⟧ »S$PKBU«
MACRO 00010000
&ID $PKBU &OPC-SET,&DTF-,&RECL-,&REPLY-,&SPACE-,&REQK-,&FILL-, X00020000
&RCAD-,&ERR-,&EOF-,&CHK-,&RTN- 00030000
GBLB &$PKB 00520000
TABLE &OPC 00540000
GET TABDF GET 00550000
PUT TABDF PUT 00560000
WTOR TABDF WTOR 00570000
SET TABDF OK 00580000
TABDF '''OPC' 00590000
TABLE &REQK 00610000
Y TABDF SBN 00620000
N TABDF SBF 00630000
'' TABDF OK 00640000
TABDF '''REQK' 00650000
TABLE &FILL 00670000
Y TABDF SBN 00680000
N TABDF SBF 00690000
'' TABDF OK 00700000
TABDF '''FILL' 00710000
TABLE &CHK 00730000
N TABDF SBF 00740000
Y TABDF SBN 00750000
'' TABDF OK 00760000
TABDF '''CHK' 00770000
TABLE &RTN 00790000
Y TABDF SBN 00800000
N TABDF SBF 00810000
'' TABDF OK 00820000
TABDF '''RTN' 00830000
TEXT 00840000
* PRINTER/KEYBOARD LINKAGE RELEASE-7 00850000
SPACE 00860000
AIF (&$PKB).A 00870000
$CEOF EQU X'42' END OF FILE. 00880000
$CERR EQU X'41' PERMIN NT ERROR. 00890000
$CFILL EQU X'02' FILL INPUT BUFFER. 00900000
$CGET EQU X'80' GET OP. 00910000
$CRETN EQU X'04' RETURN BIT IN 2ND OP BYTE. 00920000
$COP EQU X'C0' OP BITS. 00930000
$CPUT EQU X'40' PUT OP. 00940000
$CREQ EQU X'10' REQUEST KEY INPUT. 00950000
$CHECK EQU X'08' CHECK BIT IN 2ND OP BYTE. 00960000
$CWTOR EQU X'C0' WTOR OP. 00970000
SPACE 2 00980000
&$PKB SETB 1 00990000
.A AIF (T'&ID EQ '').C 01000000
&ID EQU * 01010000
.C AIF (T'&DTF EQ '').E 01020000
LA &DTF,$DTF LOAD DTF ADDR. 01030000
.E AIF (&OPC EQ 'OK').G 01040000
SBF $CDOP2(,$DTF),$COP SET OFF OPERATION BITS. 01050000
SBN $CDOP2(,$DTF),$C&OPC SET REQUESTED OPERATION. 01060000
AGO .J 01070000
.G TBF $CDOP2(,$DTF),$COP PREVIOUS OP ? 01080000
JF $OK&SYSNDX YES-CONTINUE. 01090000
SBN $CDOP2(,$DTF),$CPUT NO-SET OP FOR PUT. 01100000
$OK&SYSNDX EQU * 01110000
.J AIF (T'&RECL EQ '').L 01120000
MVI $CDCT1(,$DTF),&RECL MOVE IN RECORD LENGTH. 01130000
.L AIF (T'&REPLY EQ '').N 01140000
MVI $CDCT2(,$DTF),&REPLY MOVE IN REPLY LENGTH. 01150000
.N AIF (T'&SPACE EQ '').P 01160000
MVI $CDSPC(,$DTF),X'&SPACE' MOVE IN SPACE SPEC. 01170000
.P AIF (T'&RCAD EQ '').R 01180000
MVC $CDIO2(2,$DTF),$IO&SYSNDX MOVE IN RECORD ADDR. 01190000
MVC $CDLRA(2,$DTF),$CDIO2(,$DTF) MOVE TO LOG. REC. ADDR. 01200000
.R AIF (&REQK EQ 'OK').S 01210000
&REQK $CDOPR(,$DTF),$CREQ SET REQ. KEY ID FOR INPUT. 01220000
.S AIF (&FILL EQ 'OK').T 01230000
&FILL $CDOPR(,$DTF),$CFILL SET EXACT INDICATOR. 01240000
.T AIF (&CHK EQ 'OK').U 01250000
&CHK $CDOP2(,$DTF),$CHECK SET THE CHECK OPTION. 01260000
.U AIF (&RTN EQ 'OK').V 01270000
&RTN $CDOP2(,$DTF),$CRETN SET THE RETURN OPTION. 01280000
.V B $$COAM CALL CONSOLE DM. 01290000
AIF (T'&EOF EQ '').W 01300000
CLI $CDCMP(,$DTF),$CEOF END OF FILE ? 01310000
BE &EOF YES-EXIT TO EOF RTN. 01320000
.W AIF (T'&ERR EQ '').X 01330000
TBN $CDCMP(,$DTF),$CERR ERROR ? 01340000
BT &ERR YES-GO TO ERROR ROUTINE. 01350000
.X AIF (T'&RCAD EQ '').Y 01360000
J $NX&SYSNDX EXIT THIS ROUTINE. 01370000
$IO&SYSNDX DC AL2(&RCAD) ADDR OF RECORD AREA. 01380000
$NX&SYSNDX EQU * 01390000
.Y ANOP 01400000
MEND 01410000
EST KEY INPUT. 00710000 $CWTOR EQU X'C0'
WTOR OP. 00720000 SPACE 2
00730000 &$PKB SETB 1
INDICATE INCLUDE GENERATED. 00740000 .A AIF (T'&ID EQ '