Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

; UPD ID= 323 on 9/7/77 at 9:05 AM
TITLE	SRTTAB FOR COBOL V13
SUBTTL	SORT DIAGNOSTIC WORDS	AL BLACKINGTON/CAM

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1974, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION

	SEARCH	P
	%%P==:%%P

TWOSEG
	.COPYRIGHT		;Put standard copyright statement in REL file
RELOC	400000

;EDITS
;V10*****************
;NAME	DATE		COMMENTS
;MDL	11-FEB-77	[464] ALLOW DIGITS TO BE LEXICALLY ORDERED BEFORE LETTERS.
;ACK	12-JAN-74	ADD CAPABILITY TO HAVE DIAG NUMBERS UP TO 1023.
;********************


	ENTRY SRTERA
	ENTRY SRTNAM

;THE DATA CONSISTS OF ONE AND TWO WORD ENTRIES.
;THEY ARE SORTED DISREGARDING DIAGNOSTIC NUMBERS, SUCH THAT
;	ALL DIAGS FOR SAME POSITION WILL BE PRINTED IN THE ORDER
;	THEY WERE WRITTEN ONTO ERAFIL.

;THE DIAGS ARE CURRENTLY IN CORE, "ERATAB" POINTS TO THE FIRST ITEM,
;	"DT" POINTS TO THE LAST.

SRTERA:	HRRZ	TA,ERATAB	;SET TA TO THE FIRST DIAG
	MOVEI	TC,0		;CLEAR FLAG

SRTER1:	CAIN	TA,(DT)		;ARE WE DONE?
	JRST	SRTER8		;YES

	MOVE	TB,0(TA)	;NO--GET FIRST DIAG OF CURRENT PAIR
	ANDI	TB,DIAGNO	;IS IT A DOUBLE-WORD ONE?
	CAIG	TB,LASTHI
	CAIGE	TB,FRSTHI
	TDCA	TB,TB		;SINGLE--TB_0
	SKIPA	TE,2(TA)	;DOUBLE
	SKIPA	TE,1(TA)	;SINGLE
	MOVEI	TB,1		;DOUBLE

	MOVE	TD,TE		;IS SECOND DIAG DOUBLE?
	ANDI	TD,DIAGNO
	CAIG	TD,LASTHI
	CAIGE	TD,FRSTHI
	CAIA
	ADDI	TB,2		;YES--BUMP TB BY 2

	MOVE	TD,0(TA)
	ANDCMI	TD,DIAGNO	;STRIP OFF DIAG NUMBER
	ANDCMI	TE,DIAGNO

	CAMLE	TD,TE		;ARE THEY IN ORDER?
	JRST	@STAB1(TB)	;NO--EXCHANGE
	AOJA	TA,@STAB2(TB)	;YES--NO EXCHANGE

SRTER8:	JUMPN	TC,SRTERA	;ONE PASS DONE--ANY EXCHANGES?
	POPJ	PP,		;NO--THEY ARE ALL IN ORDER

;TABLE OF ROUTINES TO EXCHANGE ITEMS

STAB1:	EXP	SRT10	;SINGLE FOLLOWED BY SINGLE
	EXP	SRT15	;DOUBLE,SINGLE
	EXP	SRT13	;SINGLE,DOUBLE
	EXP	SRT16	;DOUBLE,DOUBLE

;TABLE OF WHERE TO GO IF NO EXCHANGE

STAB2:	EXP	SRTER1	;SINGLE,SINGLE
	EXP	SRT12	;DOUBLE,SINGLE
	EXP	SRTER1	;SINGLE,DOUBLE
	EXP	SRT12	;DOUBLE,DOUBLE

;EXCHANGE ROUTINES

;BOTH ARE SINGLE
SRT10:	MOVE	TB,0(TA)
	EXCH	TB,1(TA)
	MOVEM	TB,0(TA)

SRT11:	MOVNI	TC,1

SRT12:	AOJA	TA,SRTER1

;SINGLE FOLLOWED BY DOUBLE
SRT13:	MOVE	TB,0(TA)
	EXCH	TB,2(TA)
	EXCH	TB,1(TA)
	MOVEM	TB,0(TA)

SRT14:	AOJA	TA,SRT11

;DOUBLE FOLLOWED BY SINGLE
SRT15:	MOVE	TB,0(TA)
	EXCH	TB,1(TA)
	EXCH	TB,2(TA)
	MOVEM	TB,0(TA)

	MOVNI	TC,1
	AOJA	TA,SRTER1

;BOTH ARE DOUBLES

