|
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: 13716 (0x3594)
Types: s3xseg
Names: »S$EBEQ«
└─⟦d0bc1a931⟧ Bits:30009189 5704-sc1.V08.ccp
└─⟦64693a1c9⟧
└─⟦this⟧ »S$EBEQ«
MACRO 00010000
.********************************************************************** 00020000
.* STATUS: RELEASE 4 * 00030000
.* * 00040000
.* NAME: $EBEQ * 00050000
.* * 00060000
.* FUNCTION: * 00070000
.* * 00080000
.* . CCP GENERATION SECOND PASS MACRO INSTRUCTION -- DEFINE * 00090000
.* SYMBOLS FOR BSCA -- FOR: * 00100000
.* * 00110000
.* . IOB OFFSETS OFFSETS * 00120000
.* . BSCA WORK AREA OFFSETS * 00130000
.* . POLL/SELECTION LIST OFFSETS * 00140000
.* . CHECK LIST OFFSETS * 00150000
.* . MINIMUN BSCA SYSTEM TRANSIENT ID'S * 00160000
.* . 3270/3735 COMMANDS, ORDERS,BUFFER OFFSETS * 00170000
.* * 00180000
.* INPUT OPERANDS: * 00190000
.* * 00200000
.* . IOB-Y/N: IOB EQUATES (DEFAULT N) * 00210000
.* . WKA-Y/N: BSCA WORK AREA EQUATES (DEFAULT N) * 00220000
.* . POL-Y/N: POLL LIST EQUATES (DEFAULT N) * 00230000
.* . CKL-Y/N: CHECK LIST EQUATES (DEFAULT N) * 00240000
.* . MIN-Y/N: MINIMUN SYSTEM TRANSIENT ID'S. * 00250000
.* . CMD-CM/Y/N: CM-SAME AS IF CMD-Y,ORDS-Y,BUFR-ALL,OUT32-EQU GIVEN* 00260000
.* Y/N - 3270 COMMAND EQUATES (DEFAULT N) * 00270000
.* . ORDS-Y/N: 3270 ORDER EQUATES (DEFAULT N) * 00280000
.* . BUFR-OFSET/AID/ALL/N: OFSET - 3270/3735 LINE BUFFER OFFSETS * 00290000
.* AID - 3270 AID EQUATES * 00300000
.* ALL - BOTH OFFSETS AND AID EQUATES * 00310000
.* N - NEITHER OF ABOVE (DEFAULT N) * 00320000
.* . OUT32-ALL/EQU/N: ALL - IGNORES ALL OTHER KEYWORDS. GENERATE * 00330000
.* CCP 3270 OUTPUT BUFFER FORMAT. * 00340000
.* EQU - LENGTH OF CCP 3270 OUTPUT BUFFER FORMAT.* 00350000
.* N - NEITHER OF THE ABOVE (DEFAULT N) * 00360000
.* * 00370000
.********************************************************************** 00380000
$EBEQ &IOB-N,&WKA-N,&POL-N,&CKL-N,&MIN-N,&CMD-N,&ORDS-N, X00390000
&BUFR-N,&OUT32-N,&BITS-N,&#CMEQ-N,&ARRAD-XX,&BCEQ-N 00400000
TEXT 00410000
.* OUT32-ALL WILL CAUSE ALL OTHER KEYWORDS TO BE IGNORED. IT WILL 00420000
.* GENERATE ONLY 3270 OUTPUT CONSTANTS AND EQUATES. 00430000
.* OUT32-EQU AND ANY OF THE OTHER KEYWARDS CAN BE USED TOGETHER. 00440000
AIF (&OUT32 EQ 'ALL').OUT32 00450000
AIF (&IOB NE 'Y').WKA 00460000
*---------------------------------------------------------------------* 00470000
* BSCA IOB EQUATES(FROM BSEQU MACROS OF MLMP). * 00480000
*---------------------------------------------------------------------* 00490000
SPACE 00500000
IOBNXT EQU 1 @ NEXT IOB. 00510000
IOBQ EQU IOBNXT+1 DEVICE ADDRESS. 00520000
IOBDBL EQU IOBQ+2 BUFFER LENGTH. 00530000
IOBFLA EQU IOBDBL+1 IOB FLAG A. 00540000
TDLAY EQU X'20' TWO SEC. TIME OUT STARTED. 00550000
FIRST EQU X'04' FIRST TIME. LINE INIT NOT DONE. 00560000
DELAY EQU X'02' DELAY IOB-WAIT SEQUENCE GOING. 00570000
IOBFLG EQU IOBFLA+1 IOB FLAG B. 00580000
IOBCMP EQU IOBFLG+1 IOB COMPLETION CODE. 00590000
PROCES EQU X'80' IOB CMP, IOB IN PROCESS. B 00600000
IOBDAT EQU IOBCMP+2 @ DATA BUFFER. 00610000
IOBSNS EQU IOBDAT+2 SENSE AREA. 00620000
IOBERR EQU IOBSNS+1 ERROR COUNT. 00630000
IOBCAR EQU IOBERR+2 CURRENT ADDRESS. 00640000
IOBTAR EQU IOBCAR+2 TRANSITION ADDRESS. 00650000
IOBSAR EQU IOBTAR+2 STOP ADDRESS. 00660000
IOBDTF EQU IOBSAR+2 @ DTF. 00670000
IOBMSG EQU IOBDTF+2 DELAY MESSAGE OFFSET. 00680000
IOBNEX EQU IOBDTF+2 AREA FOR CALC @ NEXT IOB. 00690000
IOBDBN EQU IOBNEX+2 AREA FOR CALL @ 2ND NEXT BUFFER. 00700000
IOB2NX EQU IOBDBN+2 AREA FOR CALC @ 2ND NEXT IOB. 00710000
IOBL EQU IOBDTF+1 LENGTH OF THE OPERATIONAL IOB. 00720000
.WKA AIF (&WKA NE 'Y').POL 00730000
*---------------------------------------------------------------------* 00740000
* BSCA WORK AREA EQUATES(FROM BSEQU MACRO OF MLMP). * 00750000
*---------------------------------------------------------------------* 00760000
SPACE 00770000
PL1EOT EQU X'40' RECORD TRUNCATE IND. (IN $BPOLD) 00780000
WKDTFD EQU 20 DTF ADDRESS 00790000
BSRJ2D EQU 22 WORK AREA INDICATORS 00800000
JF2SAR EQU X'20' STOP AUTO RESPONSE. (IN BSRJ2D) 00810000
JF2SR2 EQU X'10' STOP AUTO RESPONSE. (IN BSFL4D) 00815000
WKIOBD EQU 28 ADDRESS OF LAST IOB. 00820000
WKERRD EQU X'1A' ERROR RETRY COUNT 00823000
DCOUNT EQU X'7B' DELAY COUNT 00826000
F3AUTO EQU X'01' AUTO RESPONSE ACTIVE.(IN $BWFG3) 00830000
F3MOVE EQU X'04' RECORD MOVE INDICATOR(IN $BWFG3) 00840000
BSFLGD EQU 35 WORK AREA FLAGS. 00850000
BSFL4D EQU X'82' WORK AREA FLAGS. 00855000
ACTIVE EQU X'10' BSCA ENABLED. (IN BSFLGD) 00860000
FWDABT EQU X'04' FORWARD ABORT IND. (IN BSFLGD) 00870000
ACKSD EQU 36 ACK NUMBER AND OTHER STATUS. 00880000
AKERR EQU X'04' ERROR, LINE DISABLED.(IN ACKSD) 00890000
WKDELL EQU 132 WORK AREA ERROR LOG LIST. 00900000
.POL AIF (&POL NE 'Y').CKL 00910000
*---------------------------------------------------------------------* 00920000
* BSCA POLL / SELECT LIST EQUATES. * 00930000
*---------------------------------------------------------------------* 00940000
SPACE 00950000
POLID EQU 0 ENTRY ID IN LIST. 00960000
POLCNT EQU 1 NUMBER OF TERM CHARS IN ENTRY. 00970000
POLCH1 EQU 2 1ST TERM CHAR. 00980000
POLCH2 EQU 3 2ND TERM CHAR. 00990000
POLNXT EQU 3 # CONSTANT BYTES IN EVERY ENTRY. 01000000
WRAP EQU X'FF' END OF WRAP LIST INDICATOR. 01010000
ONETIM EQU X'FE' END OF OPEN LIST INDICATOR. 01020000
POLEND EQU X'F0' CODES RESV. FOR SYST. F0-FF. 01030000
POLACT EQU X'F1' USE ONLY ACTIVE ENTRIES. 01040000
.CKL AIF (&CKL NE 'Y').MIN 01050000
*---------------------------------------------------------------------* 01060000
* BSCA CHECK LIST EQUATES. * 01070000
*---------------------------------------------------------------------* 01080000
SPACE 01090000
CKLSTS EQU 0 CHECK LIST STATUS BYTE. B 01100000
CKLDTF EQU 2 CHECK DTF @. B 01110000
CKLEN EQU 3 CHECK LIST ENTRY LENGTH. B 01120000
CKLSKP EQU X'80' CHECK LIST: SKIP ENTRY BIT. B 01130000
CKLAST EQU X'20' CHECK LIST: LAST ENTRY INDICATOR 01140000
.MIN AIF (&MIN NE 'Y').NOMIN 01150000
*---------------------------------------------------------------------* 01160000
* ID'S FOR TRANSIENT FORM OF RESIDENT FUNCTION. * 01170000
*---------------------------------------------------------------------* 01180000
SPACE 01190000
CTTASV EQU 1 TRANSIENT FORM OF 'CMTASV'. 01200000
CTREJC EQU 3 TRANSIENT FORM OF 'CMREJC'. 01210000
CTSTOR EQU 4 TRANSIENT FORM OF 'CMSTOR'. 01220000
CTBTAS EQU 5 TRANSIENT FORM OF 'CMBTAS'. 01230000
CTFORB EQU 6 TRANSIENT FORM OF 'CMFORB 01240000
CTRLB EQU 7 TRANSIENT FORM OF 'CMFIGL' 01250000
.NOMIN ANOP 01260000
.TEQU AIF (&CMD EQ 'Y').TQ 01270000
AIF (&CMD EQ 'CM').TQ 01280000
AIF (&ORDS EQ 'Y').TQ 01290000
AIF (&BUFR NE 'N').TQ 01300000
AIF (&OUT32 EQ 'N').END32 01310000
.TQ ANOP 01320000
*********************************************************************** 01330000
* TERMINAL DEPENDENT EQUATES. * 01340000
*********************************************************************** 01350000
AIF (&CMD EQ 'CM').CM1 01360000
AIF (&CMD NE 'Y').ORD 01370000
.CM1 ANOP 01380000
SPACE 01390000
*---------------------------------------------------------------------* 01400000
* 3270 COMMANDS. * 01410000
*---------------------------------------------------------------------* 01420000
SPACE 01430000
ESC EQU X'27' ESCAPE IDENTIFICATION. 01440000
COPY EQU X'F7' COPY COMMAND. 01450000
WRITE EQU X'F1' WRITE COMMAND. 01460000
ERSUPT EQU X'6F' ERASE UNPROTECTED COMMAND. 01470000
ERSWRT EQU X'F5' ERASE/WRITE COMMAND. 01480000
.ORD AIF (&CMD EQ 'CM').CM2 01490000
AIF (&ORDS NE 'Y').BUFR 01500000
.CM2 ANOP 01510000
SPACE 01520000
*---------------------------------------------------------------------* 01530000
* 3270 ORDERS. * 01540000
*---------------------------------------------------------------------* 01550000
SPACE 01560000
IC EQU X'13' INSERT CURSOR. 01570000
DUP EQU X'1C' DUP CHAR. (KEYBOARD ONLY). 01580000
EUA EQU X'12' ERASE UNPROTESTED TO ADDRESS. 01590000
FM EQU X'1E' FIELD MARK (KEYBOARD ONLY). 01600000
PT EQU X'05' PROGRAM TAB. 01610000
RA EQU X'3C' REPEAT TO ADDRESS. 01620000
SBA EQU X'11' SET BUFFER ADDRESS. 01630000
SF EQU X'1D' START OF FIELD. 01640000
.BUFR ANOP 01650000
AIF (&CMD EQ 'CM').CM3 01660000
AIF (&BUFR EQ 'OFSET').OFSET 01670000
AIF (&BUFR EQ 'ALL').OFSET 01680000
AIF (&BUFR EQ 'AID').AID 01690000
AGO .OUTEQ 01700000
.OFSET ANOP 01710000
.CM3 ANOP 01720000
SPACE 01730000
*---------------------------------------------------------------------* 01740000
* 3270 BUFFER OFFSETS. * 01750000
*---------------------------------------------------------------------* 01760000
SPACE 01770000
CU EQU 0 CONTROL UNIT IDENTIFICATION. 01780000
DA EQU 1 DEVICE ADDRESS. 01790000
SPACE 01800000
AID EQU 0 AID CHARACTER POSITION. 01810000
SWAID EQU 0 AID CHAR POSITION FOR SWITCHED. 01815000
AIF (&BUFR EQ 'OFSET').CNTU 01820000
.AID ANOP 01830000
SPACE 01840000
* EBCDIC AID VALUES. 01850000
SPACE 01860000
AIDCLR EQU X'6D' AID FOR CLEAR KEY. 01870000
AIDENT EQU X'7D' AID FOR ENTER KEY. 01880000
AIDCRD EQU X'E6' AID FOR CARD READER DATA. 01883000
AIDTST EQU X'F0' AID FOR RFT KEY. 01886000
SPACE 01890000
* ASCII AID VALUES. 01900000
SPACE 01910000
ASCCLR EQU X'5F' AID FOR CLEAR KEY. 01920000
ASCENT EQU X'27' AID FOR ENTER KEY. 01930000
AIF (&BUFR EQ 'AID').OUTEQ 01940000
SPACE 01950000
.CNTU ANOP 01960000
CURSOR EQU 4 CURSOR POSITION. 01970000
TEXT EQU 5 FIRST TEXT POSITION. 01980000
SWTEXT EQU 3 FIRST TEXT POS. SWITCHED LINE. 01985000
SPACE 2 01990000
* OR 02000000
SPACE 02010000
SNSTAS EQU 1 SENSE/STATUS MESSAGE ID. 02020000
SSID EQU C'%R' SENSE/STATUS CHARACTERS. 02030000
SSTX EQU 2 STX IN STATUS MESSAGE. 02040000
SSCU EQU 3 CONTROL UNIT ID. 02050000
SSDA EQU 4 DEVICE ADDRESS. 02060000
SSBYT1 EQU 5 BYTE 1 SENSE BYTE. 02070000
SSBYT2 EQU 6 BYTE 2 STATUS BYTE. 02080000
SSETX EQU 7 ETX IN STATUS MESSAGE. 02090000
SPACE 1 02100000
*---------------------------------------------------------------------* 02110000
* 3735 BUFFER OFFSTES. * 02120000
*---------------------------------------------------------------------* 02130000
S375ID EQU 1 MESSAGE IDENTIFIER. 02140000
S375NL EQU 2 -NUL- FOLLOWING IDENTIFIER. 02150000
S375B1 EQU 3 STATUS BYTE ONE. 02160000
S375B2 EQU 4 STATUS BYTE TWO. 02170000
*********************************************************************** 02171000
* * 02172000
* 3741 BUFFER OFFSETS * 02173000
* * 02174000
*********************************************************************** 02175000
S374ST EQU 1 STATUS MESSAGE IDENTIFIER 02176000
AGO .OUTEQ 02180000
.OUT32 ANOP 02190000
.* NOTE: ANY CHANGE TO THE NUMBER OF FORMAT CONTROL CHARACTERS MUST 02200000
.* BE REFLECTED IN BOTH 'FORMTL' STATEMENTS BELOW. 02210000
SPACE 2 02220000
FORMAT EQU * HOLD AREA TO BUILD 3270 OUTPUT. 02230000
DC AL1(ESC) 3270 ESCAPE COMMAND. 02240000
COMAND DC AL1(WRITE) OP COMMAND BYTE. 02250000
DC XL1'C2' RESTORE KEYBOARD. 02260000
SPACE 02270000
* FOLLOWING CLEARS TOP OF SCREEN FOR 'A, E, AND R' CLASS MESSAGES. 02272000
* SETS INPUT FIELD ATTR, AND SETS CURSOR. 02274000
SPACE 02276000
ORD1 EQU * ORDER FIELD ONE. 02278000
CURSR@ DC AL1(SBA) SET FIRST FIELD 02280000
DC XL2'4040' * TO R-1, C-1 (M1/M2). 02290000
DC AL1(SF) START FIELD / INPUT ATTRIBUTES. 02300000
DC XL1'40' UNPROT-ALPHAMERIC-NORMAL-MDT OFF 02310000
DC AL1(IC) INSERT CURSOR R-1,C-2 (M1/M2). 02310900
SPACE 02311800
* FOLLOWING CLEARS LAST OPERATOR INPUT (FOR CLASS A MESSAGES ONLY). 02312700
SPACE 02313600
ORD2 EQU * ORDER FIELD TWO. 02314500
OPRDAT DC AL1(RA) CLEAR INPUT TO R-03, C-02 (M1) 02315400
#OPER2 DC XL2'C1D1' * TO R-02, C-02 (M2). 02316300
DC XL1'00' * WITH NULLS. 02317200
SPACE 02318100
* FOLLOWING IS FRAMING FOR OUTPUT TEXT. 02319000
SPACE 02320000
ORD3 EQU * ORDER FIELD THREE. 02325000
OUTFRM DC AL1(SBA) SET BUF @ OUTPUT MESSAGE. 02330000
#OUT@ DC XL2'C1D1' OUTPUT @: R-03, C-02 (MOD 1). 02340000
* * R-02, C-02 (MOD 2). 02345000
DC AL1(SF) START FIELD / REPLY ATTRIBUTES. 02350000
DC XL1'60' PROT-ALPHAMERIC-NORMAL-MDT OFF. 02360000
SPACE 02362000
* FOLLOWING IS THE OUTPUT TEXT AREA. (MESSAGE A11 IS DEFAULT). 02364000
SPACE 02366000
DATA EQU * 02370000
MSG# DC CL3'A11' MESSAGE 02380000
DC XL1'40' * A11(BLANK) 02390000
DC CL5'CLEAR' * CLEAR. 02400000
SPACE 02410000
* FOLLOWING NULLS OUT THE REST OF THE MESSAGE AREA. 02412000
SPACE 02414000
ORD4 EQU * ORDER FIELD FOUR. 02416000
CLREST DC AL1(RA) CLEAR REST 02430000
#END@ DC XL2'C260' * TO R-5,C-1 (MOD 1). 02440000
* * TO R-3,C-1 (MOD 2). 02445000
DC XL1'00' * WITH NULLS. 02460000
ENDSCR EQU * END OF OUTPUT TEXT STREAM. 02470000
.* NOTE: ANY CHANGE TO THE NUMBER OF FORMAT CONTROL CHARACTERS MUST 02560000
.* BE REFLECTED IN BOTH 'FORMTL' STATEMENTS BELOW. 02570000
FORMTL EQU DATA-FORMAT+ENDSCR-CLREST-1 # FORMAT CONTROL BYTES-1. 02580000
AGO .EXIT 02590000
.OUTEQ AIF (&CMD EQ 'CM').CM4 02600000
AIF (&OUT32 NE 'EQU').END32 02610000
.CM4 ANOP 02620000
SPACE 3 02630000
*---------------------------------------------------------------------* 02640000
* EQUATE FOR NUMBER OF CCP FORMAT CONTROL CHAR TO 3270. * 02650000
*---------------------------------------------------------------------* 02660000
FORMTL EQU 22 # OF FORMAT CONTROL CHARS. 02670000
.END32 ANOP 02680000
.BITS AIF (&BITS NE 'Y').NOBIT 02690000
*---------------------------------------------------------------------* 02700000
* HEX DEFINITION FOR BITS. * 02710000
*---------------------------------------------------------------------* 02720000
SPACE 02730000
BIT0 EQU X'80' * HEX DEFINITIONS FOR A BIT. 02740000
BIT1 EQU X'40' * 02750000
BIT2 EQU X'20' * 02760000
BIT3 EQU X'10' * 02770000
BIT4 EQU X'08' * 02780000
BIT5 EQU X'04' * 02790000
BIT6 EQU X'02' * 02800000
BIT7 EQU X'01' * 02810000
.NOBIT AIF (&#CMEQ NE 'Y').NO#EQ 02820000
SPACE 02830000
* BSCA EQUATES FOR $CMWK. 02840000
SPACE 02850000
#CMBL0 EQU 0 BSCA LOG MSG TYPE 0. 02860000
#CMBL1 EQU 1 BSCA LOG MSG TYPE 1. 02870000
#CMBL2 EQU 2 BSCA LOG MSG TYPE 2. 02880000
.NO#EQ AIF (&ARRAD EQ 'XX').ENDAR 02890000
SPACE 02900000
* ARR INCREMENT VALUES FOR TRANSIENT RETURN TO MAINLINE ROUTINE. 02910000
SPACE 02920000
.ARR2 AIF (&ARRAD NE 'BE').ARR3 02930000
BEXIT1 EQU 0 POST COMPLETE, RETURN TO USER. 02940000
BEXIT2 EQU 4 RESCHEDULE WORK ON THE LINE. 02950000
BEXIT3 EQU 8 DATA AVAILABLE, HANDLE FOR USER. 02960000
AGO .ENDAR 02970000
.ARR3 AIF (&ARRAD NE 'BQ').ARR4 02980000
BQXIT1 EQU 0 RESCHEDULE WORK ON THE LINE. 02990000
BQXIT2 EQU 4 STOP FAILED, COMPLETE READ OPEND 03000000
BQXIT3 EQU 7 ABORT OF THE BSCA LINE REQUIRED. 03010000
AGO .ENDAR 03020000
.ARR4 AIF (&ARRAD NE 'BP').ARR5 03030000
BPXIT1 EQU 0 RESET TP SCHEDULED BITS. 03040000
BPXIT2 EQU 4 HANDLE ABORT OF THE BSCA LINE. 03050000
AGO .ENDAR 03060000
.ARR5 AIF (&ARRAD NE 'BB').ARR6 03070000
BBXIT1 EQU 0 ERROR RETURN TO CM. 03080000
BBXIT2 EQU 7 NORMAL RETURN TO CM. 03090000
AGO .ENDAR 03100000
.ARR6 ANOP 03110000
.ENDAR ANOP 03120000
.NOXEQ ANOP 03130000
AIF (&BCEQ EQ 'CK').BFX01 03140000
AIF (&BCEQ NE 'Y').NOBFQ 03150000
.BFX01 ANOP 03160000
BCXRTN EQU 0 DON'T X-CONTROL, RETURN. 03170000
BCX2S2 EQU 10 X-CONTROL TO $CC4S2. 03180000
.NOBFQ AIF (&BCEQ NE 'CK').BFX02 03190000
BCXXS2 EQU BCS2-BC THE X-CONTROL VALUE IN BC. 03200000
.BFX02 ANOP 03210000
.EXIT ANOP 03220000
MEND 03230000