|
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: 14478 (0x388e)
Types: s3xseg
Names: »S$EBEQ«
└─⟦827b5bd03⟧ Bits:30009184 5702-sc1.V16.ccp
└─⟦f17e99db6⟧
└─⟦this⟧ »S$EBEQ«
MACRO 00010000
.********************************************************************** 00020000
.* * 00030000
.* NAME: $EBEQ * 00040000
.* * 00050000
.* MODIFICATION LEVEL: VERSION 13,MODIFICATION LEVEL 0 OF 5702-SC1 * 00060000
.* * 00070000
.* FUNCTION: * 00080000
.* * 00090000
.* . CCP GENERATION SECOND PASS MACRO INSTRUCTION -- DEFINE * 00100000
.* SYMBOLS FOR BSCA -- FOR: * 00110000
.* * 00120000
.* . IOB OFFSETS OFFSETS * 00130000
.* . BSCA WORK AREA OFFSETS * 00140000
.* . POLL/SELECTION LIST OFFSETS * 00150000
.* . CHECK LIST OFFSETS * 00160000
.* . MINIMUN BSCA SYSTEM TRANSIENT ID'S * 00170000
.* . 3270/3735 COMMANDS, ORDERS,BUFFER OFFSETS * 00180000
.* * 00190000
.* INPUT OPERANDS: * 00200000
.* * 00210000
.* . IOB-Y/N: IOB EQUATES (DEFAULT N) * 00220000
.* . WKA-Y/N: BSCA WORK AREA EQUATES (DEFAULT N) * 00230000
.* . POL-Y/N: POLL LIST EQUATES (DEFAULT N) * 00240000
.* . CKL-Y/N: CHECK LIST EQUATES (DEFAULT N) * 00250000
.* . MIN-Y/N: MINIMUN SYSTEM TRANSIENT ID'S. * 00260000
.* . CMD-CM/Y/N: CM-SAME AS IF CMD-Y,ORDS-Y,BUFR-ALL,OUT32-EQU GIVEN* 00270000
.* Y/N - 3270 COMMAND EQUATES (DEFAULT N) * 00280000
.* . ORDS-Y/N: 3270 ORDER EQUATES (DEFAULT N) * 00290000
.* . BUFR-OFSET/AID/ALL/N: OFSET - 3270/3735/3741 LINE BUF OFFSETS. * 00300000
.* AID - 3270 AID EQUATES * 00310000
.* ALL - BOTH OFFSETS AND AID EQUATES * 00320000
.* N - NEITHER OF ABOVE (DEFAULT N) * 00330000
.* . OUT32-ALL/EQU/N: ALL - IGNORES ALL OTHER KEYWORDS. GENERATE * 00340000
.* CCP 3270 OUTPUT BUFFER FORMAT. * 00350000
.* EQU - LENGTH OF CCP 3270 OUTPUT BUFFER FORMAT.* 00360000
.* N - NEITHER OF THE ABOVE (DEFAULT N) * 00370000
.* * 00380000
.********************************************************************** 00390000
.* * 00400000
$EBEQ &IOB-N,&WKA-N,&POL-N,&CKL-N,&MIN-N,&CMD-N,&ORDS-N, X00410000
&BUFR-N,&OUT32-N, X00420000
&BITS-N,&#CMEQ-N,&ARRAD-XX,&XEQ-,&XREG-N,&BCEQ-N 00430000
TABLE &ARRAD 00440000
'' TABDF XX 00450000
TABLE &BUFR 00460000
'' TABDF N 00470000
TABLE &XEQ 00480000
'' TABDF 'XX' 00490000
TABLE &OUT32 00500000
'' TABDF N 00510000
TEXT 00520000
.* OUT32-ALL WILL CAUSE ALL OTHER KEYWORDS TO BE IGNORED. IT WILL 00530000
.* GENERATE ONLY 3270 OUTPUT CONSTANTS AND EQUATES. 00540000
.* OUT32-EQU AND ANY OF THE OTHER KEYWARDS CAN BE USED TOGETHER. 00550000
AIF (&OUT32 EQ 'ALL').OUT32 00560000
AIF (&IOB NE 'Y').WKA 00570000
*---------------------------------------------------------------------* 00580000
* BSCA IOB EQUATES. * 00590000
*---------------------------------------------------------------------* 00600000
SPACE 00610000
IOBNXT EQU 1 @ NEXT IOB. 00620000
IOBQ EQU IOBNXT+1 DEVICE ADDRESS. 00630000
IOBDBL EQU IOBQ+2 BUFFER LENGTH. 00640000
IOBFLA EQU IOBDBL+1 IOB FLAG A. 00650000
TDLAY EQU X'20' TWO SEC. TIME OUT STARTED. 00660000
FIRST EQU X'04' FIRST TIME. LINE INIT NOT DONE. 00670000
DELAY EQU X'02' DELAY IOB-WAIT SEQUENCE GOING. 00680000
IOBFLG EQU IOBFLA+1 IOB FLAG B. 00690000
IOBCMP EQU IOBFLG+1 IOB COMPLETION CODE. 00700000
PROCES EQU X'80' IOB CMP, IOB IN PROCESS. B 00710000
IOBDAT EQU IOBCMP+2 @ DATA BUFFER. 00720000
IOBSNS EQU IOBDAT+2 SENSE AREA. 00730000
IOBERR EQU IOBSNS+1 ERROR COUNT. 00740000
IOBCAR EQU IOBERR+2 CURRENT ADDRESS. 00750000
IOBTAR EQU IOBCAR+2 TRANSITION ADDRESS. 00760000
IOBSAR EQU IOBTAR+2 STOP ADDRESS. 00770000
IOBDTF EQU IOBSAR+2 @ DTF. 00780000
IOBMSG EQU IOBDTF+2 DELAY MESSAGE OFFSET. 00790000
IOBNEX EQU IOBDTF+2 AREA FOR CALC @ NEXT IOB. 00800000
IOBDBN EQU IOBNEX+2 AREA FOR CALL @ 2ND NEXT BUFFER. 00810000
IOB2NX EQU IOBDBN+2 AREA FOR CALC @ 2ND NEXT IOB. 00820000
IOBL EQU IOBDTF+1 LENGTH OF THE OPERATIONAL IOB. 00830000
.WKA AIF (&WKA NE 'Y').POL 00840000
*---------------------------------------------------------------------* 00850000
* BSCA WORK AREA EQUATES. * 00860000
*---------------------------------------------------------------------* 00870000
SPACE 00880000
WKIOBD EQU 28 ADDRESS OF LAST IOB. 00890000
WKERRD EQU X'1A' ERROR RETRY COUNT 00893000
DCOUNT EQU X'7B' DELAY COUNT 00896000
F3MOVE EQU X'04' RECORD MOVE INDICATOR. B 00900000
BSFLGD EQU 35 WORK AREA FLAG WITH FORWARD ABT. 00910000
ACTIVE EQU X'10' BSCA ENABLED. 00911000
FWDABT EQU X'04' FORWARD ABORT INDICATOR. 00920000
ACKS EQU 36 ACK NUMBER AND OTHER STATUS. 00930000
AKERR EQU X'04' ERROR POSTED, LINE DISABLED. 00940000
WKDEL EQU 132 WORK AREA ERROR LOG LIST. 00950000
CPURGE EQU X'59' CCP ABORT COMPLETION CODE. 00960000
.POL AIF (&POL NE 'Y').CKL 00970000
*---------------------------------------------------------------------* 00980000
* BSCA POLL / SELECT LIST EQUATES. * 00990000
*---------------------------------------------------------------------* 01000000
SPACE 01010000
POLID EQU 0 ENTRY ID IN LIST. 01020000
POLCNT EQU 1 NUMBER OF TERM CHARS IN ENTRY. 01030000
POLCH1 EQU 2 1ST TERM CHAR. 01040000
POLCH2 EQU 3 2ND TERM CHAR. 01050000
POLNXT EQU 3 # CONSTANT BYTES IN EVERY ENTRY. 01060000
WRAP EQU X'FF' END OF WRAP LIST INDICATOR. 01070000
ONETIM EQU X'FE' END OF OPEN LIST INDICATOR. 01080000
POLEND EQU X'F0' CODES RESV. FOR SYST. F0-FF. 01090000
POLACT EQU X'F1' USE ONLY ACTIVE ENTRIES. 01100000
.CKL AIF (&CKL NE 'Y').MIN 01110000
*---------------------------------------------------------------------* 01120000
* BSCA CHECK LIST EQUATES. * 01130000
*---------------------------------------------------------------------* 01140000
SPACE 01150000
CKLSTS EQU 0 CHECK LIST STATUS BYTE. B 01160000
CKLDTF EQU 2 CHECK DTF @. B 01170000
CKLEN EQU 3 CHECK LIST ENTRY LENGTH. B 01180000
CKLSKP EQU X'80' CHECK LIST: SKIP ENTRY BIT. B 01190000
CKLAST EQU X'20' CHECK LIST: LAST ENTRY INDICATOR 01200000
.MIN AIF (&MIN NE 'Y').NOMIN 01210000
*---------------------------------------------------------------------* 01220000
* ID'S FOR TRANSIENT FORM OF RESIDENT FUNCTION. * 01230000
*---------------------------------------------------------------------* 01240000
SPACE 01250000
CTTASV EQU 1 TRANSIENT FORM OF 'CMTASV'. 01260000
CTSET EQU 2 TRANSIENT FORM OF 'CMSET '. 01270000
CTREJC EQU 3 TRANSIENT FORM OF 'CMREJC'. 01280000
CTSTOR EQU 4 TRANSIENT FORM OF 'CMSTOR'. 01290000
CTBTAS EQU 5 TRANSIENT FORM OF 'CMBTAS'. 01300000
CTFORB EQU 6 TRANSIENT FORM OF 'CMFORB'. 01310000
CTRLB EQU 7 TRANSIENT FORM OF 'CMRLB'. 01310100
.NOMIN ANOP 01320000
.TEQU AIF (&CMD EQ 'Y').TQ 01330000
AIF (&CMD EQ 'CM').TQ 01340000
AIF (&ORDS EQ 'Y').TQ 01350000
AIF (&BUFR NE 'N').TQ 01360000
AIF (&OUT32 EQ 'N').END32 01370000
.TQ ANOP 01380000
*********************************************************************** 01390000
* TERMINAL DEPENDENT EQUATES. * 01400000
*********************************************************************** 01410000
AIF (&CMD EQ 'CM').CM1 01420000
AIF (&CMD NE 'Y').ORD 01430000
.CM1 ANOP 01440000
SPACE 01450000
*---------------------------------------------------------------------* 01460000
* 3270 COMMANDS. * 01470000
*---------------------------------------------------------------------* 01480000
SPACE 01490000
ESC EQU X'27' ESCAPE IDENTIFICATION. 01500000
COPY EQU X'F7' COPY COMMAND. 01510000
WRITE EQU X'F1' WRITE COMMAND. 01520000
ERSUPT EQU X'6F' ERASE UNPROTECTED COMMAND. 01530000
ERSWRT EQU X'F5' ERASE/WRITE COMMAND. 01540000
.ORD ANOP 01550000
AIF (&CMD EQ 'CM').CM2 01560000
AIF (&ORDS NE 'Y').BUFR 01570000
.CM2 ANOP 01580000
SPACE 01590000
*---------------------------------------------------------------------* 01600000
* 3270 ORDERS. * 01610000
*---------------------------------------------------------------------* 01620000
SPACE 01630000
IC EQU X'13' INSERT CURSOR. 01640000
DUP EQU X'1C' DUP CHAR. (KEYBOARD ONLY). 01650000
EUA EQU X'12' ERASE UNPROTESTED TO ADDRESS. 01660000
FM EQU X'1E' FIELD MARK (KEYBOARD ONLY). 01670000
PT EQU X'05' PROGRAM TAB. 01680000
RA EQU X'3C' REPEAT TO ADDRESS. 01690000
SBA EQU X'11' SET BUFFER ADDRESS. 01700000
SF EQU X'1D' START OF FIELD. 01710000
.BUFR ANOP 01720000
AIF (&CMD EQ 'CM').CM3 01730000
AIF (&BUFR EQ 'OFSET').OFSET 01740000
AIF (&BUFR EQ 'ALL').OFSET 01750000
AIF (&BUFR EQ 'AID').AID 01760000
AGO .OUTEQ 01770000
.OFSET ANOP 01780000
.CM3 ANOP 01790000
SPACE 01800000
*---------------------------------------------------------------------* 01810000
* 3270 BUFFER OFFSETS. * 01820000
*---------------------------------------------------------------------* 01830000
SPACE 01840000
CU EQU 0 CONTROL UNIT IDENTIFICATION. 01850000
DA EQU 1 DEVICE ADDRESS. 01860000
SPACE 01870000
AID EQU 0 AID CHARACTER POSITION. 01880000
SWAID EQU 0 AID CHAR POSITION FOR SW LINE 01885000
AIF (&BUFR EQ 'OFSET').CNTU 01890000
.AID ANOP 01900000
SPACE 01910000
* EBCDIC AID VALUES. 01920000
SPACE 01930000
AIDCLR EQU X'6D' AID FOR CLEAR KEY. 01940000
AIDENT EQU X'7D' AID FOR ENTER KEY. 01950000
SPACE 01960000
* ASCII AID VALUES. 01970000
SPACE 01980000
ASCCLR EQU X'5F' AID FOR CLEAR KEY. 01990000
ASCENT EQU X'27' AID FOR ENTER KEY. 02000000
AIF (&BUFR EQ 'AID').OUTEQ 02010000
SPACE 02020000
.CNTU ANOP 02030000
CURSOR EQU 4 CURSOR POSITION. 02040000
TEXT EQU 5 FIRST TEXT POSITION. 02050000
SPACE 2 02060000
* OR 02070000
SPACE 02080000
SNSTAS EQU 1 SENSE/STATUS MESSAGE ID. 02090000
SSID EQU C'%R' SENSE/STATUS CHARACTERS. 02100000
SSTX EQU 2 STX IN STATUS MESSAGE. 02110000
SSCU EQU 3 CONTROL UNIT ID. 02120000
SSDA EQU 4 DEVICE ADDRESS. 02130000
SSBYT1 EQU 5 BYTE 1 SENSE BYTE. 02140000
SSBYT2 EQU 6 BYTE 2 STATUS BYTE. 02150000
SSETX EQU 7 ETX IN STATUS MESSAGE. 02160000
SPACE 1 02170000
*---------------------------------------------------------------------* 02180000
* 3735 BUFFER OFFSETS. * 02190000
*---------------------------------------------------------------------* 02200000
SPACE 1 02205000
S375ID EQU 1 MESSAGE IDENTIFIER. 02210000
S375NL EQU 2 -NUL- FOLLOWING IDENTIFIER. 02220000
S375B1 EQU 3 STATUS BYTE ONE. 02230000
S375B2 EQU 4 STATUS BYTE TWO. 02240000
SPACE 3 02241000
*---------------------------------------------------------------------* 02242000
* 3741 BUFFER OFFSETS. * 02243000
*---------------------------------------------------------------------* 02244000
SPACE 1 02245000
S374ID EQU 1 STATUS MSG ID - %V. 02246000
S374B1 EQU 3 STATUS BYTE. 02247000
AGO .OUTEQ 02250000
.OUT32 ANOP 02260000
.* NOTE: ANY CHANGE TO THE NUMBER OF FORMAT CONTROL CHARACTERS MUST 02270000
.* BE REFLECTED IN BOTH 'FORMTL' STATEMENTS BELOW. 02280000
SPACE 2 02290000
FORMAT EQU * HOLD AREA TO BUILD 3270 OUTPUT. 02300000
DC AL1(ESC) 3270 ESCAPE COMMAND. 02310000
COMAND DC AL1(WRITE) OP COMMAND BYTE. 02320000
DC XL1'C2' RESTORE KEYBOARD. 02330000
SPACE 02340000
* FOLLOWING CLEARS TOP OF SCREEN FOR 'A, E, AND R' CLASS MESSAGES. 02340400
* SETS INPUT FIELD ATTR. AND SETS CURSOR. 02340800
SPACE 02341200
ORD1 EQU * ORDER FIELD ONE. 02341600
CURSR@ DC AL1(SBA) SET FIRST FIELD 02342000
DC XL2'4040' * TO R-1, C-1 (M1/M2). 02342400
DC AL1(SF) START FIELD / INPUT ATTRIBUTES. 02342800
DC XL1'40' UNPROT-ALPHAMERIC-NORMAL-MDT OFF 02343200
DC AL1(IC) INSERT CURSOR R-1,C-2 (M1/M2). 02343600
SPACE 02344000
* FOLLOWING CLEARS LAST OPERATOR INPUT (FOR CLASS A MESSAGES ONLY). 02344400
SPACE 02344800
ORD2 EQU * ORDER FIELD TWO. 02345200
OPRDAT DC AL1(RA) CLEAR INPUT TO R-03, C-02 (M1). 02345600
#OPER2 DC XL2'C1D1' * TO R-02, C-02 (M2). 02346000
DC XL1'00' * WITH NULLS. 02346400
SPACE 02346800
* FOLLOWING IS FRAMING FOR OUTPUT TEXT. 02347200
SPACE 02347600
ORD3 EQU * ORDER FIELD THREE. 02348000
OUTFRM DC AL1(SBA) SET BUF @ OUTPUT MESSAGE. 02350000
#OUT@ DC XL2'C1D1' OUTPUT @: R-03, C-02 (MOD 1). 02360000
* * R-02, C-02 (MOD 2). 02365000
DC AL1(SF) START FIELD / REPLY ATTRIBUTES. 02370000
DC XL1'60' PROT-ALPHAMERIC-NORMAL-MDT OFF. 02380000
SPACE 02390000
* FOLLOWING IS THE OUTPUT TEXT AREA. (MESSAGE A11 IS DEFAULT). 02390700
SPACE 02391400
DATA EQU * 02392100
MSG# DC CL3'A11' MESSAGE 02392800
DC XL1'40' * A11(BLANK) 02393500
DC CL5'CLEAR' * CLEAR. 02394200
SPACE 02394900
* FOLLOWING NULLS OUT THE REST OF THE MESSAGE AREA. 02395600
SPACE 02396300
ORD4 EQU * ORDER FIELD FOUR. 02397000
CLREST DC AL1(RA) CLEAR REST. 02397700
#END@ DC XL2'C260' * TO R-5,C-1 (MOD 1). 02398400
* * TO R-3,C-1 (MOD 2). 02399100
DC XL1'00' * WITH NULLS. 02400000
ENDSCR EQU * END OF OUTPUT TEXT STREAM. 02402000
.* NOTE: ANY CHANGE TO THE NUMBER OF FORMAT CONTROL CHARACTERS MUST 02404000
.* BE REFLECTED IN BOTH 'FORMTL' STATEMENTS BELOW. 02406000
FORMTL EQU DATA-FORMAT+ENDSCR-CLREST-1 # FORMAT CONTROL BYTES-1. 02408000
AGO .EXIT 02660000
.OUTEQ ANOP 02670000
AIF (&CMD EQ 'CM').CM4 02680000
AIF (&OUT32 NE 'EQU').END32 02690000
.CM4 ANOP 02700000
SPACE 3 02710000
*---------------------------------------------------------------------* 02720000
* EQUATE FOR NUMBER OF CCP FORMAT CONTROL CHAR TO 3270. * 02730000
*---------------------------------------------------------------------* 02740000
FORMTL EQU 25 # OF FORMAT CONTROL CHARS. 02750000
.END32 ANOP 02760000
.BITS AIF (&BITS NE 'Y').NOBIT 02770000
*---------------------------------------------------------------------* 02780000
* HEX DEFINITION FOR BITS. * 02790000
*---------------------------------------------------------------------* 02800000
SPACE 02810000
BIT0 EQU X'80' * HEX DEFINITIONS FOR A BIT. 02820000
BIT1 EQU X'40' * 02830000
BIT2 EQU X'20' * 02840000
BIT3 EQU X'10' * 02850000
BIT4 EQU X'08' * 02860000
BIT5 EQU X'04' * 02870000
BIT6 EQU X'02' * 02880000
BIT7 EQU X'01' * 02890000
.NOBIT ANOP 02900000
AIF (&#CMEQ NE 'Y').NO#EQ 02910000
SPACE 02920000
* BSCA EQUATES FOR $CMWK. 02930000
SPACE 02940000
#CMBK1 EQU #CMTMA BSCA WORK AREA #1. 02950000
#CMBK2 EQU #CMTFT BSCA WORK AREA #2. 02960000
#CMBL0 EQU 0 BSCA LOG MSG TYPE 0. 02970000
#CMBL1 EQU 1 BSCA LOG MSG TYPE 1. 02980000
#CMBL2 EQU 2 BSCA LOG MSG TYPE 2. 02990000
.NO#EQ ANOP 03000000
AIF (&ARRAD EQ 'XX').ENDAR 03010000
SPACE 03020000
* ARR INCREMENT VALUES FOR TRANSIENT RETURN TO MAINLINE ROUTINE. 03030000
SPACE 03040000
.ARR2 AIF (&ARRAD NE 'BE').ARR3 03050000
BEXIT1 EQU 0 POST COMPLETE, RETURN TO USER. 03060000
BEXIT2 EQU 4 RESCHEDULE WORK ON THE LINE. 03070000
BEXIT3 EQU 8 DATA AVAILABLE, HANDLE FOR USER. 03080000
AGO .ENDAR 03090000
.ARR3 AIF (&ARRAD NE 'BQ').ARR4 03100000
BQXIT1 EQU 0 RESCHEDULE WORK ON THE LINE. 03110000
BQXIT2 EQU 4 STOP FAILED, COMPLETE READ OPEND 03120000
BQXIT3 EQU 7 ABORT OF THE BSCA LINE REQUIRED. 03130000
AGO .ENDAR 03140000
.ARR4 ANOP 03150000
AIF (&ARRAD NE 'BP').ARR5 03160000
BPXIT1 EQU 0 RESET TP SCHEDULED BITS. 03170000
BPXIT2 EQU 4 HANDLE ABORT OF THE BSCA LINE. 03180000
AGO .ENDAR 03190000
.ARR5 ANOP 03200000
AIF (&ARRAD NE 'BB').ARR6 03210000
BBXIT1 EQU 0 ERROR RETURN TO CM. 03220000
BBXIT2 EQU 7 NORMAL RETURN TO CM. 03230000
AGO .ENDAR 03240000
.ARR6 ANOP 03250000
.ENDAR ANOP 03260000
AIF (&XEQ EQ 'XX').NOXEQ 03270000
SPACE 03280000
* COMMON EQUATES FOR TRANSIENTS. 03290000
SPACE 03300000
&XEQ EQU $CC4&XEQ FORCE RLD FOR XIENT ENTRY. 03310000
C EQU $CC4&XEQ FORCE RLD FOR $CCCOM ENTRY. 03320000
COM EQU X'C000' RAT ID FOR $CCCOM ENTRY. 03330000
P EQU $CC4&XEQ FORCE RLD FOR PROGRAM SERVICE. 03340000
PGM EQU X'8000' RAT ID FOR PROGRAM SERVICE ENTRY 03350000
.NOXEQ ANOP 03360000
AIF (&XREG NE 'Y').NOREG 03370000
SPACE 03380000
* EQUATE VALUES FOR REGISTERS STORED IN TCBSAV. 03390000
SPACE 03400000
NSI@ EQU 2 SAVE AREA FOR ARR. 03410000
REG1 EQU 4 SAVE AREA FOR XR1. 03420000
REG2 EQU 6 SAVE AREA FOR XR2. 03430000
.NOREG ANOP 03440000
AIF (&BCEQ EQ 'CK').BFX01 03450000
AIF (&BCEQ NE 'Y').NOBFQ 03460000
.BFX01 ANOP 03470000
BCXRTN EQU 0 DON'T X-CONTROL, RETURN. 03480000
BCX2S2 EQU 10 X-CONTROL TO $CC4S2. 03490000
.NOBFQ AIF (&BCEQ NE 'CK').BFX02 03500000
BCXXS2 EQU BCS2-BC THE X-CONTROL VALUE IN BC. 03510000
.BFX02 ANOP 03520000
.EXIT ANOP 03530000
MEND 03540000