Trailing-Edge
-
PDP-10 Archives
-
BB-H506E-SM
-
cobol/source/srttab.mac
There are 9 other files named srttab.mac in the archive. Click here to see a list.
; UPD ID= 323 on 9/7/77 at 9:05 AM
TITLE SRTTAB FOR COBOL V12C
SUBTTL SORT DIAGNOSTIC WORDS AL BLACKINGTON/CAM
SEARCH COPYRT
SALL
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
SEARCH P
%%P==:%%P
;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.
;********************
TWOSEG
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
RELOC 400000
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