SRT16:	MOVE	TB,0(TA)
	EXCH	TB,2(TA)
	MOVEM	TB,0(TA)
	MOVE	TB,1(TA)
	EXCH	TB,3(TA)
	MOVEM	TB,1(TA)

	AOJA	TA,SRT11

DIAGNO==1777	;MASK FOR DIAG NUMBER

EXTERNAL FRSTHI	;FIRST DIAG WHICH HAS APPENDED DATA (DOUBLE-WORD)
EXTERNAL LASTHI ;LAST DIAG WHICH CAN HAVE APPENDED DATA.
EXTERNAL ERATAB	;WHERE DIAGS ARE

SUBTTL SORT USER NAMES IN NAMTAB	AL BLACKINGTON

;PACK POINTERS TO USER NAMES AT TOP OF NM2TAB

SRTNAM:	MOVN	TA,NM12SZ
	MOVSS	TA
	HRR	TA,NM2LOC
	MOVEI	LN,(TA)
	HRRZ	CP,NAMLOC
	MOVSI	TD,CP

SRTN1:	SKIPN	TE,(TA)
	JRST	SRTN2

	HRR	TD,TE
	MOVE	TC,@TD
	TLNN	TC,NAMRSV/1000000
	TRNN	TC,-1
	JRST	SRTN2

	MOVEM	TE,(LN)
	ADDI	LN,1

SRTN2:	AOBJN	TA,SRTN1

;LN NOW POINTS TO LAST ENTRY PLUS 1

	SETZM	(LN)

;SORT NM2TAB ACCORDING TO NAMES IN NAMTAB

	MOVSI	TA,CP
	MOVSI	TB,CP
	PUSH	PP,W1		;[464] SAVE BEFORE THE SORT LOOP

SRTN3:	HRRZ	TC,NM2LOC	;SET TC TO TOP OF TABLE
	MOVEI	DT,0
	SUBI	LN,1

SRTN4:	CAIL	TC,(LN)		;DONE WITH THIS PASS?
	JRST	SRTN9		;YES

	HLRZ	TE,(TC)		;NO--GET SIZE OF ITEM-A
	HLRZ	TD,1(TC)	;GET SIZE OF ITEM-B
	HRR	TA,(TC)		;GET ADDRESS OF ITEM-A
	HRR	TB,1(TC)	;GET ADDRESS OF ITEM-B

SRTN5:	ADDI	TA,1
	ADDI	TB,1

	MOVE	CH,@TA		;GET A WORD FROM ITEM-A
	CAME	CH,@TB		;IS IT EQUAL TO WORD FROM ITEM-B?
	JRST	SRTN8		;NO

	SOJLE	TD,SRTN6	;YES--HAVE WE LOOKED AT ALL OF ITEM-B?
	SOJG	TE,SRTN5	;NO--HAVE WE LOOKED AT ALL OF ITEM-A?

SRTN5A:	AOJA	TC,SRTN4	;YES--THEY ARE EQUAL

SRTN6:	SOJLE	TE,SRTN5A	;HAVE WE LOOKED AT ALL OF ITEM-A?

SRTN7:	MOVE	TE,(TC)		;NO--ITEM-A IS LARGER, SO SWAP POINTERS
	EXCH	TE,1(TC)
	MOVEM	TE,(TC)

	HRROI	DT,-1		;SET FLAG

	AOJA	TC,SRTN4	;LOOP TO LOOK AT NEXT PAIR

SRTN8:	MOVE	W1,CH		;[464] DO NOT DESTROY CP
	XOR	W1,@TB		;[464] DETERMINE IF ONE DATA-ITEM IS POS
				;[464] AND THE OTHER DATA-ITEM IS A LETTER.
	JUMPGE	W1,SRTN8A	;[464] JUMP IF THE SAME TYPES
	CAMLE	CH,@TB		;[464] DIFF TYPES, REVERSE THE TEST
	AOJA	TC,SRTN4	;[464] ITEM-A .LT. ITEM-B
	JRST	SRTN7		;[464] ITEM-B .GT. ITEM-B, SWAP
SRTN8A:				;[464]
	CAMG	CH,@TB		;IS ITEM-A > ITEM-B?
	AOJA	TC,SRTN4	;NO--LOOP TO LOOK AT NEXT PAIR

	JRST	SRTN7		;YES--GO SWAP THEM

SRTN9:	JUMPN	DT,SRTN3	;ANYTHING SWAPPED ON THAT PASS?
	POP	PP,W1		;[464] RESTORE
	POPJ	PP,		;NO--RETURN

EXTERNAL NAMLOC,NM2LOC,NM12SZ

	END