TITLE 'IKJEFP60 - IKJPARS2 INTERFACE AND INITIALIZATION' 00010000 * GEN (EJECT); 00020000 EJECT 00030000 * 00040000 * /******************************************************************** 00050000 * /* * 00060000 * /* TITLE: IKJPEF60 - IKJPARS2 LOAD MODULE * 00070000 * /* * 00080000 * /* STATUS: CHANGE LEVEL - 000 * 00090000 * /* * 00100000 * /* FUNCTION: * 00110000 * /* * 00120000 * /* IKJPARS2 IS A SEPARATE LOAD MODULE OF THE IKJPARS * 00130000 * /* SERVICE ROUTINE IN TSO. IKJPARS2 CONTROLS THE SYNTACTICAL * 00140000 * /* SCAN OF COBOL SYMBOLIC DEBUG COMMAND PARAMETERS. SYNTAX * 00150000 * /* CHECKING IS PERFORMED, AND PROMPTING IS ACCOMPLISHED, * 00160000 * /* THROUGH INTERFACES WITH THE IKJPARS LOAD MODULE. CONSISTENCY * 00170000 * /* IS MAINTAINED IN ALL EXTERNAL INTERFACES WITH THE TERMINAL * 00180000 * /* IN SO FAR AS PROMPTING IS CONCERNED. * 00190000 * /* THE INTERFACE WITH THE CP IS THE SAME AS WITH IKJPARS. * 00200000 * /* * 00210000 * /* ENTRY POINT: IKJPARS2 * 00220000 * /* * 00230000 * /* INPUT: * 00240000 * /* * 00250000 * /* THE PAREMETER CONTROL LIST (PCL) IS CREATED BY THE CP * 00260000 * /* USING PARSE MACROS. THE COBOL SYMBOLIC DEBUG COMMAND * 00270000 * /* SYNTAX IS DESCRIBED BY THREE MACROS: * 00280000 * /* * 00290000 * /* 1) IKJTERM - VARIABLES, CONSTANTS, STATEMENTS * 00300000 * /* * 00310000 * /* 2) IKJOPER - EXPRESSIONS * 00320000 * /* * 00330000 * /* 3) IKJRSVWD - RESERVED WORDS. * 00340000 * /* * 00350000 * /* EACH MACRO GENERATES AN ENTRY IN THE PCL, (PCE). * 00360000 * /* CONTROL IS PASSED TO IKJPARS2 BY THE IKJPARS LOAD MODULE * 00370000 * /* WHENEVER ONE OF THESE PCE TYPES IS ENCOUNTERED. * 00380000 * /* IKJPARS2 INITIALIZATION INTERROGATES THE PCE TYPE AND * 00390000 * /* PASSES CONTROL TO ONE OF THREE SCAN ROUTINES TO HANDLE THE * 00400000 * /* PARTICULAR INPUT PARAMETER: * 00410000 * /* * 00420000 * /* 1) IKJOPER - IKJEFP50 CSECT * 00430000 * /* 2) IKJRSVWD - IKJEFP40 CSECT * 00440000 * /* 3) IKJTERM - IKJEFP60 CSECT * 00450000 * /* * 00460000 * /* THE PDL ADDRESS IS PLACED IN A 4 BYTE AREA PROVIDED AS INPUT * 00470000 * /* BY THE CP. * 00480000 * /* THE INPUT BUFFER RECEIVED BY IKJPARS IS PASSED TO IKJPARS2 * 00490000 * /* WITH POINTERS INITIALIZED TO THE COBOL COMMAND PARAMETER * 00500000 * /* TO BE SCANNED UNDER THE PCE. A POINTER TO THE PCE TO CONTROL * 00510000 * /* THE SCAN IS ALSO PASSED TO IKJPARS2. * 00520000 * /* * 00530000 * /* OUTPUT: * 00540000 * /* * 00550000 * /* PARAMETER DESCRIPTOR LIST (PDL) POINTED TO BY THE ANSWER * 00560000 * /* PLACE. THE PDL CONTAINS THE PDE'S BUILT BY IKJPARS2 WHILE * 00570000 * /* SCANNING THE INPUT COMMAND PARAMETERS. * 00580000 * /* EACH PDE CORRESPONDS TO ONE PCE AND CONTAINS POINTER TO THE * 00590000 * /* INPUT PARAMETER, PLUS INDICATORS TO TYPE, LENGTH, ETC. THE * 00600000 * /* PDE FULLY DESCRIBES THE INPUT PARAMETER TO THE CP. * 00610000 * /* * 00620000 * /* EXTERNAL REFERENCES: * 00630000 * /* * 00640000 * /* IKJPARS - SEVERAL SUBROUTINES IN THE PARSE SERVICE ROUTINE * 00650000 * /* ARE USED BY THE IKJPARS2 LOAD MODULE TO ACCOMPLISH THE SCAN, * 00660000 * /* PDL BUILD AND PROMPTING. THESE ROUTINES ARE ENTERED THROUGH * 00670000 * /* THE COMMON IKJPARS2 INTERFACE ROUTINE - LINKRET. ADDRESSES * 00680000 * /* WITHIN IKJPARS ARE OBTAINED FROM AN ADCON TABLE CREATED * 00690000 * /* IN IKJPARS. INDICES INTO THE ADCON TABLE ARE PASSED TO * 00700000 * /* LINKRET FROM THE PARS2 ROUTINES TO CONTROL THE LINKAGE TO THE * 00710000 * /* PROPER SUBROUTINE. * 00720000 * /* MAINLINE IKJPARS INITIALIZATION IS ENTERED FIRST. IF A * 00730000 * /* COBOL PCE IS ENCOUNTERED, THE IKJPARS2 LOAD MODULE IS BROUGHT * 00740000 * /* INTO CORE AND CONTROL PASSED TO IT. * 00750000 * /* SUBROUTINES OF IKJPARS USED BY IKJPARS2 ARE: * 00760000 * /* * 00770000 * /* 1) QSTR01 - QSTRING ROUTINE * 00780000 * /* 2) PROMPTQ - PROMPT WITH 'ENTER ..' ROUTINE * 00790000 * /* 3) POSITXCB - ADD PDE TO PERMANENT PDL ROUTINE * 00800000 * /* 4) SYSR1 - WRITE INVALID MESSAGE AND PROMPT WITH REENTER * 00810000 * /* 5) SKIPB - SKIP BLANKS ROUTINE * 00820000 * /* 6) RANGE - DETERMINE IF RANGE ENTERED * 00830000 * /* 7) GENSCAN - PARAMETER SCAN ROUTINE * 00840000 * /* 8) TYPETEST - DETERMINE CHARACTER TYPE ROUTINE * 00850000 * /* 9) TRANSQ - TRANSLATE TO UPPER CASE ROUTINE * 00860000 * /* 10) PSTRIMSG - WRITE OUT ENDING PAREN ASSUMED MESSAGE * 00870000 * /* 11) LISTT - DETERMINE IF A LIST ENTERED * 00880000 * /* 12) STALOC - ALLOCATE STORAGE IN SUBPOOL 1 - PASSED BACK * 00890000 * /* TO CP. * 00900000 * /* 13) SCANF - POP THE STACK ROUTINE * 00910000 * /* 14) GETCORE - GET CORE WHICH WILL BE RELEASED BEFORE EXIT * 00920000 * /* 15) NAMESKP3 - SKIP TO NEXT PCE ROUTINE * 00930000 * /* 17) CLEANUP - FREE CORE, DELETE MODULES AND EXIT * 00940000 * /* 18) PUSHI - PUSH THE STACK ROUTINE * 00950000 * /* 19) PARS2ENT - ENTRY POINT FROM IKJPARS2 WHEN SUBROUTINE * 00960000 * /* FUNCTIONS ARE REQUIRED. * 00970000 * /* 20) NEXTPCE - GOTO NEXT PCE ROUTINE * 00980000 * /* * 00990000 * /* EXITS NORMAL: * 01000000 * /* * 01010000 * /* REGISTER 15 CONTAINS A 00 RETURN CODE. * 01020000 * /* ANSWER PLACE CONTAINS PDL ADDRESS. * 01030000 * /* * 01040000 * /* EXITS ERROR: * 01050000 * /* * 01060000 * /* REGISTER 15 CONTAINS A 24 RETURN CODE INDICATING AN ERROR * 01070000 * /* WAS DETECTED IN THE PARAMETERS PASSED TO THE IKJPARS2 LOAD * 01080000 * /* MODULE. * 01090000 * /* ALL PRESENT RETURN CODES FROM IKJPARS MAY ALSO BE RETURNED * 01100000 * /* IF AN ERROR IS DETECTED BY IKJPARS OUTSIDE THE IKJPARS2 MODULE. * 01110000 * /* THE ANSWER PLACE CONTAINS A X'FF000000' IF AN ERROR WAS * 01120000 * /* DETECTED. * 01130000 * /* * 01140000 * /* TABLES AND WORK AREAS: * 01150000 * /* * 01160000 * /* MACRO IKJEFPWA IS USED TO DEFINE THE WORK AREA OBTAINED * 01170000 * /* BY IKJEFP00 DURING INITIALIZATION. THIS MACRO HAS BEEN CHANGED * 01180000 * /* IN RELEASE 21.6 TO CONTIAN NECESSARY FIELDS FOR IKJPARS2 * 01190000 * /* PROCESSING. THIS MACRO IS EXPANDED IN BOTH IKJPARS AND * 01200000 * /* IKJEFP20. * 01210000 * /* * 01220000 * /* ATTRIBUTES: * 01230000 * /* * 01240000 * /* REENTRANT * 01250000 * /* * 01260000 * /* CHARACTER CODE DEPENDENCY: * 01270000 * /* * 01280000 * /* CLASS C. THE OPERATION OF THIS PROGRAM IS DEPENDENT UPON * 01290000 * /* AN INTERNAL REPRESENTATION OF THE EXTERNAL CHARACTER SET * 01300000 * /* WHICH IS EQUIVALENT TO THE ONE USED AT ASSEMBLY TIME. THE * 01310000 * /* CODING HAS BEEN DONE SO THAT REDEFINITION OF THE 'CHARACTER' * 01320000 * /* CONSTANTS, THROUGH MACRO VARIABLES, BY REASSEMBLY, WILL RESULT * 01330000 * /* IN A CORRECT PROGRAM FOR THE NEW DEFINITION. * 01340000 * /* * 01350000 * /* RELEASE 21.6 SUPPORT CODE: F00969 * 01360000 * /* * 01370000 * /******************************************************************** 01380000 * /* A 328320-328380,329320-329360,400320-400360,458320-458388 A00996 * 01390000 * /* A 337220-337260,430420-430496 A00996 * 01400000 * /* A 264420-264440,271920-271960,282510-282540,288220-288280 A00996 * 01410000 * /* A 295020,298520,304520,368820,381220,447220-447300,295020 A00996 * 01420000 * /* A 298520,304520,368820,381220,447220-447300,467920-467980 A00996 * 01430000 * /* A 521700,632720-633388,572126-572200 A00996 * 01440000 * /* C 246524,247200,265420,295000,298500,304500,316700,348300 A00996 * 01450000 * /* C 337300-338400,363600,368800,381200,383500,454000-454300 A00996 * 01460000 * /* C 523300,536600-536800,538500,546600-546700 A00996 * 01470000 * /* C 337300-338400,342000 A00996 * 01480000 * /* D 247300-247400,287800-288200,383600-383700,523400 A00996 * 01490000 * /* D 326700-326800 A00996 * 01500000 * /* C 395100 M4151 * 01510000 * /* C 129328-129385,522140-522319 M4161 * 01520000 * /* A 370000 - 370080,387500 YM2849 * 01530000 * /* D 370000,387500 -387600 YM2849 * 01540000 * 01550000 * GEN (EJECT); 01560000 EJECT 01570000 * 01580000 * IKJPARS2: 01590000 * PROC OPTIONS(DONTSAVE,CODEREG(2,3),NOSAVEAREA, REENTRANT); 01600000 LCLA &T,&SPN 0003 01610000 .@001 ANOP 0003 01620000 IKJPARS2 CSECT , 0003 01630000 BALR @2,0 0003 01640000 @PSTART DS 0H 0003 01650000 USING @PSTART+00000,@2 0003 01660000 LA @3,4095(0,@2) 0003 01670000 USING @PSTART+04095,@3 0003 01680000 L @0,@SIZ001 0003 01690000 GETMAIN R,LV=(0) 0003 01700000 LR @C,@1 0003 01710000 USING @DATD+00000,@C 0003 01720000 XC @TEMPS(@L),@TEMPS 0003 01730000 * 01740000 * /***************************************************************** 01750000 * /* * 01760000 * /* MACRO VARIABLES * 01770000 * /* * 01780000 * /***************************************************************** 01790000 * 01800000 * GEN (SPACE); 01810000 SPACE 01820000 DS 0H 01830000 * GEN (EJECT); 01840000 EJECT 01850000 DS 0H 01860000 * 01870000 * /***************************************************************** 01880000 * /* * 01890000 * /* DECLARATIONS * 01900000 * /* * 01910000 * /***************************************************************** 01920000 * 01930000 * DCL 01940000 * R0 REG(0); /* REGISTER 0 - WORK REG * 01950000 * DCL 01960000 * R1 PTR(31)REG(1); /* REGISTER 1 - WORK REGISTER * 01970000 * DCL 01980000 * R2 REG(2); /* BASE REGISTER * 01990000 * DCL 02000000 * R3 REG(3); /* BASE REGISTER * 02010000 * DCL 02020000 * XINPUT REG(4) PTR(31); /* POINTER IN COMMAND BUFFER * 02030000 * DCL 02040000 * XINPUTB REG(5) PTR(31); /* BACKUP POINTER * 02050000 * DCL 02060000 * XPCE REG(6) PTR(31); /* POINTER TO CURRENT PCE * 02070000 * DCL 02080000 * R7 REG(7); /* WORK REGISTER * 02090000 * DCL 02100000 * LINK1 REG(8); /* LINKAGE REGISTER FOR PARSE 02110000 * SUBROUTINES * 02120000 * DCL 02130000 * INDEX REG(8) PTR(31); /* USED AS INDEX INTO SPECIAL 02140000 * MESSAGE AREA * 02150000 * DCL 02160000 * LINK2 REG(9); /* LINKAGE REGISTER FOR PARSE 02170000 * SUBROUTINES * 02180000 * DCL 02190000 * R10 REG(10); /* REGISTER 10 - WORK REG * 02200000 * DCL 02210000 * PWAREG REG(11) PTR(31); /* BASE REGISTER TO PERMANENT 02220000 * WORK AREA * 02230000 * DCL 02240000 * OPCEPTR AUTOMATIC PTR(31); /* BASE FOR OPER PCE DSECT * 02250000 * DCL 02260000 * RSVDRTN AUTOMATIC PTR(31); /* RETURN LOCATION FROM P40 * 02270000 * /* F41448 * 02280000 * DCL 1 PWORK BASED(PWAREG) BDY(DWORD), /* F41448 * 02290000 * /* F41448 * 02300000 * /* PARSE PERMANENT WORKSPACE * 02310000 * /* F41448 * 02320000 * 2 DUMMY1, /* USED TO FIND LEN OF CSWORK * 02330000 * 4 SAVE1(18) PTR(31), /* SAVE AREA F41448 * 02340000 * 4 ADDRSAVE(4) PTR(31), /* SAVEAREA FOR ADDRESS RTN./-* 02350000 * /* -IKJEFP03 Y30NQJN* 02360000 * 4 P20SAVE(4) PTR(31), /* IKJEFP20 SAVE AREA Y02666 * 02370000 * 4 INTEGER(8) PTR(31) BDY(DWORD), /* P20 WORK AREA YM5578 * 02380000 * 4 PDWORD(2) PTR(31) BDY(DWORD), /* SCRATCH/SAVE/CONVERT*/ 02390000 * 6 PDWORD1 CHAR(4), 02400000 * 6 PDWORD2 PTR(31), 02410000 * 8 PDWD CHAR(1), 02420000 * /* F41448 * 02430000 * 4 ENDINPUT PTR(31), /* LAST INPUT CHAR. ADDRESS * 02440000 * /* F41448 * 02450000 * /*USED TO DETERMINE END OF DAT* 02460000 * /* F41448 * 02470000 * /* POINTER TO START OF DATA BEING SCANNED SET BY SKIPB SUBROUTINE * 02480000 * /* ALSO LENGTH OF DATA FIELD. THESE AREAS MUST BE CONTIGUOUS F41448 * 02490000 * /* F41448 * 02500000 * 4 PPOINTR PTR(31), /* LAST ENTITY START F41448 * 02510000 * 02520000 * 4 PLENGTH FIXED(15), /* LAST ENTITY LENGTH F41448 * 02530000 * /* F41448 * 02540000 * 4 RETCODE PTR(8), /* RETURN CODE AREA * 02550000 * /* F41448 * 02560000 * 2 DUMMY2 BDY(DWORD), /* TO PUT SUBRWORK ON DWRD BDY* 02570000 * /* F41448 * 02580000 * 3 SUBRWORK(2) PTR(31), /* SCRATCH/SAVE AREA * 02590000 * /* F41448 * 02600000 * 2 XPDL PTR(31), /* ADDRESS OF PDL * 02610000 * /* F41448 * 02620000 * 2 TEMPSAVE PTR(31), /*USED TO TEMPORARILY SAVE R1 * 02630000 * /* F41448 * 02640000 * /*BEFORE LINKING TO TRANSLATE * 02650000 * /* ROUTINE F41448 * 02660000 * 02670000 * /* PREMANENT WORKSPACE FLAGS F41448 * 02680000 * 02690000 * 2 PFLAGS BIT(8), /* FIRST FLAG BYTE F41448 * 02700000 * /* F41448 * 02710000 * 3 PFLIST BIT(1), /* CURRENTLY PROCESSING LIST */ 02720000 * /* F41448 * 02730000 * 3 PFDEFLT BIT(1), /* INDICATES A DEFAULT TAKEN * 02740000 * /* F41448 * 02750000 * 3 PFENDF BIT(1), /* END OF INPUT AREA HAS BEEN * 02760000 * /* REACHED F41448 * 02770000 * /* F41448 * 02780000 * 3 ADREXP BIT(1), /* INDICATE ADDRESS EXPRESSION* 02790000 * /* F41448 * 02800000 * 3 HEXBIT BIT(1), /* ADDRESS EXPRESSION CONTAINS* 02810000 * /* A HEX CHARACTER F41448 * 02820000 * /* F41448 * 02830000 * 3 PFBYPAS BIT(1), /* BYPASS MODE IS TO BE ESTAB*/ 02840000 * /* F41448 * 02850000 * 3 PFNEW BIT(1), /* USED BY ADDRESS ROUTINE TO * 02860000 * /* F41448 * 02870000 * /* DENOTE A NEW VALID ADDRESS * 02880000 * /* F41448 * 02890000 * /* ENTRYNAME (WITH OR WITHOUT * 02900000 * /* F41448 * 02910000 * /* LOADNAME QUALIFICATION * 02920000 * /* F41448 * 02930000 * 3 DECBIT BIT(1), /* ADDR EXPRESSION IS DECIMAL * 02940000 * /* F41448 * 02950000 * 2 PFLAGS2 BIT(8), /* SECOND FLAG BYTE * 02960000 * /* F41448 * 02970000 * 3 PFSKPINV BIT(1), /* VALIDITY CHECK ROUTINE * 02980000 * /* F41448 * 02990000 * /* REQUESTED A REENTER MESSAGE* 03000000 * /* ONLY F41448 * 03010000 * /* F41448 * 03020000 * 3 RNGEVAL1 BIT(1), /* ADDRESS ROUTINE PROCESSED * 03030000 * /* FIRST VAL OF RANGE F41448 * 03040000 * /* PARAMETER F41448 * 03050000 * /* F41448 * 03060000 * 3 ONERBIT BIT(1), /* CONTROL BIT USED DURING * 03070000 * /* F41448 * 03080000 * /* SCAN BY ADDRESS ROUTINE * 03090000 * /* F41448 * 03100000 * 3 TWORBIT BIT(1), /* CONTROL BIT USED DURING * 03110000 * /* F41448 * 03120000 * /* SCAN BY ADDRESS ROUTINE * 03130000 * /* F41448 * 03140000 * 3 RNGEVAL2 BIT(1), /* ADDRESS ROUTINE PROCESSED * 03150000 * /* F41448 * 03160000 * /* SECOND VALUE OF RANGE * 03170000 * /* PARAMETER F41448 * 03180000 * /* F41448 * 03190000 * 3 REGBIT BIT(1), /* CONTROL BIT USED DURING * 03200000 * /* F41448 * 03210000 * /* SCAN BY ADDRESS ROUTINE * 03220000 * /* F41448 * 03230000 * 3 FLTERBIT BIT(1), /* CONTROL BIT USED DURING * 03240000 * /* F41448 * 03250000 * /* SCAN BY ADDRESS ROUTINE * 03260000 * /* F41448 * 03270000 * 3 BREAKBIT BIT(1), /* USED BY ADDRESS ROUTINE TO * 03280000 * /* F41448 * 03290000 * 2 PFLAGS3 BIT(8), /* THIRD FLAG BYTE * 03300000 * 3 PFSTPRMT BIT(1), /* PROMPT FOR STRING F41448 * 03310000 * /* F41448 * 03320000 * 3 PFONE BIT(1), /* INDICATES AT LEAST ONE PDE * 03330000 * /* HAS BEEN BUILT F41448 * 03340000 * /* F41448 * 03350000 * 3 LOADBIT BIT(1), /* CONTROL BIT USED BY ADDRESS* 03360000 * /* F41448 * 03370000 * /* RTN DENOTING LOADNAME DATA * 03380000 * /* F41448 * 03390000 * 3 ENTRYBIT BIT(1), /* CONTROL BIT USED BY ADDRESS* 03400000 * /* F41448 * 03410000 * /* RTN DENOTING ENTRYNAME DATA* 03420000 * /* F41448 * 03430000 * 3 PFNULL BIT(1), /* INDICATES A NULL LINE WAS * 03440000 * /* F41448 * 03450000 * /* ENTERED AFTER A PROMPT * 03460000 * /* F41448 * 03470000 * 3 LPRNFND BIT(1), /* USED TO INDICATE A LEFT * 03480000 * /* F41448 * 03490000 * /* PAREN WAS FND BY THE ERROR * 03500000 * /* ROUTINE F41448 * 03510000 * /* F41448 * 03520000 * 3 PFSPACE BIT(1), /* USED TO INDICATE A F41448 * 03530000 * /* F41448 * 03540000 * /* POSITIONAL SPACE PARAMETER * 03550000 * /* F41448 * 03560000 * /* WAS ENCOUNTERED SO THAT THE* 03570000 * /* F41448 * 03580000 * /* SO THAT THE POSITIONAL * 03590000 * /* F41448 * 03600000 * /* STRING RTN KNOWS WHEN TO * 03610000 * /* END THE STRING F41448 * 03620000 * /* F41448 * 03630000 * 3 PFMORE BIT(1), /* USED TO INDICATE IF THE * 03640000 * /* F41448 * 03650000 * /* LEFT PAREN OF A SUBFIELD * 03660000 * /* F41448 * 03670000 * /* WAS ALSO USED AS THE LEFT * 03680000 * /* F41448 * 03690000 * /* PAREN OF THE LIST WITHIN * 03700000 * /* THE SUBFIELD F41448 * 03710000 * /* F41448 * 03720000 * 2 PFLAGS4 BIT(8), /* FOURTH FLAG BYTE * 03730000 * /* F41448 * 03740000 * 3 PFENDLIM BIT(1), /* INDICATES END DILIMETER FOR* 03750000 * /* F41448 * 03760000 * /* SELF-DILIMITING STRING HAS * 03770000 * /* BEEN FOUND F41448 * 03780000 * 3 PFLSTEND BIT(1), /* INDICATES LIST END F41448 * 03790000 * /* F41448 * 03800000 * /* DILIMETER HAS BEEN FOUND * 03810000 * /* F41448 * 03820000 * 3 PFVCMSG BIT(1), /* INDICATES A VALIDITY CHECK * 03830000 * /* F41448 * 03840000 * /* ROUTINE HAS SUPPLIED A * 03850000 * /* SECOND LEVEL MESSAG F41448 * 03860000 * /* F41448 * 03870000 * 3 PFPDDATA BIT(1), /* INDICATE PROCESSING PROMPT * 03880000 * /* OR DEFAULT DATA F41448 * 03890000 * /* F41448 * 03900000 * 3 PFSLASH BIT(1), /* INDICATE DSNAME/USERID RTN * 03910000 * /* F41448 * 03920000 * /* IS SCANNING FOR PASSWORD * 03930000 * /* F41448 * 03940000 * 3 PFENDSET BIT(1), /* INDICATES BACKUP POINTER * 03950000 * /* F41448 * 03960000 * /* FOR ENDINPUT HAS BEEN SET * 03970000 * /* F41448 * 03980000 * 3 PFNOPOP BIT(1), /* INDICATES STACK IS NOT TO * 03990000 * /* F41448 * 04000000 * /* BE POPPED IF ALL SEPARATORS* 04010000 * /* IN PROMPT BUFFER F41448 * 04020000 * /* F41448 * 04030000 * 3 CKRANGE BIT(1), /* ADDR RTN SHOULD CHECK FOR * 04040000 * /* RANGE F41448 * 04050000 * /* F41448 * 04060000 * 2 PFLAGS5 BIT(8), /* FIFTH FLAG BYTE * 04070000 * /* F41448 * 04080000 * 3 PFSQSTR BIT(1), /* SPECIAL QSTRING HANDLING * 04090000 * /* DONE AT LEAST ONCE F41448 * 04100000 * /* F41448 * 04110000 * 3 INVPRMPT BIT(1), /* CHECK FOR INVALID MSG PRMT * 04120000 * /* F41448 * 04130000 * 3 SUBFLG BIT(1), /*CHECK FOR SUBFIELD PROCESSING* 04140000 * /* F41448 * 04150000 * 3 INVFLG BIT(1), /* CHECK FOR INVALID INPUT FOR 04160000 * USER IN NOPROMPT MODE * 04170000 * /* F41448 * 04180000 * 3 BYPASFLG BIT(1), /*PREVIOUS PCE SPECIFIED BYPAS 04190000 * OR PRINT INHIBIT MODE * 04200000 * /* F41448 * 04210000 * 3 RD4 BIT(1), /* RESERVED * 04220000 * /* F41448 * 04230000 * 3 RD5 BIT(1), /* RESERVED * 04240000 * /* F41448 * 04250000 * 3 RD6 BIT(1), /* RESERVED * 04260000 * 04270000 * 2 PFLAGS6 BIT(8), /* SIXTH FLAG BYTE Y01156* 04280000 * 2 PFLAGS7 BIT(8), /* SEVENTH FLAG BYTE Y02666* 04290000 * 2 PFLAGS8 BIT(8), /* EIGHTH FLAG BYTE Y02666* 04300000 * /* F41448 * 04310000 * /* WORKSPACE NEEDED FOR STORAGE ALLOCATION SUBROUTINE * 04320000 * /* F41448 * 04330000 * 2 STORANC CHAR(8), 04340000 * 4 PANCHOR PTR(31), /* ANCHOR FOR STORAGE CHAIN * 04350000 * /* F41448 * 04360000 * 04370000 * /* F41448 * 04380000 * 4 PANCHORT PTR(31), /* INTERNAL MSS CHAIN FREE * 04390000 * /* F41448 * 04400000 * /* Q ANCHOR * 04410000 * 04420000 * /* F41448 * 04430000 * /* PARAMETER LIST FOR CONDITIONAL GETMAIN SUBROUTINE * 04440000 * 04450000 * /* F41448 * 04460000 * 2 PGETLIST, 04470000 * /* F41448 * 04480000 * 5 PGETLNTH FIXED(31), /* LENGTH REQUESTED * 04490000 * /* F41448 * 04500000 * 5 PGETRADR PTR(31), /* ADDR IN WHICH ALLOCATED * 04510000 * /* F41448 * 04520000 * /* SPACE ADDR IS PLACED * 04530000 * /* F41448 * 04540000 * 5 PGETMDSP FIXED(15), /* MODE AND SUBPOOL * 04550000 * 04560000 * /* THE FIRST INPUT PUSHDOWN STACK. IF THIS STACK FILLS UP A F41448 * 04570000 * /* GETMAIN IS ISSUED FOR AN ADDITIONAL STACK. THIS PROCESS F41448 * 04580000 * /* CONTINUES INDEFINITELY. THE STACKS ARE BACKWARD CHAINED F41448 * 04590000 * /* WITH THE FIRST STACKS CHAIN WORD REMAINING ZERO.EACH NEW F41448 * 04600000 * /* ENTRY IN THE STACK CONSISTS OF TWO WORDS. THE FIRST IS F41448 * 04610000 * /* THE CONTENTS OF XINPUT,AND THE SECOND IS THE CONTENTS OF F41448 * 04620000 * /* ENDINPUT. THE NEXT FREE AREA IN THE STACK IS FOUND BY F41448 * 04630000 * /* USING PIPDLX AS AN INDEX INTO THE STACK. F41448 * 04640000 * 04650000 * /* F41448 * 04660000 * 2 PIPDLCUR PTR(31), /* ADDRESS OF CURRENT INPUT * 04670000 * /* PUSHDOWN STACK F41448 * 04680000 * /* F41448 * 04690000 * 2 PIPDLCHN PTR(31), /* STORAGE CHAIN - SHOULD * 04700000 * 2 NME(20) PTR(31), /*FIRST INPUT PUSHDOWN F41448 * 04710000 * /* STACK F41448 * 04720000 * /* F41448 * 04730000 * 2 PIPDLX PTR(8), /*INDEX TO NEXT FREE AREA IN * 04740000 * /* F41448 * 04750000 * /*CURRENT PUSHDOWN STACK * 04760000 * /* F41448 * 04770000 * 2 PLINKSV1 PTR(31), /*SAVE AREA FOR RETURN ADDRESS* 04780000 * /* F41448 * 04790000 * /*OF LINK1 ROUTINES WHICH USE * 04800000 * /* F41448 * 04810000 * /*LINK2 ROUTINES AS SUBRTNS * 04820000 * /* F41448 * 04830000 * 2 INVPSAVE PTR(31), /*BEGINNING ADDR OF PARM -USED* 04840000 * /*IF PARM IS INVALID F41448 * 04850000 * /* ADDRESSES FOR KEYWORD SCANS F41448 * 04860000 * /* F41448 * 04870000 * 2 PKEYWDPS PTR(31), /*PTR TO CURRENT NAME ENTRY * 04880000 * /* F41448 * 04890000 * 2 PKEYWDPC PTR(31), /*PTR TO CURRENT IKJKEYWD PCE * 04900000 * /* F41448 * 04910000 * 2 PKEYWDPX PTR(31), /*TO SAVE IKJKEYWD PCE ADDR * 04920000 * /* F41448 * 04930000 * 2 PKEYWDTB PTR(31), /*PCL RESULT DURING KEYWORD * 04940000 * /*PROCESSING F41448 * 04950000 * /* F41448 * 04960000 * 2 PKEYWDPM PTR(31), /*SAVE AREA FOR PDE DURING * 04970000 * /*KEYWORD PROCESSING F41448 * 04980000 * 2 PTABLEAD PTR(31), /*START OF PCL ADDRESS F41448 * 04990000 * 2 PTABLEND PTR(31), /*END OF PCL ADDRESS F41448 * 05000000 * /* F41448 * 05010000 * /* THE FOLLOWING FIELDS ARE USED AS TEMPORARY POSITIONAL PDE.F41448 * 05020000 * /* THE FIELDS ARE MOVED FROM HERE TO THE ACTUAL PDE BY THE F41448 * 05030000 * /* POSITIONAL EXIT ROUTINE. THE AREAS MUST BE CONTIGUOUS F41448 * 05040000 * /* F41448 * 05050000 * 2 TEMPPDE, /* NAME OF TEMPORARY AREA * 05060000 * 4 TEMPPDE2, /*LEN FOR NORMAL PARSE F41448 * 05070000 * /* F41448 * 05080000 * 7 TEMPFLD1, 05090000 * 9 DATAPTR1 PTR(31), /*PTR TO STRING, PSTRING * 05100000 * /* F41448 * 05110000 * /*QSTRING,PASSWORD,DSNAME * 05120000 * /*LOADNAME, OR VALUE F41448 * 05130000 * 9 DATALEN1 FIXED(15), /*LENGTH OF ABOVE DATA F41448 * 05140000 * 9 DATAFLA1 BIT(8), /*FLAG BYTE F41448 * 05150000 * 9 DATAFLB1 BIT(8), /*TYPE CODE FOR VALUE F41448 * 05160000 * /* F41448 * 05170000 * 7 TEMPFLD2, 05180000 * 9 DATAPTR2 PTR(31), /*PTR TO MEMBER OR ENTRY NAME * 05190000 * 9 DATALEN2 FIXED(15), /*LENGTH OF ABOVE DATA F41448 * 05200000 * 9 DATAFLA2 BIT(8), /*FLAG BYTE F41448 * 05210000 * 9 DATAFLB2 BIT(8), /*RESERVED BYTE F41448 * 05220000 * /* F41448 * 05230000 * 7 TEMPFLD3, 05240000 * 9 DATAPTR3 PTR(31), /*PTR TO PASSWORD OR ADDRESS * 05250000 * 9 DATALEN3 FIXED(15), /*LENGTH OF ABOVE DATA F41448 * 05260000 * 9 DATAFLA3 BIT(8), /*FLAG BYTE F41448 * 05270000 * 9 DATAFLB3 BIT(8), /*RESERVED BYTE F41448 * 05280000 * /* F41448 * 05290000 * 9 DATAFLG BIT(8), /*REGISTER NOTATION FLAGS * 05300000 * 9 DATASGN BIT(8), /*SIGN OF FIRST VALUE F41448 * 05310000 * /* F41448 * 05320000 * 9 DATAICT FIXED(15), /*INDIRECT ADDRESSING COUNT * 05330000 * /* F41448 * 05340000 * 9 DATAEXP PTR(31), /*PTR TO NEXT EXPRESSION * 05350000 * /* VALUE PDE F41448 * 05360000 * 9 DATAUSER FIXED(31), /*USER WORD F41448 * 05370000 * /* F41448 * 05380000 * 4 CBADD(11) PTR(31), /*COBOL ADDITIONS TO PARSE * 05390000 * /*TEMPORARY PDE F41448 * 05400000 * /* F41448 * 05410000 * 2 ENDBAKUP PTR(31), /*BACKUP FOR ENDINPUT IF * 05420000 * /* PFSCANX FLAG IS ON F41448 * 05430000 * /* F41448 * 05440000 * 2 PDELIM CHAR(1), /*SELF-DEFINED DELIMETER * 05450000 * /* F41448 * 05460000 * /*STORED BY DELIMETER ROUTINE * 05470000 * 2 PPCOUNT PTR(8), /*POSITIONAL DATA SIZE F41448 * 05480000 * 2 PPDESIZE PTR(8), /*POSIITONAL PDE SIZE F41448 * 05490000 * /* F41448 * 05500000 * 2 PERRCODE PTR(8), /*INDEX TO RESCAN ADDR TABLE * 05510000 * 2 PKEYWDVL FIXED(15), /*TO SAVE VALUE DURING F41448 * 05520000 * /* KEYWORD LOOKUP F41448 * 05530000 * /* F41448 * 05540000 * 2 RNG2ADDR PTR(31), /*ADDR OF 2ND PDE FOR A RANGE * 05550000 * /* F41448 * 05560000 * 2 SEGLIST(5) PTR(31), /*LIST OF MESSAGE SEGMENTS * 05570000 * /* F41448 * 05580000 * /* FOR I/O SERVICE ROUTINES * 05590000 * /* F41448 * 05600000 * 2 PREVPDEL PTR(31), /*USED TO CONTAIN THE PREV- * 05610000 * /* F41448 * 05620000 * /*IOUS PDE ADDRESS SO THAT * 05630000 * /* F41448 * 05640000 * /*THE VALIDITY CHECK ROUTINE * 05650000 * /* F41448 * 05660000 * /*CAN FETCH IT WHEN A RETURN * 05670000 * /* F41448 * 05680000 * /*CODE OF 4 OR 8 IS RETURNED * 05690000 * /*TO IT BY THE USER F41448 * 05700000 * /* F41448 * 05710000 * 2 VCEPARAM, /*VALIDITY CHECK EXIT PARAM- * 05720000 * /* ETERS F41448 * 05730000 * 11 PDEADR PTR(31), /*ADDRESS OF PDE JUST F41448 * 05740000 * /* CONSTRUCTED F41448 * 05750000 * /* F41448 * 05760000 * 11 USERWORD FIXED(31), /*USER DATA PASSED IN PARSE * 05770000 * /* F41448 * 05780000 * /* INPUT PARAMETER LIST * 05790000 * /* F41448 * 05800000 * 11 VALMSG PTR(31), /*ADDRESS OF SECOND LEVEL MSG * 05810000 * /* FROM VALIDITY CHECK F41448 * 05820000 * 11 MSGCODE PTR(8), /*OFFSET TO MSG ADDRES F41448 * 05830000 * /* MESSAGE SEGMENT CONTAINING THE LAST PRIMARY MESSAGE ID. F41448 * 05840000 * /* THIS IS USED AS SEGMENT 1 OF HELP MESSAGES PASSED TO THE F41448 * 05850000 * /* I/O SERVICE ROUTINES. IT INCLUDES THE FOUR BYTE HEADER F41448 * 05860000 * /* REQUIRED BY THE I/O ROUTINES, AND THE WORD 'ENTER'. F41448 * 05870000 * /* F41448 * 05880000 * 2 PRIMSGID CHAR(20), /* PRIMARY MESSAGE SEGMENT * 05890000 * /* F41448 * 05900000 * 2 SAVLSLEN FIXED(15), /* USED TO SAVE THE CORE SIZE * 05910000 * /* F41448 * 05920000 * /* REQUESTED BY THE HELP * 05930000 * /* MESSAGE ROUTINE. F41448 * 05940000 * /* F41448 * 05950000 * 2 PLUSSEG CHAR(5), /* PLUS SIGN MESSAGE SEGMENT * 05960000 * /* F41448 * 05970000 * /* F41448 * 05980000 * /* SAVE AREAS FOR ADDRESSES OF I/O SERVICE ROUTINES 'LOADED' DURING* 05990000 * /* INITIALIZATION F41448 * 06000000 * /* F41448 * 06010000 * /* * 06020000 * 2 PUTLPTR PTR(31), /* NAME THE LIST * 06030000 * 2 PUTGPTR PTR(31), /* PTR TO IKJPTGT RTN F41448 * 06040000 * /* F41448 * 06050000 * 2 UPTADDR PTR(31), /* FIRST WORD OF INPUT PARMS * 06060000 * /* F41448 * 06070000 * 2 ECTADDR PTR(31), /* SECOND WORD OF INPUT PARMS * 06080000 * /* F41448 * 06090000 * 2 ECBADDR PTR(31), /* THIRD WORD OF INPUT PARMS * 06100000 * /* F41448 * 06110000 * 2 * PTR(31), /* FOURTH WORD OF INPUT PARMS * 06120000 * 06130000 * /* F41448 * 06140000 * 2 OPEREND PTR(31), /* PTR TO LAST PCE UNDER OPER * 06150000 * 06160000 * /* F41448 * 06170000 * 2 RSVWDPCE PTR(31), /* PTR TO PCE BEING USED BY * 06180000 * /* IKJRSVWD F41448 * 06190000 * 06200000 * /* F41448 * 06210000 * 2 TERMXPCE PTR(31), /* PTR TO MAJOR TERM * 06220000 * 06230000 * /* F41448 * 06240000 * 2 OPERPCE PTR(31), /* PTR TO CURRENT OPER PCE * 06250000 * 06260000 * /* F41448 * 06270000 * 2 OPERSVE PTR(31), /* PTR TO LEFT PAREN OF EXPR.* 06280000 * 06290000 * 2 RSVWDSV1 PTR(31), /* LINK REG. SAV AREA F41448 * 06300000 * 06310000 * 2 RSVWDSV2 PTR(31), /* LINK REG. SAVE AREA F41448 * 06320000 * 06330000 * 2 CBLNKSV1 PTR(31), /* LINK REG. SAVE AREA F41448 * 06340000 * 06350000 * 2 CBLNKSV2 PTR(31), /* LINK REG. SAVE AREA F41448 * 06360000 * 06370000 * /* F41448 * 06380000 * 2 ENDNMPTR PTR(31), /* PTR TO END OF CURRENT * 06390000 * /* F41448 * 06400000 * /* DATANAME BEING SCANNED * 06410000 * 06420000 * /* F41448 * 06430000 * 2 CHAINPTR PTR(31), /*PTR TO CHAIN WD FOR DATANAME* 06440000 * /* QUALIFIER PDE'S F41448 * 06450000 * 06460000 * /* F41448 * 06470000 * 2 PDEPTR PTR(31), /* PTR TO NEXT AVAIL. SPACE IN* 06480000 * /* THE TEMPPDE F41448 * 06490000 * 06500000 * /* F41448 * 06510000 * 2 AANC PTR(31), /* ANCHORS TO CONTROL THE * 06520000 * /* F41448 * 06530000 * 2 TANC PTR(31), /* ALLOCATION OF DATANAME * 06540000 * /* F41448 * 06550000 * 2 OANC PTR(31), /* QUALIFIER PDE'S - IN CORE * 06560000 * /* F41448 * 06570000 * 2 ENDANC PTR(31), /* GOTTEN VIA STALOC ROUTINE * 06580000 * 06590000 * /* F41448 * 06600000 * 2 PRMTPTR PTR(31), /* PTR TO START OF INVALID * 06610000 * /* F41448 * 06620000 * /* DATA FOR SPECIAL MSG. * 06630000 * 06640000 * /* F41448 * 06650000 * 2 OPERLL FIXED(15), /*LEN OF PDE FLDS UNDER OPER * 06660000 * 06670000 * /* F41448 * 06680000 * 2 MSGAREA BDY(BYTE), /* PARMS PASSED TO PROMPT FOR * 06690000 * /* F41448 * 06700000 * /* SPECIAL MSG. CONSTRUCTION * 06710000 * /* F41448 * 06720000 * 7 MSGLEN FIXED(15), /* LENGTH OF FIRST SEGMENT * 06730000 * /* F41448 * 06740000 * 7 MSGADDR PTR(31), /* ADDR OF FIRST SEGMENT * 06750000 * 06760000 * /* F41448 * 06770000 * 2 DIGITCT PTR(8), /* DIGIT COUNTER FOR STRINGS * 06780000 * 06790000 * /* F41448 * 06800000 * 2 ELEMNCT PTR(8), /* NUMBER OF SUBSCRIPTS * 06810000 * 06820000 * /* F41448 * 06830000 * 2 QUALCT PTR(8), /* NUMBER OF QUALIFIERS * 06840000 * 06850000 * 2 CBFLAGS1 BIT(8), /* FIRST FLAG BYT F41448 * 06860000 * /* F41448 * 06870000 * 7 COBOLMOD BIT(1), /* COBOL PROCESSING SWITCH * 06880000 * /* F41448 * 06890000 * 7 OPERMODE BIT(1), /* EXPRESSION PROCESSING SW * 06900000 * /* F41448 * 06910000 * 7 SUBSMODE BIT(1), /* TERM - SUBSCRIPT MODE SW * 06920000 * /* F41448 * 06930000 * 7 NAMEREQD BIT(1), /* TERM - DATANAME EXPECTED * 06940000 * /* F41448 * 06950000 * 7 ERRORBIT BIT(1), /* TERM - ERROR HAS OCCURED * 06960000 * /* F41448 * 06970000 * 7 RSVDPRMT BIT(1), /* RSVWD HAS BEEN PRMPTED FOR * 06980000 * 7 OPERPRMT BIT(1), /* EXPRESSION HAS BEEN F41448 * 06990000 * /* F41448 * 07000000 * /* PROMPTED FOR BY OPER * 07010000 * /* F41448 * 07020000 * 7 RC16 BIT(1), /* A 16 RETURN CODE HAS BEEN * 07030000 * /* F41448 * 07040000 * /* ENCOUNTERED FROM VALIDITY * 07050000 * /* CHECK ROUTINE F41448 * 07060000 * 07070000 * 2 CBFLAGS2 BIT(8), /* SECOND FLAG BYTE F41448 * 07080000 * /* F41448 * 07090000 * 7 SPECMSG BIT(1), /* SPECIAL MSG. FORMAT IS TO * 07100000 * /* F41448 * 07110000 * /* BE USED IN PROMPTING * 07120000 * /* F41448 * 07130000 * 7 LFTPAREN BIT(1), /* A LEFT PAREN IS TO BE * 07140000 * /* F41448 * 07150000 * /* ADDED TO SPECIAL MSG * 07160000 * /* F41448 * 07170000 * 7 RHTPAREN BIT(1), /* A RIGHT PAREN IS TO BE * 07180000 * /* F41448 * 07190000 * /* ADDED TO SPECIAL MSG. TEXT * 07200000 * /* F41448 * 07210000 * 7 CHAINTRM BIT(1), /* A TERM CHAINED FROM AN * 07220000 * /* F41448 * 07230000 * /* OPER IS BEING PROCESSED * 07240000 * /* F41448 * 07250000 * 7 PARS2IN BIT(1), /* PARS2 HAS BEEN LOADED * 07260000 * /* F41448 * 07270000 * 7 PRMTSCAN BIT(1), /* USED BY TERM FOR PRMT DATA * 07280000 * /* F41448 * 07290000 * 7 BUFPOPED BIT(1), /* RECURSION IN SCANF ROUTINE * 07300000 * /* F41448 * 07310000 * 7 RNGADDED BIT(1), /* 1ST VALUE OF RNG ADDED * 07320000 * 07330000 * 2 CBFLAGS3 BIT(8), /* FLAG BYTE THREE F41448 * 07340000 * /* F41448 * 07350000 * 7 FIRSTNAM BIT(1), /* 1ST DN. OF VAR ENCOUNTERED * 07360000 * /* F41448 * 07370000 * 7 CTFOUND BIT(1), /*BEGIN. OF CHNTRM SBSCRPT FND* 07380000 * /* F41448 * 07390000 * 7 BLNKFLAG BIT(1), /* OPER PTING AT BLNK FOR * 07400000 * /* INVALID MSG. FORMAT F41448 * 07410000 * 07420000 * /* F41448 * 07430000 * 2 CBFLAGS4 BIT(8), /* FLAG BYTE FOUR - RSVD * 07440000 * 07450000 * /* F41448 * 07460000 * 2 TRANAREA CHAR(2) BDY(HWORD),/* TRANSLATE AREA FOR TERM * 07470000 * 07480000 * 2 CORELEN FIXED(15), /* RESERVED F41448 * 07490000 * 07500000 * /* F41448 * 07510000 * 2 PARS2ADR PTR(31), /* ADDR OF IKJPARS2 LOAD MOD * 07520000 * 07530000 * /* F41448 * 07540000 * 2 VCONAD PTR(31), /*ADDR OF VCON TAB IN IKJPARS * 07550000 * 07560000 * /* F41448 * 07570000 * 2 GOREGSV PTR(31), /*RETURN ADDR FROM SUBROUTINE * 07580000 * 07590000 * /* F41448 * 07600000 * 2 TERMBASE PTR(31), /*TERM BASE REG SAVE AREA * 07610000 * 07620000 * /* F41448 * 07630000 * 2 OPERBASE PTR(31), /*OPER BASE REG SAVE AREA * 07640000 * 07650000 * /* F41448 * 07660000 * 2 BASE3SV PTR(31), /*SAVE AREA - PARSE BASE REG3 * 07670000 * 07680000 * /* F41448 * 07690000 * 2 BASE2SV PTR(31), /*SAVE AREA - PARSE BASE REG2 * 07700000 * 07710000 * /* F41448 * 07720000 * 2 BASE1SV PTR(31), /*SAVE AREA - PARSE BASE REG1 * 07730000 * 07740000 * /* F41448 * 07750000 * 2 RBASESV PTR(31), /*SAVE AREA - PARSE RBASE * 07760000 * 07770000 * /* F41448 * 07780000 * 2 CBLRET PTR(31), /* POINT TO RETURN TO IN THE * 07790000 * /* F41448 * 07800000 * /* NEW IKJPARS2 LOAD * 07810000 * /* F41448 * 07820000 * /* AFTER EXECUTION OF ANY * 07830000 * /* F41448 * 07840000 * /* SUBROUTINE IN IKJPARS * 07850000 * /* F41448 * 07860000 * 2 COREADDR PTR(31), /* ADDR OF CORE GOTTEN FOR MSG* 07870000 * 07880000 * /* F41448 * 07890000 * 2 AUTOBASE PTR(31), /*SAVE AREA FOR DATAREG (BSL) * 07900000 * 07910000 * /* F41448 * 07920000 * 2 WORKSAVE(4) PTR(31), /* WORKREG SAVE AREA -LINKAGE * 07930000 * 07940000 * /* F41448 * 07950000 * 2 PLINKSV2 PTR(31), /* RETURN ADDR SAVE AREA FROM * 07960000 * /* F41448 * 07970000 * /* VALIDITY CHECK AND CODE4 * 07980000 * /* F41448 * 07990000 * 2 KEYPTR PTR(31), /* KEYWORD PTR Y01156* 08000000 * 2 KEYLEN FIXED(15), /* USER KEYWORD LENGTH Y01156* 08010000 * 2 KEYBUF CHAR(37) BDY(HWORD), /* 2ND SEGMENT FOR SUBFIELD- 08020000 * PROMPT Y01156* 08030000 * 6 KEYBUFLN FIXED(15), /* ENTIRE SEGMENT LENGTHY01156* 08040000 * 6 KEYBUFOF FIXED(15), /* OFFSET IN PRIMARY MSGY01156* 08050000 * 6 KEYDATA CHAR(33); /* USER ENTERED KEYWORD Y01156* 08060000 * /* ALLOCATE SPACE IN WHICH TO MOVE THE L FORM OF THE I/O F41448 * 08070000 * /* SERVICE ROUTINE MACROS. F41448 * 08080000 * /* F41448 * 08090000 * GENERATE DATA; 08100000 * /* END OF IKJEFPWA F41448 * 08110000 * DCL 08120000 * R12 REG(12); /* WORK REG - REGISTER 12 * 08130000 * DCL 08140000 * R13 REG(13); /* WORK REG - REGISTER 13 * 08150000 * DCL 08160000 * GOREG REG(14); /* USED AS RETURN REGISTER WHEN 08170000 * GO TO PARSE SUB- ROUTINES * 08180000 * DCL 08190000 * R14 REG(14); /* USED AS RETURN REGISTER * 08200000 * DCL 08210000 * R15 REG(15); /* SUBROUTINE ADDRESS LOADED HERE 08220000 * BY PARS2 - RETURN CODE HERE 08230000 * FROM IKJPARS * 08240000 * DCL 08250000 * INDEX1 PTR(31); /* USED AS INDEX PTR INTO SPECIAL 08260000 * MESSAGE AREA * 08270000 * 08280000 * /***************************************************************** 08290000 * /* * 08300000 * /* LABEL FOR REFERENCING PCE TYPE TO DETERMINE WHETHER OPER, TERM* 08310000 * /* OR RESERVED WORD PCE * 08320000 * /* * 08330000 * /***************************************************************** 08340000 * 08350000 * DCL 08360000 * 1 MASK BASED(XPCE), /* LABEL FOR REFERENCING PCE TYPE 08370000 * MASK IN FIRST BYTE OF * 08380000 * 2 PCETYPE BIT(3), /* PCE * 08390000 * 2 * BIT(5); 08400000 * 08410000 * /***************************************************************** 08420000 * /* * 08430000 * /* IKJOPER PCE MAPPING * 08440000 * /* * 08450000 * /***************************************************************** 08460000 * 08470000 * DCL 08480000 * 1 OPCEFLD1 BASED(OPERPCE) BDY(BYTE), /* MAP FIRST FIXED 08490000 * OPER FIELD * 08500000 * 2 OPCEBYT1 BIT (16), /* FIRST BYTE OF INDICATORS * 08510000 * 3 OPERMASK BIT(3), /* INDICATES PCE TYPE * 08520000 * 3 OPRMTI BIT(1), /* PROMPT DATA SUPPLIED * 08530000 * 3 ODLFTI BIT(1), /* DEFAULT DATA SUPPLIED * 08540000 * 3 * BIT(11), /* NOT REFERENCED * 08550000 * 2 OPCELNTH FIXED(15), /* OPER PCE LENGTH * 08560000 * 2 OPDEINDX FIXED(15), /* OFFSET TO OPER PDE FROM START 08570000 * OF PDL * 08580000 * 2 OPCEPTL FIXED(15), /* PARAMETER TYPE FIELD LENGTH * 08590000 * 2 * FIXED(15); /* NOT REFERENCED * 08600000 * 08610000 * /***************************************************************** 08620000 * /* * 08630000 * /* MAP SECOND FIXED FIELD IN THE IKJOPER PCE * 08640000 * /* * 08650000 * /***************************************************************** 08660000 * 08670000 * DCL 08680000 * 1 OPCEFLD2 BASED(OPCEPTR) BDY(BYTE), /* MAP SECOND FIXED 08690000 * OPER FIELD * 08700000 * 2 RPCEINDX FIXED(15), /* OFFSET TO RSVWD PCE FROM START 08710000 * OF PDL * 08720000 * 2 T1PCEIDX FIXED(15), /* OFFSET TO MINOR TERM1 PCE * 08730000 * 2 T2PCEIDX FIXED(15), /* OFFSET TO MINOR TERM2 PCE * 08740000 * 2 T3PCEIDX FIXED(15), /* OFFSET TO MINOR TERM3 PCE * 08750000 * 2 * FIXED(15); /* NOT REFERENCED * 08760000 * 08770000 * /***************************************************************** 08780000 * /* * 08790000 * /* NAME REFERENCING PDE SPACE UNDER THE OPER PDE * 08800000 * /* * 08810000 * /***************************************************************** 08820000 * 08830000 * DCL 08840000 * OPDE CHAR(256) BASED(INDEX); 08850000 * DCL 08860000 * ADDR1 FIXED(15); /* INDEX INTO LINE SCANNING * 08870000 * DCL 08880000 * LINKRET INTERNAL ENTRY LOCAL; /* SUBROUTINE TO PROVIDE 08890000 * LINKAGE WITH IKJPARS * 08900000 * DCL 08910000 * MSGSETUP INTERNAL ENTRY LOCAL; /* SUBROUTINE TO BUILD THE 08920000 * SPECIAL MESSAGE REQUIRED BY 08930000 * IKJPARS2 * 08940000 * DCL 08950000 * VCONTAB(19) PTR(31) BASED(VCONAD); /* VCON TABLE FOR 08960000 * RESOLVING * 08970000 * DCL 08980000 * DTANME (*) CHAR(1) BASED(MSGADDR); /* FIRST DATA NAME WHICH 08990000 * IS INVALID - PINTED TO BY MSG 09000000 * ADDR FIELD SET BY MACRO 09010000 * PROCESSORS * 09020000 * DCL 09030000 * INVDATA (*) CHAR(1) BASED(INVPSAVE); /* DATA FOUND TO BE 09040000 * INVALID MUST BE MOVED INTO THE 09050000 * 'INVALID...' MESSAGE * 09060000 * 09070000 * /***************************************************************** 09080000 * /* * 09090000 * /* POINTER TO NEXT LIST PDE FOR ELIMINATING LAST PDE FROM CHAIN * 09100000 * /* * 09110000 * /***************************************************************** 09120000 * 09130000 * DCL 09140000 * LISTPTR PTR(31) BASED(PREVPDEL); 09150000 * 09160000 * /***************************************************************** 09170000 * /* * 09180000 * /* NAME FOR REFERENCING THE COBOL TEMPORARY PDE AREA WHEN MUST * 09190000 * /* ERASE * 09200000 * /* * 09210000 * /***************************************************************** 09220000 * 09230000 * DCL 09240000 * CBLTEMP CHAR(LENGTH(TEMPPDE)) BASED(ADDR(TEMPPDE)); 09250000 * DCL 09260000 * MSGAREA1 (*) CHAR(1) BASED(COREADDR); /* CORE GOTTEN TO 09270000 * BUILD SPECIAL MESSAGE * 09280000 * DCL 09290000 * MSGA (*) CHAR(1) BASED(INDEX1); /* ALSO USED AS MESSAGE 09300000 * AREA * 09310000 * DCL 09320000 * TERM LABEL GENERATED; /* LABEL FOR TERM PCE * 09330000 * DCL 09340000 * OPERLD LABEL GENERATED; /* LABEL FOR OPER PCE * 09350000 * DCL 09360000 * RSVD LABEL GENERATED; /* LABEL FOR RSVD WORD PCE * 09370000 * DCL 09380000 * RTRNAD LABEL GENERATED; /* ENTRY RETURN FROM IKJPARS * 09390000 * 09400000 * /***************************************************************** 09410000 * /* * 09420000 * /* GENERATE ENTRY CODE TO LOAD REQUIRED MACRO PROCESSOR ADDRESS * 09430000 * /* * 09440000 * /***************************************************************** 09450000 * 09460000 * RESPECIFY 09470000 * (XPCE, 09480000 * XINPUT, 09490000 * XINPUTB, 09500000 * PWAREG) RESTRICTED; 09510000 * TERMBASE = R2; /* SAVE IKJPARS2 BASE * 09520000 ST @2,620(0,@B) 0048 09530000 * OPERBASE = R3; /* REGISTERS * 09540000 ST @3,624(0,@B) 0049 09550000 * AUTOBASE = R12; /* SAVE BASE REGISTER TO AUTO- 09560000 * MATIC STORAGE * 09570000 ST @C,652(0,@B) 0050 09580000 * CBLRET = ADDR(RTRNAD); /* SAVE RETURN ADDRESS FROM 09590000 * IKJPARS IN THE WORK AREA * 09600000 LA @F,RTRNAD 0051 09610000 ST @F,644(0,@B) 0051 09620000 * IF PCETYPE = '110'B /* IF THIS IS A TERM PCE GO * 09630000 * THEN 09640000 TM 0(@6),B'11000000' 0052 09650000 BC 12,@9FF 0051 09660000 TM 0(@6),B'00100000' 0052 09670000 * GOTO TERM; /* TO LOAD IKJEFP60 ADDRESS * 09680000 BC 10,TERM 0053 09690000 * IF PCETYPE = '111'B /* IF THIS IS AN OPER PCE GO * 09700000 * THEN 09710000 @9FE EQU * 0054 09720000 @9FF TM 0(@6),B'11100000' 0054 09730000 * GOTO OPERLD; /* LOAD IKJEFP50 ADDRESS * 09740000 BC 01,OPERLD 0055 09750000 * IF PCETYPE = '101'B /* IF RESERVED WORD PCE GO * 09760000 * THEN 09770000 TM 0(@6),B'10100000' 0056 09780000 BC 12,@9FD 0055 09790000 TM 0(@6),B'01000000' 0056 09800000 * GOTO RSVD; /* LOAD IKJEFP40 ADDRES * 09810000 BC 10,RSVD 0057 09820000 * GOTO ERROR; /* IF NONE OF COBOL PCE'S IT IS 09830000 * AN ERROR * 09840000 BC 15,ERROR 0058 09850000 * 09860000 * /***************************************************************** 09870000 * /* * 09880000 * /* GENERATE CODE TO LOAD THE MACRO PROCESSOR ENTRY ADDRESS INTO * 09890000 * /* REGISTER 1 AND BRANCH TO THE REQUIRED ENTRY * 09900000 * /* * 09910000 * /***************************************************************** 09920000 * 09930000 * GENERATE; 09940000 RSVD L R1,RSVDENT RESERVED WORD MACRO PROCESSOR 09950000 BR R1 GO TO RESERVED WORD 09960000 TERM L R1,TERMENT LOAD TERM MACRO PROCESSOR 09970000 BR R1 ADDRESS AND BRANCH 09980000 OPERLD L R1,OPERENT LOAD OPER MACRO PROCESSOR 09990000 BR R1 ADDRESS AND BRANCH 10000000 TERMENT DC A(IKJEFP60) ENTRY - TERM MACRO PROCESSOR 10010000 RSVDENT DC A(IKJEFP40) ENTRY - RESERVED WORD MACRO 10020000 * PROCESSOR 10030000 OPERENT DC A(IKJEFP50) ENTRY - OPER MACRO PROCESSOR 10040000 EJECT 10050000 DS 0H 10060000 * 10070000 * /***************************************************************** 10080000 * /* * 10090000 * /* INTERNAL PROCEDURE - LINKRET THE MACRO PROCESSORS COME HERE TO* 10100000 * /* GO TO PARSE TO USE A SUBROUTINE OF IKJPARS - IKJEFP00 * 10110000 * /* * 10120000 * /***************************************************************** 10130000 * 10140000 * 10150000 * LINKRET: 10160000 * PROC OPTIONS(DONTSAVE,NOSAVEAREA); 10170000 @EL01 LR @1,@C 0060 10180000 L @0,@SIZ001 0060 10190000 FREEMAIN R,LV=(0),A=(1) 0060 10200000 BCR 15,@E 0060 10210000 LINKRET EQU * 0060 10220000 * 10230000 * /***************************************************************** 10240000 * /* * 10250000 * /* RESTRICT REQUIRED REGISTERS * 10260000 * /* * 10270000 * /***************************************************************** 10280000 * 10290000 * RESPECIFY 10300000 * (XPCE, 10310000 * XINPUT, 10320000 * XINPUTB, 10330000 * PWAREG, 10340000 * R7, 10350000 * R1) RESTRICTED; 10360000 * 10370000 * /***************************************************************** 10380000 * /* * 10390000 * /* GENERATE THE CODE TO HANDLE THE LINKAGE BETWEEN IKJPARS AND * 10400000 * /* IKJPARS2. THIS MUST BE DONE BECAUSE THE VALUES IN REGISTER 14 * 10410000 * /* AND REGISTER 15 MUST REMAIN UNCHANGED. * 10420000 * /* * 10430000 * /***************************************************************** 10440000 * 10450000 * GENERATE; /* SAVE WORK REGISTERS * 10460000 USING PWORK,PWAREG ESTABLIST PWORK ADDRESSABILITY 10470000 STM R7,R10,WORKSAVE SAVE WORK REGISTERS 10480000 DROP PWAREG FREE BASE REGISTER 10490000 DS 0H 10500000 * BUFPOPED='0'B; /* SET CONTRL FOR POPSTCK RTN * 10510000 NI 600(@B),B'11111101' 0063 10520000 * INVPRMPT='0'B; /* TURN OFF INVALID PROMPT IND- 10530000 * ICATOR FOR IKJPARS1 * 10540000 NI 180(@B),B'10111111' 0064 10550000 * R15 = VCONTAB(R15); /* LOAD THE REQUIRED IKJPARS 10560000 * ROUTINE ADDRESS FROM THE VCON 10570000 * TABLE - INDEX INTO THE TABLE 10580000 * IS IN R15 * 10590000 LR @8,@F 0065 10600000 BCTR @8,0 0065 10610000 SLA @8,2 0065 10620000 L @9,612(0,@B) 0065 10630000 L @F,0(@8,@9) 0065 10640000 * GOREGSV=GOREG; /* STORE RETURN ADDRESS IN WORK 10650000 * AREA * 10660000 ST @E,616(0,@B) 0066 10670000 * GOREG=VCONTAB (18); /* LOAD ENTRY PT INTO IKJPARS * 10680000 L @8,612(0,@B) 0067 10690000 L @E,68(0,@8) 0067 10700000 * RESPECIFY 10710000 * R1 UNRESTRICTED; /* RELEASE REGISTER 1 * 10720000 * GENERATE; 10730000 USING PWORK,PWAREG ADDRESSABILITY TO PWORK 10740000 LR R13,PWAREG RESTORE IKJPARS' WORK AREA 10750000 * BASE REGISTER 10760000 L R7,BASE3SV RESTORE BASE REGISTERS 10770000 LM R10,R12,BASE2SV RESTORE BASE REGS AND BASE 10780000 * REGISTER TO RECURSIVE WORK 10790000 * AREA 10800000 BR GOREG BRANCH TO IKJPARS ENTRY 10810000 RTRNAD L R14,GOREGSV LAOD RETURN ADDRESS TO PROPER 10820000 * ROUTINE IN IKJPARS2 10830000 AR R14,R15 ADD RETURN CODE TO RETURN ADDR 10840000 LM 7,10,WORKSAVE RESTORE WORK REGISTERS 10850000 BR R14 RETURN TO ROUTINE ADDRESS PLUS 10860000 * RETURN CODE 10870000 DROP PWAREG FREE BASE REG FOR WORKAREA 10880000 EJECT 10890000 DS 0H 10900000 * 10910000 * /***************************************************************** 10920000 * /* * 10930000 * /* TESTING * 10940000 * /* * 10950000 * /***************************************************************** 10960000 * 10970000 * 10980000 * EL: 10990000 * END LINKRET; /* END INTERFACE PROCEDURE * 11000000 EL EQU * 0070 11010000 @EL02 BCR 15,@E 0070 11020000 * 11030000 * /***************************************************************** 11040000 * /* * 11050000 * /* INTERNAL PROCEDURE - MSGSETUP THIS ROUTINE PREPARES THE * 11060000 * /* 'INVALID - PARAMETER TYPE - INVALID DATA' MESSAGE BEFORE GOING* 11070000 * /* TO IKJPARS TO WRITE IT TO THE TERMINAL. COBOL SUPPORT HAS A * 11080000 * /* SPECIAL MESSAGE FORMAT WHICH THIS ROUITNE HANDLES. CORE IS * 11090000 * /* GOTTEN FOR THE SPECIAL MESSAGE AND ALL THE INVALID DATA IS * 11100000 * /* MOVED INTO A CONTIGUOUS AREA SO THAT THE SPECIAL MESSAGE * 11110000 * /* APPEARS IDENTICAL TO ALL OTHER MESSAGES IKJPARS MUST HANDLE. * 11120000 * /* THE MESSAGE FORMAT IS THE FOLLOWING: 'INVALID PARMATER TYPE * 11130000 * /* DATA * 11140000 * /* ...DATA' THE ELLIPSES REPRESENT A NEW FUNCTION ADDED TO * 11150000 * /* THE INVALID MESSAGE. * 11160000 * /* * 11170000 * /***************************************************************** 11180000 * 11190000 * 11200000 * MSGSETUP: 11210000 * PROC OPTIONS(DONTSAVE,NOSAVEAREA); 11220000 MSGSETUP EQU * 0071 11230000 * 11240000 * /***************************************************************** 11250000 * /* * 11260000 * /* RESTRICT REQUIRED REGISTERS * 11270000 * /* * 11280000 * /***************************************************************** 11290000 * 11300000 * RESPECIFY 11310000 * (XPCE, 11320000 * XINPUT, 11330000 * XINPUTB, 11340000 * PWAREG, 11350000 * INDEX) RESTRICTED; 11360000 * PLINKSV2 = CBLNKSV2; /* RETURN ADDRESS IN CASE OF AN 11370000 * ERROR FROM VALIDITY CHECK MUST 11380000 * BE SAVED. IKJPARS WILL RESTORE 11390000 * ADDR. FROM PLINKSV2 IF AN 11400000 * ERROR IS RETURNED FROM THE 11410000 * V.C. EXIT * 11420000 MVC 672(4,@B),552(@B) 0073 11430000 * 11440000 * /***************************************************************** 11450000 * /* * 11460000 * /* CHECK TO SEE IF IT IS AN IKJTERM PCE * 11470000 * /* * 11480000 * /***************************************************************** 11490000 * 11500000 * IF PCETYPE = '110'B THEN /* IS IT AN IKJTERM * 11510000 TM 0(@6),B'11000000' 0074 11520000 BC 12,@9FB 0073 11530000 TM 0(@6),B'00100000' 0074 11540000 BC 05,@9FA 0074 11550000 * DO; /* IF IS , DO THE FOLLOWING 11560000 * INITIALIZATION * 11570000 * TANC = AANC; /* RESET CORE ANCHORS TO ERASE 11580000 * ALL QUALIFIER PDE'S WHICH MAY 11590000 * HAVE BEEN ADDED * 11600000 MVC 572(4,@B),568(@B) 0076 11610000 * SEGLIST (5)= XPCE+7; /* INITIALIZE MESSAGE PARM 11620000 * FIELD FOR THE PUTLINE TO POINT 11630000 * TO THE PARAMETER TYPE FIELD IN 11640000 * THE PCE * 11650000 LA @F,7 0077 11660000 AR @F,@6 0077 11670000 ST @F,444(0,@B) 0077 11680000 * GOTO MSGSET; /* GO TO FORMAT THE MESSAGE * 11690000 BC 15,MSGSET 0078 11700000 * END; 11710000 * 11720000 * /***************************************************************** 11730000 * /* * 11740000 * /* DETERMINE IF THE PCETYPE IS AN OPER * 11750000 * /* * 11760000 * /***************************************************************** 11770000 * 11780000 * IF PCETYPE = '111'B THEN /* IF PCE TYPE IS AN OPER * 11790000 @9FA EQU * 0080 11800000 @9FB TM 0(@6),B'11100000' 0080 11810000 BC 12,@9F9 0080 11820000 * DO; /* DO THE FOLLOWING INIDTIAL- 11830000 * IZATION * 11840000 * TANC=OANC; /* RESET CORE ANCHORS TO WIPE * 11850000 MVC 572(4,@B),576(@B) 0082 11860000 * AANC = OANC; /* OUT ANY QUALIFIER PDE'S * 11870000 MVC 568(4,@B),576(@B) 0083 11880000 * INDEX = XPDL + OPDEINDX; /* ADD OPER PDE OFFSET FROM THE 11890000 * PCE TO THE BEGINNING OF THE 11900000 * PDE TO GET OPER PDE ADDRESS * 11910000 L @1,532(0,@B) 0084 11920000 MVC @TEMP2+2(2),4(@1) 0084 11930000 LH @8,@TEMP2+2 0084 11940000 A @8,168(0,@B) 0084 11950000 * 11960000 * /************************************************************* 11970000 * /* * 11980000 * /* CLEAR THE PERMANENT PDE UNDER THE OPER PDE TO GET RID OF * 11990000 * /* ANY INFORMATION WHICH MAY HAVE BEEN FILLED IN UNDER THE * 12000000 * /* OPER * 12010000 * /* * 12020000 * /************************************************************* 12030000 * 12040000 * OPDE (1:OPERLL) = OPDE(1:OPERLL)&&OPDE(1:OPERLL); 12050000 LR @E,@8 0085 12060000 LH @7,588(0,@B) 0085 12070000 BCTR @7,0 0085 12080000 LR @A,@8 0085 12090000 EX @7,@XC 0085 12100000 * SEGLIST (5) = XPCE+6; /* FILL IN PUTLINE PARAMETER 12110000 * LIST WITH ADDR OF PARAMETER 12120000 * TYPE FIELD IN THE PCE * 12130000 LA @F,6 0086 12140000 AR @F,@6 0086 12150000 ST @F,444(0,@B) 0086 12160000 * GOTO MSGSET; /* GO TO FORMAT THE MESSAGE * 12170000 BC 15,MSGSET 0087 12180000 * END; /* END OPER PCE PROCESSING * 12190000 * 12200000 * /***************************************************************** 12210000 * /* * 12220000 * /* DETERMINE IF PROCESSING UNDER A RESERVED WORD PCE * 12230000 * /* * 12240000 * /***************************************************************** 12250000 * 12260000 * IF PCETYPE = '101'B THEN /* SEE IF PROCESSING A RESERVD * 12270000 @9F9 TM 0(@6),B'10100000' 0089 12280000 BC 12,@9F8 0088 12290000 TM 0(@6),B'01000000' 0089 12300000 BC 05,@9F7 0089 12310000 * DO; /* WORD PCE * 12320000 * SEGLIST (5)= XPCE+6; /* POSITION TO PARAMETER TYPE 12330000 * FIELD IN THE PCE * 12340000 LA @F,6 0091 12350000 AR @F,@6 0091 12360000 ST @F,444(0,@B) 0091 12370000 * GOTO MSGSET; /* GO TO FORMAT THE MESSAGE * 12380000 BC 15,MSGSET 0092 12390000 * END; /* END SPECIAL RESERVED WORD PCE 12400000 * PROCESSING * 12410000 * 12420000 * ERROR: /* ERROR ENTRY * 12430000 * RETCODE = 24; /* IF FALL THROUGH TO HERE. 12440000 * MSGSETUP WAS ENTERED UNDER AN 12450000 * INVALID PCE TYPE AND AN ERROR 12460000 * RETURN MUST BE MADE * 12470000 @9F7 EQU * 0094 12480000 @9F8 EQU * 0094 12490000 ERROR MVI 154(@B),24 0094 12500000 * R15 = 16; /* LOAD R15 WITH ADDRESS OF 12510000 * CLEANUP ROUTINE IN IKJPARS * 12520000 LA @F,16 0095 12530000 * GOTO LINKRET; /* GO TO ROUTINE TO HANDLE 12540000 * LINKAGE TO IKJPARS * 12550000 BC 15,LINKRET 0096 12560000 * 12570000 * /***************************************************************** 12580000 * /* * 12590000 * /* ROUTINE TO FORMAT THE SPECIAL MESSAGE IF REQUIRED * 12600000 * /* * 12610000 * /***************************************************************** 12620000 * 12630000 * 12640000 * MSGSET: 12650000 * MSGCODE = 20; /* INDICATE INVALID MESSAGE TO BE 12660000 * WRITTEN * 12670000 MSGSET MVI 464(@B),20 0097 12680000 * CBLTEMP = CBLTEMP && CBLTEMP; /* CLEAR THE COBOL TEMPORARY PDE * 12690000 XC 332(80,@B),332(@B) 0098 12700000 * 12710000 * /***************************************************************** 12720000 * /* * 12730000 * /* IF XINPUTB IS GREATER THAN THE END OF THE BUFFER, MUST SET IT * 12740000 * /* EQUAL TO ENDINPUT SO WON'T GET GARBAGE IN THE ERROR MESSAGE * 12750000 * /* * 12760000 * /***************************************************************** 12770000 * 12780000 * IF BLNKFLAG ^= '1'B /* IF OPER SAYS NOT PTING AT A * 12790000 * THEN /* BLANK OUT OF BUFFER THEN * 12800000 TM 601(@B),B'00100000' 0099 12810000 BC 01,@9F6 0099 12820000 * IF XINPUTB>ENDINPUT /* IF XINPUTB IS OFF THE * 12830000 * THEN /* BUFFER, RESET IT SO * 12840000 C @5,144(0,@B) 0100 12850000 BC 12,@9F5 0100 12860000 * XINPUTB=ENDINPUT; /* NO GARBAGE IN MESSAGE * 12870000 L @5,144(0,@B) 0101 12880000 * BLNKFLAG = '0'B; /* RESET BLANK INDICATOR * 12890000 @9F5 EQU * 0102 12900000 @9F6 NI 601(@B),B'11011111' 0102 12910000 * INDEX = XINPUTB - INVPSAVE; /* GET LENGTH OF INVALID DATA * 12920000 L @8,300(0,@B) 0103 12930000 LCR @8,@8 0103 12940000 AR @8,@5 0103 12950000 * IF INDEX <= 0 /* IF LENGTH IS ZERO OR LESS * 12960000 * THEN 12970000 LTR @8,@8 0104 12980000 * GOTO ERROR; /* IT IS AN ERROR * 12990000 BC 12,ERROR 0105 13000000 * 13010000 * /***************************************************************** 13020000 * /* * 13030000 * /* DETERMINE IF A SPECIAL MESSAGE IS REQUIRED * 13040000 * /* * 13050000 * /***************************************************************** 13060000 * 13070000 * IF SPECMSG = '1'B THEN /* IF SPECIAL MESSAGE, MUST DO 13080000 * INITIALIZATION BEFORE GO TO 13090000 * IKJPARS TO WRITE IT OUT * 13100000 TM 600(@B),B'10000000' 0106 13110000 BC 12,@9F4 0106 13120000 * DO; /* DO SPECIAL MESSAGE PROCESS * 13130000 * RESPECIFY 13140000 * R1 RESTRICTED; /* RESTRICT R1 BECAUSE IKJPARS IS 13150000 * DEPENDENT ON VALUES IN 1 * 13160000 * XINPUTB = XINPUTB-INVPSAVE; /* GET LENGTH OF INVALID DATA 13170000 * INTO XINPUTB * 13180000 S @5,300(0,@B) 0109 13190000 * R1 = XINPUTB + 5 + MSGLEN; /* GET TOTAL LENGTH OF CORE 13200000 * REQUIRED IN WHICH TO BUILD THE 13210000 * SPECIAL MESSAGE * 13220000 LH @1,590(0,@B) 0110 13230000 AH @1,@D1 0110 13240000 AR @1,@5 0110 13250000 * CORELEN = R1; /* SAVE THE LENGTH OF THE GET- 13260000 * MAIN FOR SUBSEQUEND FREEMAN * 13270000 STH @1,606(0,@B) 0111 13280000 * R15 = 14; /* LOAD THE ADDRESS OF THE 13290000 * GETMAIN ROUTINE IN IKJPARS * 13300000 LA @F,14 0112 13310000 * CALL LINKRET; /* GO TO PROCEDURE WHICH HANDLES 13320000 * LINKAGES TO IKJPARS. * 13330000 BAL @E,LINKRET 0113 13340000 * COREADDR = SUBRWORK(1); /* SAVE ADDR OF CORE GOTTEN FOR 13350000 * SUBSEQUENT FREEMAIN * 13360000 MVC 648(4,@B),160(@B) 0114 13370000 * INDEX1=SUBRWORK (1); /* SET BASE FOR MSGA * 13380000 MVC INDEX1(4),160(@B) 0115 13390000 * 13400000 * /************************************************************* 13410000 * /* * 13420000 * /* DETERMINE IF IT IS NECESSARY TO INSERT A LEFT PARENTHESIS * 13430000 * /* INTO THE SPECIAL MESSAGE BUFFER. THIS BIT IS SET BY THE * 13440000 * /* INDIVIDUAL MACRO PROCESSORS * 13450000 * /* * 13460000 * /************************************************************* 13470000 * 13480000 * IF LFTPAREN = '1'B /* IS LEFT PAREN REQUIRED * 13490000 * THEN 13500000 TM 600(@B),B'01000000' 0116 13510000 BC 12,@9F3 0116 13520000 * MSGAREA1 (1) = '('; /* IF SO, INSERT LEFT PAREN * 13530000 L @7,648(0,@B) 0117 13540000 MVI 0(@7),C'(' 0117 13550000 BC 15,@9F2 0118 13560000 * ELSE 13570000 * MSGAREA1 (1) = ' '; /* IF NOT, BLANK OUT FIRST BYTE 13580000 * OF THE MESSAGE BUFFER * 13590000 @9F3 L @7,648(0,@B) 0118 13600000 MVI 0(@7),C' ' 0118 13610000 * INDEX1=INDEX1+1; /* INCREMENT MSGA BASE * 13620000 @9F2 LA @F,1 0119 13630000 A @F,INDEX1 0119 13640000 ST @F,INDEX1 0119 13650000 * 13660000 * /************************************************************* 13670000 * /* * 13680000 * /* MOVE IN THE FIRST PART OF THE INVALID MESSAGE. THIS MOVES * 13690000 * /* IN THE FIRST DATA NAME MOVE DATA INTO FIRST PART OF * 13700000 * /* MESSAGE AREA * 13710000 * /* * 13720000 * /************************************************************* 13730000 * 13740000 * DO INDEX=MSGLEN TO 1 BY -1; /* MOVE 1 CHARACTER AT A TIME 13750000 * FROM THE END BACKWARDS * 13760000 LH @F,590(0,@B) 0120 13770000 LTR @8,@F 0120 13780000 BC 12,@DO9F0 0120 13790000 * MSGA (INDEX) = DTANME(INDEX); /* 1 CHARACTER OF DATA FOR 13800000 * SPECIFIED LENGTH * 13810000 @DO9F1 LR @7,@8 0121 13820000 BCTR @7,0 0121 13830000 L @9,592(0,@B) 0121 13840000 LA @E,0(@7,@9) 0121 13850000 L @9,INDEX1 0121 13860000 LA @A,0(@7,@9) 0121 13870000 MVC 0(1,@A),0(@E) 0121 13880000 * END; /* LENGTH OF FIRST DATA NAME * 13890000 * INDEX1 = INDEX1 + MSGLEN; /* INCREASE ADDRESS INTO SPECIAL 13900000 * MESSAGE LINE BY LENGTH OF DATA 13910000 * JUST MOVED IN * 13920000 BCT @8,@DO9F1 0122 13930000 @DO9F0 LH @F,590(0,@B) 0123 13940000 A @F,INDEX1 0123 13950000 ST @F,INDEX1 0123 13960000 * 13970000 * /************************************************************* 13980000 * /* * 13990000 * /* MOVE IN ELLIPSES * 14000000 * /* * 14010000 * /************************************************************* 14020000 * 14030000 * DO INDEX=3 TO 1 BY -1; /* MOVE IN ELLIPSES * 14040000 LA @8,3 0124 14050000 * MSGA (INDEX) = '.'; /* MOVE IN ELLIPSES - 3 PERIOD * 14060000 @DO9ED LR @7,@8 0125 14070000 BCTR @7,0 0125 14080000 L @9,INDEX1 0125 14090000 LA @A,0(@7,@9) 0125 14100000 MVI 0(@A),C'.' 0125 14110000 * END; /* END MOVE * 14120000 * INDEX1 = INDEX1+3; /* INCREMENT MSGA ADDRESS PASSED 14130000 * THE '...' * 14140000 BCT @8,@DO9ED 0126 14150000 LA @F,3 0127 14160000 A @F,INDEX1 0127 14170000 ST @F,INDEX1 0127 14180000 * 14190000 * /************************************************************* 14200000 * /* * 14210000 * /* MOVE IN VARIABLE LENGTH DATA INTO SPECIAL MESSAGE AREA * 14220000 * /* * 14230000 * /************************************************************* 14240000 * 14250000 * DO INDEX=XINPUTB TO 1 BY -1; /* MOVE IN INVALID DATA * 14260000 LR @8,@5 0128 14270000 LTR @8,@8 0128 14280000 BC 12,@DO9E8 0128 14290000 * MSGA (INDEX) = INVDATA(INDEX); /* MOVE IN VARIABLE LENGTH 14300000 * INVALID DATA * 14310000 @DO9E9 LR @7,@8 0129 14320000 BCTR @7,0 0129 14330000 L @9,300(0,@B) 0129 14340000 LA @E,0(@7,@9) 0129 14350000 L @9,INDEX1 0129 14360000 LA @A,0(@7,@9) 0129 14370000 MVC 0(1,@A),0(@E) 0129 14380000 * END; /* END VARIABLE LENGTH MOVE * 14390000 * 14400000 * /************************************************************* 14410000 * /* * 14420000 * /* DETERMINE IF A RIGHT PARENTHESIS MUST BE INCLUDED * 14430000 * /* * 14440000 * /************************************************************* 14450000 * 14460000 * IF RHTPAREN = '1'B THEN 14470000 BCT @8,@DO9E9 0130 14480000 @DO9E8 TM 600(@B),B'00100000' 0131 14490000 BC 12,@9E5 0131 14500000 * MSGAREA1 (MSGLEN+XINPUTB+5) = ')'; /* MOVE IN RIGHT 14510000 * PARENTHESIS * 14520000 LR @7,@5 0132 14530000 AH @7,590(0,@B) 0132 14540000 BCTR @7,0 0132 14550000 L @9,648(0,@B) 0132 14560000 LA @A,5(@7,@9) 0132 14570000 MVI 0(@A),C')' 0132 14580000 BC 15,@9E4 0133 14590000 * ELSE 14600000 * MSGAREA1 (MSGLEN+XINPUTB+5) = ' '; 14610000 @9E5 LR @7,@5 0133 14620000 AH @7,590(0,@B) 0133 14630000 BCTR @7,0 0133 14640000 L @9,648(0,@B) 0133 14650000 LA @A,5(@7,@9) 0133 14660000 MVI 0(@A),C' ' 0133 14670000 * INVPSAVE = SUBRWORK(1); /* POINT INVPSAVE TO NEW BUFFER 14680000 * SO IKJPARS WILL PICK UP 14690000 * SPECIAL MESSAGE JUST BUILT * 14700000 @9E4 MVC 300(4,@B),160(@B) 0134 14710000 * PPOINTR = SUBRWORK(1); /* SET PPOINTR = TO CORE ADDRESS 14720000 * IN CASE GOING TO WRITE OUT 14730000 * CLOSING PAREN ASSUMED MSAGE * 14740000 MVC 148(4,@B),160(@B) 0135 14750000 * XINPUTB = SUBRWORK(1) + MSGLEN + /* POINT XINPUTB TO END FOR * 14760000 * XINPUTB + 5; /* SAME REASON - SO LENGTH WILL 14770000 * BE FOR SPECIAL MESSAGE * 14780000 LA @F,5 0136 14790000 AR @F,@5 0136 14800000 AH @F,590(0,@B) 0136 14810000 A @F,160(0,@B) 0136 14820000 LR @5,@F 0136 14830000 * END; 14840000 * R15 = 4; /* LOAD SUBROUTINE ADDRESS FOR 14850000 * WRITING INVALID MESSAGE * 14860000 @9F4 LA @F,4 0138 14870000 * CALL LINKRET; /* CALL INTERFACE ROUTINE * 14880000 BAL @E,LINKRET 0139 14890000 * IF SPECMSG = '1'B THEN /* WAS A SPECIAL MESSAGE * 14900000 TM 600(@B),B'10000000' 0140 14910000 BC 12,@9E3 0140 14920000 * DO; /* WRITTEN * 14930000 * RESPECIFY 14940000 * R1 RESTRICTED; /* IF SO, MUST FREE CORE - NEED 14950000 * REG1 * 14960000 * 14970000 * /************************************************************* 14980000 * /* * 14990000 * /* ISSUE FREEMAIN FOR CORE IN WHICH BUILT SPECIAL MESSAGE * 15000000 * /* * 15010000 * /************************************************************* 15020000 * 15030000 * 15040000 * FREE: 15050000 * GENERATE; 15060000 FREE EQU * 0143 15070000 USING PWORK,PWAREG ADDRESSABILITY TO PWORK 15080000 L R1,COREADDR RESTORE ADDRESS OF CORE 15090000 LH R0,CORELEN LOAD LENGTH INTO R0 15100000 DROP PWAREG FREE BASE REG FOR WORKAREA 15110000 FREEMAIN R,LV=(0),A=(1) FREE THE CORE 15120000 DS 0H 15130000 * RESPECIFY 15140000 * R1 UNRESTRICTED; /* RELEASE REGISTER 1 * 15150000 * END; 15160000 * LFTPAREN = '0'B; /* TURN SPECIAL MESSAGE AND * 15170000 @9E3 NI 600(@B),B'00011111' 0146 15180000 * RHTPAREN = '0'B; /* FORMAT INDICATORS * 15190000 * SPECMSG = '0'B; /* OFF * 15200000 * R14 = PLINKSV2; /* RESTORE RETURN REGISTER * 15210000 L @E,672(0,@B) 0149 15220000 * RETURN; /* MACRO PROCESSORS AND RETURN * 15230000 * END MSGSETUP; /* END MSGSET UP PROCEDURE * 15240000 @EL03 BCR 15,@E 0151 15250000 * 15260000 * /***************************************************************** 15270000 * /* * 15280000 * /* IKJOPER MACRO PROCESSING * 15290000 * /* * 15300000 * /***************************************************************** 15310000 * 15320000 * 15330000 * IKJEFP50: /* ENTRY POINT * 15340000 * PROC OPTIONS(NOSAVEAREA, /* NO STANDARD LINKAGE * 15350000 * DONTSAVE); /* NO STANDARD LINKAGE * 15360000 IKJEFP50 EQU * 0152 15370000 * 15380000 * /***************************************************************** 15390000 * /* * 15400000 * /* REGISTER DECLARES AND RESTRICTIONS * 15410000 * /* * 15420000 * /***************************************************************** 15430000 * 15440000 * DCL 15450000 * R4 REG(4) PTR(31); /* REGISTER 4 * 15460000 * DCL 15470000 * R5 REG(5) PTR(31); /* REGISTER 5 * 15480000 * DCL 15490000 * R6 REG(6) PTR(31); /* REGISTER 6 * 15500000 * DCL 15510000 * R8 REG(8) PTR(31); /* REGISTER 8 * 15520000 * DCL 15530000 * R9 REG(9) PTR(31); /* REGISTER 9 * 15540000 * DCL 15550000 * R11 REG(11) PTR(31); /* REGISTER 11 * 15560000 * RESTRICT (R4,R5,R6); /* KEEP SCAN PTRS INTACT * 15570000 * RESTRICT (PWAREG); /* KEEP WORKAREA REFERENCE * 15580000 * RESTRICT (R8); /* COUNTER * 15590000 * 15600000 * /***************************************************************** 15610000 * /* * 15620000 * /* DATA VARIABLES * 15630000 * /* * 15640000 * /***************************************************************** 15650000 * 15660000 * DCL 15670000 * COMBUF CHAR(1) BASED(R4); /* CHARACTER IN THE COMMAND 15680000 * BUFFER POINTED TO BY XINPUT * 15690000 * DCL 15700000 * COMBUFBV CHAR(256) BASED(R5); /* CHARACTERS IN THE 15710000 * COMMAND BUFFER POINTED TO BY 15720000 * XINPUT * 15730000 * DCL 15740000 * COMBUFP CHAR(256) BASED(PPOINTR); /* CHARACTER IN THE 15750000 * COMMAND BUFFER POINTED TO BY 15760000 * PPOINTR * 15770000 * DCL 15780000 * COMBUFB CHAR(1) BASED (R5); /* CHARACTER IN THE 15790000 * COMMAND BUFFER POINTED TO BY 15800000 * XINPUTB * 15810000 * DCL 15820000 * BLNK STATIC INTERNAL CHAR(1) INIT(' '); /* BLANK * 15830000 * DCL 15840000 * P40PR LABEL LOCAL INTERNAL; /* RETURN AFTER PROMPTING * 15850000 * DCL 15860000 * P50PR LABEL LOCAL INTERNAL; /* RETURN AFTER PROMPTING * 15870000 * DCL 15880000 * IP LABEL LOCAL INTERNAL; /* OPER INVALID MSG SET UP * 15890000 * 15900000 * /***************************************************************** 15910000 * /* * 15920000 * /* THE SAME PDE MAP IS USED TO REFERENCE ALL FOUR TYPES OF * 15930000 * /* IKJTERM PDE'S -CONSTANT,STATEMENT NUMBER,VARIBLE, AND PDE'S * 15940000 * /* FOR DATA NAME QUALIFIERS. * 15950000 * /* * 15960000 * /***************************************************************** 15970000 * 15980000 * DCL 15990000 * 1 PDEMPT BASED(PDEPTR), /* MAP OF PDE * 16000000 * 2 DNAMEPTR PTR(31), /* PTR TO DATA NAME * 16010000 * 3 LNGTH1 PTR(8), /* LENGTH OF DIGITS OR PGM.ID * 16020000 * 3 LNGTH2 PTR(8), /* LENGTH OF EXPONENT OR LINE# * 16030000 * 3 LNGTH3 PTR(8), /* LENGTH OF VERB NO. * 16040000 * 3 RESVA CHAR(1), /* RESERVE BYTE * 16050000 * 2 RESWDNUM PTR(15), /* NUMBER OF RESERVE WORDS * 16060000 * 3 LNGTH4 PTR(8), /* LENGTH OF DATA NAME * 16070000 * 3 RESV2 CHAR(1), /* RESERVE BYTE * 16080000 * 2 FLAG1 BIT(8), /* TYPE INDICATOR * 16090000 * 3 PARMIND BIT(1), /* PARAMETER PRESENT * 16100000 * 3 CONST BIT(1), /* TYPE EQUAL CONSTANT * 16110000 * 3 VARIA BIT(1), /* TYPE EQUAL VARIABLE * 16120000 * 3 STATE BIT(1), /* TYPE EQUAL STATEMENT NO. * 16130000 * 3 FIXED BIT(1), /* FIXED PTR. NUMERIC LITERAL * 16140000 * 3 NONNUM BIT(1), /* NON-NUMERIC LITERAL * 16150000 * 3 FIGUR BIT(1), /* FIGURATIVE CONSTANT * 16160000 * 3 FLOAT BIT(1), /* FLOATING PT.NUMERIC LITERAL * 16170000 * 2 FLAG2 BIT(8), /* SIGN INDICATOR * 16180000 * 3 SIGN BIT(1), /* SIGN IS PLUS OR MINUS * 16190000 * 3 EXPSIGN BIT(1), /* SIGN ON EXPONENT IS (+)OR(-) * 16200000 * 3 DECPT BIT(1), /* DECIMAL PTR INDICATOR * 16210000 * 3 RESV3 BIT(5), /* RESERVE BITS * 16220000 * 2 DATAPTRH PTR(32), /* SPACE FOR LAST INDICATOR * 16230000 * 3 DATAPTR PTR(31), /* PTR TO STRING OF DIGITS OR PTR 16240000 * TO PGM.ID OR PTR TO PDE FOR 16250000 * NXT QUALIFIER * 16260000 * 2 DATAPTRA PTR(31), /* PTR TO EXPONENT OR PTR TO LINE 16270000 * NUMBER OR PTR TO PGM.ID NAME * 16280000 * 2 DATAPTRB PTR(31), /* PTR TO PERIOD OR PTR TO VERB 16290000 * NUMBER * 16300000 * 3 LNGTH5 PTR(8), /* LENGTH OF PGM.ID (VAR PDE) * 16310000 * 3 NUMQUAL CHAR(1), /* NUMBER OF QUALIFIERS-VAR PDE * 16320000 * 3 NUMSUB CHAR(1), /* NUMBER OF SUBCRIPTS-VAR PDE * 16330000 * 3 RESV4 CHAR(1); /* RESERVE BYTE (VAR PDE) * 16340000 * 16350000 * /***************************************************************** 16360000 * /* * 16370000 * /* IKJTERM PCE MAPPING * 16380000 * /* * 16390000 * /***************************************************************** 16400000 * 16410000 * DCL 16420000 * 1 PCEMPT BASED(R6), /* MAP OF PCE * 16430000 * 2 PCEFLG1 BIT(16), /* MESSAGE INDICATOR * 16440000 * 3 TERPCE BIT(3), /* IKJTERM PCE * 16450000 * 3 PROMPT BIT(1), /* PROMPT SPECIFIED * 16460000 * 3 DEFAULT BIT(1), /* DEFAULT SPECIFIED * 16470000 * 3 RESERV1 BIT(1), /* RESERVE BIT * 16480000 * 3 HELP BIT(1), /* HELP MESSAGE PROVIDED * 16490000 * 3 VALCHK BIT(1), /* VALIDITY CHECK EXIT * 16500000 * 3 LIST BIT(1), /* LIST SPECIFIED * 16510000 * 3 ASIS BIT(1), /* ASIS SPECIFIED * 16520000 * 3 RANG BIT(1), /* RANGE SPECIFIED * 16530000 * 3 SUBSCRP BIT(1), /* TERM MAY BE SUBSCRIPTED * 16540000 * 3 RESVCHA BIT(1), /* RESERVE WORD PCE CHAINED * 16550000 * 3 RESERV2 BIT(3), /* RESERVE BIT * 16560000 * 2 PCELNGTH CHAR(2), /* HEX LENGTH OF THIS PCE * 16570000 * 2 PDEOFST CHAR(2), /* OFFSET IN PDL FOR PDE * 16580000 * 2 PCEFLG2 BIT(8), /* PCE TYPE OPERAND * 16590000 * 3 STMT BIT(1), /* TYPE EQUAL STATEMENT * 16600000 * 3 VAR BIT(1), /* TYPE EQUAL VARIBLE * 16610000 * 3 CNST BIT(1), /* TYPE EQUAL CONSTANT * 16620000 * 3 ANY BIT(1), /* TYPE EQUAL ANY * 16630000 * 3 SUBSCPPT BIT(1), /* TERM DESCRIBING A SUBSCRIPT * 16640000 * 3 RESERV3 BIT(3), /* RESERVE BITS * 16650000 * 2 TPTSL PTR(15) BDY(BYTE); /* LENGTH OF THE PARAMETER 16660000 * TYPE SEGMENT * 16670000 * 16680000 * /***************************************************************** 16690000 * /* * 16700000 * /* MAP THE SECOND FIXED FIELD IN THE IKJTERM PCE * 16710000 * /* * 16720000 * /***************************************************************** 16730000 * 16740000 * DCL 16750000 * TPODL BIT(8) BASED(R6); /* LENGTH OF PROMPT DEFAULT 16760000 * SEGMENT IN TERM PCE * 16770000 * 16780000 * /***************************************************************** 16790000 * /* * 16800000 * /* MAP THE THIRD FIXED FIELD IN THE IKJTERM PCE * 16810000 * /* * 16820000 * /***************************************************************** 16830000 * 16840000 * DCL 16850000 * RSVWDIDX FIXED(15) BASED(R6) /* OFFSET TO CHAINED * 16860000 * BDY(BYTE); /* RSVWD FROM TOP OF PDL * 16870000 * 16880000 * /***************************************************************** 16890000 * /* * 16900000 * /* IKJNAME PCE MAPPING * 16910000 * /* * 16920000 * /***************************************************************** 16930000 * 16940000 * DCL 16950000 * 1 NPCE1 BASED(R6) BDY(BYTE), /* IKJNAME PCE * 16960000 * 2 NPCE BIT(16), /* MASK AND FLAG DATA AREA * 16970000 * 3 NPCEMASK BIT(3), /* MASK INDICATING TYPE PCE * 16980000 * 3 * BIT(13), /* NOT REFERENCED * 16990000 * 2 NPCELNTH FIXED(15), /* LENGTH OF PCE * 17000000 * 2 NAMELM1 PTR(8), /* LENGTH OF NAME DATA -1 * 17010000 * 2 NAMEDATA CHAR(256); /* FIRST CHAR OF NAME * 17020000 * 17030000 * /***************************************************************** 17040000 * /* * 17050000 * /* IKJRSVWD PCE MAPPING * 17060000 * /* * 17070000 * /***************************************************************** 17080000 * 17090000 * DCL 17100000 * 1 RPCEFLD BASED(R6)BDY(BYTE), /* MAP RSVWD PCE * 17110000 * 2 RPCEBYT1 BIT (16), /* FIRST BYTE OF INDICATORS * 17120000 * 3 RSVWMASK BIT(3), /* INDICATES PCE TYPE * 17130000 * 3 RPRMTI BIT(1), /* PROMPT DATA SUPPLIED * 17140000 * 3 RDFLTI BIT(1), /* DEFAULT DATA SUPPLIED * 17150000 * 3 * BIT(3), /* NOT REFERENCED * 17160000 * 3 RFCONST BIT(1), /* FIGURATIVE CONSTANT IF ON * 17170000 * 3 * BIT(7), /* NOT REFERENCED * 17180000 * 2 RPCELNTH FIXED(15), /* RSVWD PCE LENGTH * 17190000 * 2 RPDEINDX FIXED(15); /* OFFSET TO RSVWD PDE FROM START 17200000 * OF PDL * 17210000 * 17220000 * /***************************************************************** 17230000 * /* * 17240000 * /* SAVE AREA FOR SPECIAL MESSAGE DATA --- THIS INFORMATION IS * 17250000 * /* USED TO PROMPT FOR AN EXPRESSION * 17260000 * /* * 17270000 * /***************************************************************** 17280000 * 17290000 * DCL 17300000 * 1 OPERSPM AUTOMATIC, /* MSGAREA SAVE * 17310000 * 2 OPERSPM1 FIXED(15), /* SAVE TERM1 WORD1 LENGTH * 17320000 * 2 OPERSPM2 FIXED(31); /* SAVE ADDR TERM1 WORD1 * 17330000 * 17340000 * /***************************************************************** 17350000 * /* * 17360000 * /* IKJOPER PDE AND IKJRSVWD PDE MAPPING * 17370000 * /* * 17380000 * /***************************************************************** 17390000 * 17400000 * DCL 17410000 * 1 ORPDE BASED(ADDR(TEMPPDE)) BDY(BYTE), /* MAP OPER & RSVWD 17420000 * PDE * 17430000 * 2 * CHAR(2), 17440000 * 2 RNAMENUM FIXED (15), /* IKJNAME NUMBER * 17450000 * 2 * CHAR(2), 17460000 * 2 ORPDEFLG BIT(8), /* FLAG DATA * 17470000 * 3 ORFND BIT(1), /* INDICATES THAT THE DATA 17480000 * DESCRIBED BY THE PCE WAS FOUND* 17490000 * 3 ORPDERD2 BIT(7), /* RESERVED FLAG AREA * 17500000 * 2 ORPDERD3 CHAR(1); /* RESERVED DATA AREA * 17510000 * 17520000 * /***************************************************************** 17530000 * /* * 17540000 * /* INITIATE IKJOPER MACRO PROCESSING * 17550000 * /* * 17560000 * /***************************************************************** 17570000 * 17580000 * COBOLMOD = '1'B; /* INDICATE THAT A COBOL SCAN IS 17590000 * IN PROGRESS * 17600000 OI 599(@B),B'11000000' 0178 17610000 * OPERMODE = '1'B; /* INDICATE THAT A SCAN OF AN 17620000 * EXPRESSION IS IN PROGRESS * 17630000 * OPERPRMT = '0'B; /* TURN OFF INDICATOR FOR 17640000 * EXPRESSION PROMPT RETURN 17650000 * PROCESSING * 17660000 NI 599(@B),B'11111101' 0180 17670000 * OANC = AANC; /* SAVE PTR TO TERM QUALIFIER PDE 17680000 * CORE ON ENTRY - THE PTR WILL 17690000 * BE RESET TO THIS VALUE IF THE 17700000 * ENTIRE EXPRESSION IS FOUND TO 17710000 * BE INVALID * 17720000 MVC 576(4,@B),568(@B) 0181 17730000 * OPERPCE = R6; /* SAVE PTR TO IKJOPER PCE * 17740000 ST @6,532(0,@B) 0182 17750000 * RESPECIFY 17760000 * (R7, 17770000 * R9) RESTRICTED; /* KEEP TEMP WORKAREA * 17780000 * OPCEPTR = R6 + OPCEPTL + 6; /* ESTABLISH ADDRESSABILITY FOR 17790000 * THE OPCEFLD2 DSECT THAT MAPS 17800000 * THE SECOND FIXED DATA AREA IN 17810000 * THE OPER PCE * 17820000 LA @F,6 0184 17830000 L @1,532(0,@B) 0184 17840000 MVC @TEMP2+2(2),6(@1) 0184 17850000 LH @0,@TEMP2+2 0184 17860000 AR @F,@0 0184 17870000 AR @F,@6 0184 17880000 ST @F,OPCEPTR 0184 17890000 * R7 = PTABLEAD; /* SET UP PTR TO TOP OF PCL * 17900000 L @7,324(0,@B) 0185 17910000 * R9 = R6; /* SAVE PCE PTR FOR 'OTERMCK' * 17920000 LR @9,@6 0186 17930000 * R6 = R7 + T1PCEIDX; /* PLACE TERM1 PCE ADDR INXPCE * 17940000 LR @1,@F 0187 17950000 MVC @TEMP2+2(2),2(@1) 0187 17960000 LH @6,@TEMP2+2 0187 17970000 AR @6,@7 0187 17980000 * CALL TERMOCK; /* TERMINATE THE SCAN IF THE 17990000 * FORMAT OF THE MINOR TERM PCE 18000000 * IS INCORRECT * 18010000 L @F,@V1 ADDRESS OF TERMOCK 0188 18020000 BALR @E,@F 0188 18030000 * R6 = R7 + RPCEINDX; /* PLACE RSVWD PCE ADR IN XPCE * 18040000 L @1,OPCEPTR 0189 18050000 MVC @TEMP2+2(2),0(@1) 0189 18060000 LH @6,@TEMP2+2 0189 18070000 AR @6,@7 0189 18080000 * 18090000 * /***************************************************************** 18100000 * /* * 18110000 * /* IF THE MINOR RSVWD PCE ADDRESS DOES NOT REFERENCE A RSVWD PCE * 18120000 * /* THE SCAN IS TERMINATED * 18130000 * /* * 18140000 * /***************************************************************** 18150000 * 18160000 * IF RSVWMASK ^= '101'B /* COMPARE THE RSVWD PCE TYPE * 18170000 * THEN 18180000 TM 0(@6),B'10100000' 0190 18190000 BC 12,@9E2 0189 18200000 TM 0(@6),B'01000000' 0190 18210000 BC 08,@9E1 0190 18220000 * GOTO RTNCLNUP; /* MASK TO THE PCE * 18230000 BC 15,RTNCLNUP 0191 18240000 * 18250000 * /***************************************************************** 18260000 * /* * 18270000 * /* IF THE FIGURATIVE CONSTANT INDICATOR BIT IS ON IN THE RSVWD * 18280000 * /* PCE DESCRIBING AN OPERATOR THE SCAN IS TERMINATED * 18290000 * /* * 18300000 * /***************************************************************** 18310000 * 18320000 * THEN 18330000 @9E1 TM 1(@6),B'10000000' 0192 18340000 * GOTO RTNCLNUP; /* BIT IS ON GOTO 'CLEANUP' * 18350000 BC 01,RTNCLNUP 0193 18360000 * 18370000 * /***************************************************************** 18380000 * /* * 18390000 * /* THE RSVWD PCE ADDRESS MUST BE GREATER THAN THE FIRST OPERAND * 18400000 * /* ADDRESS. THE FIRST OPERAND ADDRESS IS PLACED IN PRIOPPCE BY * 18410000 * /* TERMOCK. * 18420000 * /* * 18430000 * /***************************************************************** 18440000 * 18450000 * IF R6 ^> R9 /* IF XPCE NOT GREATER * 18460000 * THEN 18470000 CR @6,@9 0194 18480000 * GOTO RTNCLNUP; /* GOTO CLEANUP * 18490000 BC 12,RTNCLNUP 0195 18500000 * R9 = R6; /* PRIORPCE = ADDR RSVWD PCE * 18510000 LR @9,@6 0196 18520000 * R6 = R7 + T2PCEIDX; /* PLACE TERM2 PCE ADR IN XPCE * 18530000 L @1,OPCEPTR 0197 18540000 MVC @TEMP2+2(2),4(@1) 0197 18550000 LH @6,@TEMP2+2 0197 18560000 AR @6,@7 0197 18570000 * CALL TERMOCK; /* TERMINATE THE SCAN IF THE 18580000 * FORMAT OF THE MINOR TERM PCE 18590000 * IS INCORRECT * 18600000 L @F,@V1 ADDRESS OF TERMOCK 0198 18610000 BALR @E,@F 0198 18620000 * 18630000 * /***************************************************************** 18640000 * /* * 18650000 * /* IF THERE IS A THIRD TERM PCE, TEST IT WITH TERMOCK * 18660000 * /* * 18670000 * /***************************************************************** 18680000 * 18690000 * IF T3PCEIDX ^= 0 /* IF THE TERM3 ADDRESS * 18700000 * THEN /* IN THE OPER PCE IS NOT * 18710000 SR @F,@F 0199 18720000 L @1,OPCEPTR 0199 18730000 MVC @TEMP2+2(2),6(@1) 0199 18740000 LH @0,@TEMP2+2 0199 18750000 CR @F,@0 0199 18760000 BC 08,@9E0 0199 18770000 * DO; /* SET TO ZEROS, * 18780000 * /* THERE IS AN OPTIONAL THIRD * 18790000 * /* TERM UNDER THE OPER PCE * 18800000 * R6 = R7 + T3PCEIDX; /* XPCE = TERM3 PCE ADDR * 18810000 MVC @TEMP2+2(2),6(@1) 0201 18820000 LH @6,@TEMP2+2 0201 18830000 AR @6,@7 0201 18840000 * CALL TERMOCK; /* TEST MINOR TERM PCE * 18850000 L @F,@V1 ADDRESS OF TERMOCK 0202 18860000 BALR @E,@F 0202 18870000 * END; 18880000 * RESPECIFY 18890000 * (R8) RESTRICTED; /* RESTRICT TERMPORARY INDEX * 18900000 * 18910000 * /***************************************************************** 18920000 * /* * 18930000 * /* CALCULATE THE LENGTH OF THE LAST MINOR TERM PDE * 18940000 * /* * 18950000 * /***************************************************************** 18960000 * 18970000 * IF SUBSCRP = '1'B /* IF PCE IS SUBSCRIPTABLE * 18980000 * THEN /* THEN SET I EQUAL TO * 18990000 @9E0 TM 1(@6),B'00010000' 0205 19000000 BC 12,@9DF 0205 19010000 * DO; /* THE LENGTH OF A * 19020000 * R8 = 80; /* SUBSCRIPT PDE * 19030000 LA @8,80 0207 19040000 * R9 = R9 + PCELNGTH; /* UPDATE TO NEXT PCE * 19050000 MVC @TEMP2+2(2),2(@6) 0208 19060000 A @9,@TEMP2 0208 19070000 * 19080000 * /************************************************************* 19090000 * /* * 19100000 * /* THE PCE FOLLOWING A SUBSCRIPTABLE TERM MUST BE A TERM * 19110000 * /* PCE. * 19120000 * /* * 19130000 * /************************************************************* 19140000 * 19150000 * IF R9 -> TERPCE ^= '110'B THEN /* IS THE * 19160000 TM 0(@9),B'11000000' 0209 19170000 BC 12,@9DE 0208 19180000 TM 0(@9),B'00100000' 0209 19190000 BC 08,@9DD 0209 19200000 * GOTO RTNCLNUP; /* PCE A TERM PCE * 19210000 BC 15,RTNCLNUP 0210 19220000 * 19230000 * /************************************************************* 19240000 * /* * 19250000 * /* THE SUBSCRIPT TERM MUST HAVE THE SUBSCRIPT OPTION CODED * 19260000 * /* * 19270000 * /************************************************************* 19280000 * 19290000 * IF R9 -> SUBSCPPT = '0'B THEN /* ISSUE RETURN CODE 19300000 @9DD TM 6(@9),B'00001000' 0211 19310000 * GOTO RTNCLNUP; /* AND TERMINATE SCAN IF 0 * 19320000 BC 08,RTNCLNUP 0212 19330000 BC 15,@9DC 0214 19340000 * END; 19350000 * ELSE 19360000 * R8 = 20; /* SET I EQUAL LENGTH NON- 19370000 * SUBSCRIPT PCE * 19380000 @9DF LA @8,20 0214 19390000 * RESPECIFY 19400000 * (R7) UNRESTRICTED; /* FREE TEMP PTRS * 19410000 @9DC EQU * 0215 19420000 * 19430000 * /***************************************************************** 19440000 * /* * 19450000 * /* CALCULATE THE LENGTH OF THE PDE STRUCTURE UNDER THE IKJOPER * 19460000 * /* PCE * 19470000 * /* * 19480000 * /***************************************************************** 19490000 * 19500000 * RESPECIFY 19510000 * (R7) RESTRICTED; /* SET UP NEW TEMP AREA * 19520000 * R7 = PDEOFST + XPDL + R8; /* PLACE END ADDR OF LAST TERM 19530000 * PDE IN ENDTPDE * 19540000 LR @7,@8 0217 19550000 A @7,168(0,@B) 0217 19560000 MVC @TEMP2+2(2),4(@6) 0217 19570000 A @7,@TEMP2 0217 19580000 * OPERLL = R7 -(XPDL + OPDEINDX); /* PLACE THE PDE STRUCTURE 19590000 * LENGTH IN OPERLL * 19600000 L @1,532(0,@B) 0218 19610000 MVC @TEMP2+2(2),4(@1) 0218 19620000 LH @F,@TEMP2+2 0218 19630000 A @F,168(0,@B) 0218 19640000 LCR @F,@F 0218 19650000 AR @F,@7 0218 19660000 STH @F,588(0,@B) 0218 19670000 * OPEREND = R9; /* SAVE THE ADDR OF LAST MINOR 19680000 * TERM PCE * 19690000 ST @9,520(0,@B) 0219 19700000 * RESPECIFY 19710000 * (R7, 19720000 * R9) UNRESTRICTED; /* RELEASE PTRS * 19730000 * R15 = 5; /* PLACE THE ADDRESS OF THE * 19740000 LA @F,5 0221 19750000 * /* SKIPB ROUTINE IN LINKB * 19760000 * 19770000 * /***************************************************************** 19780000 * /* * 19790000 * /* SKIP OVER ANY SEPARATOR IN THE INPUT LINE VIA SKIPB RTN * 19800000 * /* * 19810000 * /***************************************************************** 19820000 * 19830000 * CALL LINKRET; /* PASS CONTROL TO SKIPB * 19840000 BAL @E,LINKRET 0222 19850000 * GOTO D1; /* SKIPB RETURN +0 - END OF * 19860000 BC 15,D1 0223 19870000 * /* INPUT ENCOUNTERED -- * 19880000 * /* PROMPT FOR MISSING VIA * 19890000 * /* 'PROMPTQ' ROUTINE * 19900000 * 19910000 * PR: 19920000 * 19930000 * /***************************************************************** 19940000 * /* * 19950000 * /* RECEIVE CONTROL AFTER DATA IS RETURNED FROM THE PROMPT FOR AN * 19960000 * /* EXPRESSION * 19970000 * /* * 19980000 * /***************************************************************** 19990000 * 20000000 * OPERSVE = R5; /* SKIPB RETURN +4 - * 20010000 PR ST @5,536(0,@B) 0224 20020000 * /* SAVE PTR TO START OF DATA * 20030000 * 20040000 * /***************************************************************** 20050000 * /* * 20060000 * /* IF A LEFT PAREN IS NOT THE FIRST CHARACTER POINTED TO BY * 20070000 * /* XINPUT, PROCESS THE ENTRY AS A CHAINED TERM * 20080000 * /* * 20090000 * /***************************************************************** 20100000 * 20110000 * IF COMBUFB ^= '(' /* IF THE CHARACTER POINTED * 20120000 * THEN /* TO BY XINPUTB IS NOT A * 20130000 CLI 0(@5),C'(' 0225 20140000 BC 08,@9DB 0225 20150000 * DO; /* LEFT PARENTHESIS... * 20160000 * IF COMBUFB = ';' THEN /* IF XINPUTB POINTS TO A * 20170000 CLI 0(@5),C';' 0227 20180000 * GOTO I1; /* SEMICOLON, THE EXPRESSION * 20190000 BC 08,I1 0228 20200000 * /* IS MISSING * 20210000 * GOTO OPTTERM; /* ELSE, PROCESS CHAINED TERM * 20220000 BC 15,OPTTERM 0229 20230000 * END; 20240000 * 20250000 * /***************************************************************** 20260000 * /* * 20270000 * /* THIS SECTION OF CODE CONTROLS THE SCAN OF THE INDIVIDUAL * 20280000 * /* ELEMENTS OF AN EXPRESSION * 20290000 * /* * 20300000 * /***************************************************************** 20310000 * 20320000 * R4 = R4 + 1; /* UP THE INPUT LINE PTR BY 1 * 20330000 @9DB AH @4,@D2 0231 20340000 * CHAINTRM = '0'B; /* TURN OF CHAINED TERM SWITCH * 20350000 NI 600(@B),B'11101111' 0232 20360000 * R6 = T1PCEIDX + PTABLEAD; /* PLACE THE ADDRESS OF THE TERM1 20370000 * PCE IN XPCE * 20380000 L @6,324(0,@B) 0233 20390000 L @1,OPCEPTR 0233 20400000 MVC @TEMP2+2(2),2(@1) 0233 20410000 LH @0,@TEMP2+2 0233 20420000 AR @6,@0 0233 20430000 * CALL IKJEFP60; /* CALL THE TERM SCAN ROUTINE * 20440000 L @F,@V2 ADDRESS OF IKJEFP60 0234 20450000 BALR @E,@F 0234 20460000 * GOTO F1; /* ON +O RETURN PROMPT WITH 20470000 * INVALID EXPRESSION MSG * 20480000 BC 15,F1 0235 20490000 * OPERSPM1 = MSGLEN; /* ON +4 RETURN SAVE THE TERM1 * 20500000 MVC OPERSPM(2),590(@B) 0236 20510000 * OPERSPM2 = MSGADDR; /* SPECIAL MSG DATA * 20520000 MVC OPERSPM+4(4),592(@B) 0237 20530000 * PFNOPOP='0'B; /* ALLOW BUFFER POP M0000 * 20540000 NI 179(@B),B'11111101' 0238 20550000 * R6 = RPCEINDX + PTABLEAD; /* XPCE = ADDR RSVWD PCE * 20560000 L @6,324(0,@B) 0239 20570000 L @1,OPCEPTR 0239 20580000 MVC @TEMP2+2(2),0(@1) 0239 20590000 LH @0,@TEMP2+2 0239 20600000 AR @6,@0 0239 20610000 * CALL IKJEFP40; /* CALL THE RSVWD SCAN RTN * 20620000 L @F,@V3 ADDRESS OF IKJEFP40 0240 20630000 BALR @E,@F 0240 20640000 * GOTO OSPMSG; /* ON +0 RETURN PROMPT WITH 20650000 * INVALID EXPRESSION MSG * 20660000 BC 15,OSPMSG 0241 20670000 * R6 = T2PCEIDX + PTABLEAD; /* ON +4 RETURN PLACE THE ADDR OF 20680000 * THE TERM2 PCE IN XPCE * 20690000 L @6,324(0,@B) 0242 20700000 L @1,OPCEPTR 0242 20710000 MVC @TEMP2+2(2),4(@1) 0242 20720000 LH @0,@TEMP2+2 0242 20730000 AR @6,@0 0242 20740000 * PFNOPOP = '0'B; /* ALLOW BUFFER TO BE POPED * 20750000 NI 179(@B),B'11111101' 0243 20760000 * R15 = 5; /* SKIP TO NEXT BUFFER IF AT THE 20770000 * END OF A BUFFER * 20780000 LA @F,5 0244 20790000 * CALL LINKRET; /* GOTO PARS2 * 20800000 BAL @E,LINKRET 0245 20810000 * GEN (NOP 0); /* GOTO IKJEFP60 ON +0 & +4 * 20820000 NOP 0 20830000 DS 0H 20840000 * CALL IKJEFP60; /* CALL THE TERM SCAN ROUTINE * 20850000 L @F,@V2 ADDRESS OF IKJEFP60 0247 20860000 BALR @E,@F 0247 20870000 * GOTO OSPMSG; /* ON +0 RETURN PROMPT WITH 20880000 * INVALID EXPRESSION MSG * 20890000 BC 15,OSPMSG 0248 20900000 * IF PFENDSET ='1'B /* PFENDSET IS ON IF TERM * 20910000 * THEN /* POPPED TO LOWER BUFFER * 20920000 TM 179(@B),B'00000100' 0249 20930000 BC 12,@9DA 0249 20940000 * DO; /* IF SO , SET OPERSVE = * 20950000 * OPERSVE = ENDBAKUP; /* END OF BUFFER POPPED OFF * 20960000 MVC 536(4,@B),412(@B) 0251 20970000 * GOTO SK; /* GO TO SKIP BLANKS M4161 * 20980000 BC 15,SK 0252 20990000 * END; /* ROUTINE M4161 * 21000000 * IF PFNOPOP = '1'B /* PFENDSET NOT, ON CHECK M4161 * 21010000 * THEN /* PFNOPOP. IF ON, M4161 * 21020000 @9DA TM 179(@B),B'00000010' 0254 21030000 BC 12,@9D9 0254 21040000 * DO; /* SUBSCRIPT WAS PROCESSED M4161 * 21050000 * OPERSVE=R4; /* SET BAKUP POINTER TO R4 M4161 * 21060000 ST @4,536(0,@B) 0256 21070000 * PFNOPOP='0'B; /* RESET PFNOPOP, SO WILL M4161 21080000 * POP TO LOWER BUFFERS M4161 * 21090000 NI 179(@B),B'11111101' 0257 21100000 BC 15,@9D8 0259 21110000 * END; /* END, PFNOPOP PROCESS M4161 * 21120000 * ELSE 21130000 * OPERSVE = R4 +1; /* THAT DID NOT CONTAIN PART * 21140000 @9D9 LA @F,1 0259 21150000 AR @F,@4 0259 21160000 ST @F,536(0,@B) 0259 21170000 * /* OF A VARIABLE * 21180000 * SK: R15 = 5; /* LOAD ADDR SKIPB SUBROUTINE * 21190000 @9D8 EQU * 0260 21200000 SK LA @F,5 0260 21210000 * CALL LINKRET; /* GOTO SKIPB TO SKIP OVER 21220000 * SEPARATORS BEFORE RHT PAREN * 21230000 BAL @E,LINKRET 0261 21240000 * GOTO A; /* ON +0 RETURN -E0F- GOTO A * 21250000 BC 15,A 0262 21260000 * 21270000 * /***************************************************************** 21280000 * /* * 21290000 * /* TEST FOR A CLOSING RIGHT PARENTHESIS * 21300000 * /* * 21310000 * /***************************************************************** 21320000 * 21330000 * IF COMBUFB ^= ')' THEN /* ISSUE CLOSING PAREN ASSUMED * 21340000 CLI 0(@5),C')' 0263 21350000 * GOTO A; /* MESSAGE IF NO RIGHT PAREN * 21360000 BC 07,A 0264 21370000 * INVPSAVE = PRMTPTR; /* SAVE PTR TO THE LAST WORD OF 21380000 * OPERAND2 FOR VALIDITY CHECK 21390000 * FAILURE PROMPTING * 21400000 MVC 300(4,@B),584(@B) 0265 21410000 * R4 = R5; /* UPDATE XINPUT TO THE RIGHT 21420000 * PAREN * 21430000 LR @4,@5 0266 21440000 * GOTO B; /* PREPARE TO ADD PDE * 21450000 BC 15,B 0267 21460000 * 21470000 * /***************************************************************** 21480000 * /* * 21490000 * /* THE OPTTERM SECTION OF CODE RECEIVES CONTROL WHEN THE DATA * 21500000 * /* REFERENCED BY THE INPUT LINE POINTER, XINPUT, DOES NOT START * 21510000 * /* WITH A RIGHT PARENTHESIS ON ENTRY, OR AFTER A PROMPT REPLY * 21520000 * /* * 21530000 * /***************************************************************** 21540000 * 21550000 * 21560000 * OPTTERM: /* CHAINED TERM PROCESSING * 21570000 * 21580000 * /***************************************************************** 21590000 * /* * 21600000 * /* DETERMINE IF THE CHAIN OPTION IS CODED ON THE OPER MACRO * 21610000 * /* * 21620000 * /***************************************************************** 21630000 * 21640000 * IF T3PCEIDX = 0 /* IF THE INDEX TO THE CHAINED * 21650000 * THEN /* TERM PCE IS ZERO THEN THE * 21660000 OPTTERM SR @F,@F 0268 21670000 L @1,OPCEPTR 0268 21680000 MVC @TEMP2+2(2),6(@1) 0268 21690000 LH @0,@TEMP2+2 0268 21700000 CR @F,@0 0268 21710000 * DO; /* DATA IN THE INPUT LINE * 21720000 * GOTO I1; /* MUST BE IN PARENTHESIS * 21730000 BC 08,I1 0270 21740000 * END; /* BEFORE IT CAN BE PROCESSED * 21750000 * /* UNDER AN OPER PCE * 21760000 * R6 = PTABLEAD + T3PCEIDX; /* PLACE THE ADDRESS OF THE 21770000 * CHAINED TERM PCE IN XPCE * 21780000 @9D7 L @1,OPCEPTR 0272 21790000 MVC @TEMP2+2(2),6(@1) 0272 21800000 LH @6,@TEMP2+2 0272 21810000 A @6,324(0,@B) 0272 21820000 * CHAINTRM = '1'B; /* TURN ON CHAINED TERM 21830000 * PROCESSING INDICATOR BIT * 21840000 OI 600(@B),B'00010000' 0273 21850000 * CALL IKJEFP60; /* SCAN THE INPUT LINE * 21860000 L @F,@V2 ADDRESS OF IKJEFP60 0274 21870000 BALR @E,@F 0274 21880000 * 21890000 * /***************************************************************** 21900000 * /* * 21910000 * /* RETURN ON +0 IF THE TERM PROCESSOR DID NOT SCAN A VALID TERM -* 21920000 * /* RETURN ON +4 IF A VALID TERM WAS FOUND * 21930000 * /* * 21940000 * /***************************************************************** 21950000 * 21960000 * GEN; 21970000 BC 15,D1 /* TERM +0 RETURN */ 21980000 BC 15,B /* TERM +4 RETURN */ 21990000 DS 0H 22000000 * 22010000 * /***************************************************************** 22020000 * /* * 22030000 * /* THIS SECTION OF CODE RECEIVES CONTROL WHEN THE FIRST CHARACTER* 22040000 * /* OF DATA IS INVALID. * 22050000 * /* * 22060000 * /***************************************************************** 22070000 * 22080000 * 22090000 * I1: 22100000 * IF OPERPRMT = '1'B /* IF THE DATA WAS RETURNED * 22110000 * THEN /* IN THE PROMPT FOR AN * 22120000 I1 TM 599(@B),B'00000010' 0276 22130000 BC 12,@9D6 0276 22140000 * DO; /* EXPRESSION, THE FIRST 22150000 * CHARACTER IS ALWAYS INVALID * 22160000 * INVPSAVE = OPERSVE; /* POINT INVPSAVE TO THE START OF 22170000 * THE INPUT LINE * 22180000 MVC 300(4,@B),536(@B) 0278 22190000 * R4 = R5; /* INCREMENT TO FIRST CHARACTER * 22200000 LR @4,@5 0279 22210000 * R8 = 'FFFF'X; /* NO-OP THE PAREN COUNTER 22220000 * FOR THE END OF DATA SCAN * 22230000 L @8,@X11 0280 22240000 * GOTO A1I; /* GO TO THE SECTION OF CODE 22250000 * WHICH SCANS TO THE END OF THE * 22260000 BC 15,A1I 0281 22270000 * END; /* INVALID DATA --- 22280000 * BEGIN SCAN AFTER FIRST CHAR * 22290000 * 22300000 * D1: 22310000 * R6 = OPERPCE; /* WHEN OPERPRMT IS SET TO ZERO, 22320000 * POINT XPCE AT THE OPER PCE * 22330000 @9D6 EQU * 0283 22340000 D1 L @6,532(0,@B) 0283 22350000 * R15 = 2; /* LOAD THE ADDRESS OF THE 22360000 * PROMPTQ ROUTINE * 22370000 LA @F,2 0284 22380000 * CALL LINKRET; /* PASS CONTROL TO PROMPTQ * 22390000 BAL @E,LINKRET 0285 22400000 * GEN; /* GENERATE PROMPTQ RETURNS * 22410000 BC 15,P50PR /* TEST FOR NEW DATA, +0 RTN */ 22420000 BC 15,EP /* EXIT IF NO NEW DATA, +4 RTN*/ 22430000 DS 0H 22440000 * 22450000 * /***************************************************************** 22460000 * /* * 22470000 * /* BUILD THE PARAMETERS NEEDED BY THE 'MSGSETUP' ROUTINE FOR * 22480000 * /* CONSTRUCTION OF THE SPECIAL MESSAGE. * 22490000 * /* * 22500000 * /***************************************************************** 22510000 * 22520000 * 22530000 * OVCERR: /* HANDLE VALIDITY CHECK ERRORS * 22540000 * RHTPAREN = '1'B; /* TURN ON INDICATOR TO ADD RIGHT 22550000 * PAREN TO PROMPT MSG * 22560000 OVCERR OI 600(@B),B'11100000' 0287 22570000 * LFTPAREN = '1'B; /* ADD LEFT PAREN TO MSG * 22580000 * SPECMSG = '1'B; /* INDICATE MESSAGE TYPE * 22590000 * MSGLEN = OPERSPM1; /* INDICATE TERM1 WORD1 LENGTH * 22600000 MVC 590(2,@B),OPERSPM 0290 22610000 * MSGADDR = OPERSPM2; /* INDICATE TERM1 WORD1 ADDR * 22620000 MVC 592(4,@B),OPERSPM+4 0291 22630000 * R4 = R4 +1; /* INCREMENT PAST RIGHT PAREN * 22640000 AH @4,@D2 0292 22650000 * GOTO WWW; /* SET UP FOR PROMPT * 22660000 BC 15,WWW 0293 22670000 * 22680000 * /***************************************************************** 22690000 * /* * 22700000 * /* SET UP SPECIAL MESSAGE WHEN MISSING OPERAND1 * 22710000 * /* * 22720000 * /***************************************************************** 22730000 * 22740000 * 22750000 * F1: 22760000 * MSGADDR = OPERSVE; /* SET UP PTR TO LEFT PAREN * 22770000 F1 MVC 592(4,@B),536(@B) 0294 22780000 * MSGLEN = 1; /* LEFT PAREN 1 CHAR LONG * 22790000 LA @F,1 0295 22800000 STH @F,590(0,@B) 0295 22810000 * GOTO F2; /* FINISH SET UP OF SPM MSG * 22820000 BC 15,F2 0296 22830000 * 22840000 * OSPMSG: /* SET UP SPECIAL MESSAGE WHEN 22850000 * MISSING RSVWD OR OPERAND2 * 22860000 * LFTPAREN = '1'B; /* INSERT LEFT PAREN BEFORE 22870000 * MSGAREA DATA * 22880000 OSPMSG OI 600(@B),B'01000000' 0297 22890000 * MSGLEN = OPERSPM1; /* MOVE PTRS TO FIRST ELEMENT * 22900000 MVC 590(2,@B),OPERSPM 0298 22910000 * MSGADDR = OPERSPM2; /* OF THE EXPRESSION INTO 22920000 * 'MSGSETUP' COMMUNICATION AREA * 22930000 MVC 592(4,@B),OPERSPM+4 0299 22940000 * 22950000 * F2: 22960000 * SPECMSG = '1'B; /* INDICATE THAT A SPECIAL 22970000 * MESSAGE FORMAT IS BEING USED * 22980000 F2 OI 600(@B),B'10000000' 0300 22990000 * R15 = 5; /* SKIP OVER SEPARATORS * 23000000 LA @F,5 0301 23010000 * CALL LINKRET; /* GOTO PARS1 * 23020000 BAL @E,LINKRET 0302 23030000 * GEN (BC 15,T); /* GOTO T ON END OF INPUT * 23040000 BC 15,T 23050000 DS 0H 23060000 * INVPSAVE = R5; /* SET INVPSAVE = TO START OF 23070000 * INVALID DATA ON +4 RTN * 23080000 ST @5,300(0,@B) 0304 23090000 * R4 = R5; /* SET XINPUT TO FIRST CHAR * 23100000 LR @4,@5 0305 23110000 * R8 = 1; /* INITIALIZE PAREN COUNTER TO 23120000 * ONE ----- SCAN PICKS UP AFTER 23130000 * THE LEFT PAREN * 23140000 LA @8,1 0306 23150000 * 23160000 * /***************************************************************** 23170000 * /* * 23180000 * /* SCAN FOR CLOSING PAREN WHEN AN EXPRESSION IS INVALID * 23190000 * /* * 23200000 * /* THE SCAN LOOP IS EXITED UNDER ONE OF THREE CIRCUMSTANCES: * 23210000 * /* (1) THE SCAN FINDS BALANCED LEFT & RIGHT PARENTHESIS * 23220000 * /* (2) THE SCAN REACHES END OF INPUT * 23230000 * /* (3) A SEMICOLON IS ENCOUNTERED IN THE ORIGINAL INPUT BUFFER * 23240000 * /* * 23250000 * /***************************************************************** 23260000 * 23270000 * 23280000 * R: /* TEST THE CHARACTER POINTED TO 23290000 * BY XINPUT FOR A RIGHT PAREN * 23300000 * IF COMBUF = ')' /* IF THE CHARACTER IN THE * 23310000 * THEN /* COMMAND BUFFER IS A * 23320000 R CLI 0(@4),C')' 0307 23330000 BC 07,@9D5 0307 23340000 * DO; /* RIGHT PAREN THEN * 23350000 * R8 = R8 - 1; /* SUBTRACT ONE FROM THE PAREN 23360000 * COUNT * 23370000 BCTR @8,0 0309 23380000 * 23390000 * /************************************************************* 23400000 * /* * 23410000 * /* TEST THE PAREN COUNT FOR ZERO * 23420000 * /* * 23430000 * /************************************************************* 23440000 * 23450000 * IF R8 > 0 THEN /* A COUNT GREATER THAN ZERO * 23460000 LTR @8,@8 0310 23470000 * DO; /* MEANS THE RIGHT PAREN DOES * 23480000 * GOTO A1I; /* NOT BALANCE THE OPENING * 23490000 BC 03,A1I 0312 23500000 * END; /* LEFT PAREN - REPEAT LOOP * 23510000 * R4 = R4 + 1; /* UP THE INPUT PTR PAST * 23520000 @9D4 AH @4,@D2 0314 23530000 * GOTO WW; /* THE RIGHT PAREN & SET UP * 23540000 BC 15,WW 0315 23550000 * END; /* REMAINING PARAMETERS * 23560000 * 23570000 * /***************************************************************** 23580000 * /* * 23590000 * /* TEST FOR LEFT PARENTHESIS * 23600000 * /* * 23610000 * /***************************************************************** 23620000 * 23630000 * IF COMBUF = '(' /* IF XINPUT POINTS * 23640000 * THEN 23650000 @9D5 CLI 0(@4),C'(' 0317 23660000 BC 07,@9D3 0317 23670000 * R8 = R8 + 1; /* TO A LEFT PAREN ADD 1 TO THE 23680000 * PAREN COUNT * 23690000 AH @8,@D2 0318 23700000 * 23710000 * /***************************************************************** 23720000 * /* * 23730000 * /* IF IN THE ORIGINAL INPUT BUFFER, TREAT A SEMICOLON AS THOUGH * 23740000 * /* IT WERE END OF INPUT * 23750000 * /* * 23760000 * /***************************************************************** 23770000 * 23780000 * IF COMBUF = ';' /* IF A SEMICOLON IS * 23790000 * THEN /* FOUND IN THE * 23800000 @9D3 CLI 0(@4),C';' 0319 23810000 BC 07,@9D2 0319 23820000 * DO; /* INPUT BUFFER, END THE SCAN * 23830000 * 23840000 * /************************************************************* 23850000 * /* * 23860000 * /* TEST FOR A ZERO LENGTH INVALID DATA SEGMENT * 23870000 * /* * 23880000 * /************************************************************* 23890000 * 23900000 * IF INVPSAVE - R4 = 0 23910000 * THEN 23920000 LCR @F,@4 0321 23930000 A @F,300(0,@B) 0321 23940000 CH @F,@D3 0321 23950000 * GOTO T; /* GOTO 'T' IF SEMCOL FIRST CHAR * 23960000 BC 08,T 0322 23970000 * GOTO WW; /* TERMINATE INVALID DATA SCAN * 23980000 BC 15,WW 0323 23990000 * END; 24000000 * 24010000 * A1I: 24020000 * R4 = R4 + 1; /* ADD ONE TO THE INPUT PTR * 24030000 @9D2 EQU * 0325 24040000 A1I AH @4,@D2 0325 24050000 * IF R4 ^< ENDINPUT THEN /* TERMINATE SCAN IF AT * 24060000 C @4,144(0,@B) 0326 24070000 * GOTO WW; /* ENDINPUT, ELSE... * 24080000 BC 10,WW 0327 24090000 * GOTO R; /* CONTINUE THE PAREN SCAN * 24100000 BC 15,R 0328 24110000 * 24120000 * T: /* SET UP ZERO LENGTH INVALID 24130000 * DATA MESSAGE SEGMENT * 24140000 * BLNKFLAG = '1'B; /* SIGNAL MSGSETUP THAT XINPUTB * 24150000 T OI 601(@B),B'00100000' 0329 24160000 * /* IS OUT OF BUFFER ON PURPOSE * 24170000 * INVPSAVE = ADDR(BLNK); /* FOR THE INVALID DATA PORTION * 24180000 LA @F,BLNK 0330 24190000 ST @F,300(0,@B) 0330 24200000 * R5 = ADDR(BLNK) +1; /* OF THE MESSAGE - SET UP THE * 24210000 LA @5,BLNK+1 0331 24220000 * GOTO W; /* REMAING PARAMETERS FOR THE * 24230000 BC 15,W 0332 24240000 * /* MSGSETUP RTN AT W * 24250000 * 24260000 * /***************************************************************** 24270000 * /* * 24280000 * /* PROMPT WITH THE INVALID DATA * 24290000 * /* * 24300000 * /***************************************************************** 24310000 * 24320000 * 24330000 * WW: 24340000 * R5 = R4; /* SET UP XINPUTB TO POINT AT * 24350000 WW LR @5,@4 0333 24360000 * /* THE END OF THE INVALID DATA * 24370000 * 24380000 * W: 24390000 * R6 = OPERPCE; /* RESTORE THE PCE PTR TO THE 24400000 * IKJOPER PCE * 24410000 W L @6,532(0,@B) 0334 24420000 * 24430000 * WWW: 24440000 * PPCOUNT = 7; /* SET PPCOUNT TO THE LENGTH OF 24450000 * THE OPER PDE -1 * 24460000 WWW MVI 417(@B),7 0335 24470000 * CBLNKSV2 = ADDR(P50PR); /* PLACE THE RETURN ADDRESS IN 24480000 * CBLNKSV2 * 24490000 LA @F,P50PR 0336 24500000 ST @F,552(0,@B) 0336 24510000 * CALL MSGSETUP; /* GOTO MSGSETUP TO FORMAT THE 24520000 * SPECIAL MESSAGE PROMPT - 24530000 * RETURN AFTER THE USER REPLIES 24540000 * TO A PROMPT * 24550000 BAL @E,MSGSETUP 0337 24560000 * 24570000 * /***************************************************************** 24580000 * /* * 24590000 * /* RECEIVE CONTROL AFTER A PROMPT FOR AN EXPRESSION * 24600000 * /* * 24610000 * /***************************************************************** 24620000 * 24630000 * 24640000 * P50PR: /* RETURN FROM PROMPT * 24650000 * 24660000 * /***************************************************************** 24670000 * /* * 24680000 * /* PFNULL IS OFF IF DATA WAS RETURNED FROM THE PROMPT * 24690000 * /* * 24700000 * /***************************************************************** 24710000 * 24720000 * IF PFNULL = '1'B THEN /* GOTO EXIT PROCESSING IF * 24730000 P50PR TM 178(@B),B'00001000' 0338 24740000 BC 12,@9D1 0338 24750000 * DO; /* THERE IS * 24760000 * PFNULL = '0'B; /* NO PROMPT DATA RETURNED - * 24770000 NI 178(@B),B'11110111' 0340 24780000 * GOTO EP; /* ELSE - * 24790000 BC 15,EP 0341 24800000 * END; 24810000 * OPERPRMT = '1'B; /* ------ GOTO PROCESS THE * 24820000 @9D1 OI 599(@B),B'00000010' 0343 24830000 * GOTO PR; /* PROMPT RETURN * 24840000 BC 15,PR 0344 24850000 * 24860000 * A: 24870000 * CBLNKSV1 = ADDR(B); /* PLACE RETURN ADDRESS IN 24880000 * CBLNKSV1 * 24890000 A LA @F,B 0345 24900000 ST @F,548(0,@B) 0345 24910000 * PPOINTR = PRMTPTR+1; /* SET UP PTR TO LAST WORD OF THE 24920000 * SECOND OPERAND * 24930000 LA @F,1 0346 24940000 A @F,584(0,@B) 0346 24950000 ST @F,148(0,@B) 0346 24960000 * R5 = OPERSVE; /* SET PTR TO END OF LAST WORD * 24970000 L @5,536(0,@B) 0347 24980000 * R15 = 10; /* LOAD ADDR PSTRIMSG ROUTINE * 24990000 LA @F,10 0348 25000000 * CALL LINKRET; /* GIVE CONTROL TO PSTRIMSG RTN 25010000 * TO WRITE OUT THE CLOSING PAREN 25020000 * ASSUMED MESSAGE * 25030000 BAL @E,LINKRET 0349 25040000 * 25050000 * B: /* FILL IN OPER TEMPORARY PDE * 25060000 * ORFND = '1'B; /* TURN ON BIT IN THE TEMP PDE TO 25070000 * INDICATE THAT THE DATA 25080000 * DESCRIBED UNDER THE OPER PCE 25090000 * WAS FOUND * 25100000 B OI 338(@B),B'10000000' 0350 25110000 * R6 = OPERPCE; /* RESTORE XPCE TO OPER PCE * 25120000 L @6,532(0,@B) 0351 25130000 * CHAINTRM = '0'B; /* BIT INDICATING CHAIN TERM 25140000 * PROCESSING MUST BE ZERO BEFORE 25150000 * THE END OF OPER PROCESSING * 25160000 NI 600(@B),B'11101111' 0352 25170000 * RESPECIFY 25180000 * (R1)RESTRICTED; /* RESTRICT PTRS FOR USE BY 25190000 * SUBROUTINE 'POSITXCB' * 25200000 * R1 = 7; /* PLACE LENGTH OF PDE -1 IN 25210000 * COMMUNICATION REG FOR POSITXCB 25220000 * RTN * 25230000 LA @1,7 0354 25240000 * PLINKSV2 = ADDR(OVCERR); /* OVCERR WILL RECEIVE CONTROL IF 25250000 * THE VALIDITY CHECK ROUTINE 25260000 * REJECTS THE EXPRESSION * 25270000 LA @F,OVCERR 0355 25280000 ST @F,672(0,@B) 0355 25290000 * R15 = 3; /* PLACE PTR TO SUBROUTINE 25300000 * POSITXCB IN LINKAGE REG * 25310000 LA @F,3 0356 25320000 * CALL LINKRET; /* PASS CONTROL TO POSITXCB * 25330000 BAL @E,LINKRET 0357 25340000 * RESPECIFY 25350000 * (R1) UNRESTRICTED; /* PTR NO LONGER REQUIRED * 25360000 * 25370000 * /***************************************************************** 25380000 * /* * 25390000 * /* THE FOLLOWING SECTION PERFORMS NORMAL EXIT PROCESSING * 25400000 * /* * 25410000 * /***************************************************************** 25420000 * 25430000 * 25440000 * EP: /* SET PTRS FOR NORMAL EXIT * 25450000 * R6 = OPEREND; /* PLACE THE ADDRESS OF THE LAST 25460000 * MINOR TERM PCE IN XPCE * 25470000 EP L @6,520(0,@B) 0359 25480000 * OPERMODE = '0'B; /* TURN OFF OPER MODE INDICATOR * 25490000 NI 599(@B),B'10111111' 0360 25500000 * GOTO RTNNSKP3; /* UPDATE TO NEXT PCE * 25510000 BC 15,RTNNSKP3 0361 25520000 * 25530000 * /***************************************************************** 25540000 * /* * 25550000 * /* INITIATE IKJRSVWD MACRO PROCESSING * 25560000 * /* * 25570000 * /***************************************************************** 25580000 * 25590000 * 25600000 * IKJEFP40: /* ENTRY POINT RSVWD PROCESSOR * 25610000 * PROC OPTIONS(NOSAVEAREA, /* IKJEFP40 * 25620000 * DONTSAVE); /* NO STANDARD LINKAGE * 25630000 @EL04 BCR 15,@E 0362 25640000 * RESPECIFY 25650000 * (R6, 25660000 * R4, 25670000 * R8, 25680000 * R5) RESTRICTED; /* SAVE PTRS * 25690000 * RESPECIFY 25700000 * (PWAREG, 25710000 * R1) RESTRICTED; /* SAVE PTRS * 25720000 * RSVDRTN = R14; /* SAVE RETURN ADDR * 25730000 IKJEFP40 ST @E,RSVDRTN 0365 25740000 * RSVWDSV2 = R6; /* SAVE PCE POINTER * 25750000 ST @6,544(0,@B) 0366 25760000 * RSVDPRMT = '0'B; /* ZERO RSVD PROMPT BIT * 25770000 NI 599(@B),B'11111011' 0367 25780000 * 25790000 * /***************************************************************** 25800000 * /* * 25810000 * /* IF XPCE POINTS TO A TERM PCE CALCULATE THE RSVWD PCE ADR * 25820000 * /* * 25830000 * /***************************************************************** 25840000 * 25850000 * IF TERPCE = '110'B THEN /* IF XPCE POINTS TO A TERM * 25860000 TM 0(@6),B'11000000' 0368 25870000 BC 12,@9D0 0367 25880000 TM 0(@6),B'00100000' 0368 25890000 BC 05,@9CF 0368 25900000 * GOTO RCT; /* PCE ON ENTRY, * 25910000 BC 15,RCT 0369 25920000 * /* GOTO RCT AND UPDATE THE PCE 25930000 * PTR TO THE CHAINED IKJRSVWD 25940000 * PCE * 25950000 * 25960000 * /***************************************************************** 25970000 * /* * 25980000 * /* CALL CLEANUP IF XPCE DOES NOT POINT TO A RSVWD PCE OR A TERM * 25990000 * /* PCE * 26000000 * /* * 26010000 * /***************************************************************** 26020000 * 26030000 * IF RSVWMASK ^= '101'B THEN /* IF XPCE DOES NOT POINT TO * 26040000 @9CF EQU * 0370 26050000 @9D0 TM 0(@6),B'10100000' 0370 26060000 BC 12,@9CE 0369 26070000 TM 0(@6),B'01000000' 0370 26080000 BC 08,@9CD 0370 26090000 * GOTO RTNCLNUP; /* A RSVD PCE OR A TERM PCE ON 26100000 * ENTRY, TERMINATE SCAN. GOTO 26110000 * CLEANUP WITH THE RETURN CODE 26120000 * IN RETCODE. * 26130000 BC 15,RTNCLNUP 0371 26140000 * 26150000 * /***************************************************************** 26160000 * /* * 26170000 * /* SKIP OVER RSVWD PCE, IF IT DESCRIBES A FIGURATIVE CONSTANT * 26180000 * /* * 26190000 * 26200000 * IF RFCONST = '1'B THEN /* IF THE RFCONST BIT IS ON, * 26210000 @9CD TM 1(@6),B'10000000' 0372 26220000 * GOTO RTNNSKP3; /* UPDATE THE PCE POINTR * 26230000 BC 01,RTNNSKP3 0373 26240000 * /* TO THE NEXT PCE. ROUTINE * 26250000 * /* NAMESKP3 PERFORMS * 26260000 * /* THIS FUNCTION AND THEN GIVES * 26270000 * /* CONTROL TO THE APPROPRIATE * 26280000 * /* PCE PROCESSOR. * 26290000 * COBOLMOD = '1'B; /* INDICATE COBOL MODE * 26300000 OI 599(@B),B'10000000' 0374 26310000 * GOTO EE; /* INITIATE SCAN OF RSVWD * 26320000 BC 15,EE 0375 26330000 * 26340000 * RCT: 26350000 * R6 = ADDR(RSVWDSV2 -> TPTSL) /* UPDATE XPCE PAST THE TERM * 26360000 * + RSVWDSV2 -> TPTSL; /* PCE'S FIRST VARIABLE LENGTH 26370000 * FIELD TO BASE DSECT * 26380000 RCT L @7,544(0,@B) 0376 26390000 MVC @TEMP2+2(2),7(@7) 0376 26400000 LH @F,@TEMP2+2 0376 26410000 LA @0,7(0,@7) 0376 26420000 AR @F,@0 0376 26430000 LR @6,@F 0376 26440000 * IF RSVWDSV2 -> PROMPT = '1'B /* IF PROMPT DATA PRESENT * 26450000 * | /* OR * 26460000 * RSVWDSV2 -> DEFAULT = '1'B /* IF DEFAULT DATA PRESENT * 26470000 * THEN /* THEN * 26480000 TM 0(@7),B'00010000' 0377 26490000 BC 01,@9CC 0377 26500000 TM 0(@7),B'00001000' 0377 26510000 BC 12,@9CB 0377 26520000 * R8 = ADDR(TPODL) + TPODL + 2; /* SET UP DSECT BASE FOR NEXT 26530000 * FIELD IN TERM PCE * 26540000 @9CC LA @F,2 0378 26550000 SR @0,@0 0378 26560000 IC @0,0(0,@6) 0378 26570000 AR @F,@0 0378 26580000 AR @F,@6 0378 26590000 LR @8,@F 0378 26600000 BC 15,@9CA 0379 26610000 * ELSE /* ELSE * 26620000 * R8 = R6; /* XPCE IS ALREADY POSITIONED * 26630000 @9CB LR @8,@6 0379 26640000 * IF RSVWDSV2 -> SUBSCRP = '1'B /* IF SUBSCRPTS ALLOWED * 26650000 * THEN /* THEN * 26660000 @9CA L @7,544(0,@B) 0380 26670000 TM 1(@7),B'00010000' 0380 26680000 BC 12,@9C9 0380 26690000 * R8 = R8 + 2; /* INCREMENT PAST SUBSC. OFFSET * 26700000 AH @8,@D4 0381 26710000 * R6 = PTABLEAD + R8 -> RSVWDIDX; /* XPCE = RSVWD PCE ADDR * 26720000 @9C9 MVC @TEMP2+2(2),0(@8) 0382 26730000 LH @F,@TEMP2+2 0382 26740000 A @F,324(0,@B) 0382 26750000 LR @6,@F 0382 26760000 * 26770000 * /***************************************************************** 26780000 * /* * 26790000 * /* CALL CLEANUP IF THE CHAINED PCE IS NOT A RSVWD PCE * 26800000 * /* * 26810000 * /***************************************************************** 26820000 * 26830000 * IF RSVWMASK ^= '101'B THEN /* RETURN CODE IN RETCODE * 26840000 TM 0(@6),B'10100000' 0383 26850000 BC 12,@9C8 0382 26860000 TM 0(@6),B'01000000' 0383 26870000 BC 08,@9C7 0383 26880000 * GOTO RTNCLNUP; /* IS RETURNED TO THE CP IF NO 26890000 * CHAINED RSVWD PCE * 26900000 BC 15,RTNCLNUP 0384 26910000 * 26920000 * /***************************************************************** 26930000 * /* * 26940000 * /* CALL CLEANUP IF THE CHAINED RSVWD PCE DOES NOT HAVE THE * 26950000 * /* FIGURATIME CONSTANT INDICATOR BIT ON * 26960000 * /* * 26970000 * /***************************************************************** 26980000 * IF RFCONST = '0'B THEN /* TERMINATE SCAN IF NOT AN * 26990000 @9C7 TM 1(@6),B'10000000' 0385 27000000 * GOTO RTNCLNUP; /* RFCONST RSVWD PCE * 27010000 BC 08,RTNCLNUP 0386 27020000 * RSVWDSV1 = R4; /* SAVE POINTER TO START OF DATA * 27030000 ST @4,540(0,@B) 0387 27040000 * EE: 27050000 * RSVWDPCE = R6; /* SAVE RSVWD PCE ADDRESS * 27060000 EE ST @6,524(0,@B) 0388 27070000 * R15 = 5; /* PLACE THE ADDRESS OF THE SKIPB 27080000 * ROUTINE IN LINKB * 27090000 LA @F,5 0389 27100000 * CALL LINKRET; /* GOTO SKIPB ROUTINE * 27110000 BAL @E,LINKRET 0390 27120000 * GOTO A1; /* ON +0 RETURN - PROMPT * 27130000 BC 15,A1 0391 27140000 * /* ON +4 RETURN INITIATE SCAN * 27150000 * RESPECIFY 27160000 * (R8, 27170000 * R1) RESTRICTED; /* SET UP TEMP AREAS * 27180000 * 27190000 * E: 27200000 * R8 = 0; /* ZERO LENGTH COUNTER * 27210000 E SR @8,@8 0393 27220000 * RSVWDSV1 = R4; /* SAVE PTR TO START OF DATA * 27230000 ST @4,540(0,@B) 0394 27240000 * R1 = '08'X; /* SET UP TYPE TEST MASK FOR 27250000 * SEPARATOR CHARACTERS * 27260000 LA @1,X'08' 0395 27270000 * 27280000 * /***************************************************************** 27290000 * /* * 27300000 * /* INITIATE SCAN FOR RSVWD LENGTH * 27310000 * /* * 27320000 * /***************************************************************** 27330000 * 27340000 * 27350000 * SL: 27360000 * R4 = R4 + 1; /* INCREMENT INPUT POINTER * 27370000 SL AH @4,@D2 0396 27380000 * 27390000 * /***************************************************************** 27400000 * /* * 27410000 * /* EXIT LOOP IF END OF INPUT IS REACHED * 27420000 * /* * 27430000 * /***************************************************************** 27440000 * 27450000 * IF R4 ^< ENDINPUT THEN /* IF THE END OF INPUT IS * 27460000 C @4,144(0,@B) 0397 27470000 * GOTO F; /* REACHED, I EQUALS RSVWD LENGTH* 27480000 BC 10,F 0398 27490000 * R15 = 8; /* PLACE ADDR OF TYPETEST ROUTINE 27500000 * IN LINKB * 27510000 LA @F,8 0399 27520000 * 27530000 * /***************************************************************** 27540000 * /* * 27550000 * /* EXIT THE LOOP IF XINPUT POINTS TO A BLANK, COMMA OR TAB * 27560000 * /* * 27570000 * /***************************************************************** 27580000 * 27590000 * CALL LINKRET; /* CALL TYPETEST ROUTINE * 27600000 BAL @E,LINKRET 0400 27610000 * GEN; /* GENERATE TYPETEST RETURNS * 27620000 BC 15,RPTEST /* +0 RETURN - CONTINUE SCAN */ 27630000 BC 15,OMODCK /* +4 RETURN - EXIT LOOP */ 27640000 DS 0H 27650000 * 27660000 * /***************************************************************** 27670000 * /* * 27680000 * /* TERMINATE SCAN IF A RIGHT PAREN IS FOUND WHEN NOT ALLOWED * 27690000 * /* * 27700000 * /***************************************************************** 27710000 * 27720000 * 27730000 * RPTEST: 27740000 * IF COMBUF = ')' /* A RIGHT PAREN TERMINATES * 27750000 * THEN 27760000 RPTEST CLI 0(@4),C')' 0402 27770000 BC 07,@9C6 0402 27780000 * DO; /* THE RSVWD SCAN * 27790000 * IF OPERMODE = '1'B THEN /* WHEN PROCESSING EITHER * 27800000 TM 599(@B),B'01000000' 0404 27810000 * GOTO OMODCK2; /* AN EXPRESSION, * 27820000 BC 01,OMODCK2 0405 27830000 * IF SUBSMODE = '1'B | /* OR A FIGURATIVE * 27840000 * PFLIST = '1'B THEN /* CONST WITHIN * 27850000 TM 599(@B),B'00100000' 0406 27860000 BC 01,@9C5 0406 27870000 TM 176(@B),B'10000000' 0406 27880000 BC 12,@9C4 0406 27890000 * GOTO F; /* A LIST OR * 27900000 BC 03,F 0407 27910000 * END; /* SUBSCRIPT * 27920000 @9C4 EQU * 0408 27930000 * 27940000 * /***************************************************************** 27950000 * /* * 27960000 * /* WHEN PROCESSING A MEMBER OF A RANGE, A COLON DELIMITS * 27970000 * /* THE SCAN FOR A FIGURATIVE CONSTANT * 27980000 * /* * 27990000 * /***************************************************************** 28000000 * 28010000 * IF COMBUF = ':' & /* A RANGE CAN ONLY BE * 28020000 * RSVWDPCE -> RFCONST = '1'B & /* ENTERED UNDER A TERM PCE * 28030000 * RSVWDSV2 -> RANG = '1'B THEN /* THAT IS NOT UNDER AN * 28040000 @9C6 CLI 0(@4),C':' 0409 28050000 BC 07,@9C3 0409 28060000 L @7,524(0,@B) 0409 28070000 TM 1(@7),B'10000000' 0409 28080000 BC 12,@9C2 0409 28090000 L @9,544(0,@B) 0409 28100000 TM 1(@9),B'00100000' 0409 28110000 * GOTO F; /* OPER PCE * 28120000 BC 03,F 0410 28130000 * 28140000 * /***************************************************************** 28150000 * /* * 28160000 * /* TEST FOR A SEMICOLON * 28170000 * /* * 28180000 * /***************************************************************** 28190000 * 28200000 * IF COMBUF = ';' /* END THE SCAN IF A SEMICOLON * 28210000 * THEN 28220000 @9C1 EQU * 0411 28230000 @9C2 EQU * 0411 28240000 @9C3 EQU * 0411 28250000 CLI 0(@4),C';' 0411 28260000 BC 07,@9C0 0411 28270000 * DO; /* IS ENCOUNTERED IN THE * 28280000 * IF RSVDPRMT = '0'B THEN /* INITIAL INPUT BUFFER... * 28290000 TM 599(@B),B'00000100' 0413 28300000 * GOTO F; /* END THE SCAN IF A SEMICOLON * 28310000 BC 08,F 0414 28320000 * IF OPERMODE = '0'B & /* IS ENCOUNTERED IN A NON OPER * 28330000 * R8 ^= 0 THEN /* MODE PROMPT REPLY ON OTHER * 28340000 TM 599(@B),B'01000000' 0415 28350000 BC 05,@9BF 0415 28360000 LTR @8,@8 0415 28370000 * GOTO F2R; /* THE FIRST CHARACTER * 28380000 BC 07,F2R 0416 28390000 * END; 28400000 @9BE EQU * 0417 28410000 @9BF EQU * 0417 28420000 * 28430000 * AI1: 28440000 * R8 = R8 + 1; /* UP THE LENGTH COUNTER AND * 28450000 @9C0 EQU * 0418 28460000 AI1 AH @8,@D2 0418 28470000 * GOTO SL; /* RETURN TO THE ENTRY POINT * 28480000 BC 15,SL 0419 28490000 * 28500000 * /***************************************************************** 28510000 * /* * 28520000 * /* *************END OF LENGTH SCAN LOOP********************** * 28530000 * /* CHECK FOR ZERO LENGTH RSVWD * 28540000 * /* * 28550000 * /***************************************************************** 28560000 * 28570000 * 28580000 * F: 28590000 * IF R8 = 0 /* WAS THE FIRST CHAR OF * 28600000 * THEN /* THE RSVWD A * 28610000 F LTR @8,@8 0420 28620000 BC 07,@9BD 0420 28630000 * DO; /* DELIMITER * 28640000 * 28650000 * /************************************************************* 28660000 * /* * 28670000 * /* PROMPT FOR MISSING IF NOT RETURNED FROM RSVWD PROMPT * 28680000 * /* * 28690000 * /************************************************************* 28700000 * 28710000 * IF RSVDPRMT = '1'B /* DATA RETURNED IN A PROMPT * 28720000 * THEN /* FOR A RSVWD IS INVALID * 28730000 TM 599(@B),B'00000100' 0422 28740000 BC 12,@9BC 0422 28750000 * DO; /* UNLESS THERE IS A NAME MATCH * 28760000 * 28770000 * /********************************************************* 28780000 * /* * 28790000 * /* REJECT ENTIRE BUFFER IF RETURNED FROM PROMPT IN OPER * 28800000 * /* MODE * 28810000 * /* * 28820000 * /********************************************************* 28830000 * 28840000 * IF OPERMODE = '1'B THEN /* PROMPT WITH THE ENTIRE * 28850000 TM 599(@B),B'01000000' 0424 28860000 * GOTO IPA; /* BUFFER WHEN IN OPER MODE --- * 28870000 BC 01,IPA 0425 28880000 * GOTO A1I; /* ELSE, PROMPT WITH DATA UP TO * 28890000 BC 15,A1I 0426 28900000 * END; /* FIRST VALID DELIMITER, * 28910000 * /* WHEN NO MATCH CAN * 28920000 * /* BE FOUND * 28930000 * R4 = R4 -1; /* DECREMENT XINPUT FOR NEXT * 28940000 @9BC BCTR @4,0 0428 28950000 * GOTO A1; /* ROUTINES SKIPB CALL AND * 28960000 BC 15,A1 0429 28970000 * END; /* ASSUME RSVWD IS MISSING * 28980000 * 28990000 * /***************************************************************** 29000000 * /* * 29010000 * /* WAS THE MAXIMUM LENGTH EXCEEDED IN THE SCAN * 29020000 * /* * 29030000 * /***************************************************************** 29040000 * 29050000 * F2R: 29060000 * IF R8 > 256 THEN /* ASSUME NAME DOESN'T MATCH * 29070000 @9BD EQU * 0431 29080000 F2R CH @8,@D5 0431 29090000 * GOTO NOMATCH2; /* IF MAX LENGTH EXCEEDED * 29100000 BC 02,NOMATCH2 0432 29110000 * PLENGTH = R8; /* PLENGTH = RSVWD LENGTH * 29120000 STH @8,152(0,@B) 0433 29130000 * 29140000 * /***************************************************************** 29150000 * /* * 29160000 * /* DATA CAN'T BE TRANSLATED TO UPPER CASE IN THE COMMAND BUFFER * 29170000 * /* BEFORE AN IKJNAME MATCH IS FOUND * 29180000 * /* * 29190000 * /***************************************************************** 29200000 * 29210000 * R1 =R8; /* PASS NUMBER OF BYTES NEEDED IN 29220000 * R1 * 29230000 LR @1,@8 0434 29240000 * R15 = 14; /* LOAD ADR GETCORE ROUTINE * 29250000 LA @F,14 0435 29260000 * CALL LINKRET; /* OBTAIN WORK AREA FOR RSVWD'S * 29270000 BAL @E,LINKRET 0436 29280000 * /* TRANSLATION TO UPPER CASE * 29290000 * PPOINTR = R1; /* PLACE ADDR OF WORK AREA IN 29300000 * PPOINTR * 29310000 ST @1,148(0,@B) 0437 29320000 * R1 -> COMBUFP(1:R8) = COMBUFBV(1:R8);/* 29330000 * COPY RSVWD * 29340000 LR @E,@5 0438 29350000 LR @7,@8 0438 29360000 BCTR @7,0 0438 29370000 LR @A,@1 0438 29380000 EX @7,@MVC 0438 29390000 * 29400000 * RTQ: 29410000 * R15 = 9; /* PLACE ADDR TRANSQ ROUTINE * 29420000 RTQ LA @F,9 0439 29430000 * CALL LINKRET; /* IN LINKB AND CALL TRANSQ * 29440000 BAL @E,LINKRET 0440 29450000 * R5 = PPOINTR; /* POINT XINPUTB TO THE UPPER 29460000 * CASE COPY OF THE RSVWD * 29470000 L @5,148(0,@B) 0441 29480000 * PPOINTR = RSVWDSV1 + 1; /* RESTORE PPOINTR TO ADDR OF 29490000 * FIRST CHAR OF RSVWD * 29500000 LA @F,1 0442 29510000 A @F,540(0,@B) 0442 29520000 ST @F,148(0,@B) 0442 29530000 * R4 = R8 + PPOINTR; /* POINT XINPUT PAST THE RSVWD * 29540000 L @4,148(0,@B) 0443 29550000 AR @4,@8 0443 29560000 * RESPECIFY 29570000 * (R9) RESTRICTED; /* SAVE IKJNAME COUNTER * 29580000 * R9 = 0; /* SET COUNTER TO ZERO * 29590000 SR @9,@9 0445 29600000 * 29610000 * /***************************************************************** 29620000 * /* * 29630000 * /* THIS LOOP COMPARES THE RSVWD IN THE BUFFER TO THE NAMES IN THE* 29640000 * /* IKJNAME PCE'S * 29650000 * /* * 29660000 * /***************************************************************** 29670000 * 29680000 * 29690000 * NAMECK: 29700000 * R6 = R6 + NPCELNTH; /* UPDATE XPCE TO NEXT PCE * 29710000 NAMECK MVC @TEMP2+2(2),2(@6) 0446 29720000 AH @6,@TEMP2+2 0446 29730000 * R9 = R9 + 1; /* UPDATE IKJNAME # COUNTER * 29740000 AH @9,@D2 0447 29750000 * 29760000 * /***************************************************************** 29770000 * /* * 29780000 * /* EXIT WHEN ALL THE NAMES HAVE BEEN EXHAUSTED * 29790000 * /* * 29800000 * /***************************************************************** 29810000 * 29820000 * IF NPCEMASK ^= '011'B THEN /* GOTO NOMATCH WHEN XPCE NO * 29830000 TM 0(@6),B'01100000' 0448 29840000 BC 12,@9BB 0447 29850000 TM 0(@6),B'10000000' 0448 29860000 BC 08,@9BA 0448 29870000 * GOTO NOMATCH; /* LONGER POINTS TO A NAME PCE * 29880000 BC 07,NOMATCH 0449 29890000 * 29900000 * /***************************************************************** 29910000 * /* * 29920000 * /* REPEAT LOOP IF NAME AND RSVWD LENGTHS DO NOT MATCH * 29930000 * /* * 29940000 * /***************************************************************** 29950000 * 29960000 * IF R8 ^= NAMELM1 +1 THEN /* COMPARE RSVWD LENGTH TO * 29970000 @9BA LA @F,1 0450 29980000 SR @0,@0 0450 29990000 IC @0,4(0,@6) 0450 30000000 AR @F,@0 0450 30010000 CR @F,@8 0450 30020000 * GOTO NAMECK; /* NAME LENGTH * 30030000 BC 07,NAMECK 0451 30040000 * 30050000 * /***************************************************************** 30060000 * /* * 30070000 * /* REPEAT LOOP IF NAME AND UPPER CASE RSVWD DO NOT MATCH * 30080000 * /* * 30090000 * /***************************************************************** 30100000 * 30110000 * IF R5 -> COMBUFBV(1:R8) ^= NAMEDATA(1:R8) THEN /* COMPARE 30120000 * RSVWD TO * 30130000 LA @E,5(0,@6) 0452 30140000 LR @7,@8 0452 30150000 BCTR @7,0 0452 30160000 LR @A,@5 0452 30170000 EX @7,@CLC 0452 30180000 * GOTO NAMECK; /* THE NAME * 30190000 BC 07,NAMECK 0453 30200000 * 30210000 * /***************************************************************** 30220000 * /* * 30230000 * /* *********END OF NAME COMPARE LOOP************************* * 30240000 * /* FREE CORE FOR UPPER CASE RSVWD COPY * 30250000 * /* * 30260000 * /***************************************************************** 30270000 * 30280000 * CALL FREECORE; /* FREE RSVWD COPY AREA * 30290000 L @F,@V4 ADDRESS OF FREECORE 0454 30300000 BALR @E,@F 0454 30310000 * 30320000 * /***************************************************************** 30330000 * /* * 30340000 * /* RETURN TO IKJEFP60 IF A FIGURATIVE CONSTANT IS FOUND * 30350000 * /* * 30360000 * /***************************************************************** 30370000 * 30380000 * IF RSVWDPCE -> RFCONST = '1'B /* THE RFCONST SWITCH IS ON * 30390000 * THEN /* ONLY IN A TERM CHAINED * 30400000 L @7,524(0,@B) 0455 30410000 TM 1(@7),B'10000000' 0455 30420000 BC 12,@9B9 0455 30430000 * DO; /* RSVWD PCE. * 30440000 * PDEPTR -> RESWDNUM = R9; /* PLACE NAME # IN TEMP PDE * 30450000 L @7,564(0,@B) 0457 30460000 STH @9,4(0,@7) 0457 30470000 * GOTO RTN4; /* RETURN ON LINK REG +4 WHEN * 30480000 BC 15,RTN4 0458 30490000 * END; /* MATCH FOUND. * 30500000 * R4 = R4 -1; /* DECREMENT FOR NEXT SUBRTN * 30510000 @9B9 BCTR @4,0 0460 30520000 * R6 = RSVWDPCE; /* PLACE PTR TO RSVWD PCE IN XPCE* 30530000 L @6,524(0,@B) 0461 30540000 * 30550000 * /***************************************************************** 30560000 * /* * 30570000 * /* FILL IN TEMPORARY RSVWD PDE * 30580000 * /* * 30590000 * /***************************************************************** 30600000 * 30610000 * RNAMENUM = R9; /* PLACE IKJNAME NUMBER IN 30620000 * TEMPORARY PDE * 30630000 ST @9,@TEMP4 0462 30640000 MVC 334(2,@B),@TEMP4+2 0462 30650000 * ORFND = '1'B; /* INDICATE THAT MATCH WAS FOUND * 30660000 OI 338(@B),B'10000000' 0463 30670000 * R5 = R4; /* UPDATE XINPUTB PAST RSVWD * 30680000 LR @5,@4 0464 30690000 * INVPSAVE = PPOINTR; /* INVPSAVE = FIRST CHAR RSVWD * 30700000 MVC 300(4,@B),148(@B) 0465 30710000 * R1 = 7; /* R1 = PDELENGTH -1 * 30720000 LA @1,7 0466 30730000 * R15 = 3; /* LOAD ADDR POSITXCB ROUTINE * 30740000 LA @F,3 0467 30750000 * CALL LINKRET; /* GOTO ADD PERMANENT PDE VIA 30760000 * POSITXCB ROUTINE * 30770000 BAL @E,LINKRET 0468 30780000 * 30790000 * /***************************************************************** 30800000 * /* * 30810000 * /* DETERMINE IDENTITY OF CALLING ROUTINE WHEN NOT IKJEFP60 * 30820000 * /* * 30830000 * /***************************************************************** 30840000 * 30850000 * IF OPERMODE = '0'B THEN /* GOTO NAMESKP3 IF CALLER * 30860000 TM 599(@B),B'01000000' 0469 30870000 * GOTO RTNNSKP3; /* IS NOT IKJOPER PROCESSOR * 30880000 BC 08,RTNNSKP3 0470 30890000 * GOTO RTN4; /* RETURN TO IKJOPER PROCESSOR * 30900000 BC 15,RTN4 0471 30910000 * 30920000 * /***************************************************************** 30930000 * /* * 30940000 * /* RECEIVE CONTROL WHEN NO MATCH IS FOUND * 30950000 * /* * 30960000 * /***************************************************************** 30970000 * 30980000 * 30990000 * NOMATCH: 31000000 * CALL FREECORE; /* FREE CORE USED FOR UPPER * 31010000 NOMATCH L @F,@V4 ADDRESS OF FREECORE 0472 31020000 BALR @E,@F 0472 31030000 * /* CASE RSVWD COPY * 31040000 * 31050000 * /***************************************************************** 31060000 * /* * 31070000 * /* SET UP PROMPT MESSAGE UNLESS A FIGURATIME CONSTANT IS BEING * 31080000 * /* PROCESSED UNDER A TERM PCE * 31090000 * /* * 31100000 * /***************************************************************** 31110000 * 31120000 * 31130000 * NOMATCH2: 31140000 * IF RSVWDPCE -> RFCONST = '1'B THEN /* RETURN TO IKJEFP50 IF * 31150000 NOMATCH2 L @7,524(0,@B) 0473 31160000 TM 1(@7),B'10000000' 0473 31170000 * GOTO RTN0; /* RFCONST BIT IS ON * 31180000 BC 01,RTN0 0474 31190000 * 31200000 * /***************************************************************** 31210000 * /* * 31220000 * /* DETERMINE IF RSVWD IS INVALID WHEN NO MATCH IS FOUND * 31230000 * /* * 31240000 * /***************************************************************** 31250000 * 31260000 * IF RSVDPRMT = '1'B | /* RSVWD IS INVALID IF * 31270000 * OPERMODE = '1'B | /* IT IS A RSVWD PROMPT * 31280000 * RSVWDPCE -> RPRMTI = '1'B | /* REPLY, IF IN OPER MODE, * 31290000 * RSVWDPCE -> RDFLTI = '1'B THEN /* OR IF PROMPT-DEFAULT * 31300000 TM 599(@B),B'00000100' 0475 31310000 BC 01,@9B8 0475 31320000 TM 599(@B),B'01000000' 0475 31330000 BC 01,@9B7 0475 31340000 TM 0(@7),B'00010000' 0475 31350000 BC 01,@9B6 0475 31360000 TM 0(@7),B'00001000' 0475 31370000 BC 12,@9B5 0475 31380000 * GOTO IP; /* DATA IS PRESENT * 31390000 BC 03,IP 0476 31400000 * R6 = RSVWDSV2; /* RESTORE XPCE TO ENTRY VALUE * 31410000 @9B5 L @6,544(0,@B) 0477 31420000 * R4 = RSVWDSV1; /* POINT XINPUT TO CHAR BEFORE * 31430000 L @4,540(0,@B) 0478 31440000 * GOTO RTNNSKP3; /* RSVWD, THEN EXIT * 31450000 BC 15,RTNNSKP3 0479 31460000 * 31470000 * /***************************************************************** 31480000 * /* * 31490000 * /* SET UP PARAMETERS WHEN PROMPTING WITH INVALID DATA * 31500000 * /* * 31510000 * /***************************************************************** 31520000 * 31530000 * 31540000 * IPA: 31550000 * R4 = ENDINPUT; /* PROMPT WITH REMAINDER * 31560000 IPA L @4,144(0,@B) 0480 31570000 * /* OF BUFFER * 31580000 * 31590000 * IP: 31600000 * INVPSAVE = RSVWDSV1 + 1; /* SET INVPSAVE TO FIRST CHAR * 31610000 IP LA @F,1 0481 31620000 A @F,540(0,@B) 0481 31630000 ST @F,300(0,@B) 0481 31640000 * /* OF INVALID DATA * 31650000 * PPCOUNT = 7; /* SET PPCOUNT = PDE LENGTH -1 * 31660000 MVI 417(@B),7 0482 31670000 * R6 = RSVWDPCE; /* SET PCE PTR TO RSVWD PCE * 31680000 L @6,524(0,@B) 0483 31690000 * R5 = R4; /* SET XINPUTB TO NEXT CHAR AFTER 31700000 * INVALID DATA * 31710000 LR @5,@4 0484 31720000 * CBLNKSV2 = ADDR(P40PR); /* CBLNKSV2 = RETURN ADDR * 31730000 LA @F,P40PR 0485 31740000 ST @F,552(0,@B) 0485 31750000 * GOTO MSGSETUP; /* PROMPT * 31760000 BC 15,MSGSETUP 0486 31770000 * 31780000 * /***************************************************************** 31790000 * /* * 31800000 * /* PROMPT FOR MISSING DATA UNLESS PROCESSING A FIGURATIVE * 31810000 * /* CONSTANT * 31820000 * /* * 31830000 * /***************************************************************** 31840000 * 31850000 * 31860000 * A1: 31870000 * IF RSVWDPCE -> RFCONST = '1'B THEN /* RETURN TO TERM * 31880000 A1 L @7,524(0,@B) 0487 31890000 TM 1(@7),B'10000000' 0487 31900000 * GOTO RTN0; /* PROCESSOR IF RSVWD PCE IS 31910000 * CHAINED TO A TERM PCE * 31920000 BC 01,RTN0 0488 31930000 * R6 = RSVWDPCE; /* PLACE PROMPT PCE IN XPCE * 31940000 L @6,524(0,@B) 0489 31950000 * R15 = 2; /* LOAD PROMPTQ RTN ADDR * 31960000 LA @F,2 0490 31970000 * CALL LINKRET; /* CALL PROMPTQ * 31980000 BAL @E,LINKRET 0491 31990000 * GEN (BC 15,P40PR); /* ON +0 RETURN -- DATA RETURNED * 32000000 BC 15,P40PR 32010000 DS 0H 32020000 * GEN (BC 15,RPQRTN4); /* ON +4 RETURN -- NO NEW DATA * 32030000 BC 15,RPQRTN4 32040000 DS 0H 32050000 * 32060000 * /***************************************************************** 32070000 * /* * 32080000 * /* RECEIVE CONTROL AFTER THE PROMPT REPLY * 32090000 * /* * 32100000 * /***************************************************************** 32110000 * 32120000 * 32130000 * P40PR: /* DETERMINE IF NEW DATA WAS 32140000 * RETURNED FROM THE PROMPT * 32150000 * IF PFNULL = '0'B /* IF DATA WAS RETURNED * 32160000 * THEN /* FROM THE PROMPT, SCAN THE * 32170000 P40PR TM 178(@B),B'00001000' 0494 32180000 BC 05,@9B4 0494 32190000 * DO; /* NEW RSVWD DATA. SET * 32200000 * RSVDPRMT = '1'B; /* RSVDPRMT TO INDITCATE THAT * 32210000 OI 599(@B),B'00000100' 0496 32220000 * GOTO E; /* THE DATA MUST BE INVALID * 32230000 BC 15,E 0497 32240000 * END; /* IF NO MATCH IS FOUND * 32250000 * PFNULL = '0'B; /* TURN OFF NULL REPLY SWITCH * 32260000 @9B4 NI 178(@B),B'11110111' 0499 32270000 * 32280000 * /***************************************************************** 32290000 * /* * 32300000 * /* DETERMINE CALLING ROUTINE AFTER A NULL PROMPT REPLY * 32310000 * /* * 32320000 * /***************************************************************** 32330000 * 32340000 * 32350000 * RPQRTN4: 32360000 * IF OPERMODE = '1'B THEN /* RETURN TO OPER PROCESSOR * 32370000 RPQRTN4 TM 599(@B),B'01000000' 0500 32380000 * GOTO RTNO0; /* IF IN OPER MODE. GIVE * 32390000 BC 01,RTNO0 0501 32400000 * ELSE /* CONTROL TO NAMESKP3 IF * 32410000 * GOTO RTNNSKP3; /* CALLED BY MAIN LINE PARSE * 32420000 BC 15,RTNNSKP3 0502 32430000 * 32440000 * /***************************************************************** 32450000 * /* * 32460000 * /* CHECK FOR INVALID OPTIONAL DATA ON THE REPLY TO RSVWD * 32470000 * /* PROMPTING IN THE OPER MODE * 32480000 * /* * 32490000 * /***************************************************************** 32500000 * 32510000 * OMODCK: 32520000 * IF OPERMODE = '0'B THEN /* OPTIONAL DATA IS INVALID * 32530000 OMODCK TM 599(@B),B'01000000' 0503 32540000 * GOTO F; /* ONLY WHEN IN OPER MODE * 32550000 BC 08,F 0504 32560000 * 32570000 * /***************************************************************** 32580000 * /* * 32590000 * /* CHECK FOR INVALID OPTIONAL DATA ON THE PROMPT REPLY * 32600000 * /* * 32610000 * /***************************************************************** 32620000 * 32630000 * OMODCK2: 32640000 * IF RSVDPRMT = '0'B THEN /* THE CHECK ONLY APPLIES TO * 32650000 OMODCK2 TM 599(@B),B'00000100' 0505 32660000 * GOTO F; /* DATA RETURNED FROM A PROMPT * 32670000 BC 08,F 0506 32680000 * PFNOPOP = '1'B; /* ENSURE THAT SKIPB DOES NOT POP 32690000 * PROMPT BUFFER * 32700000 OI 179(@B),B'00000010' 0507 32710000 * R15 = 5; /* LOAD ADDR SKIPB RTN * 32720000 LA @F,5 0508 32730000 * CALL LINKRET; /* CALL SKIPB TO SKIP OVER 32740000 * SEPARATORS * 32750000 BAL @E,LINKRET 0509 32760000 * GOTO NOPRMT; /* +0 RETURN-- NO OPTIONAL DATA 32770000 * BEFORE END OF BUFFER * 32780000 BC 15,NOPRMT 0510 32790000 * PFNOPOP = '0'B; /* +4 RETURN-- INVALID OPTIONAL 32800000 * DATA FOUND * 32810000 NI 179(@B),B'11111101' 0511 32820000 * GOTO IPA; /* PROMPT * 32830000 BC 15,IPA 0512 32840000 * 32850000 * NOPRMT: 32860000 * PFNOPOP = '0'B; /* ALLOW SKIPB TO POP BUFFER ON 32870000 * FUTURE CALLS * 32880000 NOPRMT NI 179(@B),B'11111101' 0513 32890000 * R5 = RSVWDSV1 + 1; /* SET PTR TO RSVWD FIRST CHAR * 32900000 LA @5,1 0514 32910000 A @5,540(0,@B) 0514 32920000 * GOTO F; /* CONTINUE RSVWD SCAN * 32930000 BC 15,F 0515 32940000 * 32950000 * /***************************************************************** 32960000 * /* * 32970000 * /* RETURN CONTROL TO THE CALLING ROUTINE * 32980000 * /* * 32990000 * /***************************************************************** 33000000 * 33010000 * 33020000 * RTN0: 33030000 * R4 = RSVWDSV1; /* RESTORE XINPUT TO ENTRY VALUE * 33040000 RTN0 L @4,540(0,@B) 0516 33050000 * 33060000 * RTNO0: 33070000 * R8 = 0; /* RETURN ON +0 * 33080000 RTNO0 SR @8,@8 0517 33090000 * GOTO RTNC; /* SKIP OVER +4 RETURN * 33100000 BC 15,RTNC 0518 33110000 * 33120000 * RTN4: 33130000 * R8 = 4; /* RETURN ON +4 * 33140000 RTN4 LA @8,4 0519 33150000 * 33160000 * RTNC: 33170000 * R6 = RSVWDSV2; /* RESTORE XPCE TO ENTRY VALUE * 33180000 RTNC L @6,544(0,@B) 0520 33190000 * R14 = RSVDRTN + R8; /* LOAD RETURN ADDR * 33200000 LR @E,@8 0521 33210000 A @E,RSVDRTN 0521 33220000 * RETURN; /* RETURN TO CALLER * 33230000 BC 15,@EL05 0522 33240000 * 33250000 * RTNNSKP3: 33260000 * COBOLMOD = '0'B; /* LEAVE COBOL MODE * 33270000 RTNNSKP3 NI 599(@B),B'01111111' 0523 33280000 * GEN (BAL 14,@EL01); /* FREE AUTOMATIC STORAGE * 33290000 BAL 14,@EL01 33300000 DS 0H 33310000 * R15 = 15; /* LOAD ADDR NAMESKP3 ROUTINE * 33320000 LA @F,15 0525 33330000 * CALL LINKRET; /* GIVE CONTROL - NO RETURN * 33340000 BAL @E,LINKRET 0526 33350000 * 33360000 * RTNCLNUP: 33370000 * RETCODE = 24; /* PASS RETURN CODE FOR BAD PCE 33380000 * BACK TO THE CP * 33390000 RTNCLNUP MVI 154(@B),24 0527 33400000 * GEN (BAL 14,@EL01); /* FREE AUTOMATIC STORAGE * 33410000 BAL 14,@EL01 33420000 DS 0H 33430000 * R15 = 16; /* LOAD ADDR CLEANUP RTN * 33440000 LA @F,16 0529 33450000 * CALL LINKRET; /* TERMINATE SCAN AND GOTO 33460000 * CLEANUP * 33470000 BAL @E,LINKRET 0530 33480000 * END IKJEFP40; 33490000 @EL05 BCR 15,@E 0531 33500000 * 33510000 * /***************************************************************** 33520000 * /* * 33530000 * /* FREE STORAGE OBTAINED BY THE GETCORE SUBROUTINE * 33540000 * /* * 33550000 * /***************************************************************** 33560000 * 33570000 * 33580000 * FREECORE: /* ENTRY FREECORE * 33590000 * PROC OPTIONS(NOSAVEAREA, /* NO STANDARD LINKAGE * 33600000 * DONTSAVE); /* NO STANDARD LINKAGE * 33610000 * RESPECIFY 33620000 * (R8, 33630000 * R9, 33640000 * R4, 33650000 * R6, 33660000 * R5, 33670000 * PWAREG) RESTRICTED; /* SAVE CRITICAL POINTERS * 33680000 * GOREGSV = R14; /* SAVE RETURN ADDR * 33690000 FREECORE ST @E,616(0,@B) 0534 33700000 * GEN; /* FREE STORAGE * 33710000 LR R0,R8 /* R8 = I = # OF BYTES */ 33720000 LR R1,R5 /* R5 = XINPUTB = ADDR CORE */ 33730000 FREEMAIN R,LV=(0),A=(1) /* FREE CORE */ 33740000 DS 0H 33750000 * R14 = GOREGSV; /* RESTORE RETURN ADDR * 33760000 L @E,616(0,@B) 0536 33770000 * END FREECORE; 33780000 @EL06 BCR 15,@E 0537 33790000 * 33800000 * /***************************************************************** 33810000 * /* * 33820000 * /* THIS ROUTINE VALIDITY CHECKS THE STRUCTURE OF TERM PCE'S CODED* 33830000 * /* UNDER THE OPER PCE * 33840000 * /* * 33850000 * /***************************************************************** 33860000 * 33870000 * 33880000 * TERMOCK: 33890000 * PROC OPTIONS(NOSAVEAREA, /* ENTRY TERMOCK * 33900000 * DONTSAVE); /* NO STANDARD LINKAGE * 33910000 * RESPECIFY 33920000 * (R6, 33930000 * R4, 33940000 * R5, 33950000 * R7, 33960000 * R9, 33970000 * PWAREG) RESTRICTED; /* SAVE POINTERS * 33980000 * GOREGSV = R14; /* SAVE RETURN ADDR * 33990000 TERMOCK ST @E,616(0,@B) 0540 34000000 * IF TERPCE ^= '110'B /* COMPARE THE TERM PCE TYPE * 34010000 * THEN 34020000 TM 0(@6),B'11000000' 0541 34030000 BC 12,@9B3 0540 34040000 TM 0(@6),B'00100000' 0541 34050000 BC 08,@9B2 0541 34060000 * GOTO RTNCLNUP; /* MASK TO THE MINOR TERM * 34070000 BC 15,RTNCLNUP 0542 34080000 * /* PCE LOCATION - IF THERE IS * 34090000 * /* NO MATCH GOTO CLEANUP WITH * 34100000 * /* THE RETURN CODE IN RETCODE * 34110000 * 34120000 * /***************************************************************** 34130000 * /* * 34140000 * /* IF THE MINOR TERM PCE HAS LIST OR RANGE SPECIFIED IT CAN NOT * 34150000 * /* BE CODED UNDER AN OPER PCE * 34160000 * /* * 34170000 * /***************************************************************** 34180000 * 34190000 * IF LIST = '1'B | /* TEST THE LIST AND THE RANGE * 34200000 * RANG = '1'B /* BITS IN THE MINOR TERM PCE * 34210000 * THEN 34220000 @9B2 TM 1(@6),B'10000000' 0543 34230000 BC 01,@9B1 0543 34240000 TM 1(@6),B'00100000' 0543 34250000 BC 12,@9B0 0543 34260000 * GOTO RTNCLNUP; /* - IF THEY ARE ON GOTO THE * 34270000 BC 15,RTNCLNUP 0544 34280000 * /* PARSE SUBROUTINE 'CLEANUP' * 34290000 * /* WHICH PASSES THE PCE ERROR * 34300000 * /* RETURN CODE -RETCODE- BACK * 34310000 * /* TO THE COMMAND PROCESS * 34320000 * 34330000 * /***************************************************************** 34340000 * /* * 34350000 * /* THE MINOR TERM PCE ADDRESS MUST BE LESS THAN THE PCE ADDRESS * 34360000 * /* FOUND IN 'PRIORPCE' * 34370000 * /* * 34380000 * /***************************************************************** 34390000 * 34400000 * IF R6 ^> R9 /* COMPARE THE ADDRESS OF THE * 34410000 * THEN 34420000 @9B0 CR @6,@9 0545 34430000 * GOTO RTNCLNUP; /* TERM PCE BEING TESTED WITH * 34440000 BC 12,RTNCLNUP 0546 34450000 * /* THE PRIOR PCE - IF THE * 34460000 * /* CURRENT TERM IS NOT THE * 34470000 * /* GREATER GOTO 'CLEANUP'. * 34480000 * R9 = R6; /* UPDATE PRIORPCE BEFORE THE * 34490000 LR @9,@6 0547 34500000 * R14 = GOREGSV; /* RESTORE RETURN ADDR * 34510000 L @E,616(0,@B) 0548 34520000 * END TERMOCK; /* END OF PROCEDURE TERMOCK * 34530000 @EL07 BCR 15,@E 0549 34540000 * END IKJEFP50; 34550000 * 34560000 * IKJEFP60: /* TERM PROCESSOR * 34570000 * PROC OPTIONS(DONTSAVE,NOSAVEAREA); /* MAIN ENTRY POINT * 34580000 IKJEFP60 EQU * 0551 34590000 * 34600000 * /***************************************************************** 34610000 * /* * 34620000 * /* REGISTER DECLARES AND RESTRICTIONS * 34630000 * /* * 34640000 * /***************************************************************** 34650000 * 34660000 * DCL 34670000 * PARS2BAS REG(2) PTR(31); /* TERM BASE REGISTER * 34680000 * DCL 34690000 * OTHBASE REG(3) PTR(31); /* OPER/RESVWD BASE REG * 34700000 * DCL 34710000 * ADDCDE REG(15) PTR(31); /* SUBROUTINE ADDR AND RET/CODE * 34720000 * RESTRICT (R4,R5); /* KEEP COMMAND PTRS INTACT * 34730000 * RESTRICT (R6); /* KEEP PTR TO NEXT PCE * 34740000 * RESTRICT (PWAREG); /* KEEP WORKAREA INTACT * 34750000 * RESTRICT (LINK2); /* SAVE LINKAGE REG * 34760000 * 34770000 * /***************************************************************** 34780000 * /* * 34790000 * /* COMPILE TIME VARIBLES * 34800000 * /* * 34810000 * /***************************************************************** 34820000 * 34830000 * 34840000 * /***************************************************************** 34850000 * /* * 34860000 * /* TABLES AND WORKAREAS THE FOLLOWING AREA CONTAIN CONTROL INFO * 34870000 * /* FOR GENSCAN * 34880000 * /* * 34890000 * /***************************************************************** 34900000 * 34910000 * DCL 34920000 * 1 WORKAR AUTO, /* GENSCAN CONTROL OPTIONS * 34930000 * 2 GOPTION CHAR(1), /* SCAN OPTIONS * 34940000 * 2 GFIRST CHAR(1), /* FIRST CHAR TYPE * 34950000 * 2 GOTHER CHAR(1), /* OTHER CHAR TYPE * 34960000 * 2 GOMAX CHAR(1); /* MAXIMUN SCAN LENGTH * 34970000 * DCL 34980000 * 1 WORKAR1 BASED(TANC), /* AREA FOR QUALIFIER PDE * 34990000 * 2 QNAMEPTR PTR(31), /* PTR TO DATA NAME * 35000000 * 2 QNGTH4 PTR(8), /* LENGTH OF DATA NAME * 35010000 * 2 QRESV CHAR(3), /* RESERVE FIELD * 35020000 * 2 QATAPTRH PTR(32); /* SPACE FOR LAST INDICATOR * 35030000 * DCL 35040000 * PTRARE PTR(31) BASED(CHAINPTR); /* DSECT FOR CHAINPTR AREA * 35050000 * DCL 35060000 * COMBUFA CHAR(2) BASED(R4); /* TWO BYTE COMMAND BUFFER * 35070000 * DCL 35080000 * VCOMBF CHAR(1) BASED(R4-1); /* PREV INPUT CHAR * 35090000 * DCL 35100000 * CNSTTEMP CHAR(20) BASED(PDEPTR); /*PDE TO ZERO IF TYPE ANY * 35110000 * 35120000 * /***************************************************************** 35130000 * /* * 35140000 * /* MAP OF VARIABLE PDE * 35150000 * /* * 35160000 * /***************************************************************** 35170000 * 35180000 * DCL 35190000 * 1 VARIPDE BASED(ADDR(TEMPPDE)), /* PDE MAP * 35200000 * 2 * CHAR(18), /* DUMMY AREA * 35210000 * 2 NUMSUB1 CHAR(1); /* NUMBER OF SUBSCRIPTS * 35220000 * DCL 35230000 * BUMP INTERNAL LABEL LOCAL; /* INTERNAL PROCDURE TO UPDATE 35240000 * INPUT POINTER * 35250000 * 35260000 * /***************************************************************** 35270000 * /* * 35280000 * /* THIS ROUTINE PERFORMS INITIALIZATION FUNCTIONS, INTERROGATES * 35290000 * /* THE PCE TYPE(CONST, STMT, VAR, OR ANY) AND BRANCHES TO THE * 35300000 * /* CORRESPONDING ROUTINE. * 35310000 * /* * 35320000 * /***************************************************************** 35330000 * 35340000 * 35350000 * TERMBGN: 35360000 * COBOLMOD='1'B; /* TURN ON COBOL SWITCH * 35370000 TERMBGN OI 599(@B),B'10000000' 0567 35380000 * PRMTSCAN='0'B; /* MISSING PARM PROMPTED FOR * 35390000 NI 600(@B),B'11111011' 0568 35400000 * PFENDSET='0'B; /* SET POP STACK SWITCH TO 35410000 * CONTROL VARIABLE SCAN * 35420000 NI 179(@B),B'11111011' 0569 35430000 * PREVPDEL=0; /* LIST PTR TO ZERO * 35440000 SR @F,@F 0570 35450000 ST @F,448(0,@B) 0570 35460000 * RC16='0'B; /* TURN VALIDITY CHECK BIT OFF * 35470000 NI 599(@B),B'11111110' 0571 35480000 * PDEPTR=ADDR (TEMPPDE); /* SET PDE PTR TO TEMPORARY PDE * 35490000 LA @F,332(0,@B) 0572 35500000 ST @F,564(0,@B) 0572 35510000 * CBLNKSV1=GOREG; /* SAVE RETURN ADDRESS * 35520000 ST @E,548(0,@B) 0573 35530000 * TERMXPCE=R6; /* SAVE CURRENT PCE POINTER * 35540000 ST @6,528(0,@B) 0574 35550000 * ADDCDE=5; /* ADDR OF SKIPB IN REG 15 * 35560000 LA @F,5 0575 35570000 * CALL LINKRET; /* BRANCH TO PARSE2 * 35580000 BAL @E,LINKRET 0576 35590000 * GOTO PROMPT01; /* BRANCH ON ZERO RETURN * 35600000 BC 15,PROMPT01 0577 35610000 * 35620000 * /***************************************************************** 35630000 * /* * 35640000 * /* GENERATE BRANCH AROUND SETTING PRMTSCAN IF MORE * 35650000 * /* * 35660000 * /***************************************************************** 35670000 * 35680000 * GEN (BC 15,OPER); 35690000 BC 15,OPER 35700000 DS 0H 35710000 * 35720000 * /***************************************************************** 35730000 * /* * 35740000 * /* TEST TO DETERMINE IF IKJOPER HAS BEEN ENTERED * 35750000 * /* * 35760000 * /***************************************************************** 35770000 * 35780000 * 35790000 * OPER1: 35800000 * PRMTSCAN='1'B; /* RETURN HERE AFTER DATA 35810000 * RETURNED FROM PROMPT - TURN 35820000 * PRMTSCAN ON FOR INVALID * 35830000 OPER1 OI 600(@B),B'00000100' 0579 35840000 * 35850000 * OPER: 35860000 * IF OPERMODE='1'B /* IS THIS IN OPER MODE ? * 35870000 * THEN /* IF YES * 35880000 OPER TM 599(@B),B'01000000' 0580 35890000 BC 12,@9AF 0580 35900000 * DO; /* TEST FOR SUBSCRIPTS * 35910000 * 35920000 * /************************************************************* 35930000 * /* * 35940000 * /* TEST TO DETERMINE IF SUBSCRIPTS ARE ALLOWED * 35950000 * /* * 35960000 * /************************************************************* 35970000 * 35980000 * 35990000 * PDESIZ: 36000000 * IF SUBSCRP='1'B /* ARE SUBSCRIPTS ALLOWED ? * 36010000 * THEN /* IF YES * 36020000 PDESIZ TM 1(@6),B'00010000' 0582 36030000 BC 12,@9AE 0582 36040000 * DO; /* SET LENGTHS * 36050000 * PPCOUNT=79; /* DATA SIZE EQUAL 3 SUBSCRIPTS * 36060000 MVI 417(@B),79 0584 36070000 * GOTO INVPSAV; /* BRANCH TO UPDATE INPUT PTR * 36080000 BC 15,INVPSAV 0585 36090000 * END; /* IF SUBSCRIPTS NOT ALLOWED * 36100000 * PPCOUNT=19; /* DATA SIZE EQUAL 1 SUBSCRIPT * 36110000 @9AE MVI 417(@B),19 0587 36120000 * 36130000 * /************************************************************* 36140000 * /* * 36150000 * /* CHECK FOR RANGE PROCESSING * 36160000 * /* * 36170000 * /************************************************************* 36180000 * 36190000 * 36200000 * INVPSAV: 36210000 * IF RNGEVAL1='1'B /* TEST FOR FIRST VAL OF RANGE * 36220000 * THEN /* IF YES * 36230000 INVPSAV TM 177(@B),B'01000000' 0588 36240000 BC 12,@9AD 0588 36250000 * DO; /* SET UP FOR TYPETEST * 36260000 * IF R4=>ENDINPUT /* IF XINPUT IS AT ENDINPUT 36270000 * A00996 * 36280000 * THEN /* OR AT A SEMICOLON * 36290000 C @4,144(0,@B) 0590 36300000 * GOTO RANGERR1; /* IS AN ERROR * 36310000 BC 10,RANGERR1 0591 36320000 * IF COMBUF=';' /* IS IT A SEMI COLON * 36330000 * THEN /* IF SO IS AN * 36340000 CLI 0(@4),C';' 0592 36350000 * GOTO RANGERR1; /* ERROR TOO * 36360000 BC 08,RANGERR1 0593 36370000 * ADDCDE=8; /* ADDR OF TYPE TEST REG 15 * 36380000 LA @F,8 0594 36390000 * R1='08'X; /* BLK-TAB-COMMA MASK REG 1 * 36400000 LA @1,X'08' 0595 36410000 * CALL LINKRET; /* BRANCH TO PARSE2 * 36420000 BAL @E,LINKRET 0596 36430000 * GOTO INVPSAV1; /* BRANCH AROUND * 36440000 BC 15,INVPSAV1 0597 36450000 * RANGERR1: 36460000 * ERRORBIT='1'B; /* SET ERROR BIT * 36470000 RANGERR1 OI 599(@B),B'00001000' 0598 36480000 * PFNOPOP='1'B; /* PREVENT STACK POPPING * 36490000 OI 179(@B),B'00000010' 0599 36500000 * CALL TSTRNGE; /* CHECK RANGE A00996 * 36510000 L @F,@V5 ADDRESS OF TSTRNGE 0600 36520000 BALR @E,@F 0600 36530000 * GOTO EXIT; /* BRANCH FOR ERROR PROC * 36540000 BC 15,EXIT 0601 36550000 * END; /* IF NOT RANGE PROCESSING * 36560000 * 36570000 * INPUTUP: 36580000 * R4=R4+1; /* PTR TO NEXT CHAR IN BUFFER * 36590000 @9AD EQU * 0603 36600000 INPUTUP AH @4,@D2 0603 36610000 * INVPSAVE=R4; /* RESET INVPSAVE TO BEG OF THIS 36620000 * TERM * 36630000 ST @4,300(0,@B) 0604 36640000 * 36650000 * /************************************************************* 36660000 * /* * 36670000 * /* IF THE ERROR BIT IS NOT ON, SET INVPSAVE AND PRMTPTR EQUAL* 36680000 * /* TO XINPUT. RANGES ARE NOT ALLOWED WITHIN AN EXPRESSION. * 36690000 * /* THE ERRORBIT CANNOT BE ON UNLESS HAVE COME INTO * 36700000 * /* INITIALIZATION CODE AFTER SCANNING PART OF A RANGE, I.E., * 36710000 * /* THE FIRST VALUE. * 36720000 * /* * 36730000 * /************************************************************* 36740000 * 36750000 * 36760000 * INVPSAV1: /* IF ERROR BIT IS * 36770000 * IF ERRORBIT^='1'B /* NOT ON, * 36780000 * THEN /* WANT TO SET INVPSAVE AND * 36790000 INVPSAV1 TM 599(@B),B'00001000' 0605 36800000 BC 01,@9AC 0605 36810000 * DO; /* PRMTPTR * 36820000 * PRMTPTR=R4; /* BEGINNING OF VARIABLE * 36830000 ST @4,584(0,@B) 0607 36840000 * END; /* END SET OF POINTERS * 36850000 * 36860000 * /************************************************************* 36870000 * /* * 36880000 * /* DETERMINE PCE TYPE AND BRANCH TO SUBROUTINE * 36890000 * /* * 36900000 * /************************************************************* 36910000 * 36920000 * 36930000 * PCETYPE1: 36940000 * IF VAR='1'B /* IF TYPE EQUAL VARIABLE * 36950000 * THEN /* IF YES * 36960000 @9AC EQU * 0609 36970000 PCETYPE1 TM 6(@6),B'01000000' 0609 36980000 * GOTO IKJEFP6V; /* BRANCH TO VARIABLE RTN * 36990000 BC 01,IKJEFP6V 0610 37000000 * 37010000 * /************************************************************* 37020000 * /* * 37030000 * /* TEST FOR TYPE EQUAL STATEMENT NUMBER * 37040000 * /* * 37050000 * /************************************************************* 37060000 * 37070000 * IF STMT='1'B /* IF TYPE EQUAL STATEMENT NO. * 37080000 * THEN /* IF YES * 37090000 TM 6(@6),B'10000000' 0611 37100000 * GOTO IKJEFP6S; /* BRANCH TO STATEMENT RTN * 37110000 BC 01,IKJEFP6S 0612 37120000 * 37130000 * /************************************************************* 37140000 * /* * 37150000 * /* TEST FOR TYPE EQUAL CONSTANT * 37160000 * /* * 37170000 * /************************************************************* 37180000 * 37190000 * IF CNST='1'B /* IF TYPE EQUAL CONSTANT * 37200000 * THEN /* IF YES * 37210000 TM 6(@6),B'00100000' 0613 37220000 * GOTO SUBTEST; /* BRANCH TO CONSTANT RTN * 37230000 BC 01,SUBTEST 0614 37240000 * 37250000 * /************************************************************* 37260000 * /* * 37270000 * /* TEST FOR TYPE EQUAL ANY * 37280000 * /* * 37290000 * /************************************************************* 37300000 * 37310000 * IF ANY='1'B /* IF TYPE EQUAL ANY * 37320000 * THEN /* IF YES * 37330000 TM 6(@6),B'00010000' 0615 37340000 * GOTO SUBTEST; /* BRANCH TO CONSTANT RTN * 37350000 BC 01,SUBTEST 0616 37360000 * END; /* IF OPER MODE NOT SET * 37370000 * ADDCDE=11; /* ADDR OF LISTT IN REG 15 * 37380000 @9AF LA @F,11 0618 37390000 * CALL LINKRET; /* BRANCH TO PARSE2 * 37400000 BAL @E,LINKRET 0619 37410000 * GOTO VARCODE3; /* GOTO RESET PTRS SO WON'T MISS 37420000 * END OF LIST * 37430000 BC 15,VARCODE3 0620 37440000 * GEN (BC 15,PDESIZ); /* BRANCH TO SET PDE SIZE * 37450000 BC 15,PDESIZ 37460000 DS 0H 37470000 * 37480000 * VARCODE3: /* MUST RESET XINPUTB SO * 37490000 * R5=PPOINTR+1; /* END OF LIST WILL NOT BE MISSED* 37500000 VARCODE3 LA @5,1 0622 37510000 A @5,148(0,@B) 0622 37520000 * GOTO VARCODE4; /* ISSUE INVALID MESSAGE * 37530000 BC 15,VARCODE4 0623 37540000 * 37550000 * PROMPT01: /* DETERMINE IF PARM OPTIONAL * 37560000 * ADDCDE=2; /* ADDR OF PROMPTQ IN REG 15 * 37570000 PROMPT01 LA @F,2 0624 37580000 * CALL LINKRET; /* BRANCH TO PARSE2 * 37590000 BAL @E,LINKRET 0625 37600000 * GOTO OPER; /* TEST FOR OPER MODE * 37610000 BC 15,OPER 0626 37620000 * 37630000 * /***************************************************************** 37640000 * /* * 37650000 * /* TEST TO DETERMINE IF IKJOPER HAS BEEN ENTERED * 37660000 * /* * 37670000 * /***************************************************************** 37680000 * 37690000 * 37700000 * NTRQEXT: 37710000 * IF OPERMODE='1'B /* IS THIS OPER MODE ? * 37720000 * THEN /* IF YES * 37730000 NTRQEXT TM 599(@B),B'01000000' 0627 37740000 BC 12,@9AB 0627 37750000 * DO; /* RETURN TO CALLER * 37760000 * GOREG=CBLNKSV1; /* RESTORE REG 14 * 37770000 L @E,548(0,@B) 0629 37780000 * RETURN; /* RETURN TO CALLER * 37790000 BC 15,@EL08 0630 37800000 * END; /* IF OPERMODE NOT SET * 37810000 * GOTO UPDTPCE; /* EXIT TO UPDATE PCE * 37820000 * 37830000 * OPERTEST: /* ENTRY AFTER PROMPT RESPONSE * 37840000 * R6=TERMXPCE; /* LOAD PRIMARY PCE * 37850000 OPERTEST L @6,528(0,@B) 0633 37860000 * 37870000 * /***************************************************************** 37880000 * /* * 37890000 * /* DETERMINE IF PROCESSING PROMPT OR DEFAULT DATA * 37900000 * /* * 37910000 * /***************************************************************** 37920000 * 37930000 * PDEPTR=ADDR (TEMPPDE); /* RESET PDEPTR FOR RANGE * 37940000 LA @F,332(0,@B) 0634 37950000 ST @F,564(0,@B) 0634 37960000 * IF PFNULL='1'B /* NULL LINE RETURNED ? * 37970000 * THEN /* IF YES * 37980000 TM 178(@B),B'00001000' 0635 37990000 BC 12,@9AA 0635 38000000 * DO; /* SET SWITCH OFF * 38010000 * PFNULL='0'B; /* TURN SWITCH OFF * 38020000 NI 178(@B),B'11110111' 0637 38030000 * IF PFLIST='1'B /* IF PROCESSING A LIST, MUST * 38040000 * THEN /* GO TO PROCESSOR TO EITHER * 38050000 TM 176(@B),B'10000000' 0638 38060000 * GOTO LISTEST; /* CATCH NEXT ELEMENT OF THE LIST 38070000 * OR THE END OF LIST * 38080000 BC 01,LISTEST 0639 38090000 * GOTO NTRQEXT; /* PICK UP NEXT PCE * 38100000 BC 15,NTRQEXT 0640 38110000 * END; /* IF SWITCH NOT ON * 38120000 * GOTO OPER; /* TEST FOR OPER MODE * 38130000 * 38140000 * /***************************************************************** 38150000 * /* * 38160000 * /* THE STATEMENT PROCESSING ROUTINE IS ENTERED WHEN THE TYPE * 38170000 * /* PARAMETER IN THE CURRENT PCE IS STMT. * 38180000 * /* * 38190000 * /***************************************************************** 38200000 * 38210000 * 38220000 * IKJEFP6S: /* ENTRY FOR TYPE EQUAL STMT * 38230000 * 38240000 * /***************************************************************** 38250000 * /* * 38260000 * /* TEST FOR OPER MODE * 38270000 * /* * 38280000 * /***************************************************************** 38290000 * 38300000 * IF OPERMODE^='1'B /* IS THIS OPER MODE ? * 38310000 * THEN /* IF NO * 38320000 IKJEFP6S TM 599(@B),B'01000000' 0643 38330000 * GOTO CONT; /* BRANCH AROUND * 38340000 BC 12,CONT 0644 38350000 * 38360000 * /***************************************************************** 38370000 * /* * 38380000 * /* TEST FOR CHAIN TERM * 38390000 * /* * 38400000 * /***************************************************************** 38410000 * 38420000 * IF CHAINTRM='1'B /* CHAIN TERM BIT ON ? * 38430000 * THEN /* IF YES * 38440000 TM 600(@B),B'00010000' 0645 38450000 * GOTO CONT; /* BRANCH AROUND * 38460000 * GOTO COD24; /* BRANCH TO ISSUE ERROR MSG * 38470000 BC 14,COD24 0647 38480000 * 38490000 * CONT: 38500000 * ADDCDE=8; /* ADDR OF TYPETEST IN REG 15 * 38510000 CONT LA @F,8 0648 38520000 * R1='C0'X; /* ALPHA MASK IN REG 1 * 38530000 LA @1,X'C0' 0649 38540000 * CALL LINKRET; /* BRANCH TO PARSE2 * 38550000 BAL @E,LINKRET 0650 38560000 * GEN; /* RETURN BRANCHES * 38570000 BC 15,STRINPTR BRANCH AROUND 38580000 BC 15,STRPGMID BRANCH TO STORE PGM ID 38590000 DS 0H 38600000 * 38610000 * STRINPTR: /* STORE INPUT POINTER * 38620000 * DATAPTRA=R4; /* STOR INPUT PTR AS LINE NUMBER 38630000 * PTR IN PDE * 38640000 STRINPTR L @1,564(0,@B) 0652 38650000 ST @4,12(0,@1) 0652 38660000 * 38670000 * NUMCK1: 38680000 * ADDCDE=8; /* ADDR OF TYPE TEST IN REG 15 * 38690000 NUMCK1 LA @F,8 0653 38700000 * R1='10'X; /* NUMERIC MASK IN REG 1 * 38710000 LA @1,X'10' 0654 38720000 * CALL LINKRET; /* BRANCH TO PARSE2 * 38730000 BAL @E,LINKRET 0655 38740000 * GOTO MAXLNGTH; /* CHECK LENGTH OF LINE NO. * 38750000 BC 15,MAXLNGTH 0656 38760000 * NUMCK2: /* BRANCH FROM PGMID A00996 38770000 * PROCESSING A56846 * 38780000 * DIGITCT=DIGITCT+1; /* ADD ONE TO DATE COUNT * 38790000 NUMCK2 LA @F,1 0657 38800000 SR @0,@0 0657 38810000 IC @0,596(0,@B) 0657 38820000 AR @F,@0 0657 38830000 STC @F,596(0,@B) 0657 38840000 * R4=R4+1; /* POINT TO NEXT CHAR IN BUFFER * 38850000 AH @4,@D2 0658 38860000 * 38870000 * /***************************************************************** 38880000 * /* * 38890000 * /* DETERMINE IF END OF BUFFER HAS BEEN REACHED * 38900000 * /* * 38910000 * /***************************************************************** 38920000 * 38930000 * IF R4=>ENDINPUT /* IS THIS END OF INPUT BUFFER 38940000 * A00996 * 38950000 * THEN /* IF YES * 38960000 C @4,144(0,@B) 0659 38970000 BC 04,@9A9 0659 38980000 * DO; /* CHECK LENGTH OF LINE NO. * 38990000 * 39000000 * /************************************************************* 39010000 * /* * 39020000 * /* TEST LINE NUMBER FOR GREATER THAN SIX NUMERIC DIGIT * 39030000 * /* * 39040000 * /************************************************************* 39050000 * 39060000 * 39070000 * MAXLNGTH: 39080000 * IF DIGITCT>6 /* LINE NO. GREATER THAN 6 ? * 39090000 * THEN /* IF YES * 39100000 MAXLNGTH CLI 596(@B),6 0661 39110000 * GOTO SEPSCAN; /* SCAN FOR A SEPARATOR * 39120000 BC 02,SEPSCAN 0662 39130000 * 39140000 * /************************************************************* 39150000 * /* * 39160000 * /* DETERMINE IF THIS IS THE FIRST CHARACTER IN BUFFER * 39170000 * /* * 39180000 * /************************************************************* 39190000 * 39200000 * IF R4=INVPSAVE /* FIRST CHAR IN INPUT BUFFER * 39210000 * THEN /* IF YES * 39220000 C @4,300(0,@B) 0663 39230000 BC 07,@9A8 0663 39240000 * DO; /* TEST FOR LIST PROCESSING * 39250000 * 39260000 * /********************************************************* 39270000 * /* * 39280000 * /* DETERMINE IF THIS PROCESSING IS FOR A LIST * 39290000 * /* * 39300000 * /********************************************************* 39310000 * 39320000 * IF PFLIST='1'B /* IS THIS LIST PROCESSING * 39330000 * THEN /* IF YES * 39340000 TM 176(@B),B'10000000' 0665 39350000 * GOTO SEPSCAN; /* SCAN FOR A SEPARATOR * 39360000 BC 01,SEPSCAN 0666 39370000 * 39380000 * /********************************************************* 39390000 * /* * 39400000 * /* DETERMINE IF PROCESSING FIRST VALUE OF RANGE * 39410000 * /* * 39420000 * /********************************************************* 39430000 * 39440000 * IF RNGEVAL1='1'B /* IS THIS RANGE PROCESSING * 39450000 * THEN /* IF YES * 39460000 TM 177(@B),B'01000000' 0667 39470000 * GOTO SEPSCAN; /* SCAN FOR A SEPARATOR * 39480000 BC 01,SEPSCAN 0668 39490000 * GOTO PROMPT05; /* DETERMINE IF PARAMETER REQ * 39500000 BC 15,PROMPT05 0669 39510000 * END; /* IF NOT FIRST CHAR OF BUFFER * 39520000 * 39530000 * /************************************************************* 39540000 * /* * 39550000 * /* DETERMINE IF THIS IS THE 1ST CHARACTER OF LINE NO. * 39560000 * /* * 39570000 * /************************************************************* 39580000 * 39590000 * IF R4=DATAPTRA /* FIRST CHAR OF LINE NO. ? * 39600000 * THEN /* IF YES * 39610000 @9A8 L @1,564(0,@B) 0671 39620000 C @4,12(0,@1) 0671 39630000 * GOTO SEPSCAN; /* SCAN FOR A SEPARATOR * 39640000 BC 08,SEPSCAN 0672 39650000 * LNGTH2=DIGITCT; /* STORE LINE NO. SIZE IN PDE * 39660000 MVC 1(1,@1),596(@B) 0673 39670000 * DIGITCT=0; /* ZERO DATA COUNT * 39680000 MVI 596(@B),0 0674 39690000 * 39700000 * /************************************************************* 39710000 * /* * 39720000 * /* CHECK INPUT LINE FOR PERIOD AFTER LINE NO. * 39730000 * /* * 39740000 * /************************************************************* 39750000 * 39760000 * IF R4=>ENDINPUT /* IF AT END OF BUFFER A00996 * 39770000 * THEN /* GO TO END A00996 * 39780000 C @4,144(0,@B) 0675 39790000 * GOTO RANGECK; /* OF STATEMENT A00996 39800000 * PROCESSING A00996 * 39810000 BC 10,RANGECK 0676 39820000 * IF COMBUF='4B'X /* PERIOD AFTER LINE NO. * 39830000 * THEN /* IF YES * 39840000 CLI 0(@4),X'4B' 0677 39850000 * GOTO BUMP1; /* CHECK NEXT CHARACTER * 39860000 BC 08,BUMP1 0678 39870000 * GOTO RANGECK; /* SET UP RANGE PROCESSING * 39880000 BC 15,RANGECK 0679 39890000 * END; /* IF END OF BUFFER NOT REACHED * 39900000 * 39910000 * /***************************************************************** 39920000 * /* * 39930000 * /* HAS THE END OF A STATEMENT BEEN REACHED ? * 39940000 * /* * 39950000 * /***************************************************************** 39960000 * 39970000 * IF COMBUF=';' /* INPUT LINE EQUAL SEMICOLON * 39980000 * THEN /* IF YES * 39990000 @9A9 CLI 0(@4),C';' 0681 40000000 * GOTO MAXLNGTH; /* CHECK LENGTH OF LINE NO. * 40010000 BC 08,MAXLNGTH 0682 40020000 * GOTO NUMCK1; /* TEST FOR NUMERIC CHARACTER * 40030000 BC 15,NUMCK1 0683 40040000 * /***************************************************************** 40050000 * /* THE STRPGMID ROUTINE SILL SCAN THE INPUT LINE TO ENSURE THAT * 40060000 * /* A PROGRAM ID PRECEEDS A LINE NUMBER. THIS MUST BE DONE IN * 40070000 * /* ORDER TO ENSURE THAT THE PARAMETER IS INDEED A STATEMENT * 40080000 * /* NUMBER OR SHOULD BE PARSED ON THE NEXT PCE. IF A VALID PGMID * 40090000 * /* IS FOUND, FOLLOWED BY A NUMERIC, THE PARAMETER IS ASSUMED * 40100000 * /* TO BE A STATEMENT NUMBER. IF THE INPUT LINE DOES NOT CONTAIN * 40110000 * /* A PGMID.NUMERIC, THE PARAMETER (STATEMENT NUMBER) IS ASSUMED * 40120000 * /* MISSING AND THE PROMPT ROUTINE WILL BE ENTERED TO EITHER * 40130000 * /* PROMPT THE USER WITH THE "ENTER ..." MESSAGE OR IF NOT * 40140000 * /* REQUIRED, GO THE PROCESS THE PARAMETER ON THE NEXT PCE * 40150000 * /***************************************************************** 40160000 * STRPGMID: /* SCAN FOR VALID DATANAME * 40170000 * FIRSTNAM='0'B; /* INITIALIZE SWITCH USED IN SCAN* 40180000 STRPGMID NI 601(@B),B'01111111' 0684 40190000 * DIGITCT=DIGITCT+1; /* INITIALIZE DIGITCOUNT - THE 40200000 * FIRST CHAR WAS FOUND TO BE 40210000 * ALPHABETIC * 40220000 LA @F,1 0685 40230000 SR @0,@0 0685 40240000 IC @0,596(0,@B) 0685 40250000 AR @F,@0 0685 40260000 STC @F,596(0,@B) 0685 40270000 * CHK: /* CHECK OTHER CHARS FOR VALIDITY* 40280000 * R4=R4+1; /* UPDATE TO NEXT CHARACTER * 40290000 CHK AH @4,@D2 0686 40300000 * IF R4=>ENDINPUT /* IF AT END OF BUFFER, THIS * 40310000 * THEN /* IS NOT A STATEMENT NUMBER * 40320000 C @4,144(0,@B) 0687 40330000 * GOTO REJECT; /* CONSIDER JUST LIKE INVALID 40340000 * FIRST CHARACTER * 40350000 BC 10,REJECT 0688 40360000 * IF COMBUF=';' /* IF INPUT POINTING TO SEMI * 40370000 * THEN /* TREAT JUST LIKE * 40380000 CLI 0(@4),C';' 0689 40390000 * GOTO REJECT; /* EOB * 40400000 BC 08,REJECT 0690 40410000 * IF FIRSTNAM='1'B /* IF FIRST NAME SWITCH ON WE * 40420000 * THEN /* ARE LOOKING AT WHAT SHOULD * 40430000 TM 601(@B),B'10000000' 0691 40440000 BC 12,@9A7 0691 40450000 * DO; /* BE A NUMERIC * 40460000 * FIRSTNAM='0'B; /* TURN CONTROL SWITCH OFF * 40470000 NI 601(@B),B'01111111' 0693 40480000 * GOTO NUMERCK; /* GO MAKE SURE NUMERIC FOLLOWS * 40490000 BC 15,NUMERCK 0694 40500000 * END; /* WHAT APPEARED TO BE A VALID 40510000 * PGMID PART OF A STATEMENT 40520000 * NUMBER - IF NOT NUMERIC, WILL 40530000 * ASSUME STATEMENT NUMBER WAS 40540000 * NOT ENTERED * 40550000 * IF DIGITCT>8 /* IF MORE THAN EIGHT CHARS * 40560000 * THEN /* SCANNED IS NOT A PGMID * 40570000 @9A7 CLI 596(@B),8 0696 40580000 * GOTO REJECT; /* PORTION OF A STATEMENT NUMBER 40590000 * CONSIDER THE STATEMENT NUMBER 40600000 * NOT ENTERED * 40610000 BC 02,REJECT 0697 40620000 * ADDCDE=8; /* IF STILL IN PGMID SCAN GO * 40630000 LA @F,8 0698 40640000 * R1='D0'X; /* TO TYPETEST TO SEE IF VALID * 40650000 LA @1,X'D0' 0699 40660000 * CALL LINKRET; /* CHAR FOR A PGMID * 40670000 BAL @E,LINKRET 0700 40680000 * GOTO PERCHK; /* IF NOT VALID, CHECK FOR PERIOD* 40690000 BC 15,PERCHK 0701 40700000 * GEN; /* GENERATE PROPER BRANCHES * 40710000 BC 15,STRPGMID IF VALID, CONTINUE CHECK 40720000 DS 0H 40730000 * PERCHK: /* CHECK - MAKE SURE INVALID 40740000 * CHAR IS A PERIOD * 40750000 * IF COMBUF^='4B'X /* IF NOT PERIOD, IS NOT A VALID * 40760000 * THEN /* PGMID, DONSIDER THE STATEMENT * 40770000 PERCHK CLI 0(@4),X'4B' 0703 40780000 * GOTO REJECT; /* NUMBER MISSING * 40790000 BC 07,REJECT 0704 40800000 * FIRSTNAM='1'B; /* INDICATE NUMERIC MUST FOLLOW * 40810000 OI 601(@B),B'10000000' 0705 40820000 * GOTO CHK; /* GO CHECK FOR VALID CHARACTER * 40830000 BC 15,CHK 0706 40840000 * NUMERCK: /* MAKE SURE NUMERIC AFER PGMID * 40850000 * R1='10'X; /* PLACE NUMERIC MASK IN R1 * 40860000 NUMERCK LA @1,X'10' 0707 40870000 * ADDCDE=8; /* FOR TYPETEST * 40880000 LA @F,8 0708 40890000 * CALL LINKRET; /* CHECK FOR NUMERIC * 40900000 BAL @E,LINKRET 0709 40910000 * GOTO REJECT; /* IF +0 - NOT NUMERIC - CONSIDER 40920000 * THAT THE PARAMETER IS NOT 40930000 * A STATEMENT NUMBER * 40940000 BC 15,REJECT 0710 40950000 * DATAPTR=INVPSAVE; /* IF NUMERIC, PARAMETER IS A 40960000 * STATEMENT NUMBER - FILL IN 40970000 * PDE WITH POINTER TO PGMID 40980000 * PORTION OF STATEMENT NUMBER * 40990000 L @1,564(0,@B) 0711 41000000 MVC 8(4,@1),300(@B) 0711 41010000 * LNGTH1=DIGITCT; /* FILL IN LENGTH OF PGMID * 41020000 MVC 0(1,@1),596(@B) 0712 41030000 * DIGITCT=0; /* ZERO DIGIT COUNT * 41040000 MVI 596(@B),0 0713 41050000 * DATAPTRA=R4; /* FILL IN POINTER TO LINE 41060000 * NUMBER IN PDE * 41070000 L @1,564(0,@B) 0714 41080000 ST @4,12(0,@1) 0714 41090000 * GOTO NUMCK2; /* GO TO SCAN REST OF STATEMENT 41100000 * NUMBER BEGINNING WITH 2ND 41110000 * CHAR OF LINE NUMBER * 41120000 BC 15,NUMCK2 0715 41130000 * REJECT: /* PARAMETER NOT A VALID STATE- 41140000 * MENT NUMBER - MUST PARSE ON 41150000 * NEXT PCE * 41160000 * FIRSTNAM='0'B; /* SET CONTROL SWITCH OFF * 41170000 REJECT NI 601(@B),B'01111111' 0716 41180000 * DIGITCT=0; /* REINITIALIZE ALL FIELDS USED * 41190000 MVI 596(@B),0 0717 41200000 * R4=INVPSAVE; /* REINITIALIZE INPUT POINTER TO 41210000 * BEGINNING OF PARAMETER SO WILL 41220000 * GET PUSHED ON STACK * 41230000 L @4,300(0,@B) 0718 41240000 * GOTO MAXLNGTH; /* GO TO ROUTINE WHICH WILL GO 41250000 * PROMPT WITH "ENTER.... IF THE 41260000 * STATEMENT NUMBER IS REQUIRED * 41270000 BC 15,MAXLNGTH 0719 41280000 * SEPSCAN: 41290000 * /***************************************************************** 41300000 * /* * 41310000 * /* DETERMINE IF END OF BUFFER HAS BEEN REACHED * 41320000 * /* * 41330000 * /***************************************************************** 41340000 * IF R4=>ENDINPUT /* IS THIS END OF BUFFER A00996 * 41350000 * THEN /* IF YES, CHECK FOR A00996 * 41360000 SEPSCAN C @4,144(0,@B) 0720 41370000 * GOTO SEPFOUND; /* LIST PROCESSING A00996 * 41380000 BC 10,SEPFOUND 0721 41390000 * ADDCDE=8; /* ADDR OF TYPETEST IN REG 15 * 41400000 LA @F,8 0722 41410000 * R1='08'X; /* SEPARATOR MASK IN REG 1 * 41420000 LA @1,X'08' 0723 41430000 * CALL LINKRET; /* BRANCH TO PARSE2 * 41440000 BAL @E,LINKRET 0724 41450000 * GEN; /* RETURN BRANCHES * 41460000 BC 15,CKEND CHECK FOR END OF BUFFER 41470000 BC 15,SEPFOUND CHECK FOR LIST PROCESSING 41480000 DS 0H 41490000 * 41500000 * /***************************************************************** 41510000 * /* * 41520000 * /* HAS THE END OF A STATEMENT BEEN REACHED ? * 41530000 * /* * 41540000 * /***************************************************************** 41550000 * 41560000 * CKEND: /* END OF STATEMENT A00996 * 41570000 * IF COMBUF=';' /* INPUT LINE EQUAL SEMICOLON * 41580000 * THEN /* IF YES * 41590000 CKEND CLI 0(@4),C';' 0726 41600000 * GOTO SEPFOUND; /* CHECK FOR LIST PROCESSING * 41610000 BC 08,SEPFOUND 0727 41620000 * R4=R4+1; /* POINT TO NEXT INPUT CHAR * 41630000 AH @4,@D2 0728 41640000 * GOTO SEPSCAN; /* BRANCH TO TYPE TEST * 41650000 BC 15,SEPSCAN 0729 41660000 * 41670000 * SEPFOUND: /* RESET INPUT POINTER * 41680000 * R5=R4; /* RESET INPUT POINTER * 41690000 SEPFOUND LR @5,@4 0730 41700000 * 41710000 * /***************************************************************** 41720000 * /* * 41730000 * /* DETERMINE IF THIS PROCESSING IS FOR A LIST * 41740000 * /* * 41750000 * /***************************************************************** 41760000 * 41770000 * IF PFLIST='1'B /* IS THIS LIST PROCESSING ? * 41780000 * THEN /* IF YES * 41790000 TM 176(@B),B'10000000' 0731 41800000 BC 12,@9A6 0731 41810000 * 41820000 * /************************************************************* 41830000 * /* * 41840000 * /* CHECK FOR END OF LIST EXPRESSION * 41850000 * /* * 41860000 * /************************************************************* 41870000 * 41880000 * IF VCOMBF=')' /* PREVIOUS CHAR EQUAL PAREN * 41890000 * THEN /* IF YES 41900000 * SET XINPUTB TO CHAR AFTER * 41910000 LR @1,@4 0732 41920000 LR @A,@1 0732 41930000 BCTR @A,0 0732 41940000 CLI 0(@A),C')' 0732 41950000 BC 07,@9A5 0732 41960000 * R5=R5-1; /* THE END OF STATEMENT * 41970000 BCTR @5,0 0733 41980000 * ERREXIT: /* SET UP TO ISSUE A00996 * 41990000 * DIGITCT=0; /* SET DIGIT CT TO ZERO A00996 * 42000000 @9A5 EQU * 0734 42010000 @9A6 EQU * 0734 42020000 ERREXIT MVI 596(@B),0 0734 42030000 * GOTO CODE4B; /* GO TO ISSUE PROMPT A00996 42040000 * MESSAGE A00996 * 42050000 BC 15,CODE4B 0735 42060000 * 42070000 * RANGECK: 42080000 * CALL TSTRNGE; /* TEST FOR RANGE A00996 * 42090000 RANGECK L @F,@V5 ADDRESS OF TSTRNGE 0736 42100000 BALR @E,@F 0736 42110000 * GEN; /* RETURN BRANCHES * 42120000 BC 15,RANGCHK CHECK FOR 6 PROCESSING 42130000 BC 15,COMPDE01 SET PARM PRESENT BIT IN PDE 42140000 DS 0H 42150000 * 42160000 * /***************************************************************** 42170000 * /* * 42180000 * /* DETERMINE IF FIRST VALUE OF A RANGE HAS BEEN PROCESSED * 42190000 * /* * 42200000 * /***************************************************************** 42210000 * 42220000 * 42230000 * RANGCHK: 42240000 * IF RNGEVAL1='1'B /* FIRST VALUE OF RANGE ? * 42250000 * THEN /* IF YES * 42260000 RANGCHK TM 177(@B),B'01000000' 0738 42270000 * GOTO SEPSCAN; /* BRANCH, CHECK FOR SEPARATOR * 42280000 BC 01,SEPSCAN 0739 42290000 * 42300000 * /***************************************************************** 42310000 * /* * 42320000 * /* DETERMINE IF SECOND VALUE OF RANGE HAS BEEN PROCESSED * 42330000 * /* * 42340000 * /***************************************************************** 42350000 * 42360000 * IF RNGEVAL2='1'B /* SECOND VALUE OF RANGE ? * 42370000 * THEN /* IF YES * 42380000 TM 177(@B),B'00001000' 0740 42390000 BC 12,@9A4 0740 42400000 * DO; /* INDICATE PARAMETER PRESENT * 42410000 * 42420000 * COMPDE01: 42430000 * PARMIND='1'B; /* SET PARM PRESENT BIT IN PDE * 42440000 COMPDE01 L @1,564(0,@B) 0742 42450000 OI 6(@1),B'10010000' 0742 42460000 * STATE='1'B; /* PDE TYPE EQUAL STATEMENT NO. * 42470000 * PPOINTR=INVPSAVE; /* SET POINTER FOR TRANSLATION * 42480000 MVC 148(4,@B),300(@B) 0744 42490000 * PLENGTH=R4-PPOINTR; /* SET LENGTH OF DATA * 42500000 L @F,148(0,@B) 0745 42510000 LCR @F,@F 0745 42520000 AR @F,@4 0745 42530000 STH @F,152(0,@B) 0745 42540000 * ADDCDE=9; /* ADDR OF TRANSQ IN REG 15 * 42550000 LA @F,9 0746 42560000 * R1=PPCOUNT; /* SET LENGTH IN REG 1 * 42570000 SR @1,@1 0747 42580000 IC @1,417(0,@B) 0747 42590000 * CALL LINKRET; /* BRANCH TO PARSE2 * 42600000 BAL @E,LINKRET 0748 42610000 * GOTO VAREXIT; /* EXIT VIA VARIABLE RTN * 42620000 BC 15,VAREXIT 0749 42630000 * END; /* RANGE HAS NOT BEEN PROCESSED * 42640000 * ADDCDE=8; /* ADDR OF TYPE TEST IN REG 15 * 42650000 @9A4 LA @F,8 0751 42660000 * R1='08'X; /* BLANK-TAB-COMMA MASK IN REG1 * 42670000 LA @1,X'08' 0752 42680000 * CALL LINKRET; /* BRANCH TO PARSE2 * 42690000 BAL @E,LINKRET 0753 42700000 * GEN; /* BRANCH RETURNS * 42710000 BC 15,CHKSEM CHECK FOR SEMICOLON 42720000 BC 15,COMPDE01 INDICATE PARAMETER PRESENT 42730000 DS 0H 42740000 * 42750000 * /***************************************************************** 42760000 * /* * 42770000 * /* HAS THE END OF A STATEMENT BEEN REACHED ? * 42780000 * /* * 42790000 * /***************************************************************** 42800000 * 42810000 * 42820000 * CHKSEM: 42830000 * IF COMBUF=';' /* INPUT LINE EQUAL SEMICOLON * 42840000 * THEN /* IF YES * 42850000 CHKSEM CLI 0(@4),C';' 0755 42860000 * GOTO COMPDE01; /* INDICATE PARAMETER PRESENT * 42870000 BC 08,COMPDE01 0756 42880000 * 42890000 * /***************************************************************** 42900000 * /* * 42910000 * /* DETERMINE IF END OF BUFFER HAS BEEN REACHED * 42920000 * /* * 42930000 * /***************************************************************** 42940000 * 42950000 * IF R4=>ENDINPUT /* IS THIS END OF INPUT BUFFER 42960000 * A00996 * 42970000 * THEN /* IF YES * 42980000 C @4,144(0,@B) 0757 42990000 * GOTO COMPDE01; /* INDICATE PARAMETER PRESENT * 43000000 BC 10,COMPDE01 0758 43010000 * 43020000 * /***************************************************************** 43030000 * /* * 43040000 * /* CHECK FOR END OF LIST EXPRESSION * 43050000 * /* * 43060000 * /***************************************************************** 43070000 * 43080000 * IF COMBUF^=')' /* INPUT CHAR NOT EQUAL PAREN * 43090000 * THEN /* IF YES * 43100000 CLI 0(@4),C')' 0759 43110000 * GOTO SEPSCAN; /* CHECK FOR SEPARATOR * 43120000 BC 07,SEPSCAN 0760 43130000 * 43140000 * /***************************************************************** 43150000 * /* * 43160000 * /* CHECK FOR LIST PROCESSING * 43170000 * /* * 43180000 * /***************************************************************** 43190000 * 43200000 * IF LIST^='1'B /* IF NOT LIST PROCESSING * 43210000 * THEN /* IF YES * 43220000 TM 1(@6),B'10000000' 0761 43230000 * GOTO SEPSCAN; /* CHECK FOR SEPARATOR * 43240000 BC 12,SEPSCAN 0762 43250000 * R4=R4-1; /* POINT TO PREV INPUT CHAR * 43260000 BCTR @4,0 0763 43270000 * GOTO COMPDE01; /* INDICATE PARAMETER PRESENT * 43280000 BC 15,COMPDE01 0764 43290000 * 43300000 * BUMP1: 43310000 * R4=R4+1; /* POINT TO NEXT INPUT CHAR * 43320000 BUMP1 AH @4,@D2 0765 43330000 * 43340000 * /***************************************************************** 43350000 * /* * 43360000 * /* DETERMINE IF END OF BUFFER HAS BEEN REACHED * 43370000 * /* * 43380000 * /***************************************************************** 43390000 * 43400000 * IF R4=>ENDINPUT /* IS THIS END OF INPUT BUFFER 43410000 * A00996 * 43420000 * THEN /* IF YES * 43430000 C @4,144(0,@B) 0766 43440000 * GOTO ERREXIT; /* BRANCH TO ISSUE PROMPT MSG * 43450000 BC 10,ERREXIT 0767 43460000 * 43470000 * /***************************************************************** 43480000 * /* * 43490000 * /* HAS THE END OF A STATEMENT BEEN REACHED ? * 43500000 * /* * 43510000 * /***************************************************************** 43520000 * 43530000 * IF COMBUF=';' /* INPUT LINE EQUAL SEMICOLON * 43540000 * THEN /* IF YES * 43550000 CLI 0(@4),C';' 0768 43560000 * GOTO ERREXIT; /* BRANCH TO ISSUE PROMPT MSG * 43570000 BC 08,ERREXIT 0769 43580000 * ADDCDE=8; /* ADDR OF TYPE TEST IN REG 15 * 43590000 LA @F,8 0770 43600000 * R1='10'X; /* NUMERIC MASK IN REG 1 * 43610000 LA @1,X'10' 0771 43620000 * CALL LINKRET; /* BRANCH TO PARSE2 * 43630000 BAL @E,LINKRET 0772 43640000 * GOTO SEPSCAN; /* CHECK FOR SEPARATOR * 43650000 BC 15,SEPSCAN 0773 43660000 * DATAPTRB=R4; /* ADDR OF VERB IN PDE * 43670000 L @1,564(0,@B) 0774 43680000 ST @4,16(0,@1) 0774 43690000 * LNGTH3=1; /* LENGTH OF VERB IN PDE * 43700000 MVI 2(@1),1 0775 43710000 * R4=R4+1; /* POINT TO NEXT INPUT CHAR * 43720000 AH @4,@D2 0776 43730000 * GOTO RANGECK; /* CHECK FOR RANGE PROCESSING * 43740000 BC 15,RANGECK 0777 43750000 * 43760000 * IKJEFP6C: /* CONSTANT PROCESSING * 43770000 * 43780000 * /***************************************************************** 43790000 * /* * 43800000 * /* THIS CONSTANT SUBROUTINE IS ENTERED WHENEVER THE PCE TYPE IS * 43810000 * /* 'CONST' OR 'ANY'. WHEN 'ANY'IS SPECIFIED, THE CONSTANT ROUTINE* 43820000 * /* SCANS THE INPUT AS IF IT WERE A CONSTANT. IF A CONSTANT IS * 43830000 * /* FOUND, IT IS PROCESSED AS A CONSTANT. IF A VALID CONSTANT IS * 43840000 * /* NOT FOUND, IT IS PROCESSED AS A VARIABLE. ALL PROMPTING WILL * 43850000 * /* BE FOR A VARIABLE. DETERMINE IF IKJTERM IS PROCESSING A * 43860000 * /* SUBSCRIPT * 43870000 * /* * 43880000 * /***************************************************************** 43890000 * 43900000 * 43910000 * SUBTEST: 43920000 * IF SUBSMODE='1'B /* TERM PROCESSING A SUBSCRIPT * 43930000 * THEN /* IF YES * 43940000 IKJEFP6C EQU * 0778 43950000 SUBTEST TM 599(@B),B'00100000' 0778 43960000 BC 12,@9A3 0778 43970000 * DO; /* CHECK FOR ERROR MODE * 43980000 * 43990000 * /************************************************************* 44000000 * /* * 44010000 * /* DETERMINE IF IKJTERM HAS ENCOUNTERED AN ERROR * 44020000 * /* * 44030000 * /************************************************************* 44040000 * 44050000 * IF ERRORBIT='1'B /* ERROR IN TERM PROCESSING? * 44060000 * THEN /* IF YES * 44070000 TM 599(@B),B'00001000' 0780 44080000 BC 12,@9A2 0780 44090000 * DO; /* CHECK FOR END OF BUFFER * 44100000 * 44110000 * /********************************************************* 44120000 * /* * 44130000 * /* DETERMINE IF END OF BUFFER HAS BEEN REACHED * 44140000 * /* * 44150000 * /********************************************************* 44160000 * 44170000 * 44180000 * ENDTEST: 44190000 * IF R4=>ENDINPUT /* END OF INPUT BUFFER REACHED 44200000 * A00996 * 44210000 * THEN /* IF YES * 44220000 ENDTEST C @4,144(0,@B) 0782 44230000 * GOTO VERRBIT; /* PROCESS AS AN ERROR * 44240000 BC 10,VERRBIT 0783 44250000 * 44260000 * /********************************************************* 44270000 * /* * 44280000 * /* CHECK FOR THE END OF INPUT DATA * 44290000 * /* * 44300000 * /********************************************************* 44310000 * 44320000 * IF COMBUF=';' /* INPUT LINE EQUAL SEMICOLON * 44330000 * THEN /* IF YES * 44340000 CLI 0(@4),C';' 0784 44350000 * GOTO VERRBIT; /* ISSUE PROMPT MSG * 44360000 BC 08,VERRBIT 0785 44370000 * 44380000 * /********************************************************* 44390000 * /* * 44400000 * /* CHECK THE ELEMENT COUNT FOR MAXIMUM # SUBSCRIPTS * 44410000 * /* * 44420000 * /********************************************************* 44430000 * 44440000 * 44450000 * SUBENDCK: 44460000 * IF ELEMNCT=3 /* NUMBER SUBSCRIPTS EQUAL 3 * 44470000 * THEN /* IF YES * 44480000 SUBENDCK CLI 597(@B),3 0786 44490000 BC 07,@9A1 0786 44500000 * DO; /* INDICATE TERM ERROR * 44510000 * ERRORBIT='1'B; /* SET ERROR BIT ON * 44520000 OI 599(@B),B'00001000' 0788 44530000 * GOTO SUBERSCN; /* RESET PDE POINTER * 44540000 BC 15,SUBERSCN 0789 44550000 * END; /* NUMBER SUBSCRIPTS NOT = 3 * 44560000 * PDEPTR=PDEPTR+20; /* NEXT AVAILABLE SPACE IN PDE * 44570000 @9A1 LA @F,20 0791 44580000 A @F,564(0,@B) 0791 44590000 ST @F,564(0,@B) 0791 44600000 * GOTO ALPHATST; /* BRANCH TO TYPE TEST * 44610000 BC 15,ALPHATST 0792 44620000 * END; /* IF ERROR BIT IS NOT ON * 44630000 * PRMTPTR=R4; /* SET SPECIAL MSG POINTER * 44640000 @9A2 ST @4,584(0,@B) 0794 44650000 * GOTO ENDTEST; /* CHECK FOR END OF BUFFER * 44660000 BC 15,ENDTEST 0795 44670000 * END; 44680000 * 44690000 * STPDEPTR: /* SET PDEPTR TO TEMP PDE * 44700000 * PDEPTR=ADDR (TEMPPDE); /* SET PDEPTR TO ADDR TEMPPDE * 44710000 @9A3 EQU * 0797 44720000 STPDEPTR LA @F,332(0,@B) 0797 44730000 ST @F,564(0,@B) 0797 44740000 * 44750000 * ALPHATST: /* CHECK FOR ALPHA CHAR * 44760000 * ADDCDE=8; /* ADDR OF TYPE TEST IN REG 15 * 44770000 ALPHATST LA @F,8 0798 44780000 * R1='C0'X; /* ALPHA MASK IN REG 1 * 44790000 LA @1,X'C0' 0799 44800000 * CALL LINKRET; /* BRANCH TO PARS2 * 44810000 BAL @E,LINKRET 0800 44820000 * GEN; /* RETURN BRANCHES * 44830000 BC 15,CHKQUOT CHECK FOR '7D'X 44840000 BC 15,RSVWDPC CHECK FOR RESERVED WORD PCE 44850000 DS 0H 44860000 * 44870000 * /***************************************************************** 44880000 * /* * 44890000 * /* CHECK INPUT LINE FOR QUOTED STRING PROCESSING * 44900000 * /* * 44910000 * /***************************************************************** 44920000 * 44930000 * 44940000 * CHKQUOT: 44950000 * IF COMBUF='7D'X /* INPUT LINE EQUAL QUOTE ? * 44960000 * THEN /* IF YES * 44970000 CHKQUOT CLI 0(@4),X'7D' 0802 44980000 * GOTO QSTRING1; /* BRANCH TO QUOTED STRING RTN * 44990000 BC 08,QSTRING1 0803 45000000 * 45010000 * /***************************************************************** 45020000 * /* * 45030000 * /* CHECK INPUT LINE FOR MINUS SIGN * 45040000 * /* * 45050000 * /***************************************************************** 45060000 * 45070000 * IF COMBUF='-' /* INPUT CHAR EQUAL MINUS * 45080000 * THEN /* IF YES * 45090000 CLI 0(@4),C'-' 0804 45100000 * GOTO SETMINUS; /* SET MINUS INDICATOR IN PDE * 45110000 BC 08,SETMINUS 0805 45120000 * GOTO SETPLUS; /* SET PLUS INDICATOR IN PDE * 45130000 BC 15,SETPLUS 0806 45140000 * 45150000 * /***************************************************************** 45160000 * /* * 45170000 * /* DETERMINE IF IKJTERM IS PROCESSING A SUBSCRIPT * 45180000 * /* * 45190000 * /***************************************************************** 45200000 * 45210000 * 45220000 * SUBTST: 45230000 * IF SUBSMODE='1'B /* TERM PROCESSING A SUBSCRIPT * 45240000 * THEN /* IF YES * 45250000 SUBTST TM 599(@B),B'00100000' 0807 45260000 * GOTO VERRBIT; /* SET ERROR BIT ON * 45270000 BC 01,VERRBIT 0808 45280000 * 45290000 * PCEUPDTE: /* UPDATE TO NEXT PCE * 45300000 * R6=R6+PCELNGTH; /* XPCE EQUL NEXT PCE * 45310000 PCEUPDTE MVC @TEMP2+2(2),2(@6) 0809 45320000 A @6,@TEMP2 0809 45330000 * COBOLMOD='0'B; /* TURN OFF COBOL SWITCH * 45340000 NI 599(@B),B'01111111' 0810 45350000 * GEN (BAL @E,@EL01); /* ISSUE FREEMAIN * 45360000 BAL @E,@EL01 45370000 DS 0H 45380000 * ADDCDE=19; /* RETRUN TO NEXTPCE SUBROUT- INE 45390000 * IN PARSE * 45400000 LA @F,19 0812 45410000 * CALL LINKRET; /* CALL RETURN ROUTINE * 45420000 BAL @E,LINKRET 0813 45430000 * 45440000 * SETPLUS: /* SET PLUS INDICATOR IN PDE * 45450000 * 45460000 * /***************************************************************** 45470000 * /* * 45480000 * /* CHECK INPUT LINE FOR PLUS SIGN * 45490000 * /* * 45500000 * /***************************************************************** 45510000 * 45520000 * IF COMBUF^='+' /* INPUT CHAR NOT EQUAL PLUS * 45530000 * THEN /* IF YES * 45540000 SETPLUS CLI 0(@4),C'+' 0814 45550000 * GOTO PERIODCK; /* CHECK FOR PERIOD * 45560000 BC 07,PERIODCK 0815 45570000 * 45580000 * CBUMP02: 45590000 * R4=R4+1; /* POINT TO NEXT INPUT CHAR * 45600000 CBUMP02 AH @4,@D2 0816 45610000 * 45620000 * /***************************************************************** 45630000 * /* * 45640000 * /* CHECK FOR END OF INPUT DATA * 45650000 * /* * 45660000 * /***************************************************************** 45670000 * 45680000 * IF COMBUF=';' /* INPUT LINE EQUAL SEMICOLON * 45690000 * THEN /* IF YES * 45700000 CLI 0(@4),C';' 0817 45710000 * GOTO VERRBIT; /* ISSUE PROMPT MSG * 45720000 BC 08,VERRBIT 0818 45730000 * 45740000 * /***************************************************************** 45750000 * /* * 45760000 * /* DETERMINE IF END OF BUFFER HAS BEEN REACHED * 45770000 * /* * 45780000 * /***************************************************************** 45790000 * 45800000 * IF R4=>ENDINPUT /* END OF INPUT BUFFER ? A00996 * 45810000 * THEN /* IF YES * 45820000 C @4,144(0,@B) 0819 45830000 * GOTO VERRBIT; /* ISSUE PROMPT MESSAGE * 45840000 BC 10,VERRBIT 0820 45850000 * CONST='1'B; /* INDICATE A DEFINITE CONS- HAS 45860000 * BEEN FOUND SO TERM WILL NOT BE 45870000 * PROCESSED AS A VARIABLE * 45880000 L @1,564(0,@B) 0821 45890000 OI 6(@1),B'01000000' 0821 45900000 * 45910000 * /***************************************************************** 45920000 * /* * 45930000 * /* CHECK INPUT LINE FOR A PERIOD * 45940000 * /* * 45950000 * /***************************************************************** 45960000 * 45970000 * 45980000 * PERIODCK: /* SCAN INPUT CHAR FOR PERIOD * 45990000 * IF COMBUF='4B'X /* INPUT CHAR EQUAL PERIOD * 46000000 * THEN /* IF YES * 46010000 PERIODCK CLI 0(@4),X'4B' 0822 46020000 BC 07,@9A0 0822 46030000 * DO; /* STORE PTR TO STRING * 46040000 * DATAPTR=R4; /* PTR TO STRING * 46050000 L @1,564(0,@B) 0824 46060000 ST @4,8(0,@1) 0824 46070000 * GOTO PPDSCAN; /* STORE INPUT PTR IN PDE * 46080000 BC 15,PPDSCAN 0825 46090000 * END; /* END PERIOD PROCESSING * 46100000 * ADDCDE=8; /* ADDR OF TYPE TEST IN REG 15 * 46110000 @9A0 LA @F,8 0827 46120000 * R1='10'X; /* NUMERIC MASK IN REG 1 * 46130000 LA @1,X'10' 0828 46140000 * CALL LINKRET; /* BRANCH TO PARSE2 * 46150000 BAL @E,LINKRET 0829 46160000 * GEN; /* RETURN BRANCHES * 46170000 BC 15,ZERTEMP 0 TEMP PDE 46180000 BC 15,PREPDSCN STROE DIGIT STRING PTR 46190000 DS 0H 46200000 * 46210000 * ZERTEMP: /* ZERO TEMPORARY PDE * 46220000 * IF CONST='1'B /* IF A SIGN WAS ENCOUNTERED * 46230000 * THEN /* CANNOT PROCESS AS A VARIABL * 46240000 ZERTEMP L @1,564(0,@B) 0831 46250000 TM 6(@1),B'01000000' 0831 46260000 * GOTO VERRBIT; /* AND IS AN ERROR * 46270000 BC 01,VERRBIT 0832 46280000 * CNSTTEMP = /* ZERO CNSTTEMP * 46290000 * CNSTTEMP && CNSTTEMP; /* PDEPTR POINTS TO TEMP PDE * 46300000 XC 0(20,@1),0(@1) 0833 46310000 * 46320000 * /***************************************************************** 46330000 * /* * 46340000 * /* TEST IF PCE TYPE EQUAL ANY * 46350000 * /* * 46360000 * /***************************************************************** 46370000 * 46380000 * 46390000 * PARMTEST: /* TEST FOR TYPE EQUAL ANY * 46400000 * IF ANY = '1'B /* TYPE EQUAL ANY * 46410000 * THEN /* IF YES * 46420000 PARMTEST TM 6(@6),B'00010000' 0834 46430000 * GOTO GOTOVAR; /* GOTO TO PREPARE FOR VARIABLE 46440000 * PROCESSING * 46450000 BC 01,GOTOVAR 0835 46460000 * 46470000 * /***************************************************************** 46480000 * /* * 46490000 * /* DETERMINE IF CURRENTLY PROCESSING A LIST * 46500000 * /* * 46510000 * /***************************************************************** 46520000 * 46530000 * 46540000 * PROMPT05: /* TEST FOR LIST PROCESSING * 46550000 * IF PFLIST = '1'B /* TEST LIST BIT IN PWA * 46560000 * THEN /* IF ON * 46570000 PROMPT05 TM 176(@B),B'10000000' 0836 46580000 * GOTO VERRBIT; /* SCAN TO END OF PARM * 46590000 BC 01,VERRBIT 0837 46600000 * 46610000 * /***************************************************************** 46620000 * /* * 46630000 * /* DETERMINE IF IKJTERM IS PROCESSING A SUBSCRIPT * 46640000 * /* * 46650000 * /***************************************************************** 46660000 * 46670000 * IF SUBSMODE='1'B /* TERM PROCESSING SUBSCRIPT * 46680000 * THEN /* IF YES * 46690000 TM 599(@B),B'00100000' 0838 46700000 * GOTO VERRBIT; /* ERROR, FOUND END OF SUBSCRP * 46710000 BC 01,VERRBIT 0839 46720000 * 46730000 * /***************************************************************** 46740000 * /* * 46750000 * /* CHECK FOR INVALID FIRST CHAR * 46760000 * /* * 46770000 * /***************************************************************** 46780000 * 46790000 * IF R4^=INVPSAVE /* INVALID FIRST CHAR ? * 46800000 * THEN /* IF NO * 46810000 C @4,300(0,@B) 0840 46820000 * GOTO VERRBIT; /* SCAN FOR END OF PARM * 46830000 BC 07,VERRBIT 0841 46840000 * 46850000 * /***************************************************************** 46860000 * /* * 46870000 * /* DETERMINE IF MISSING PROMPT MSG HAS BEEN ISSUED * 46880000 * /* * 46890000 * /***************************************************************** 46900000 * 46910000 * IF PRMTSCAN='1'B /* MISSING PROMPT MSG ISSUED ? * 46920000 * THEN /* IF YES * 46930000 TM 600(@B),B'00000100' 0842 46940000 BC 12,@99F 0842 46950000 * DO; /* SCAN TILL END FOR ERROR MSG * 46960000 * R4=R4+1; /* START SCAN AFTER FIRST CHAR * 46970000 AH @4,@D2 0844 46980000 * GOTO VERRBIT; /* ERROR GOTO END OF SUBSCRIPT * 46990000 BC 15,VERRBIT 0845 47000000 * END; /* END INVALID PROCESSING * 47010000 * R4=R4-1; /* GET FIRST CHAR ON STACK * 47020000 @99F BCTR @4,0 0847 47030000 * ADDCDE=2; /* ADDR OF PROMPTQ IN REG 15 * 47040000 LA @F,2 0848 47050000 * CALL LINKRET; /* BRANCH TO PARSE2 * 47060000 BAL @E,LINKRET 0849 47070000 * GOTO STRPTR; /* STORE POINTER TO INPUT DATA * 47080000 BC 15,STRPTR 0850 47090000 * 47100000 * /***************************************************************** 47110000 * /* * 47120000 * /* TEST TO DETERMINE IF IKJOPER HAS BEEN ENTERED * 47130000 * /* * 47140000 * /***************************************************************** 47150000 * 47160000 * IF OPERMODE='1'B /* IS THIS IN OPER MODE? * 47170000 * THEN /* IF UES * 47180000 TM 599(@B),B'01000000' 0851 47190000 * GOTO VERRBIT; /* BRANCH TO ISSUE PROMPT MSG * 47200000 BC 01,VERRBIT 0852 47210000 * GOTO PCEUPDTE; /* UPDATE TO NEXT PCE * 47220000 BC 15,PCEUPDTE 0853 47230000 * 47240000 * STRPTR: 47250000 * PRMTSCAN='1'B; /* INDICATE PROMPT MSG ISSUED * 47260000 STRPTR OI 600(@B),B'00000100' 0854 47270000 * GOTO INPUTUP; /* PTR TO NEXT INPUT CHAR * 47280000 BC 15,INPUTUP 0855 47290000 * 47300000 * PPDSCAN: 47310000 * IF DECPT='1'B /* IF ONE DECIMAL POINT HAS * 47320000 * THEN /* THEN A SECOND INDICATES A * 47330000 PPDSCAN L @1,564(0,@B) 0856 47340000 TM 7(@1),B'00100000' 0856 47350000 * GOTO VERRBIT; /* INVALID CONSTANT * 47360000 BC 01,VERRBIT 0857 47370000 * DATAPTRB=R4; /* STORE PTR TO PERIOD IN PDE * 47380000 ST @4,16(0,@1) 0858 47390000 * DECPT='1'B; /* SET DEC PTR FLAG IN PDE * 47400000 OI 7(@1),B'00100000' 0859 47410000 * 47420000 * CBUMP04: 47430000 * R4=R4+1; /* POINT TO NEXT INPUT CHAR * 47440000 CBUMP04 AH @4,@D2 0860 47450000 * IF R4=>ENDINPUT /* IF AT END OF BUFFER A00996 * 47460000 * THEN /* AFTER DEC. PT. IS AN A00996 * 47470000 C @4,144(0,@B) 0861 47480000 * GOTO VERRBIT; /* ERROR A00996 * 47490000 BC 10,VERRBIT 0862 47500000 * 47510000 * CBUMP: 47520000 * ADDCDE=8; /* USE TYPETEST TO DETERMINE * 47530000 CBUMP LA @F,8 0863 47540000 * R1='10'X; /* IF CHAR IS NUMERIC, IF NOT * 47550000 LA @1,X'10' 0864 47560000 * CALL LINKRET; /* MUST BE AN E OR THERE IS * 47570000 BAL @E,LINKRET 0865 47580000 * GOTO ETEST1; /* AN ERROR, GO TO CHECK FOR E * 47590000 BC 15,ETEST1 0866 47600000 * 47610000 * NUMER: 47620000 * DIGITCT=DIGITCT+1; /* IF WAS NUMERIC CHECK REST * 47630000 NUMER LA @F,1 0867 47640000 SR @0,@0 0867 47650000 IC @0,596(0,@B) 0867 47660000 AR @F,@0 0867 47670000 STC @F,596(0,@B) 0867 47680000 * R4=R4+1; /* UNTIL HIT NON NUMERIC * 47690000 AH @4,@D2 0868 47700000 * IF R4=>ENDINPUT /* IF AT END OF BUFFER A00996 * 47710000 * THEN /* GO TO PROCESS END A00996 * 47720000 C @4,144(0,@B) 0869 47730000 * GOTO MAXDIGIT; /* OF CONSTANT A00996 * 47740000 BC 10,MAXDIGIT 0870 47750000 * ADDCDE=8; /* USE TYPETEST TO CHECK FOR * 47760000 LA @F,8 0871 47770000 * R1='10'X; /* NUMERIC * 47780000 LA @1,X'10' 0872 47790000 * CALL LINKRET; /* GO TO TYPETEST IN PARSE * 47800000 BAL @E,LINKRET 0873 47810000 * GOTO ETEST; /* IF NON NUMERIC GO TO ETEST TO 47820000 * CHECK FOR E * 47830000 BC 15,ETEST 0874 47840000 * GEN (BC 15,NUMER); /* IF NUMERIC, CHECK NEXT CHAR * 47850000 BC 15,NUMER 47860000 DS 0H 47870000 * 47880000 * ETEST1: 47890000 * IF COMBUF='E'| /* MAKE SURE IS EITHER * 47900000 * COMBUF='85'X /* A CAPITAL * 47910000 * THEN /* E OR SMALL E SO KNOW NOT * 47920000 ETEST1 CLI 0(@4),C'E' 0876 47930000 BC 08,@99E 0876 47940000 CLI 0(@4),X'85' 0876 47950000 BC 07,@99D 0876 47960000 * GOTO ETEST; /* AN ERROR * 47970000 BC 08,ETEST 0877 47980000 * ELSE /* IF NOT, KNOW ERROR IF NOT * 47990000 * GOTO VERRBIT; /* NUMERIC OR E FOLLOWING A 48000000 * DECIMAL POINT * 48010000 BC 15,VERRBIT 0878 48020000 * 48030000 * /***************************************************************** 48040000 * /* * 48050000 * /* TEST FOR RESERVED WORD PCE CHAINED TO THIS TERM PCE * 48060000 * /* * 48070000 * /***************************************************************** 48080000 * 48090000 * 48100000 * RSVWDPC: /* CHAINED RESERVED WORD PCE? * 48110000 * IF RESVCHA^='1'B /* TEST RESERVED WRD BIT IN PCE * 48120000 * THEN /* IF NOT ON * 48130000 RSVWDPC TM 1(@6),B'00001000' 0879 48140000 * GOTO PARMTEST; /* TEST FOR TYPE EQUAL ANY * 48150000 BC 12,PARMTEST 0880 48160000 * R4=R4-1; /* PTR TO PREVIOUS INPUT CHAR * 48170000 BCTR @4,0 0881 48180000 * CALL IKJEFP40; /* BRANCH TO RESERVED WORD RTN * 48190000 BAL @E,IKJEFP40 0882 48200000 * GOTO TYPANY; /* TEST FOR TYPE EQUAL ANY * 48210000 BC 15,TYPANY 0883 48220000 * FIGUR = '1'B; /* SET FIGURATIVE CONSTANT BIT * 48230000 L @1,564(0,@B) 0884 48240000 OI 6(@1),B'00000010' 0884 48250000 * GOTO DATAEND; /* TEST FOR SUBSCRIPT MODE * 48260000 BC 15,DATAEND 0885 48270000 * 48280000 * TYPANY: 48290000 * R4=R4+1; /* PTR TO NEXT INPUT CHAR * 48300000 TYPANY AH @4,@D2 0886 48310000 * GOTO PARMTEST; /* TEST FOR TYPE EQUAL ANY * 48320000 BC 15,PARMTEST 0887 48330000 * 48340000 * QSTRING1: /* TEST FOR QUAOTED STRING * 48350000 * ADDCDE=1; /* ADDR OF QSTRING IN REG 15 * 48360000 QSTRING1 LA @F,1 0888 48370000 * CALL LINKRET; /* BRANCH TO PARSE * 48380000 BAL @E,LINKRET 0889 48390000 * GOTO VERRBIT; /* SET ERROR BIT ONE * 48400000 BC 15,VERRBIT 0890 48410000 * 48420000 * /***************************************************************** 48430000 * /* * 48440000 * /* CHECK THE LENGTH OF THE STRING DATA AGAINST MAXIMUM 120 * 48450000 * /* * 48460000 * /***************************************************************** 48470000 * 48480000 * IF COMBUF='7D'X /* IF ENDINPUT FOLLOWS * 48490000 * THEN /* XINPUT LEFT AT ENDING QUOTE * 48500000 CLI 0(@4),X'7D' 0891 48510000 BC 07,@99C 0891 48520000 * R4=R4+1; /* INCREMENT TO NEXT CHAR * 48530000 AH @4,@D2 0892 48540000 * IF PLENGTH>120 /* LENGTH OF DATA GREATER 120 * 48550000 * THEN /* IF YES * 48560000 @99C LA @F,120 0893 48570000 CH @F,152(0,@B) 0893 48580000 * GOTO VERRBIT; /* SET ERROR BIT ON * 48590000 BC 04,VERRBIT 0894 48600000 * DATAPTR=PPOINTR; /* STORE PTR TO DATA IN PDE * 48610000 L @1,564(0,@B) 0895 48620000 MVC 8(4,@1),148(@B) 0895 48630000 * LNGTH1=PLENGTH; /* STORE LENGTH OF DATA IN PDE * 48640000 MVC 0(1,@1),153(@B) 0896 48650000 * NONNUM='1'B; /* INDICATE NON-NUMERIC LITERL * 48660000 OI 6(@1),B'00000100' 0897 48670000 * R5=R4; /* PTR TO CHAR TO BE TRNSLATED * 48680000 LR @5,@4 0898 48690000 * ADDCDE=9; /* ADDR TRANSLATE RTN IN R 15 * 48700000 LA @F,9 0899 48710000 * CALL LINKRET; /* BRANCH TO PARSE * 48720000 BAL @E,LINKRET 0900 48730000 * 48740000 * /***************************************************************** 48750000 * /* * 48760000 * /* DETERMINE IF IKJTERM IS PROCESSING A SUBSCRIPT * 48770000 * /* * 48780000 * /***************************************************************** 48790000 * 48800000 * 48810000 * DATAEND: 48820000 * IF SUBSMODE = '1'B /* TERM PROCESSING A SUBSCRIPT * 48830000 * THEN /* IF YES * 48840000 DATAEND TM 599(@B),B'00100000' 0901 48850000 * GOTO ADELCT; /* BUMP SUBSCRIPT CTR BY ONE * 48860000 BC 01,ADELCT 0902 48870000 * 48880000 * /***************************************************************** 48890000 * /* * 48900000 * /* CHECK FOR END OF LIST EXPRESSION * 48910000 * /* * 48920000 * /***************************************************************** 48930000 * 48940000 * IF R4=>ENDINPUT /* IF AT END OF A00996 * 48950000 * THEN /* BUFFER, GO PROC- A00996 * 48960000 C @4,144(0,@B) 0903 48970000 * GOTO ADD; /* ESS END OF DATA A00996 * 48980000 BC 10,ADD 0904 48990000 * IF COMBUF=')' /* INPUT CHAR NOT EQUAL ) A00996 * 49000000 * THEN /* IF YES A00996 * 49010000 CLI 0(@4),C')' 0905 49020000 * GOTO LISTCK; /* CHECK FOR LIST A00996 * 49030000 BC 08,LISTCK 0906 49040000 * ADD: /* MAKE SURE RANGE BITS A00996 * 49050000 * CALL TSTRNGE; /* PROCESS POSSIBLE RANGE A00996 * 49060000 ADD L @F,@V5 ADDRESS OF TSTRNGE 0907 49070000 BALR @E,@F 0907 49080000 * GEN; /* GENERATE PROPER BRNCHS A00996 * 49090000 BC 15,SEP /* NO RANGE, OR 2ND VALUE A00996 49100000 * PROCESS END A00996 */ 49110000 DS 0H 49120000 * MSGADDR=PPOINTR; /* SET UP SPECIAL MESSAGE A00996 * 49130000 MVC 592(4,@B),148(@B) 0909 49140000 * MSGLEN=R4-PPOINTR; /* FIELDS IN CASE REQURED A00996 * 49150000 L @F,148(0,@B) 0910 49160000 LCR @F,@F 0910 49170000 AR @F,@4 0910 49180000 STH @F,590(0,@B) 0910 49190000 * GOTO PDESIZE; /* FIRST VALUE OF RANGE A00996 * 49200000 BC 15,PDESIZE 0911 49210000 * 49220000 * SEP: 49230000 * ADDCDE=8; /* ADDR OF TYPE TEST IN REG15 * 49240000 SEP LA @F,8 0912 49250000 * R1='08'X; /* BLANK-TAB-COMMA MASK REG 1 * 49260000 LA @1,X'08' 0913 49270000 * CALL LINKRET; /* BRANCH TO PARSE * 49280000 BAL @E,LINKRET 0914 49290000 * GOTO TESTCOL; /* BRANCH TO TEST OFR SEMICOLN * 49300000 BC 15,TESTCOL 0915 49310000 * 49320000 * PDESIZE: 49330000 * CONST='1'B; /* PDE TYPE EQUAL CONSTANT * 49340000 PDESIZE L @1,564(0,@B) 0916 49350000 OI 6(@1),B'11000000' 0916 49360000 * PARMIND='1'B; /* INDICATE PARAMETER PRESENT * 49370000 * 49380000 * TESTERR: 49390000 * GOTO EXIT; /* BRANCH TO EXIT IN VAR RTN * 49400000 BC 15,EXIT 0918 49410000 * 49420000 * /***************************************************************** 49430000 * /* * 49440000 * /* CHECK FOR END OF INPUT DATA * 49450000 * /* * 49460000 * /***************************************************************** 49470000 * 49480000 * 49490000 * TESTCOL: 49500000 * IF COMBUF=';' /* INPUT LINE EQUAL SEMICOLON * 49510000 * THEN /* IF YES * 49520000 TESTCOL CLI 0(@4),C';' 0919 49530000 * GOTO PDESIZE; /* SET PDE TYPE EQUAL CONSTANT * 49540000 BC 08,PDESIZE 0920 49550000 * 49560000 * /***************************************************************** 49570000 * /* * 49580000 * /* DETERMINE IF END OF BUFFER HAS BEEN REACHED * 49590000 * /* * 49600000 * /***************************************************************** 49610000 * 49620000 * IF R4=>ENDINPUT /* TEST FOR END OF BUFFER A00996 * 49630000 * THEN /* IF YES * 49640000 C @4,144(0,@B) 0921 49650000 * GOTO PDESIZE; /* SET PCE TYPE EQUAL CONSTANT * 49660000 BC 10,PDESIZE 0922 49670000 * ELSE /* IF NOT END OF INPUT, ERROR * 49680000 * GOTO VERRBIT; /* ERROR * 49690000 BC 15,VERRBIT 0923 49700000 * 49710000 * ENDSUB: 49720000 * IF PFENDSET='1'B /* IF BUFFER HAS BEEN POPPED * 49730000 * THEN /* MUST RESET XINPUTB * 49740000 ENDSUB TM 179(@B),B'00000100' 0924 49750000 BC 12,@99B 0924 49760000 * DO; /* TO END OF PREVIOUS * 49770000 * R5=ENDBAKUP; /* BUFFER * 49780000 L @5,412(0,@B) 0926 49790000 * PFENDSET='0'B; /* TURN OFF BUFFER POPPED * 49800000 NI 179(@B),B'11111011' 0927 49810000 * END; /* INDICATOR * 49820000 * PPOINTR=INVPSAVE+1; /* SET PTR FOR PSTRIMSG * 49830000 @99B LA @F,1 0929 49840000 A @F,300(0,@B) 0929 49850000 ST @F,148(0,@B) 0929 49860000 * ADDCDE=10; /* ISSUE MSG STATING ENDING ) * 49870000 LA @F,10 0930 49880000 * CALL LINKRET; /* ASSUMED-EOB IN SUBSCRIPT * 49890000 BAL @E,LINKRET 0931 49900000 * R5=R4; /* RESET XINPUTB * 49910000 LR @5,@4 0932 49920000 * GOTO VSUBENDK; /* PROCESS END OF SUBSCRIPT * 49930000 BC 15,VSUBENDK 0933 49940000 * 49950000 * /***************************************************************** 49960000 * /* * 49970000 * /* DETERMINE IF FIRST VALUE OF A RANGE HAS BEEN PROCESSED * 49980000 * /* * 49990000 * /***************************************************************** 50000000 * 50010000 * 50020000 * RANTST: 50030000 * IF RNGEVAL1='1'B /* FIRST VALUE OF RANGE? * 50040000 * THEN /* IF YES * 50050000 RANTST TM 177(@B),B'01000000' 0934 50060000 * GOTO VERRBIT; /* SET ERROR BIT ON * 50070000 BC 01,VERRBIT 0935 50080000 * 50090000 * /***************************************************************** 50100000 * /* * 50110000 * /* DETERMINE IF SECOND VALUE OFRANGE HAS BEEN PROCESSED * 50120000 * /* * 50130000 * /***************************************************************** 50140000 * 50150000 * IF RNGEVAL2='1'B /* SECOND VALUE OF RANGE? * 50160000 * THEN /* IF YES * 50170000 TM 177(@B),B'00001000' 0936 50180000 * GOTO PDESIZE; /* SET PDE TYPE EQUAL CONSTANT * 50190000 BC 01,PDESIZE 0937 50200000 * 50210000 * SETMINUS: /* INDICATE MINUS IN INPUT LINE * 50220000 * SIGN='1'B; /* SET MINUS INDICATOR IN PDE * 50230000 SETMINUS L @1,564(0,@B) 0938 50240000 OI 7(@1),B'10000000' 0938 50250000 * GOTO CBUMP02; /* CHECK FOR END OF INPUT DATA * 50260000 BC 15,CBUMP02 0939 50270000 * 50280000 * PREPDSCN: /* STORE ADDR OF DIGIT STRING * 50290000 * DATAPTR=R4; /* ADDR OF DIGIT STRING IN PDE * 50300000 PREPDSCN L @1,564(0,@B) 0940 50310000 ST @4,8(0,@1) 0940 50320000 * 50330000 * ADDCOUNT: /* UPDATE DIGIT STRING COUNTER * 50340000 * DIGITCT=DIGITCT+1; /* ADD ONE TO DIGIT COUNTER * 50350000 ADDCOUNT LA @F,1 0941 50360000 SR @0,@0 0941 50370000 IC @0,596(0,@B) 0941 50380000 AR @F,@0 0941 50390000 STC @F,596(0,@B) 0941 50400000 * R4=R4+1; /* PTR TO NEXT INPUT CHAR * 50410000 AH @4,@D2 0942 50420000 * 50430000 * /***************************************************************** 50440000 * /* * 50450000 * /* CHECK FOR END OF INPUT DATA * 50460000 * /* * 50470000 * /***************************************************************** 50480000 * 50490000 * 50500000 * SEMCHK: 50510000 * IF COMBUF=';' /* INPUT LINE EQUAL SEMICOLON * 50520000 * THEN /* IF YES * 50530000 SEMCHK CLI 0(@4),C';' 0943 50540000 * GOTO MAXDIGIT; /* CHECK DIGIT STRING COUNTER * 50550000 BC 08,MAXDIGIT 0944 50560000 * 50570000 * /***************************************************************** 50580000 * /* * 50590000 * /* DETERMINE IF END OF BUFFER HAS BEEN REACHED * 50600000 * /* * 50610000 * /***************************************************************** 50620000 * 50630000 * IF R4=>ENDINPUT /* TEST FOR END OF BUFFER A00996 * 50640000 * THEN /* IF YES * 50650000 C @4,144(0,@B) 0945 50660000 * GOTO MAXDIGIT; /* CHECK DIGIT STRING COUNTER * 50670000 BC 10,MAXDIGIT 0946 50680000 * ADDCDE=8; /* ADDR OF TYPE TEST IN REG 15 * 50690000 LA @F,8 0947 50700000 * R1='10'X; /* NUMERIC MASK IN REG 1 * 50710000 LA @1,X'10' 0948 50720000 * CALL LINKRET; /* BRANCH TO PARSE2 * 50730000 BAL @E,LINKRET 0949 50740000 * GEN; /* RETURN BRANCHES * 50750000 BC 15,PERCHK1 CHECK FOR '4B'X 50760000 BC 15,ADDCOUNT UPDATE STRING COUNTER 50770000 DS 0H 50780000 * 50790000 * /***************************************************************** 50800000 * /* * 50810000 * /* CHECK INPUT LINE FOR A PERIOD * 50820000 * /* * 50830000 * /***************************************************************** 50840000 * 50850000 * 50860000 * PERCHK1: 50870000 * IF COMBUF='4B'X /* INPUT CHAR EQUAL PERIOD * 50880000 * THEN /* IF YES * 50890000 PERCHK1 CLI 0(@4),X'4B' 0951 50900000 * GOTO PPDSCAN; /* STORE PTR TO PERIOD * 50910000 BC 08,PPDSCAN 0952 50920000 * 50930000 * SEPTEST: 50940000 * ADDCDE=8; /* ADDR OF TYPETEST IN REG 15 * 50950000 SEPTEST LA @F,8 0953 50960000 * R1='08'X; /* BLANK=TAB-COMMA MASK * 50970000 LA @1,X'08' 0954 50980000 * CALL LINKRET; /* BRANCH TO PARSE2 * 50990000 BAL @E,LINKRET 0955 51000000 * GEN; /* RETURN BRANCHES * 51010000 BC 15,LSTCHK CHECK FOR END EXPRESSION 51020000 BC 15,MAXDIGIT CHECK DIGIT STRING COUNTER 51030000 DS 0H 51040000 * 51050000 * /***************************************************************** 51060000 * /* * 51070000 * /* CHECK FOR END OF LIST EXPRESSION * 51080000 * /* * 51090000 * /***************************************************************** 51100000 * 51110000 * 51120000 * LSTCHK: 51130000 * IF COMBUF=')' /* INPUT CHAR EQUAL PAREN * 51140000 * THEN /* IF YES * 51150000 LSTCHK CLI 0(@4),C')' 0957 51160000 * GOTO MAXDIGIT; /* CHECK DIGIT STRING COUNTER * 51170000 BC 08,MAXDIGIT 0958 51180000 * 51190000 * /***************************************************************** 51200000 * /* * 51210000 * /* CHECK INPUT LINE FOR END OF RANGE * 51220000 * /* * 51230000 * /***************************************************************** 51240000 * 51250000 * IF COMBUF^=':' /* END OF RANGE? * 51260000 * THEN /* IF NOT * 51270000 CLI 0(@4),C':' 0959 51280000 * GOTO VARTEST; /* CHECK FOR ALPHA CHAR * 51290000 BC 07,VARTEST 0960 51300000 * 51310000 * /***************************************************************** 51320000 * /* * 51330000 * /* DETERMINE IF IKJTERM IS PROCESSING A SUBSCRIPT * 51340000 * /* * 51350000 * /***************************************************************** 51360000 * 51370000 * IF SUBSMODE='1'B /* TERM PROCESSING A SUBSCRPT * 51380000 * THEN /* IF YES * 51390000 TM 599(@B),B'00100000' 0961 51400000 * GOTO VERRBIT; /* SET ERROR BIT ON * 51410000 BC 01,VERRBIT 0962 51420000 * 51430000 * /***************************************************************** 51440000 * /* * 51450000 * /* DETERMINE IF TOTAL NUMBER OF DIGITS HAS EXCEEDED 18 * 51460000 * /* * 51470000 * /***************************************************************** 51480000 * 51490000 * 51500000 * MAXDIGIT: /* TEST DIGIT COUNTER * 51510000 * IF DIGITCT>18 /* DIGIT CTR GREATER THAN 18 * 51520000 * THEN /* IF YES * 51530000 MAXDIGIT CLI 596(@B),18 0963 51540000 * GOTO VERRBIT; /* SET ERROR BIT ON * 51550000 BC 02,VERRBIT 0964 51560000 * LNGTH1=DIGITCT; /* LENGTH OF DIGIT DATA IN PDE * 51570000 L @1,564(0,@B) 0965 51580000 MVC 0(1,@1),596(@B) 0965 51590000 * DIGITCT=0; /* ZERO DIGIT COUNTER * 51600000 MVI 596(@B),0 0966 51610000 * 51620000 * ENDPDE: 51630000 * FIXED='1'B; /* INDICATE FIXED PTR LITERAL * 51640000 ENDPDE L @1,564(0,@B) 0967 51650000 OI 6(@1),B'00001000' 0967 51660000 * GOTO DATAEND; /* TEST FOR SUBSCRIPT MODE * 51670000 BC 15,DATAEND 0968 51680000 * 51690000 * VARTEST: 51700000 * ADDCDE=8; /* ADDR OF TYPE TEST IN REG15 * 51710000 VARTEST LA @F,8 0969 51720000 * R1='C0'X; /* ALPHA MASK IN REG 1 * 51730000 LA @1,X'C0' 0970 51740000 * CALL LINKRET; /* BRANCH TO PARSE * 51750000 BAL @E,LINKRET 0971 51760000 * GOTO ANYTEST; /* NOT ALPHA,CHECK FOR TYPE=ANY * 51770000 BC 15,ANYTEST 0972 51780000 * /* YM2849* 51790000 * GEN(BC 15,ETEST); /*TEST FOR VALID ALPHA CHARACTER * 51800000 BC 15,ETEST 51810000 DS 0H 51820000 * /* YM2849* 51830000 * 51840000 * ANYTEST: /* TYPE = ANY TEST YM2849* 51850000 * /***************************************************************** 51860000 * /* * 51870000 * /* TEST FOR PCE TYPE EQUAL ANY * 51880000 * /* * 51890000 * /***************************************************************** 51900000 * 51910000 * IF ANY^='1'B /* PCE TYPE EQUAL ANY? * 51920000 * THEN /* IF NOT * 51930000 ANYTEST TM 6(@6),B'00010000' 0974 51940000 * GOTO VERRBIT; /* SET ERROR BIT * 51950000 BC 12,VERRBIT 0975 51960000 * 51970000 * GOTOVAR: 51980000 * R4=PRMTPTR; /* RESET INPUT POINTER * 51990000 GOTOVAR L @4,584(0,@B) 0976 52000000 * R5=PRMTPTR; /* RESET BACKUP INPUT POINTER * 52010000 L @5,584(0,@B) 0977 52020000 * DIGITCT=0; /* RESET DIGIT COUNT * 52030000 MVI 596(@B),0 0978 52040000 * IF SUBSMODE='1'B /* IF IN SUBSMODE, MUST RESET * 52050000 * THEN /* SUBSCRIPT COUNT * 52060000 TM 599(@B),B'00100000' 0979 52070000 BC 12,@99A 0979 52080000 * ELEMNCT=ELEMNCT+1; /* INCREMENT SUBSCRPT COUNT * 52090000 LA @F,1 0980 52100000 SR @0,@0 0980 52110000 IC @0,597(0,@B) 0980 52120000 AR @F,@0 0980 52130000 STC @F,597(0,@B) 0980 52140000 * CNSTTEMP= /* ZERO CNSTTEMP * 52150000 * CNSTTEMP && CNSTTEMP; /* PDEPTR POINTS TO CNSTTEMP * 52160000 @99A L @1,564(0,@B) 0981 52170000 XC 0(20,@1),0(@1) 0981 52180000 * GOTO IKJEFP6V; /* BRANCH TO VARIABLE RTN * 52190000 BC 15,IKJEFP6V 0982 52200000 * 52210000 * /***************************************************************** 52220000 * /* * 52230000 * /* DETERMINE IF DATA TYPE EQUAL FLOATING POINT LITERAL * 52240000 * /* * 52250000 * /***************************************************************** 52260000 * 52270000 * 52280000 * ETEST: 52290000 * IF COMBUF='E' /* FLOATING PT LITERAL? * 52300000 * THEN /* IF YES * 52310000 ETEST CLI 0(@4),C'E' 0983 52320000 BC 07,@999 0983 52330000 * DO; /* SET FLOATING PT FLAG IN PDE * 52340000 * 52350000 * EFOUND: 52360000 * FLOAT='1'B; /* SET FLOATING PT FLAG IN PDE * 52370000 EFOUND L @1,564(0,@B) 0985 52380000 OI 6(@1),B'00000001' 0985 52390000 * 52400000 * /************************************************************* 52410000 * /* * 52420000 * /* DETERMINE IF FLOATING POINT LITERAL HAS EXCEEDED 16 * 52430000 * /* * 52440000 * /************************************************************* 52450000 * 52460000 * IF DIGITCT>16 /* STRING EXCEEDED MAX LENGTH? * 52470000 * THEN /* IF YES * 52480000 CLI 596(@B),16 0986 52490000 * GOTO VERRBIT; /* SET ERROR BIT * 52500000 BC 02,VERRBIT 0987 52510000 * LNGTH1=DIGITCT; /* STORE LENGTH OF DATA IN PDE * 52520000 MVC 0(1,@1),596(@B) 0988 52530000 * DIGITCT=0; /* ZERO DIGIT COUNTER * 52540000 MVI 596(@B),0 0989 52550000 * 52560000 * /************************************************************* 52570000 * /* * 52580000 * /* IS DEC PTR FLAG SET IN PDE ? * 52590000 * /* * 52600000 * /************************************************************* 52610000 * 52620000 * IF DECPT='0'B /* DEC PTR FLAG SET ? * 52630000 * THEN /* IF NO * 52640000 L @1,564(0,@B) 0990 52650000 TM 7(@1),B'00100000' 0990 52660000 * GOTO VERRBIT; /* SET ERROR BIT * 52670000 BC 08,VERRBIT 0991 52680000 * R4= R4+1; /* POINT TO NEXT INPUT CHAR * 52690000 AH @4,@D2 0992 52700000 * 52710000 * /************************************************************* 52720000 * /* * 52730000 * /* DETERMINE IF END OF BUFFER HAS BEEN REACHED * 52740000 * /* * 52750000 * /************************************************************* 52760000 * 52770000 * IF R4=>ENDINPUT /* END OF BUFFER? A00996 * 52780000 * THEN /* IF YES * 52790000 C @4,144(0,@B) 0993 52800000 * GOTO VERRBIT; /* ISSUE PROMPT MSG * 52810000 BC 10,VERRBIT 0994 52820000 * 52830000 * /************************************************************* 52840000 * /* * 52850000 * /* CHECK FOR AN END OF THE PARAMETER * 52860000 * /* * 52870000 * /************************************************************* 52880000 * 52890000 * IF COMBUF=';' /* A SEMICOLON DELIMITS PARM * 52900000 * THEN /* IF YES * 52910000 CLI 0(@4),C';' 0995 52920000 * GOTO VERRBIT; 52930000 BC 08,VERRBIT 0996 52940000 * 52950000 * /************************************************************* 52960000 * /* * 52970000 * /* PROMPT-INCOMPLETE PARAMETER CHECK THE SIGN OF THE EXPONENT* 52980000 * /* INDICATED BY E IN PARM * 52990000 * /* * 53000000 * /************************************************************* 53010000 * 53020000 * IF COMBUF='-' /* CHECK FIRST FOR A MINUS * 53030000 * THEN /* IF YES (MINUS) * 53040000 CLI 0(@4),C'-' 0997 53050000 * GOTO MINUSEXP; /* SET THE INDICATOR IN THEPDE * 53060000 BC 08,MINUSEXP 0998 53070000 * 53080000 * /************************************************************* 53090000 * /* * 53100000 * /* IF THERE IS A PLUS SIGN IT MUST BE SKIPPED * 53110000 * /* * 53120000 * /************************************************************* 53130000 * 53140000 * IF COMBUF='+' /* IS THERE A PLUS PRESENT * 53150000 * THEN /* IF YES * 53160000 CLI 0(@4),C'+' 0999 53170000 * GOTO CBUMP03; /* SKIP OVER TO CONTINUE SCAN * 53180000 BC 08,CBUMP03 1000 53190000 * 53200000 * NUMCK: 53210000 * ADDCDE=8; /* USE TYPETEST TO CHECK FOR A * 53220000 NUMCK LA @F,8 1001 53230000 * R1='10'X; /* NUMERIC CHARACTER AS THE * 53240000 LA @1,X'10' 1002 53250000 * CALL LINKRET; /* EXPONENT * 53260000 BAL @E,LINKRET 1003 53270000 * GOTO VERRBIT; /* NO NUMERIC EXP IS AN ERROR * 53280000 BC 15,VERRBIT 1004 53290000 * DATAPTRA=R4; /* STORE PTR TO EXPONENT * 53300000 L @1,564(0,@B) 1005 53310000 ST @4,12(0,@1) 1005 53320000 * 53330000 * ADCT01: 53340000 * DIGITCT=DIGITCT+1; /* KEEP A COUNT OF EXP LENGTH * 53350000 ADCT01 LA @F,1 1006 53360000 SR @0,@0 1006 53370000 IC @0,596(0,@B) 1006 53380000 AR @F,@0 1006 53390000 STC @F,596(0,@B) 1006 53400000 * R4=R4+1; /* INCREMENT THE INPUT POINTER * 53410000 AH @4,@D2 1007 53420000 * 53430000 * /************************************************************* 53440000 * /* * 53450000 * /* CHECK FOR THE END OF THE INPUT BUFFER * 53460000 * /* * 53470000 * /************************************************************* 53480000 * 53490000 * IF R4=>ENDINPUT /* IS XINPUT AT END OF INPUT 53500000 * A00996 * 53510000 * THEN /* IF YES, * 53520000 C @4,144(0,@B) 1008 53530000 * GOTO VALEXP; /* THE END OF PARM IS FOUND * 53540000 BC 10,VALEXP 1009 53550000 * ADDCDE=8; /* IF NO CONTINUE THE SCAN * 53560000 LA @F,8 1010 53570000 * R1='10'X; /* IS THIS A NUMERIC CHARACTER * 53580000 LA @1,X'10' 1011 53590000 * CALL LINKRET; /* USE TYPETEST TO CHECK * 53600000 BAL @E,LINKRET 1012 53610000 * GEN; /* RETURN BRANCHES * 53620000 BC 15,TSEP IT IS NOT CHECK FOR DELIMITR 53630000 BC 15,ADCT01 IT IS, CONTINUE THE SCAN 53640000 DS 0H 53650000 * 53660000 * TSEP: 53670000 * ADDCDE=8; /* USE TYPETEST TO CHECK FOR A * 53680000 TSEP LA @F,8 1014 53690000 * R1='08'X; /* VALID PARM SEPARATOR. IF NOT * 53700000 LA @1,X'08' 1015 53710000 * CALL LINKRET; /* CHECK FOR PARM DELIMITER * 53720000 BAL @E,LINKRET 1016 53730000 * GEN; /* RETURN BRANCHES * 53740000 BC 15,PARTTST NONE FOUND 53750000 BC 15,VALEXP A SEPARATOR WAS FOUND THUS 53760000 DS 0H 53770000 * END; /* THE END OF PARM ALSO FOUND * 53780000 * 53790000 * /***************************************************************** 53800000 * /* * 53810000 * /* MUST CONSIDER A LOWER CASE E * 53820000 * /* * 53830000 * /***************************************************************** 53840000 * 53850000 * IF COMBUF='85'X /* IS THIS A LOWER CASE E * 53860000 * THEN /* IF YES * 53870000 @999 CLI 0(@4),X'85' 1019 53880000 BC 07,@998 1019 53890000 * DO; /* CHECK FOR TRANSLATION * 53900000 * 53910000 * /************************************************************* 53920000 * /* * 53930000 * /* CHECK TO SEE IF UPPERCASE REQUESTED * 53940000 * /* * 53950000 * /************************************************************* 53960000 * 53970000 * IF ASIS='0'B /* IS UPPERCASE REQUESTED? * 53980000 * THEN /* IF YES * 53990000 TM 1(@6),B'01000000' 1021 54000000 BC 05,@997 1021 54010000 * DO; /* TRANSLATE * 54020000 * 54030000 * /********************************************************* 54040000 * /* * 54050000 * /* TEST FOR DEFAULT DATA PROCESSING * 54060000 * /* * 54070000 * /********************************************************* 54080000 * 54090000 * IF PFDEFLT='1'B /* TEST FOR DEFAULT DATA * 54100000 * THEN /* IF YES * 54110000 TM 176(@B),B'01000000' 1023 54120000 * GOTO EFOUND; /* SET FLOATING PTR FLAG IN PDE * 54130000 BC 01,EFOUND 1024 54140000 * COMBUF=COMBUF|' '; /* TRANSLATE TO UPPERCASE * 54150000 OI 0(@4),C' ' 1025 54160000 * END; /* EXPONENT * 54170000 * GOTO EFOUND; /* IF NO TRANSLATION NEEDED * 54180000 BC 15,EFOUND 1027 54190000 * END; /* RETURN TO PROCESS EXPONENT * 54200000 * ELSE /* IF NOT AN E, WE HAVE AN * 54210000 * GEN(BC 15,ANYTEST); /* NOT VALID FOR CONSTANT YM2849* 54220000 @998 EQU * 1029 54230000 BC 15,ANYTEST 54240000 DS 0H 54250000 * 54260000 * /***************************************************************** 54270000 * /* * 54280000 * /* A LOGICAL END OF A CONSTANT HAS BEEN FOUND CHECKS FOR A VALID * 54290000 * /* DELIMITER WILL NOW BE MADE * 54300000 * /* * 54310000 * /***************************************************************** 54320000 * 54330000 * 54340000 * PARTTST: 54350000 * IF COMBUF=')' /* A ) IS A VALID DELIMITER * 54360000 * THEN /* IF YES * 54370000 @996 EQU * 1030 54380000 PARTTST CLI 0(@4),C')' 1030 54390000 * GOTO VALEXP; /* PARM END HAS BEEN FOUND * 54400000 BC 08,VALEXP 1031 54410000 * IF COMBUF^=':' /* A COLON INDICATES A RANGE * 54420000 * THEN /* IF NOT A COLON THE PARAMETR * 54430000 CLI 0(@4),C':' 1032 54440000 * GOTO VERRBIT; /* IS INVALID,NO MORE DELIMITR * 54450000 BC 07,VERRBIT 1033 54460000 * 54470000 * /***************************************************************** 54480000 * /* * 54490000 * /* A CHECK IS MADE FOR SUBSCRIPT MODE AS THERE MAY NOT BE A RANGE* 54500000 * /* IN SUBSCRIPTS AND A COLON HAS BEEN FOUND. IF THE SUBSMODE BIT * 54510000 * /* IS ON THE PARAMETER IS CONSIDERED INVALID * 54520000 * /* * 54530000 * /***************************************************************** 54540000 * 54550000 * IF SUBSMODE='1'B /* TEST THE SUBSCRIPT BIT * 54560000 * THEN /* IF ON * 54570000 TM 599(@B),B'00100000' 1034 54580000 * GOTO VERRBIT; /* PROMPT FOR INVALID PARAMETER * 54590000 BC 01,VERRBIT 1035 54600000 * 54610000 * /***************************************************************** 54620000 * /* * 54630000 * /* CHECK THE DIGITCT FOR LENGTH OF THE EXPONENT * 54640000 * /* * 54650000 * /***************************************************************** 54660000 * 54670000 * 54680000 * VALEXP: 54690000 * IF DIGITCT>2 /* TWO IS MAX FOR EXPONENT * 54700000 * THEN /* IF MAX IS EXCEEDED * 54710000 VALEXP CLI 596(@B),2 1036 54720000 * GOTO VERRBIT; /* PROMPT * 54730000 BC 02,VERRBIT 1037 54740000 * LNGTH2=DIGITCT; /* STORE EXPONENT LENGTH IN PDE * 54750000 L @1,564(0,@B) 1038 54760000 MVC 1(1,@1),596(@B) 1038 54770000 * DIGITCT=0; /* REINTIALIZE THE COUNTER * 54780000 MVI 596(@B),0 1039 54790000 * GOTO DATAEND; /* ADD THE PDE TO THE PDL * 54800000 BC 15,DATAEND 1040 54810000 * 54820000 * MINUSEXP: /* SET THE MINUS ECPONENT BIT * 54830000 * EXPSIGN='1'B; /* IN THE PDE * 54840000 MINUSEXP L @1,564(0,@B) 1041 54850000 OI 7(@1),B'01000000' 1041 54860000 * 54870000 * CBUMP03: 54880000 * R4=R4+1; /* INCREMENT XINPUT PAST MINUS * 54890000 CBUMP03 AH @4,@D2 1042 54900000 * 54910000 * /***************************************************************** 54920000 * /* * 54930000 * /* AFTER INCREMENTING XINPUT A CHECK FOR END OF COMMAND OR END OF* 54940000 * /* INPUT MUST BE MADE * 54950000 * /* * 54960000 * /***************************************************************** 54970000 * 54980000 * IF COMBUF=';' /* A SEMICOLON IS END OF CMD * 54990000 * THEN /* IF YES * 55000000 CLI 0(@4),C';' 1043 55010000 * GOTO VERRBIT; 55020000 BC 08,VERRBIT 1044 55030000 * 55040000 * /***************************************************************** 55050000 * /* * 55060000 * /* PROMPT-INCOMPLETE PARAMETER NOW CHECK FOR EOB * 55070000 * /* * 55080000 * /***************************************************************** 55090000 * 55100000 * IF R4=>ENDINPUT /* DOES XINPUT EQUAL END INPUT 55110000 * A00996 * 55120000 * THEN /* IF YES * 55130000 C @4,144(0,@B) 1045 55140000 * GOTO VERRBIT; 55150000 BC 10,VERRBIT 1046 55160000 * 55170000 * /***************************************************************** 55180000 * /* * 55190000 * /* PROMPT-INCOMPLETE PARAMETER * 55200000 * /* * 55210000 * /***************************************************************** 55220000 * 55230000 * GOTO NUMCK; /* OTHERWISE CONTINUE THE SCAN * 55240000 BC 15,NUMCK 1047 55250000 * 55260000 * /***************************************************************** 55270000 * /* * 55280000 * /* AFTER A ) HAS BEEN FOUND CHECK FOR LIST PROCESSING * 55290000 * /* * 55300000 * /***************************************************************** 55310000 * 55320000 * 55330000 * LISTCK: 55340000 * IF PFLIST='1'B /* PFLIST ON INDICATES LIST * 55350000 * THEN /* IF ON * 55360000 LISTCK TM 176(@B),B'10000000' 1048 55370000 BC 12,@995 1048 55380000 * DO; /* MUST DECREMENT XINPUT SO * 55390000 * CALL TSTRNGE; /* PROCESS RANGE, ONLY A00996 55400000 * POSSIBLE RETURN +0 * 55410000 L @F,@V5 ADDRESS OF TSTRNGE 1050 55420000 BALR @E,@F 1050 55430000 * R4=R4-1; /* DON'T MISS THE ENDING PAREN * 55440000 BCTR @4,0 1051 55450000 * GOTO PDESIZE; /* GO TO NORMAL END * 55460000 BC 15,PDESIZE 1052 55470000 * END; /* END LIST PROCESSING * 55480000 * 55490000 * /***************************************************************** 55500000 * /* * 55510000 * /* IF PFLIST NOT ON ASSUME ) TO BE SUBSCRIPT DELIMITER * 55520000 * /* * 55530000 * /***************************************************************** 55540000 * 55550000 * IF OPERMODE='1'B /* SUBSCRIPT CAN BE VALID FOR A * 55560000 * THEN /* CONSTANT ONLY IN OPER MODE * 55570000 @995 TM 599(@B),B'01000000' 1054 55580000 * GOTO PDESIZE; /* IF OPERMOD ON-VALID-CONTINUE * 55590000 BC 01,PDESIZE 1055 55600000 * GOTO VERRBIT; /* OTHERWISE ) IS INVALID PROMPT * 55610000 BC 15,VERRBIT 1056 55620000 * 55630000 * ADELCT: 55640000 * ELEMNCT=ELEMNCT+1; /* ADD ONE TO THE SUBSCRIPT CT * 55650000 ADELCT LA @F,1 1057 55660000 SR @0,@0 1057 55670000 IC @0,597(0,@B) 1057 55680000 AR @F,@0 1057 55690000 STC @F,597(0,@B) 1057 55700000 * CONST='1'B; /* INDICATE A CONSTANT WAS FOUND 55710000 * IN THE PDE * 55720000 L @1,564(0,@B) 1058 55730000 OI 6(@1),B'11000000' 1058 55740000 * PARMIND='1'B; /* SET PARM PRESENT BIT IN THE 55750000 * PDE * 55760000 * R4=R4-1; /* DECREMENT XINPUT FOR SKIPB * 55770000 BCTR @4,0 1060 55780000 * ADDCDE=5; /* SKIP ANY SEPARATORS PRIOR * 55790000 LA @F,5 1061 55800000 * CALL LINKRET; /* TO SCAN FOR NEXT SUBSCRIPT * 55810000 BAL @E,LINKRET 1062 55820000 * GOTO ENDSUB; /* NO MORE DATA IN BUFFER * 55830000 BC 15,ENDSUB 1063 55840000 * R4=R4+1; /* CONTINUE THE SCAN * 55850000 AH @4,@D2 1064 55860000 * 55870000 * /***************************************************************** 55880000 * /* * 55890000 * /* CHECK FOR THE END OF THE SUBSCRIPTS * 55900000 * /* * 55910000 * /***************************************************************** 55920000 * 55930000 * IF COMBUF=')' /* IS THIS A DELIMITING ) * 55940000 * THEN /* IF YES * 55950000 CLI 0(@4),C')' 1065 55960000 * GOTO VSUBENDK; /* PROCESS END OF SUBSCRIPTS * 55970000 BC 08,VSUBENDK 1066 55980000 * 55990000 * /***************************************************************** 56000000 * /* * 56010000 * /* CHECK FOR A COMMAND DELIMITER * 56020000 * /* * 56030000 * /***************************************************************** 56040000 * 56050000 * 56060000 * ENDCMDCK: /* CHECK FOR SEMICOLON * 56070000 * IF COMBUF=';' /* IS THERE A COMMAND DELIMITER * 56080000 * THEN /* IF YES * 56090000 ENDCMDCK CLI 0(@4),C';' 1067 56100000 BC 07,@994 1067 56110000 * DO; /* PTR TO PREVIOUS CHAR * 56120000 * R4=R4-1; /* PTR TO PREVIOUS CHAR * 56130000 BCTR @4,0 1069 56140000 * GOTO ENDSUB; /* PROMPT-INVALID IN SUBSCRIPTS * 56150000 BC 15,ENDSUB 1070 56160000 * END; /* IF NOT END OF BUFFER * 56170000 * ELSE /* IF VALID NEXT CHAR, PREPARE * 56180000 * DO; /* TO PROCESS NEXT SUBSCRIPT * 56190000 * PRMTPTR=R4; /* SET PRMTPTR SO IN CASE OF 56200000 * ERROR, PROMPT WITH THE COR- 56210000 * RECT SUBSCRIPT * 56220000 @994 ST @4,584(0,@B) 1073 56230000 * GOTO SUBENDCK; /* GO BACK TO PROCESS NEXT 56240000 * SUBSCRIPT * 56250000 BC 15,SUBENDCK 1074 56260000 * END; /* RETURN TO SUBSCRIPT PROCESS * 56270000 * 56280000 * /***************************************************************** 56290000 * /* * 56300000 * /* TERM VARIABLE PROCESSING * 56310000 * /* * 56320000 * /***************************************************************** 56330000 * 56340000 * 56350000 * IKJEFP6V: /* VARIABLE RTN ENTRY POINT * 56360000 * VARIA='1'B; /* SET VARIABLE BIT IN PDE * 56370000 @993 EQU * 1076 56380000 IKJEFP6V L @1,564(0,@B) 1076 56390000 OI 6(@1),B'00100000' 1076 56400000 * IF SUBSMODE='1'B /* IF SUBSCRIPT MODE , DO * 56410000 * THEN /* NOT SET FIRST NAME SWITCH * 56420000 TM 599(@B),B'00100000' 1077 56430000 * GOTO SCAN; /* FOR MESSAGE SETUP * 56440000 BC 01,SCAN 1078 56450000 * IF RNGEVAL1='1'B /* IF SECOND VALUE OF RANGE * 56460000 * THEN /* DO NOT SET FIRST NAME * 56470000 TM 177(@B),B'01000000' 1079 56480000 * GOTO SCAN; /* SWITCH FOR MESSAGE * 56490000 BC 01,SCAN 1080 56500000 * FIRSTNAM='1'B; /* SET FIRST NAME SWITCH SO THAT 56510000 * FIELDS WILL BE INIT- IALIZED 56520000 * FOR THE SPECIAL MESSAGE * 56530000 OI 601(@B),B'10000000' 1081 56540000 * 56550000 * SCAN: 56560000 * PPOINTR=R4; /* PPOINTR IS NOT INITIAL- IZED 56570000 * BY GENSCAN IF INVALID FIRST 56580000 * CHARACTER * 56590000 SCAN ST @4,148(0,@B) 1082 56600000 * PDWORD (1)=ADDR(WORKAR); /* ADDR OF CONTROL INFO IN PWA * 56610000 LA @F,WORKAR 1083 56620000 ST @F,@TEMP4 1083 56630000 MVC 136(4,@B),@TEMP4 1083 56640000 * GOPTION='40'X; /* MAX IS SPECIFIED-GENSCAN * 56650000 MVI WORKAR,X'40' 1084 56660000 * GFIRST='01'X; /* MFIRST CHAR EQUAL ALPHA * 56670000 MVI WORKAR+1,X'01' 1085 56680000 * GOTHER='03'X; /* OTHER CHAR ALPHAMERIC * 56690000 MVI WORKAR+2,X'03' 1086 56700000 * GOMAX=8; /* MAXIMUM LENGTH EQUAL 8 * 56710000 MVI WORKAR+3,8 1087 56720000 * ADDCDE=7; /* ADDR OF GENSCAN IN REG 15 * 56730000 LA @F,7 1088 56740000 * R4=R4-1; /* TEST PREVIOUS CHAR * 56750000 BCTR @4,0 1089 56760000 * CALL LINKRET; /* BRANCH TO PARSE2 * 56770000 BAL @E,LINKRET 1090 56780000 * GEN; /* RETURN BRANCHES * 56790000 BC 15,NOPGMID INVALID FIRSR CHAR 56800000 BC 15,NOPGMID MAXIMUM LENGTH EXCEEDED 56810000 BC 15,NOPGMID EOB REACHED 56820000 DS 0H 56830000 * 56840000 * /***************************************************************** 56850000 * /* * 56860000 * /* CHECK INPUT LINE FOR VALID PGM. ID * 56870000 * /* * 56880000 * /***************************************************************** 56890000 * 56900000 * IF COMBUF^='4B'X /* PERIOD IN INPUT LINE? * 56910000 * THEN /* IF NO * 56920000 CLI 0(@4),X'4B' 1092 56930000 * GOTO NOPGMID; /* CHECK FOR DATA NAME * 56940000 BC 07,NOPGMID 1093 56950000 * 56960000 * /***************************************************************** 56970000 * /* * 56980000 * /* DETERMINE IF TERM IS PROCESSING IN ERROR MODE * 56990000 * /* * 57000000 * /***************************************************************** 57010000 * 57020000 * DATAPTRA=PPOINTR; /* PTR TO PGM. ID IN PDE M4151 * 57030000 L @1,564(0,@B) 1094 57040000 MVC 12(4,@1),148(@B) 1094 57050000 * PLENGTH=R4-PPOINTR; /* LENGTH OF PGM.ID * 57060000 L @F,148(0,@B) 1095 57070000 LCR @F,@F 1095 57080000 AR @F,@4 1095 57090000 STH @F,152(0,@B) 1095 57100000 * LNGTH5=PLENGTH; /* LENGTH OF PGM.ID IN PDE * 57110000 L @1,564(0,@B) 1096 57120000 MVC 16(1,@1),153(@B) 1096 57130000 * IF SUBSMODE='1'B /* IF SUBSCRPT MODE * 57140000 * THEN /* MUST RESET PRMTPTR TO * 57150000 TM 599(@B),B'00100000' 1097 57160000 BC 12,@992 1097 57170000 * PRMTPTR=PPOINTR; /* BEGINNING FOR POSSIBLE 57180000 * PROMPTING * 57190000 MVC 584(4,@B),148(@B) 1098 57200000 * IF FIRSTNAM^='1'B /* IF ISN'T FIRST DATA * 57210000 * THEN /* NAME OF VARIABLE, DO * 57220000 @992 TM 601(@B),B'10000000' 1099 57230000 * GOTO UPRCSE; /* NOT SET UP SPECIAL MESSAGE 57240000 * FIELDS * 57250000 BC 12,UPRCSE 1100 57260000 * MSGADDR=PPOINTR; /* IF IS FIRST DATA NAME * 57270000 MVC 592(4,@B),148(@B) 1101 57280000 * MSGLEN=PLENGTH; /* SET UP MESSAGE FIELDS FOR 57290000 * ERROR MESSAGE * 57300000 MVC 590(2,@B),152(@B) 1102 57310000 * 57320000 * UPRCSE: 57330000 * ADDCDE=9; /* ADDR OF TRANSQ IN REG 15 * 57340000 UPRCSE LA @F,9 1103 57350000 * CALL LINKRET; /* BRANCH TO PARSE2 * 57360000 BAL @E,LINKRET 1104 57370000 * 57380000 * NAMEREQA: /* SET NAME REQUIRED BIT * 57390000 * NAMEREQD='1'B; /* SET NAME REQUIRED BIT IN PWA * 57400000 NAMEREQA OI 599(@B),B'00010000' 1105 57410000 * R4=R4+1; /* PTR TO NEXT INPUT CHAR * 57420000 AH @4,@D2 1106 57430000 * PPOINTR=R4; /* SET PTR TO DATA NAME FOR SCAN * 57440000 ST @4,148(0,@B) 1107 57450000 * GOTO NAMSCAN; /* CHECK FOR DATA NAME * 57460000 BC 15,NAMSCAN 1108 57470000 * 57480000 * NOPGMID: 57490000 * R4=PPOINTR; /* UPDATE INPUT POINTERS * 57500000 NOPGMID L @4,148(0,@B) 1109 57510000 * R5=PPOINTR; /* UPDATE PTRS FOR GENSCAN * 57520000 L @5,148(0,@B) 1110 57530000 * 57540000 * DNAMSCAN: /* PREPARE FOR GENSCAN * 57550000 * 57560000 * /***************************************************************** 57570000 * /* * 57580000 * /* DETERMINE IF TERM IS PROCESSING IN ERROR MODE * 57590000 * /* * 57600000 * /***************************************************************** 57610000 * 57620000 * IF ERRORBIT='1'B /* IKJTERM ERROR PROCESSING ? * 57630000 * THEN /* IF YES * 57640000 DNAMSCAN TM 599(@B),B'00001000' 1111 57650000 * GOTO NAMSCAN; /* CHECK FOR DATA NAME * 57660000 BC 01,NAMSCAN 1112 57670000 * PRMTPTR=R4; /* SET UP FOR SPECIAL MSG * 57680000 ST @4,584(0,@B) 1113 57690000 * 57700000 * NAMSCAN: 57710000 * R1='D0'X; /* SET ALPHAMERIC MASK FOR * 57720000 NAMSCAN LA @1,X'D0' 1114 57730000 * ADDCDE=8; /* TYPETEST * 57740000 LA @F,8 1115 57750000 * CALL LINKRET; /* GO TO TYPETEST FOR 1ST CHAR * 57760000 BAL @E,LINKRET 1116 57770000 * GOTO RSTPTRS; /* INVALID FIRST CHARACTER * 57780000 BC 15,RSTPTRS 1117 57790000 * 57800000 * LOOP: 57810000 * DO R8 = 1 TO 30; /* SCAN REST OF DATA NAME * 57820000 LOOP LA @8,1 1118 57830000 * R4 = R4+1; /* INCREMENT TO NEXT CHAR * 57840000 @DO991 AH @4,@D2 1119 57850000 * R5 = R4; /* SET BACKUP POINTER * 57860000 LR @5,@4 1120 57870000 * IF R4=>ENDINPUT /* IF AT END OF BUFFER A00996 * 57880000 * THEN /* THEN GO PROCESS A00996 * 57890000 C @4,144(0,@B) 1121 57900000 * GOTO SETPLNGH; /* AS A DATANAME A00996 * 57910000 BC 10,SETPLNGH 1122 57920000 * R1 = 'D0'X; /* SET ALPHAMERIC MASK FOR * 57930000 LA @1,X'D0' 1123 57940000 * ADDCDE = 8; /* TYPETEST TO CHECK OTHER * 57950000 LA @F,8 1124 57960000 * CALL LINKRET; /* CHARACTERS * 57970000 BAL @E,LINKRET 1125 57980000 * 57990000 * /*************************************************************** 58000000 * /* * 58010000 * /* GENERATE BRANCHES * 58020000 * /* * 58030000 * /*************************************************************** 58040000 * 58050000 * GENERATE; 58060000 BC 15,ERRORCHA INVALID OTHER CHARACTER 58070000 BC 15,CONTLOOP IF VALID,CONTINUE SCAN 58080000 DC 25F'0' 58090000 DS 0H 58100000 * 58110000 * ERRORCHA: 58120000 * IF COMBUF = '-' /* HYPHEN IS ALSO A VALID CHAR * 58130000 * THEN 58140000 ERRORCHA CLI 0(@4),C'-' 1127 58150000 * GOTO CONTLOOP; /* EXCEPT FOR LAST CHAR * 58160000 * GOTO RESCAN; /* CHECK TO SEE IF VALID SEP- 58170000 * ARATOR WAS FLAGGED AS INVAL- 58180000 * ID OTHER CHARACTER * 58190000 BC 07,RESCAN 1129 58200000 * 58210000 * CONTLOOP: 58220000 * END; /* END LOOP * 58230000 * 58240000 * MAXLNEXC: 58250000 * GOTO VERRBIT; /* IF FALL THROUGH LOOP MAX 58260000 * LENGTH FOR A DATA NAME WAS 58270000 * EXCEEDED * 58280000 CONTLOOP AH @8,@D2 1130 58290000 @DO990 CH @8,@D6 1130 58300000 BC 12,@DO991 1130 58310000 BC 15,VERRBIT 1131 58320000 * 58330000 * /***************************************************************** 58340000 * /* * 58350000 * /* SCAN THE INVALID OTHER CHARACTER TO MAKE SURE A VALID * 58360000 * /* DELIMITER IS THE INVALID OTHER CHARACTER. IF NOT, MUST PROCESS* 58370000 * /* IN ERROR MODE * 58380000 * /* * 58390000 * /***************************************************************** 58400000 * 58410000 * 58420000 * RESCAN: 58430000 * ADDCDE=8; /* CHECK TO SEE IF A SEPARATOR * 58440000 RESCAN LA @F,8 1132 58450000 * R1='08'X; /* IS THE INVALID CHAR * 58460000 LA @1,X'08' 1133 58470000 * CALL LINKRET; /* USE PARSE TYPETEST * 58480000 BAL @E,LINKRET 1134 58490000 * GEN; /* GENERATE BRANCHES +0 + +4 * 58500000 BC 15,TPAR DELIMITER WAS NOT A SEPARATOR, 58510000 * CHECK FOR OTHER VALID DELIMITERS 58520000 BC 15,SETPLNGH IF SEPARATOR, VALID - GO TO END 58530000 * OF GOOD DATA NAME PROCESSING 58540000 DS 0H 58550000 * 58560000 * 58570000 * TPAR: 58580000 * 58590000 * /***************************************************************** 58600000 * /* * 58610000 * /* CHECK FOR END OF BUFFER WHICH IS VALID * 58620000 * /* * 58630000 * /***************************************************************** 58640000 * 58650000 * IF R4=>ENDINPUT /* IS THIS END OF BUFFER? A00996 * 58660000 * THEN /* IF SO GO PROCESS AS A * 58670000 TPAR C @4,144(0,@B) 1136 58680000 * GOTO SETPLNGH; /* VALID DATA NAME * 58690000 BC 10,SETPLNGH 1137 58700000 * 58710000 * /***************************************************************** 58720000 * /* * 58730000 * /* CHECK INPUT LINE FOR OTHER VALID SEPARATORS, OTHER THAN A * 58740000 * /* SEPARATOR. THESE ARE : ;, (, ), EOB OR ; * 58750000 * /* * 58760000 * /***************************************************************** 58770000 * 58780000 * IF COMBUF='(' /* INPUT LINE EQUAL LEFT PAREN * 58790000 * THEN /* THIS IS VALID GO TO PROCESS * 58800000 CLI 0(@4),C'(' 1138 58810000 * GOTO SETPLNGH; /* END OF VALID DATA NAME * 58820000 BC 08,SETPLNGH 1139 58830000 * 58840000 * /***************************************************************** 58850000 * /* * 58860000 * /* CHECK INPUT LINE FOR A RIGHT PAREN WHICH IS A VALID DELIMITER * 58870000 * /* * 58880000 * /***************************************************************** 58890000 * 58900000 * IF COMBUF=')' /* IS THIS A RIGHT PAREN? * 58910000 * THEN /* IF YES, GO PROCESS AS A * 58920000 CLI 0(@4),C')' 1140 58930000 * GOTO SETPLNGH; /* VALID DATA NAME * 58940000 BC 08,SETPLNGH 1141 58950000 * 58960000 * 58970000 * /***************************************************************** 58980000 * /* * 58990000 * /* CHECK FOR A COLON WHICH IS A VALID DELIMITER AND DELIMITS THE * 59000000 * /* FIRST VALUE OF A RANGE * 59010000 * /* * 59020000 * /***************************************************************** 59030000 * 59040000 * IF COMBUF=':' /* IS THIS A COLON? * 59050000 * THEN /* IF YES, PROCESS AS A * 59060000 CLI 0(@4),C':' 1142 59070000 * GOTO SETPLNGH; /* VALID DATA NAME * 59080000 BC 08,SETPLNGH 1143 59090000 * 59100000 * /***************************************************************** 59110000 * /* * 59120000 * /* CHECK FOR SEMICOLON. IF NOT A SEMICOLON WE HAVE AN INVALID * 59130000 * /* DELIMITER AND ERROR MODE MUST BE ENTERED * 59140000 * /* * 59150000 * /***************************************************************** 59160000 * 59170000 * IF COMBUF^=';' /* IF NOT A SEMICOLON, MUST * 59180000 * THEN /* INCREMENT XINPUT FOR ERROR * 59190000 CLI 0(@4),C';' 1144 59200000 BC 08,@98D 1144 59210000 * DO; /* SCAN * 59220000 * R4=R4+1; /* INCREMENT TO NEXT CHAR * 59230000 AH @4,@D2 1146 59240000 * GOTO VERRBIT; /* GO TO ERROR PROCESSING * 59250000 BC 15,VERRBIT 1147 59260000 * END; /* IF IS A SEMICOLON, FALL 59270000 * THROUGH TO PROCESS VALID DATA 59280000 * NAME * 59290000 * 59300000 * /***************************************************************** 59310000 * /* * 59320000 * /* IF COME TO HERE, HAVE FOUND A VALID DATA NAME FOLLOWED BY A * 59330000 * /* VALID DELIMITER. NOW MUST CHECK THE DATA NAME TO MAKE SURE IT * 59340000 * /* CONTAINS AT LEAST ONE ALPHABETIC. IF NOT IT IS AN ERROR. IF * 59350000 * /* THE LAST CHAR IS A HYPHEN IT IS ALSO AN ERROR. * 59360000 * /* * 59370000 * /***************************************************************** 59380000 * 59390000 * 59400000 * SETPLNGH: /* SAVE LENGTH OF DATA FOR PDE * 59410000 * PFENDSET='0'B; /* INDICATE GOOD DN AFTER STACK 59420000 * POPPED * 59430000 @98D EQU * 1149 59440000 SETPLNGH NI 179(@B),B'11111011' 1149 59450000 * PLENGTH=R4-PPOINTR; /* LENGTH IN PLENGTH * 59460000 L @F,148(0,@B) 1150 59470000 LCR @F,@F 1150 59480000 AR @F,@4 1150 59490000 STH @F,152(0,@B) 1150 59500000 * R4=PPOINTR; /* RESET XINPUT TO BEGINNING OF 59510000 * DATA NAME * 59520000 L @4,148(0,@B) 1151 59530000 * 59540000 * TSTLOOP: 59550000 * ADDCDE=8; /* SET UP LOOP TO FIND AT * 59560000 TSTLOOP LA @F,8 1152 59570000 * R1='C0'X; /* LEAT ONE ALPHABETIC * 59580000 LA @1,X'C0' 1153 59590000 * CALL LINKRET; /* GO TO PARSE TYPETEST * 59600000 BAL @E,LINKRET 1154 59610000 * 59620000 * /***************************************************************** 59630000 * /* * 59640000 * /* GENERATE APPROPRIATE BRANCH +0 NOT ALPHA, +4 ALPHA * 59650000 * /* * 59660000 * /***************************************************************** 59670000 * 59680000 * GEN; 59690000 BC 15,NOTALPHA PROCESS NOT ALPHA - CONTINUE 59700000 * LOOP 59710000 BC 15,ALPHAFND VALID DATA NAME CONTINUE SCAN 59720000 DS 0H 59730000 * 59740000 * /***************************************************************** 59750000 * /* * 59760000 * /* IF AN ALPHA WAS NOT FOUND, CHECK TO DETERMINE IF HAVE SCANNED * 59770000 * /* THE ENTIRE DATA NAME WITHOUT FINDING AN ALPHA. IF SO, IT IS * 59780000 * /* AND ERROR. IF NOT, CONTINUE ALPHA SCAN * 59790000 * /* * 59800000 * /***************************************************************** 59810000 * 59820000 * 59830000 * NOTALPHA: /* DETERMINE IF AT THE END OF * 59840000 * IF R4=PPOINTR+PLENGTH-1 /* THE DATA NAME, IF SO GO * 59850000 * THEN /* TO PROCESS AS AN * 59860000 NOTALPHA LH @F,@D7 1156 59870000 AH @F,152(0,@B) 1156 59880000 A @F,148(0,@B) 1156 59890000 CR @F,@4 1156 59900000 * GOTO SETERBT2; /* ERROR * 59910000 BC 08,SETERBT2 1157 59920000 * R4=R4+1; /* IF NOT AT END OF DATA NAME * 59930000 AH @4,@D2 1158 59940000 * GOTO TSTLOOP; /* CONTINUE SCAN WITH NEXT 59950000 * CHARACTER * 59960000 BC 15,TSTLOOP 1159 59970000 * 59980000 * ALPHAFND: /* IF AN ALPHA WAS FOUND * 59990000 * R4=R5-1; /* CHECK LAST CHAR OF DATA NAME 60000000 * FOR NON-HYPHEN * 60010000 ALPHAFND LH @4,@D7 1160 60020000 AR @4,@5 1160 60030000 * 60040000 * /***************************************************************** 60050000 * /* * 60060000 * /* IS THE LAST CHARACTER A HYPHEN. XINPUTB AT THIS POINT IS SET * 60070000 * /* TO ONE AFTER THE LAST CHARACTER. XINPUT IS POINT- AT THE LAST * 60080000 * /* CHARACTER * 60090000 * /* * 60100000 * /***************************************************************** 60110000 * 60120000 * IF COMBUF='-' /* IF THE LAST CHARACTER IS A * 60130000 * THEN /* HYPHEN THEN PROCESS REMAIN- * 60140000 CLI 0(@4),C'-' 1161 60150000 * GOTO SETERBT2; /* DER IN ERROR MODE * 60160000 BC 08,SETERBT2 1162 60170000 * 60180000 * /***************************************************************** 60190000 * /* * 60200000 * /* NOW CHECK TO SEE IF IN ERROR MODE. IF IN ERROR MODE HAVE FOUND* 60210000 * /* ERROR PREVIOUSLY AND WANT TO BYPASS FILLINT IN THE PDE * 60220000 * /* * 60230000 * /***************************************************************** 60240000 * 60250000 * IF ERRORBIT='1'B /* IF THE ERROR FLAG IS ON * 60260000 * THEN /* GO TO PROCESS THE END OF * 60270000 TM 599(@B),B'00001000' 1163 60280000 * GOTO ENDSCAN; /* THE DATA NAME WITHOUT FILLING 60290000 * IN THE PDE * 60300000 BC 01,ENDSCAN 1164 60310000 * 60320000 * /***************************************************************** 60330000 * /* * 60340000 * /* IF THIS IS A QUALIFIER FOR THE ORIGINAL DATA NAME, MUST GO DO * 60350000 * /* SPECIAL PROCESSING. CORE MUST BE GOTTEN IF REQUIRED AND THE * 60360000 * /* PDE FOR THE QUALIFIER MUST BE FILLED IN DIFFERENTLY THAN FOR * 60370000 * /* THE FIRST DATA NAME * 60380000 * /* * 60390000 * /***************************************************************** 60400000 * 60410000 * IF QUALCT^=0 /* IF QUALIFIER COUNT IS NOT * 60420000 * THEN /* ZERO WE ARE PROCESSING * 60430000 CLI 598(@B),0 1165 60440000 * GOTO CORETEST; /* A QUALIFIER AND MUST DO 60450000 * SPECIAL PROCESSING TO FILL IN 60460000 * THE PDE * 60470000 BC 07,CORETEST 1166 60480000 * 60490000 * /***************************************************************** 60500000 * /* * 60510000 * /* IF THIS IS A GOOD DATA NAME (FIRST) WE WILL FALL THROUGH TO * 60520000 * /* HERE TO ADD THE DATA NAME INFORMATION TO THE PDE * 60530000 * /* * 60540000 * /***************************************************************** 60550000 * 60560000 * 60570000 * ADDNAME: 60580000 * ADDCDE=9; /* THE DATA NAME MUST BE TRANS * 60590000 ADDNAME LA @F,9 1167 60600000 * CALL LINKRET; /* LATED TO UPPERCASE IF 60610000 * SPECIFIED IN THE PDE * 60620000 BAL @E,LINKRET 1168 60630000 * DNAMEPTR=PPOINTR; /* SET DATANAME PTR IN PDE * 60640000 L @1,564(0,@B) 1169 60650000 MVC 0(4,@1),148(@B) 1169 60660000 * PARMIND='1'B; /* INDICATE PARM IS PRESENT * 60670000 OI 6(@1),B'10000000' 1170 60680000 * LNGTH4=PLENGTH; /* STORE THE LENGTH OF THE DATA 60690000 * NAME IN PDE * 60700000 MVC 4(1,@1),153(@B) 1171 60710000 * DATAPTRH='FF000000'X; /* SET QUALIFIER POINTR TO 60720000 * FF000000 TO INDICATE NO 60730000 * QUALIFIERS HAVE BEEN ADDED UP 60740000 * TO THIS TIME * 60750000 MVC 8(4,@1),@X27 1172 60760000 * CHAINPTR=ADDR (DATAPTR); /* SAVE THE PTR TO THE QUALI- 60770000 * FIIER PTR SO CAN FILL IN IF 60780000 * QUALIFIER ENCOUNTERED * 60790000 LA @F,8(0,@1) 1173 60800000 ST @F,560(0,@B) 1173 60810000 * IF FIRSTNAM^='1'B /* IF NOT FIRST DATA NAME OF * 60820000 * THEN /* VARIABLE, GO TO END OF * 60830000 TM 601(@B),B'10000000' 1174 60840000 * GOTO ENDSCAN; /* DATA NAME SCAN * 60850000 BC 12,ENDSCAN 1175 60860000 * FIRSTNAM='0'B; /* IF ON, TURN OFF - FIRST DATA 60870000 * NAME SCANNED * 60880000 NI 601(@B),B'01111111' 1176 60890000 * IF LNGTH5 ^= 0 /* IF NAMEREQD ON, PGMID * 60900000 * THEN /* PRECEEDED DATA NAME. MUST * 60910000 L @1,564(0,@B) 1177 60920000 CLI 16(@1),0 1177 60930000 BC 08,@98C 1177 60940000 * MSGLEN=LNGTH4+LNGTH5+1; /* ADD PGMID LENGTH TO DATA NAME 60950000 * LENGTH * 60960000 LA @F,1 1178 60970000 SR @0,@0 1178 60980000 IC @0,16(0,@1) 1178 60990000 AR @F,@0 1178 61000000 IC @0,4(0,@1) 1178 61010000 AR @F,@0 1178 61020000 STH @F,590(0,@B) 1178 61030000 BC 15,@98B 1179 61040000 * ELSE /* IF NO PGMID, FILL IN * 61050000 * DO; /* MESSAGE FIELDS WITH * 61060000 * MSGADDR=PPOINTR; /* ADDRESS AND LENGTH * 61070000 @98C MVC 592(4,@B),148(@B) 1180 61080000 * MSGLEN=PLENGTH; /* OF DATA NAME JUST * 61090000 MVC 590(2,@B),152(@B) 1181 61100000 * END; /* SCANNED * 61110000 * GOTO ENDSCAN; /* GOTO PROCESS THE END OF THIS 61120000 * DATA NAME AND CONTINUE THE 61130000 * SCAN * 61140000 BC 15,ENDSCAN 1183 61150000 * 61160000 * /***************************************************************** 61170000 * /* * 61180000 * /* IF COME TO SETERBT2, AN ERROR HAS BEEN FOUND WHILE PROCESSING * 61190000 * /* THE DATA NAME. THE ERROR BIT MUST BE SET BEFORE CONTINUING THE* 61200000 * /* SCAN TO FIND THE END OF THE TERM * 61210000 * /* * 61220000 * /***************************************************************** 61230000 * 61240000 * 61250000 * SETERBT2: /* SET THE ERROR MODE BIT AND * 61260000 * ERRORBIT='1'B; /* PFNOPOP TO PREVENT POPPING * 61270000 SETERBT2 OI 599(@B),B'00001000' 1184 61280000 * PFNOPOP='1'B; /* PREVENT STACK POPPING * 61290000 OI 179(@B),B'00000010' 1185 61300000 * 61310000 * /***************************************************************** 61320000 * /* * 61330000 * /* THE END OF A GOOD DATA NAME HAS BEEN FOUND. SAVE THE END OF * 61340000 * /* THE DATA NAME IN CASE HAVE TO BACK UP, I.E., NO QUALIFIER OR * 61350000 * /* SUBSCRIPT FOLLOWS. ALSO DETERMINE THE TYPE OF DELIMITER WHICH * 61360000 * /* FOLLOWS THE DATA NAME. THE DELIMITER WILL DETERMINE THE TYPE * 61370000 * /* OF PROCESSING. IF BLANKS FOLLOW, QUALIFIERS AND SUBSCRIPTS * 61380000 * /* MUST BE TESTED FOR. IF NO BLANKS, MUST BE A VALID DELIMITER, * 61390000 * /* I.E., ( ) ; EOB : * 61400000 * /* * 61410000 * /***************************************************************** 61420000 * 61430000 * 61440000 * ENDSCAN: 61450000 * ENDNMPTR=R4; /* SAVE THE END OF THE DATA NAME 61460000 * IN CASE SOMETHING NOT 61470000 * ASSOCIATED WITH THIS TERM PCE 61480000 * FOLLOWS * 61490000 ENDSCAN ST @4,556(0,@B) 1186 61500000 * CALL BUMP; /* INCREMENT SCAN PTR TO NEXT 61510000 * NEXT CHARACTER * 61520000 BAL @E,BUMP 1187 61530000 * 61540000 * /***************************************************************** 61550000 * /* * 61560000 * /* BRANCH TO APPROPRIATE ROUTINE TO HANDLE TYPE OF DELIMITER * 61570000 * /* FOLLOWING DATA * 61580000 * /* * 61590000 * /***************************************************************** 61600000 * 61610000 * GEN; 61620000 BC 15,ENDCK NO MORE DATA - EOB 61630000 BC 15,MORDTA MORE DATA AFTER DATA NAME 61640000 BC 15,XINUP2 STACK HAS BEEN POPPED AND MORE 61650000 DS 0H 61660000 * 61670000 * /***************************************************************** 61680000 * /* * 61690000 * /* IF IN SUBSCRIPT MODE AND NO ERROR MUST ISSUE 'ENDING PAREN * 61700000 * /* ASSUMED' MESSAGE THROUGH ROUTINE IS CONSTAND * 61710000 * /* * 61720000 * /***************************************************************** 61730000 * 61740000 * 61750000 * ENDCK: 61760000 * IF PFENDSET='1'B /* IF THE BUFFER HAS A00996 * 61770000 * THEN /* BEEN POPPED, MUST A00996 * 61780000 ENDCK TM 179(@B),B'00000100' 1189 61790000 BC 12,@98A 1189 61800000 * DO; /* RESET BUFFER A00996 * 61810000 * ENDINPUT=ENDBAKUP; /* POINTERS TO PREVIOUS A00996 * 61820000 MVC 144(4,@B),412(@B) 1191 61830000 * R4=ENDNMPTR+1; /* BUFFER AT END OF A00996 * 61840000 LA @4,1 1192 61850000 A @4,556(0,@B) 1192 61860000 * R5=ENDBAKUP; /* VARIABLE JUST SCANNED A00996 * 61870000 L @5,412(0,@B) 1193 61880000 * PFENDSET='0'B; /* RESET BUFFER POPPED A00996 * 61890000 NI 179(@B),B'11111011' 1194 61900000 * END; /* INDICATOR A00996 * 61910000 * IF SUBSMODE='1'B /* IF IN SUBSCRIPT MODE, GO * 61920000 * THEN /* ISSUE 'ENDING PAREN * 61930000 @98A TM 599(@B),B'00100000' 1196 61940000 * GOTO ENDSUB; /* DO NOT HAVE TO ISSUE MESSAGE. * 61950000 BC 01,ENDSUB 1197 61960000 * 61970000 * /***************************************************************** 61980000 * /* * 61990000 * /* IF FALL THROUGH MUST GO TO RANGE TO GET RNGEVAL2 TURNED ON IF * 62000000 * /* PROCESSING THE 2ND VALUE OF A RANGE AND A VALID END DELIMITER * 62010000 * /* HAS BEEN FOUND * 62020000 * /* * 62030000 * /***************************************************************** 62040000 * 62050000 * 62060000 * RANGESET: /* GO TO RANGE, TO GET * 62070000 * CALL TSTRNGE; /* PROCESS RANGE, ONLY A00996 62080000 * POSSIBLE RETURN 62090000 * IS +0 BECAUSE KNOW NOT 62100000 * POINTING AT A COLON * 62110000 RANGESET L @F,@V5 ADDRESS OF TSTRNGE 1198 62120000 BALR @E,@F 1198 62130000 * 62140000 * /***************************************************************** 62150000 * /* * 62160000 * /* THIS IS A COMMON EXIT ROUTINE WHICH DETERMINES THE PROCESSING * 62170000 * /* ENVIRONMENT AT THE TIME OF ADDING THE PDE IF IN ERRORMODE, NO * 62180000 * /* PDE PROCESSING IS NECESSARY. * 62190000 * /* * 62200000 * /***************************************************************** 62210000 * 62220000 * 62230000 * EXIT: 62240000 * IF ERRORBIT='1'B /* IF ERRORMODE, GO DIRECTLY * 62250000 * THEN /* TO END PROCESSING. NO PDE * 62260000 EXIT TM 599(@B),B'00001000' 1199 62270000 * GOTO CODE4; /* PROCESSING * 62280000 BC 01,CODE4 1200 62290000 * 62300000 * /***************************************************************** 62310000 * /* * 62320000 * /* IF THE NUMBER OF QUALIFIERS HAVE EXCEEDED 256, IT IS AN ERROR * 62330000 * /* * 62340000 * /***************************************************************** 62350000 * 62360000 * 62370000 * EXITA: 62380000 * IF QUALCT=256 /* IS QUALIFIER COUNT=> 256? * 62390000 * THEN /* IF YES, SET * 62400000 EXITA LA @F,256 1201 62410000 SR @0,@0 1201 62420000 IC @0,598(0,@B) 1201 62430000 CR @F,@0 1201 62440000 BC 07,@989 1201 62450000 * DO; /* THE ERRORBIT ON * 62460000 * ERRORBIT='1'B; /* AND GO TO ERROR ROUTINE * 62470000 OI 599(@B),B'00001000' 1203 62480000 * PFNOPOP='1'B; /* PREVENT STACK POPPING * 62490000 OI 179(@B),B'00000010' 1204 62500000 * GOTO PRMTEXT; /* IN THE END PROCESSING RTN * 62510000 BC 15,PRMTEXT 1205 62520000 * END; /* END ERROR PROCESSING FOR MORE 62530000 * THAN 255 QUALIFIERS * 62540000 * 62550000 * /***************************************************************** 62560000 * /* * 62570000 * /* IF NO ERROR, SPECIAL PROCESSING MUST BE DONE TO COMPLETE THE * 62580000 * /* PDE BEFORE GOING TO POSITXCB IN PARSE TO ADD THE PDE TO THE * 62590000 * /* PDL * 62600000 * /* * 62610000 * /***************************************************************** 62620000 * 62630000 * 62640000 * ZEROQLCT: /* ADD QUALIFIER COUNT IF * 62650000 * /* REQUIRED * 62660000 * 62670000 * /***************************************************************** 62680000 * /* * 62690000 * /* IF THE TERM IS NOT A VARIABLE DO NOT WANT TO ADD THE QUALIFIER* 62700000 * /* COUNT * 62710000 * /* * 62720000 * /***************************************************************** 62730000 * 62740000 * IF CONST='1'B /* IF PDE DESCRIBES A CONS- * 62750000 * THEN /* SKIP OVER ADDING * 62760000 @989 EQU * 1207 62770000 ZEROQLCT L @1,564(0,@B) 1207 62780000 TM 6(@1),B'01000000' 1207 62790000 * GOTO SKPQLST; /* QUALIFIER COUNT * 62800000 BC 01,SKPQLST 1208 62810000 * 62820000 * /***************************************************************** 62830000 * /* * 62840000 * /* IF STATEMENT PDE, SKIP ADDING QUALIFIER COUNT * 62850000 * /* * 62860000 * /***************************************************************** 62870000 * 62880000 * IF STATE='1'B /* STATEMENT PDE? * 62890000 * THEN /* SKIP ADDING * 62900000 TM 6(@1),B'00010000' 1209 62910000 * GOTO SKPQLST; /* QUALIFIER COUNT * 62920000 BC 01,SKPQLST 1210 62930000 * NUMQUAL=QUALCT; /* IF FALL THROUGH, IS A VAR- * 62940000 MVC 17(1,@1),598(@B) 1211 62950000 * QUALCT=0; /* PDE. QUALIFIER COUNT MUST BE 62960000 * ADDED AND THE COUNTER SET TO 62970000 * ZERO * 62980000 MVI 598(@B),0 1212 62990000 * R6=TERMXPCE; /* RESET THE PCE PTR TO THE MAJOR 63000000 * PCE IN CASE PROCES- UNDER A 63010000 * SUBSCPCE * 63020000 L @6,528(0,@B) 1213 63030000 * 63040000 * SKPQLST: 63050000 * PDEPTR=ADDR (TEMPPDE); /* RESET THE PDE PTR TO THE THE 63060000 * BEGINNING OF THE TEMP- ORARY 63070000 * PDE FOR ADDING * 63080000 SKPQLST LA @F,332(0,@B) 1214 63090000 ST @F,564(0,@B) 1214 63100000 * IF OPERMODE^='1'B /* IF OPERMODE NOT ON CONTINUE * 63110000 * THEN /* NORMAL PARSE AND DO NOT * 63120000 TM 599(@B),B'01000000' 1215 63130000 * GOTO VAREXIT; /* CHECK FOR MORE DATA * 63140000 BC 12,VAREXIT 1216 63150000 * IF PRMTSCAN^='1'B /* IF OPERMODE, BUT HAVE NOT * 63160000 * THEN /* PROMPTED PREVIOUSLY, DON'T * 63170000 TM 600(@B),B'00000100' 1217 63180000 * GOTO VAREXIT; /* FOR MORE DATA * 63190000 BC 12,VAREXIT 1218 63200000 * IF PFENDSET='1'B /* IF HAVE SCANNED ENTIRE * 63210000 * THEN /* PROMPT BUFFER, PROMPT * 63220000 TM 179(@B),B'00000100' 1219 63230000 * GOTO VAREXIT; /* RESPONSE WAS GOOD * 63240000 BC 01,VAREXIT 1220 63250000 * PFNOPOP='1'B; /* DON'T ALLOW STACK POPPING * 63260000 OI 179(@B),B'00000010' 1221 63270000 * ADDCDE=5; /* GO TO SKIPB TO SEE IF ADDIT * 63280000 LA @F,5 1222 63290000 * CALL LINKRET; /* DATA ENTERED ON PROMPT IN 63300000 * OPERMODE. IF SO, ERROR * 63310000 BAL @E,LINKRET 1223 63320000 * GOTO VAREXIT; /* IF +0, NO MORE DATA - O.K. * 63330000 BC 15,VAREXIT 1224 63340000 * ERRORBIT='1'B; /* +4, MORE DATA - ERROR * 63350000 OI 599(@B),B'00001000' 1225 63360000 * PFNOPOP='1'B; /* PREVENT STACK POPPING * 63370000 OI 179(@B),B'00000010' 1226 63380000 * GOTO CODE4; /* GO TO MESSAGE PROCESSOR * 63390000 BC 15,CODE4 1227 63400000 * 63410000 * /***************************************************************** 63420000 * /* * 63430000 * /* IF SKIPB HAS DETECTED THE END OF THE BUFFER, DO NOT WANT TO * 63440000 * /* SET XINPUTB = XINPUT FOR POSSIBLE ERROR FROM VALIDITY CHECK * 63450000 * /* EXIT. THIS WILL PREVENT LOSING THE END OF THE BUFFER * 63460000 * /* * 63470000 * /***************************************************************** 63480000 * 63490000 * 63500000 * VAREXIT: 63510000 * IF PFENDF^='1'B /* IF SKIPB DID NOT DETECT EOB * 63520000 * THEN /* THEN SET XINPUTB = XINPUT * 63530000 VAREXIT TM 176(@B),B'00100000' 1228 63540000 BC 01,@988 1228 63550000 * R5=R4; /* FOR POSSIBLE ERROR MESSAGE * 63560000 LR @5,@4 1229 63570000 * GOTO CODE4; /* IN EITHER CASE GO TO END OF 63580000 * TERM PROCESSING * 63590000 BC 15,CODE4 1230 63600000 * GEN (EJECT); 63610000 EJECT 63620000 DS 0H 63630000 * 63640000 * /***************************************************************** 63650000 * /* * 63660000 * /* THIS ROUTINE IS ENTERED IF MORE DATA WAS DETECTED AFTER A GOOD* 63670000 * /* DATA NAME. TESTS MUST BE MADE TO SEE WHAT KIND OF DATA * 63680000 * /* FOLLOWS; SEPARATORS, OR DELIMITERS * 63690000 * /* * 63700000 * /***************************************************************** 63710000 * 63720000 * 63730000 * MORDTA: 63740000 * ADDCDE=8; /* GO TO TYPETEST TO DETER- * 63750000 MORDTA LA @F,8 1232 63760000 * R1='08'X; /* IF SEPARATOR FOLLOWS * 63770000 LA @1,X'08' 1233 63780000 * CALL LINKRET; /* INTERFACE TO PARSE * 63790000 BAL @E,LINKRET 1234 63800000 * GEN; /* RETURN BRANCHES * 63810000 BC 15,GDNNBL GO TO GOOD NAME NO BLANKS RTN 63820000 DS 0H 63830000 * 63840000 * /***************************************************************** 63850000 * /* * 63860000 * /* ROUTINE ENTERED IF SEPARATORS FOUND AFTER A GOOD DATA NAME * 63870000 * /* * 63880000 * /***************************************************************** 63890000 * 63900000 * 63910000 * VSEPSKIP: /* SKIP THE FOLLOWING SEP- * 63920000 * ADDCDE=5; /* USING THE PARSE SKIPB * 63930000 VSEPSKIP LA @F,5 1236 63940000 * CALL LINKRET; /* ROUTINE * 63950000 BAL @E,LINKRET 1237 63960000 * GOTO ENDCK; /* IF NOT MORE DATA (+0 RET) GOTO 63970000 * THE END OF DATA ROUTIN * 63980000 BC 15,ENDCK 1238 63990000 * 64000000 * /***************************************************************** 64010000 * /* * 64020000 * /* IF MORE DATA APPEARS AFTER THE SEPARATORS, MUST CHECK FOR * 64030000 * /* QUALIFIERS. QUALIFIERS ARE PRECEDED BY IN OR OF * 64040000 * /* * 64050000 * /***************************************************************** 64060000 * 64070000 * 64080000 * XINUP2: 64090000 * R4=R4+2; /* MSUT CHECK TO MAKE A00996 * 64100000 XINUP2 AH @4,@D4 1239 64110000 * IF R4=>ENDINPUT /* SURE ENDINPUT IS NOT A00996 * 64120000 * THEN /* WITHIN NEXT TWO CHARS A00996 * 64130000 C @4,144(0,@B) 1240 64140000 BC 04,@987 1240 64150000 * DO; /* SO DON'T REFERENCE A00996 * 64160000 * R4=R4-1; /* OUTSIDE OF PARSE2 A00996 64170000 * REGION. POINT AT CHAR A00996 * 64180000 BCTR @4,0 1242 64190000 * GOTO ASIS1; /* AND GO TO PROCESS AS A00996 * 64200000 BC 15,ASIS1 1243 64210000 * END; /* DELIMITER A00996 * 64220000 * R4=R4-1; /* POINT AT FIRST CHAR A00996 * 64230000 @987 BCTR @4,0 1245 64240000 * TRANAREA=COMBUFA; /* MOVE TWO CHARACTERS FROM IN * 64250000 MVC 604(2,@B),0(@4) 1246 64260000 * TRANAREA (1:2)= /* PUT OT WORD AREA TO TRANS- * 64270000 * TRANAREA(1:2)|' '; /* LATE THEM TO UPPER CASE * 64280000 OC 604(2,@B),@C28 1247 64290000 * 64300000 * /***************************************************************** 64310000 * /* * 64320000 * /* CHECK FOR QUALIFIER DELIMETER WORD - IN * 64330000 * /* * 64340000 * /***************************************************************** 64350000 * 64360000 * IF TRANAREA^='IN' /* CHECK TWO CHARACTERS FOR * 64370000 * THEN /* IN OR OF * 64380000 CLC 604(2,@B),@C29 1248 64390000 BC 08,@986 1248 64400000 * 64410000 * /*************************************************************** 64420000 * /* * 64430000 * /* IF NOT IN, CHECK FOR OF. IF NEITHER, GO TO THE ROUTINE TO * 64440000 * /* PROCESS DELIMITERS OTHER THAN IN OR OF FOLLOWING A DATA NAME* 64450000 * /* WHICH HAS BLANKS FOLLOWING IT * 64460000 * /* * 64470000 * /*************************************************************** 64480000 * 64490000 * IF TRANAREA^='OF' /* IF NOT IN, IS IT OF * 64500000 * THEN /* IF NEITHER, GO TO THE * 64510000 CLC 604(2,@B),@C30 1249 64520000 * GOTO ASIS1; /* DELIMITER AFTER BLANKS RTN * 64530000 BC 07,ASIS1 1250 64540000 * 64550000 * /***************************************************************** 64560000 * /* * 64570000 * /* IF FALL THROUGH TO HERE AN IN OR OF WAS FOUND IN THE BUFFER. * 64580000 * /* SPECIAL PROCESSING FOR THE QUALIFIERS OF THIS DATA NAME MUST * 64590000 * /* BE DONE * 64600000 * /* * 64610000 * /***************************************************************** 64620000 * 64630000 * 64640000 * TRNSLATE: /* CHECK TO SEE IF UPPERCASE * 64650000 * IF ASIS='1'B /* IS REQUESTED IN THE PCE * 64660000 * THEN /* IF NOT (ASIS BIT ON), THEN * 64670000 @986 EQU * 1251 64680000 TRNSLATE TM 1(@6),B'01000000' 1251 64690000 * GOTO XINUP3; /* SKIP OVER TRANSLATION * 64700000 BC 01,XINUP3 1252 64710000 * 64720000 * /***************************************************************** 64730000 * /* * 64740000 * /* IF UPPERCASE REQUESTED, MOVE THE TWO BYTES FROM THE TRANAREA * 64750000 * /* BACK TO THE INPUT BUFFER * 64760000 * /* * 64770000 * /***************************************************************** 64780000 * 64790000 * IF PFDEFLT='1'B /* IF PROCESSING A DEFAULT * 64800000 * THEN /* IN THE PCE CANNOT CHANGE * 64810000 TM 176(@B),B'01000000' 1253 64820000 * GOTO XINUP3; /* THE DATA IN THE USER'S CORE 64830000 * (THE PCE IS IN HIS PROGRAM * 64840000 BC 01,XINUP3 1254 64850000 * COMBUF (1:2)=TRANAREA; /* OTHERWISE, MOVE IN UPPER- CASE 64860000 * DATA * 64870000 MVC 0(2,@4),604(@B) 1255 64880000 * 64890000 * /***************************************************************** 64900000 * /* * 64910000 * /* SKIP OVER THE IN OR OF AND SET UP FOR PROCESSING THE THE * 64920000 * /* QUALIFYING DATA NAME * 64930000 * /* * 64940000 * /***************************************************************** 64950000 * 64960000 * 64970000 * XINUP3: 64980000 * R4=R4+1; /* INCREMENT XINPUT PASSED * 64990000 XINUP3 AH @4,@D2 1256 65000000 * CALL BUMP; /* THE IN OR OF * 65010000 BAL @E,BUMP 1257 65020000 * GOTO SETER; /* IF BUMP RETURNS +0, A00996 65030000 * EOB WAS DETECTED A00996 65040000 * THIS IS AN ERROR AFTER A00996 65050000 * IN OR OF A00996 * 65060000 BC 15,SETER 1258 65070000 * 65080000 * /***************************************************************** 65090000 * /* * 65100000 * /* GENERATE BRANCHES FOR +4- MORE DATA, +8 - MORE DATA STACK * 65110000 * /* POPPED * 65120000 * /* * 65130000 * /***************************************************************** 65140000 * 65150000 * GEN; 65160000 BC 15,BLNKTEST MORE DATA IN BUFFER 65170000 BC 15,VSEPSK STACK POPPED MORE DATA A00996 65180000 DS 0H 65190000 * 65200000 * BLNKTEST: /* DETERMINE IF SEP AFTER INOF * 65210000 * ADDCDE=8; /* IF BUMP RETURNS +4 , MUST 65220000 * CHECK TO MAKE SURE SEP FOL- * 65230000 BLNKTEST LA @F,8 1260 65240000 * R1='08'X; /* IN OR OF. IF NOT A SEP, THE IN 65250000 * OR OF IS PART OF ANOTHER PCE 65260000 * TERM AND WE MUST BACK UP AND 65270000 * CONSIDER THE DATA NAME BEFORE 65280000 * THE IN OR OF AS A VALID DATA 65290000 * NAME * 65300000 LA @1,X'08' 1261 65310000 * CALL LINKRET; /* GOT TO TYPETEST * 65320000 BAL @E,LINKRET 1262 65330000 * GEN; /* GENERATE RETURN BRANCHES * 65340000 BC 15,ENDNAME NO SEPARATOR FOUND +0 65350000 BC 15,VSEPSK1 IF SEPARATOR, SKIP THEM 65360000 DS 0H 65370000 * 65380000 * /***************************************************************** 65390000 * /* * 65400000 * /* IF NO BLANKS FOLLOW THE IN OR OF, WE MUST BACK UP TO THE END * 65410000 * /* OF THE PREVIOUS GOOD DATA NAME. IF WE HAVE POPPED THE STACK TO* 65420000 * /* REACH THE IN.. OF.., WE MUST PUSH THESE ON THE STACK FOR LATER* 65430000 * /* PROCESSING SO THEY ARE NOT LOST * 65440000 * /* * 65450000 * /***************************************************************** 65460000 * 65470000 * 65480000 * ENDNAME: 65490000 * IF SUBSMODE='1'B /* IF IN SUBSCRIPT MODE A00996 * 65500000 * THEN /* RESET THE INPUT PTR A00996 * 65510000 ENDNAME TM 599(@B),B'00100000' 1264 65520000 BC 12,@985 1264 65530000 * DO; /* TO PROCESS A00996 * 65540000 * R4=R4-2; /* RESET TO BEGINNING A00996 * 65550000 SH @4,@D4 1266 65560000 * GOTO ASIS1; /* FINSH PROCESSING A00996 * 65570000 BC 15,ASIS1 1267 65580000 * END; /* END A00996 * 65590000 * IF PFENDSET='1'B /* WAS THE PROMPT BUFFER POP- * 65600000 * THEN /* PED OFF THE STACK, IF SO * 65610000 @985 TM 179(@B),B'00000100' 1269 65620000 BC 12,@984 1269 65630000 * DO; /* THE IN. OF. MUST BE SAVED * 65640000 * R4=R4-3; /* BACK THE BUFFER PTR TO BEFORE 65650000 * THE IN. OF. * 65660000 SH @4,@D8 1271 65670000 * ADDCDE=17; /* PREPARE TO CALL PUSH THE * 65680000 LA @F,17 1272 65690000 * CALL LINKRET; /* STACK ROUTINE IN PARSE * 65700000 BAL @E,LINKRET 1273 65710000 * ENDINPUT=ENDBAKUP; /* ON RETURN, RESET THE EOB 65720000 * INDICATOR TO THE END OF THE 65730000 * PREVIOUS BUFFER BEFORE IT WAS 65740000 * POPPED * 65750000 MVC 144(4,@B),412(@B) 1274 65760000 * END; /* END SPECIAL PROMPT BUFFER 65770000 * PROCESSING * 65780000 * R4=ENDNMPTR+1; /* IN EITHER CASE MUST RESET THE 65790000 * INPUT BUFFER TO THE END OF THE 65800000 * PREVIOUS DATA NAME * 65810000 @984 LA @4,1 1276 65820000 A @4,556(0,@B) 1276 65830000 * GOTO ZEROQLCT; /* GOTO PROCESS THE END OF THE 65840000 * DATA NAME AND FILL IN THE PDE 65850000 * INFO REQUIRED * 65860000 BC 15,ZEROQLCT 1277 65870000 * 65880000 * /***************************************************************** 65890000 * /* * 65900000 * /* IF SEPARATORS WERE DETECTED AFTER THE IN OR OF, SKIP THEM AND * 65910000 * /* DETERMINE TYPE OF PROCESSING WHICH FOLLOWS * 65920000 * /* * 65930000 * /***************************************************************** 65940000 * 65950000 * 65960000 * VSEPSK1: 65970000 * ADDCDE=5; /* SKIP THE FOLLOWING SEPS * 65980000 VSEPSK1 LA @F,5 1278 65990000 * CALL LINKRET; /* THROUGH AKIPB RTN IN PARSE * 66000000 BAL @E,LINKRET 1279 66010000 * GOTO SETER; /* IF EOB OCCURS, THIS IS AN 66020000 * ERROR, SINCE IN OR OF MUST BE 66030000 * FOLLOWED BY A VALID DATA NAME * 66040000 BC 15,SETER 1280 66050000 * VSEPSK: /* MORE DATA AFTER SEPS A00996 * 66060000 * R4=R4+1; /* IF MORE DATA, SET XINPUT TO 66070000 * THE FIRST CHARACTER * 66080000 VSEPSK AH @4,@D2 1281 66090000 * NAMEREQD='1'B; /* INIDCATE THAT A GOOD DATA NAME 66100000 * IS REQUIRED AT THIS POINT IN 66110000 * THE BUFFER * 66120000 OI 599(@B),B'00010000' 1282 66130000 * QUALCT=QUALCT+1; /* ADD ONE TO THE QUALIFIER COUNT 66140000 * - KNOW AT THIS TIME THAT THIS 66150000 * MUST BE A QUALI- FIER * 66160000 LA @F,1 1283 66170000 SR @0,@0 1283 66180000 IC @0,598(0,@B) 1283 66190000 AR @F,@0 1283 66200000 STC @F,598(0,@B) 1283 66210000 * GOTO DNAMSCAN; /* GO TO SCAN THE QUALIFIER AS A 66220000 * DATA NAME * 66230000 BC 15,DNAMSCAN 1284 66240000 * 66250000 * SETER: 66260000 * IF PFENDSET='1'B /* IF BUFFER WAS POPPED * 66270000 * THEN /* MUST RESET BUFFER POINT * 66280000 SETER TM 179(@B),B'00000100' 1285 66290000 BC 12,@983 1285 66300000 * DO; /* ERS, SO WILL BE CORRECT * 66310000 * R4=ENDBAKUP; /* FOR MESSAGE. ENDBAKUP * 66320000 L @4,412(0,@B) 1287 66330000 * ENDINPUT=ENDBAKUP; /* SET WHEN STACK POPPED * 66340000 MVC 144(4,@B),412(@B) 1288 66350000 * END; /* END SPECIAL PROCESSING * 66360000 * ERRORBIT='1'B; /* IF NO DATA AFTER IN OR OF THIS 66370000 * IS AN ERROR * 66380000 @983 OI 599(@B),B'00001000' 1290 66390000 * PFNOPOP='1'B; /* PREVENT STACK POPPING * 66400000 OI 179(@B),B'00000010' 1291 66410000 * R4=R4+1; /* SET XINPUT = EOB * 66420000 AH @4,@D2 1292 66430000 * GOTO CODE4; /* GO TO END PROCESSING * 66440000 BC 15,CODE4 1293 66450000 * GEN (EJECT); 66460000 EJECT 66470000 DS 0H 66480000 * 66490000 * /***************************************************************** 66500000 * /* * 66510000 * /* THIS ROUTINE IS ENTERED WHEN A GOOD DATA NAME IS FOUND AND THE* 66520000 * /* DATA NAME IF FOLLOWED BY A DELIMITER OTHER THAN A SEPARATOR. * 66530000 * /* THE TYPE OF DELIMITER IS DETERMINED AND THE TYPE OF PROCESSING* 66540000 * /* REQUIRED IS DETERMINED BY THE TYPE OF DELIMITER FOLLOWING THE * 66550000 * /* DATA NAME. IF A ( FOLLOWS A GOOD DATA NAME WITH NO BLANKS * 66560000 * /* BETWEEN THE DATA NAME AND THE (, THE DATA AFTER THE LEFT PAREN* 66570000 * /* IS AUTOMATICALLY CONSIDERED A SUBSCRIPT IF THE SUBSCRIPTABLE * 66580000 * /* OPTION IS IN THE TERM PCE. IF THERE IS NO SUBSCRIPTABLE * 66590000 * /* OPTION, THIS LEFT PAREN IS AN INVALID OTHER CHARACTER. * 66600000 * /* * 66610000 * /***************************************************************** 66620000 * 66630000 * 66640000 * GDNNBL: 66650000 * IF COMBUF='(' /* IF THE DELIMITER IS A LEFT * 66660000 * THEN /* GOTO THE ROUTINE TO CHECK * 66670000 GDNNBL CLI 0(@4),C'(' 1295 66680000 * GOTO SUBSCK; /* THE VALIDITY OF A SUB- SCRIPT 66690000 * FOLLOWING THIS DATA NAME * 66700000 BC 08,SUBSCK 1296 66710000 * 66720000 * /***************************************************************** 66730000 * /* * 66740000 * /* IF NOT A LEFT PAREN, CHECK FOR A SEMICOLON. IF A SEMICOLON, A * 66750000 * /* CHECK MUST BE MADE FOR SUBSCRIPT AND ERROR MOCE FOR SPECIAL * 66760000 * /* PROCESSING IN CASE OF A ; WHILE PROCESSING A SUBSCRIPT. THE * 66770000 * /* 'ENDING PAREN ASSUMED' MESSAGE MUST BE WRITTEN UNLESS IN * 66780000 * /* ERRORMODE * 66790000 * /* * 66800000 * /***************************************************************** 66810000 * 66820000 * IF COMBUF=';' /* IF SEMICOLON IN BUFFER, * 66830000 * THEN /* MUST DO SPECIAL CHECKING * 66840000 CLI 0(@4),C';' 1297 66850000 BC 07,@982 1297 66860000 * DO; /* IF SUBSCRIPT MODE AND NOT * 66870000 * IF SUBSMODE^='1'B /* ERROR MODE MUST PROCESS * 66880000 * THEN /* END, BUT FIRST MUST ISSUE * 66890000 TM 599(@B),B'00100000' 1299 66900000 * GOTO RANGESET; /* GET RANGE WITCHES SET * 66910000 BC 12,RANGESET 1300 66920000 * IF ERRORBIT='1'B /* IF SUBSCRIPT MODE A00996 * 66930000 * THEN /* AND ERROR MODE, DO NOT A00996 * 66940000 TM 599(@B),B'00001000' 1301 66950000 * GOTO VSBEND1; /* GO TO ISSUE RIGHT A00996 66960000 * PAREN ASSUMED MESSAGE A00996 * 66970000 BC 01,VSBEND1 1302 66980000 * GOTO ENDCMDCK; /* IF SUBSMODE ON, EXIT TO 66990000 * ENDCMDCK LABEL IN CONSTANT * 67000000 BC 15,ENDCMDCK 1303 67010000 * END; /* END TH PROCESSING FOR ; FOUND 67020000 * IN BUFFER IMMEDIATELY 67030000 * FOLLOWING THE DATA NAME * 67040000 * 67050000 * /***************************************************************** 67060000 * /* * 67070000 * /* MUST CHECK FOR REMAINING VALID DELIMITERS IF NOT A LEFT PAREN * 67080000 * /* OR SEMICOLON * 67090000 * /* * 67100000 * /***************************************************************** 67110000 * 67120000 * 67130000 * RHTPARCK: /* CHECK FOR A RIGHT PAREN * 67140000 * IF COMBUF=')' /* IF A RIGHT PAREN, SPECIAL * 67150000 * THEN /* IS REQUIRED TO MAKE SURE * 67160000 @982 EQU * 1305 67170000 RHTPARCK CLI 0(@4),C')' 1305 67180000 BC 07,@981 1305 67190000 * DO; /* THE RIGHT PAREN IS VALID * 67200000 * 67210000 * /************************************************************* 67220000 * /* * 67230000 * /* IF IN SUBSCRIPT MODE, GO TO ROUTINE TO PROCESS THE END OF * 67240000 * /* THE SUBSCRIPT. * 67250000 * /* * 67260000 * /************************************************************* 67270000 * 67280000 * IF SUBSMODE='1'B /* IF SUBSCRIPT MODE * 67290000 * THEN /* PROCESS END OF SUBSCRIPT * 67300000 TM 599(@B),B'00100000' 1307 67310000 * GOTO VSUBENDK; /* THRU SUBENDCK RTN * 67320000 BC 01,VSUBENDK 1308 67330000 * 67340000 * /************************************************************* 67350000 * /* * 67360000 * /* IF EITHER THE OPERMODE OR THE PFLIST BITS ARE ON THE RIGHT* 67370000 * /* PAREN SIGNIFIES THE END OF THE EXPRESSION OR THE END OF * 67380000 * /* THE LIST * 67390000 * /* * 67400000 * /************************************************************* 67410000 * 67420000 * IF OPERMODE='1'B /* IF OPERMODE ON * 67430000 * THEN /* GOTO PROCESS THE END OF * 67440000 TM 599(@B),B'01000000' 1309 67450000 * GOTO EXIT; /* THE DATA NAME AND FILL IN THE 67460000 * PDE * 67470000 BC 01,EXIT 1310 67480000 * 67490000 * /************************************************************* 67500000 * /* * 67510000 * /* IF PFLIST ON GO TO END OF DATA NAME PROCESSING * 67520000 * /* * 67530000 * /************************************************************* 67540000 * 67550000 * IF PFLIST='1'B /* IF PROCESSING A LIST, THE * 67560000 * THEN /* RIGHT PAREN IS A VALID * 67570000 TM 176(@B),B'10000000' 1311 67580000 * GOTO VRNGCK1; /* DELIMITER * 67590000 BC 01,VRNGCK1 1312 67600000 * GOTO VERRBIT; /* IF A RIGHT PAREN WAS FOUND AND 67610000 * NEITHER OPERMODE, SUBS- CRIPT 67620000 * MODE OR LIST MODE, IT IS AN 67630000 * INVALID DELIMITER * 67640000 BC 15,VERRBIT 1313 67650000 * END; /* END PROCESSING OF A RIGHT 67660000 * PAREN IMMEDIATELY FOLLOWING A 67670000 * DATA NAME * 67680000 * 67690000 * /***************************************************************** 67700000 * /* * 67710000 * /* CHECK TO SEE IF DELIMITER IS A COLON. THIS IS THE ONLY * 67720000 * /* REMAINING VALID DELIMITER IMMEDIATELY FOLLOWING A DATA NAME * 67730000 * /* * 67740000 * /***************************************************************** 67750000 * 67760000 * IF COMBUF=':' /* IF DELIMTER IS A COLON GO * 67770000 * THEN /* GO TO RANGE TO SET SWITCHES * 67780000 @981 CLI 0(@4),C':' 1315 67790000 * GOTO VRNGCK1; /* GET RNGEVAL1 TURNED ON * 67800000 BC 08,VRNGCK1 1316 67810000 * ELSE /* IF NOT COLON, NO MORE VALID * 67820000 * GOTO VERRBIT; /* DELIMITERS, GOTO ERROR RTN * 67830000 BC 15,VERRBIT 1317 67840000 * 67850000 * /***************************************************************** 67860000 * /* * 67870000 * /* IF DELIMITER WAS A LEFT PAREN MUST CHECK TO SEE IF PCE IS * 67880000 * /* SUBSCRIPTABLE. IF NOT, THE LEFT PAREN IS AN INVALID CHARACTER.* 67890000 * /* * 67900000 * /***************************************************************** 67910000 * 67920000 * 67930000 * SUBSCK: 67940000 * IF SUBSCRP^='1'B /* IF PCE IS NOT SUBSCRIPTABLE * 67950000 * THEN /* THE RIGHT PAREN IS INVALID * 67960000 SUBSCK TM 1(@6),B'00010000' 1318 67970000 BC 01,@980 1318 67980000 * DO; /* THE ERROBIT MUST BE SET ON * 67990000 * ERRORBIT='1'B; /* AND EXIT TO THE RTN TO SCAN * 68000000 OI 599(@B),B'00001000' 1320 68010000 * PFNOPOP='1'B; /* PREVENT STACK POPPING * 68020000 OI 179(@B),B'00000010' 1321 68030000 * GOTO XINUP; /* THE REST OF THE DATA IN * 68040000 BC 15,XINUP 1322 68050000 * END; /* ERROR * 68060000 * ADDCDE=5; /* IF SUBSCRIPTABLE, SKIP * 68070000 @980 LA @F,5 1324 68080000 * PFNOPOP='1'B; /* SUBSCRIPT MUST BE ON ONE 68090000 * BUFFER * 68100000 OI 179(@B),B'00000010' 1325 68110000 * CALL LINKRET; /* INTERVENING BLANKS BEFORE 68120000 * SUBSCRIPT * 68130000 BAL @E,LINKRET 1326 68140000 * GOTO SETERR; /* IF NO DATA AFTER RHT PAREN IS 68150000 * AN ERROR * 68160000 BC 15,SETERR 1327 68170000 * R4=R4+1; /* IF DATA, INCREMENT XINPUT TO 68180000 * POINT TO THE FIRS CHAR * 68190000 AH @4,@D2 1328 68200000 * PFNOPOP='0'B; /* RESET PFNOPOP IF DATA FOUND * 68210000 NI 179(@B),B'11111101' 1329 68220000 * IF CHAINTRM='1'B /* IF THIS IS A CHAINED * 68230000 * THEN /* TERM OFF AN OPER, THIS * 68240000 TM 600(@B),B'00010000' 1330 68250000 * GOTO SUBSCRPT; /* IS DEFINITELY A SUBSCPT * 68260000 BC 01,SUBSCRPT 1331 68270000 * 68280000 * /***************************************************************** 68290000 * /* * 68300000 * /* IF THE ERRORBIT IS ON , GO TO THE ROUTINE TO SCAN FOR THE END * 68310000 * /* OF THE SUBSCRIPT * 68320000 * /* * 68330000 * /***************************************************************** 68340000 * 68350000 * IF ERRORBIT='1'B /* IF ERROR BIT ON, SET * 68360000 * THEN /* INDICATORS * 68370000 TM 599(@B),B'00001000' 1332 68380000 BC 12,@97F 1332 68390000 * DO; /* PROPERLY * 68400000 * SUBSMODE='1'B; /* SET SUBSMODE BIT TO CONTROL * 68410000 OI 599(@B),B'00100000' 1334 68420000 * GOTO SUBERSCN; /* ERROR SCAN ROUTINE * 68430000 BC 15,SUBERSCN 1335 68440000 * END; /* END ERROR PROCESSING * 68450000 * NUMQUAL=QUALCT; /* IF ALL O.K. ADD THE QUAL- * 68460000 @97F L @1,564(0,@B) 1337 68470000 MVC 17(1,@1),598(@B) 1337 68480000 * QUALCT=0; /* IFIER COUNT TO THE PDE FOR THE 68490000 * DATA NAME BEFORE THE SUBSCRIPT* 68500000 MVI 598(@B),0 1338 68510000 * NAMEREQD='0'B; /* TURN THE NAMEREQUIRED BIT OFF 68520000 * - END OF QUALIFIER * 68530000 NI 599(@B),B'11101111' 1339 68540000 * GOTO SUBSCRPT; /* GOTO ROUTINE FOR SUBSCRIPT 68550000 * PROCESSING * 68560000 BC 15,SUBSCRPT 1340 68570000 * 68580000 * /***************************************************************** 68590000 * /* * 68600000 * /* IF NO DATA FOUND AFTER THE LEFT PAREN, IT IS AN ERROR * 68610000 * /* * 68620000 * /***************************************************************** 68630000 * 68640000 * 68650000 * SETERR: 68660000 * ERRORBIT='1'B; /* SET THE ERROR BIT * 68670000 SETERR OI 599(@B),B'00001000' 1341 68680000 * R4=R4+1; /* RESET XINPUT SO WON'T MISS THE 68690000 * PAREN IN ERROR MESAGE * 68700000 AH @4,@D2 1342 68710000 * GOTO VRNGCK1; /* GO TO END ROUTINE WHICH WILL 68720000 * ENSURE PROPER SETTING OF THE 68730000 * RANGE SWITCHES * 68740000 BC 15,VRNGCK1 1343 68750000 * GEN (EJECT); 68760000 EJECT 68770000 DS 0H 68780000 * 68790000 * /***************************************************************** 68800000 * /* * 68810000 * /* THIS ROUTINE IS ENTERED IF BLANKS FOLLOWED A GOOD DATA NAME * 68820000 * /* AND OF OR IN DID NOT FOLLOW THE BLANKS. AGAIN THE DELIMITER * 68830000 * /* FOLLOWING THE BLANKS MUST BE CHECKED TO SEE IF INDEED IT IS * 68840000 * /* PART OF THE DATA NAME OR BELONGS TO THE NEXT PCE. SPECIAL * 68850000 * /* PROCESSING IS REQUIRED IF WE ARE PROCESSING A TERM CHAINED OFF* 68860000 * /* AN OPER. * 68870000 * /* * 68880000 * /***************************************************************** 68890000 * 68900000 * 68910000 * ASIS1: 68920000 * NAMEREQD='0'B; /* TURN NAMEREQD BIT OFF SINCE 68930000 * FINISHED PROCESSING ANY 68940000 * QUALIFIERS * 68950000 ASIS1 NI 599(@B),B'11101111' 1345 68960000 * 68970000 * /***************************************************************** 68980000 * /* * 68990000 * /* CHECK TO SEE IF DELIMITER IS A LEFT PARENTHESIS * 69000000 * /* * 69010000 * /***************************************************************** 69020000 * 69030000 * IF COMBUF^='(' /* IS THIS A LEFT PAREN? IF * 69040000 * THEN /* NOT, GO TO CHECK FOR A * 69050000 CLI 0(@4),C'(' 1346 69060000 * GOTO RHTPRCK; /* RIGHT PAREN * 69070000 BC 07,RHTPRCK 1347 69080000 * RSVWDSV1=R4; /* IF RIGHT PAREN, SAVE THE 69090000 * POINTER IN CASE HAVE TO RETURN 69100000 * TO IT WHEN PUSH- ING THE STACK* 69110000 ST @4,540(0,@B) 1348 69120000 * 69130000 * /***************************************************************** 69140000 * /* * 69150000 * /* IF THE DELIMITER AFTER BLANKS IS A LEFT PAREN, SPECIAL CHECKS * 69160000 * /* MUST BE MADE TO DETERMINE IF THIS IS A SUBSCRIPT FOLLOWING THE* 69170000 * /* DATA NAME. IF WE ARE PROCESSING A TERM PCE CHAINED OFF OF AN * 69180000 * /* OPER PCE (CHAINTRM BIT ON) A VALIDITY CHECK EXIT MUST BE TAKEN* 69190000 * /* TO DETERMINE IF THE DATA FOLLOWING THE DATA NAME IS A * 69200000 * /* SUBSCRIPT. * 69210000 * /* * 69220000 * /***************************************************************** 69230000 * 69240000 * IF SUBSMODE='1'B /* IF THE SUBSCRIPT BIT IS * 69250000 * THEN /* ALREADY ON WE HAVE ENCOUNT- * 69260000 TM 599(@B),B'00100000' 1349 69270000 BC 12,@97E 1349 69280000 * DO; /* ERED A LEFT PAREN WITHIN 69290000 * A SUBSCRIPT WHICH IS AN 69300000 * ERROR * 69310000 * IF PFENDSET='1'B /* IF STACK JUST POPPED * 69320000 * THEN /* MUST RESET PRMTPTR SO DON'T * 69330000 TM 179(@B),B'00000100' 1351 69340000 BC 12,@97D 1351 69350000 * PRMTPTR=R4; /* PROMPT OVER 2 BUFFERS * 69360000 ST @4,584(0,@B) 1352 69370000 * ERRORBIT='1'B; /* SET THE ERROR BIT * 69380000 @97D OI 599(@B),B'00001000' 1353 69390000 * GOTO SUBERSCN; /* SCAN TILL THE END OF THE * 69400000 BC 15,SUBERSCN 1354 69410000 * END; /* SUBSCRIPT FOR THE PROMPT 69420000 * MESSAGE * 69430000 * 69440000 * SKIPBL3: 69450000 * ADDCDE=5; /* SKIP THE BLANKS BETWEEN THE * 69460000 @97E EQU * 1356 69470000 SKIPBL3 LA @F,5 1356 69480000 * PFNOPOP='1'B; /* PREVENT STACK POPPING * 69490000 OI 179(@B),B'00000010' 1357 69500000 * CALL LINKRET; /* LFT PAREN AND SUBSCRIPT * 69510000 BAL @E,LINKRET 1358 69520000 * GOTO SUBSCPCK; /* IF ENDINPUT AFTER THE ( MUST 69530000 * MAKE CHECKS TO DETERM- INE 69540000 * TYPE OF PROCESSING TO FOLLOW * 69550000 BC 15,SUBSCPCK 1359 69560000 * PFNOPOP='0'B; /* TURN NO STACK POPPING OFF * 69570000 NI 179(@B),B'11111101' 1360 69580000 * R4=R4+1; /* IF DATA FOLLOWS POINT TO THE 69590000 * FIRST CHAR OF THE DATA * 69600000 AH @4,@D2 1361 69610000 * NUMQUAL=QUALCT; /* ADD THE QUALIFIER COUNT FOR 69620000 * THE PREVIOUS DATA NAME TO THE 69630000 * PDE * 69640000 L @1,564(0,@B) 1362 69650000 MVC 17(1,@1),598(@B) 1362 69660000 * QUALCT=0; /* CLEAR THE QUALIFIER COUNT * 69670000 MVI 598(@B),0 1363 69680000 * 69690000 * /***************************************************************** 69700000 * /* * 69710000 * /* CHECK TO MAKE USRE THE TERM PCE IS SUBSCRIPTABLE. IF IT ISN'T * 69720000 * /* THE BUFFER POINTER MUST BE RESET TO THE END OF THE PREVIOUS * 69730000 * /* DATA NAME SCANNED. THE LEFT PAREN AND DATA ENCOUNTERED IS * 69740000 * /* ASSOCIATED WITH THE NEXT PCE * 69750000 * /* * 69760000 * /***************************************************************** 69770000 * 69780000 * IF SUBSCRP='1'B /* IF THE SUBSCRIPTABLE BIT IS * 69790000 * THEN /* ON THEN GO TO CHECK IF WE * 69800000 TM 1(@6),B'00010000' 1364 69810000 * GOTO CHNCK1; /* ARE PROCESSING A CHAINED TERM 69820000 * OFF AN OPER * 69830000 BC 01,CHNCK1 1365 69840000 * 69850000 * RESTXIN1: 69860000 * IF PFENDSET='1'B /* IF A PROMPT BUFFER HAS * 69870000 * THEN /* BEEN POPPED OFF THE STACK * 69880000 RESTXIN1 TM 179(@B),B'00000100' 1366 69890000 BC 12,@97C 1366 69900000 * DO; /* MUST RESET BUFFER POINTERS * 69910000 * R4=R4-1; /* RESET XINPUT * 69920000 BCTR @4,0 1368 69930000 * ADDCDE=17; /* PUSH BUFFER POPPED BACK ON * 69940000 LA @F,17 1369 69950000 * CALL LINKRET; /* STACK * 69960000 BAL @E,LINKRET 1370 69970000 * ENDINPUT=ENDBAKUP; /* RESET END OF BUFFER POINTER * 69980000 MVC 144(4,@B),412(@B) 1371 69990000 * END; /* TO THAT BUFFER POPPED OFF * 70000000 * R4=ENDNMPTR+1; /* RESET XINPUT INTO PREVIOUS 70010000 * BUFFER * 70020000 @97C LA @4,1 1373 70030000 A @4,556(0,@B) 1373 70040000 * GOTO RANGESET; /* GO TO PROCESS THE END OF A 70050000 * DATA NAME AND FILL IS REST OF 70060000 * PDE * 70070000 BC 15,RANGESET 1374 70080000 * 70090000 * /***************************************************************** 70100000 * /* * 70110000 * /* IF THE CHAINED TERM BIT IS ON, MUST ASSUME END OF THE DATA * 70120000 * /* NAME AND GO TO A VALIDITY CHECK EXIT TO DETERMINE IF THIS IS A* 70130000 * /* SUBSCRIPT. * 70140000 * /* * 70150000 * /***************************************************************** 70160000 * 70170000 * 70180000 * CHNCK1: 70190000 * IF CHAINTRM^='1'B /* IF NOT A CHAINED TERM, GO * 70200000 * THEN /* TO SUBSCRIPT PROCESSING * 70210000 CHNCK1 TM 600(@B),B'00010000' 1375 70220000 * GOTO SUBSCRPT; /* ROUTINE * 70230000 BC 12,SUBSCRPT 1376 70240000 * CTFOUND='1'B; /* INDICATE SUBSCRPT FOUND AFTER 70250000 * VARIABLE SO CAN DETERMINE 70260000 * VALIDITY OF +4 RETURN FROM 70270000 * V.C. EXIT * 70280000 OI 601(@B),B'01000000' 1377 70290000 * 70300000 * RESTXIN: 70310000 * R4=RSVWDSV1; /* RESET XINPUT SO ( GETS SAVED * 70320000 RESTXIN L @4,540(0,@B) 1378 70330000 * GOTO RESTXIN1; /* GO TO RESTORE XINPUT AND 70340000 * COMPLETE PDE * 70350000 BC 15,RESTXIN1 1379 70360000 * 70370000 * /***************************************************************** 70380000 * /* * 70390000 * /* IF NO DATA FOLLOWED THE LEFT PAREN, CHECK TO SEE IF THE LEFT * 70400000 * /* PAREN SHOULD BE INCLUDED UNDER THIS PCE * 70410000 * /* * 70420000 * /***************************************************************** 70430000 * 70440000 * 70450000 * SUBSCPCK: /* CHECK SUBSCRIPTABLE BIT * 70460000 * PFNOPOP='0'B; /* TURN NO STACK POPPING OFF * 70470000 SUBSCPCK NI 179(@B),B'11111101' 1380 70480000 * IF SUBSCRP^='1'B /* IF PCE IS NOT SUBSCRIPTABLE * 70490000 * THEN /* RESTORE XINPUT AND DISRE- * 70500000 TM 1(@6),B'00010000' 1381 70510000 * GOTO RESTXIN; /* LEFT PAREN * 70520000 BC 12,RESTXIN 1382 70530000 * ERRORBIT='1'B; /* IF IS SUBSCRIPTABLE, THE * 70540000 OI 599(@B),B'00001000' 1383 70550000 * PFNOPOP='1'B; /* LEFT PAREN WITH NO DATA * 70560000 OI 179(@B),B'00000010' 1384 70570000 * R4=R4+1; /* DON'T MISS PAREN IN MSG * 70580000 AH @4,@D2 1385 70590000 * GOTO CODE4; /* FOLLOWING IS AN ERROR * 70600000 BC 15,CODE4 1386 70610000 * GEN (EJECT); 70620000 EJECT 70630000 DS 0H 70640000 * 70650000 * /***************************************************************** 70660000 * /* * 70670000 * /* THE FOLLOWING ROUTINE PREPARES FOR THE PROCESSING OF A * 70680000 * /* SUBSCRIPT. SEVERAL ERROR CHECKS ARE MADE TO AVOID UNNECESSARY * 70690000 * /* PROCESSING * 70700000 * /* * 70710000 * /***************************************************************** 70720000 * 70730000 * 70740000 * SUBSCRPT: /* SUBSCRIPT PROCESSING * 70750000 * IF SUBSMODE='1'B /* IF ALREADY PROCESSING A * 70760000 * THEN /* SUBSCRIPT, THE LEFT PAREN * 70770000 SUBSCRPT TM 599(@B),B'00100000' 1388 70780000 BC 12,@97B 1388 70790000 * DO; /* FOUND IS INVALID * 70800000 * ERRORBIT='1'B; /* INDICATE ERROR DETECTED * 70810000 OI 599(@B),B'00001000' 1390 70820000 * GOTO SUBERSCN; /* GOTO SCAN TO THE END OF * 70830000 BC 15,SUBERSCN 1391 70840000 * END; /* THE SUBSCRIPT * 70850000 * 70860000 * /***************************************************************** 70870000 * /* * 70880000 * /* IF THE ERRORBIT IS ALREADY ON, IT IS POSSIBLE TO GO TO THE * 70890000 * /* ROUTINE TO SCAN TO THE END OF THE SUBSCRIPT WITHOUT GOING * 70900000 * /* THROUGH INTERVENING PROCESSING * 70910000 * /* * 70920000 * /***************************************************************** 70930000 * 70940000 * IF ERRORBIT='1'B /* IF ALREADY IN ERROR MODE * 70950000 * THEN /* GOTO SCAN TO THE END OF * 70960000 @97B TM 599(@B),B'00001000' 1393 70970000 * GOTO SUBERSCN; /* THE SUBSCRIPT * 70980000 BC 01,SUBERSCN 1394 70990000 * 71000000 * /***************************************************************** 71010000 * /* * 71020000 * /* IF NO ERROR, PREPARE TO PROCESS SUBSCRIPT * 71030000 * /* * 71040000 * /***************************************************************** 71050000 * 71060000 * SUBSMODE='1'B; /* INDICATE PROCESSING A 71070000 * SUBSCRIPT * 71080000 OI 599(@B),B'00100000' 1395 71090000 * R6=R6+PCELNGTH; /* UPDATE PCE PTR TO THE NEXT PCE* 71100000 MVC @TEMP2+2(2),2(@6) 1396 71110000 A @6,@TEMP2 1396 71120000 * 71130000 * /***************************************************************** 71140000 * /* * 71150000 * /* IF THE FOLLOWING PCE IS NOT A TERM PCE, WE HAVE INVALID * 71160000 * /* PARAMETERS SINCE A TERM PCE IS REQUIRED TO PROCESS THE * 71170000 * /* SUBSCRIPT. WE ALSO HAVE AN UNRECOVERABLE ERROR IF THE * 71180000 * /* FOLLOWING PCE IS A TERM BUT IS EITHER NOT A SUBSCRIPT TERM OR * 71190000 * /* IS A STATEMENT TERM. EXIT IS MADE TO THE RTNCLNUP IN THE OPER * 71200000 * /* PROCESSOR IF THIS TYPE OF ERROR IS DETECTED. A RETURN CODE OF * 71210000 * /* 24 IS RETURNED TO THE CP * 71220000 * /* * 71230000 * /***************************************************************** 71240000 * 71250000 * IF TERPCE^='110'B /* IF THE PCE IS NOT A TERM * 71260000 * THEN /* PCE WE HAVE INVALID * 71270000 TM 0(@6),B'11000000' 1397 71280000 BC 12,@97A 1396 71290000 TM 0(@6),B'00100000' 1397 71300000 BC 08,@979 1397 71310000 * GOTO COD24; /* PARAMETERS * 71320000 BC 15,COD24 1398 71330000 * 71340000 * /***************************************************************** 71350000 * /* * 71360000 * /* IS THE FOLLOWING TERM A SUBSCRIPT TERM PCE? * 71370000 * /* * 71380000 * /***************************************************************** 71390000 * 71400000 * IF SUBSCPPT^='1'B /* IF THIS IS NOT A SUBSCRIPT * 71410000 @979 TM 6(@6),B'00001000' 1399 71420000 * GOTO COD24; /* INVALID PARAMETERS * 71430000 BC 12,COD24 1400 71440000 * 71450000 * /***************************************************************** 71460000 * /* * 71470000 * /* IS THE FOLLOWING TERM PCE INDICATE STATEMENT? * 71480000 * /* * 71490000 * /***************************************************************** 71500000 * 71510000 * IF STMT^='1'B /* IF THE IS NOT A STATEMENT * 71520000 * THEN /* GOTO PROCESS DATA AS A * 71530000 TM 6(@6),B'10000000' 1401 71540000 * GOTO ELCHECK; /* SUBSCRIPT * 71550000 BC 12,ELCHECK 1402 71560000 * 71570000 * COD24: 71580000 * CALL RTNCLNUP; /* IF FALL THROUGH, WE HAVE 71590000 * INVALID PARAMETERS. EXIT 71600000 * THROUGH OPER ROUTINE * 71610000 COD24 BAL @E,RTNCLNUP 1403 71620000 * GEN (EJECT); 71630000 EJECT 71640000 DS 0H 71650000 * 71660000 * /***************************************************************** 71670000 * /* * 71680000 * /* IF COME INTO THIS ROUTINE, THE DATA NAME WAS FOLLOWED BY * 71690000 * /* BLANKS. THE DELIMITER AFTER THE BLANKS WAS NOT IN OR OF OR A * 71700000 * /* LEFT PARENTHESIS. A CHECK IS MADE HERE FOR A RIGHT PAREN WITH * 71710000 * /* APPROPRIATE PROCESSING IF THE RIGHT PAREN IS ENCOUNTERED AFTER* 71720000 * /* THE DATA NAME * 71730000 * /* * 71740000 * /***************************************************************** 71750000 * 71760000 * 71770000 * RHTPRCK: /* RIGHT PAREN CHECK * 71780000 * IF COMBUF^=')' /* IF THIS IS NOT A RIGHT * 71790000 * THEN /* PAREN, CONTINUE THE CHECK * 71800000 RHTPRCK CLI 0(@4),C')' 1405 71810000 * GOTO STQULCT; /* OF THE DELIMITER * 71820000 BC 07,STQULCT 1406 71830000 * 71840000 * /***************************************************************** 71850000 * /* * 71860000 * /* IF THE DELIMITER IS A RIGHT PAREN, CHECKS MUST BE MADE TO * 71870000 * /* DETERMINE IF THE RIGHT PAREN IS A VALID DELIMITER AND TO * 71880000 * /* DETERMINE THE PROPER PROCESSING DEPENDING ON THE ENVIRONMENT * 71890000 * /* OF THE SCAN * 71900000 * /* * 71910000 * /***************************************************************** 71920000 * 71930000 * IF SUBSMODE='1'B /* IF SUBSCRIPT MODE THE RIGHT * 71940000 * THEN /* INDICATES THE END OF THE * 71950000 TM 599(@B),B'00100000' 1407 71960000 * GOTO VSUBENDK; /* END OF THE SUBSCRIPT * 71970000 BC 01,VSUBENDK 1408 71980000 * 71990000 * /***************************************************************** 72000000 * /* * 72010000 * /* IF NOT SUBSCRIPT MODE, MAKE OTHER CHECKS TO DETERMINE WHAT THE* 72020000 * /* RIGHT PARENTHESIS MEANS. * 72030000 * /* * 72040000 * /***************************************************************** 72050000 * 72060000 * IF OPERMODE='1'B /* IF IN OPERMODE, THE RIGHT * 72070000 * THEN /* PAREN INDICATES THE END * 72080000 TM 599(@B),B'01000000' 1409 72090000 * GOTO EXIT; /* OF THE EXPRESSION * 72100000 BC 01,EXIT 1410 72110000 * 72120000 * /***************************************************************** 72130000 * /* * 72140000 * /* DOES THE RIGHT PAREN INDICATE THE END OF A LIST IF A RIGHT * 72150000 * /* PAREN IS ENCOUNTERED AND NEITHER THE SUBSCRIPT MODE, OPER * 72160000 * /* MODE, OR PFLIST BITS ARE ON, THE RIGHT PAREN IS INVALID. * 72170000 * /* * 72180000 * /***************************************************************** 72190000 * 72200000 * IF PFLIST='1'B /* IF PROCESSING A LIST, GO * 72210000 * THEN /* TO END OF DATA NAME PROCES- * 72220000 TM 176(@B),B'10000000' 1411 72230000 * GOTO VRNGCK1; /* SING AND FILL IN PDE * 72240000 BC 01,VRNGCK1 1412 72250000 * GOTO RESETXIN; /* IF FALL THROUGH ALL CHECKS THE 72260000 * RIGHT PAREN IS AN ERROR * 72270000 BC 15,RESETXIN 1413 72280000 * GEN (EJECT); 72290000 EJECT 72300000 DS 0H 72310000 * 72320000 * /***************************************************************** 72330000 * /* * 72340000 * /* A RIGHT PAREN WAS NOT ENCOUNTERED. THE DATA NAME WAS FOLLOWED * 72350000 * /* BY BLANKS. THE DATA FOLLOWING THE BLANKS WAS NOT IN OR OF, A * 72360000 * /* LEFT PAREN OR A RIGHT PAREN. THIS IDICATES THAT WE HAVE * 72370000 * /* REACHED THE END OF A DATA NAME. IF IN SUBSCRIPT MODE, THE DATA* 72380000 * /* FOLLOWING IS ASSUMED TO BE A SUBSCRIPT. * 72390000 * /* * 72400000 * /***************************************************************** 72410000 * 72420000 * 72430000 * STQULCT: 72440000 * IF SUBSMODE='1'B /* IF IN SUBSCRIPT MODE, * 72450000 * THEN /* SET UP TO PROCESS THE * 72460000 STQULCT TM 599(@B),B'00100000' 1415 72470000 BC 12,@978 1415 72480000 * DO; /* FOLLOWING DATA AS A * 72490000 * NUMQUAL=QUALCT; /* SUBSCRIPT. ADD THE * 72500000 L @1,564(0,@B) 1417 72510000 MVC 17(1,@1),598(@B) 1417 72520000 * QUALCT=0; /* QUALIFIER COUNT FOR THE 72530000 * PREVIOUS DATA NAME * 72540000 MVI 598(@B),0 1418 72550000 * GOTO ELCHECK; /* GO TO DETERMINE TYPE OF 72560000 * SUBSCRIPT PROCESSING - * 72570000 BC 15,ELCHECK 1419 72580000 * END; /* CONSTANT OR VARIABLE * 72590000 * 72600000 * RESETXIN: /* END OF DATA NAME * 72610000 * IF PFENDSET='1'B /* IF PROMPT BUFFER POPPED * 72620000 * THEN /* OFF MUST RESET BUFFER PNTRS * 72630000 @978 EQU * 1421 72640000 RESETXIN TM 179(@B),B'00000100' 1421 72650000 BC 12,@977 1421 72660000 * DO; /* TO THE PROMPT BUFFER * 72670000 * R4=R4-1; /* SET XINPUT TO PUSH THIS BUFFER 72680000 * BACK ON STACK * 72690000 BCTR @4,0 1423 72700000 * ADDCDE=17; /* PUSH POPPED BUFFER BACK * 72710000 LA @F,17 1424 72720000 * CALL LINKRET; /* ON STACK * 72730000 BAL @E,LINKRET 1425 72740000 * ENDINPUT=ENDBAKUP; /* RESET END OF BUFFER PTR * 72750000 MVC 144(4,@B),412(@B) 1426 72760000 * END; /* END BUFFER PUSH * 72770000 * R4=ENDNMPTR+1; /* RESET XINPUT INTO PREV IOUS 72780000 * BUFFER * 72790000 @977 LA @4,1 1428 72800000 A @4,556(0,@B) 1428 72810000 * GOTO VRNGCK1; /* GO TO RANGE TO DETERMINE 72820000 * WHETHER RANGE PROCESSING IS 72830000 * REQUIRED * 72840000 BC 15,VRNGCK1 1429 72850000 * 72860000 * /***************************************************************** 72870000 * /* * 72880000 * /* IT HAS BEEN DETERMINED THAT WE ARE PROCESSING A SUBSCRIPT * 72890000 * /* CHECKS ARE MADE TO DETERMINE WHETHER THE SUBSCRIPT IS A * 72900000 * /* CONSTANT , VARIABLE, OR ANY IS SPECIFIED IN THE PCE IF IN * 72910000 * /* ERRORMODE, THE ERROR SCAN FOR SUBSCRIPTS IS ENTERED. THIS * 72920000 * /* ROUTINE SCANS TO FIND THE CLOSING RIGHT PAREN OR THE END OF * 72930000 * /* THE BUFFER FOR THE ERROR MESSAGE * 72940000 * /* * 72950000 * /***************************************************************** 72960000 * 72970000 * 72980000 * ELCHECK: 72990000 * IF ELEMNCT=3 /* IF THE ELEMENT COUNT IS * 73000000 * THEN /* ALREADY THREE, THE NEXT * 73010000 ELCHECK CLI 597(@B),3 1430 73020000 BC 07,@976 1430 73030000 * DO; /* SUBSCRIPT IS IN ERROR ONLY 3 73040000 * SUBSCRIPTS ALLOWED * 73050000 * PRMTPTR=R4; /* RESET PRMTPTR SO RIGHT 73060000 * SUBSCRIPT ELEMENT IS IN ERROR 73070000 * MESSAGE * 73080000 ST @4,584(0,@B) 1432 73090000 * ERRORBIT='1'B; /* INDICATE ERROR ENCOUNTERED * 73100000 OI 599(@B),B'00001000' 1433 73110000 * GOTO SUBERSCN; /* SCAN TO THE END OF THE * 73120000 BC 15,SUBERSCN 1434 73130000 * END; /* SUBSCRIPT * 73140000 * 73150000 * /***************************************************************** 73160000 * /* * 73170000 * /* CHECK TO DETERMINE TYPE OF SUBSCRIPT * 73180000 * /* * 73190000 * /***************************************************************** 73200000 * 73210000 * IF VAR='1'B /* DOES SUBSCRIPT PCE SPECIFY * 73220000 * THEN /* VARIABLE, IF SO * 73230000 @976 TM 6(@6),B'01000000' 1436 73240000 BC 12,@975 1436 73250000 * DO; /* INCREMENT THE ELEMENT * 73260000 * ELEMNCT=ELEMNCT+1; /* COUNT (SUBSCRIPT COUNT) * 73270000 LA @F,1 1438 73280000 SR @0,@0 1438 73290000 IC @0,597(0,@B) 1438 73300000 AR @F,@0 1438 73310000 STC @F,597(0,@B) 1438 73320000 * PDEPTR=PDEPTR+20; /* POINT TO THE NEXT PDE 73330000 * CORRESPONDING TO THIS 73340000 * SUBSCRIPT PCE * 73350000 LA @F,20 1439 73360000 A @F,564(0,@B) 1439 73370000 ST @F,564(0,@B) 1439 73380000 * GOTO IKJEFP6V; /* SCAN THE SUBSCRIPT AS A * 73390000 BC 15,IKJEFP6V 1440 73400000 * END; /* VARIABLE * 73410000 * GOTO IKJEFP6C; /* OTHERWISE GO TO THE CONSTANT 73420000 * ROUTINE TO CHECK TO SEE IF 73430000 * SUBSCRIPT IS A CONSTANT * 73440000 * 73450000 * /***************************************************************** 73460000 * /* * 73470000 * /* THE FOLLOWING ROUTINE IS ENTERED IF AN ERROR HAS BEEN DETECTED* 73480000 * /* WHILE IN SUBSCRIPT MODE. A SCAN IS DONE TO FIND THE ENDING * 73490000 * /* PAREN OR EOB * 73500000 * /* * 73510000 * /***************************************************************** 73520000 * 73530000 * 73540000 * SUBERSCN: 73550000 * IF COMBUF=')' /* SCAN THE INPUT LINE * 73560000 * THEN /* UNTIL FIND THE ENDING RGHT * 73570000 SUBERSCN CLI 0(@4),C')' 1443 73580000 * GOTO VSUBENDK; /* PAREN OR EOB * 73590000 BC 08,VSUBENDK 1444 73600000 * PFNOPOP='1'B; /* PREVENT STACK POPPING A00996 * 73610000 OI 179(@B),B'00000010' 1445 73620000 * CALL BUMP; /* IF NOT RIGHT PAREN CALL 73630000 * ROUTINE TO UP XINPUT * 73640000 BAL @E,BUMP 1446 73650000 * GEN; /* GENERATE PROPER BRANCHES * 73660000 BC 15,VRNGCK1 EOB DETECTED 73670000 BC 15,SUBERSCN MORE DATA - CHECK FOR RT PAREN 73680000 BC 15,VRNGCK1 STACK SHOULD NEVER BE POPPED 73690000 * SINCE IN ERROR MODE AND PFNOPOP IS ON 73700000 DS 0H 73710000 * 73720000 * /***************************************************************** 73730000 * /* * 73740000 * /* THIS ROUTINE IS ENTERED WHEN THE ENDING PAREN FOR SUBSCRIPTS * 73750000 * /* IS ENCOUNTERED. THIS ROUTINE CAN BE ENTERED FROM THE CONSTANT * 73760000 * /* PROCESSOR IF PROCESSING CONSTANT SUBSCRIPTS. THIS ROUTINE IS * 73770000 * /* ALSO ENTERED EVEN IF IN ERRORMODE WHEN THE END OF THE * 73780000 * /* SUBSCRIPT IS DETECTED. * 73790000 * /* * 73800000 * /***************************************************************** 73810000 * 73820000 * 73830000 * VSUBENDK: /* END OF SUBSCRIPT ROUTINE * 73840000 * R4=R4+1; /* BUMP XINPUT PASSED THE ENDING 73850000 * RIGHT PAREN * 73860000 VSUBENDK AH @4,@D2 1448 73870000 * VSBEND1: /* NEW ENTRY LABEL A00996 * 73880000 * NUMSUB1=ELEMNCT; /* SET THE SUBSCRIPT COUNT INTO 73890000 * THE PDE BASED ON TEMPPDE * 73900000 VSBEND1 MVC 350(1,@B),597(@B) 1449 73910000 * ELEMNCT=0; /* CLEAR THE ELEMENT COUNT * 73920000 MVI 597(@B),0 1450 73930000 * TEMPSAVE=R6; /* SAVE POINTER TO M4161 73940000 * SUBSCRIPT PCE M4161 * 73950000 ST @6,172(0,@B) 1451 73960000 * R6=TERMXPCE; /* RESET XPCE TO MAJOR M4161 73970000 * PCE FOR RANGE PROCESS M4161 * 73980000 L @6,528(0,@B) 1452 73990000 * CALL TSTRNGE; /* RANGE PROCESSING A00996 * 74000000 L @F,@V5 ADDRESS OF TSTRNGE 1453 74010000 BALR @E,@F 1453 74020000 * GOTO ZERORET; /* ON PLUS ZERO RETURN M4161 74030000 * CHECK ERROR CONDITIONS M4161 * 74040000 BC 15,ZERORET 1454 74050000 * R6=TEMPSAVE; /* +4 - RESET PCE POINTER M4161 74060000 * TO SUBSCRIPT PCE FOR M4161 74070000 * FURTHER PROCESSING. M4161 * 74080000 L @6,172(0,@B) 1455 74090000 * GOTO VALRANGE; /* GOTO PROCESS VALID FIRSTM4161 74100000 * VALUE OF A RANGE M4161 * 74110000 BC 15,VALRANGE 1456 74120000 * ZERORET: /* +0 RETURN FROM RANGE M4161 * 74130000 * R6=TEMPSAVE; /* RESET PCE POINTER TO M4161 74140000 * SUBSCRIPT PCE FOR M4161 74150000 * FURTHER PROCESSING M4161 * 74160000 ZERORET L @6,172(0,@B) 1457 74170000 * GOTO CKRNG; /* GOTO NO RANGE PROCESS M4161 * 74180000 BC 15,CKRNG 1458 74190000 * 74200000 * /***************************************************************** 74210000 * /* * 74220000 * /* THE LOGICAL END OF A VARIABLE SCAN HAS BEEN REACHED THE RANGE * 74230000 * /* ROUTINE IN PARSE IS ENTERED TO GET THE RANGE SWITCHES SET * 74240000 * /* PROPERLY FOR FURTHER PROCESSING * 74250000 * /* * 74260000 * /***************************************************************** 74270000 * 74280000 * 74290000 * VRNGCK1: 74300000 * CALL TSTRNGE; /* RANGE PROCESSING A00996 * 74310000 VRNGCK1 L @F,@V5 ADDRESS OF TSTRNGE 1459 74320000 BALR @E,@F 1459 74330000 * GOTO CKRNG; /* IF PLUS 0 RETURN BRANCH TO 74340000 * VALID RETURN * 74350000 BC 15,CKRNG 1460 74360000 * 74370000 * VALRANGE: /* VALID FIRST VALUE OF RANGE 74380000 * ENCOUNTERED * 74390000 * 74400000 * /***************************************************************** 74410000 * /* * 74420000 * /* TEST TO SEE IF PROCESSING IN ERRORMODE. IF IN ERROR MODE * 74430000 * /* BRANCH SO DON'T COMPLETE THE PDE * 74440000 * /* * 74450000 * /***************************************************************** 74460000 * 74470000 * IF ERRORBIT='1'B /* IF IN ERROR MODE * 74480000 * THEN /* BRANCH SO DON'T FILL IN * 74490000 VALRANGE TM 599(@B),B'00001000' 1461 74500000 * GOTO INVPSAV; /* PDE BUT SCAN SECOND RANGE 74510000 * VALUE * 74520000 BC 01,INVPSAV 1462 74530000 * ELSE /* IF GOOD TO THIS POINT, GO * 74540000 * GOTO EXITA; /* FILL IN PDE AND COMPLETE END 74550000 * OF DATA NAME PROCESSING * 74560000 BC 15,EXITA 1463 74570000 * 74580000 * /***************************************************************** 74590000 * /* * 74600000 * /* IF RANGEVAL1 IS ON WITH A +0 RETURN THERE IS A RANGE ERROR * 74610000 * /* * 74620000 * /***************************************************************** 74630000 * 74640000 * 74650000 * CKRNG: 74660000 * IF RNGEVAL1^='1'B /* IF RNGEVAL1 IS NOT ON * 74670000 * THEN /* THEN CONTINUE WITH NORMAL * 74680000 CKRNG TM 177(@B),B'01000000' 1464 74690000 * GOTO EXIT; /* END OF DATA NAME PROCESS * 74700000 BC 12,EXIT 1465 74710000 * 74720000 * RANGERR: 74730000 * R4=R4+1; /* IF RNGEVAL1 ON ERROR * 74740000 RANGERR AH @4,@D2 1466 74750000 * GEN (EJECT); 74760000 EJECT 74770000 DS 0H 74780000 * 74790000 * /***************************************************************** 74800000 * /* * 74810000 * /* THE VERRBIT ROUTINE IS ENTERED WHEN AN ERROR HAS BEEN DETECTED* 74820000 * /* IN THE SCAN OF A DATA NAME. EACH SUCCEEDING CHARACTER MUST BE * 74830000 * /* SCANNED TO DETERMINE THE END OF THE DATA NAME FOR THE ERROR * 74840000 * /* PROMPT MESSAGE. IF NO VALID DELIMITER IS DISCOVERED THE SCAN * 74850000 * /* CONTINUES UNTIL THE END OF THE BUFFER IS DETECTED. * 74860000 * /* * 74870000 * /***************************************************************** 74880000 * 74890000 * 74900000 * VERRBIT: 74910000 * ERRORBIT='1'B; /* INDICATE AN ERROR HAS BEEN 74920000 * DETECTED * 74930000 VERRBIT OI 599(@B),B'00001000' 1468 74940000 * PFNOPOP='1'B; /* PREVENT STACK POPPING * 74950000 OI 179(@B),B'00000010' 1469 74960000 * PFENDSET='0'B; /* INDICATE DN AFTER STACK POPPED* 74970000 NI 179(@B),B'11111011' 1470 74980000 * 74990000 * /***************************************************************** 75000000 * /* * 75010000 * /* IF PROCESSING A SUBSCRIPT, GO IMMEDIATELY TO SCAN ROUTINE TO * 75020000 * /* FIND THE END OF THE SUBSCRIPT. * 75030000 * /* * 75040000 * /***************************************************************** 75050000 * 75060000 * IF SUBSMODE='1'B /* IF IN SUBSCRIPT MODE, * 75070000 * THEN /* GO TO SCNA FOR ENDING * 75080000 TM 599(@B),B'00100000' 1471 75090000 * GOTO SUBERSCN; /* GOTO SUBSCRPT ERROR * 75100000 BC 01,SUBERSCN 1472 75110000 * 75120000 * SPTST: 75130000 * /***************************************************************** 75140000 * /* SEE IF AT END OF BUFFER - IF SO, IS THE END OF THE * 75150000 * /* ERROR DATA NAME * 75160000 * /***************************************************************** 75170000 * 75180000 * IF R4=>ENDINPUT /* ERROR DATA FOLLOWED * 75190000 * THEN /* BY EOB, IF SO GO TO ERROR * 75200000 SPTST C @4,144(0,@B) 1473 75210000 * GOTO CODE4; /* ESIT TO PROMPT * 75220000 BC 10,CODE4 1474 75230000 * ADDCDE=8; /* DETERMINE IF SEPARATOR * 75240000 LA @F,8 1475 75250000 * R1='08'X; /* FOLLOWS BAD DATA NAME * 75260000 LA @1,X'08' 1476 75270000 * CALL LINKRET; /* GO TO PARSE * 75280000 BAL @E,LINKRET 1477 75290000 * GOTO TEND; /* IF NOT, CHECK FOR OTHER VALID 75300000 * DELIMITERS * 75310000 BC 15,TEND 1478 75320000 * R4=R4-1; /* IF IS, SET XINPUT BACK TO * 75330000 BCTR @4,0 1479 75340000 * GOTO ENDSCAN; /* THE END OF THE PREVIOUS DATA 75350000 * NAME AND CONTINUE SCAN TO 75360000 * DETERMINE LOGICAL END OF THE 75370000 * ERROR DATA * 75380000 BC 15,ENDSCAN 1480 75390000 * 75400000 * /***************************************************************** 75410000 * /* * 75420000 * /* IF NOT A SEPARATOR, MAKE CHECKS FOR THE OTHER VALID DATA NAME * 75430000 * /* DELIMITERS: ) EOB ; ( : THE ERROR PROCESSING WILL DEPEND ON * 75440000 * /* THE TYPE OF DELIMITER WHICH FOLLOWS THE DATA NAME IN ERROR. IF* 75450000 * /* NO VALID DELIMITER IS FOUND, ASSUME THE CHARACTER IS INVALID * 75460000 * /* AND CONTINUE SCAN WITH NEXT CHAR IN THE BUFFER. * 75470000 * /* * 75480000 * /***************************************************************** 75490000 * 75500000 * 75510000 * TEND: 75520000 * IF COMBUF^=')' /* IF CHAR NOT A RIGHT * 75530000 * THEN /* CONTINUE SCAN FOR * 75540000 TEND CLI 0(@4),C')' 1481 75550000 * GOTO EOBCK; /* VALID DELIMITER * 75560000 BC 07,EOBCK 1482 75570000 * 75580000 * /***************************************************************** 75590000 * /* * 75600000 * /* IF IS A RIGHT PAREN DETERMINE WHAT THIS RIGHT PAREN MEANS IN * 75610000 * /* TERMS OF THE ERROR SCAN * 75620000 * /* * 75630000 * /***************************************************************** 75640000 * 75650000 * IF PFLIST='1'B /* IF LIST PROCESSING, HAVE * 75660000 * THEN /* REACHED A LOGICAL END OF * 75670000 TM 176(@B),B'10000000' 1483 75680000 * GOTO XINUP6; /* ERROR SCAN * 75690000 BC 01,XINUP6 1484 75700000 * 75710000 * /***************************************************************** 75720000 * /* * 75730000 * /* DOES RIGHT PAREN SIGNIFY END OF AN EXPRESSION * 75740000 * /* * 75750000 * /***************************************************************** 75760000 * 75770000 * IF OPERMODE='1'B /* IF IN OPERMODE, HAVE * 75780000 * THEN /* REACHED A LOGICAL END OF * 75790000 TM 599(@B),B'01000000' 1485 75800000 * GOTO XINUP6; /* ERROR DATA * 75810000 * GOTO XINUP; /* IF NEITHER OF ABOVE ENVIR- 75820000 * ONMENTS (SUBSMODE CHECK MADE 75830000 * EARLIER) THE RIGHT PAREN IS 75840000 * JUST ANOTHER INVALID CHAR * 75850000 BC 14,XINUP 1487 75860000 * 75870000 * XINUP6: 75880000 * R4=R4+1; /* BUMP PASSED THE RIGHT PAREN * 75890000 XINUP6 AH @4,@D2 1488 75900000 * ADDCDE=8; /* CHECK TO SEE IF SEPARATOR 75910000 * FOLLOWS RIGHT PAREN * 75920000 LA @F,8 1489 75930000 * R1='08'X; /* SET UP SEP MASK * 75940000 LA @1,X'08' 1490 75950000 * CALL LINKRET; /* GO TO TYPETEST IN PARSE * 75960000 BAL @E,LINKRET 1491 75970000 * GOTO EOBCK1; /* IF NOT SEPAR, CHECK TO SEE IF 75980000 * VALID DELIMITER AFTER THE 75990000 * RIGHT PAREN * 76000000 BC 15,EOBCK1 1492 76010000 * 76020000 * BACKIN: 76030000 * CALL TSTRNGE; /* GOTO RANGE PROCESSING A00996 76040000 * ONLY POSSIBLE RETURN A00996 76050000 * IS +0 A00996 * 76060000 BACKIN L @F,@V5 ADDRESS OF TSTRNGE 1493 76070000 BALR @E,@F 1493 76080000 * R4=R4-1; /* IF VALID DELIMITER AFTER THE 76090000 * RIGHT PAREN, POINT XINPUT AT 76100000 * IT AND GO TO THE EXIT ROUTINE 76110000 * TO PROMPT * 76120000 BCTR @4,0 1494 76130000 * GOTO CODE4; /* EXIT AND PROMPT * 76140000 BC 15,CODE4 1495 76150000 * 76160000 * /***************************************************************** 76170000 * /* * 76180000 * /* IF CHARACTER AFTER THE RIGHT PAREN IS EOB OR ; THIS IS ALSO * 76190000 * /* VALID. OTHERWISE THE RIGHT PAREN MUST BE CONSIDERED ANOTHER * 76200000 * /* INVALID CHARACTER. * 76210000 * /* * 76220000 * /***************************************************************** 76230000 * 76240000 * 76250000 * EOBCK1: 76260000 * IF R4=>ENDINPUT /* IS IT EOB? A00996 * 76270000 * THEN /* IF SO, VALID GO TO EXIT * 76280000 EOBCK1 C @4,144(0,@B) 1496 76290000 * GOTO BACKIN; /* ERROR PROCESSING * 76300000 BC 10,BACKIN 1497 76310000 * 76320000 * /***************************************************************** 76330000 * /* * 76340000 * /* IS IN A SEMICOLON * 76350000 * /* * 76360000 * /***************************************************************** 76370000 * 76380000 * IF COMBUF=';' /* SEMICOLON? * 76390000 * THEN /* IF SO, VALID AND GOT TO * 76400000 CLI 0(@4),C';' 1498 76410000 * GOTO BACKIN; /* ERROR EXIT PROCESSING * 76420000 BC 08,BACKIN 1499 76430000 * GOTO XINUP; /* IF NOT A VALID DELIMITER AFTER 76440000 * THE ), CONTINUE SCAN FOR END 76450000 * OF ERROR DATA * 76460000 BC 15,XINUP 1500 76470000 * 76480000 * /***************************************************************** 76490000 * /* * 76500000 * /* IS ERROR DATA DELIMITED BY A ; * 76510000 * /* * 76520000 * /***************************************************************** 76530000 * 76540000 * EOBCK: /* CHECK FOR SEMI COLON A00996 * 76550000 * IF COMBUF=';' /* IF SEMICOLON, SCAN OF ERROR * 76560000 * THEN /* DATA COMPLETE. GO TO ERROR * 76570000 EOBCK CLI 0(@4),C';' 1501 76580000 * GOTO CODE4; /* EXIT TO PROMPT * 76590000 BC 08,CODE4 1502 76600000 * 76610000 * /***************************************************************** 76620000 * /* * 76630000 * /* DOES A LEFT PAREN FOLLOW DATA * 76640000 * /* * 76650000 * /***************************************************************** 76660000 * 76670000 * IF COMBUF='(' /* IF IS LEFT PAREN, CHECK * 76680000 * THEN /* TO SEE IF PCE IS * 76690000 CLI 0(@4),C'(' 1503 76700000 BC 07,@974 1503 76710000 * DO; /* SUBSCRIPTABLE * 76720000 * 76730000 * /************************************************************* 76740000 * /* * 76750000 * /* IF PCE SUBSCRIPTABLE, GO TO THE SCAN ROUTINE TO FIND THE * 76760000 * /* END OF THE SUBSCRIPT. IF NOT SUBSCRIPTABLE, THE LEFT PAREN* 76770000 * /* IS AN INVALID CHARACTER. * 76780000 * /* * 76790000 * /************************************************************* 76800000 * 76810000 * IF SUBSCRP='1'B /* IF PCE SUBSCRIPTABLE * 76820000 * THEN /* GO TO THE SUBSCRIPT ERROR * 76830000 TM 1(@6),B'00010000' 1505 76840000 BC 12,@973 1505 76850000 * DO; /* SCAN ROUTINE * 76860000 * SUBSMODE='1'B; /* INDICATE PROCESSING A * 76870000 OI 599(@B),B'00100000' 1507 76880000 * GOTO SUBERSCN; /* SUBSCRIPT AND GO TO ERROR * 76890000 BC 15,SUBERSCN 1508 76900000 * END; /* SCAN ROUTINE * 76910000 * ELSE /* IF PCE NOT SUBSCRIPTABLE * 76920000 * GOTO XINUP; /* CONSIDER LEFT PAREN INVALID * 76930000 * END; /* END LEFT PAREN PROCESSING * 76940000 @972 EQU * 1511 76950000 * 76960000 * /***************************************************************** 76970000 * /* * 76980000 * /* IF NOT SEPARATOR,RIGHT PAREN, ENDINPUT, ; , OR LEFT PAREN ONLY* 76990000 * /* VALID DELIMITER LEFT IS A COLON. IF NOT COLON, IS JUST ANOTHER* 77000000 * /* CHARACTER OF THE INVALID DATA NAME. * 77010000 * /* * 77020000 * /***************************************************************** 77030000 * 77040000 * IF COMBUF^=':' /* IF NOT A COLON, CONTINUE * 77050000 * THEN /* SCAN OF ERROR DATA UNTIL * 77060000 @974 CLI 0(@4),C':' 1512 77070000 * GOTO XINUP; /* FIND VALID DELIMITER. * 77080000 BC 07,XINUP 1513 77090000 * 77100000 * RANGE1: 77110000 * CALL TSTRNGE; /* GO PROCESS RANGE A00996 77120000 * IF REQUIRED A00996 * 77130000 RANGE1 L @F,@V5 ADDRESS OF TSTRNGE 1514 77140000 BALR @E,@F 1514 77150000 * GEN; /* GENERATE PROPER BRANCHES * 77160000 BC 15,XINUP IF +0 RETURN AND ':' 77170000 * IT IS AN ERROR 77180000 BC 15,INVPSAV IF +4, GO PROCESS 2ND 77190000 * VALUE OF THE 6 77200000 DS 0H 77210000 * 77220000 * 77230000 * XINUP: 77240000 * R4=R4+1; /* INCREMENT TO NEXT CHAR CHAR IN 77250000 * ERROR SCAN FOR VALID DELIMITER* 77260000 XINUP AH @4,@D2 1516 77270000 * GOTO SPTST; /* CONTINUE SCAN * 77280000 BC 15,SPTST 1517 77290000 * GEN (EJECT); 77300000 EJECT 77310000 DS 0H 77320000 * 77330000 * /***************************************************************** 77340000 * /* * 77350000 * /* THE CODE4 ROUTINE IS ENTERED WHEN THE SCAN OF THE VARIABLE IS * 77360000 * /* COMPLETE EITHER FOR A GOOD DATA NAME OR FOR ONE IN WHICH AN * 77370000 * /* ERROR WAS DETECTED. ON ENTRY, XINPUTB POINTS TO THE CHARACTER * 77380000 * /* AFTER THE END OF THE VARIABLE. PROCESSING IS DONE TO SET UP * 77390000 * /* THE MESSAGE FOR PROMPTING IF IN ERRORMODE OR TO PREPARE TO * 77400000 * /* ISSUE THE PROMPT IF THE VALIDITY CHECK EXIT RETURNS AN ERROR * 77410000 * /* INDICATOR. IF NOT IN ERRORMODE (AN ERROR WAS NOT DETECTED IN * 77420000 * /* THE VARIABLE SCAN), THE PDE IS COMPLETED FOR THE TERM AND AN * 77430000 * /* EXIT IS MADE TO THE POSITXCB ROUTINE IN PARSE TO ADD THE PDE * 77440000 * /* AND GO TO THE VALIDITY CHECK EXIT IF SPECIFIED. * 77450000 * /* * 77460000 * /***************************************************************** 77470000 * 77480000 * 77490000 * CODE4: 77500000 * IF SUBSMODE='1'B /* IF FINISHED PROCESSING A * 77510000 * THEN /* SUBSCRIPT, RESET THE PDE * 77520000 CODE4 TM 599(@B),B'00100000' 1519 77530000 BC 12,@971 1519 77540000 * PDEPTR=ADDR (TEMPPDE); /* PTR TO THE MAJOR TERM PDE * 77550000 LA @F,332(0,@B) 1520 77560000 ST @F,564(0,@B) 1520 77570000 BC 15,@970 1521 77580000 * ELSE /* IF NOT SUBSMODE, SET THE * 77590000 * R6=TERMXPCE; /* THE PCE PTR TO THE MAJOR TERM 77600000 * PCE. THIS CANNOT BE DONE IN 77610000 * SUBSCRIPT MODE SINCE IF AN 77620000 * ERROR HAS OCCURRED PROMPTING 77630000 * MUST BE DONE FROM THE 77640000 * SUBSCRIPT TERM PCE * 77650000 @971 L @6,528(0,@B) 1521 77660000 * 77670000 * PRMTEXT: 77680000 * DIGITCT=0; /* RESET DIGIT COUNT IN CASE 77690000 * CODE4 ENTERED FROM CONSTANT * 77700000 @970 EQU * 1522 77710000 PRMTEXT MVI 596(@B),0 1522 77720000 * 77730000 * /***************************************************************** 77740000 * /* * 77750000 * /* THE FOLLOWING ROUTINE ESTABLISHES THE NEED TO SET UP A SPECIAL* 77760000 * /* MESSAGE. IF THE PARM TYPE IS STATEMENT, A SPECIAL MESSAGE IS * 77770000 * /* NOT REQUIRED. * 77780000 * /* * 77790000 * /***************************************************************** 77800000 * 77810000 * IF STMT='1'B /* IF PCE TYPE STATEMENT * 77820000 * THEN /* DO NOT PROCESSING TO SET * 77830000 TM 6(@6),B'10000000' 1523 77840000 * GOTO RTNTEST; /* UP FOR SPECIAL MESSAGE * 77850000 BC 01,RTNTEST 1524 77860000 * 77870000 * /***************************************************************** 77880000 * /* * 77890000 * /* THIS ROUTINE DETERMINES IF A SPECIAL MESSAGE IS REQUIRED. THE * 77900000 * /* SPECIAL MESSAGE MUST BE SET UP SO AS NOT TO LOSE ANY DATA * 77910000 * /* WHICH HAS BEEN DETERMINED AS BEING INVALID. BECAUSE VARIABLES * 77920000 * /* MAY HAVE IMBEDDED BLANKS WITHIN AN ENTIRE DATA NAME, IT IS * 77930000 * /* POSSIBLE FOR THE BUFFER TO BE POPPED DURING THE SCAN. * 77940000 * /* THEREFORE, IT IS NOT POSSIBLE TO PRINT OUT THE DATA NAME IN A * 77950000 * /* CONTIGUOUS FORMAT. THUS A POINTER IS OBTAINED TO THE FIRST * 77960000 * /* PART OF THE DATA NAME AND TO THE PART WHICH IS IN ERROR. THE * 77970000 * /* POINTERS TO THE FIRST DATA NAME ARE OBTAINED FROM THE PDE; THE* 77980000 * /* POINTER TO THE INVALID DATA IS OBTAINED FROM PRMTPTR WHICH HAS* 77990000 * /* BEEN LEFT AT THE INVALID DATA FOUND IN THE BUFFER. THE SPECIAL* 78000000 * /* MESSAGE IS FORMATTED BY THE MSGSETUP ROUTINE AND INCLUDES * 78010000 * /* ELLIPSES FOLLOWING THE THE FIRST DATA NAME, UP TO THE PART OF * 78020000 * /* THE VARIABLE IN ERROR. EXAMPLE: A OF B IN * (1 2 3) PROMPT: * 78030000 * /* INVALID DATA NAME - A...* (1 2 3) * 78040000 * /* * 78050000 * /***************************************************************** 78060000 * 78070000 * IF OPERMODE='1'B /* IF PROCESSING AN EXPRESSION * 78080000 * THEN /* GO TO SET UP THE SPECIAL * 78090000 TM 599(@B),B'01000000' 1525 78100000 BC 12,@96F 1525 78110000 * IF CONST='1'B /* IF IS A CONSTANT, JUST * 78120000 * THEN /* SET UP SPECIAL MESSAGE * 78130000 L @1,564(0,@B) 1526 78140000 TM 6(@1),B'01000000' 1526 78150000 * GOTO SPECMSG2; /* FIELDS FOR OPER * 78160000 BC 01,SPECMSG2 1527 78170000 * 78180000 * /***************************************************************** 78190000 * /* * 78200000 * /* IF THE TWO POINTERS - INVPSAVE AND PRMTPTR - ARE POINT- ING TO* 78210000 * /* THE SAME CHARACTER IN THE BUFFER, THE DATA IN WAS DETECTED IN * 78220000 * /* THE FIRST PART OF THE DATA NAME. A SPECIAL MESSAGE IS NOT * 78230000 * /* REQUIRED, BECAUSE THE BUFFER IS NOT POPPED IN WHILE PROCESSING* 78240000 * /* IN ERROR MODE. ALTHOUGH THE SPECIAL MESSAGE AREAS ARE * 78250000 * /* INITIALIZED, THE SPECIAL MESSAGE BIT IS NOT TURNED ON. * 78260000 * /* * 78270000 * /***************************************************************** 78280000 * 78290000 * 78300000 * SPECMG: 78310000 * IF INVPSAVE^=PRMTPTR /* IF SPECIAL MESSAGE REQUIRED * 78320000 * THEN /* THEN GO TO ROUTINE TO * 78330000 @96F EQU * 1528 78340000 SPECMG L @F,584(0,@B) 1528 78350000 C @F,300(0,@B) 1528 78360000 * GOTO SPECMSG3; /* OBTAIN POINTERS TO THE ERROR 78370000 * DATA FROM THE PDE * 78380000 BC 07,SPECMSG3 1529 78390000 * 78400000 * /***************************************************************** 78410000 * /* * 78420000 * /* IF NO SPECIAL MESSAGE, SET UP MESSAGE AREAS FROM THE BUFFER * 78430000 * /* POINTERS - INVPSAVE AND XINPUT. INVPSAVE POINTS TO THE * 78440000 * /* BEGINNING OF THE DATA NAME. XINPUT POINTS TO THE CHARACTER * 78450000 * /* FOLLOWING THE VARIABLE. * 78460000 * /* * 78470000 * /***************************************************************** 78480000 * 78490000 * 78500000 * SPECMSG2: 78510000 * IF R4 = INVPSAVE /* IF XINPUT POINTS TO THE * 78520000 * THEN /* FIRST CHAR OF THE DATA NAME, * 78530000 SPECMSG2 C @4,300(0,@B) 1530 78540000 BC 07,@96E 1530 78550000 * R4 = R4 +1; /* INCREMENT BY ONE * 78560000 AH @4,@D2 1531 78570000 * /* SET UP SPECIAL MESSAGE * 78580000 * IF PFENDSET='1'B /* IF BUFFER POPPED * 78590000 * THEN MSGLEN=ENDBAKUP-INVPSAVE; /* USE ENDBAKUP FOR LENGTH * 78600000 @96E TM 179(@B),B'00000100' 1532 78610000 BC 12,@96D 1532 78620000 L @F,300(0,@B) 1533 78630000 LCR @F,@F 1533 78640000 A @F,412(0,@B) 1533 78650000 STH @F,590(0,@B) 1533 78660000 BC 15,@96C 1534 78670000 * ELSE MSGLEN=R4-INVPSAVE; /* OTHERWISE USE XINPUT * 78680000 @96D L @F,300(0,@B) 1534 78690000 LCR @F,@F 1534 78700000 AR @F,@4 1534 78710000 STH @F,590(0,@B) 1534 78720000 * MSGADDR=INVPSAVE; /* MSGADDR CONTAINS A POINTER TO 78730000 * THE BEGINNING OF THE INVALID 78740000 * DATA * 78750000 @96C MVC 592(4,@B),300(@B) 1535 78760000 * GOTO RTNTEST; /* BYPASS SETTING SPECIAL MSG BIT* 78770000 BC 15,RTNTEST 1536 78780000 * 78790000 * /***************************************************************** 78800000 * /* * 78810000 * /* SPECMSG3 ROUTINE SETS THE SPECIAL MESSAGE BIT ON. INVPSAVE IS * 78820000 * /* INITIALIZED TO POINT TO THE BEGINNING OF THAT PART OF THE * 78830000 * /* VARIABLE WHICH WAS FIRST DETECTED AS BEING IN ERROR. THE * 78840000 * /* POINTER TO THE BEGINNING OF THE VARIABLE ENTERED IS OBTAINED * 78850000 * /* FROM THE PDE. THE POINTER TO THE CORRECT PDE, EITHER THE * 78860000 * /* TEMPORARY OR THE PERM- ANENT IS IN PDEPTR. * 78870000 * /* * 78880000 * /***************************************************************** 78890000 * 78900000 * 78910000 * SPECMSG3: /* SET UP SPECIAL MESSAGE * 78920000 * SPECMSG='1'B; /* INDICATE SPEC MSG REQUIRED * 78930000 SPECMSG3 OI 600(@B),B'10000000' 1537 78940000 * IF RNGEVAL1='1'B /* IF FIRST VALUE OF RANGE * 78950000 * THEN /* BEING PROCESSED, DO NOT * 78960000 TM 177(@B),B'01000000' 1538 78970000 BC 12,@96B 1538 78980000 * IF ERRORBIT^='1'B /* SET INVPSAVE =PRMTPTR * 78990000 * THEN /* UNLESS THE ERROR BIT * 79000000 TM 599(@B),B'00001000' 1539 79010000 * GOTO ADDPDE; /* IS ON * 79020000 BC 12,ADDPDE 1540 79030000 * INVPSAVE=PRMTPTR; /* SET INVPSAVE TO THE BEGIN- 79040000 * NING OF THE DATA FOUND TO TO 79050000 * BE IN ERROR. INVPSAVE IS USED 79060000 * BY THE MSGSETUP RTN IN 79070000 * FORMATTING A CONTIGUOUS LINE 79080000 * OF INVALID DATA * 79090000 @96B MVC 300(4,@B),584(@B) 1541 79100000 * GEN (EJECT); 79110000 EJECT 79120000 DS 0H 79130000 * 79140000 * /***************************************************************** 79150000 * /* * 79160000 * /* THE EXIT ROUTINE DETERMINES IF THE SCAN WAS SUCCESSFUL OR NOT.* 79170000 * /* (ERRORBIT ON IF ERROR FOUND) IF SUCCESSFUL, THE PDE IS ADDED * 79180000 * /* TO THE PDL THROUGH THE POSITXCB ROUTINE IN IKJEFP00. THE * 79190000 * /* RETURN FROM POSITXCB IS PROCESSED. IF RETURN IS ON +4, A * 79200000 * /* CHAINED TERM OFF AN OPER IS BEING PROCESSED AND A SUBSCRIPT * 79210000 * /* FOR THE VARIABLE FOLLOWS IN THE BUFFER. IF +0, PROCESSING IS * 79220000 * /* DONE TO PREPARE TO CONTINUE THE SCAN IN THE BUFFER, EITHER BY * 79230000 * /* RETURNING TO PARSE AND PROCEEDING ON THE NEXT PCE IN THE PCL, * 79240000 * /* RETURNING TO THE OPER PROCESSOR TO CONTINUE THE SCAN OF AN * 79250000 * /* EXPRESSION, OR RETURNING TO TERM INITIALIZATION TO SCAN THE * 79260000 * /* NEXT TERM OF A LIST. IF AN ERROR HAS BEEN DETECTED IN THE * 79270000 * /* SCAN, THE MSGSETUP ROUTINE IS CALLED TO FORMAT THE INVALID * 79280000 * /* MESSAGE AND TO EXIT TO IKJEFP00 TO PROMPT. THE PROMPT RESPONSE* 79290000 * /* IS RETURNED AT THE LABEL 'OPERTEST' * 79300000 * /* * 79310000 * /***************************************************************** 79320000 * 79330000 * 79340000 * RTNTEST: 79350000 * IF ERRORBIT^='1'B /* IF NO ERROR IN SCAN * 79360000 * THEN /* GO TO ADD THE PDE TO * 79370000 RTNTEST TM 599(@B),B'00001000' 1543 79380000 * GOTO ADDPDE; /* THE PDL * 79390000 BC 12,ADDPDE 1544 79400000 * 79410000 * /***************************************************************** 79420000 * /* * 79430000 * /* IF PROCESSING A PROMPT RESPONSE AND WE ARE IN OPER MODE THE * 79440000 * /* ENTIRE BUFFER CAN BE REJECTED AS INVALID. THIS IS POSSIBLE * 79450000 * /* BECAUSE IF THE USER IS PROMPTED FOR PART OF AN EXPRESSION, HE * 79460000 * /* IS ALLOWED TO ENTER ONLY THAT PART OF THE EXPRESSION WHICH WAS* 79470000 * /* IN ERROR. THUS ANYTHING ELSE IN THE BUFFER IS NOT SCANNED. * 79480000 * /* * 79490000 * /***************************************************************** 79500000 * 79510000 * 79520000 * CODE4A: 79530000 * IF OPERMODE^='1'B /* IF NOT OPER, DO NOT SET * 79540000 * THEN /* ENTIRE BUFFER AS * 79550000 CODE4A TM 599(@B),B'01000000' 1545 79560000 * GOTO CODE4B; /* INVALID * 79570000 BC 12,CODE4B 1546 79580000 * 79590000 * /***************************************************************** 79600000 * /* * 79610000 * /* IF IN OPER MODE BUT NOT PROCESSING A PROMPT RESPONSE, CANNOT * 79620000 * /* THROW OUT ENTIRE BUFFER * 79630000 * /* * 79640000 * /***************************************************************** 79650000 * 79660000 * IF PRMTSCAN^='1'B /* IS THIS A PROMPT RESPONSE * 79670000 * THEN /* IF NOT, DO NOT SET ENTIRE * 79680000 TM 600(@B),B'00000100' 1547 79690000 BC 01,@96A 1547 79700000 * DO; /* BUFFER AS INVALID * 79710000 * PRMTSCAN='1'B; /* INDICATE HAVE PROMPTED ONCE * 79720000 OI 600(@B),B'00000100' 1549 79730000 * GOTO CODE4B; /* GO WRITE OUT MESSAGE * 79740000 BC 15,CODE4B 1550 79750000 * END; /* END SPECIAL OPER PROCESSNG * 79760000 * 79770000 * /***************************************************************** 79780000 * /* * 79790000 * /* TO SET ENTIRE BUFFER INVALID, SET XINPUT EQUAL TO ENDINPUT. * 79800000 * /* * 79810000 * /***************************************************************** 79820000 * 79830000 * 79840000 * INVALPRM: 79850000 * R4=ENDINPUT; /* SET XINPUT TO END OF BUFFER * 79860000 @96A EQU * 1552 79870000 INVALPRM L @4,144(0,@B) 1552 79880000 * 79890000 * /***************************************************************** 79900000 * /* * 79910000 * /* XINPUTB IS USED BY THE MSGSETUP ROUTINE AND THE PARSE PARSE * 79920000 * /* PROMPTING ROUTINE. XINPUTB IS SET EQUAL TO XINPUT XINPUT IS * 79930000 * /* EITHER LEFT AT THE CHARACTER AFTER THE END OF INVALID DATA * 79940000 * /* SCANNED OR IS SET TO THE END OF THE BUFFER IF SCANNING A * 79950000 * /* PROMPT RESPONSE IN OPER MODE * 79960000 * /* * 79970000 * /***************************************************************** 79980000 * 79990000 * 80000000 * CODE4B: 80010000 * R5=R4; /* POINT AT END OF INVALID DATA * 80020000 CODE4B LR @5,@4 1553 80030000 * 80040000 * CODE4C: 80050000 * ERRORBIT='0'B; /* TURN ERROR BIT OFF * 80060000 CODE4C NI 599(@B),B'11100111' 1554 80070000 * NAMEREQD='0'B; /* NAME REQUIRED OFF * 80080000 * PFNOPOP='0'B; /* ALLOW STACK POPPING * 80090000 NI 179(@B),B'11111101' 1556 80100000 * FIRSTNAM='0'B; /* TURN FIRSTNAM SWITCH OFF * 80110000 NI 601(@B),B'01111111' 1557 80120000 * QUALCT=0; /* REINITIALIZE QUALIFIER COUNT * 80130000 MVI 598(@B),0 1558 80140000 * ELEMNCT=0; /* REININTIALIZE ELEMNT COUNT * 80150000 MVI 597(@B),0 1559 80160000 * SUBSMODE='0'B; /* SET SUBSCRIPT MODE OFF * 80170000 NI 599(@B),B'11011111' 1560 80180000 * IF PFLIST='1'B /* IF PROCESSING A LIST * 80190000 * THEN /* MSUT CHECK TO SEE IF RANGE * 80200000 TM 176(@B),B'10000000' 1561 80210000 BC 12,@969 1561 80220000 * DO; /* (FIRST HALF ADDED * 80230000 * IF RNGADDED='1'B /* IF FIRST HALF ADDED, * 80240000 * THEN /* MUST SEE IF WAS AN ELEMENT * 80250000 TM 600(@B),B'00000001' 1563 80260000 BC 12,@968 1563 80270000 * DO; /* OF THE LIST (NOT FIRST) OR * 80280000 * IF PREVPDEL=0 /* THE FIRST LIST ELEMENT. IF * 80290000 * THEN /* PREVPDEL IS ZERO, IS FIRST * 80300000 SR @F,@F 1565 80310000 C @F,448(0,@B) 1565 80320000 * GOTO PTRNOTST; /* ELEMENT AND CAN ERASE THE 80330000 * PERMANENT PDE * 80340000 BC 08,PTRNOTST 1566 80350000 * LISTPTR='FF000000'X;/* IF OTHER THAN FIRST ELEMENT * 80360000 L @1,448(0,@B) 1567 80370000 MVC 0(4,@1),@X27 1567 80380000 * RNGEVAL1='0'B; /* MUST RESET LISTPTR TO ERASE 80390000 * A00996 * 80400000 NI 177(@B),B'10110111' 1568 80410000 * RNGEVAL2='0'B; /* LIST PDE WITH HALF THE RANGE 80420000 * AND MUST TURN OFF RANGE 80430000 * SWITCHES SO DON'T GET PERM 80440000 * PDE ZEROED A00996 * 80450000 * END; /* END LIST/RANGE ADDED PROCESS * 80460000 * END; /* END SPECIAL LIST TESTS TO 80470000 * PREVENT ERASING GOOD FIRST 80480000 * LIST ELEMENT PDE 80490000 * IN ALL CASES, REINITIALIZE 80500000 * RANGE ADDED INDICATOR * 80510000 @968 EQU * 1571 80520000 * 80530000 * PTRNOTST: /* SET SEITCHES FOR MESSAGE * 80540000 * RNGADDED='0'B; /* TURN RNGADDED OFF * 80550000 @969 EQU * 1572 80560000 PTRNOTST NI 600(@B),B'11111110' 1572 80570000 * IF PFSKPINV='1'B /* IF THE V.C. EXIT WROTE A00996 * 80580000 * THEN /* INVALID MSG, DECRMNT A00996 * 80590000 TM 177(@B),B'10000000' 1573 80600000 BC 12,@967 1573 80610000 * R4=R4-1; /* XINPUT SO WON'T MISS A00996 * 80620000 BCTR @4,0 1574 80630000 * /* NEXT CHAR IN BUFFER A00996 * 80640000 * VARCODE4: /* SET UP TO GO ISSUE ERROR * 80650000 * CBLNKSV2=ADDR (OPERTEST); /* MESSAGE. INITIALIZE RETURN 80660000 * ADDRESS. THE TERM PROCESSOR 80670000 * WILL BE ENTERED AT THIS POINT 80680000 * FROM IKJEFP00 WHEN THE PROMPT 80690000 * RESPONSE IS PICKED UP. * 80700000 @967 EQU * 1575 80710000 VARCODE4 LA @F,OPERTEST 1575 80720000 ST @F,552(0,@B) 1575 80730000 * CALL MSGSETUP; /* FORMAT AND WRITE OUT THE 80740000 * INVALID MESSAGE. RETURN IS AT 80750000 * OPERTEST. * 80760000 BAL @E,MSGSETUP 1576 80770000 * GEN (EJECT); 80780000 EJECT 80790000 DS 0H 80800000 * 80810000 * /***************************************************************** 80820000 * /* * 80830000 * /* THE ADDPDE ROUTINE PREPARES TO GO TO IKJEFP00 TO ADD THE PDE * 80840000 * /* TO THE PDL THE RETURN FROM POSITXCB IS DIAGNOSED WITH PROPER * 80850000 * /* ACTION TAKEN IF PROCESSING A CHAINED TERM OFF AN OPER, A LIST,* 80860000 * /* OR AN EXPRESSION IN OPER MODE. * 80870000 * /* * 80880000 * /***************************************************************** 80890000 * 80900000 * 80910000 * ADDPDE: 80920000 * R6=TERMXPCE; /* IF PROCESSING A SUBSCRIPT MUST 80930000 * RESET XPCE AT THIS POINT. LEFT 80940000 * AT THE SUBSCRIPT PCE UNTIL NO 80950000 * ERROR DETECTED * 80960000 ADDPDE L @6,528(0,@B) 1578 80970000 * IF R4=>ENDINPUT /* IF EOB, GO TO A00996 * 80980000 * THEN /* ADD THE PDE WITHOUT A00996 * 80990000 C @4,144(0,@B) 1579 81000000 * GOTO ADDPDE2; /* FURTHER LIST CHECKING A00996 * 81010000 BC 10,ADDPDE2 1580 81020000 * IF PFLIST^='1'B /* IF NOT PROCESSING A LIST * 81030000 * THEN /* DO NOT HAVE TO CHECK FOR * 81040000 TM 176(@B),B'10000000' 1581 81050000 * GOTO ADDPDE2; /* CLOSING PAREN * 81060000 BC 12,ADDPDE2 1582 81070000 * IF COMBUF=')' /* IF AT THE END OF A LIST * 81080000 * THEN /* MUST DECREMENT XINPUT SO * 81090000 CLI 0(@4),C')' 1583 81100000 BC 07,@966 1583 81110000 * R4=R4-1; /* POSITXCB WILL NOT MISS IT * 81120000 BCTR @4,0 1584 81130000 * 81140000 * ADDPDE2: 81150000 * PLINKSV2=ADDR (CODE4C); /* IF AN ERROR IS DETECTED IN THE 81160000 * VALIDITY CHECK EXIT, RETURN IS 81170000 * TO CODE4C TO WRITE OUT THE 81180000 * INVALID MESSAGE * 81190000 @966 EQU * 1585 81200000 ADDPDE2 LA @F,CODE4C 1585 81210000 ST @F,672(0,@B) 1585 81220000 * FIRSTNAM='0'B; /* TURN FIRSTNAM SWITCH OFF * 81230000 NI 601(@B),B'01111111' 1586 81240000 * SUBSMODE='0'B; /* REINITIALIZE SUBSCRIPT AND * 81250000 NI 599(@B),B'11011111' 1587 81260000 * ELEMNCT=0; /* SUBSCRIPT COUNT INDICATORS * 81270000 MVI 597(@B),0 1588 81280000 * R1=PPCOUNT; /* SET THE SIZE OF THE PDE TO BE 81290000 * ADDED IN REG1 FOR POSITX * 81300000 SR @1,@1 1589 81310000 IC @1,417(0,@B) 1589 81320000 * ADDCDE=3; /* GOTO POSITX IN IKJEFP00 TO * 81330000 LA @F,3 1590 81340000 * CALL LINKRET; /* ADD THE PDE * 81350000 BAL @E,LINKRET 1591 81360000 * GOTO SPECOF; /* IF RETURN +0, KNOW NOT 81370000 * PROCESSING CHAINED TERM * 81380000 BC 15,SPECOF 1592 81390000 * SPECMSG='0'B; /* +4 RETURN MEANS MUST CONTIN * 81400000 NI 600(@B),B'01111111' 1593 81410000 * IF CHAINTRM^='1'B /* IF NOT PROCESSING A * 81420000 * THEN /* CHAINED TERM, RET. ON * 81430000 TM 600(@B),B'00010000' 1594 81440000 * GOTO RTNCLNUP; /* +4 IS INVALID * 81450000 BC 12,RTNCLNUP 1595 81460000 * IF CTFOUND^='1'B /* IF A SUBSCRIPT WAS NOT * 81470000 * THEN /* FOUND AFTER THE VARIABLE * 81480000 TM 601(@B),B'01000000' 1596 81490000 * GOTO CODE4B; /* THE VARIABLE IS INVALID * 81500000 BC 12,CODE4B 1597 81510000 * ADDCDE=5; /* SKIP BLANKS TO THE * 81520000 LA @F,5 1598 81530000 * CALL LINKRET; /* SUBSCRIPT. RETURN IS +4 81540000 * BECAUSE KNOW SOME DATA FOLLOWS* 81550000 BAL @E,LINKRET 1599 81560000 * GEN (NOP 0 ); /* NO +0 RETURN * 81570000 NOP 0 81580000 DS 0H 81590000 * R4=R4+1; /* POINT AT LEFT PAREN * 81600000 AH @4,@D2 1601 81610000 * GOTO GDNNBL; /* PROCESS SUBSCRIPT * 81620000 BC 15,GDNNBL 1602 81630000 * 81640000 * /***************************************************************** 81650000 * /* * 81660000 * /* DETERMINE PROCESSING REQUIRED AFTER ADDING THE PDE * 81670000 * /* * 81680000 * /***************************************************************** 81690000 * 81700000 * 81710000 * SPECOF: 81720000 * SPECMSG='0'B; /* TURN OFF SPECIAL MESSAGE 81730000 * INDICATOR - NO LONGER NECES- 81740000 * SARY * 81750000 SPECOF NI 600(@B),B'01111111' 1603 81760000 * 81770000 * /***************************************************************** 81780000 * /* * 81790000 * /* IF RNGEVAL1 IS ON, HAVE COMPLETED THE FIRST VALUE OF A RANGE. * 81800000 * /* MUST RETURN TO THE BEGINNING OF THE TERM PROCESSOR TO SCAN THE* 81810000 * /* SECOND RANGE VALUE * 81820000 * /* * 81830000 * /***************************************************************** 81840000 * 81850000 * IF RNGEVAL1='1'B /* FIRST VALUE OF RANGE PRO- * 81860000 * THEN /* CESSED. IF SO * 81870000 TM 177(@B),B'01000000' 1604 81880000 BC 12,@965 1604 81890000 * DO; /* RESET THE PDE PTR TO THE * 81900000 * RNGADDED='1'B; /* INDICATE 1ST HALF OF RANGE 81910000 * ADDED * 81920000 OI 600(@B),B'00000001' 1606 81930000 * 81940000 * GOBACK: 81950000 * PDEPTR=ADDR (TEMPPDE); /* ADDR OF THE TEMPORARY PDE TO 81960000 * ADD 2ND VALUE INFO * 81970000 GOBACK LA @F,332(0,@B) 1607 81980000 ST @F,564(0,@B) 1607 81990000 * GOTO INVPSAV; /* RETURN TO BEGINNING OF * 82000000 BC 15,INVPSAV 1608 82010000 * END; /* TERM * 82020000 * 82030000 * /***************************************************************** 82040000 * /* * 82050000 * /* MUST INITIALIZE CORE ANCHORS SO QUALIFIER LEVELS WILL BE ADDED* 82060000 * /* CORRECTLY. * 82070000 * /* * 82080000 * /***************************************************************** 82090000 * 82100000 * AANC=TANC; /* ADD NEXT QUALIFIER LEVEL AFTER 82110000 * LAST ADDED. TANCH POINTS TO 82120000 * THE NEXT FREE PDE SPACE * 82130000 @965 MVC 568(4,@B),572(@B) 1610 82140000 * RNGADDED='0'B; /* IF PROCESSING RANGE, HAVE 82150000 * SUCCESSFULLY ADED BOTH HALVES 82160000 * OF THE RANGE * 82170000 NI 600(@B),B'11111110' 1611 82180000 * 82190000 * /***************************************************************** 82200000 * /* * 82210000 * /* IF IN OPERMODE, RETURN TO THE OPER PROCESSOR WITH INDICATION * 82220000 * /* PDE WAS ADDED - +4 * 82230000 * /* * 82240000 * /***************************************************************** 82250000 * 82260000 * IF OPERMODE^='1'B /* IF NOT OPERMODE, CONTINUE * 82270000 * THEN /* SPECIAL TESTS FOR LIST * 82280000 TM 599(@B),B'01000000' 1612 82290000 * GOTO LISTEST; /* LISTS ARE NOT POSSIBLE UNDER 82300000 * AN OPER * 82310000 BC 12,LISTEST 1613 82320000 * GOREG=CBLNKSV1+4; /* RETURN +4 TO INDICATE PDE WAS 82330000 * ADDED * 82340000 LA @E,4 1614 82350000 A @E,548(0,@B) 1614 82360000 * R4=R4-1; /* DECREMENT XINPUT FOR SKIPB IN 82370000 * OPER PROCESSOR * 82380000 BCTR @4,0 1615 82390000 * RETURN; /* RETURN TO OPER * 82400000 BC 15,@EL08 1616 82410000 * 82420000 * /***************************************************************** 82430000 * /* * 82440000 * /* IF PROCESSING A LIST, RETURN MUST BE TO THE BEGINNING OF THE * 82450000 * /* TERM PROCESSOR. DO NOT WANT TO SCAN THE NEXT ELEMENT OF THE * 82460000 * /* LIST UNDER THE NEXT PCE BUT UNDER THE PRESENT TERM PCE. * 82470000 * /* * 82480000 * /***************************************************************** 82490000 * 82500000 * 82510000 * LISTEST: 82520000 * IF PFLIST^='1'B /* IF NO LIST, * 82530000 * THEN /* CONTINUE WITH NORMAL EXIT * 82540000 LISTEST TM 176(@B),B'10000000' 1617 82550000 * GOTO END1; /* PROCESSING * 82560000 BC 12,END1 1618 82570000 * ADDCDE=5; /* SKIP BLANKS TO THE NEXT 82580000 * ELEMENT OF THE LIST * 82590000 LA @F,5 1619 82600000 * CALL LINKRET; /* SKIPB IN PARSE * 82610000 BAL @E,LINKRET 1620 82620000 * GOTO UPDTPCE; /* IF EOB, MUST GO TO UPDATE TO 82630000 * THE NEXT PCE * 82640000 BC 15,UPDTPCE 1621 82650000 * R4=R4+1; /* IF NOT EOB , CHECK NEXT NEXT 82660000 * CHAR FOR SEMICOLON * 82670000 AH @4,@D2 1622 82680000 * 82690000 * /***************************************************************** 82700000 * /* * 82710000 * /* IF SEMICOLON ENDS LIST, MUST GO TO UPDATE TO THE NEXTPCE * 82720000 * /* * 82730000 * /***************************************************************** 82740000 * 82750000 * IF COMBUF^=';' /* IF NOT A SEMICOLON * 82760000 * THEN /* DECREMENT XINPUT * 82770000 CLI 0(@4),C';' 1623 82780000 BC 08,@964 1623 82790000 * DO; /* AND CONTINUE LIST PROCES * 82800000 * R4=R4-1; /* DECREMENT BEFORE SEMCOL * 82810000 BCTR @4,0 1625 82820000 * GOTO GOBACK; /* RETURN TO BEGINNING OF * 82830000 BC 15,GOBACK 1626 82840000 * END; /* OF TERM * 82850000 * R4=R4-1; /* DECREMENT BEFORE SEMCOL * 82860000 @964 BCTR @4,0 1628 82870000 * 82880000 * /***************************************************************** 82890000 * /* * 82900000 * /* ISSUE ENDING PAREN ASSUMED MESSAGE * 82910000 * /* * 82920000 * /***************************************************************** 82930000 * 82940000 * 82950000 * MSGRTN: 82960000 * GOTO UPDTPCE; /* GO TO UPDATE TO THE NEXT PCE * 82970000 BC 15,UPDTPCE 1629 82980000 * 82990000 * /***************************************************************** 83000000 * /* * 83010000 * /* THIS IS NORMAL END PROCESSING. NO RANGE OR LIST OR NOT * 83020000 * /* OPERMODE. A CHECK MUST BE MADE FOR EOB OR SEMICOLON SO THE * 83030000 * /* STACK CAN BE POPPED IF NECESSARY. * 83040000 * /* * 83050000 * /***************************************************************** 83060000 * 83070000 * 83080000 * END1: 83090000 * IF R4=>ENDINPUT /* IF AT END OF BUFFER A00996 * 83100000 * THEN /* GO TO END A00996 * 83110000 END1 C @4,144(0,@B) 1630 83120000 * GOTO SKIPSCAN; /* PROCESSING IMMEDIATELY A00996 * 83130000 BC 10,SKIPSCAN 1631 83140000 * IF COMBUF=';' /* IF NOT EOB, AND IS * 83150000 * THEN /* SEMICOLON, MUST DECREMENT * 83160000 CLI 0(@4),C';' 1632 83170000 BC 07,@963 1632 83180000 * R4=R4-1; /* XINPUT TO BEFORE SEMCOL 83190000 * SO WON'T MISS IT IN SUCCEED- 83200000 * ING SCANS * 83210000 BCTR @4,0 1633 83220000 * SKIPSCAN: 83230000 * ADDCDE=5; /* IF EOB OR ANYTHING ELSE * 83240000 @963 EQU * 1634 83250000 SKIPSCAN LA @F,5 1634 83260000 * CALL LINKRET; /* TRY TO POP THE STACK * 83270000 BAL @E,LINKRET 1635 83280000 * GEN (NOP 0); /* GO TO SAME PLACE WHETHER STACK 83290000 * POPPED OR NOT * 83300000 NOP 0 83310000 DS 0H 83320000 * 83330000 * /***************************************************************** 83340000 * /* * 83350000 * /* XPCE MSUT BE UPDATED PASSED THE SUBSCRIPT PCE IF ONE IS * 83360000 * /* PRESENT. ALL COBOL PROCESSING INDICATORS MUST BE OFF WHEN * 83370000 * /* RETURN TO PARSE TO PROCESS THE NEXT PCE * 83380000 * /* * 83390000 * /***************************************************************** 83400000 * 83410000 * 83420000 * UPDTPCE: 83430000 * R6=R6+PCELNGTH; /* UPDATE TO NEXT PCE * 83440000 UPDTPCE MVC @TEMP2+2(2),2(@6) 1637 83450000 A @6,@TEMP2 1637 83460000 * 83470000 * /***************************************************************** 83480000 * /* * 83490000 * /* IF NEXT PCE IS A TERM, DETERMINE IF IT IS A SUBSCRIPT PCE * 83500000 * /* * 83510000 * /***************************************************************** 83520000 * 83530000 * IF TERPCE='110'B /* IF IS A TERM * 83540000 * THEN /* CHECK FOR SUBSCRIPT TERM * 83550000 TM 0(@6),B'11000000' 1638 83560000 BC 12,@962 1637 83570000 TM 0(@6),B'00100000' 1638 83580000 BC 05,@961 1638 83590000 * 83600000 * /*************************************************************** 83610000 * /* * 83620000 * /* IF IS A SUBSCRIPT PCE, UPDATE PASSED IT. IF NOT A SUBSCRIPT,* 83630000 * /* RETURN TO PARSE * 83640000 * /* * 83650000 * /*************************************************************** 83660000 * 83670000 * IF SUBSCPPT='1'B /* IF SUBSCRIPT PCE * 83680000 * THEN /* THEN UPDATE PASSED * 83690000 TM 6(@6),B'00001000' 1639 83700000 * GOTO UPDTPCE; /* IT * 83710000 BC 01,UPDTPCE 1640 83720000 * PFLIST='0'B; /* TURN POSSIBLE LIST BIT OFF * 83730000 @961 EQU * 1641 83740000 @962 NI 176(@B),B'01111111' 1641 83750000 * COBOLMOD='0'B; /* TURN COBOL PROCESSING 83760000 * INDICATOR OFF * 83770000 NI 599(@B),B'01111111' 1642 83780000 * ADDCDE=19; /* RETURN TO PARSE TO PROCESS * 83790000 LA @F,19 1643 83800000 * CALL LINKRET; /* NEXT PCE. RETURN WILL BE TO 83810000 * THE PROPER PROCESSOR TO 83820000 * PROCESS THE NEXT PCE * 83830000 BAL @E,LINKRET 1644 83840000 * GEN (EJECT); 83850000 EJECT 83860000 DS 0H 83870000 * 83880000 * /***************************************************************** 83890000 * /* * 83900000 * /* THE RSTPRTS ROUTINE IS ENTERED WHEN AN INVALID FIRST CHARACTER* 83910000 * /* IS FOUND IN SCANNING A DATA NAME. SEVERAL CHECKS MUST BE MADE * 83920000 * /* TO DETERMINE IF THE "ENTER * 83930000 * /* ......." MESSAGE SHOULD BE ISSUED THROUGH THE PROMPTQ0 * 83940000 * /* ROUTINE IN PARSE. THE INVALID CHARACTER COULD HAVE BEEN * 83950000 * /* DETECTED WHILE SCANNING A LEVEL OF QUALIFICATION, A LIST * 83960000 * /* ELEMENT THE SECOND VALUE OF A RANGE, A SUBSCRIPT, OR WHILE * 83970000 * /* SCANNING AN EXPRESSION ELEMENT IN OPER MODE. IF THIS IS THE * 83980000 * /* CASE, THE VARIABLE MUST BE CONSIDERED INVALID AND NOT MISSING.* 83990000 * /* IF THE INVALID FIRST CHARACTER IS FOUND AFTER WE HAVE ALREADY * 84000000 * /* PROMPTED FOR THIS TERM ONCE AS MISSING - PRMTSCAN ON - IT IS * 84010000 * /* THEN CONSIDERED INVALID ALSO SINCE THE USER WAS PROMPTED FOR A* 84020000 * /* SPECIFIC TERM. IF NONE OF THE ABOVE SITIUATIONS APPLY, * 84030000 * /* PROMPTQ0 IN IKJEFP00 IS ENTERED TO DETERMINE IF THE TERM IS * 84040000 * /* REQUIRED. IF IT IS, PROMPTQ0 ISSUES THE "ENTER...." MESSAGE. * 84050000 * /* IF NOT, PROMTPQ0 RETURNS ON +4. * 84060000 * /* * 84070000 * /***************************************************************** 84080000 * 84090000 * 84100000 * RSTPTRS: 84110000 * R4=PPOINTR; /* RESTORE XINPUT TO BEGINNIN * 84120000 RSTPTRS L @4,148(0,@B) 1646 84130000 * R5=PPOINTR; /* OF VARIABLE. XINPUTB TOO * 84140000 L @5,148(0,@B) 1647 84150000 * 84160000 * /***************************************************************** 84170000 * /* * 84180000 * /* IF PRMTSCAN IS NOT ON (HAVE NOT PROMPTED FOR THIS TERM AS * 84190000 * /* MISSING BEFORE) GO MAKE CHECKS FOR INVALID OR MISSING * 84200000 * /* * 84210000 * /***************************************************************** 84220000 * 84230000 * IF PRMTSCAN^='1'B /* IF HAVEN'T ISSUED "ENTER.. * 84240000 * THEN /* MESSAGE FOR THIS TERM * 84250000 TM 600(@B),B'00000100' 1648 84260000 * GOTO NAMEREQ; /* BEFORE CHECK TO SEE IF SHOULD 84270000 * BE CONSIDERED INVAL- ID OR 84280000 * MISSING * 84290000 BC 12,NAMEREQ 1649 84300000 * 84310000 * /***************************************************************** 84320000 * /* * 84330000 * /* IF PRMTSCAN IS ON, TERM IS INVALID SINCE HAVE PROMPTED * 84340000 * /* SPECIFICALLY FOR A CORRECT TERM. * 84350000 * /* * 84360000 * /***************************************************************** 84370000 * 84380000 * IF OPERMODE='1'B /* IF IN OPER MODE * 84390000 * THEN /* MAY REJECT ENTIRE PROMPT * 84400000 TM 599(@B),B'01000000' 1650 84410000 * GOTO INVALPRM; /* BUFFER AS INVALID * 84420000 BC 01,INVALPRM 1651 84430000 * R4=R4+1; /* GO PASSED INVAL 1ST CHAR * 84440000 AH @4,@D2 1652 84450000 * GOTO VERRBIT; /* IF NOT OPER, MUST CONTINUE 84460000 * NORMAL SCAN TO DETERMINE END 84470000 * OF VARIABLE IN ERROR * 84480000 BC 15,VERRBIT 1653 84490000 * 84500000 * /***************************************************************** 84510000 * /* * 84520000 * /* IF NAMEREQD BIT ON, VARIABLE IS INVALID * 84530000 * /* * 84540000 * /***************************************************************** 84550000 * 84560000 * 84570000 * NAMEREQ: 84580000 * IF NAMEREQD='1'B /* IF NAMEREQD BIT ON * 84590000 * THEN /* GO TO SCAN TO END OF VARIA- * 84600000 NAMEREQ TM 599(@B),B'00010000' 1654 84610000 * GOTO VERRBIT; /* BLE FOR INVALID MESSAGE * 84620000 BC 01,VERRBIT 1655 84630000 * 84640000 * /***************************************************************** 84650000 * /* * 84660000 * /* IF OPERMODE BIT ON, VARIABLE IS INVALID * 84670000 * /* * 84680000 * /***************************************************************** 84690000 * 84700000 * IF OPERMODE='1'B /* IF OPERMODE ON, GO * 84710000 * THEN /* SCAN TO END OF VARIABLE * 84720000 TM 599(@B),B'01000000' 1656 84730000 BC 12,@960 1656 84740000 * DO; /* FOR INVALID MESSAGE * 84750000 * IF COMBUF=';' /* IF INVALID FIRST CHAR * 84760000 * THEN /* IS A SEMI COLON OR A * 84770000 CLI 0(@4),C';' 1658 84780000 * GOTO PRMPT; /* RIGHT PAREN, MUST * 84790000 BC 08,PRMPT 1659 84800000 * IF COMBUF=')' /* PROMPT FOR MISSING * 84810000 * THEN /* INSTEAD OF * 84820000 CLI 0(@4),C')' 1660 84830000 * GOTO PRMPT; /* INVALID * 84840000 BC 08,PRMPT 1661 84850000 * R4=R4+1; /* PREVENT LENGTH OF ZERO * 84860000 AH @4,@D2 1662 84870000 * GOTO VERRBIT; /* SCAN INVALID VARIABLE * 84880000 BC 15,VERRBIT 1663 84890000 * END; /* END SPECIAL OPER PROCESS * 84900000 * 84910000 * /***************************************************************** 84920000 * /* * 84930000 * /* IF PROCESSING A LIST, TERM CANNOT BE MISSING. MUST BE * 84940000 * /* CONSIDERED INVALID. * 84950000 * /* * 84960000 * /***************************************************************** 84970000 * 84980000 * IF PFLIST='1'B /* IF PROCESSING LIST, GO * 84990000 * THEN /* SCAN TO END OF VARIABLE * 85000000 @960 TM 176(@B),B'10000000' 1665 85010000 BC 12,@95F 1665 85020000 * DO; /* FOR INVALID MESSAGE * 85030000 * R4=R4+1; /* PREVENT LENGTH OF ZERO * 85040000 AH @4,@D2 1667 85050000 * GOTO VERRBIT; /* SCAN TO END OF INVALID DATA * 85060000 BC 15,VERRBIT 1668 85070000 * END; /* END SPECIAL LIST PROCES * 85080000 * 85090000 * /***************************************************************** 85100000 * /* * 85110000 * /* IF ON 2ND VALUE OF RANGE, MUST BE CONSIDERED INVALID * 85120000 * /* * 85130000 * /***************************************************************** 85140000 * 85150000 * IF RNGEVAL1='1'B /* 2ND VALUE OF RANGE, GO * 85160000 * THEN /* SCAN TO END OF VARIABLE * 85170000 @95F TM 177(@B),B'01000000' 1670 85180000 * GOTO VERRBIT; /* FOR INVALID MESSAGE * 85190000 BC 01,VERRBIT 1671 85200000 * 85210000 * /***************************************************************** 85220000 * /* * 85230000 * /* IF PROCESSING A SUBSCRIPT, ENTIRE VARIABLE IS INVALID * 85240000 * /* * 85250000 * /***************************************************************** 85260000 * 85270000 * IF SUBSMODE='1'B /* SUBSCRIPT PROCESSING - GO * 85280000 * THEN /* SCAN TO END OF VARIABLE * 85290000 TM 599(@B),B'00100000' 1672 85300000 * GOTO VERRBIT; /* FOR INVALID MESSAGE * 85310000 BC 01,VERRBIT 1673 85320000 * 85330000 * /***************************************************************** 85340000 * /* * 85350000 * /* IF NONE OF THE PREVIOUS CONDITIONS WERE MET, THE INVALID FIRST* 85360000 * /* CHARACTER DENOTES A MISSING PARAMETER FOR THIS PCE. PROMPTING * 85370000 * /* WILL BE PERFORMED IN PROMPTQ0 - IKJEFP00 IF THE TERM IS * 85380000 * /* REQUIRED. * 85390000 * /* * 85400000 * /***************************************************************** 85410000 * 85420000 * 85430000 * PRMPT: 85440000 * PRMTSCAN='1'B; /* INDICATE HAVE PROMPTED FOR 85450000 * THIS TERM ONCE AS MISSING. 85460000 * CANNOT BE MISSING AGAIN. 85470000 * INVALID IF INVALID 1ST CHAR IN 85480000 * PROMPT RESPONSE * 85490000 PRMPT OI 600(@B),B'00000100' 1674 85500000 * R4=R4-1; /* DECREMENT XINPUT SO WON'T MISS 85510000 * ANY OF PRESENT DATA WHEN 85520000 * PROMPTQ0 PUSHES THE STACK * 85530000 BCTR @4,0 1675 85540000 * VARIA = '0'B; /* TURN OFF VARIABLE BIT IN PDE * 85550000 L @1,564(0,@B) 1676 85560000 NI 6(@1),B'11011111' 1676 85570000 * ADDCDE=2; /* ADDRESS OF PROMPT ROUTINE * 85580000 LA @F,2 1677 85590000 * CALL LINKRET; /* IN R15 - GO TO PROMPT * 85600000 BAL @E,LINKRET 1678 85610000 * GEN; /* GENERATE BRANCHES * 85620000 BC 15,INVPSAV +0 - PARM REQUIRED AND PROMPT 85630000 * DATA RETURNED 85640000 BC 15,NTRQEXT +4 - PARM NOT REQUIRED. RETURN 85650000 * PARSE TO PROCESS PARM ENTERED 85660000 * ON THE NEXT PCE 85670000 DS 0H 85680000 * GEN (EJECT); 85690000 EJECT 85700000 DS 0H 85710000 * 85720000 * /***************************************************************** 85730000 * /* * 85740000 * /* THE FOLLOWING ROUTINE IS ENTERED IF A LEVEL OF QUALIFICA- ON A* 85750000 * /* DATA NAME IS BEING PROCESSED. SINCE QUALIFIER PDES ARE CHAINED* 85760000 * /* OFF THE MAIN PDE FOR THE DATA NAME, BLOCKS OF CORE ARE GOTTEN * 85770000 * /* IN WHICH TO PLACE THE QUALIFIER PDE'S. THE STALOC ROUTINE IN * 85780000 * /* IKJEFP00 IS ENTERED TO GET THIS BLOCK OF CORE AND CHAIN IT TO * 85790000 * /* THE CORE OF THE MAIN PDE. INTERNAL ANCHORS WITHIN THE * 85800000 * /* QUALIFIER CORE BLOCKS ARE MAINTAINED IN ORDER TO ENSURE THAT * 85810000 * /* THE QUALIFIER PDE'S ARE ADDED IN THE PROPER ORDER AND THAT THE* 85820000 * /* RIGHT PDE'S ARE ERASED IN CASE OF AN ERROR. THE INTERNAL * 85830000 * /* ANCHORS ARE: OANC - FIRST QUALIFIER PDE ADDRESS ADDED WHEN * 85840000 * /* PROCESSING AN EXPRESSION AANC - FIRST QUALIFIER PDE ADDRESS * 85850000 * /* ADDED FOR A SINGLE VARIABLE TANC - ADDRESS AT WHICH TO ADD THE* 85860000 * /* NEXT QUALIFIER PDE FOR A VARIABLE ENDANC - ENDING ADDRESS FOR * 85870000 * /* ONE 248 BYTE BLOCK. THE END OF THE CURRENT QUALIFIER PDE BLOCK* 85880000 * /* THE CHAINPTR SLWAYS POINTS TO THE POSITION IN THE QUALIFIER * 85890000 * /* PDE WHICH CONTAINS A PTR TO THE NEXT QUALIFIER PDE. * 85900000 * /* * 85910000 * /***************************************************************** 85920000 * 85930000 * 85940000 * CORETEST: 85950000 * 85960000 * /***************************************************************** 85970000 * /* * 85980000 * /* DETERMINE IF A NEW 248 BYTE BLOCK OF CORE IS REQUIRED * 85990000 * /* * 86000000 * /***************************************************************** 86010000 * 86020000 * IF TANC=ENDANC /* ARE WE AT THE END OF THE * 86030000 * THEN /* BLOCK OR IS THIS THE FIRST * 86040000 CORETEST L @F,580(0,@B) 1681 86050000 C @F,572(0,@B) 1681 86060000 * GOTO GETCOR; /* QUALIFIER. IF SO GO GET CORE * 86070000 BC 08,GETCOR 1682 86080000 * 86090000 * /***************************************************************** 86100000 * /* * 86110000 * /* DETERMINE IF AN ERROR HAS CAUSED AANC TO BE RESET TO A * 86120000 * /* PREVIOUS BLOCK OF CORE. IF SO, UPDATE AANC TO POINT TO THE * 86130000 * /* BEGINNING OF THE LAST BLOCK OF CORE GOTTEN. AANC COULD GET * 86140000 * /* RESET TO THE PREVIOUS BLOCK, IF THE PREVIOUD DATANAME * 86150000 * /* QUALIFIER SCAN CAUSED A NEW BLOCK OF CORE TO BE OBTAINED FOR * 86160000 * /* THE PDE'S ASSOCIATED WITH THE QUALIF- FIERS OF THE DATA NAME. * 86170000 * /* IF A SUBSEQUENT ERROR OCCURED TANC WOULD HAVE BEEN RESET TO * 86180000 * /* AANC. SINCE AANC WAS LEFT WHERE THE FIRST QUALIFIER WAS ADDED,* 86190000 * /* AANC WOULD REMAIN POINTING INTO THE FIRST BLOCK OF CORE. * 86200000 * /* * 86210000 * /***************************************************************** 86220000 * 86230000 * IF TANC=>ENDANC-240 /* TWO CHECKS ARE NECESSARY * 86240000 * THEN /* TO ENSURE AANC LIES WITHIN * 86250000 LH @F,@D9 1683 86260000 A @F,580(0,@B) 1683 86270000 C @F,572(0,@B) 1683 86280000 BC 02,@95E 1683 86290000 * DO; /* THE PRESENT CORE BLOCK * 86300000 * 86310000 * /************************************************************* 86320000 * /* * 86330000 * /* IF AANC IS EQUAL TO OR GREATER THAN THE BEGINNING OF THE * 86340000 * /* CORE BLOCK ADDRESS AND LESS THAN THE ENDING ADDRESS, IT * 86350000 * /* LIES WITHIN THE PRESENT CORE BLOCK. * 86360000 * /* * 86370000 * /************************************************************* 86380000 * 86390000 * IF TANCENDINPUT /* OFF EOB * 88250000 * THEN /* IF SO, TRY * 88260000 C @4,144(0,@B) 1722 88270000 BC 04,@95B 1722 88280000 * DO; /* TO POP STACK * 88290000 * ADDCDE=5; /* IF +4, SKIPB IN THE BUFFER * 88300000 LA @F,5 1724 88310000 * CALL LINKRET; /* IF NOTHING ELSE IN BUFFER * 88320000 BAL @E,LINKRET 1725 88330000 * GOTO RESTORE; /* RETURN +0 * 88340000 BC 15,RESTORE 1726 88350000 * GOREG=LINK2; /* IF +4 - MORE DATA - RTRN * 88360000 LR @E,@9 1727 88370000 * GOREG=GOREG+8; /* +8 TO INDICATE STACK WAS * 88380000 AH @E,@D10 1728 88390000 * RETURN; /* POPPED ( SEPARATOR FOLLOWED * 88400000 BC 15,@EL09 1729 88410000 * END; /* END EOB PROCESSING * 88420000 * IF COMBUF=';' /* IF XINPUT POINTS AT A * 88430000 * THEN /* SEMICOLON, WE ARE ALSO AT * 88440000 @95B CLI 0(@4),C';' 1731 88450000 BC 07,@95A 1731 88460000 * DO; /* THE END OF OUR BUFFER * 88470000 * R4=R4-1; /* DECREMENT FOR INCREMENT * 88480000 BCTR @4,0 1733 88490000 * GOTO RESTORE; /* AT RESTORE * 88500000 BC 15,RESTORE 1734 88510000 * END; /* END SEMICOLON PROCESS * 88520000 * GOREG=LINK2; /* RESTORE CALLERS RETURN ADDRESS* 88530000 @95A LR @E,@9 1736 88540000 * GOREG=GOREG+4; /* INDICATE MORE DATA IN BUFFER 88550000 * BY RETURNING ON + 4 * 88560000 AH @E,@D11 1737 88570000 * RETURN; /* RETURN TO CALLER * 88580000 BC 15,@EL09 1738 88590000 * 88600000 * RESTORE: 88610000 * R4=R4+1; /* INCREMENT SO WON'T CATCH 88620000 * LAST CHAR IN BUFFER * 88630000 RESTORE AH @4,@D2 1739 88640000 * GOREG=LINK2; /* RESTORE CALLER'S RETURN AD- * 88650000 LR @E,@9 1740 88660000 * RETURN; /* DRESS, RETURN ON A +0 * 88670000 * END BUMP; /* TO INDICATE N OMORE DATA * 88680000 @EL09 BCR 15,@E 1742 88690000 * 88700000 * /***************************************************************** 88710000 * /* THIS INTERNAL SUBROUTINE DOES RANGE PROCESSING. IF XINPUT * 88720000 * /* IS POINTING AT THE END OF THE BUFFER, NO TEST OF THE CHAR * 88730000 * /* IS MADE BUT THE RANGE SWITCHES ARE SET CORRECTLY. IF NOT * 88740000 * /* AT EOB, THE RANGE ROUTINE IN IKJPARS IS ENTERED TO TEST THE * 88750000 * /* INPUT CHARACTER AND SET THE RANGE SWITCHES CORRECTLY. RETURN * 88760000 * /* TO THE CALLER IS ON RETURN REGISTER +0 OR +4 DEPENDING ON THE * 88770000 * /* RETURN FROM THE RANGE PROCESSOR IN IKJPARS. * 88780000 * /***************************************************************** 88790000 * 88800000 * TSTRNGE: /* RANGE TESTING A00996 * 88810000 * PROC OPTIONS(DONTSAVE,NOSAVEAREA); /* INTERNAL SUBROUTINE A00996 * 88820000 * RESTRICT (R4,R5,R6); /* MUST RESTRICT A00996 * 88830000 * RESTRICT (PWAREG,LINK2); /* CRITICAL REGISTERS A00996 * 88840000 * LINK2=GOREG; /* SAVE THE CALLERS A00996 88850000 * RETURN REGISTER A00996 * 88860000 TSTRNGE LR @9,@E 1746 88870000 * IF R4=>ENDINPUT /* IF AT END OF BUFFER A00996 * 88880000 * THEN /* MUST TEST RANGE SWITCH A00996 * 88890000 C @4,144(0,@B) 1747 88900000 BC 04,@959 1747 88910000 * DO; /* ES TO SET CORRECTLY A00996 * 88920000 * IF RNGEVAL1='1'B /* IF FIRST VALUE OF RANGEA00996 * 88930000 * THEN /* PROCESSED, MUST INDI- A00996 * 88940000 TM 177(@B),B'01000000' 1749 88950000 BC 12,@958 1749 88960000 * DO; /* SECOND RANGE VALUE A00996 * 88970000 * RNGEVAL1='0'B; /* SCAN COMPLETED. A00996 * 88980000 NI 177(@B),B'10111111' 1751 88990000 * RNGEVAL2='1'B; /* SET SECOND RANGE A00996 * 89000000 OI 177(@B),B'00001000' 1752 89010000 * END; /* SWITCH ON A00996 * 89020000 * GOREG=LINK2; /* IF NOT RANGE VALUE BUT A00996 * 89030000 @958 LR @E,@9 1754 89040000 * RETURN; /* END OF BUFFER, RETURN A00996 * 89050000 BC 15,@EL10 1755 89060000 * END; /* +0 TO INDICATE NO A00996 89070000 * RANGE OR 2ND VALUE A00996 * 89080000 * ADDCDE=6; /* IF NOT EOB, MSUT GO TO A00996 * 89090000 @959 LA @F,6 1757 89100000 * CALL LINKRET; /* THE RANGE PROCESSOR IN A00996 89110000 * IKJPARS TO TEST THE A00996 89120000 * INPUT CHAR AND SET A00996 89130000 * SWITCHES ACCORDINGLY A00996 * 89140000 BAL @E,LINKRET 1758 89150000 * GOTO ZERORNG; /* IF +0 RETURN, NO RANGE A00996 89160000 * OR 2ND VALUE - RETURN A00996 89170000 * +0 TO CALLER A00996 * 89180000 BC 15,ZERORNG 1759 89190000 * GOREG=LINK2; /* IF +4 RETURN, FIRST A00996 * 89200000 LR @E,@9 1760 89210000 * GOREG=GOREG+4; /* VALUE OF RANGE ENCOUN- A00996 * 89220000 AH @E,@D11 1761 89230000 * RETURN; /* TERED - RETURN TO A00996 89240000 * CALLER +4 A00996 * 89250000 BC 15,@EL10 1762 89260000 * ZERORNG: /* RETURN TO CALLER +0 A00996 * 89270000 * GOREG=LINK2; /* RESTORE CALLER RETURN A00996 * 89280000 ZERORNG LR @E,@9 1763 89290000 * RETURN; /* ADDRESS - RETURN +0 A00996 * 89300000 * END TSTRNGE; /* END THE RANGE INTERNAL A00996 89310000 * PROCEDURE A00996 * 89320000 @EL10 BCR 15,@E 1765 89330000 * ENDTERM: 89340000 * END IKJEFP60; /* END TERM PROCESSOR * 89350000 **/*CSDPARSE: CHART IKJEFP50 COMBINED WITH IKJEFP40 */ 89360000 **/* HEADER 89370000 **/*IKJEFP40 - IKJEFP50 */ 89380000 **/*IKJEFP50: E START */ 89390000 **/* P TURN ON OPER AND COBOL MODE BITS */ 89400000 **/* P ZERO OPER PROMPT BIT */ 89410000 **/* P SET OANC = AANC */ 89420000 **/* P OPERPCE = XPCE */ 89430000 **/* P PRIORPCE = XPCE */ 89440000 **/* P XPCE = TERM1 PCE ADDR */ 89450000 **/* S TERMOCK: TEST MINOR TERM1 PCE */ 89460000 **/* P XPCE = ADDR MINOR RSVWD PCE */ 89470000 **/* D (NO,RTNCLNUP,YES,) XPCE POINTS TO A RSVWD PCE */ 89480000 **/* D (YES,RTNCLNUP,NO,) FIGURATIVE CONSTANT RSVWD PCE */ 89490000 **/* D (NO,RTNCLNUP,YES,) RSVWD PCE ADDR GREATER THAN PRIORPCE */ 89500000 **/* P PRIORPCE = XPCE */ 89510000 **/* P XPCE = TERM2 PCE ADDR */ 89520000 **/* S TERMOCK: TEST MINOR TERM2 PCE */ 89530000 **/* D (NO,%ORSKP1,YES,) OPER PCE HAS A CHAINED TERM3 */ 89540000 **/* P XPCE = ADDR TERM3 PCE */ 89550000 **/* S TERMOCK: TEST MINOR TERM3 PCE */ 89560000 **/*%ORSKP1: D (YES,%PEI,NO,) PRIORPCE TERM CAN HAVE SUBSCRIPT */ 89570000 **/* P (,%PB) I = 20 */ 89580000 **/*%PEI: P I = 80 */ 89590000 **/* P PRIORPCE = PRIORPCE + PCE LENGTH */ 89600000 **/* D (YES,,NO,RTNCLNUP) PRIORPCE POINTS TO A SUBSCRIPT TERM */ 89610000 **/*%PB: P OPERLL = LAST MINOR TERM PDE ADDR +I MINUS OPER PDE ADDR */ 89620000 **/* P STORE PRIORPCE IN OPEREND */ 89630000 **/* S (+0,D1,+4,) SKIPB: +0 RETURN ON END OF INPUT */ 89640000 **/*PR: P OPERSVE = XINPUTB */ 89650000 **/* D (YES,%ABC,NO,) XINPUTB -> LEFT PAREN */ 89660000 **/* D (YES,I1,NO,OPTTERM) XINPUTB -> SEMICOLON */ 89670000 **/*%ABC: P UP XINPUT POINTER BY ONE */ 89680000 **/* P TURN OFF CHAINTRM BIT */ 89690000 **/* P XPCE = TERM1 PCE ADDR */ 89700000 **/* S (+4,,+0,F1) IKJEFP60: ADD TERM PDE */ 89710000 **/* P SAVE MSGAREA DATA IN OPERSPM */ 89720000 **/* P SET XPCE TO RSVWD PCE */ 89730000 **/* S (+4,,+0,OSPMSG) IKJEFP40: ADD RSVWD PDE */ 89740000 **/* P SET XPCE TO TERM2 PCE */ 89750000 **/* P TURN OFF PFNOPOP */ 89760000 **/* S SKIPB: RETURN TO OPER INPUT BUFFER */ 89770000 **/* S (+4,,+0,OSPMSG) IKJEFP60: ADD TERM PDE */ 89780000 **/* D (YES,,NO,%OR060) PWA FLAG PFENDSET ON */ 89790000 **/* P (,%OR070) OPERSVE = ENDBAKUP */ 89800000 **/*%OR060: P OPERSVE = XINPUT +1 */ 89810000 **/*%OR070: S (+0,A,+4,) SKIPB: SKIP SEPARATORS IN BUFFER */ 89820000 **/* D (YES,,NO,A) XINPUTB POINTS TO A RIGHT PAREN */ 89830000 **/* P SET INVPSAVE = PRMTPTR */ 89840000 **/* P (,B) XINPUT = XINPUTB */ 89850000 **/*OPTTERM: D (NO,I1,YES,) CHAINED TERM PCE EXISTS */ 89860000 **/* P SET XPCE TO CHAIN TERM PCE ADDR */ 89870000 **/* P TURN ON CHAINTRM BIT */ 89880000 **/* S (+4,B,+0,D1) IKJEFP60: ADD TERM PDE */ 89890000 **/*I1: D (YES,,NO,D1) OPER PROMPT BIT ON */ 89900000 **/* P SET INVPSAVE = OPERSVE */ 89910000 **/* P XINPUT = XINPUTB */ 89920000 **/* P (,A1I) I = 'FFFF'X */ 89930000 **/*D1: P SET XPCE = OPERPCE */ 89940000 **/* S (+0,P50PR,+4,EP) PROMPTQ: PROMPT FOR MISSING DATA */ 89950000 **/*OVCERR: P TURN ON RIGHT PAREN INDICATOR FOR SPECIAL MESSAGE */ 89960000 **/* P TURN ON LEFT PAREN INDICATOR */ 89970000 **/* P TURN ON SPECIAL MESSAGE INDICATOR */ 89980000 **/* P MOVE OPERSPM DATA INTO MSGAREA */ 89990000 **/* P (,WWW) XINPUT = XINPUT +1 */ 90000000 **/*F1: P MSGADDR = OPERSVE */ 90010000 **/* P (,F2) MSGLEN = 1 */ 90020000 **/*OSPMSG: P SET LEFT PAREN BIT ON */ 90030000 **/* P MSGAREA = OPERSPM */ 90040000 **/*F2: P SET SPECIAL MESSAGE BIT ON */ 90050000 **/* S (+0,T,+4,) SKIPB: SKIP OVER SEPARATORS */ 90060000 **/* P SET INVPSAVE = XINPUTB */ 90070000 **/* P XINPUT = XINPUTB */ 90080000 **/* P INITIALIZE PAREN COUNT TO ONE */ 90090000 **/*R: D (YES,,NO,%LPCK) INPUT CHARACTER A RIGHT PAREN */ 90100000 **/* P SUBTRACT ONE FROM PAREN COUNT */ 90110000 **/*%CZERO: D (NO,,YES,A1I) PAREN COUNT GREATER THAN ZERO */ 90120000 **/* P (,WW) XINPUT = XINPUT + 1 */ 90130000 **/*%LPCK: D (YES,,NO,%OR020) INPUT CHARACTER A LEFT PAREN */ 90140000 **/* P ADD ONE TO PAREN COUNT */ 90150000 **/*%OR020: D (YES,,NO,A1I) XINPUT POINTS TO A SEMICOLON */ 90160000 **/* D (YES,T,NO,WW) INVPSAVE - XINPUT = 0 */ 90170000 **/*A1I: P XINPUT = XINPUT +1 */ 90180000 **/* D (NO,R,YES,WW) XINPUT NOT < ENDINPUT */ 90190000 **/*T: P TURN ON BLNKFLAG */ 90200000 **/* P INVPSAVE = ADDR(BLNK) */ 90210000 **/* P (,W) XINPUTB = ADDR(BLNK) +1 */ 90220000 **/*WW: P XINPUTB = XINPUT */ 90230000 **/*W: P SET XPCE = OPERPCE */ 90240000 **/*WWW: P PPCOUNT = OPER PDE LENGTH -1 */ 90250000 **/* P CBLNKSV2 = ADDR(P50PR) */ 90260000 **/* S MSGSETUP: PROMPT */ 90270000 **/*P50PR: D (YES,%TPR,NO,) PFNULL OFF */ 90280000 **/* P (,EP) TURN OFF PFNULL */ 90290000 **/*%TPR: P (,PR) TURN ON OPER PROMPT BIT */ 90300000 **/*A: P SET CBLNKSV1 TO ADDR(B) FOR RETURN */ 90310000 **/* P PPOINTR = PRMTPTR +1 */ 90320000 **/* P XINPUTB = OPERSVE */ 90330000 **/* S PSTRIMSG: WRITE CLOSING PARENTHESIS ASSUMED MESSAGE */ 90340000 **/*B: P FILL IN THE OPER PDE */ 90350000 **/* P RESTORE XPCE FROM OPERPCE */ 90360000 **/* P TURN OFF CHAINTRM BIT */ 90370000 **/* P SET REGISTER 1 = PDE LENGTH -1 */ 90380000 **/* P PLINKSV2 = ADDR(OVCERR) */ 90390000 **/* S (NORM,,ERR,OVCERR) POSITXCB: ADD OPER PDE */ 90400000 **/*EP: P SET XPCE = OPEREND */ 90410000 **/* P (,RTNNSKP3) SET OPER MODE SWITCH OFF */ 90420000 **/*IKJEFP40: E START */ 90430000 **/* P SET RSVDRTN = LINKA */ 90440000 **/* P RSVWDSV2 = XPCE */ 90450000 **/* P ZERO RSVDPRMT SWITCH */ 90460000 **/* D (NO,,YES,RCT) XPCE -> TERM PCE */ 90470000 **/* D (NO,RTNCLNUP,YES,) XPCE -> RESERVE WORD PCE */ 90480000 **/* D (NO,RTNNSKP3,YES,) PDE ALLOCATED */ 90490000 **/* P (,EE) SET COBOL SWITCH ON */ 90500000 **/*RCT: P PLACE CHAINED RSVWD PTR IN XPCE */ 90510000 **/* D (YES,,NO,RTNCLNUP) XPCE POINTS TO A RSVWD PCE */ 90520000 **/* D (YES,RTNCLNUP,NO,) RSVWD PDE ALLOCATED */ 90530000 **/* P RSVWDSV1 = XINPUT */ 90540000 **/*EE: P RSVWDPCE = XPCE */ 90550000 **/* S (NO,A1,YES,) SKIPB: SKIP TO THE FIRST CHAR OF THE RSVWD */ 90560000 **/*E: P SET LENGTH COUNT = ZERO */ 90570000 **/* P SAVE XINPUT IN RSVWDSV1 */ 90580000 **/* P SET UP SEPARATOR MASK FOR TYPETEST */ 90590000 **/*SL: P XINPUT = XINPUT +1 */ 90600000 **/* D (YES,F,NO,) XINPUT NOT < ENDINPUT */ 90610000 **/* S (+4,OMODCK,+0,) TYPETEST: XINPUT -> SEPARATOR IF +4 */ 90620000 **/*RPTEST: D (YES,,NO,%CTEST) DOES XINPUT P0INT TO A RIGHT PAREN */ 90630000 **/* D (YES,OMODCK2,NO,) OPERMODE */ 90640000 **/* D (YES,F,NO,) SUBSMODE FLAG ON IN PWA */ 90650000 **/* D (YES,F,NO,) PFLIST FLAG ON IN PWA */ 90660000 **/*%CTEST: D (YES,,NO,%SCTEST) XINPUT POINTS TO A COLON */ 90670000 **/* D (YES,,NO,%SCTEST) RFCONST FLAG ON IN RSVWD PCE */ 90680000 **/* D (YES,F,NO,) RANG FLAG ON IN TERM PCE */ 90690000 **/*%SCTEST: D (YES,,NO,AI1) XINPUT POINTS TO A SEMICOLON */ 90700000 **/* D (YES,,NO,F) PWA RSVDPRMT FLAG ON */ 90710000 **/* D (YES,AI1,NO,) PWA OPERMODE FLAG ON */ 90720000 **/* D (NO,F2R,YES,) RSVWD LENGTH COUNT = ZERO */ 90730000 **/*AI1: P (,SL) ADD ONE TO RSVWD LENGTH COUNT */ 90740000 **/*F: D (YES,,NO,F2R) RSVWD LENGTH COUNT = 0 */ 90750000 **/* D (YES,,NO,%OR050) PWA RSVDPRMT FLAG ON */ 90760000 **/* D (YES,IPA,NO,A1I) PWA OPERMODE FLAG ON */ 90770000 **/*%OR050: P (,A1) XINPUT = XINPUT -1 */ 90780000 **/*F2R: D (YES,NOMATCH2,NO,) RSVWD LENGTH COUNT GREATER THAN 256 */ 90790000 **/* P PLENGTH = ICOUNT */ 90800000 **/* P REG1 = RSVWD LENGTH COUNT */ 90810000 **/* S GETCORE: OBTAIN TEMPORARY WORK AREA */ 90820000 **/* P PPOINTR = START OF WORK AREA = REG1 */ 90830000 **/* P COPY RSVWD INTO WORK AREA */ 90840000 **/*RTQ: S TRANSQ: TRANSLATE RSVWD COPY TO UPPER CASE */ 90850000 **/* P XINPUTB = PPOINTR */ 90860000 **/* P PPOINTR = RSVWDSV1 +1 */ 90870000 **/* P XINPUT = RSVWD LENGTH COUNT + PPOINTR */ 90880000 **/* P NAME COUNT = ZERO */ 90890000 **/*NAMECK: P UP XPCE PTR BY PCE LENGTH */ 90900000 **/* P NAME COUNT = NAME COUNT +1 */ 90910000 **/* D (YES,,NO,NOMATCH) XPCE POINTS TO IKJNAME PCE */ 90920000 **/* D (YES,,NO,NAMECK) RSVWD LENGTH = NAME LENGTH */ 90930000 **/* D (YES,,NO,NAMECK) RSVWD MATCHES NAME */ 90940000 **/* S FREECORE: FREE RSVWD COPY AREA */ 90950000 **/* D (YES,,NO,%ADDPDE) RSVWD PCE RFCONST FLAG ON */ 90960000 **/* P (,RTN4) PLACE NAME# IN PDE INDICATED BY PDEPTR */ 90970000 **/*%ADDPDE: P XINPUT = XINPUT -1 */ 90980000 **/* P RESTORE XPCE FROM RSVWDPCE */ 90990000 **/* P FILL IN THE RSVWD PDE */ 91000000 **/* P XINPUTB = XINPUT */ 91010000 **/* P INVPSAVE = PPOINTR */ 91020000 **/* P REGISTER ONE = PDE LENGTH -1 = 7 */ 91030000 **/* S POSITXCB: ADD PDE */ 91040000 **/* D (YES,RTN4,NO,RTNNSKP3) OPER MODE BIT ON */ 91050000 **/*NOMATCH: S FREECORE: FREE RSVWD COPY AREA */ 91060000 **/*NOMATCH2: D (YES,RTN0,NO,) RSVWD PCE RFCONST FLAG ON */ 91070000 **/* D (YES,IP,NO,) PWA RSVDPRMT FLAG ON */ 91080000 **/* D (YES,IP,NO,) PWA OPERMODE FLAG ON */ 91090000 **/* D (YES,IP,NO,) RSVWD PCE RPRMTI FLAG ON */ 91100000 **/* D (YES,IP,NO,) RSVWD PCE RDFLTI FLAG ON */ 91110000 **/* P XPCE = RSVWDPCE */ 91120000 **/* P (,RTNNSKP3) XINPUT = RSVWDSV1 */ 91130000 **/*IPA: P XINPUT = ENDINPUT */ 91140000 **/*IP: P INVPSAVE = RSVWDSV1 +1 */ 91150000 **/* P PPCOUNT = LENGTH OF RSVWD PDE -1 = 7 */ 91160000 **/* P RESTORE XPCE FROM RSVWDPCE */ 91170000 **/* P XINPUTB = XINPUT */ 91180000 **/* P CBLNKSV2 = ADDR(P40PR) */ 91190000 **/* S (,P40PR) MSGSETUP: PICK UP PROMPT DATA */ 91200000 **/*A1: D (YES,RTN0,NO,) RSVWD PCE RFCONST FLAG ON */ 91210000 **/* P XPCE = RSVWDPCE */ 91220000 **/* S (+0,P40PR,+4,RPQRTN4) PROMPTQ: PROMPT FOR MISSING DATA */ 91230000 **/*P40PR: D (NO,%OM1,YES,) PWA PFNULL FLAG OFF */ 91240000 **/* P (,E) SET RSVWD PROMPT BIT ON */ 91250000 **/*%OM1: P TURN PWA PFNULL FLAG OFF */ 91260000 **/*RPQRTN4: D (YES,RTNO0,NO,RTNNSKP3) PWA OPERMODE FLAG ON */ 91270000 **/*OMODCK: D (YES,,NO,F) PWA OPERMODE FLAG ON */ 91280000 **/*OMODCK2: D (NO,F,YES,) RSVWD PROMPT BIT ON */ 91290000 **/* P TURN ON PWA PFNOPOP FLAG */ 91300000 **/* S (+0,NOPRMT,+4,) SKIPB: SKIP TO END OF PROMPT BUFFER */ 91310000 **/* P (,IPA) TURN OFF PWA PFNOPOP FLAG */ 91320000 **/*NOPRMT: P TURN OFF PWA PFNOPOP FLAG */ 91330000 **/* P (,F) XINPUTB = RSVWDSV1 +1 */ 91340000 **/*RTN0: P XINPUT = RSVWDSV1 */ 91350000 **/*RTNO0: P (,RTNC) I = 0 */ 91360000 **/*RTN4: P I = 4 */ 91370000 **/*RTNC: P XPCE = RSVWDSV2 */ 91380000 **/* R RETURN ON ADDR IN CBLNKSV1 + I */ 91390000 **/*RTNCLNUP: P SET RETCODE = 24 */ 91400000 **/* S @EL01: FREE TEMP STORAGE */ 91410000 **/* R ISSUE RETURN CODE 24 - GOTO CLEANUP */ 91420000 **/*RTNNSKP3: P TURN OFF PWA COBOLMOD FLAG */ 91430000 **/* S @EL01: FREE TEMP CORE */ 91440000 **/* R RETURN TO NAMESKP3 IN IKJEFP00 */ 91450000 **/* E FREECORE */ 91460000 **/* P GOREGSV = LINKA */ 91470000 **/* P REG0 = RSVWD LENGTH COUNT */ 91480000 **/* P REG1 = XINPUTB */ 91490000 **/* P ISSUE FREEMAIN */ 91500000 **/* P LINKA = GOREGSV */ 91510000 **/* R RETURN */ 91520000 **/* E TERMOCK */ 91530000 **/* P GOREGSV = LINKA */ 91540000 **/* D (YES,,NO,RTNCLNUP) XPCE POINTS TO TERM PCE */ 91550000 **/* D (NO,,YES,RTNCLNUP) LIST SPECIFIED IN TERM PCE */ 91560000 **/* D (NO,,YES,RTNCLNUP) RANGE SPECIFIED IN TERM PCE */ 91570000 **/* D (YES,,NO,RTNCLNUP) XPCE > PRIORPCE */ 91580000 **/* P PRIORPCE = XPCE */ 91590000 **/* P LINKA = GOREGSV */ 91600000 **/* R RETURN TO CALLER */ 91610000 **/*CSDPARSE: END */ 91620000 **/*IKJEFP60: CHART */ 91630000 **/* HEADER 91640000 **/*SEPTEMBER 24,1971 PAGE # 91650000 **/*FLOWCHART FOR TERM PCE PROCESSING 91660000 **/*PARSE SUPPORT FOR COBOL SYMBOLIC DEBUG SDD POK. */ 91670000 **/*IKJEFP6I: E BEGIN TERM PROCESSING */ 91680000 **/*INITIAL: P TURN PRMTSCAN OFF */ 91690000 **/* P TURN ON THE COBOL SWITCH (COBOLMOD) */ 91700000 **/* P TURN OFF RC16 BIT */ 91710000 **/* P SET PREVPDEL AND PFENDSET TO ZERO */ 91720000 **/* P SET PDEPTR TO THE TEMP PDE IN THE WORK AREA */ 91730000 **/*SAVELNK1: P SAVE LINK1 IN CBLNKSV1 */ 91740000 **/* P SAVE XPCE IN TERMXPCE */ 91750000 **/* S SKIPB: SKIP OVER ANY SEPARATORS */ 91760000 **/* COMMENT (1,15) LINK2 */ 91770000 **/*SKRETURN: D (+0,PROMPT01,+4,OPER) DETERMINE RETURN TYPE */ 91780000 **/*PROMPT01: S PROMPTQ0: DETERMINE IF THE PARM IS OPTIONAL */ 91790000 **/* COMMENT (1,15) LINK1 */ 91800000 **/*PROMPRN: D (+0,OPER,+4,NTRQEXIT) +4 NOTREQD +0 NEW DATA RTD */ 91810000 **/*OPER1: P TURN PRMTSCAN ON */ 91820000 **/* COMMENT (1,15) RETURN HERE */ 91830000 **/* COMMENT (2,15) DATA RTRND */ 91840000 **/* COMMENT (3,15) FRM PROMPT */ 91850000 **/*OPER: D (YES,PDESIZ,NO,CKLIST) IS THIS IN OPER MODE? */ 91860000 **/*CKLIST: S LISTT: SET UP FOR LIST PROCESSING IF NEEDED */ 91870000 **/* COMMENT (1,15) LINK1 */ 91880000 **/* D (+0,CODE4,+4,) DETERMINE RETURN TYPE */ 91890000 **/*PDESIZ: D (YES,LNGTH79,NO,) IS THE PCE SUBSCRIPT BIT ON ? */ 91900000 **/* P SET PPCOUNT = 19 */ 91910000 **/*INVPSAV: D (YES,CKBLNK,NO,INPUTUP) RANGEVAL1 ON? */ 91920000 **/*CKBLNK: P SET UP FOR SEPARATOR CHECK - '09' MASK */ 91930000 **/* S TYPETEST: */ 91940000 **/* D (YES,,NO,INVPSAV1) SEPARATOR? */ 91950000 **/* P SET ERROR BIT ON */ 91960000 **/* P SET PFNOPOP ON */ 91970000 **/* S RANGE: */ 91980000 **/* COMMENT (1,15) RETURN WILL */ 91990000 **/* COMMENT (2,15) ALWAYS BE 0 */ 92000000 **/* P XINPUT = XINPUT + 1 */ 92010000 **/* E () EXIT TO EXIT IN VARIABLE */ 92020000 **/*INPUTUP: P XINPUT = XINPUT+1 */ 92030000 **/*INVPSAV1: P INVPSAVE = XINPUT */ 92040000 **/* P PRMTPTR = XINPUT */ 92050000 **/*PCETYPE: D (STMT,STMTRTN,CNST,CONSTRTN,VAR,VARRTN,ANY,CONSTRTN) 92060000 **/*BRANCH ON THE PCE TYPE */ 92070000 **/*NEXTPCE: R EXIT TO UPDTEPCE IN VARIABLE RTN */ 92080000 **/*CODE4: R EXIT TO CODE4 IN VARIABLE RTN */ 92090000 **/*LNGTH79: P (,INVPSAV) SET PPCOUNT = 79 */ 92100000 **/*OPERTEST: E ENTRY FROM PRMT RETURN */ 92110000 **/* P XPCE = TERMXPCE */ 92120000 **/* D (NO,OPER,YES,) PFLAGS3 PFNULL ON? */ 92130000 **/* P (,NTRQEXIT) TURN OFF PFNULL */ 92140000 **/* COMMENT (1,15) NULL LINE */ 92150000 **/* COMMENT (2,15) RETURNED */ 92160000 **/*NTRQEXIT: D (YES,,NO,NEXTPCE) IS OPERMODE ON ? */ 92170000 **/* P RESTORE LINK1 FROM CBLNKSV1 */ 92180000 **/* R RETURN TO OPER ON LINK1+0 */ 92190000 **/*IKJEFP60: END END OF THIS CHART */ 92200000 **/*STATEMNT: CHART */ 92210000 **/* HEADER 92220000 **/*SEPTEMBER 24,1971 PAGE # 92230000 **/*FLOWCHART FOR STATEMENT SUBROUTINE 92240000 **/*PARSE SUPPORT FOR COBOL SYMBOLIC DEBUG SDD POK */ 92250000 **/*IKJEFP6I: E BEGIN STMT PROCESSING */ 92260000 **/* D (YES,,NO,CONT) OPERMODE BIT ON? */ 92270000 **/* D (YES,CONT,NO,) CHAINTRM BIT ON? */ 92280000 **/* R () EXIT TO CODE24 IN VARIABLE */ 92290000 **/*CONT: S TYPETEST: CHECK FOR ALPHA CHAR MASK= X'C0' (LINK1) */ 92300000 **/* D (+4,STRPGMID,+0,STRINPTR) +4=ALPHA +0=NON ALPHA */ 92310000 **/*STRINPTR: P STORE XINPUT AS THE LINE # PTR IN THE PDE */ 92320000 **/* S TYPETEST: CHECK FOR A NUMERIC MASK= X'10' (LINK1) */ 92330000 **/*NUMCK1: D (+4,ADDCTR1,+0,) +4=NUMERIC +0=NON NUMERIC */ 92340000 **/*MAXLNGTH: D (YES,SEPSCAN,NO,) IS DIGITCT > 6 ? */ 92350000 **/* D (YES,LISTEST,NO,) XINPUT = INVPSAVE ?*/ 92360000 **/* D (YES,SEPSCAN,NO,) XINPUT = LINE # PTR IN THE PDE ? */ 92370000 **/*STRLINSZ: P STORE DIGITCT AS THE LINE SIZE IN THE PDE */ 92380000 **/* P ZERO DIGITCT */ 92390000 **/* D (YES,BUMP1,NO,RANGECK) IS THIS A PERIOD ? */ 92400000 **/*RANGECK: S RANGE: SET UP RANGE PROCESSING IF PRESENT (LINK1)*/ 92410000 **/* D (+0,,+4,COMPDE01) DETERMINE RETURN TYPE */ 92420000 **/* D (YES,SEPSCAN,NO,) IS RANGVAL1 BIT ON ? */ 92430000 **/* D (YES,COMPDE01,NO,SEPCK01) IS RANGVAL2 BIT ON ? */ 92440000 **/*STRPGMID: P STORE XINPUT AS THE PGM ID PTR IN THE PDE */ 92450000 **/*ADDCTR2: P ADD ONE TO DIGITCT */ 92460000 **/* P XINPUT = XINPUT+1 */ 92470000 **/* D (YES,ERREXIT,NO,) IS THIS A ; ? */ 92480000 **/* D (YES,ERREXIT,NO,) XINPUT = ENDINPUT ? */ 92490000 **/* S TYPETEST: CHECK FOR ALPHAMERIC MASK=X'D0' LINK1 */ 92500000 **/* D (+4,ADDCTR2,+0,) +4 = ALPHAMERIC +0=NON ALPHAMERIC */ 92510000 **/* D (YES,SEPSCAN,NO,) IS DIGITCT > 8 ? */ 92520000 **/* D (YES,,NO,SEPSCAN) IS THIS A PERIOD ? */ 92530000 **/* P STORE DIGITCT AS THE PGM ID LENGTH IN THE PDE */ 92540000 **/* P ZERO DIGITCT */ 92550000 **/* P XINPUT = XINPUT+1 */ 92560000 **/* D (YES,ERREXIT,NO,) IS THIS A ; ? */ 92570000 **/* D (YES,ERREXIT,NO,STRINPTR) DOES XINPUT = ENDINPUT ? */ 92580000 **/*ADDCTR1: P ADD ONE TO DIGITCT */ 92590000 **/* P XINPUT = XINPUT+1 */ 92600000 **/* D (YES,MAXLNGTH,NO,) XINPUT = ENDINPUT ? */ 92610000 **/* D (YES,MAXLNGTH,NO,NUMCK1) IS THIS A ; ? */ 92620000 **/*BUMP1: P XINPUT = XINPUT+1 */ 92630000 **/* D (YES,ERREXIT,NO,) IS THIS A ; ? */ 92640000 **/* D (YES,ERREXIT,NO,) XINPUT = ENDINPUT ? */ 92650000 **/* S TYPETEST: CHECK FOR NUMERIC MASK= X'10' (LINK1)*/ 92660000 **/* D (+4,,+0,SEPSCAN) +4=NUMERIC +0=NON NUMERIC */ 92670000 **/* P PDE VERB PTR = XINPUT ; PDE VERB LENGTH = 1 */ 92680000 **/* P (,RANGECK) XINPUT = XINPUT+1 */ 92690000 **/*SEPSCAN: S TYPETEST: CHECK FOR A SEPARATOR MASK= X'09' (LINK1)*/ 92700000 **/* D (+4,SEPFOUND,+0,) +4=SEPARATOR +0=NON SEP */ 92710000 **/* D (YES,SEPFOUND,NO,) DOES XINPUT = ENDINPUT */ 92720000 **/* D (YES,SEPFOUND,NO,) IS THIS A ; ? */ 92730000 **/* P (,SEPSCAN) XINPUT=XINPUT+1 */ 92740000 **/*SEPFOUND: P XINPUTB = XINPUT */ 92750000 **/* D (YES,,NO,ERREXIT) IS PFLIST BIT ON ? */ 92760000 **/* D (YES,,NO,ERREXIT) IS XINPUT-1 = ) ? */ 92770000 **/* P (,ERREXIT) XINPUTB = XINPUTB-1 */ 92780000 **/*ERREXIT: P SET DIGITCT TO ZERO */ 92790000 **/* S CODE4B: PROMPT THRU CODE4B RTN IN VARIABLE */ 92800000 **/* R () EXIT TO CODE4B */ 92810000 **/*COMPDE01: P SET PARM BIT IN PDE ; SET STMT BIT IN PDE*/ 92820000 **/* P R1 = PPCOUNT */ 92830000 **/* P PPOINTR = INVPSAVE */ 92840000 **/* P PLENGTH = XINPUT - PPOINTR */ 92850000 **/* S TRANSQ: VIA R15 XLATE TO UPPER CASE IF REQD (LINK1)*/ 92860000 **/* R EXIT VIA VARIABLE RTN AT EXIT1 */ 92870000 **/*SEPCK01: S TYPETEST: CHECK FOR A SEPARATOR MASK= X'09' (LINK1)*/ 92880000 **/* D (+4,COMPDE01,+0,) +4=SEPARATOR +0=NON SEP */ 92890000 **/* D (YES,COMPDE01,NO,) IS THIS A ; ? */ 92900000 **/* D (YES,COMPDE01,NO,) DOES XINPUT = ENDINPUT ? */ 92910000 **/*PARNTEST: D (YES,,NO,SEPSCAN) IS THIS CHARACTER A ) ? */ 92920000 **/* D (YES,,NO,SEPSCAN) IS THIS A LIST ? */ 92930000 **/* P (,COMPDE01) XINPUT = XINPUT-1 */ 92940000 **/* E BEGIN BUMP */ 92950000 **/* P XINPUT = XINPUT+1 */ 92960000 **/* D (YES,POPSTACK,NO,RETURN) IS XINPUT => ENDINPUT ? */ 92970000 **/*PTRBUMP: P SET XINPUT = XINPUT+1 */ 92980000 **/*RETURN: R RETURN ON LINK2 + 4 MORE DATA */ 92990000 **/*POPSTACK: S SCANF: POP THE STACK IF MORE DATA (LINK1)*/ 93000000 **/* D (+4,PTRBUMP,+0,) +4 = MORE DATA +0 = END */ 93010000 **/* R RETURN ON LINK2 +0 NO MORE DATA */ 93020000 **/*LISTEST: D (YES,SEPSCAN,NO,) IS THE PFLIST BIT ON ? */ 93030000 **/* D (YES,SEPSCAN,NO,) IS THE RANGVAL1 BIT ON ? */ 93040000 **/*PROMPT05: R EXIT TO PROMPT05 IN CONSTANT RTN */ 93050000 **/*STATEMNT: END END OF THIS CHART */ 93060000 **/*CONSTANT: CHART */ 93070000 **/* HEADER 93080000 **/*SEPTEMBER 24,1971 PAGE # 93090000 **/*FLOWCHART FOR CONSTANT PROCESSING 93100000 **/*PARSE SUPPORT FOR COBOL DEBUG SDD POK */ 93110000 **/*IKJEFP6C: E BEGIN CONSTANT PROCESSING */ 93120000 **/*SUBTEST: D (YES,CBUMP01,NO,) IS SUBSMODE BIT ON ? */ 93130000 **/*STPDEPTR: P SET PDEPTR TO THE TEMP PDE IN WORK AREA */ 93140000 **/* P (,ENDTEST) PRMTPTR=XINPUT; */ 93150000 **/*ALPHATST: S TYPETEST: CHECK FOR ALPHA MASK='C0' (LINK1)*/ 93160000 **/* D (+4,RSVWDPC,+0,) +4=ALPHA +0=NON ALPHA */ 93170000 **/*CHKQUOT: D (YES,QSTRING1,NO,) IS THE FIRST CHARACTER A QUOTE ? */ 93180000 **/* D (YES,SETMINUS,NO,SETPLUS) IS THE FIRST CHARACTER A - ? */ 93190000 **/*SUBTEST1: D (YES,CODE4,NO,) IS THIS SUBSMODE? */ 93200000 **/*PCEUPDTE: P UPDATE TO NEXT PCE */ 93210000 **/* P TURN COBOLMOD SWITCH OFF */ 93220000 **/* R () EXIT TO NEXTPCE ROUTINE */ 93230000 **/*SETPLUS: P SET THE PLUS INDICATOR IN THE PDE */ 93240000 **/* D (YES,CBUMP02,NO,) IS THE FIRST CHARACTER A + ? */ 93250000 **/*PERIODCK: D (YES,PPDSCAN,NO,) IS THIS CHARACTER A PERIOD ? */ 93260000 **/* S TYPETEST: CHECK FOR NUMERIC MASK= X'10' (LINK1)*/ 93270000 **/* D (+4,PREPDSCN,+0,) +4=NUMERIC +0=NON NUMERIC */ 93280000 **/*ZERTEMP: D (YES,CODE4,NO,) 'CONST' BIT ON IN PDE ? */ 93290000 **/* P ZERO THE TEMP PDE POINTED TO BY PDEPTR */ 93300000 **/*PARMTEST: D (YES,GOTOVAR,NO,PROMPT05) IS THE PARAMETER TYPE ANY? */ 93310000 **/*PROMPT05: D (YES,CODE4,NO,) IS THE PFLIST BIT ON ? */ 93320000 **/* D (YES,CODE4,NO,) IS SUBSMODE BIT ON ? */ 93330000 **/* D (NO,CODE4,YES,) DOES XINPUT = INVPSAVE? */ 93340000 **/* D (YES,CODE4,NO,PROMPT) IS PRMTSCAN ON? */ 93350000 **/* COMMENT (1,15) SCANNING A */ 93360000 **/* COMMENT (2,15) PROMPT */ 93370000 **/* COMMENT (3,15) RESPONSE? */ 93380000 **/*PROMPT: S PROMPTQ0: IS PARAMETER REQUIRED ? (LINK1)*/ 93390000 **/* D (REQ,STRPTR,NTRQ,) WAS THE CONSTANT REQUIRED ? */ 93400000 **/*NTRQEXIT: D (YES,CODE4,NO,) IS OPERMODE BIT ON ? */ 93410000 **/* P XINPUT = XINPUT-ONE */ 93420000 **/*R () EXIT TO PCEUPDTE RTN IN VARIABLE */ 93430000 **/*RSVWDPC: D (YES,,NO,PARMTEST) IS THERE A RESERVED WORD PCE ? */ 93440000 **/* P XINPUT = XINPUT-1 FOR RSVWD PROCESSING */ 93450000 **/* S RSVWD: PROCESS AS A RESERVED WORD LINK1*/ 93460000 **/* D (YES,FIGCONST,NO,) WAS THERE A RESERVED WORD ? */ 93470000 **/* P (,PARMTEST) XINPUT = XINPUT+1 */ 93480000 **/*FIGCONST: P (,DATAEND) SET THE FIGURATIVE CONSTANT BIT */ 93490000 **/*QSTRING1: S QSTRING: PROCESS AS A QUOTED STRING (LINK2) */ 93500000 **/* D (YES,,NO,CODE4) WAS THERE A VALID QSTRING ? */ 93510000 **/* D (YES,,NO,LNGTCHK) XINPUT LEFT AT ENDING QUOTE? */ 93520000 **/* P XINPUT=XINPUT+ONE */ 93530000 **/*LNGTCHK: D (YES,CODE4,NO,) WAS THE LENGTH > 120 ? */ 93540000 **/* P STORE PPOINTR AS QSTRING PTR IN THE PDE */ 93550000 **/* P STORE PLENGTH AS THE QSTRING LENGTH */ 93560000 **/* P SET NON NUMERIC LITERAL BIT IN PDE */ 93570000 **/* P SET QSTRING BIT IN THE PDE */ 93580000 **/* P XINPUTB = XINPUT USE 15 AS B REG */ 93590000 **/* S (,DATAEND) TRANSQ: TRANSLATE TO UPPER CASE IF REQD (LINK1)*/ 93600000 **/*PREPDSCN: P STORE XINPUT INTO THE PDE AS DIGIT STRING PTR */ 93610000 **/*ADDCOUNT: P ADD ONE TO DIGITCT */ 93620000 **/* P XINPUT = XINPUT+1 */ 93630000 **/* D (YES,MAXDIGIT,NO,) IS THIS A ; ? */ 93640000 **/* D (YES,MAXDIGIT,NO,) DOES XINPUT = ENDINPUT ? */ 93650000 **/* S TYPETEST: CHECK FOR NUMERIC MASK = X'10' (LINK1) */ 93660000 **/* D (+4,ADDCOUNT,+0,) +4 = NUMERIC +0 = NON NUMERIC */ 93670000 **/* D (YES,PPDSCAN,NO,) IS THIS CHARACTER A PERIOD ? */ 93680000 **/*SEPTEST: S TYPETEST: LINK1 - CHECK FOR A SEPARATOR - X'09' */ 93690000 **/* D (YES,MAXDIGIT,NO,) +4 - SEPARATOR +0 - NON SEPARATOR */ 93700000 **/*LSTCHK: D (YES,MAXDIGIT,NO,) IS THIS A ) ? */ 93710000 **/* D (YES,,NO,VARTEST) IS THIS A : */ 93720000 **/* D (YES,CODE4,NO,MAXDIGIT) IS SUBSMODE BIT ON? */ 93730000 **/*MAXDIGIT: D (YES,CODE4,NO,) IS DIGITCT > 18 ? */ 93740000 **/* P (,ENDPDE) STORE DIGITCT IN PDE ZERO DIGITCT */ 93750000 **/*VARTEST: S TYPETEST: CHECK FOR ALPHA MASK = X'C0' (LINK1)*/ 93760000 **/* D (+4,,+0,CODE4) +4 ALPHA +0 NON ALPHA */ 93770000 **/* D (YES,,NO,CODE4) TYPE = ANY ? */ 93780000 **/*GOTOVAR: P XINPUT = PRMTPTR-1, XINPUTB = PRMTPTR */ 93790000 **/* P ADD 1 TO ELEMNCT */ 93800000 **/* P ZERO THE PDE */ 93810000 **/* R EXIT TO VARIABLE */ 93820000 **/*CBUMP01: D (YES,ENDTEST,NO,) IS ERRORBIT ON? */ 93830000 **/* P PRMTPTR = XINPUT */ 93840000 **/*ENDTEST: D (YES,CODE4,NO,) DOES XINPUT = ENDINPUT ? */ 93850000 **/* D (YES,CODE4,NO,) IS THIS A ; ? */ 93860000 **/*SUBENDCK: D (YES,SETERBIT,NO,) IS THE ELEMNTCT = 3 ? */ 93870000 **/* P (,ALPHATST) PDEPTR = PDEPTR+20 UPDATE TO NEXT PDE */ 93880000 **/*SETERBIT: P SET THE ERROR BIT, SET PFNOPOP */ 93890000 **/* R () EXIT TO SUBERSCN IN VARIABLE */ 93900000 **/*SETMINUS: P SET THE MINUS SIGN INDICATOR IN THE PDE */ 93910000 **/*CBUMP02: P XINPUT = XINPUT+1 */ 93920000 **/* D (YES,CODE4,NO,) IS THIS A ; ? */ 93930000 **/* D (YES,CODE4,NO,) DOES XINPUT = ENDINPUT ? */ 93940000 **/* P (,PERIODCK) SET 'CONST' BIT IN PDE */ 93950000 **/*STRPTR: P TURN PRMTSCAN ON */ 93960000 **/* R () EXIT TO INPUTUP */ 93970000 **/* COMMENT (1,15) IN TERM */ 93980000 **/* COMMENT (2,15) INITIALIZTN */ 93990000 **/*PPDSCAN: P STORE XINPUT AS THE ADDRESS OF THE PERIOD IN THE PDE */ 94000000 **/* D (YES,CODE4,NO,) DECPT FLAG ON IN PDE ? */ 94010000 **/* P TURN ON DECPT FLAG (3RD BIT - FLAG2) */ 94020000 **/*CBUMP04: P XINPUT = XINPUT+1 */ 94030000 **/* D (YES,NUMER,NO,) NUMERIC ? */ 94040000 **/* COMMENT (1,15) TYPETEST */ 94050000 **/* COMMENT (2,15) MASK = '10' */ 94060000 **/*ETEST1: D (NO,CODE4,YES,ETEST) CAP OR SMALL E ? */ 94070000 **/*NUMER: P ADD 1 TO DIGITCT */ 94080000 **/* P XINPUT = XINPUT + 1 */ 94090000 **/* S TYPETEST: NUMERIC MASK = '10' */ 94100000 **/* D (YES,NUMER,NO,) NUMERIC ? */ 94110000 **/*ETEST: D (YES,,NO,%ENDTEST) IS THIS CHARACTER AN E ? */ 94120000 **/*EFOUND: P SET FLOATING POINT FLAG IN PDE */ 94130000 **/* D (YES,CODE4,NO,) IS THE DIGIT COUNT > 16 ? */ 94140000 **/* P STORE DIGITCT AS LNGTH-1 IN THE PDE, ZERO DIGITCT */ 94150000 **/* D (NO,CODE4,YES,) IS DEC PT FLAG ON IN TEMPPDE? */ 94160000 **/* P XINPUT = XINPUT+1 */ 94170000 **/* D (YES,CODE4,NO,) DOES XINPUT = ENDINPUT ? */ 94180000 **/* D (YES,CODE4,NO,) IS THIS A ; ? */ 94190000 **/* D (YES,MINUSEXP,NO,) IS THIS A MINUS SIGN ? */ 94200000 **/* P SET THE PLUS EXPONENT BIT IN THE PDE */ 94210000 **/* D (YES,CBUMP03,NO,) IS THIS A PLUS SIGN ? */ 94220000 **/*NUMCK: S TYPETEST: CHECK FOR NUMERIC MASK = X'10' LINK1 */ 94230000 **/* D (+4,,+0,CODE4) +4 NUMERIC, +0 NONNUMERIC */ 94240000 **/* P (,ADCT01) STORE XINPUT AS PTR TO EXPONENT (+12 - DATAPTRA) */ 94250000 **/*%ENDTEST: D (YES,,NO,SEMCHK) IS THIS A SMALL LETTER E ? */ 94260000 **/* D (YES,,NO,EFOUND) IS UPPER CASE REQD ? */ 94270000 **/* D (YES,EFOUND,NO,) IS PFDEFLT ON ? */ 94280000 **/*SEMCHK: D (YES,MAXDIGIT,NO,) DOES XINPUT POINT TO A ; ? */ 94290000 **/* D (YES,MAXDIGIT,NO,) XINPUT = ENDINPUT */ 94300000 **/* S TYPETEST: CHECK FOR NUMERIC */ 94310000 **/* D (+0,PERCHK,+4,ADDCOUNT) NUMERIC? */ 94320000 **/*PERCHK: D (YES,PPDSCAN,NO,SEPTEST) XINPUT = PERIOD */ 94330000 **/* P (,EFOUND) TRANSLATE TO UPPER CASE */ 94340000 **/*MINUSEXP: P SET THE MINUS EXPONENT BIT */ 94350000 **/*CBUMP03: P XINPUT = XINPUT+1 */ 94360000 **/* D (YES,CODE4,NO,) IS THIS A ;? */ 94370000 **/* D (YES,CODE4,NO,NUMCK) DOES XINPUT = ENDINPUT ? */ 94380000 **/*ADCT01: P ADD ONE TO THE DIGIT COUNTER */ 94390000 **/* P XINPUT = XINPUT+1 */ 94400000 **/* D (YES,VALEXP,NO,) IS THIS A ; ? */ 94410000 **/* D (YES,VALEXP,NO,) DOES XINPUT = ENDINPUT ? */ 94420000 **/* S TYPETEST: CHECK FOR NUMERIC MASK = X'10' LINK1 */ 94430000 **/* D (+4,ADCT01,+0,) +4 - NUMERIC +0 NON NUMERIC */ 94440000 **/*TSEP: S TYPETEST: LINK1 CHECK FOR SEPARATOR MASK X '09' (LINK1)*/ 94450000 **/* COMMENT (1,15) CHECK FOR */ 94460000 **/* COMMENT (2,15) DELIMITER */ 94470000 **/* D (+4,VALEXP,+0,) +4 SEPARATOR +0 NON SEPARATOR */ 94480000 **/*PARTTST: D (YES,VALEXP,NO,) IS THIS A ) ? */ 94490000 **/* D (YES,,NO,CODE4) IS THIS A : ? */ 94500000 **/* D (YES,CODE4,NO,VALEXP) IS SUBSMODE BIT ON? */ 94510000 **/*VALEXP: D (YES,CODE4,NO,) IS THE DIGIT COUNT > 2 ? */ 94520000 **/* P ADD DIGITCT AS EXP LENGTH LNGTH-2 TO PDE*/ 94530000 **/* P ZERO THE DIGITCT */ 94540000 **/*DATAEND: D (YES,ADELCT,NO,) IS SUBSMODE BIT ON? */ 94550000 **/* D (YES,LISTCK,NO,) IS THIS CHARACTER A ) ? */ 94560000 **/* S RANGE: */ 94570000 **/* D (+4,,+0,SEP) RETURN ? */ 94580000 **/* P (,PDESIZE) SET UP MSGADDR + MSGLEN FOR SPEC MSG */ 94590000 **/*SEP: S TYPETEST: CHECK FOR SEPARATOR MASK X'09' (LINK1) */ 94600000 **/* D (+4,PDESIZE,+0,TESTCOL) +4 SEPARATOR +0 NON SEPARATOR */ 94610000 **/* COMMENT (1,15) IS THIS A */ 94620000 **/* COMMENT (2,15) SEP */ 94630000 **/* COMMENT (3,15) OR EOB */ 94640000 **/*TESTCOL: D (YES,PDESIZE,NO,) IS THIS A ; ? */ 94650000 **/* D (YES,PDESIZE,NO,CODE4) DOES XINPUT = ENDINPUT? */ 94660000 **/*LISTCK: D (YES,BACKXIN,NO,) IS THE PFLIST BIT ON ? */ 94670000 **/* D (YES,PDESIZE,NO,CODE4) IS OPERMODE BIT ON? */ 94680000 **/*BACKXIN: S RANGE: GET RANGE SWITCHES SET PROPERLY */ 94690000 **/* P XINPUT = XINPUT - 1 */ 94700000 **/*PDESIZE: P (,TESTERR) TURN ON CONST AND PARM PRESENT BITS IN PDE*/ 94710000 **/*ADELCT: P ADD ONE TO ELEMNTCT */ 94720000 **/* P SET CONST AND PARM PRESENT BITS IN PDE */ 94730000 **/* P DECRIMENT XINPUT BY ONE FOR SKIPB */ 94740000 **/* S SKIPB: SKIP OVER ANY SEPARATORS LINK2 */ 94750000 **/* D (MORE,,END,ENDSUB) DETERMINE TYPE RETURN */ 94760000 **/* COMMENT (1,15) +4 - MORE DATA */ 94770000 **/* COMMENT (2,15) +0 - END OF BUFFER */ 94780000 **/* P XINPUT = XINPUT+1 */ 94790000 **/* D (YES,,NO,ENDCMDCK) IS THIS A ) ? */ 94800000 **/*SUBEXIT: R EXIT TO VSUBENDCK IN VARIABLE RTN */ 94810000 **/*ENDCMDCK: D (YES,,NO,SETPRMT) IS THIS A ; ? */ 94820000 **/* P (,ENDSUB) XINPUT = XINPUT-1 */ 94830000 **/*SETPRMT: P (,SUBENDCK) PRMTPTR = XINPUT */ 94840000 **/*ENDPDE: P (,DATAEND) SET FIXED PT LITRL BIT IN THE PDE?*/ 94850000 **/*ENDSUB: P PPOINTR = INVPSAVE */ 94860000 **/* S (,SUBEXIT) PSTRIMSG: PUT OUT ENDING ) ASSUMED MESSAGE LINK2*/ 94870000 **/*TESTERR: R GO TO EXIT IN VARIABLE ROUTINE */ 94880000 **/*CODE4: R () EXIT TO VERRBIT IN VARIABLE */ 94890000 **/*CONSTANT: END END OF THIS CHART */ 94900000 **/*VARIABLE: CHART (FMODE)*/ 94910000 **/* HEADER 94920000 **/*JANUARY 10, 1971 PAGE # 94930000 **/*FLOWCHART FOR VARIABLE SUBROUTINE 94940000 **/*PARSE SUPPORT FOR COBOL SYMBOLIC DEBUG SDD POK */ 94950000 **/*IKJEFP6V:1A1 E BEGIN VARIABLE PROCESSING */ 94960000 **/*TERMBEG:1B1 P SET VARIA BIT IN PDE */ 94970000 **/*1B2 D (YES,SCAN,NO,) SUBSMODE ON? */ 94980000 **/*1B3 D (NO,SCAN,YES,) RNGEVAL1 ON? */ 94990000 **/*1B4 P FIRSTNAM='1'B */ 95000000 **/*SCAN:1C2 P PPOINTR=XINPUT */ 95010000 **/*1C1 S GENSCAN: ALPHA ALPHAMERIC - PGMID */ 95020000 **/*1D1 D (YES,,NO,NOPGMID) RETURN AT +12? */ 95030000 **/*1D2 D (YES,,NO,NOPGMID) IS CHAR A . ? */ 95040000 **/*1D3 P PGMID PTR IN PDE = PPOINTR */ 95050000 **/*1D4 P PLENGTH = XINPUT-PPOINTR */ 95060000 **/*1D5 P PDELEN2 = PLENGTH */ 95070000 **/*1E5 D (NO,FIRSTON,NO,) SUBSMODE ON? */ 95080000 **/*1F5 P PRMTPTR = PPOINTR */ 95090000 **/*FIRSTON:1G5 D (NO,TRANS,YES,) FIRSTNAM ON? */ 95100000 **/*1H5 P MSGADDR=PPOINTR; MSGLEN = PLENGTH */ 95110000 **/*1G4 S TRANSQ: TRANSLATE PGMID TO UPPERCASE */ 95120000 **/*1E4 P SET NAMEREQD BIT ON */ 95130000 **/*1E3 P XINPUT = XINPUT+1 */ 95140000 **/*1E2 P PPOINTR =XINPUT */ 95150000 **/* COMMENT (1,15) PREPARE FOR */ 95160000 **/* COMMENT (2,15) VARIABLE SCAN */ 95170000 **/*1F2 P (,NAMSCAN) PRMTPTR=INVPSAVE */ 95180000 **/*NOPGMID:1E1 P XINPUT = PPOINTR, XINPUTB=PPOINTR */ 95190000 **/*DNAMSCAN:1F1 D (NO,,YES,NAMSCAN) ERRORBIT ON? */ 95200000 **/*1G1 P PRMTPTR = XINPUT */ 95210000 **/*NAMSCAN:1H1 S TYPETEST: ALPHAMERIC? */ 95220000 **/*1J1 D (YES,RSTPTRS,NO,) INVALID 1ST CHAR? */ 95230000 **/*LOOP:2A1 P LOOP LENGTH 1-30 */ 95240000 **/*LXINUP:2B1 P XINPUT = XINPUT +1, XINPUTB=XINPUT */ 95250000 **/*2C1 S TYPETEST: ALPHAMERIC? */ 95260000 **/*2D1 D (YES,LXINUP,NO,) VALID OTHER CHAR? */ 95270000 **/*ERRORCHA:2E1 D (YES,LXINUP,NO,) HYPHEN? */ 95280000 **/*2F1 D (YES,VERRBIT,NO,) LOOP LENGTH > 30? */ 95290000 **/*RESCAN:2A3 S TYPETEST: SEPARATOR? */ 95300000 **/*2B3 D (YES,SETPLNGH,NO,) SEPARATOR? */ 95310000 **/*TPAR:2C3 D (YES,SETPLNGH,NO,) COLON? */ 95320000 **/*2D3 D (YES,SETPLNGH,NO,) ( ? */ 95330000 **/*2E3 D (YES,SETPLNGH,NO,) ) ? */ 95340000 **/*2F3 D (YES,SETPLNGH,NO,) XINPUT => ENDINPUT? */ 95350000 **/*2G3 D (YES,SETPLNGH,NO,) ; ? */ 95360000 **/*2H3 P (,VERRBIT) XINPUT = XINPUT + 1 */ 95370000 **/*SETPLNGH:3A1 P PLENGTH = XINPUT - PPOINTR */ 95380000 **/*3A2 P XINPUT = PPOINTR */ 95390000 **/*TSTLOOP:3B2 S TYPETEST: ALPHA */ 95400000 **/*3C2 D (NO,NOTALPHA,YES,ALPHAFND) ALPHA CHAR? */ 95410000 **/*NOTALPHA:3C3 D (YES,SETERBT2,NO,) END OF ALPHA SEARCH? */ 95420000 **/*3C4 P (,TSTLOOP) XINPUT = XINPUT + 1 */ 95430000 **/*ALPHAFND:3D2 P XINPUT = XINPUTB - 1 */ 95440000 **/*3E2 D (YES,SETERBT2,NO,) LAST CHAR HYPHEN? */ 95450000 **/*3F2 D (YES,ENDSCAN,NO,) ERROR BIT ON? */ 95460000 **/*3G2 D (NO,,YES,CORETEST) QUALCT NON ZERO? */ 95470000 **/*ADDNAME:3H2 S TRANSQ: */ 95480000 **/*3H1 P PDE NAME PTR = PPOINTR */ 95490000 **/*3J1 P SET PARM PRES BIT IN PDE */ 95500000 **/*3K1 P PDE LENG-1 = PLENGTH */ 95510000 **/*3J2 P QUALIF NAME PRT = FF000000 */ 95520000 **/*3J3 P CHAINPTR = ADDR ON QUALIFIER PDE PTR */ 95530000 **/*3K3 D (NO,ENDSCAN,YES,) FIRSTNAM ON? */ 95540000 **/*3K4 P FIRSTNAM='0' */ 95550000 **/*3J4 D (NO,,YES,PGMID) NAMEREQD ON? */ 95560000 **/*3J5 P (,ENDSCAN) MSGADDR=PPOINTR, MSGLEN=PLENGTH */ 95570000 **/*PGMID:3H4 P (,ENDSCAN) MSGLEN=LENGTH OF PGMID+LENGTH OF DATANAME */ 95580000 **/*SETERBT2:3E3 P SET ERROBIT SET PFNOPOP */ 95590000 **/*ENDSCAN:3E4 P ENDNMPTR = XINPUT */ 95600000 **/* COMMENT (1,15) SAVE END OF */ 95610000 **/* COMMENT (2,15) DATA NAME */ 95620000 **/*4A1 S BUMP: BUMP XINPUT BY 1 */ 95630000 **/*4B1 D (MORE,,END,ENDCK) EOB ? */ 95640000 **/*4A2 D (YES,XINUP2,NO,) WAS STACK POPPED? */ 95650000 **/*MORDTA:4B2 S TYPETEST: SEPARATOR */ 95660000 **/*4B3 D (NO,GDDNNBL,YES,) DELIM A SEPARATOR? */ 95670000 **/* COMMENT (1,15) SEP AFTER DATA */ 95680000 **/* COMMENT (2,15) NAME - SPECIAL */ 95690000 **/* COMMENT (3,15) PROCESSING */ 95700000 **/*VSEPSKIP:4C3 S SKIPB: */ 95710000 **/*4D3 D (NO,XINUP2,YES,) END OF DATA? */ 95720000 **/*ENDCK:4E1 D (NO,RANGESET,YES,) SUBSMODE? */ 95730000 **/*4E2 R () EXIT TO ENDSUB IN CONSTANT */ 95740000 **/*RANGESET:4F1 S RANGE: GET RNGEVAL2 ON IF REQUIRED */ 95750000 **/*EXIT:4G1 D (YES,CODE4,NO,) ERROR BIT ON? */ 95760000 **/*EXITA:4H1 D (YES,,NO,ZEROQLCT) QUALCT > 256? */ 95770000 **/*4H2 P (,PRMTEXT) TURN ERROR BIT AND PFNOPOP ON */ 95780000 **/*ZEROQLCT:5A1 D (YES,SKPQLST,NO,) IS THIS CONST OR STATE PDE? */ 95790000 **/*5B1 P PDE QUALCT = QUALCT */ 95800000 **/*5C1 P ZERO QUALCT */ 95810000 **/*SETPCE:5D1 P SET PCE PTR TO MAJOR PCE */ 95820000 **/*SKPQLST:5E1 P SET PDEPTR = ADDR OF TEMPDE */ 95830000 **/*5F1 D (NO,VAREXITA,YES,) OPERMODE ON? */ 95840000 **/*5G1 D (NO,VAREXITA,YES,) PRMTSCAN ON? */ 95850000 **/*5G2 D (YES,VAREXITA,NO,) PFENDSET ON? */ 95860000 **/*5G3 P PFNOPOP = '1' */ 95870000 **/*5G4 S SKIPB: */ 95880000 **/*5H4 D (NO,VAREXITA,YES,) MORE DATA? */ 95890000 **/*5H5 P (,CODE4) ERRORBIT = '1' */ 95900000 **/*VAREXITA:5H1 P R1 = PDE LENGTH */ 95910000 **/*5J1 D (YES,CODE4,NO,) PFENDF ON? */ 95920000 **/*5K1 P (,CODE4) XINPUTB = XINPUT */ 95930000 **/*XINUP2:8A1 P XINPUT = XINPUT + 1 */ 95940000 **/*8B1 P MOVE 2 BYTES TO TRANAREA */ 95950000 **/*8B2 S TRANSQ: TRANSLATE TO UPPERCASE */ 95960000 **/*8C1 D (NO,ASIS,YES,TRANSLAT) IN OR OF? */ 95970000 **/*TRANSLAT:8D1 D (NO,XINUP3,YES,) UPPERCASE REQUESTED? */ 95980000 **/*8E1 D (YES,XINUP3,NO,) PFDEFLT ON? */ 95990000 **/*8F1 P MOVE UPPERCASE TO BUFFER */ 96000000 **/*XINUP3:8G1 P XINPUT = XINPUT + 1 */ 96010000 **/*8H1 S BUMP: INCREMENT XINPUT */ 96020000 **/*8H2 D (YES,VSEPSK1,NO,) EOB? */ 96030000 **/*BLNKTEST:8J2 S TYPETEST: SEPARATOR */ 96040000 **/*8J3 D (YES,VSEPSK1,NO,) SEPARATOR? */ 96050000 **/*ENDNAME:8J4 D (YES,,NO,RSTREXIN) PFENDSET ON? */ 96060000 **/*8H5 P XINPUT = XINPUT - 3 */ 96070000 **/*8J5 S PUSHI: PUSH IN OR OF... ON STACK */ 96080000 **/*8K5 P ENDINPUT = ENDBAKUP */ 96090000 **/* COMMENT (1,15) MUST SAVE IN.. */ 96100000 **/* COMMENT (2,15) OR OF... */ 96110000 **/*RSTREXIN:8K4 P (,ZEROQLCT) XINPUT = ENDNMPTR + 1 */ 96120000 **/*VSEPSK1:8A3 S SKIPB: */ 96130000 **/*8B3 D (YES,SETER,NO,) EOB ? */ 96140000 **/*8C3 P XINPUT = XINPUT + 1 */ 96150000 **/*8D3 P (,DNAMSCAN) SET NAMEREQD , ADD 1 TO QUALIF COUNT */ 96160000 **/*SETER:8B4 D (YES,,NO,ERROR1) PFENDSET ON? */ 96170000 **/*8B5 P XINPUT=ENDBAKUP; ENDINPUT=ENDBAKUP */ 96180000 **/*ERROR1:8C4 P TURN ON ERRORBIT AND PFNOPOP */ 96190000 **/*8C5 P (,CODE4) XINPUT=XINPUT+1*/ 96200000 **/*GDDNNBL:6A1 D (YES,SUBSCK,NO,) DELIM A ( ? */ 96210000 **/*6B1 D (YES,,NO,RHTPARCK) IS THIS A ; ? */ 96220000 **/*6B2 D (NO,RANGESET,YES,) SUBSMODE ? */ 96230000 **/*6B3 R () ENDCMDCK IN CONSTANT */ 96240000 **/*RHTPARCK:6D1 D (NO,COLONCK,YES,) IS THIS A ) ? */ 96250000 **/*6F1 D (YES,SUBENDCK,NO,) SUBSMODE ON ? */ 96260000 **/*6G1 D (YES,EXIT,NO,) OPERMODE ON ? */ 96270000 **/*6H1 D (YES,VRNGCK1,NO,VERRBIT) PFLIST BIT ON ? */ 96280000 **/*COLONCK:6D2 D (YES,VRNGCK1,NO,VERRBIT) IS THIS A : ? */ 96290000 **/*SUBSCK:7A1 D (YES,SKIPBL2,NO,) PCE SUBSCRIPTABLE ? */ 96300000 **/*7A2 P (,XINUP) TURN ON ERRORBIT AND PFNOPOP*/ 96310000 **/*SKIPBL2:7B1 S SKIPB: */ 96320000 **/*7C1 D (YES,,NO,XINUP4) EOB ? */ 96330000 **/*SETERR:7C2 P (,VRNGCK1) SET ERRORBIT - PFNOPOP */ 96340000 **/*7C3 P (,VRNGCK1) XINPUT=XINPUT + ONE */ 96350000 **/*XINUP4:7D1 P XINPUT = XINPUT + 1 */ 96360000 **/*7D2 D (YES,SUBSCRPT,NO,) CHAINTRM BIT ON? */ 96370000 **/*7E1 D (YES,,NO,NOERROR1) ERRORBIT ON? */ 96380000 **/*7E2 P (,SUBERSCN) TURN SUBSMODE ON */ 96390000 **/*NOERROR1:7F1 P ADD QUALIFIER COUNT TO PDE */ 96400000 **/*7G1 P ZERO QUALCT */ 96410000 **/*7H1 P (,SUBSCRPT) TURN NAMEREQD OFF */ 96420000 **/*RSTPTRS:18A1 P XINPUT = PPOINTR, XINPUTB = PPOINTR */ 96430000 **/*18A2 D (NO,FIRSTMIS,YES,) PRMPTSCAN ON? */ 96440000 **/*18B2 D (YES,INVALPRM,NO,VERRBIT) OPERMODE ? */ 96450000 **/*FIRSTMIS:18A3 D (YES,VERRBIT,NO,) NAMEREQD BIT ON ? */ 96460000 **/*18B3 D (YES,VERRBIT,NO,) OPERMOD BIT ON? */ 96470000 **/*18C3 D (YES,VERRBIT,NO,) PFLIST BIT ON? */ 96480000 **/*18D3 D (YES,VERRBIT,NO,) RNGEVAL1 ON? */ 96490000 **/*18E3 D (YES,VERRBIT,NO,) SUBSMODE ON? */ 96500000 **/*18F3 P TURN PRMTSCAN ON */ 96510000 **/*18G3 P XINPUT = XINPUT -1 */ 96520000 **/*18H3 S PROMPTQ0: PROMT FOR MISSING PARM */ 96530000 **/*18J3 D (NO,UPDTEPCE,YES,) PARM REQUIRED? */ 96540000 **/*18K3 R () INVPSAVE IN TERM INIT */ 96550000 **/*CORETEST:19A2 D (YES,GETCORE,NO,) TANC = ENDANC? */ 96560000 **/*19B2 D (YES,,NO,NEWBLOCK) AANC => ENDANC-240? */ 96570000 **/*19C2 D (YES,ADDQUALI,NO,) IS AANC < ENDANC? */ 96580000 **/*NEWBLOCK:19D2 P AANC = ENDANC-240 */ 96590000 **/*19E2 D (NO,TEQUALSA,YES,) OANC = TANC? */ 96600000 **/*19F2 P OANC = AANC */ 96610000 **/*TEQUALSA:19G2 P (,ADDQUALI) SET TANC = AANC */ 96620000 **/*GETCORE:19A3 S STALOC: 248 BYTE R1 */ 96630000 **/*19B3 D (YES,,NO,SETANCS) AANC=0 */ 96640000 **/*19C3 P SET OANC = R1+8 */ 96650000 **/*19D3 P AANC = R1 + 8 */ 96660000 **/*SETANCS:19E3 P TANC = R1 + 8 ,ENDANC = R1 + 248 */ 96670000 **/*ADDQUALI:19B1 P ZERO 12 BYTES FROM TANC */ 96680000 **/*19C1 S TRANSQ: TRANSLATE NAME */ 96690000 **/*19D1 P PDE DATA NAME PTR = PPOINTR */ 96700000 **/*19E1 P PDE LEN-1 = PLENGTH */ 96710000 **/*19F1 P NEXT QUALIF PTR = FF000000 */ 96720000 **/*19G1 P ADDR PTD BY CHAINPTR = TANC */ 96730000 **/*19H1 P CHAINPTR = TANC+8 */ 96740000 **/*19J1 P (,ENDSCAN) TANC = TANC+12 */ 96750000 **/*ASIS:9A1 P TURN OFF NAMEREQD */ 96760000 **/*9B1 D (NO,RHTPRCK,YES,) IS THIS A ( ? */ 96770000 **/*9C1 D (YES,,NO,SKIPBL3) SUBSMODE ON? */ 96780000 **/*9C2 P (,SUBERSCN) SET ERRORBIT, PFNOPOP */ 96790000 **/*SKIPBL3:9D1 S SKIPB: */ 96800000 **/*9E1 D (NO,XINUP5,YES,) EOB ? */ 96810000 **/*9E2 D (NO,RESTXIN1,YES,) SUBSCRIPTABLE OPTION IN PCE ? */ 96820000 **/*9E3 P (,CODE4) SET ERRORBIT,PFNOPOP */ 96830000 **/*XINUP5:9F1 P XINPUT = XINPUT + 1 */ 96840000 **/*9G1 P ADD QUALIFIER COUNT OT PDE */ 96850000 **/*9H1 P ZERO ZUALCT */ 96860000 **/*9J1 D (NO,,YES,CHNCK1) SUBSCRIPTABLE OPTION IN PCE? */ 96870000 **/*RESTXIN1:9J2 P XINPUT = ENDNMPTR + 1 */ 96880000 **/*9J3 D (YES,CODE4,NO,VAREXITA) ERRORBIT ON? */ 96890000 **/*CHNCK1:9K1 D (NO,SUBSCRPT,YES,) CHAINTRM BIT ON? */ 96900000 **/*9K2 P (,RESTXIN1) STORE XINPUT IN RSVWDSV1 */ 96910000 **/*SUBSCRPT:10A1 D (NO,CKERROR,YES,) SUBSMODE BIT ON? */ 96920000 **/*10A2 P (,SUBERSCN) SET ERROBIT, PFNOPOP */ 96930000 **/*CKERROR:10B1 D (YES,SUBERSCN,NO,) ERRORBIT ON? */ 96940000 **/*10C1 P SET SUBSMODE ON */ 96950000 **/*10D1 P UPDATE PCE TO SUBSCRIPT PCE */ 96960000 **/*10E1 D (NO,CLNUPEXT,YES,) IS THIS A TERM PCE? */ 96970000 **/*10F1 D (NO,CLNUPEXT,YES,) IS THIS A SUBSCRIPT PCE? */ 96980000 **/*10G1 D (YES,,NO,ELCHECK) IS PARM TYPE STATEMENT? */ 96990000 **/*CLNUPEXT:10F2 R () EXIT RTNCLNUP IN OPER */ 97000000 **/*RHTPRCK:11A1 D (YES,SUBCTRL2,NO,SUBCTRL1) IS THIS A ) ? */ 97010000 **/*SUBCTRL2:11B1 D (YES,SUBENDCK,NO,) SUBSMODE ON? */ 97020000 **/*11C1 D (YES,EXIT,NO,) OPERMODE? */ 97030000 **/*11D1 D (YES,EXIT,NO,VERRBIT) PFLIST ON? */ 97040000 **/*SUBCTRL1:11A3 D (NO,,YES,ADDQLCT) SUBSMODE ON? */ 97050000 **/*11A4 P (,VRNGCK1) XINPUT = ENDNMPTR + 1 */ 97060000 **/*ADDQLCT:11B3 P PDE QUAL CT = QUALCT */ 97070000 **/*11C3 P ZERO QLCOUNT */ 97080000 **/*11D3 P SET NAME REQD BIT */ 97090000 **/*ELCHECK:11E3 D (YES,ERROR4,NO,) ELEM CT = 3? */ 97100000 **/*11F3 D (YES,UPELMCT,NO,) PCE PARM TYPE VARIABLE? */ 97110000 **/*11F4 R () EXIT TO CONSTANT SUBSMODE */ 97120000 **/*UPELMCT:11G3 P ADD ON TO ELEMNTCT */ 97130000 **/*11H3 P (,TERMBEG) PDEPTR = PDETPR+20 */ 97140000 **/*ERROR4:11E4 P (,SUBERSCN) SET ERROBIT + PFNOPOP */ 97150000 **/*SUBERSCN:12A1 D (YES,SUBENDCK,NO,) IS THIS A )? */ 97160000 **/*12B1 S BUMP: */ 97170000 **/*12C1 D (+0,VRNGCK1,+4,SUBERSCN) EOB? */ 97180000 **/*SUBENDCK:12A2 P XINPUT = XINPUT+ 1 */ 97190000 **/*12A3 P PDE SUBS CT = ELEMNCT */ 97200000 **/* COMMENT (1,15) IN PDE BASED */ 97210000 **/* COMMENT (2,15) ON TEMPDE */ 97220000 **/*12B3 P RESET ELEMNCT TO 0 */ 97230000 **/*12C3 P NAMEREQD BIT OFF */ 97240000 **/*VRNGCK1:12D3 S RANGE: CHECK FOR RANGE */ 97250000 **/*12E3 D (+4,VALRANGE,+0,) RETURN */ 97260000 **/*12F3 D (NO,EXIT,YES,) RNGEVAL1 ON? */ 97270000 **/*RANGERR:12F4 P SET ERRORBIT AND PFNOPOP */ 97280000 **/*12F5 R () INVPSAVE IN TERM INIT */ 97290000 **/*VALRANGE:12E2 D (NO,EXITA,YES,TERMBEG) IS ERRORBIT ON? */ 97300000 **/*VERRBIT:13A1 P TURN ON ERRORBIT AND PFNOPOP */ 97310000 **/*13A2 D (YES,SUBERSCN,NO,) SUBSMODE ON? */ 97320000 **/*SEPTEST:13A3 S TYPETEST: SEPARATOR */ 97330000 **/*13B3 D (YES,,NO,RTPARCK2) SEPARATOR? */ 97340000 **/*13B4 P (,ENDSCAN) XINPUT = XINPUT - 1 */ 97350000 **/*RTPARCK2:13C3 D (YES,,NO,EOBCK) RIGHT PAREN? */ 97360000 **/*13C4 D (YES,XINUP6,NO,) PFLIST ON? */ 97370000 **/*13D4 D (YES,,NO,XINUP) OPERMODE ON? */ 97380000 **/*XINUP6:13C5 P XINPUT = XINPUT + 1 */ 97390000 **/*13D5 S TYPETEST: SEPARATOR */ 97400000 **/*13E5 D (YES,XINBACK,NO,) SEPARATOR? */ 97410000 **/*13F5 D (YES,XINBACK,NO,) ENDINPUT? */ 97420000 **/*13G5 D (YES,XINBACK,NO,XINUP) ; ? */ 97430000 **/*XINBACK:13F4 P (,CODE4) XINPUT = XINPUT - 1 */ 97440000 **/*EOBCK:13D3 D (YES,CODE4,NO,) ENDINPUT? */ 97450000 **/*13E3 D (YES,CODE4,NO,) ; ? */ 97460000 **/*13F3 D (NO,COLCK1,YES,) LFT PAREN? */ 97470000 **/*13F2 D (NO,XINUP,YES,) PCE SUBSCRIPTABLE? */ 97480000 **/*13F1 P (,SUBERSCN) TURN ON SUBSMODE */ 97490000 **/*COLCK1:13G3 D (YES,,NO,XINUP) COLON? */ 97500000 **/*RANGE:13H3 S RANGE: */ 97510000 **/*13J3 D (+4,,+0,ERRST) RETURN? */ 97520000 **/*13J4 R () INVPSAVE IN TERM INIT */ 97530000 **/*ERRST:13K3 P SET ERRORBIT AND PFNOPOP */ 97540000 **/*XINUP:13G2 P (,SEPTEST) XINPUT = XINPUT + 1 */ 97550000 **/*CODE4:14A2 D (NO,NOSUBS,YES,) SUBSMODE ON? */ 97560000 **/*14A3 P (,PRMTEXT) RESET PDE PTR TO TEMPDE */ 97570000 **/*NOSUBS:14B2 P SET PCE PTR TO MAJ PCE */ 97580000 **/*PRMTEXT:14C2 P SET DIGIT CTR TO 0 */ 97590000 **/*14D2 D (YES,RTNTEST,NO,) PARM TYPE STATEMENT? */ 97600000 **/*14E2 D (NO,TEMPPDE,YES,) RNGEVAL2 ON? */ 97610000 **/*14F2 D (NO,PERMPDE,YES,) PFLIST ON? */ 97620000 **/*14G2 D (YES,PERMPDE,NO,) PREVPDEL 0 ? */ 97630000 **/*14G1 P (,SPECMSG3) PDEPTR = ADDR PTD TO BY PREVPDEL */ 97640000 **/*PERMPDE:14H2 P (,PRMTEST) SET PDE PTR TO PERMPDE */ 97650000 **/*TEMPPDE:14E3 D (NO,OPERTST,YES,) TEMPPDE HAVE VARIA FLAG SET? */ 97660000 **/*PRMTEST:14F3 D (NO,SPECMSG3,YES,SETMSGLN) INVPSAVE = PRMTPTR? */ 97670000 **/*OPERTST:14E4 D (NO,RTNTEST,YES,) OPERMODE? */ 97680000 **/*SETMSGLN:14F4 P MSGLEN = XINPUT - INVPSAVE */ 97690000 **/*14G4 P (,RTNTEST) MSGADDR = INVPSAVE */ 97700000 **/*SPECMSG3:15A1 P SET SPECMSG BIT */ 97710000 **/*15B1 P INVPSAVE = PRMTPTR */ 97720000 **/*15B2 D (YES,YESPGMID,NO,) PGMID IN PDE? */ 97730000 **/*15B3 P MSGAREA LL = PDELEN-1 */ 97740000 **/*15C3 P (,RTNTEST) MSGAREA ADDR = PDE NAME PTR */ 97750000 **/*YESPGMID:15C2 P MSGAREA LL = L1 + L2 */ 97760000 **/*15D2 P MSGAREA NAME = PGMID PTR */ 97770000 **/*RTNTEST:15F2 D (YES,,NO,ADDPDE) ERRORBIT ON? */ 97780000 **/*CODE4A:15G2 D (NO,CODE4B,YES,) OPERMODE BIT ON? */ 97790000 **/*15G3 D (YES,INVALPRM,NO,CODE4B) PFPDDATA ON? */ 97800000 **/*INVALPRM:15G4 P XINPUT = ENDINPUT */ 97810000 **/*CODE4B:15H2 P XINPUTB = XINPUT */ 97820000 **/*15H3 P TURN OFF ERRORBIT, NAMEREQD, PFNOPOP */ 97830000 **/*15H4 P QUALCT = 0, ELEMENCT = 0, SUBSMODE = 0 */ 97840000 **/*15J4 P CBLNKSV2 = ADDR(OPERTEST) */ 97850000 **/*15K4 S MSGSETUP: WRITE OUT MESSAGE PROMPT */ 97860000 **/*15K5 R () EXIT TO MSGSETUP RTN */ 97870000 **/*ADDPDE:16A1 P SET PCE PTR TO MAJOR PCE */ 97880000 **/*16B1 P PLINKSV2 = ADDR (CODE4C) */ 97890000 **/*16B2 P SUBSMODE = 0, ELEMNTCT = 0 */ 97900000 **/*16C1 S POSITXCB: ADD PDE TO PDL */ 97910000 **/*16D1 D (+4,VALSUBCK,+0,SPECOFF) RETURN? */ 97920000 **/*VALSUBCK:16D2 P TURN OFF SPECMSG BIT */ 97930000 **/*16D3 P (,SUBSCRPT) XINPUT = RSVWDSV1 */ 97940000 **/*SPECOFF:16E1 P TURN OFF SPECMSG BIT */ 97950000 **/*16F1 D (YES,GOBACK,NO,) RNGEVAL1 ON? */ 97960000 **/*16G1 P AANC = TANC, PFENDSET = 0 */ 97970000 **/*16H1 D (NO,LISTEST,YES,) OPERMODE? */ 97980000 **/*16J1 P RESTORE LINK2 */ 97990000 **/*16K1 P XINPUT = XINPUT-1 */ 98000000 **/*16K2 R () RETURN + 4 */ 98010000 **/*LISTEST:16H2 D (YES,SKIPBL5,NO,) PFLIST ON? */ 98020000 **/*END:17A1 D (YES,POPSTACK,NO,) XINPUT = EOB? */ 98030000 **/*17B1 D (NO,POPSTACK,YES,) XINPUT = ; ? */ 98040000 **/*17C1 P XINPUT = XINPUT - 1 */ 98050000 **/*POPSTACK:17A2 S (,UPDTEPCE) SCANF: POP STACK IF POSSIBLE */ 98060000 **/*SKIPBL5:17H3 S SKIPB: */ 98070000 **/*17H4 D (YES,MISPAREN,NO,) END OF DATA? */ 98080000 **/*17H5 D (YES,MISPAREN,NO,) XINPUT + 1 = ; ? */ 98090000 **/*GOBACK:17F2 P PDEPTR = ADDR OF TEMPDE */ 98100000 **/*17F3 R () INVPSAVE TERM INIT */ 98110000 **/*MISPAREN:17J4 S PSTRIMSG: ENDING PAREN ASSUMED */ 98120000 **/*UPDTEPCE:17A3 P UPDATE PCE TO NEXT PCE */ 98130000 **/*17B3 D (NO,ENDSETOF,YES,) TERM PCE? */ 98140000 **/*17C3 D (YES,UPDTEPCE,NO,) SUBSCRIPT PCE? */ 98150000 **/*ENDSETOF:17B4 P PFENDSET = 0 */ 98160000 **/*17C4 P TURN COBOLMOD OFF */ 98170000 **/*17D4 R () NEXTPCE IN PARSE */ 98180000 **/*VARIABLE: END */ 98190000 * END IKJPARS2 /* END COBOL PROCESSOR * 98200000 * /* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. 98210000 * /*%INCLUDE SYSLIB (IKJEFPWA) 98220000 * ; 98230000 @DATA1 EQU * 98240000 @0 EQU 00 EQUATES FOR REGISTERS 0-15 98250000 @1 EQU 01 98260000 @2 EQU 02 98270000 @3 EQU 03 98280000 @4 EQU 04 98290000 @5 EQU 05 98300000 @6 EQU 06 98310000 @7 EQU 07 98320000 @8 EQU 08 98330000 @9 EQU 09 98340000 @A EQU 10 98350000 @B EQU 11 98360000 @C EQU 12 98370000 @D EQU 13 98380000 @E EQU 14 98390000 @F EQU 15 98400000 @D1 DC H'5' 98410000 @D2 DC H'1' 98420000 @D3 DC H'0' 98430000 @D4 DC H'2' 98440000 @D5 DC H'256' 98450000 @D6 DC H'30' 98460000 @D7 DC H'-1' 98470000 @D8 DC H'3' 98480000 @D9 DC H'-240' 98490000 @D10 DC H'8' 98500000 @D11 DC H'4' 98510000 @CLC CLC 0(1,@A),0(@E) 98520000 @MVC MVC 0(1,@A),0(@E) 98530000 @XC XC 0(1,@A),0(@E) 98540000 @V1 DC A(TERMOCK) 98550000 @V2 DC A(IKJEFP60) 98560000 @V3 DC A(IKJEFP40) 98570000 @V4 DC A(FREECORE) 98580000 @V5 DC A(TSTRNGE) 98590000 DS 0F 98600000 @SIZ001 DC AL1(&SPN) 98610000 DC AL3(@DATEND-@DATD) 98620000 DS 0F 98630000 @X11 DC X'0000FFFF' 98640000 @X27 DC X'FF000000' 98650000 @C28 DC C' ' 98660000 @C29 DC C'IN' 98670000 @C30 DC C'OF' 98680000 DS 0D 98690000 @DATA EQU * 98700000 R0 EQU 00000000 FULLWORD INTEGER REGISTER 98710000 R1 EQU 00000001 FULLWORD POINTER REGISTER 98720000 R2 EQU 00000002 FULLWORD INTEGER REGISTER 98730000 R3 EQU 00000003 FULLWORD INTEGER REGISTER 98740000 XINPUT EQU 00000004 FULLWORD POINTER REGISTER 98750000 XINPUTB EQU 00000005 FULLWORD POINTER REGISTER 98760000 XPCE EQU 00000006 FULLWORD POINTER REGISTER 98770000 R7 EQU 00000007 FULLWORD INTEGER REGISTER 98780000 LINK1 EQU 00000008 FULLWORD INTEGER REGISTER 98790000 INDEX EQU 00000008 FULLWORD POINTER REGISTER 98800000 LINK2 EQU 00000009 FULLWORD INTEGER REGISTER 98810000 R10 EQU 00000010 FULLWORD INTEGER REGISTER 98820000 PWAREG EQU 00000011 FULLWORD POINTER REGISTER 98830000 PWORK EQU 00000000 719 BYTE(S) ON DWORD 98840000 DUMMY1 EQU PWORK+00000000 155 BYTE(S) ON WORD 98850000 SAVE1 EQU PWORK+00000000 18*FULLWORD POINTER 98860000 ADDRSAVE EQU PWORK+00000072 4*FULLWORD POINTER 98870000 P20SAVE EQU PWORK+00000088 4*FULLWORD POINTER 98880000 INTEGER EQU PWORK+00000104 8*4 BYTE POINTER 98890000 PDWORD EQU PWORK+00000136 2*4 BYTE POINTER 98900000 PDWORD1 EQU PWORK+00000136 4 BYTE(S) 98910000 PDWORD2 EQU PWORK+00000140 4 BYTE POINTER 98920000 PDWD EQU PWORK+00000140 1 BYTE(S) 98930000 ENDINPUT EQU PWORK+00000144 FULLWORD POINTER 98940000 PPOINTR EQU PWORK+00000148 FULLWORD POINTER 98950000 PLENGTH EQU PWORK+00000152 HALFWORD INTEGER 98960000 RETCODE EQU PWORK+00000154 1 BYTE POINTER 98970000 DUMMY2 EQU PWORK+00000160 8 BYTE(S) ON DWORD 98980000 SUBRWORK EQU PWORK+00000160 2*FULLWORD POINTER 98990000 XPDL EQU PWORK+00000168 FULLWORD POINTER 99000000 TEMPSAVE EQU PWORK+00000172 FULLWORD POINTER 99010000 PFLAGS EQU PWORK+00000176 8 BIT(S) 99020000 PFLIST EQU PWORK+00000176 1 BIT(S) 99030000 PFDEFLT EQU PWORK+00000176 1 BIT(S) 99040000 PFENDF EQU PWORK+00000176 1 BIT(S) 99050000 ADREXP EQU PWORK+00000176 1 BIT(S) 99060000 HEXBIT EQU PWORK+00000176 1 BIT(S) 99070000 PFBYPAS EQU PWORK+00000176 1 BIT(S) 99080000 PFNEW EQU PWORK+00000176 1 BIT(S) 99090000 DECBIT EQU PWORK+00000176 1 BIT(S) 99100000 PFLAGS2 EQU PWORK+00000177 8 BIT(S) 99110000 PFSKPINV EQU PWORK+00000177 1 BIT(S) 99120000 RNGEVAL1 EQU PWORK+00000177 1 BIT(S) 99130000 ONERBIT EQU PWORK+00000177 1 BIT(S) 99140000 TWORBIT EQU PWORK+00000177 1 BIT(S) 99150000 RNGEVAL2 EQU PWORK+00000177 1 BIT(S) 99160000 REGBIT EQU PWORK+00000177 1 BIT(S) 99170000 FLTERBIT EQU PWORK+00000177 1 BIT(S) 99180000 BREAKBIT EQU PWORK+00000177 1 BIT(S) 99190000 PFLAGS3 EQU PWORK+00000178 8 BIT(S) 99200000 PFSTPRMT EQU PWORK+00000178 1 BIT(S) 99210000 PFONE EQU PWORK+00000178 1 BIT(S) 99220000 LOADBIT EQU PWORK+00000178 1 BIT(S) 99230000 ENTRYBIT EQU PWORK+00000178 1 BIT(S) 99240000 PFNULL EQU PWORK+00000178 1 BIT(S) 99250000 LPRNFND EQU PWORK+00000178 1 BIT(S) 99260000 PFSPACE EQU PWORK+00000178 1 BIT(S) 99270000 PFMORE EQU PWORK+00000178 1 BIT(S) 99280000 PFLAGS4 EQU PWORK+00000179 8 BIT(S) 99290000 PFENDLIM EQU PWORK+00000179 1 BIT(S) 99300000 PFLSTEND EQU PWORK+00000179 1 BIT(S) 99310000 PFVCMSG EQU PWORK+00000179 1 BIT(S) 99320000 PFPDDATA EQU PWORK+00000179 1 BIT(S) 99330000 PFSLASH EQU PWORK+00000179 1 BIT(S) 99340000 PFENDSET EQU PWORK+00000179 1 BIT(S) 99350000 PFNOPOP EQU PWORK+00000179 1 BIT(S) 99360000 CKRANGE EQU PWORK+00000179 1 BIT(S) 99370000 PFLAGS5 EQU PWORK+00000180 8 BIT(S) 99380000 PFSQSTR EQU PWORK+00000180 1 BIT(S) 99390000 INVPRMPT EQU PWORK+00000180 1 BIT(S) 99400000 SUBFLG EQU PWORK+00000180 1 BIT(S) 99410000 INVFLG EQU PWORK+00000180 1 BIT(S) 99420000 BYPASFLG EQU PWORK+00000180 1 BIT(S) 99430000 RD4 EQU PWORK+00000180 1 BIT(S) 99440000 RD5 EQU PWORK+00000180 1 BIT(S) 99450000 RD6 EQU PWORK+00000180 1 BIT(S) 99460000 PFLAGS6 EQU PWORK+00000181 8 BIT(S) 99470000 PFLAGS7 EQU PWORK+00000182 8 BIT(S) 99480000 PFLAGS8 EQU PWORK+00000183 8 BIT(S) 99490000 STORANC EQU PWORK+00000184 8 BYTE(S) 99500000 PANCHOR EQU PWORK+00000184 4 BYTE POINTER 99510000 PANCHORT EQU PWORK+00000188 4 BYTE POINTER 99520000 PGETLIST EQU PWORK+00000192 10 BYTE(S) ON WORD 99530000 PGETLNTH EQU PWORK+00000192 FULLWORD INTEGER 99540000 PGETRADR EQU PWORK+00000196 FULLWORD POINTER 99550000 PGETMDSP EQU PWORK+00000200 HALFWORD INTEGER 99560000 PIPDLCUR EQU PWORK+00000204 FULLWORD POINTER 99570000 PIPDLCHN EQU PWORK+00000208 FULLWORD POINTER 99580000 NME EQU PWORK+00000212 20*FULLWORD POINTER 99590000 PIPDLX EQU PWORK+00000292 1 BYTE POINTER 99600000 PLINKSV1 EQU PWORK+00000296 FULLWORD POINTER 99610000 INVPSAVE EQU PWORK+00000300 FULLWORD POINTER 99620000 PKEYWDPS EQU PWORK+00000304 FULLWORD POINTER 99630000 PKEYWDPC EQU PWORK+00000308 FULLWORD POINTER 99640000 PKEYWDPX EQU PWORK+00000312 FULLWORD POINTER 99650000 PKEYWDTB EQU PWORK+00000316 FULLWORD POINTER 99660000 PKEYWDPM EQU PWORK+00000320 FULLWORD POINTER 99670000 PTABLEAD EQU PWORK+00000324 FULLWORD POINTER 99680000 PTABLEND EQU PWORK+00000328 FULLWORD POINTER 99690000 TEMPPDE EQU PWORK+00000332 80 BYTE(S) ON WORD 99700000 TEMPPDE2 EQU PWORK+00000332 36 BYTE(S) ON WORD 99710000 TEMPFLD1 EQU PWORK+00000332 8 BYTE(S) ON WORD 99720000 DATAPTR1 EQU PWORK+00000332 FULLWORD POINTER 99730000 DATALEN1 EQU PWORK+00000336 HALFWORD INTEGER 99740000 DATAFLA1 EQU PWORK+00000338 8 BIT(S) 99750000 DATAFLB1 EQU PWORK+00000339 8 BIT(S) 99760000 TEMPFLD2 EQU PWORK+00000340 8 BYTE(S) ON WORD 99770000 DATAPTR2 EQU PWORK+00000340 FULLWORD POINTER 99780000 DATALEN2 EQU PWORK+00000344 HALFWORD INTEGER 99790000 DATAFLA2 EQU PWORK+00000346 8 BIT(S) 99800000 DATAFLB2 EQU PWORK+00000347 8 BIT(S) 99810000 TEMPFLD3 EQU PWORK+00000348 20 BYTE(S) ON WORD 99820000 DATAPTR3 EQU PWORK+00000348 FULLWORD POINTER 99830000 DATALEN3 EQU PWORK+00000352 HALFWORD INTEGER 99840000 DATAFLA3 EQU PWORK+00000354 8 BIT(S) 99850000 DATAFLB3 EQU PWORK+00000355 8 BIT(S) 99860000 DATAFLG EQU PWORK+00000356 8 BIT(S) 99870000 DATASGN EQU PWORK+00000357 8 BIT(S) 99880000 DATAICT EQU PWORK+00000358 HALFWORD INTEGER 99890000 DATAEXP EQU PWORK+00000360 FULLWORD POINTER 99900000 DATAUSER EQU PWORK+00000364 FULLWORD INTEGER 99910000 CBADD EQU PWORK+00000368 11*FULLWORD POINTER 99920000 ENDBAKUP EQU PWORK+00000412 FULLWORD POINTER 99930000 PDELIM EQU PWORK+00000416 1 BYTE(S) 99940000 PPCOUNT EQU PWORK+00000417 1 BYTE POINTER 99950000 PPDESIZE EQU PWORK+00000418 1 BYTE POINTER 99960000 PERRCODE EQU PWORK+00000419 1 BYTE POINTER 99970000 PKEYWDVL EQU PWORK+00000420 HALFWORD INTEGER 99980000 RNG2ADDR EQU PWORK+00000424 FULLWORD POINTER 99990000 SEGLIST EQU PWORK+00000428 5*FULLWORD POINTER 00000000 PREVPDEL EQU PWORK+00000448 FULLWORD POINTER 00010000 VCEPARAM EQU PWORK+00000452 13 BYTE(S) ON WORD 00020000 PDEADR EQU PWORK+00000452 FULLWORD POINTER 00030000 USERWORD EQU PWORK+00000456 FULLWORD INTEGER 00040000 VALMSG EQU PWORK+00000460 FULLWORD POINTER 00050000 MSGCODE EQU PWORK+00000464 1 BYTE POINTER 00060000 PRIMSGID EQU PWORK+00000465 20 BYTE(S) 00070000 SAVLSLEN EQU PWORK+00000486 HALFWORD INTEGER 00080000 PLUSSEG EQU PWORK+00000488 5 BYTE(S) 00090000 PUTLPTR EQU PWORK+00000496 FULLWORD POINTER 00100000 PUTGPTR EQU PWORK+00000500 FULLWORD POINTER 00110000 UPTADDR EQU PWORK+00000504 FULLWORD POINTER 00120000 ECTADDR EQU PWORK+00000508 FULLWORD POINTER 00130000 ECBADDR EQU PWORK+00000512 FULLWORD POINTER 00140000 A00000 EQU PWORK+00000516 FULLWORD POINTER 00150000 OPEREND EQU PWORK+00000520 FULLWORD POINTER 00160000 RSVWDPCE EQU PWORK+00000524 FULLWORD POINTER 00170000 TERMXPCE EQU PWORK+00000528 FULLWORD POINTER 00180000 OPERPCE EQU PWORK+00000532 FULLWORD POINTER 00190000 OPERSVE EQU PWORK+00000536 FULLWORD POINTER 00200000 RSVWDSV1 EQU PWORK+00000540 FULLWORD POINTER 00210000 RSVWDSV2 EQU PWORK+00000544 FULLWORD POINTER 00220000 CBLNKSV1 EQU PWORK+00000548 FULLWORD POINTER 00230000 CBLNKSV2 EQU PWORK+00000552 FULLWORD POINTER 00240000 ENDNMPTR EQU PWORK+00000556 FULLWORD POINTER 00250000 CHAINPTR EQU PWORK+00000560 FULLWORD POINTER 00260000 PDEPTR EQU PWORK+00000564 FULLWORD POINTER 00270000 AANC EQU PWORK+00000568 FULLWORD POINTER 00280000 TANC EQU PWORK+00000572 FULLWORD POINTER 00290000 OANC EQU PWORK+00000576 FULLWORD POINTER 00300000 ENDANC EQU PWORK+00000580 FULLWORD POINTER 00310000 PRMTPTR EQU PWORK+00000584 FULLWORD POINTER 00320000 OPERLL EQU PWORK+00000588 HALFWORD INTEGER 00330000 MSGAREA EQU PWORK+00000590 6 BYTE(S) 00340000 MSGLEN EQU PWORK+00000590 2 BYTE INTEGER 00350000 MSGADDR EQU PWORK+00000592 4 BYTE POINTER 00360000 DIGITCT EQU PWORK+00000596 1 BYTE POINTER 00370000 ELEMNCT EQU PWORK+00000597 1 BYTE POINTER 00380000 QUALCT EQU PWORK+00000598 1 BYTE POINTER 00390000 CBFLAGS1 EQU PWORK+00000599 8 BIT(S) 00400000 COBOLMOD EQU PWORK+00000599 1 BIT(S) 00410000 OPERMODE EQU PWORK+00000599 1 BIT(S) 00420000 SUBSMODE EQU PWORK+00000599 1 BIT(S) 00430000 NAMEREQD EQU PWORK+00000599 1 BIT(S) 00440000 ERRORBIT EQU PWORK+00000599 1 BIT(S) 00450000 RSVDPRMT EQU PWORK+00000599 1 BIT(S) 00460000 OPERPRMT EQU PWORK+00000599 1 BIT(S) 00470000 RC16 EQU PWORK+00000599 1 BIT(S) 00480000 CBFLAGS2 EQU PWORK+00000600 8 BIT(S) 00490000 SPECMSG EQU PWORK+00000600 1 BIT(S) 00500000 LFTPAREN EQU PWORK+00000600 1 BIT(S) 00510000 RHTPAREN EQU PWORK+00000600 1 BIT(S) 00520000 CHAINTRM EQU PWORK+00000600 1 BIT(S) 00530000 PARS2IN EQU PWORK+00000600 1 BIT(S) 00540000 PRMTSCAN EQU PWORK+00000600 1 BIT(S) 00550000 BUFPOPED EQU PWORK+00000600 1 BIT(S) 00560000 RNGADDED EQU PWORK+00000600 1 BIT(S) 00570000 CBFLAGS3 EQU PWORK+00000601 8 BIT(S) 00580000 FIRSTNAM EQU PWORK+00000601 1 BIT(S) 00590000 CTFOUND EQU PWORK+00000601 1 BIT(S) 00600000 BLNKFLAG EQU PWORK+00000601 1 BIT(S) 00610000 CBFLAGS4 EQU PWORK+00000602 8 BIT(S) 00620000 TRANAREA EQU PWORK+00000604 2 BYTE(S) ON HWORD 00630000 CORELEN EQU PWORK+00000606 HALFWORD INTEGER 00640000 PARS2ADR EQU PWORK+00000608 FULLWORD POINTER 00650000 VCONAD EQU PWORK+00000612 FULLWORD POINTER 00660000 GOREGSV EQU PWORK+00000616 FULLWORD POINTER 00670000 TERMBASE EQU PWORK+00000620 FULLWORD POINTER 00680000 OPERBASE EQU PWORK+00000624 FULLWORD POINTER 00690000 BASE3SV EQU PWORK+00000628 FULLWORD POINTER 00700000 BASE2SV EQU PWORK+00000632 FULLWORD POINTER 00710000 BASE1SV EQU PWORK+00000636 FULLWORD POINTER 00720000 RBASESV EQU PWORK+00000640 FULLWORD POINTER 00730000 CBLRET EQU PWORK+00000644 FULLWORD POINTER 00740000 COREADDR EQU PWORK+00000648 FULLWORD POINTER 00750000 AUTOBASE EQU PWORK+00000652 FULLWORD POINTER 00760000 WORKSAVE EQU PWORK+00000656 4*FULLWORD POINTER 00770000 PLINKSV2 EQU PWORK+00000672 FULLWORD POINTER 00780000 KEYPTR EQU PWORK+00000676 FULLWORD POINTER 00790000 KEYLEN EQU PWORK+00000680 HALFWORD INTEGER 00800000 KEYBUF EQU PWORK+00000682 37 BYTE(S) ON HWORD 00810000 KEYBUFLN EQU PWORK+00000682 HALFWORD INTEGER 00820000 KEYBUFOF EQU PWORK+00000684 HALFWORD INTEGER 00830000 KEYDATA EQU PWORK+00000686 33 BYTE(S) 00840000 R12 EQU 00000012 FULLWORD INTEGER REGISTER 00850000 R13 EQU 00000013 FULLWORD INTEGER REGISTER 00860000 GOREG EQU 00000014 FULLWORD INTEGER REGISTER 00870000 R14 EQU 00000014 FULLWORD INTEGER REGISTER 00880000 R15 EQU 00000015 FULLWORD INTEGER REGISTER 00890000 MASK EQU 00000000 1 BYTE(S) ON WORD 00900000 PCETYPE EQU MASK+00000000 3 BIT(S) 00910000 A00001 EQU MASK+00000000 5 BIT(S) 00920000 OPCEFLD1 EQU 00000000 10 BYTE(S) 00930000 OPCEBYT1 EQU OPCEFLD1+00000000 16 BIT(S) 00940000 OPERMASK EQU OPCEFLD1+00000000 3 BIT(S) 00950000 OPRMTI EQU OPCEFLD1+00000000 1 BIT(S) 00960000 ODLFTI EQU OPCEFLD1+00000000 1 BIT(S) 00970000 A00002 EQU OPCEFLD1+00000000 11 BIT(S) 00980000 OPCELNTH EQU OPCEFLD1+00000002 2 BYTE INTEGER 00990000 OPDEINDX EQU OPCEFLD1+00000004 2 BYTE INTEGER 01000000 OPCEPTL EQU OPCEFLD1+00000006 2 BYTE INTEGER 01010000 A00003 EQU OPCEFLD1+00000008 2 BYTE INTEGER 01020000 OPCEFLD2 EQU 00000000 10 BYTE(S) 01030000 RPCEINDX EQU OPCEFLD2+00000000 2 BYTE INTEGER 01040000 T1PCEIDX EQU OPCEFLD2+00000002 2 BYTE INTEGER 01050000 T2PCEIDX EQU OPCEFLD2+00000004 2 BYTE INTEGER 01060000 T3PCEIDX EQU OPCEFLD2+00000006 2 BYTE INTEGER 01070000 A00004 EQU OPCEFLD2+00000008 2 BYTE INTEGER 01080000 OPDE EQU 00000000 256 BYTE(S) 01090000 VCONTAB EQU 00000000 19*FULLWORD POINTER 01100000 DTANME EQU 00000000 1 BYTE(S) 01110000 INVDATA EQU 00000000 1 BYTE(S) 01120000 LISTPTR EQU 00000000 FULLWORD POINTER 01130000 CBLTEMP EQU 00000332 80 BYTE(S) 01140000 MSGAREA1 EQU 00000000 1 BYTE(S) 01150000 MSGA EQU 00000000 1 BYTE(S) 01160000 R4 EQU 00000004 FULLWORD POINTER REGISTER 01170000 R5 EQU 00000005 FULLWORD POINTER REGISTER 01180000 R6 EQU 00000006 FULLWORD POINTER REGISTER 01190000 R8 EQU 00000008 FULLWORD POINTER REGISTER 01200000 R9 EQU 00000009 FULLWORD POINTER REGISTER 01210000 R11 EQU 00000011 FULLWORD POINTER REGISTER 01220000 COMBUF EQU 00000000 1 BYTE(S) 01230000 COMBUFBV EQU 00000000 256 BYTE(S) 01240000 COMBUFP EQU 00000000 256 BYTE(S) 01250000 COMBUFB EQU 00000000 1 BYTE(S) 01260000 BLNK EQU * 1 BYTE(S) 01270000 DC C' ' 01280000 PDEMPT EQU 00000000 20 BYTE(S) ON WORD 01290000 DNAMEPTR EQU PDEMPT+00000000 FULLWORD POINTER 01300000 LNGTH1 EQU PDEMPT+00000000 1 BYTE POINTER 01310000 LNGTH2 EQU PDEMPT+00000001 1 BYTE POINTER 01320000 LNGTH3 EQU PDEMPT+00000002 1 BYTE POINTER 01330000 RESVA EQU PDEMPT+00000003 1 BYTE(S) 01340000 RESWDNUM EQU PDEMPT+00000004 HALFWORD POINTER 01350000 LNGTH4 EQU PDEMPT+00000004 1 BYTE POINTER 01360000 RESV2 EQU PDEMPT+00000005 1 BYTE(S) 01370000 FLAG1 EQU PDEMPT+00000006 8 BIT(S) 01380000 PARMIND EQU PDEMPT+00000006 1 BIT(S) 01390000 CONST EQU PDEMPT+00000006 1 BIT(S) 01400000 VARIA EQU PDEMPT+00000006 1 BIT(S) 01410000 STATE EQU PDEMPT+00000006 1 BIT(S) 01420000 FIXED EQU PDEMPT+00000006 1 BIT(S) 01430000 NONNUM EQU PDEMPT+00000006 1 BIT(S) 01440000 FIGUR EQU PDEMPT+00000006 1 BIT(S) 01450000 FLOAT EQU PDEMPT+00000006 1 BIT(S) 01460000 FLAG2 EQU PDEMPT+00000007 8 BIT(S) 01470000 SIGN EQU PDEMPT+00000007 1 BIT(S) 01480000 EXPSIGN EQU PDEMPT+00000007 1 BIT(S) 01490000 DECPT EQU PDEMPT+00000007 1 BIT(S) 01500000 RESV3 EQU PDEMPT+00000007 5 BIT(S) 01510000 DATAPTRH EQU PDEMPT+00000008 FULLWORD POINTER 01520000 DATAPTR EQU PDEMPT+00000008 FULLWORD POINTER 01530000 DATAPTRA EQU PDEMPT+00000012 FULLWORD POINTER 01540000 DATAPTRB EQU PDEMPT+00000016 FULLWORD POINTER 01550000 LNGTH5 EQU PDEMPT+00000016 1 BYTE POINTER 01560000 NUMQUAL EQU PDEMPT+00000017 1 BYTE(S) 01570000 NUMSUB EQU PDEMPT+00000018 1 BYTE(S) 01580000 RESV4 EQU PDEMPT+00000019 1 BYTE(S) 01590000 PCEMPT EQU 00000000 9 BYTE(S) ON WORD 01600000 PCEFLG1 EQU PCEMPT+00000000 16 BIT(S) 01610000 TERPCE EQU PCEMPT+00000000 3 BIT(S) 01620000 PROMPT EQU PCEMPT+00000000 1 BIT(S) 01630000 DEFAULT EQU PCEMPT+00000000 1 BIT(S) 01640000 RESERV1 EQU PCEMPT+00000000 1 BIT(S) 01650000 HELP EQU PCEMPT+00000000 1 BIT(S) 01660000 VALCHK EQU PCEMPT+00000000 1 BIT(S) 01670000 LIST EQU PCEMPT+00000001 1 BIT(S) 01680000 ASIS EQU PCEMPT+00000001 1 BIT(S) 01690000 RANG EQU PCEMPT+00000001 1 BIT(S) 01700000 SUBSCRP EQU PCEMPT+00000001 1 BIT(S) 01710000 RESVCHA EQU PCEMPT+00000001 1 BIT(S) 01720000 RESERV2 EQU PCEMPT+00000001 3 BIT(S) 01730000 PCELNGTH EQU PCEMPT+00000002 2 BYTE(S) 01740000 PDEOFST EQU PCEMPT+00000004 2 BYTE(S) 01750000 PCEFLG2 EQU PCEMPT+00000006 8 BIT(S) 01760000 STMT EQU PCEMPT+00000006 1 BIT(S) 01770000 VAR EQU PCEMPT+00000006 1 BIT(S) 01780000 CNST EQU PCEMPT+00000006 1 BIT(S) 01790000 ANY EQU PCEMPT+00000006 1 BIT(S) 01800000 SUBSCPPT EQU PCEMPT+00000006 1 BIT(S) 01810000 RESERV3 EQU PCEMPT+00000006 3 BIT(S) 01820000 TPTSL EQU PCEMPT+00000007 2 BYTE POINTER 01830000 TPODL EQU 00000000 8 BIT(S) ON BYTE 01840000 RSVWDIDX EQU 00000000 2 BYTE INTEGER 01850000 NPCE1 EQU 00000000 261 BYTE(S) 01860000 NPCE EQU NPCE1+00000000 16 BIT(S) 01870000 NPCEMASK EQU NPCE1+00000000 3 BIT(S) 01880000 A00005 EQU NPCE1+00000000 13 BIT(S) 01890000 NPCELNTH EQU NPCE1+00000002 2 BYTE INTEGER 01900000 NAMELM1 EQU NPCE1+00000004 1 BYTE POINTER 01910000 NAMEDATA EQU NPCE1+00000005 256 BYTE(S) 01920000 RPCEFLD EQU 00000000 6 BYTE(S) 01930000 RPCEBYT1 EQU RPCEFLD+00000000 16 BIT(S) 01940000 RSVWMASK EQU RPCEFLD+00000000 3 BIT(S) 01950000 RPRMTI EQU RPCEFLD+00000000 1 BIT(S) 01960000 RDFLTI EQU RPCEFLD+00000000 1 BIT(S) 01970000 A00006 EQU RPCEFLD+00000000 3 BIT(S) 01980000 RFCONST EQU RPCEFLD+00000001 1 BIT(S) 01990000 A00007 EQU RPCEFLD+00000001 7 BIT(S) 02000000 RPCELNTH EQU RPCEFLD+00000002 2 BYTE INTEGER 02010000 RPDEINDX EQU RPCEFLD+00000004 2 BYTE INTEGER 02020000 ORPDE EQU 00000332 8 BYTE(S) 02030000 A00008 EQU ORPDE+00000000 2 BYTE(S) 02040000 RNAMENUM EQU ORPDE+00000002 2 BYTE INTEGER 02050000 A00009 EQU ORPDE+00000004 2 BYTE(S) 02060000 ORPDEFLG EQU ORPDE+00000006 8 BIT(S) 02070000 ORFND EQU ORPDE+00000006 1 BIT(S) 02080000 ORPDERD2 EQU ORPDE+00000006 7 BIT(S) 02090000 ORPDERD3 EQU ORPDE+00000007 1 BYTE(S) 02100000 PARS2BAS EQU 00000002 FULLWORD POINTER REGISTER 02110000 OTHBASE EQU 00000003 FULLWORD POINTER REGISTER 02120000 ADDCDE EQU 00000015 FULLWORD POINTER REGISTER 02130000 WORKAR1 EQU 00000000 12 BYTE(S) ON WORD 02140000 QNAMEPTR EQU WORKAR1+00000000 FULLWORD POINTER 02150000 QNGTH4 EQU WORKAR1+00000004 1 BYTE POINTER 02160000 QRESV EQU WORKAR1+00000005 3 BYTE(S) 02170000 QATAPTRH EQU WORKAR1+00000008 FULLWORD POINTER 02180000 PTRARE EQU 00000000 FULLWORD POINTER 02190000 COMBUFA EQU 00000000 2 BYTE(S) 02200000 VCOMBF EQU 00000001 1 BYTE(S) 02210000 CNSTTEMP EQU 00000000 20 BYTE(S) 02220000 VARIPDE EQU 00000332 19 BYTE(S) ON WORD 02230000 A00010 EQU VARIPDE+00000000 18 BYTE(S) 02240000 NUMSUB1 EQU VARIPDE+00000018 1 BYTE(S) 02250000 ORG @DATA 02260000 DS 00000001C 02270000 @L EQU 2 02280000 @DATD DSECT 02290000 OPCEPTR EQU @DATD+00000000 FULLWORD POINTER 02300000 RSVDRTN EQU @DATD+00000004 FULLWORD POINTER 02310000 INDEX1 EQU @DATD+00000008 FULLWORD POINTER 02320000 ADDR1 EQU @DATD+00000012 HALFWORD INTEGER 02330000 OPERSPM EQU @DATD+00000016 8 BYTE(S) ON WORD 02340000 OPERSPM1 EQU OPERSPM+00000000 HALFWORD INTEGER 02350000 OPERSPM2 EQU OPERSPM+00000004 FULLWORD INTEGER 02360000 WORKAR EQU @DATD+00000024 4 BYTE(S) ON WORD 02370000 GOPTION EQU WORKAR+00000000 1 BYTE(S) 02380000 GFIRST EQU WORKAR+00000001 1 BYTE(S) 02390000 GOTHER EQU WORKAR+00000002 1 BYTE(S) 02400000 GOMAX EQU WORKAR+00000003 1 BYTE(S) 02410000 DS 00000028C 02420000 @TEMPS DS 0F 02430000 @TEMP2 DC F'0' 02440000 @TEMP4 DC F'0' 02450000 DS 0F 02460000 PUTLINE PUTLINE ,MF=L * * * * F41448 02470000 SPACE 02480000 PUTGET PUTGET ,MF=L * * * * F41448 02490000 SPACE 02500000 DS 0D ALIGN FOR FREEMAIN OF RWORK 02510000 @DATD DSECT 02520000 @DATEND EQU * 02530000 IKJPARS2 CSECT , 02540000 @9FD EQU ERROR 02550000 @9FC EQU ERROR 02560000 @9E2 EQU RTNCLNUP 02570000 @9DE EQU RTNCLNUP 02580000 @9CE EQU RTNCLNUP 02590000 @9C8 EQU RTNCLNUP 02600000 @9C5 EQU F 02610000 @9BB EQU NOMATCH 02620000 @9B8 EQU IP 02630000 @9B7 EQU IP 02640000 @9B6 EQU IP 02650000 @9B3 EQU RTNCLNUP 02660000 @9B1 EQU RTNCLNUP 02670000 @9AB EQU UPDTPCE 02680000 @9AA EQU OPER 02690000 @99E EQU ETEST 02700000 @99D EQU VERRBIT 02710000 TESTERR EQU EXIT 02720000 @997 EQU EFOUND 02730000 MAXLNEXC EQU VERRBIT 02740000 @98B EQU ENDSCAN 02750000 @988 EQU CODE4 02760000 @97A EQU COD24 02770000 @975 EQU IKJEFP6C 02780000 @973 EQU XINUP 02790000 MSGRTN EQU UPDTPCE 02800000 ENDTERM EQU @EL02 02810000 END IKJPARS2 02820000