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