|
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: 28702 (0x701e)
Types: s3xseg
Names: »S$NCIO«
└─⟦827b5bd03⟧ Bits:30009184 5702-sc1.V16.ccp
└─⟦f17e99db6⟧
└─⟦this⟧ »S$NCIO«
MACRO 00010000
.********************************************************************** 00020000
.* * 00030000
.* TITLE: $NCIO -- PERFORM COMMUNICATIONS I/O UNDER CCP * 00040000
.* * 00050000
.* FUNCTION: * 00060000
.* * 00070000
.* . SET THE CONTENTS OF A CCP COMMUNICATIONS PARAMETER LIST * 00080000
.* * 00090000
.* . BRANCH TO THE CCP COMMUNICATIONS I/O FUNCTION VIA * 00100000
.* GENERAL ENTRY * 00110000
.* * 00120000
.* INPUT: * 00130000
.* * 00140000
.* . OPTIONAL LABEL WHICH, IF PRESENT, IS EQUATED TO THE ADDRESS * 00150000
.* OF THE FIRST INSTRUCTION GENERATED BY THIS MACRO * 00160000
.* * 00170000
.* . OPERANDS, ALL OPTIONAL, AS INDICATED BELOW: * 00180000
.* * 00190000
.* PLIST-(1)/(2)/ADDRX/DISPX(REGX)/(ADDRX)/(DISPX(REGX)) * 00200000
.* * 00210000
.* ADDRESS OF THE LEFTMOST BYTE OF THE COMMUNICATIONS * 00220000
.* PARAMETER LIST TO BE USED * 00230000
.* * 00240000
.* OP-CODE/'CODE,MOD,...'/VALUEX/(1)/(ADDRX)/(DISPX(REGX)) * 00250000
.* * 00260000
.* OPERATION CODE/MODIFIERS FOR THE COMMUNICATIONS FUNCTION* 00270000
.* TO BE PERFORMED * 00280000
.* * 00290000
.* OUTLEN-VALUEX/(1)/(ADDRX)/(DISPX(REGX)) * 00300000
.* * 00310000
.* DATA LENGTH FOR AN OUTPUT OPERATION (MUTUALLY EXCLUSIVE * 00320000
.* WITH 'ATTRID' OPERAND) * 00330000
.* * 00340000
.* ATTRID-VALUEX/(1)/(ADDRX)/(DISPX(REGX)) * 00350000
.* * 00360000
.* IDENTIFIER OF AN ATTRIBUTE-SET WHOSE CONTENTS ARE TO BE * 00370000
.* SET FOR THE TERMINAL BEING ACQUIRED (MUTUALLY EXCLUSIVE * 00380000
.* WITH 'OUTLEN' OPERAND) * 00390000
.* * 00400000
.* INLEN-VALUEX/(1)/(ADDRX)/(DISPX(REGX)) * 00410000
.* * 00420000
.* MAXIMUM LENGTH FOR AN INPUT OPERATION * 00430000
.* * 00440000
.* RECA-ADDRX/(1)/(ADDRX)/(DISPX(REGX)) * 00450000
.* * 00460000
.* ADDRESS OF THE RECORD AREA TO BE USED IN THIS * 00470000
.* OPERATION * 00480000
.* * 00490000
.* TNAME-CHARS/(ADDRX)/(DISPX(REGX)) $ 00500000
.* * 00510000
.* SYMBOLIC NAME OF THE TERMINAL TO BE SELECTED BY THIS * 00520000
.* OPERATION * 00530000
.* * 00540000
.* EXEC-YES/Y/NO/N * 00550000
.* * 00560000
.* YES -- THE DEFAULT -- SPECIFIES THAT A BRANCH IS TO BE * 00570000
.* MADE TO PERFORM THE COMMUNICATIONS FUNCTION SPECIFIED. * 00580000
.* NO -- THE ALTERNATE -- SPECIFIES THAT THE PARAMETER LIST* 00590000
.* (AND POSSIBLY TERMINAL NAME) ARE TO BE SET AS SPECIFIED * 00600000
.* ABOVE, BUT A BRANCH IS *NOT* TO BE MADE TO PERFORM THE * 00610000
.* FUNCTION. * 00620000
.* * 00630000
.* . AN INDICATION (VIA THREE GLOBAL VARIABLES) WHETHER CERTAIN * 00640000
.* REQUIRED SYMBOLS HAVE ALREADY BEEN GENERATED. * 00650000
.* * 00660000
.* . SEE SRL #GC21-7579 -- CCP PROGRAMMING REFERENCE MANUAL -- FOR * 00670000
.* FURTHER DESCRIPTION OF THE INPUT TO THIS MACRO. * 00680000
.* * 00690000
.* OUTPUT: * 00700000
.* * 00710000
.* . REQUIRED SYMBOLS (OF THE FORM $N....) IF NOT PREVIOUSLY * 00720000
.* GENERATED BY THE USER. * 00730000
.* * 00740000
.* . IF A LABEL WAS SPECIFIED IN THE MACRO-INSTRUCTION, A SYMBOL * 00750000
.* EQUATED TO THE FIRST BYTE GENERATED. * 00760000
.* * 00770000
.* . SETTING OF INDEX REGISTER 2 TO THE ADDRESS OF THE PARAMETER * 00780000
.* LIST IF THE 'PLIST' OPERAND WAS SPECIFIED. * 00790000
.* * 00800000
.* . SETTING OF INDEX REGISTER 1 TO THE ADDRESS OF THE RECORD AREA * 00810000
.* IF THE OPERAND 'TNAME' WAS SPECIFIED. * 00820000
.* * 00830000
.* . INSTRUCTIONS TO SET THE PARAMETER LIST FIELDS (AND THE * 00840000
.* TERMINAL NAME FIELD OF THE RECORD AREA) AS SPECIFIED BY THE * 00850000
.* USER IN HIS INPUT. * 00860000
.* * 00870000
.* . CONSTANTS (WHERE NECESSARY) FOR THE VALUES TO BE SET INTO * 00880000
.* THE ABOVE FIELDS. * 00890000
.* * 00900000
.* . A BRANCH TO GENERAL ENTRY WITH AN IN-LINE CCP RIB AND SUB-RIB * 00910000
.* UNLESS THE OPERAND 'EXEC-NO' WAS SPECIFIED. * 00920000
.* * 00930000
.* EXTERNAL REFERENCES: * 00940000
.* * 00950000
.* . NO EXTRNS ARE GENERATED BY THIS MACRO. * 00960000
.* * 00970000
.* . A REFERENCE TO THE DSM SUPERVISOR'S GENERAL ENTRY POINT IS * 00980000
.* MADE. * 00990000
.* * 01000000
.* . THREE GLOBAL BOOLEAN VARIABLES ARE USED TO CONTROL THE * 01010000
.* GENERATION OF REQUIRED SYMBOLS: * 01020000
.* * 01030000
.* . &$NCOM -- FOR COMMON SYMBOLS * 01040000
.* . &$NPLO -- FOR PARAMETER LIST OFFSET SYMBOLS * 01050000
.* . &$NOPV -- FOR OPERATION CODE/MODIFIER VALUE SYMBOLS * 01060000
.* * 01070000
.* ERROR MESSAGES: * 01080000
.* * 01090000
.* . THE FOLLOWING ERROR MNOTES (SEVERITY 08): * 01100000
.* * 01110000
.* N2001 CONFLICTING OPERANDS--OUTLEN/ATTRID * 01120000
.* * 01130000
.* N3001 INVALID OPERATION CODE SPECIFIED * 01140000
.* * 01150000
.* N3002 INVALID OPERATION MODIFIER SPECIFIED * 01160000
.* * 01170000
.* N3003 PARAMETER MISSING FINAL RIGHT PAREN * 01180000
.* * 01190000
.* N3004 PARENTHESIZED PARAMETER TOO LONG * 01200000
.* * 01210000
.********************************************************************** 01220000
&LABEL $NCIO &PLIST-(2),&OP-,&OUTLEN-,&ATTRID-,&INLEN-,&RECA-,&TNAME-, X01230000
&EXEC-YES 01240000
.* 01250000
.* GENERATION VARIABLES USED 01260000
.* 01270000
GBLB &$NCOM,&$NPLO,&$NOPV . =1 IF SPECIFIC SYMBOLS GEN'D 01280000
LCLA &N . COUNT CONTROL VARIABLE 01290000
LCLA &M,&MM . FOR LENGTH MANIPULATION 01300000
LCLB &$N3,&$N5,&$N7,&$N9,&$N#,&$N$ . CONDITIONAL GEN SWITCHES 01310000
LCLB &CODSW . ACTUAL OP CODES SWITCH 01320000
LCLB &SYM . WHETHER SYMBOLS GEN'D HERE 01330000
LCLC &LC1,&LC2 . USED TO CONSTRUCT STRINGS 01340000
LCLC &C,&OPC,&OPM1,&OPM2,&OPM3 . FOR CONSTRUCTING OP CODES/MODS 01350000
.* 01360000
.* PARAMETER TRANSFORMATION TABLE 01370000
.* 01380000
TABLE &OP . OPERATION CODES (WITHOUT MODS) 01390000
GET TABDF $NCGET 01400000
PUT TABDF $NCPUT 01410000
PTG TABDF $NCPTG 01420000
PNW TABDF $NCPNW 01430000
INV TABDF $NCINV 01440000
ACC TABDF $NCACC 01450000
SPI TABDF $NCSPI 01460000
ACQ TABDF $NCACQ 01470000
REL TABDF $NCREL 01480000
GTA TABDF $NCGTA 01490000
SHQ TABDF $NCSHQ 01500000
CPY TABDF $NCCPY 01510000
EAU TABDF $NCEAU 01520000
.* 01530000
TABLE &EXEC . BRANCH TO PERFORM I/O OR NOT 01540000
YES TABDF Y 01550000
NO TABDF N 01560000
N TABDF N 01570000
TABDF Y 01580000
.* 01590000
TEXT 01600000
.* 01610000
.* BEGIN PROCEDURAL PORTION OF MACRO-DEFINITION 01620000
.* 01630000
SPACE 1 01640000
* *** MACRO-$NCIO RELEASE-8 *** 01650000
.* 01660000
.* IF COMMON EQUATES HAVE ALREADY BEEN GENERATED, SKIP TO NEXT 01670000
.* SECTION -- ELSE GENERATE THEM HERE 01680000
.* 01690000
AIF (&$NCOM).CI019 . SKIP IF EQUATES ALREADY GEN'D 01700000
SPACE 1 01710000
* COMMON SYMBOLS USED IN CCP COMMUNICATIONS OPERATIONS 01720000
SPACE 1 01730000
$NIXR1 EQU 1 XR1--USED AS WORK REGISTER 01740000
$NIXR2 EQU 2 XR2--POINTS TO PARAMETER LIST 01750000
$NSENT EQU 4 DSM SUPERVISOR GENERAL ENTRY 01760000
$NSCCR EQU X'01' DSM RIB--CCP OPERATION 01770000
$NSCCS EQU X'00' CCP SUB-RIB--COMMUNICATIONS I/O 01780000
$NLPL EQU 16 LENGTH OF PARAMETER LIST 01790000
$NLPLF EQU 2 LENGTH OF A PARAMETER LIST FIELD 01800000
$NLSTN EQU 6 LENGTH OF SYMBOLIC TERMINAL NAME 01810000
.* 01820000
&SYM SETB 1 . INDICATE SYMBOLS GEN'D HERE 01830000
&$NCOM SETB 1 . INDICATE COMMON SYMBOLS GEN'D 01840000
.CI019 ANOP 01850000
.* 01860000
.* IF PARAMETER LIST OFFSETS HAVE ALREADY BEEN GENERATED, SKIP TO 01870000
.* NEXT SECTION -- ELSE GENERATE THEM HERE 01880000
.* 01890000
AIF (&$NPLO).CI029 . SKIP IF OFFSETS ALREADY GEN'D 01900000
SPACE 1 01910000
* OFFSETS OF COMMUNICATIONS PARAMETER LIST FIELDS 01920000
SPACE 1 01930000
$NPRTC EQU +1 RETURN CODE FIELD 01940000
$NPOPC EQU +3 OPERATION CODE/MODIFIERS FIELD 01950000
$NPOUL EQU +5 OUTPUT LENGTH FIELD 01960000
$NPEFL EQU +5 EFFECTIVE INPUT LENGTH FIELD 01970000
$NPATI EQU +5 ATTRIBUTES IDENTIFIER FIELD 01980000
$NPINL EQU +7 MAXIMUM INPUT LENGTH FIELD 01990000
$NPRAA EQU +9 RECORD AREA ADDRESS FIELD 02000000
$NPWKA EQU +11 INTERNAL WORK FIELD 02010000
$NPWKB EQU +13 INTERNAL WORK FIELD 02020000
$NPWKC EQU +15 INTERNAL WORK FIELD 02030000
.* 02040000
&SYM SETB 1 . INDICATE SYMBOLS GEN'D HERE 02050000
&$NPLO SETB 1 . INDICATE SYMBOLS ALREADY GEN'D 02060000
.CI029 ANOP 02070000
.* 02080000
.* IF OPERATION CODE VALUES HAVE ALREADY BEEN GENERATED, SKIP TO NEXT 02090000
.* SECTION -- ELSE GENERATE THEM HERE 02100000
.* 02110000
AIF (&$NOPV).CI039 . SKIP IF VALUES ALREADY GEN'D 02120000
SPACE 1 02130000
* CCP OPERATION CODE VALUES 02140000
SPACE 1 02150000
$NCSHQ EQU X'0000' SHUTDOWN INQUIRY 02160000
$NCGET EQU X'0001' GET 02170000
$NCPUT EQU X'0002' PUT 02180000
$NCPTG EQU X'0003' PUT THEN GET 02190000
$NCACC EQU X'0004' ACCEPT INPUT 02200000
$NCINV EQU X'0005' INVITE INPUT 02210000
$NCPNW EQU X'0006' PUT-NO-WAIT 02220000
$NCGTA EQU X'0008' GET TERMINAL ATTRIBUTES 02230000
$NCACQ EQU X'0009' ACQUIRE TERMINAL 02240000
$NCREL EQU X'000A' RELEASE TERMINAL 02250000
$NCCPY EQU X'0042' COPY (DFF ONLY) 02260000
$NCEAU EQU X'0052' ERASE ALL UNPROTECTED (DFF ONLY) 02270000
$NCSPI EQU X'0401' STOP INVITE/GET 02280000
SPACE 1 02290000
* CCP OPERATION MODIFIER VALUES 02300000
SPACE 1 02310000
$NMSTA EQU X'0010' SET TERMINAL ATTRIBUTES BY ID 02320000
$NMRVI EQU X'0010' SEND REVERSE-INTERRUPT 02330000
$NMKPL EQU X'0010' KEEP THE LINE 02340000
$NMBLK EQU X'0020' END THE CURRENT OUTPUT BLOCK 02350000
$NMMSG EQU X'0030' SEND END-OF-TRANSMISSION 02360000
$NMPRF EQU X'0040' READ UNDER FORMAT 02365000
$NMNEL EQU X'0100' RECORD DOES NOT END CURRENT LINE 02370000
$NMNNL EQU X'0200' RECORD DOES NOT START NEW LINE 02380000
$NMOVR EQU X'0800' OVERRIDE/SELECTED-FIELDS LIST 02390000
.* 02400000
&SYM SETB 1 . INDICATE SYMBOLS GEN'D HERE 02410000
&$NOPV SETB 1 . INDICATE VALUES ALREADY GEN'D 02420000
.CI039 ANOP 02430000
.* 02440000
.*--------------------------- L A B E L ----------------------------* 02450000
.* 02460000
AIF (&SYM).CI040 . SKIP IF ANY SYMBOLS GEN'D HERE 02470000
AGO .CI045 . SKIP IF *NO* SYMBOLS GEN'D 02480000
.CI040 ANOP 02490000
SPACE 2 02500000
.CI045 ANOP 02510000
.* 02520000
AIF (T'&LABEL EQ 'O').CI050 . SKIP IF NO LABEL SPECIFIED 02530000
&LABEL EQU * INSTRUCTION LABEL 02540000
.CI050 ANOP 02550000
.* 02560000
.*--------------------------- P L I S T ----------------------------* 02570000
.* 02580000
.* IF 'PLIST' SPECIFIED AS OTHER THAN '(2)', SET XR2 TO PARAMETER LIST 02590000
.* ADDRESS 02600000
.* 02610000
AIF (T'&PLIST EQ 'O').CI199 . SKIP TO NEXT SECTION IF ABSENT 02620000
AIF (&PLIST EQ '(2)').CI199 . SKIP IF ALREADY IN XR2 02630000
AIF (&PLIST EQ '(1)').CI110 . SKIP IF SPEC'D AS IN XR1 NOW 02640000
AIF ('&PLIST'(1,1) EQ '(').CI150 . SKIP IF ADDR OF ADDR 02650000
.* 02660000
.* PLIST -- DIRECT ADDRESS 02670000
.* 02680000
LA &PLIST,$NIXR2 SET XR2--ADDR OF PARAMETER LIST 02690000
AGO .CI199 . SKIP TO NEXT SECTION 02700000
.* 02710000
.* PLIST -- ADDRESS IN XR1 02720000
.* 02730000
.CI110 ANOP 02740000
LA 0(,$NIXR1),$NIXR2 SET XR2--ADDR OF PARAMETER LIST 02750000
AGO .CI199 . SKIP TO NEXT SECTION 02760000
.* 02770000
.* PLIST -- INDIRECT ADDRESS 02780000
.* 02790000
.CI150 ANOP 02800000
&N SETA K'&PLIST . LENGTH OF PARAMETER 02810000
AIF (&N GT '18').CIETL . SKIP IF PARAMETER TOO LONG 02820000
AIF ('&PLIST'(&N,1) NE ')').CIERP . ERR IF NO RIGHT PAREN 02830000
.* 02840000
&M SETA &N-2 . LENGTH OF PARAMETER - 2 02850000
&MM SETA 0 . INITIALIZE VARIABLE TO ZERO 02860000
AIF (&N LE '10').CI155 . SKIP IF LE 8 CHARS IN PARENS 02870000
&MM SETA &N-10 . LENGTH OF PARAMETER - 10 02880000
.CI155 ANOP 02890000
&LC1 SETC '&PLIST'(2,&M) . REMOVE SURROUNDING PARENS 02900000
&LC2 SETC '&PLIST'(10,&MM) . GET REMAINDER IF ANY 02910000
L &LC1&LC2,$NIXR2 SET XR2--ADDR OF PARAMETER LIST 02920000
.* 02930000
.CI199 ANOP . END OF SECTION--PLIST 02940000
.* 02950000
.*------------------------------- O P ------------------------------* 02960000
.* 02970000
.* SET OPERATION CODE AND MODIFIERS INTO BYTES 2-3 OF LIST 02980000
.* 02990000
AIF (T'&OP EQ 'O').CI299 . SKIP IF OPERAND OMITTED 03000000
.* 03010000
AIF (&OP EQ '(1)').CI201 . SKIP IF SPEC'D AS IN XR1 03020000
.* 03030000
AIF ('&OP'(1,1) EQ '(').CI210 . SKIP IF INDIRECT ADDRESS 03040000
.* 03050000
AGO .CI220 . SKIP--EXPRESSION OR CODES 03060000
.* 03070000
.* OP -- IN INDEX REGISTER 1 03080000
.* 03090000
.CI201 ANOP 03100000
ST $NPOPC(,$NIXR2),$NIXR1 SET OPERATION CODE/MODIFIERS 03110000
AGO .CI299 . SKIP TO NEXT SECTION 03120000
.* 03130000
.* OP -- INDIRECT ADDRESS 03140000
.* 03150000
.CI210 ANOP 03160000
&N SETA K'&OP . LENGTH OF PARAMETER 03170000
AIF (&N GT '18').CIETL . SKIP IF PARAMETER TOO LONG 03180000
AIF ('&OP'(&N,1) NE ')').CIERP . ERR IF NO RIGHT PAREN 03190000
.* 03200000
&M SETA &N-2 . LENGTH OF PARAMETER - 2 03210000
&MM SETA 0 . INITIALIZE VARIABLE TO ZERO 03220000
AIF (&N LE '10').CI215 . SKIP IF LE 8 CHARS IN PARENS 03230000
&MM SETA &N-10 . LENGTH OF PARAMETER - 10 03240000
.CI215 ANOP 03250000
&LC1 SETC '&OP'(2,&M) . REMOVE SURROUNDING PARENS 03260000
&LC2 SETC '&OP'(10,&MM) . GET REMAINDER IF ANY 03270000
MVC $NPOPC(2,$NIXR2),&LC1&LC2 SET OPERATION CODE/MODIFIER 03280000
AGO .CI299 . SKIP TO NEXT SECTION 03290000
.* 03300000
.* OP -- DETERMINE WHETHER EXPRESSION OR CODES 03310000
.* 03320000
.CI220 ANOP 03330000
AIF ('&OP'(4,1) EQ ',').CI230 . SKIP IF CODE WITH MODIFIERS 03340000
AGO .CI280 . SKIP IF DEFINITELY EXPRESSION 03350000
.* 03360000
.* OP -- WITH MODIFIER CODES -- DETERMINE IF VALID OP CODE 03370000
.* 03380000
.CI230 ANOP 03390000
&N SETA 1 . INITIALIZE LOOP CONTROL 03400000
&C SETC '&OP'(1,3) . INITIALIZE COMPARAND 03410000
.* 03420000
.CI235 ANOP 03430000
AIF (&C EQ 'GETINVPUTPNWPTGACQRELACCSPIGTASHQ'(&N,3)).CI240 03440000
&N SETA &N+3 . STEP LOOP CONTROL 03450000
AIFB (&N LT '34').CI235 . REITERATE IF NOT EXHAUSTED 03460000
&N SETA 1 . REINITIALIZE LOOP CONTROL 03470000
.CI236 AIF (&C EQ 'CPYEAURUF'(&N,3)).CI240 03480000
&N SETA &N+3 . STEP LOOP CONTROL 03490000
AIFB (&N LT '10').CI236 . REITERATE IF NOT EXHAUSTED 03500000
.* 03510000
.* OP -- INVALID OPERATION CODE 03520000
.* 03530000
MNOTE 08,'N3001 INVALID OPERATION CODE SPECIFIED' 03540000
AGO .CI999 . SKIP TO LEAVE MACRO 03550000
.* 03560000
.* OP -- VALID OP CODE -- COLLECT ANY MODIFIERS 03570000
.* 03580000
.CI240 ANOP 03590000
&CODSW SETB 1 . SIGNAL ACTUAL OP CODE PRESENT 03600000
&OPC SETC '$NC&C' . SET UP OP CODE SYMBOL 03610000
AIF (K'&OP EQ '3').CI289 . SKIP IF ONLY OP CODE 03620000
.* 03630000
&C SETC '&OP'(5,3) . EXTRACT FIRST MODIFIER 03640000
&OPM1 SETC '+$NM&C' . CONSTRUCT 1ST MODIFIER SYMBOL 03650000
AIF (K'&OP LE '7').CI289 . SKIP IF ONLY 1 MODIFIER 03660000
.* 03670000
&C SETC '&OP'(9,3) . EXTRACT 2ND MODIFIER 03680000
&OPM2 SETC '+$NM&C' . CONSTRUCT 2ND MODIFIER SYMBOL 03690000
AIF (K'&OP LE '11').CI289 . SKIP IF ONLY 2 MODIFIERS 03700000
.* 03710000
&C SETC '&OP'(13,3) . EXTRACT 3RD MODIFIER 03720000
&OPM3 SETC '+$NM&C' . CONSTRUCT 3RD MODIFIER SYMBOL 03730000
AIF (K'&OP LE '15').CI289 . SKIP IF NO MORE THAN 3 MODIFRS 03740000
.* 03750000
.* OP -- TOO MANY MODIFIERS 03760000
.* 03770000
MNOTE 08,'N3002 INVALID OPERATION MODIFIER SPECIFIED' * 03780000
AGO .CI999 . SKIP TO END MACRO 03790000
.* 03800000
.* OP -- EXPRESSION SPECIFIED 03810000
.* 03820000
.CI280 ANOP 03830000
.CI289 ANOP 03840000
&$N3 SETB 1 . SIGNAL CONSTANT TO BE GEN'D 03850000
&$N$ SETB 1 . SIGNAL JUMP TO GE GEN'D 03860000
MVC $NPOPC(2,$NIXR2),$N3&SYSNDX SET OPERATION CODE/MODIFIER 03870000
.* 03880000
.CI299 ANOP . END OF OPERATION SECTION 03890000
.* 03900000
.*--------------------------- O U T L E N --------------------------* 03910000
.* 03920000
.* 03930000
.* SET OUTPUT LENGTH INTO BYTES 4-5 OF PARAMETER LIST 03940000
.* 03950000
AIF (T'&OUTLEN EQ 'O').CI399 . SKIP IF NO OUTPUT LENGTH 03960000
AIF (&OUTLEN EQ '(1)').CI310 . SKIP IF LENGTH IN XR1 03970000
AIF ('&OUTLEN'(1,1) EQ '(').CI350 . SKIP IF INDIRECT ADDRESS 03980000
.* 03990000
.* OUTLEN -- ACTUAL VALUE 04000000
.* 04010000
&$N5 SETB 1 . SIGNAL CONSTANT TO BE GEN'D 04020000
&$N$ SETB 1 SIGNAL JUMP TO BE GEN'D 04030000
MVC $NPOUL(2,$NIXR2),$N5&SYSNDX SET OUTPUT DATA LENGTH 04040000
AGO .CI399 . SKIP TO NEXT SECTION 04050000
.* 04060000
.* OUTLEN -- IN INDEX REGISTER 1 04070000
.* 04080000
.CI310 ANOP 04090000
ST $NPOUL(,$NIXR2),$NIXR1 SET OUTPUT DATA LENGTH 04100000
AGO .CI399 . SKIP TO NEXT SECTION 04110000
.* 04120000
.* OUTLEN -- INDIRECT ADDRESS 04130000
.* 04140000
.CI350 ANOP 04150000
&N SETA K'&OUTLEN . LENGTH OF PARAMETER 04160000
AIF (&N GT '18').CIETL . SKIP IF PARAMETER TOO LONG 04170000
AIF ('&OUTLEN'(&N,1) NE ')').CIERP . ERR IF NO RIGHT PAREN 04180000
.* 04190000
&M SETA &N-2 . LENGTH OF PARAMETER - 2 04200000
&MM SETA 0 . INITIALIZE VARIABLE TO ZERO 04210000
AIF (&N LE '10').CI355 . SKIP IF LE 8 CHARS IN PARENS 04220000
&MM SETA &N-10 . LENGTH OF PARAMETER - 10 04230000
.CI355 ANOP 04240000
&LC1 SETC '&OUTLEN'(2,&M) . REMOVE SURROUNDING PARENS 04250000
&LC2 SETC '&OUTLEN'(10,&MM) . GET REMAINDER IF ANY 04260000
MVC $NPOUL(2,$NIXR2),&LC1&LC2 SET OUTPUT DATA LENGTH 04270000
.* 04280000
.CI399 ANOP . END OF SECTION 04290000
.* 04300000
.*--------------------------- A T T R I D --------------------------* 04310000
.* 04320000
.* SET ATTRIBUTES IDENTIFIER INTO BYTES 4-5 OF PARAMETER LIST 04330000
.* 04340000
AIF (T'&ATTRID EQ 'O').CI499 . SKIP IF NO ATTRIBUTES ID 04350000
.* 04360000
AIF (T'&OUTLEN EQ 'O').CI401 . SKIP IF ATTRID--NO OUTLEN 04370000
.* 04380000
.* ATTRID -- ERROR -- SPECIFIED ALONG WITH OUTLEN 04390000
.* 04400000
MNOTE 08,'N2001 CONFLICTING OPERANDS--OUTLEN/ATTRID' 04410000
AGO .CI999 . SKIP TO END MACRO 04420000
.* 04430000
.CI401 ANOP 04440000
AIF (&ATTRID EQ '(1)').CI410 . SKIP IF ATTRID IN XR1 04450000
AIF ('&ATTRID'(1,1) EQ '(').CI450 . SKIP IF INDIRECT ADDRESS 04460000
.* 04470000
.* ATTRID -- ACTUAL VALUE 04480000
.* 04490000
&$N5 SETB 1 . SIGNAL CONSTANT TO BE GEN'D 04500000
&$N$ SETB 1 SIGNAL JUMP TO BE GEN'D 04510000
MVC $NPATI(2,$NIXR2),$N5&SYSNDX SET ATTRIBUTES IDENTIFIER 04520000
AGO .CI499 . SKIP TO NEXT SECTION 04530000
.* 04540000
.* ATTRID -- IN INDEX REGISTER 1 04550000
.* 04560000
.CI410 ANOP 04570000
ST $NPATI(,$NIXR2),$NIXR1 SET ATTRIBUTES IDENTIFIER 04580000
AGO .CI499 . SKIP TO NEXT SECTION 04590000
.* 04600000
.* ATTRID -- INDIRECT ADDRESS 04610000
.* 04620000
.CI450 ANOP 04630000
&N SETA K'&ATTRID . LENGTH OF PARAMETER 04640000
AIF (&N GT '18').CIETL . SKIP IF PARAMETER TOO LONG 04650000
AIF ('&ATTRID'(&N,1) NE ')').CIERP . ERR IF NO RIGHT PAREN 04660000
.* 04670000
&M SETA &N-2 . LENGTH OF PARAMETER - 2 04680000
&MM SETA 0 . INITIALIZE VARIABLE TO ZERO 04690000
AIF (&N LE '10').CI455 . SKIP IF LE 8 CHARS IN PARENS 04700000
&MM SETA &N-10 . LENGTH OF PARAMETER - 10 04710000
.CI455 ANOP 04720000
&LC1 SETC '&ATTRID'(2,&M) . REMOVE SURROUNDING PARENS 04730000
&LC2 SETC '&ATTRID'(10,&MM) . GET REMAINDER IF ANY 04740000
MVC $NPATI(2,$NIXR2),&LC1&LC2 SET ATTRIBUTES IDENTIFIER 04750000
.* 04760000
.CI499 ANOP . END OF SECTION 04770000
.* 04780000
.*--------------------------- I N L E N ----------------------------* 04790000
.* 04800000
.* SET INPUT LENGTH IN BYTES 6-7 OF PARAMETER LIST 04810000
.* 04820000
AIF (T'&INLEN EQ 'O').CI599 . SKIP IF NO INPUT LENGTH 04830000
AIF (&INLEN EQ '(1)').CI510 . SKIP IF INLEN IN XR1 04840000
AIF ('&INLEN'(1,1) EQ '(').CI550 . SKIP IF INDIRECT ADDRESS 04850000
.* 04860000
.* INLEN -- ACTUAL VALUE SPECIFIED 04870000
.* 04880000
&$N7 SETB 1 . SIGNAL CONSTANT TO BE GEN'D 04890000
&$N$ SETB 1 . SIGNAL JUMP TO BE GEN'D 04900000
MVC $NPINL(2,$NIXR2),$N7&SYSNDX SET MAXIMUM INPUT DATA LENGTH 04910000
AGO .CI599 . SKIP TO NEXT SECTION 04920000
.* 04930000
.* INLEN -- IN INDEX REGISTER 1 04940000
.* 04950000
.CI510 ANOP 04960000
ST $NPINL(,$NIXR2),$NIXR1 SET MAXIMUM INPUT DATA LENGTH 04970000
AGO .CI599 . SKIP TO NEXT SECTION 04980000
.* 04990000
.* INLEN -- INDIRECT ADDRESS 05000000
.* 05010000
.CI550 ANOP 05020000
&N SETA K'&INLEN . LENGTH OF PARAMETER 05030000
AIF (&N GT '18').CIETL . SKIP IF PARAMETER TOO LONG 05040000
AIF ('&INLEN'(&N,1) NE ')').CIERP . ERR IF NO RIGHT PAREN 05050000
.* 05060000
&M SETA &N-2 . LENGTH OF PARAMETER - 2 05070000
&MM SETA 0 . INITIALIZE VARIABLE TO ZERO 05080000
AIF (&N LE '10').CI555 . SKIP IF LE 8 CHARS IN PARENS 05090000
&MM SETA &N-10 . LENGTH OF PARAMETER - 10 05100000
.CI555 ANOP 05110000
&LC1 SETC '&INLEN'(2,&M) . REMOVE SURROUNDING PARENS 05120000
&LC2 SETC '&INLEN'(10,&MM) . GET REMAINDER IF ANY 05130000
MVC $NPINL(2,$NIXR2),&LC1&LC2 SET MAXIMUM INPUT DATA LENGTH 05140000
.* 05150000
.CI599 ANOP . END OF SECTION 05160000
.* 05170000
.*--------------------------- R E C A ------------------------------* 05180000
.* 05190000
.* SET RECORD AREA ADDRESS IN BYTES 8-9 OF PARAMETER LIST 05200000
.* 05210000
AIF (T'&RECA EQ 'O').CI699 . SKIP IF NO RECORD ADDRESS 05220000
AIF (&RECA EQ '(1)').CI610 . SKIP IF REC ADDR IN XR1 05230000
AIF ('&RECA'(1,1) EQ '(').CI650 . SKIP IF INDIRECT ADDRESS 05240000
.* 05250000
.* RECA -- ACTUAL ADDRESS SPECIFIED 05260000
.* 05270000
AIF (T'&TNAME NE 'O').CI605 . SKIP IF TNAME TO BE SET 05280000
.* 05290000
.* RECA -- ACTUAL ADDRESS / *NO* TNAME 05300000
.* 05310000
&$N9 SETB 1 . SIGNAL CONSTANT TO BE GEN'D 05320000
&$N$ SETB 1 . SIGNAL JUMP TO BE GEN'D 05330000
MVC $NPRAA(2,$NIXR2),$N9&SYSNDX SET RECORD AREA ADDRESS 05340000
AGO .CI699 . SKIP TO NEXT SECTION 05350000
.* 05360000
.* RECA -- ACTUAL ADDRESS / *TNAME* TO BE SET 05370000
.* 05380000
.CI605 ANOP 05390000
LA &RECA,$NIXR1 SET XR1--ADDR OF RECORD AREA 05400000
.* 05410000
.* RECA -- IN INDEX REGISTER 1 05420000
.* 05430000
.CI610 ANOP 05440000
ST $NPRAA(,$NIXR2),$NIXR1 SET RECORD AREA ADDRESS 05450000
AGO .CI699 . SKIP TO NEXT SECTION 05460000
.* 05470000
.* RECA -- INDIRECT ADDRESS 05480000
.* 05490000
.CI650 ANOP 05500000
&N SETA K'&RECA . LENGTH OF PARAMETER 05510000
AIF (&N GT '18').CIETL . SKIP IF PARAMETER TOO LONG 05520000
AIF ('&RECA'(&N,1) NE ')').CIERP . ERR IF NO RIGHT PAREN 05530000
.* 05540000
&M SETA &N-2 . LENGTH OF PARAMETER - 2 05550000
&MM SETA 0 . INITIALIZE VARIABLE TO ZERO 05560000
AIF (&N LE '10').CI655 . SKIP IF LE 8 CHARS IN PARENS 05570000
&MM SETA &N-10 . LENGTH OF PARAMETER - 10 05580000
.CI655 ANOP 05590000
&LC1 SETC '&RECA'(2,&M) . REMOVE SURROUNDING PARENS 05600000
&LC2 SETC '&RECA'(10,&MM) . GET REMAINDER IF ANY 05610000
.* 05620000
AIF (T'&TNAME NE 'O').CI670 . SKIP IF TNAME PRESENT 05630000
.* 05640000
.* RECA -- INDIRECT ADDRESS / *NO* TNAME 05650000
.* 05660000
MVC $NPRAA(2,$NIXR2),&LC1&LC2 SET RECORD AREA ADDRESS 05670000
AGO .CI699 . SKIP TO NEXT SECTION 05680000
.* 05690000
.* RECA -- INDIRECT ADDRESS -- *TNAME* TO BE SET 05700000
.* 05710000
.CI670 ANOP 05720000
L &LC1&LC2,$NIXR1 SET XR1--ADDR OF RECORD AREA 05730000
ST $NPRAA(,$NIXR2),$NIXR1 SET RECORD AREA ADDRESS 05740000
.* 05750000
.CI699 ANOP . END OF SECTION 05760000
.* 05770000
.*--------------------------- T N A M E ----------------------------* 05780000
.* 05790000
.* SET TERMINAL NAME INTO BYTES 0-5 OF THE RECORD AREA 05800000
.* 05810000
AIF (T'&TNAME EQ 'O').CI799 . SKIP IF NO TERMINAL NAME 05820000
AIF (T'&RECA NE 'O').CI701 . SKIP IF RECA *WAS* SPECIFIED 05830000
.* 05840000
.* TNAME -- RECA WAS *NOT* SPECIFIED -- MUST LOAD FROM PARAMETER LIST 05850000
.* 05860000
L $NPRAA(,$NIXR2),$NIXR1 SET XR1--ADDR OF RECORD AREA 05870000
.* 05880000
.CI701 ANOP 05890000
AIF ('&TNAME'(1,1) EQ '(').CI750 . SKIP IF ADDRESS OF NAME 05900000
.* 05910000
.* TNAME -- ACTUAL NAME SPECIFIED 05920000
.* 05930000
&$N# SETB 1 . SIGNAL CONSTANT TO BE GEN'D 05940000
&$N$ SETB 1 SIGNAL JUMP TO BE GEN'D 05950000
MVC $NLSTN-1($NLSTN,$NIXR1),$N#&SYSNDX SET TERMINAL NAME 05960000
AGO .CI799 . SKIP TO NEXT SECTION 05970000
.* 05980000
.* TNAME -- ADDRESS OF THE NAME SPECIFIED 05990000
.* 06000000
.CI750 ANOP 06010000
&N SETA K'&TNAME . LENGTH OF PARAMETER 06020000
AIF (&N GT '18').CIETL . SKIP IF PARAMETER TOO LONG 06030000
AIF ('&TNAME'(&N,1) NE ')').CIERP . ERR IF NO RIGHT PAREN 06040000
.* 06050000
&M SETA &N-2 . LENGTH OF PARAMETER - 2 06060000
&MM SETA 0 . INITIALIZE VARIABLE TO ZERO 06070000
AIF (&N LE '10').CI755 . SKIP IF LE 8 CHARS IN PARENS 06080000
&MM SETA &N-10 . LENGTH OF PARAMETER - 10 06090000
.CI755 ANOP 06100000
&LC1 SETC '&TNAME'(2,&M) . REMOVE SURROUNDING PARENS 06110000
&LC2 SETC '&TNAME'(10,&MM) . GET REMAINDER IF ANY 06120000
MVC $NLSTN-1($NLSTN,$NIXR1),&LC1&LC2 SET TERMINAL NAME 06130000
.* 06140000
.CI799 ANOP . END OF SECTION 06150000
.* 06160000
.*----------- C R E A T E A N Y C O N S T A N T S --------------* 06170000
.* 06180000
AIF (&$N$).CI801 . SKIP IF ANY CONSTANTS TO GEN 06190000
AGO .CI899 . SKIP IF *NO* CONSTANTS TO GEN 06200000
.* 06210000
.* CONSTANTS -- GENERATE THE JUMP AROUND THEM 06220000
.* 06230000
.CI801 ANOP 06240000
J $N$&SYSNDX JUMP AROUND GENERATED CONSTANTS 06250000
SPACE 1 06260000
.* 06270000
.* CONSTANTS -- FOR OPERATION CODE 06280000
.* 06290000
AIF (&$N3).CI810 . SKIP IF OP CODE TO GEN 06300000
AGO .CI829 . SKIP IF *NO* OP CODE TO GEN 06310000
.* 06320000
.CI810 ANOP 06330000
AIF (&CODSW).CI820 . SKIP IF *ACTUAL* CODES 06340000
.* 06350000
$N3&SYSNDX DC AL2(&OP) OPERATION CODE/MODIFIERS 06360000
AGO .CI829 . SKIP TO CHECK NEXT CONSTANT 06370000
.* 06380000
.CI820 ANOP 06390000
$N3&SYSNDX DC AL2(&OPC&OPM1&OPM2&OPM3) OPERATION CODE/MODIFIERS 06400000
.* 06410000
.CI829 ANOP . END OF SUB-SECTION 06420000
.* 06430000
.* CONSTANTS -- OUTPUT DATA LENGTH /OR/ ATTRIBUTES IDENTIFIER 06440000
.* 06450000
AIF (&$N5).CI830 . SKIP IF CONSTANT TO GENERATE 06460000
AGO .CI839 . SKIP IF *NO* CONSTANT TO GEN 06470000
.* 06480000
.CI830 ANOP 06490000
AIF (T'&OUTLEN EQ 'O').CI835 . SKIP IF IT IS ATTRID TO GEN 06500000
$N5&SYSNDX DC AL2(&OUTLEN) OUTPUT DATA LENGTH 06510000
AGO .CI839 . SKIP TO NEXT SUB-SECTION 06520000
.* 06530000
.CI835 ANOP 06540000
$N5&SYSNDX DC AL2(&ATTRID) ATTRIBUTES IDENTIFIER 06550000
.* 06560000
.CI839 ANOP . END OF SUB-SECTION 06570000
.* 06580000
.* CONSTANTS -- INPUT DATA LENGTH 06590000
.* 06600000
AIF (&$N7).CI840 . SKIP IF CONSTANT TO GENERATE 06610000
AGO .CI849 . SKIP IF *NO* INPUT LEN TO GEN 06620000
.* 06630000
.CI840 ANOP 06640000
$N7&SYSNDX DC AL2(&INLEN) MAXIMUM INPUT DATA LENGTH 06650000
.* 06660000
.CI849 ANOP . END OF SUB-SECTION 06670000
.* 06680000
.* CONSTANTS -- RECORD AREA ADDRESS 06690000
.* 06700000
AIF (&$N9).CI850 . SKIP IF RECA CONSTANT TO GEN 06710000
AGO .CI859 . SKIP IF *NO* RECA CONSTANT 06720000
.* 06730000
.CI850 ANOP 06740000
$N9&SYSNDX DC AL2(&RECA) RECORD AREA ADDRESS 06750000
.* 06760000
.CI859 ANOP . END OF SUB-SECTION 06770000
.* 06780000
.* CONSTANTS -- TERMINAL NAME 06790000
.* 06800000
AIF (&$N#).CI860 . SKIP IF NAME TO BE GEN'D 06810000
AGO .CI869 . SKIP IF *NO* NAME TO GEN 06820000
.* 06830000
.CI860 ANOP 06840000
$N#&SYSNDX DC CL6'&TNAME' SYMBOLIC TERMINAL NAME 06850000
.* 06860000
.CI869 ANOP . END OF SUB-SECTION 06870000
.* 06880000
.* GENERATE THE JUMP-TO SYMBOL 06890000
.* 06900000
SPACE 1 06910000
$N$&SYSNDX EQU * JUMP TO HERE AROUND CONSTANTS 06920000
.* 06930000
.CI899 ANOP . END OF SECTION 06940000
.* 06950000
.*--------------------------- E X E C ------------------------------* 06960000
.* 06970000
.* UNLESS EXEC-NO WAS SPECIFIED, BRANCH TO GENERAL ENTRY WITH PROPER 06980000
.* RIB AND SUB-RIB TO PERFORM THE OPERATION. 06990000
.* 07000000
AIF (&EXEC EQ 'N').CI999 . SKIP IF EXEC-NO SPECIFIED 07010000
.* 07020000
B $NSENT BRANCH TO GENERAL ENTRY 07030000
DC AL1($NSCCR) RIB FOR A CCP FUNCTION 07040000
DC AL1($NSCCS) SUB-RIB FOR COMMUNICATIONS I/O 07050000
.CI909 AGO .CI999 . SKIP TO CONCLUDE MACRO 07060000
.* 07070000
.* SYNTAX ERROR -- EXPRESSION TOO LONG. 07080000
.* 07090000
.CIETL ANOP 07100000
SPACE 1 07110000
MNOTE 08,'N3004 PARENTHESIZED PARAMETER TOO LONG' 07120000
SPACE 1 07130000
AGO .CI999 07140000
.* 07150000
.* SYNTAX ERROR -- MISSING RIGHT PAREN 07160000
.* 07170000
.CIERP ANOP 07180000
SPACE 1 07190000
MNOTE 08,'N3003 PARAMETER MISSING FINAL RIGHT-PAREN' 07200000
SPACE 1 07210000
.* 07220000
.* COMMON END OF MACRO 07230000
.* 07240000
.CI999 ANOP 07250000
* *** END GENERATION--$NCIO *** 07260000
SPACE 1 07270000
MEND 07280000