EDC TITLE 'DMSEDC (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * 00004000 * MODULE NAME - 00005000 * 00006000 * DMSEDC (EDCANON) 00007000 * 00008000 * FUNCTION - 00009000 * 00010000 * TO ARRANGE COMPUND (OVERSTRUCK) CHARACTERS INTO 00011000 * CANONICAL FORM, AND TO DISREGARD TAB CHARACTERS AS 00012000 * SPECIAL CHARACTERS. 00013000 * 00014000 * ATTRIBUTES - 00015000 * 00016000 * DISK-RESIDENT: BALR'D TO BY DMSEDI 00017000 * 00018000 * ENTRY POINTS - 00019000 * 00020000 * DMSEDC, EDCANON - SEE FUNCTION DESCRIPTION 00021000 * 00022000 * ENTRY CONDITIONS - 00023000 * 00024000 * GPR0 - LENGTH OF STRING (LINE FROM DMSEDI) 00025000 * GPR1 - ADDRESS OF STRING TO BE ORDERED 00026000 * GPR13- EDCB ADDRESS 00026100 * 00027000 * EXIT CONDTIONS - 00028000 * GPR0 - (NEW) LENGTH OF ORDERED STRING 00029000 * 00030000 * CALLS TO OTHER ROUTINES - 00031000 * 00032000 * NONE - 00033000 * 00034000 * EXTERNAL REFERENCES _ 00035000 * 00036000 * NONE 00037000 * 00038000 * TABLES/WORKAREAS - 00039000 * 00040000 * DUALNOS -AREA FOR DUAL NUMBERING SCHEME FOR ORDERING 00041000 * 00042000 * REGISTER USAGE - 00043000 * 00044000 * GPR1 - ADDRESS OF INPUT STRING 00045000 * GPR10- ROUTINE ADDRESSABILITY 00046000 * GPR13- EDCB ADDRESS 00046100 * GPR14- RETURN ADDRESS IN DMSEDI 00047000 * 00048000 * NOTES - 00049000 * 00050000 * DMSEDC IS LOADED WITH DMSEDI AS FOLLOWS: 00051000 * LOAD DMSEDI DMSEDA DMSEDF DMSEDC (TYPE 00052000 * 00053000 * 00054000 * OPERATION - 00055000 * 00056000 * DMSEDC RECEIVES THE LENGTH OF THE 00057000 * STRING TO BE ORDERED IN R0 AND THE ADDRESS OF 00058000 * THE STRING IN R1. 00059000 * AFTER INITIALIZING WORK REGISTERS. DMSEDC 00060000 * ASSIGNS DUAL NUMBERS TO THE CHARACTERS IN THE CALLER'S 00061000 * STRING, FORMING THE TEMPORARY STING BUFFER DUALNOS. 00062000 * BACKSPACES ARE TREATED AS EXCEPTIONS TO THE 00063000 * NORMAL SCHEMED, BEING GIVEN A NUMBER '0' TO SIGNIFY AN 00064000 * OVERSTRUCK CHARACTER LATER IN PROCESSING. 00065000 * CHARACTERS ARE SORTED TO GET CHARS. WITH BACKPSACES 00066000 * IN EBCDIC ORDER AND THE NEW CANONICALIZED STRING IS ARRAN 00067000 * AND PADDED, IF NECESSARY. RETURN IS MADE TO DMSEDI VIA 00068000 * R14. 00069000 * 00070000 *. 00071000 SPACE 2 00072000 SPACE 2 00073000 DMSEDC START 00074000 ENTRY EDCANON 00075000 EDCANON EQU DMSEDC 00076000 USING EDCB,R13 @V305614 00076100 USING EDCANON,R15 00077000 STM R0,R10,SAVEAR SAVE REGISTERS @V305614 00078100 DROP R15 00079000 LR R10,R15 SET UP PERMANENT BASE 00080000 USING EDCANON,R10 00081000 USING BUFFSECT,R1 00082000 SPACE 00083000 LTR R3,R0 LENGTH OF STRING 00084000 BNH EXIT BRANCH IF <= 0 00085000 SR R0,R0 KEEP ZERO IN R0 00086000 LA R4,239 MAXIMUM 00087000 CR R3,R4 COMPARE GIVEN LENGTH WITH THAT 00088000 BNH *+6 SKIP IF <= 00089000 LR R3,R4 SET LENGTH TO MAX. 00090000 LR R2,R3 SET CHARACTER COUNT 00091000 SPACE 00092000 LA R4,64 INITIALIZE DUAL NUMBER 00093000 SR R5,R5 INDEX = 0 00094000 B DUALP2 BRANCH INTO LOOP 00095000 EJECT 00096000 *********************************************************************** 00097000 * 00098000 * ASSIGN DUAL NUMBERS IN THE STRING 'DUALNOS' 00099000 * 00100000 *********************************************************************** 00101000 SPACE 00102000 DUALP1 EQU * 00103000 LA R4,1(R4) INCREMENT DUAL NUMBER 00104000 DUALP3 EQU * 00105000 LA R5,1(R5) AND INDEX 00106000 DUALP2 EQU * 00107000 LA R7,BUFF(R5) POINT TO CHARACTER IN BUFFER 00108000 CLI 0(R7),X'16' BACKSPACE? 00109000 BE DUALP4 BRANCH IF SO 00110000 STC R4,DUALNOS(R5) STORE DUAL NUMBER 00111000 BCT R3,DUALP1 DECREMENT LENGTH AND LOOP 00112000 B SORT1 00113000 SPACE 00114000 DUALP4 EQU * 00115000 BCTR R4,0 DECREMENT DUAL NUMBER 00116000 BCTR R2,0 AND CHARACTER COUNT 00117000 STC R0,DUALNOS(R5) STORE DUAL FOR BACKSPACE (0) 00118000 BCT R3,DUALP3 AND LOOP 00119000 EJECT 00120000 *********************************************************************** 00121000 * 00122000 * SORT CHARACTERS IN BUFFER 00123000 * 00124000 *********************************************************************** 00125000 SPACE 00126000 SORT1 EQU * 00127000 SR R6,R6 USE R6 AND R7 AS TEMPS. 00128000 SR R7,R7 00129000 L R3,SAVEAR GET GIVEN LENGTH @V305614 00130100 BCTR R3,0 DECREASE BY 1 00131000 LTR R3,R3 ZERO? 00132000 BZ ARRANGE1 BRANCH IF SO (SKIP THE SORT) 00133000 SORT2 EQU * 00134000 SR R5,R5 INITIALIZE INDEX = 0 00135000 LA R9,ARRANGE1 SET TRANSFER ADDRESS 00136000 B SORT4 00137000 SPACE 00138000 SORT3 EQU * 00139000 LA R5,1(R5) INCREMENT INDEX 00140000 CR R5,R3 COMPARE WITH LENGTH TO SORT 00141000 BE ARRANGE BRANCH IF = 00142000 SORT4 EQU * 00143000 IC R6,DUALNOS(R5) PICK UP DUAL NUMBERS 00144000 IC R7,DUALNOS+1(R5) 00145000 CR R6,R7 COMPARE THIS ONE WITH NEXT 00146000 BE SORT3A BRANCH IF EQUAL (COMPARE EBCDIC-WISE) 00147000 BL SORT3 BRANCH IF < (ALREADY CORRECT) 00148000 SORT4B EQU * INTERCHANGE THIS AND NEXT 00149000 STC R6,DUALNOS+1(R5) 00150000 STC R7,DUALNOS(R5) 00151000 IC R6,BUFF(R5) 00152000 IC R7,BUFF+1(R5) 00153000 STC R6,BUFF+1(R5) 00154000 STC R7,BUFF(R5) 00155000 LA R9,SORT2 RESET TRANSFER ADDRESS 00156000 B SORT3 AND CARRY ON WITH SORT 00157000 SPACE 00158000 ARRANGE EQU * 00159000 BCTR R3,R9 DECREMENT LENGTH AND REPEAT SORT 00160000 B ARRANGE1 OR ARRANGE IF THROUGH HERE 00161000 SPACE 00162000 SORT3A EQU * 00163000 LA R8,BUFF(R5) LOOK AT THIS CHARACTER 00164000 CLC 0(1,R8),1(R8) COMPARE ITS EBCDIC VALUE WITH THE NEXT 00165000 BNH SORT3 BRANCH IF WRONG WAY ROUND (THIS WAS BUG) 00166000 B SORT4B 00167000 EJECT 00168000 *********************************************************************** 00169000 * 00170000 * ARRANGE THE NEW CANONICALIZED STRING 00171000 * 00172000 *********************************************************************** 00173000 SPACE 00174000 ARRANGE1 EQU * 00175000 L R5,SAVEAR GIVEN LENGTH @V305614 00176100 STC R0,DUALNOS(R5) PUT A ZERO AT END 00177000 SR R5,R2 NO OF BACKSPACES 00178000 LTR R3,R2 NO OF NON-BACKSPACES 00179000 LR R8,R1 POINT R8 TO BUFF 00180000 BZ PAD BRANCH IF NO NON-BACKSPACES 00181000 ARRANGE2 EQU * 00182000 IC R6,BUFF(R5) GET CHARACTER (NOT BACKSPACE) 00183000 STC R6,0(R8) AND PUT IT IN PLACE 00184000 LA R7,DUALNOS(R5) GET DUAL NUMBER 00185000 CLC 0(1,R7),1(R7) COMPARE WITH NEXT 00186000 BNE ARRANGE3 BRANCH IF NOT 00187000 LA R7,BUFF(R5) LOOK AT CHARACTER 00188000 CLI 0(R7),C' ' BLANK? 00189000 BE ARRANGE4 BRANCH IF SO (IGNORE) 00190000 LA R8,1(R8) MOVE TO NEXT SPOT 00191000 MVI 0(R8),X'16' AND MOVE IN A BACKSPACE 00192000 ARRANGE3 EQU * 00193000 LA R8,1(R8) MOVE TO NEXT SPOT 00194000 ARRANGE4 EQU * 00195000 LA R5,1(R5) LOOK AT NEXT CHARACTER 00196000 BCT R3,ARRANGE2 AND LOOP UNTIL FINISHED 00197000 EJECT 00198000 *********************************************************************** 00199000 * 00200000 * PAD ANY REMAINDER AND SET LENGTH 00201000 * 00202000 *********************************************************************** 00203000 SPACE 00204000 PAD EQU * 00205000 L R7,SAVEAR GIVEN LENGTH @V305614 00206100 LR R6,R8 LAST BYTE NOW USED 00207000 SR R6,R1 CONVERT TO LENGTH 00208000 CR R6,R7 COMPARE WITH ORIGINAL 00209000 BNL SETL BRANCH IF = 00210000 MVI 0(R8),C' ' BLANK OUT NEXT BYTE 00211000 LA R3,1(R6) INCREMENT LENGTH 00212000 CR R3,R7 STILL SHORT? 00213000 BNL SETL BRANCH IF NOW = 00214000 SR R7,R3 CONVERT TO LENGTH 00215000 BCTR R7,0 DECREASE FOR EXEC 00216000 EX R7,BLANKPAD PAD REMAINDER 00217000 SETL EQU * 00218000 ST R6,SAVEAR SAVE NEW LEBGTH @V305614 00219100 SPACE 00220000 EXIT EQU * 00221000 LM R0,R10,SAVEAR RESTORE REGISTERS @V305614 00222100 BR R14 RETURN 00223000 EJECT 00224000 *********************************************************************** 00225000 * 00226000 * EXECUTE INSTRUCTIONS, DATA AND DSECTS 00227000 * 00228000 *********************************************************************** 00229000 SPACE 00230000 BLANKPAD MVC 1(0,R8),0(R8) 00231000 SPACE 00238000 LTORG 00239000 SPACE 2 00240000 BUFFSECT DSECT 00241000 BUFF DS CL240 00242000 SPACE 3 00243000 EDCB , @V305614 00243100 EJECT 00243200 REGEQU 00244000 SPACE 3 00245000 END 00246000