TITLE 'IEECVFTB IGC6B07B DIDOCS PFK ROUTINE 2' 00050002 IEECVFTB CSECT 00100002 *D 251000,251500 ME YM2527 00110002 *C 252000 ME YM2527 00120002 */*IEECVFTB: CHART */ 00150002 */* HEADER 00200002 */*CHART EA IEECVFTB DIDOCS PFK ROUTINE 00250002 */* 2 PAGE # */ 00300002 */* E IEECVFTB */ 00350002 SPACE 5 00400002 * /* START OF SPECIFICATIONS **** 00450002 *02* PROCESSOR = ASSEMBLER; 00500002 **** END OF SPECIFICATIONS ***/ 00550002 SPACE 4 00600002 * STATUS 00650002 * CHANGE LEVEL 0 00700002 * CREATED FOR RELEASE 21, LINE ITEM S21003. 00750002 SPACE 00800002 * FUNCTION 00850002 * TO PROCESS THE DEFINITION OR REDEFINITION, BY THE OPERATOR, 00900002 * OF PROGRAM FUNTION KEYS ALLOCATED FOR AT SYSGEN TIME AND THE 00950002 * DISPLAY OF THE PFK LINE ON THE SCREEN. 01000002 SPACE 01050002 * ENTRY POINTS 01100002 * IEECVFTB FOR ALL FUNCTIONS 01150002 * FROM IEECVET4 WHEN A K D,PFK, K N,PFK OR K E,PFK COMMAND 01200002 * IS ENTERED. 01250002 SPACE 01300002 * INPUT 01350002 * THE COMMAND AS ENTERED. 01400002 SPACE 01450002 * OUTPUT 01500002 * A NEW PFK DEFINITION IN THE DCM OR A FLAG BIT TO THE DEVICE 01550002 * DEPENDENT I/O ROUTINE, INDICATING THAT THE PFK LINE MUST 01600002 * BE ALTERED. 01650002 SPACE 01700002 * EXITS, NORMAL 01900002 * IEECVET1 (PROCESSOR 1) WHEN A KEY HAS BEEN DEFINED. 01950002 * DEVICE DEPENDENT I/O ROUTINE TO WRITE THE PFK LINE. 02000002 SPACE 02050002 * EXITS, ERROR 02100002 * IEECVETD (MESSAGE MODULE 1) OR IEECVFTD (MESSAGE MODULE 3) 02150002 * TO WRITE OUT ERROR MESSAGES. 02200002 EJECT 02250002 * TABLES/WORK AREAS 02300002 * PFK AREA 02350002 * THIS MODULE USES THE PFK AREA WHICH IS CREATED BY 02400002 * SYSGEN. THERE WILL BE ONE AREA FOR EACH PFK WHICH WAS 02450002 * ALLOCATED AT SYSGEN TIME. THE DCMADPFK FIELD IN THE 02500002 * RESIDENT DCM POINTS TO THE FIRST AREA AND ALL AREAS ARE 02550002 * CONTIGUOUS. FOLLOWING THE LAST AREA IS A ONE BYTE FIELD EQUAL TO 02600002 * X'64', USED TO IDENTIFY THE END OF PFK WORKSPACE. 02650002 * EACH PFK AREA IS 110 BYTES LONG FORMATTED AS FOLLOWS: 02700002 * 02750002 * DCMNUM A ONE BYTE FIELD CONTAINING THE KEY NUMBER 02800002 * IN BINARY. 02850002 * 02900002 * DCMSTS A ONE BYTE FLAG FIELD. FOR EXPLANATION SEE THE DCM 02950002 * DSECT FOLLOWING THE CODE FOR THIS MODULE. 03000002 * 03050002 * DCMVAL A 108 BYTE FIELD WHICH IS EITHER: 03100002 * 03150002 * A. A LIST OF KEYS IN THE FORM KFKF...KF/ WHERE K IS 03200002 * A ONE BYTE BINARY KEY NUMBER AND F IS A CONTROL 03250002 * BYTE WHICH CONTAINS C';' UNLESS PROCESSING 03300002 * IS TAKING PLACE. THE SLASH (X'61') 03350002 * IDENTIFIES THE END OF THE LIST OF KEYS. 03400002 * B. ONE OR MORE COMMANDS IN THE FORM 03450002 * COMMAND;COMMAND;...COMMAND 03500002 * WHERE SEMI-COLONS DELIMIT THE COMMANDS. IF THE 03550002 * LAST COMMAND DOES NOT FILL THE BUFFER IT IS 03600002 * PADDED WITH BLANKS. 03650002 * 03700002 * DCM DESCRIBED IN DSECT AT END OF MODULE 03750002 SPACE 2 03800002 * ATTRIBUTES 03850002 * REFRESHABLE, PRIVILEGED, TYPE 4 SVC. 03900002 SPACE 03950002 * CHARACTER CODE DEPENDENCY 04000002 * THIS MODULE WAS ASSEMBLED WITH THE EBCDIC CHARACTER SET. IF A 04050002 * DIFFERENT CHARACTER SET WILL BE USED AT EXECUTION THE MODULE 04100002 * MUST BE RE-ASSEMBLED USING THAT CHARACTER SET. IN ADDITION THE 04150002 * EQUATE 'DIGIT' MUST BE CHANGED TO INDICATE THE ZONE ASSIGNED 04200002 * TO DIGIT CHARACTERS AND THE EQUATE 'PLUS' MUST BE CHANGED TO 04250002 * A VALID POSITIVE DECIMAL SIGN. 04300002 EJECT 04350002 * NOTES 04400002 * THE FOLLOWING FLAG BITS ARE USED: 04450002 * THE ACTION COLUMN INDICATES WHETHER THE BIT IS TURNED ON, OFF OR 04500002 * JUST TESTED BY THIS MODULE. 04550002 * 04600002 * NAME ACTION FUNCTION 04650002 * DCMCMSG2 04700002 * DCMRQINC ON REQUEST INCONSISTANT MESSAGE 04750002 * DCMINVOP ON INVALID OPERAND MESSAGE 04800002 * DCMCMSG4 04850002 * DCMPFKNO ON NO PFK ALLOCATION MESSAGE 04900002 * DCMIOCM1 04950002 * DCMWRENT ON WRITE THE ENTRY AREA 05000002 * DCMWRINS ON WRITE THE INSTRUCTION LINE 05050002 * DCMINSC ON INSERT CURSOR 05100002 * DCMIOCM2 05150002 * DCMINSSH ON INITIALIZE THE INSTRUCTION LINE 05200002 * DCMBLENT ON BLANK THE ENTRY AREA 05250002 * DCMIOCM3 05300002 * DCMOPRMI ON RESTORE KEYBOARD 05350002 * DCMWRPFK ON ALTER PFK LINE 05400002 * DCMCOM3 05450002 * DCMPFKWR ON WRITE PFK AREA TO DISK 05500002 * DCMUTILT 05550002 * DCMUTILA ON/OFF/TEST KEY= OPERAND USED 05600002 * DCMUTILB ON/OFF/TEST END OF OPERAND FOUND 05650002 * DCMUTILC ON/OFF/TEST CON= OPERAND EXPECTED 05700002 * DCMUTILD ON/OFF/TEST PREVIOUS QUOTE DETECTED 05750002 * DCMUTILF ON/OFF/TEST MASTER KEY IN PROCESS 05800002 * PFK AREA 05850002 * DCMPFKCN ON KEY DEFINED AS CONVERSATIONAL MODE 05900002 * DCMPFKDF ON/TEST KEY HAS BEEN DEFINED 05950002 * DCMPFKKY ON/TEST KEY IS A LIST OF KEYS 06000002 EJECT 06050002 * REGISTER EQUATES 06100002 SPACE 06150002 X1PARM EQU 1 06160002 XERTRN EQU 14 06162002 XFBRANCH EQU 15 06170002 PFKPTR EQU 0 POINTER TO PFK AREA 06200002 CXSABASE EQU 1 CXSA BASE REGISTER 06250002 OPER EQU 2 OPERAND POINTER 06300002 APFK EQU 3 PFK AREA POINTER OR BINARY KEY 06350002 LPFK EQU 4 PFK LINE POINTER 06400002 COMPARE EQU 4 KEY COMPARISON 06450002 BADPT EQU 4 WORK REG FOR ERROR MESG SETUP 06500002 LIMIT EQU 5 SCAN LIMIT REGISTER 06550002 LISTAPFK EQU 5 PFK AREA POINTER 06600002 MPFK EQU 6 MASTER PFK 06650002 SCAN EQU 7 SCAN REGISTER 06700002 DCMB EQU 8 DCM BASE REGISTER 06750002 UCME EQU 9 UCM ENTRY ADDRESS (MOMENTARY) 06800002 STRTPT EQU 9 WORK REGISTER 06850002 SCAN2 EQU 10 SUBSCAN POINTER 06900002 ENDREG EQU 10 END OF NEW DEFINITION 06950002 BASE EQU 11 PROGRAM BASE REGISTER 07000002 LENGTH EQU 12 LENGTH FOR MVC 07050002 OPSTART EQU 12 START OF OPERAND LIST 07100002 RET EQU 13 RETURN FROM SUBROUTINE 07150002 KEYLIST EQU 14 KEY NUMBER FROM LIST 07200002 BADOP EQU 14 NUMBER OF DELETED QUOTES 07250002 RETURN EQU 14 RETURN REG FOR XCTL 07300002 STORE EQU 15 DEFINITION INDEX 07350002 EJECT 07400002 START BALR BASE,N0 ESTABLISH BASE REGISTER 07450002 USING *,BASE 07500002 B BEGIN BRANCH AROUND PATCH AREA 07550002 ICATCH DC CL72'IEECVFTB' EYECATCHER AND FIELD MAINTENANCE 07600002 BEGIN EQU * END OF PATCH AREA 07650002 USING CXSA,CXSABASE CXSA BASE PASSED AS PARM 07700002 L UCME,N16(CXSABASE) ESTABLISH UCM ENTRY ADDRESS 07800002 L DCMB,N28(UCME) ESTABLISH DCM ADDRESS 07850002 USING DCMTSRT,DCMB 07900002 L PFKPTR,DCMADPFK SAVE PFK AREA POINTER 07950002 L DCMB,DCMADTRN GET TRANSIENT DCM BASE 08000002 DROP DCMB 08050002 USING DCMSTRT,DCMB 08100002 MVC DCMTRACE(DCMTRLEN),DCMTRAC2 SHIFT OLD TRACE ENTRIES 08150002 MVI DCMTREN1,ID1 PUT CSECT ID INTO 08160002 MVI DCMTREN2,ID2 NEW TRACE ENTRY 08170002 L XFBRANCH,CSAXC ADDRESS FREELOCK SUBROUTINE 08180002 LR X1PARM,CXSABASE PASS CXSA ADDRESS IN REG 1 08190002 BALR XERTRN,XFBRANCH RELEASE LOCKS 08192002 OI DCMIOCM2,DCMBLENT BLANK THE ENTRY AREA 08200002 OI DCMIOCM1,DCMINSC+DCMWRENT+DCMWRINS CLEAN UP ENTRY AREA 08250002 OI DCMIOCM3,DCMOPRMI AND RESTORE KEYBOARD 08300002 SPACE 5 08350002 */*%START: D (YES,%CK,NO,%ERROR) ANY PFK ALLOCATED? */ 08400002 *********************************************************** 08450002 LTR APFK,PFKPTR ANY PFKS ALLOCATED 08500002 BZ ERROR1 NO, GO TO INDICATE ERROR 08550002 SPACE 5 08600002 */*%CK: D (E,ERSPFK,N,DEFPFK,D,DISPFK) WHICH OPERAND USED? */ 08650002 *********************************************************** 08700002 * AT ENTRY THE POINTER IN DCMADOPN POINTS TO THE FIRST CHARACTER 08750002 * OF THE OPERAND IN THE ENTRY AREA. THIS IS EQUIVALENT TO 08800002 * THE FIRST POSITION IN THE INPUT AREA, WHERE THE SCAN 08850002 * WILL ACTUALLY TAKE PLACE. IF A BAD OPERAND IS FOUND THE SCAN 08900002 * POINTER WILL BE CONVERTED BACK TO INDICATE A POSITION IN THE 08950002 * ENTRY AREA SO THAT THE CURSOR CAN BE CORRECTLY POSITIONED. 09000002 * NOTE THAT THE INPUT AREA IS MODIFIED AS THE SCAN PROGRESSES 09050002 * BY CONVERTING NUMBERS FROM EBCDIC TO BINARY AND REMOVING 09100002 * PAIRED QUOTES. AS A RESULT IT CANNOT BE USED TO WRITE ERROR 09150002 * INFORMATION TO THE SCREEN. 09200002 LA OPER,DCMINPUT POINT TO INPUT AREA 09250002 CLI N0(OPER),EPFK IS OPERAND E,PFK 09300002 BE ERSPFK YES, ERASE PFK LINE 09350002 CLI N0(OPER),NPFK IS OPERAND N,PFK= 09400002 BE DEFPFK YES, GO TO DEFINE PFK 09450002 * NO, ASSUME OPERAND D,PFK 09500002 SPACE 5 09550002 */*DISPFK: D (NO,ALTER,YES,%ERROR) IS PFK LINE DISPLAYED? */ 09600002 *********************************************************** 09650002 DISPFK EQU * 09700002 L LPFK,DCMPFKLN GET START OF PFK LINE 09750002 CLC N0(N6,LPFK),BLANKS IS LINE NOW BLANK 09760002 BNE ERROR2 NO, INCONSISTANT REQUEST 09770002 B ALTER EXIT TO I/O MODULE 09900002 SPACE 5 09950002 */*ERSPFK: D (YES,ALTER,NO,%ERROR) IS PFK LINE DISPLAYED? */ 10000002 *********************************************************** 10050002 ERSPFK EQU * 10100002 L LPFK,DCMPFKLN POINT TO PFK LINE 10150002 CLC N0(N6,LPFK),BLANKS IS LINE NOW BLANK 10160002 BE ERROR2 YES, INCONSISTANT REQUEST 10170002 SPACE 5 10300002 */*ALTER: P (,IOEXIT) INDICATE LINE TO BE ALTERED (DCMWRPFK) */ 10350002 *********************************************************** 10400002 ALTER OI DCMIOCM3,DCMWRPFK INDICATE LINE MUST BE ALTERED 10450002 SPACE 5 10500002 */*IOEXIT: R DEV. DEP. I/O ROUTINE */ 10550002 *********************************************************** 10600002 IOEXIT EQU * 10650002 L XFBRANCH,DCMIORTN LOAD IO ROUTINE ADDRESS 10700002 * FOR EXIT TO IEECVET(H,P,R, OR U) 10710002 OI DCMIOCM2,DCMINSSH RESTORE INSTRUCTION LINE 10750002 XCTL EQU * 10800002 L X1PARM,DCMCXSVE RESTORE CXSA ADDRESS 10850002 BR XFBRANCH EXIT ADDRESS ALREADY SET 10900002 EJECT 11000002 */*DEFPFK: D (YES,%DIG,NO,%ERROR) LEADING KEYWORD OK? */ 11050002 *********************************************************** 11100002 DEFPFK EQU * 11150002 NI DCMUTILT,ZEROS CLEAR ALL UTILITY FLAGS 11200002 LA OPER,N1(OPER) POINT TO COMMA 11250002 CLI N0(OPER),COMMA IS IT THERE 11300002 BNE INVALOP NO, INVALID 11350002 LA OPER,N1(OPER) POINT TO PFK= KEYWORD 11400002 CLC N0(N4,OPER),PFK CHECK KEYWORD 11450002 BNE INVALOP NOT VALID. TELL OPERATOR 11500002 LA OPER,N4(OPER) POINT TO NEXT SEGMENT 11550002 CLI Z(OPER),LPAREN IS IT LEFT PARENTHESIS 11600002 BNE INVALOP NO, GO TO FLAG ERROR 11650002 SPACE 5 11700002 */*%DIG: S (,VALID) CKDIGIT: CHECK MASTER KEY FOR VALIDITY */ 11750002 *********************************************************** 11800002 LA OPER,N1(OPER) POINT TO KEY BEING DEFINED 11850002 LR STRTPT,OPER SAVE POINTER FOR STORE 11900002 OI DCMUTILT,DCMUTILF INDICATE MASTER KEY IN PROCESS 11950002 BAL RET,CKDIGIT GO TO CHECK VALIDITY 12000002 NI DCMUTILT,X'FF'-DCMUTILF MASTER KEY PROCESSING OVER 12050002 LR MPFK,SCAN2 SAVE MASTER KEY AREA POINTER 12100002 STC APFK,Z(STRTPT) STORE MASTER KEY (DIAG. ONLY) 12150002 NI N1(STRTPT),ZEROS CLEAR FLAG BYTE 12200002 SPACE 5 12250002 */*VALID: D (CMD=,TEXT,KEY=,LIST,NONE,%ERROR) WHICH OPERAND USED? */ 12300002 *********************************************************** 12350002 VALID CLC Z(N4,OPER),CE IS OPERAND CMD= 12400002 BE TEXT YES, FORMAT TEXT 12450002 CLC Z(N4,OPER),KE IS OPERAND KEY= 12500002 BNE INVALOP NO, GO TO FLAG ERROR 12550002 OI DCMUTILT,DCMUTILA REMEMBER KEY= OPERAND 12600002 LA COMPARE,N108(OPER) POINT TO END OF LIST 12650002 ST COMPARE,DCMDSAV+N12 SAVE FOR LATER COMPARE 12700002 EJECT 12750002 */*LIST: D (NO,OK,YES,%ERROR) IS MASTER KEY PART OF ANOTHER LIST? 12800002 */**/ 12850002 *********************************************************** 12900002 LIST EQU * 12950002 SR COMPARE,COMPARE CLEAR COMPARE REGISTER 13000002 LR LISTAPFK,PFKPTR POINT TO PFK AREA 13050002 CKEND CLI Z(LISTAPFK),STOPPER IS THIS END OF AREA 13100002 BE OK YES, OK TO CONTINUE 13150002 TM N1(LISTAPFK),DCMPFKDF+DCMPFKKY IS IT DEFINED 13200002 * AS A LIST OF KEYS 13250002 BNO BUMP NO, GO TO NEXT KEY 13300002 IC COMPARE,N0(LISTAPFK) GET KEY NUMBER 13350002 CR COMPARE,APFK IS IT ONE WE ARE DEFINING 13400002 BE BUMP YES, GO TO NEXT KEY 13450002 LA KEYLIST,N2(LISTAPFK) NO, POINT TO FIRST 13500002 * KEY IN LIST 13550002 DEFTEST IC COMPARE,N0(KEYLIST) GET KEY FROM LIST 13600002 CR COMPARE,APFK IS IT ONE WE ARE DEFINING 13650002 BE INVAL YES, CAN'T DEFINE THIS ONE AS LIST 13700002 LA KEYLIST,N2(KEYLIST) POINT TO NEXT KEY 13750002 CLI N0(KEYLIST),KEYSTOP IS THIS END OF LIST 13800002 BNE DEFTEST NO, LOOK AT NEXT ONE 13850002 BUMP LA LISTAPFK,PFKLGN(LISTAPFK) YES, POINT TO NEXT AREA 13900002 B CKEND GO CHECK IT 13950002 INVAL LR OPER,STRTPT POINT BACK TO MASTER KEY 14000002 B INVALOP ISSUE ERROR MESSAGE 14050002 SPACE 5 14100002 */*OK: P (,NEXT) GET KEYS FROM LIST */ 14150002 */*NEXT: S (,ENDEF) CKDIGIT: KEY IN LIST MUST NOT BE A LIST OF KEYS */ 14200002 *********************************************************** 14250002 OK EQU * 14300002 LA OPER,N4(OPER) POINT TO FIRST KEY IN LIST 14350002 LR OPSTART,OPER SAVE POINTER TO START OF LIST 14400002 LR STORE,OPER POINT TO START OF NEW DEFINITION 14450002 NEXT BAL RET,CKDIGIT CHECK AND CONVERT A KEY 14500002 STC APFK,N0(STORE) STORE KEY IN DEFINITION 14550002 MVI N1(STORE),SEMI STORE SEPARATOR IN DEFINITION 14600002 LA STORE,N2(STORE) POINT TO NEXT FIELD 14650002 TM DCMUTILT,DCMUTILB+DCMUTILC IS THIS END OF OPERAND 14700002 BNZ ENDEF YES, CHECK FOR CON= 14750002 C OPER,DCMDSAV+N12 IS THIS END OF WORK AREA 14800002 BL NEXT NO, GET NEXT KEY 14850002 B INVALOP YES, INVALID, TOO LONG 14900002 EJECT 14950002 */*ENDEF: D (NO,MOVEIT,YES,PCON) IS CON= OPERAND EXPECTED? */ 15000002 *********************************************************** 15050002 ENDEF EQU * 15100002 MVI N0(STORE),KEYSTOP STOP LIST OF KEYS 15150002 LR OPER,OPSTART POINT TO START OF DEFINITION 15200002 LA ENDREG,N2(STORE) POINT TO END OF OPERAND 15250002 TM DCMUTILT,DCMUTILC IS CON= OPERAND EXPECTED 15300002 BNO MOVEIT NO, GO TO MOVE DEFINITION 15350002 SR BADOP,BADOP YES, CLEAR REMOVED QUOTE REG 15400002 B PCON CHECK OUT CON= OPERAND 15450002 SPACE 5 15500002 */* E (,CKDIGIT) CKDIGIT SUBROUTINE */ 15550002 */*CKDIGIT: D (NO,%A,YES,COMCK) ARE WE LOOKING AT THE MASTER KEY? */ 15600002 *********************************************************** 15650002 CKDIGIT EQU * 15700002 LA LIMIT,N3(LIMIT) MAXIMUM TWO DIGITS 15750002 XC DCMPACK(N8),DCMPACK CLEAR WORK AREA 15800002 MVC DCMCVBIN(N2),Z(OPER) MOVE IN NEXT TWO CHARACTERS 15850002 LR SCAN,OPER POINT SCANNER TO OPERAND 15900002 TM DCMUTILT,DCMUTILF IS THIS THE KEY BEING DEFINED 15950002 BO COMCK YES, MUST BE A NUMBER 16000002 SPACE 5 16050002 */*%A: D (NO,%B,YES,CONVERS) IS THIS A RIGHT PAREN AND COMMA? */ 16100002 *********************************************************** 16150002 CKNUMB EQU * 16200002 CLI N0(SCAN),RTPAREN IS IT RIGHT PAREN 16250002 BNE COMCK NO, CONTINUE TESTING 16300002 CLI N1(SCAN),COMMA YES, IS NEXT ONE A COMMA 16350002 BE CONVERS YES, CONVERSATIONAL SPEC FOLLOWS 16400002 SPACE 5 16450002 */*%B: D (NO,COMCK,YES,ENDOP) IS THIS A RIGHT PAREN ALONE? */ 16500002 *********************************************************** 16550002 CLI N1(SCAN),BLANK NO, IS IT A BLANK 16600002 BE ENDOP YES, END OF REDEFINE OPERANDS 16650002 LA SCAN,N1(SCAN) NO, POINT TO BAD OPERAND 16700002 B BADSCAN2 TELL OPERATOR 16750002 SPACE 5 16800002 */*COMCK: D (YES,CONVERT,NO,%ERROR) IS THIS A VALID NUMBER? */ 16850002 *********************************************************** 16900002 COMCK CLI Z(SCAN),COMMA IS THIS A COMMA 16950002 BE CONVERT YES, GO TO CONVERT DIGITS 17000002 CLI Z(SCAN),ZERO IS DIGIT LESS THAN ZERO 17050002 BL BADSCAN2 YES, ERROR 17100002 CLI Z(SCAN),NINE IS DIGIT MORE THAN NINE 17150002 BH BADSCAN2 YES, ERROR 17200002 MVC DCMPACK+N1(N5),DCMPACK+N2 SHIFT ONE CHARACTER 17250002 LA SCAN,N1(SCAN) POINT TO NEXT DIGIT 17300002 BCT LIMIT,CKNUMB DIGIT OK, CHECK NEXT ONE 17350002 B BADSCAN2 OVER TWO DIGITS IS ERROR 17400002 * NOTE CURSOR WILL POINT TO THIRD DIGIT. TO POINT TO FIRST 17450002 * DIGIT CHANGE BRANCH TO INVALOP. 17500002 SPACE 5 17550002 */*CONVERS: P (,CONVERT) INDICATE CON= OPERAND EXPECTED (DCMUTILC) */ 17600002 *********************************************************** 17650002 CONVERS EQU * 17700002 OI DCMUTILT,DCMUTILC INDICATE CON= OPER EXPECTED 17750002 B CONVERT GO TO EXIT 17800002 SPACE 5 17850002 */*ENDOP: P (,CONVERT) INDICATE END OF OPERAND FOUND (DCMUTILB) */ 17900002 *********************************************************** 17950002 ENDOP EQU * 18000002 OI DCMUTILT,DCMUTILB INDICATE END OF OPERAND 18050002 B CONVERT GO TO EXIT 18100002 SPACE 5 18150002 */*CONVERT: P (,ALLOC) CONVERT KEY NUMBER TO BINARY */ 18200002 *********************************************************** 18250002 CONVERT EQU * 18300002 OI DCMPACK+N3,PLUS FORCE VALID SIGN 18350002 CR OPER,SCAN WERE THERE ANY DIGITS 18400002 BE INVALOP NO, ERROR 18450002 * NOTE CURSOR WILL POINT TO WHERE FIRST DIGIT SHOULD HAVE BEEN 18500002 SR APFK,APFK YES, CLEAR ANSWER REG 18550002 PACK DCMCVBIN(N4),DCMPACK(N4) CONVERT 18600002 XC DCMPACK(N4),DCMPACK EBCDIC 18650002 CVB APFK,DCMPACK TO BINARY 18700002 SPACE 5 18750002 */*ALLOC: D (YES,GOOD,NO,%ERROR) IS KEY ALLOCATED? */ 18800002 *********************************************************** 18850002 ALLOC EQU * 18900002 LR SCAN2,PFKPTR POINT TO FIRST PFK AREA 18950002 SR COMPARE,COMPARE CLEAR REGISTER 19000002 CHECK EQU * 19050002 CLI Z(SCAN2),STOPPER IS THIS END OF AREA 19100002 BE INVALOP YES, KEY NOT ALLOCATED 19150002 IC COMPARE,Z(SCAN2) GET KEY NUMBER 19200002 CR COMPARE,APFK IS IT THE ONE WE WANT 19250002 BE GOOD YES 19300002 LA SCAN2,PFKLGN(SCAN2) NO, INCREMENT TO NEXT AREA 19350002 B CHECK CHECK NEXT ONE 19400002 SPACE 5 19450002 */*GOOD: D (NO,POINT,YES,%C) ARE WE DEFINING A LIST? */ 19500002 *********************************************************** 19550002 GOOD EQU * 19600002 * NOTE DCMUTILA WILL NEVER BE ON DURING PROCESSING OF THE 19650002 * KEY BEING DEFINED. 19700002 TM DCMUTILT,DCMUTILA ARE WE DEFINING A LIST 19750002 BNO POINT NO, CONTINUE 19800002 SPACE 5 19850002 */*%C: D (NO,POINT,YES,%ERROR) IS THIS KEY A LIST OF KEYS? */ 19900002 *********************************************************** 19950002 TM N1(SCAN2),DCMPFKKY YES, IS THIS KEY A LIST 20000002 BO INVALOP YES, INVALID 20050002 CR SCAN2,MPFK NO, IS THIS THE KEY BEING DEFINED 20100002 BE INVALOP YES, INVALID 20150002 * NOTE CURSOR WILL POINT TO FIRST DIGIT OF KEY NUMBER 20200002 * NO, CONTINUE 20250002 SPACE 5 20300002 */*POINT: R RETURN TO CALLER */ 20350002 *********************************************************** 20400002 POINT LA OPER,N1(SCAN) POINT TO NEXT PART OF OPERAND 20450002 BR RET RETURN TO CALLER 20500002 EJECT 20550002 */*TEXT: P (,END) SCAN TWO SINGLE QUOTES TO ONE */ 20600002 *********************************************************** 20650002 TEXT EQU * 20700002 LA OPER,N4(OPER) UPDATE OPERAND POINTER 20750002 CLI Z(OPER),QUOTE IS THIS A QUOTE 20800002 BNE INVALOP NO, INVALID 20850002 LA OPER,N1(OPER) POINT TO START OF TEXT 20900002 SR BADOP,BADOP CLEAR QUOTE COUNTER 20950002 SR LIMIT,LIMIT CLEAR LIMIT REGISTER 21000002 LA LIMIT,TEXTLGN(LIMIT) MAXIMUM NUMBER OF CHARACTERS 21050002 LR SCAN,OPER INITIALIZE SCAN REGISTER 21100002 CKQUOTE EQU * 21150002 CLI Z(SCAN),QUOTE IS THIS A QUOTE 21200002 BE QUOTECK YES, CHECK FOR PAIR 21250002 TM DCMUTILT,DCMUTILD WAS THERE A PREVIOUS QUOTE 21300002 BO END YES, MUST BE END OF TEXT 21350002 CT LA SCAN,N1(SCAN) POINT AT NEXT CHARACTER 21400002 BCT LIMIT,CKQUOTE GO CHECK IT 21450002 B BADSCAN TOO MANY CHARACTERS 21500002 * NOTE CURSOR WILL POINT TO 127TH CHARACTER IN ENTRY AREA. 21550002 QUOTECK EQU * 21600002 TM DCMUTILT,DCMUTILD WAS LAST CHAR A QUOTE 21650002 BO ADJUST YES, ADJUST LINE 21700002 OI DCMUTILT,DCMUTILD NO, INDICATE THIS ONE IS 21750002 B CT CONTINUE SCAN 21800002 ADJUST EQU * 21850002 NI DCMUTILT,X'FF'-DCMUTILD TURN OFF QUOTE FLAG 21900002 BCTR SCAN,N0 POINT BACK TO FIRST QUOTE 21950002 LA LENGTH,DCMINPUT POINT TO START OF INPUT AREA 22000002 LA LENGTH,N126(LENGTH) POINT TO END OF INPUT AREA 22050002 SR LENGTH,SCAN CALC LENGTH OF TEXT TO MOVE 22100002 EX LENGTH,MVCENTRY SHIFT LINE TO CLEAR 22150002 * DOUBLE QUOTE 22200002 LA BADOP,N1(BADOP) ADD TO COUNT OF QUOTES REMOVED 22250002 B CT CONTINUE SCAN 22300002 EJECT 22350002 */*END: D (YES,PCON,NO,MOVEIT) CON= OPERAND? */ 22400002 *********************************************************** 22450002 END EQU * 22500002 LR ENDREG,SCAN SAVE PTR TO END OF TEXT 22550002 CLI Z(SCAN),RTPAREN IS THIS RTPAREN 22600002 BNE BADSCAN NO, INVALID 22650002 CLI N1(SCAN),COMMA IS THIS A COMMA 22700002 BE PCON YES, PCON EXPECTED 22750002 CLI N1(SCAN),BLANK IS THIS A BLANK 22800002 BE MOVEIT YES, GO TO MOVE TEXT 22850002 LA SCAN,N1(SCAN) NO, POINT TO BAD CHAR 22900002 B BADSCAN GO TO TELL OPERATOR INVALID 22950002 EJECT 23000002 */*PCON: P (,MOVEIT) CHECK OPERAND AND SET FLAG AS REQUIRED */ 23050002 *********************************************************** 23100002 PCON EQU * 23150002 LA SCAN,N2(SCAN) POINT TO OPERAND 23200002 CLC N0(N4,SCAN),CONV IS OPERAND CON= 23250002 BNE BADSCAN NO, INVALID 23300002 LA SCAN,N4(SCAN) POINT TO NEXT OPERAND 23350002 CLI N0(SCAN),Y IS OPERAND YES (Y) 23400002 BE YES YES, GO TO FLAG IT 23450002 CLI N0(SCAN),N IS OPERAND NO (N) 23500002 BE MOVEIT YES, IT IS NO. BYPASS FLAGGING 23550002 B BADSCAN NONE OF ABOVE, ERROR 23600002 YES OI N1(STRTPT),DCMPFKCN INDICATE CONVERSATIONAL MODE 23650002 SPACE 4 23700002 */*MOVEIT: P (,MOVE) MOVE DEFINITION TO PFK AREA */ 23750002 *********************************************************** 23800002 MOVEIT EQU * 23850002 MVI N2(MPFK),BLANK CLEAR OUT OLD 23900002 MVC N3(CLRLGN,MPFK),N2(MPFK) PFK AREA 23950002 XR LENGTH,LENGTH CLEAR LENGTH REGISTER 24000002 LR LENGTH,ENDREG COMPUTE LENGTH 24050002 SR LENGTH,OPER OF MOVE 24100002 BCTR LENGTH,N0 REDUCE BY ONE BECAUSE WE 24150002 * SCANNED TO DELIMITER 24200002 LTR LENGTH,LENGTH WAS THERE ANY TEXT 24250002 BZ UNDEF NO, FLAG KEY AS UNDEFINED 24300002 BCTR LENGTH,N0 REDUCE BY ONE FOR EXECUTE 24350002 EX LENGTH,MVCKEY MOVE DEFINITION TO PFK AREA 24400002 TM DCMUTILT,DCMUTILA IS THIS A LIST OF KEYS 24450002 BNO MOVE NO, GO TO MOVE FLAGS 24500002 OI N1(STRTPT),DCMPFKKY INDICATE LIST OF KEYS 24550002 SPACE 4 24600002 */*MOVE: P (,IOEXIT) FLAG KEY AS DEFINED */ 24650002 *********************************************************** 24700002 MOVE EQU * 24750002 OI N1(STRTPT),DCMPFKDF INDICATE KEY NOW DEFINED 24800002 UNDEF MVC N1(N1,MPFK),N1(STRTPT) MOVE FLAGS TO PFK AREA 24850002 MVI DCMCULNO,N1 RESTORE CURSOR TO 24900002 MVI DCMPOSCU,N1 POSITION 1 LINE 1 24950002 OI DCMCOM3,DCMPFKWR INDICATE THAT PFK AREA MUST 25000002 * BE RE-WRITTEN TO DISK 25050002 B IOEXIT EXIT FROM MODULE ME YM2527 25200002 EJECT 25250002 */*%ERROR: P (,MESG) SET UP ERROR MESSAGE */ 25300002 *********************************************************** 25350002 ERROR2 EQU * 25400002 OI DCMCMSG2,DCMRQINC INDICATE REQUEST INCONSISTANT 25450002 B MESG1 GO TO ISSUE MESSAGE 25500002 BADSCAN EQU * 25550002 AR SCAN,BADOP NO, COMPENSATE FOR REMOVED QUOTES 25600002 BADSCAN2 LR OPER,SCAN POINT OPERAND TO BAD SCAN CHAR 25650002 INVALOP EQU * 25700002 LA BADPT,DCMINPUT POINT TO INPUT AREA 25750002 SR OPER,BADPT CALC DISPLACEMENT IN OPERAND 25800002 L BADPT,DCMADOPN POINT TO OPERAND IN ENTRY AREA 25850002 AR BADPT,OPER POINT TO BAD OPERAND IN ENTRY 25900002 ST BADPT,DCMDSAV PASS POINTER TO MESG MODULE 25950002 S BADPT,DCMAENTR CALC DISPLACEMENT IN ENTRY 26000002 CH BADPT,DCMLGNTH IS OPERAND IN LINE TWO 26050002 BH LINE2 YES, COMPENSATE 26100002 MVI DCMCULNO,N1 NO, SET LINE NUMBER TO ONE 26150002 STCURS EQU * 26200002 LA BADPT,N1(BADPT) ADD ONE TO POSITION 26250002 STC BADPT,DCMPOSCU STORE CURSOR POSITION 26300002 NI DCMIOCM2,X'FF'-DCMBLENT DON'T BLANK ENTRY AREA 26350002 OI DCMIOCM1,DCMINSC INDICATE INSERT CURSOR 26400002 OI DCMCMSG2,DCMINVOP INVALID OPERAND MESSAGE BIT 26450002 B MESG1 GO TO WRITE MESSAGE 26500002 LINE2 EQU * 26550002 MVI DCMCULNO,N2 SET LINE NUMBER TO TWO 26600002 SH BADPT,DCMLGNTH CALC OFFSET WITHIN LINE 26650002 B STCURS GO TO STORE VALUE 26700002 ERROR1 EQU * 26750002 OI DCMCMSG4,DCMPFKNO INDICATE NO PFK ALLOCATION 26800002 SPACE 5 26850002 */*MESG: R IEECVETD */ 26900002 *********************************************************** 26950002 MESG3 EQU * 27000002 L XFBRANCH,DCMNMSG3 LOAD MESSAGE 3 ADDRESS 27050002 B XCTL EXIT TO IEECVFTD 27060002 MESG1 EQU * 27100002 L XFBRANCH,DCMNMSG1 LOAD MESSAGE 1 ADDRESS 27150002 B XCTL EXIT TO IEECVETD 27200002 EJECT 27250002 ********************************************************************** 27300002 * EXECUTED INSTRUCTIONS 27350002 MVCENTRY MVC Z(N0,SCAN),N1(SCAN) SHIFT CHAR IN WORK AREA 27400002 MVCKEY MVC N2(N0,MPFK),Z(OPER) MOVE DEF TO PFK AREA 27450002 ********************************************************************** 27500002 SPACE 5 27550002 */*IEECVFTB: END */ 27600002 EJECT 27650002 * CONSTANTS 27700002 BLANKS DC 6C' ' BLANKS 27710002 CE DC C'CMD=' CMD= OPERAND 27750002 CONV DC C'CON=' PCON= OPERAND 27800002 KE DC C'KEY=' KEY= OPERAND 27850002 PFK DC C'PFK=' PFK= KEYWORD 27900002 SPACE 5 27950002 * EQUATES 28000002 ID1 EQU C'F' 1ST CHARACTER OF CSECT ID 28010002 ID2 EQU C'B' 2ND CHARACTER OF CSECT ID 28020002 * PFK AREA EQUATES 28030002 DCMPFKDF EQU X'80' KEY HAS BEEN DEFINED 28032002 DCMPFKCN EQU X'20' KEY DEFINED AS CONVERSATIONAL MODE 28040002 DCMPFKKY EQU X'08' KEY IS A LIST OF KEYS 28044002 * MISCELLANEOUS EQUATES 28046002 BLANK EQU C' ' BLANK CHARACTER 28050002 COMMA EQU C',' CHARACTER 28100002 EPFK EQU C'E' ERASE PFK LINE OPERAND 28200002 KEYSTOP EQU X'61' STOPS LIST OF KEYS 28250002 LPAREN EQU C'(' LEFT PARENTHESIS 28300002 N EQU C'N' CHARACTER 28350002 NINE EQU C'9' CHARACTER 28400002 NPFK EQU C'N' DEFINE PFK OPERAND 28450002 N0 EQU 0 NUMBER 28500002 N1 EQU 1 NUMBER 28550002 N2 EQU 2 NUMBER 28600002 N3 EQU 3 NUMBER 28650002 N4 EQU 4 NUMBER 28700002 N5 EQU 5 NUMBER 28750002 N6 EQU 6 NUMBER 28760002 N8 EQU 8 LENGTH OF DCMPACK + DCMCVBIN 28800002 N12 EQU 12 DISPLACEMENT IN DCMDSAVE FOR REG SAV 28850002 N16 EQU 16 NUMBER 28900002 N28 EQU 28 NUMBER 28950002 N108 EQU 108 NUMBER OF CHARS IN TEXT 29000002 N126 EQU 126 LENGTH OF ENTRY AREA 29050002 PFKLGN EQU 110 LENGTH OF PFK AREA 29100002 CLRLGN EQU PFKLGN-3 LENGTH OF TEXT MINUS ONE 29150002 PLUS EQU X'F0' PLUS SIGN VALUE 29200002 QUOTE EQU C'''' SINGLE QUOTE 29250002 RTPAREN EQU C')' RIGHT PAREN 29300002 SEMI EQU C';' SEMI-COLON 29350002 STOPPER EQU X'64' END OF PFK AREAS 29400002 TEXTLGN EQU PFKLGN LENGTH OF CMD= TEXT 29450002 Y EQU C'Y' CHARACTER 29500002 Z EQU 0 ZERO 29550002 ZERO EQU C'0' CHARACTER 29600002 ZEROS EQU X'00' HEX ZEROS 29650002 SPACE 5 29700002 TITLE 'IEECVFTB IGC6B07B PFK ROUTINE 2 RESIDENT DISPLAY CO*29750002 NTROL MODULE' 29800002 IEERDCM 29850002 TITLE 'IEECVFTB IGC6B07B PFK ROUTINE 2 TRANSIENT DISPLAY *29950002 CONTROL MODULE' 30000002 IEETDCM 30050002 TITLE 'IEECVFTB IGC6B07B PFK ROUTINE 2 CXSA' 30150002 IHACTM CXSA 30250002 END START 30300002