*DECK CRT 
          IDENT  DCREATE
          ENTRY  SDACRT,SDACRTU,SDAENDC 
SORT45    MICRO  1,1,*"PCOMMENT"* 
SORT45    SET    "SORT45" 
SORT45    IFEQ   SORT45,4 
          LDSET  LIB=SRTLIB 
SORT45    ELSE
          LDSET  LIB=SRT5LIB
SORT45    ENDIF 
 MEMR 
 KYADD                             KEY ADDRESS FOR USER CALL
 WSADD
 FWARC
 RCL
 AREC 
 FCALL
 SORTC                             NEW RECORD FLAG
 RNDKY                             HASHED KEY 
 PBUF                              START OF PARAMETER BUFFER
 FRSTP                             FIRST WORD 
 LFN                               FILE NAME
 HASH                              HASH ENTRY 
 HFL                               FILE NAME FOR USERS HASHING
 CREATE   DATA   L CREATE          CONSTANT 
 MRL                               REC LENGTH 
 HMB                               HOME BLOCKS
 MBL                               BLOCK SIZE 
 RKP                               KEY POSITION 
 RKW                               RELATIVE KEY WORD
 KL       DATA   10                KEY LENGTH 
 KYBUFF   BSSZ   14                KEY BUFFER 
 SVA2 
 LBF      EQU    65 
 MSGBUF   BSSZ   LBF
 INPUT    FILEC  MSGBUF,LBF        FET
 ADDB     BSSZ   6                 INPUT PARAMETER BUFFER 
 FORTB    BSSZ   6                 FOR EXTERNAL HASHING ROUTINE 
 BUFLD    LDREQ  BEGIN
 BUF1     LDREQ  LOAD,(XX)
 ENT      LDREQ  ENTRY,(XX) 
 ENT1     EQU    ENT+1
          LDREQ  END
 STFL     DATA   C$START FILE CREATION$ 
 BPARM    DATA   C$BAD INPUT PARAMETER-RUN TERMINATED$
 BADKY    DATA   C$BAD HASHING ROUTINE-RUN TERMINATED$
 COREUSE  DATA   C$          B WORDS OF CENTRAL MEMORY USED$
          USE    /CCOMMON/         COMMON BLOCK FOR FORM
 CCOM     BSS    3
          USE    CODE 
          SST 
 PASHDR   MACRO 
          IFEQ   #PLAO#,0 
          VFD    12/21B 
          ELSE
          VFD    12/24B 
          ENDIF 
          VFD    12/ENDPL-*-1,36/0
          ENDM
 PASEN    MACRO  A,B
          VFD    42/0L_A
          IFEQ   #PLAO#,1,2 
          VFD    18/0 
          VFD    42/0 
          IFC    EQ,*B**
          VFD    18/=Y_A
          ELSE
          VFD    18/0 
          ENDIF 
          ENDM
          SPACE 2 
 OUTF     FILE   LFN=DCREATE,FO=DA
 SDACRTU
          SB1    1
          SA2    A1                KEY LOCATION 
          ZR     X2,ABT            ABORT IF KEY LOCATION NOT SET
          SX7    X2 
          SA7    KYADD             SAVE KEY LOCATION ADDRESS
          SA3    A1+B1             WORKING STORAGE ADDRESS
          ZR     X3,ABT 
          SX6    X3                SAVE ADDRESS 
          SA6    WSADD
          SA4    A1+2 
          ZR     X4,ABT      RECORD LENGTH
          SA4    X4 
          SX6    X4 
          SA6    AREC 
 SDACRT   SB2    2                 CLOBBERED BY FORM CALL 
          SB3    3
          SB1    1                 CONSTANT 
          SX6    B1 
          SA6    SORTC             SET NEW RECORD FLAG
 CHCK     MACRO  A,B
          SA4    A                 EXPECTED VALUES IN INPUT 
          SA2    B
          IX3    X4-X2             CHECK IF PARAMETER CORRESPONDS 
          NZ     X3,ABT 
          ENDM
          SA1    FCALL             CHECK FOR FIRST CALL 
          NZ     X1,NXTRCD
          READ   INPUT,R           READ INPUT FILE
          SA1    MSGBUF            SET INPUT FOR SCAN ROUTINE 
          SA7    PBUF 
* 
*  THIS  SUBROUTINE EXTRACTS PARAMETERS FROM AN INPUT BUFFER
*  THE AND OF THE   PARAMETER IS SPECIFIED WITH A SPECIAL CHARAC. 
*  THE RESULT IS STORED EACH PARAMETER IN A SEPARATE WORD 
* 
*  INPUT PARAMETERS-
*         A1 = FIRST WORD OF BUFFER CONTAINNING THE PARAMETERS
*         A7 = ADDRESS OF BUFFER WHERE THE RESULTS ARE TO BE STORED 
* 
          IX7    X7-X7      CLEAR X7
          SB3    6                      B3=6                    KONSTANT
          SB2    60                     B2=60                   KONSTANT
          MX0    54 
          SB6    B0 
          SB5    B2 
          SB4    X0 
          SB7    B2-B3    VARIES 54 _ 0 
          EQ     NEXTCHAR 
SENDOUT   BSS    0                                 START OF PRIME LOOP
          MX0    54 
          SB3    6
          SB7    B2-B3        RESET OUTPUT CHAR COUNTER 
          SB5    B2 
          IX7    X7-X7                                  CLEAR X7
NEXTCHAR  BSS    0      GET NEXT CHAR 
          LT     B7,B0,SENDOUT       IF X7 FULL STORE IT
          SB6    B6+B3
          LT     B2,B6,SENDIN 
          LX1    6                   ELSE PACK LOWER NEXT CHAR
          BX2    -X0*X1            ISOLATE CHARACTER IN X2
          SX6    X2-1R)            CHECK FOR RIGHT PARAN. 
          ZR     X6,NNM 
          SX6    X2-1R. 
          ZR     X6,NNM            EXIT IF END
          SX4    X2-1R+ 
          PL     X4,SPECIAL    IS IT SPECIAL
          SB4    X0 
          SB5    X0          SET B5 TO AN UNGODLY NUMBER
          LX2    B7,X2         ELSE SHIFT ALPHA CHAR TO OUTPUT POSITION 
PUTINUM   BSS    0
          SB7    B7-B3       -6 FM OUTPUT CHAR COUNTER
          BX7    X7+X2                  ADD IN NEW CHAR 
          EQ     NEXTCHAR 
SENDIN    BSS    0
          SA1    A1+B1                  READ NEW INPUT WORD 
          SB6    B0 
          EQ     NEXTCHAR 
SPECIAL   BSS    0
          SB7    B7-B3
          EQ     B4,NEXTCHAR
          SB4    B0 
 NNM      BSS    0
          SA7    A7+B1                  STORE PREV CHAR STRING
          ZR     X6,EXTRACT        EXIT IF END OF INPUT 
          EQ     SENDOUT
 EXTRACT  BSS    0
          CHCK   FRSTP,CREATE      CHECK PARAMETER VALIDITY 
          SA3    LFN               GET FILE NAME
          BX6    X3 
          SA6    OUTF              STORE FILE NAME IN FIT 
          SA0    A6 
          OPENM  OUTF,NEW,R 
          SA0    OUTF              SET FIT ADDRESS
          FETCH  A0,MRL,X2         MAXIMUM RECORD LENGTH
          BX6    X2 
          FETCH  A0,HMB,X3         NUMBER OF HOME BLOCKS
          SA6    MRL         INITIALIZE MRL FOR SORTMRG 
          SA6    AREC        SAVE RECORD LENGTH 
          LX7    B0,X3
          SA7    HMB
          FETCH  A0,RKP,X4         KEY POSITION 
          BX6    X4 
          FETCH  A0,RKW,X5         RELATIVE KEY WORD
          SA6    RKP
          LX7    B0,X5
          SA7    RKW
          FETCH  A0,KL,X1 
          BX6    X1 
          SA6    KL 
          STORE  OUTF,DFC=0  ERROR MSG TO DAYFILE 
          STORE  OUTF,EFC=3  ERROR MSG,STATICTS,NOTES TO ERROR FILE 
          SA1    HASH              CHECK FOR USER HASHING ROUTINE 
          NZ     X1,USRH           SKIP IF USER HASHING ROUTINE PROVIDED
          SA1    RJHASH 
          AX1    48 
          LX1    18                CLEAR THE RJ ADDRESS 
          SA2    =XDHASH.1+#PLAO#  SET UP 1.5 DEFAULT HASHING 
          F.RM   ORG,4
          PL     X4,MRGFLOW 
          SA2    =XDHASH.2+#PLAO#  SET UP 2.0 DEFAULT HASHING 
 MRGFLOW  BSS    0                 RESUME COMMON 1.5, 2.0 CODE
          SX6    X2 
          BX6    X1+X6       OR IN SYSTEM HASHING ADDRESS 
          LX6    30 
          SA6    A1                RESTORE JUMP WORD
          EQ     NXTRCD 
 USRH     BSS    0
          SA2    HFL               FILE CONTAINING USER-S HASH
          ZR     X2,ABT 
          SA3    BUF1+B1     FORMAT LOADER CALL FOR FILE
          MX0    42 
          BX6    -X0*X3 
          BX2    X0*X2
          BX6    X6+X2
          SA6    A3 
          SA3    ENT1        FORMAT LOADER CALL FOR ENTRY POINT 
          BX6    -X0*X3 
          IX6    X1+X6
          SA6    A3 
          LOADER BUFLD,CMM   LOAD FILE
          SA1    ENT1 
          SX1    X1 
          STORE  OUTF,HRL=X1       NEW HASHING ROUTINE ADDRESS
          SX3    010B              SET RJ TO HASHING ROUTINE
          LX3    51 
          LX1    30 
          BX6    X1+X3
          SA6    RJHASH 
 NXTRCD   BSS    0
          SA2    RKP
          SA3    KL 
          SA4    KYADD             CHECK FOR USER CALL
          NZ     X4,NUCL
          SA1    CCOM 
          FETCH  X1,WSA,X4
          SA2    CCOM+B1
          UX2    B6,X2             GET RECORD LENGTH
          LX6    B6,X2
          SX7    B0 
          SA7    CCOM+B1           SUPRESS OUTPUT 
*                                  CONTAINS RECORD LENGTH IN CHARACTERS 
          SA6    AREC 
 NUCL     SA5    RKW
          LX7    B0,X4
          SA7    FWARC             SAVE FWA OF RECORD IN CORE 
          IX4    X4+X5
          SB5    KYBUFF            SET INPUT PARAMETERS FOR 
          SA5    HMB
* 
*  THIS SUBROUTINE ALINES THE KEY TO RKP = , CLEANS THE GARBEAGE OF 
*  THE LAST WORD CONTAINNING THE KEY AND STORES THE KEY IN THE BUFFER 
*  WOSE ADDRESS IS SPECIFIED IN B5. 
* 
*   INPUT PARAMETERS -
*         X2 = KEY POSITION 
*         X3 = KEY LENGTH IN CH.
*         X4 = ADDRESS OF FIRST WORD CONTAINNING THE KEY
*         B5 = RETURN ADDRESS.
* 
          SB3    10                WORD SIZE
          SB4    X4                INPUT BUFFER ADDRESS 
          SB6    X3 
          BX7    X5                SAVE NUMBER OF HOME BLOCKS 
          NZ     X2,RKPZ           CHECK IF RKP=0 
          SB2    B0 
          SX0    B0 
          EQ     SFTAG
 RKPZ     BSS    0
          LX2    1                 FORM MASCK IN X2 
          LX1    B1,X2
          IX2    X2+X1
          SB2    X2 
          MX0    1
          SB2    B2-B1
          AX0    B2,X0             SHIFT MASCK TO RIGHT POSITION
          SB2    B2+B1
 SFTAG    BSS    0
          SA4    B4                LOAD NEXT WORD 
          SB4    B4+B1
          SB6    B6-B3
          SA5    B4 
          BX5    X0*X5
          BX4    -X0*X4 
          BX4    X4+X5
          LX6    B2,X4
          SA6    B5                STORE WORD 
          SB5    B5+B1
          GE     B6,B1,SFTAG
          ZR     B6,CLEAN1
          SB6    B6+10             RESTORE B6 
          SB6    B6+B6             MUL IPLAY B6 BY 6
          SB2    B6-B1
          SB6    B6+B6
          SB6    B2+B6
          MX0    1
          AX0    B6,X0
*                                  FORM MASK TO CLEAN OF GARBEAGE 
*                                  IN LAST WORD CONTAINNING THE KEY 
          SB5    B5-B1
          SA1    B5 
          BX6    X0*X1
          SA6    B5                RESTORE LAST WORD
 CLEAN1   BSS    0
          BX5    X7                RESTORE NUMBER OF HOME BLOCS 
          SX2    B0                SET INPUT PARAMETERS FOR HASHING 
          BX6    X2                SET INPIT PARAMETERSFOR
          SA6    FORTB             FORTRAN HASHING ROUTINES 
          SX7    A6 
          SA7    ADDB 
          SA3    KL                KEY LENGTH 
          BX6    X3 
          SA6    FORTB+1
          SX7    A6 
          SA7    ADDB+1 
          SA1    KYBUFF            ROUTINES 
          SX4    A1 
          BX6    X4 
          SA6    FORTB+2
          SA6    ADDB+2 
          BX7    X5 
          SA7    FORTB+3
          SX6    A7 
          SA6    ADDB+3 
          MX7    1
          SA7    FORTB+4
          SX6    A7 
          SA6    ADDB+4 
          SA1    ADDB+1      FWA ARGUMENT LIST FOR HASH.
          RJ     CLSTACK     CLEAR THE OPERATION STACK
 CLSTACK  BSSZ   1
 RJHASH   RJ     *+1S17 
+         SB1    1
          SA1    FORTB+4           CHECK IF COMPASS HASHING ROUTINE 
          OR     X1,COMPS 
          BX6    X1 
 COMPS    PL     X6,KEYP1 
          BX6    -X6
 KEYP1    SA5    HMB         CONVERT RANDOMIZED KEY TO MODULO OF HMB. 
          PX5    X5 
          NX7    X5 
          PX6    X6 
          FX7    X6/X7
          UX7    B6,X7
          LX7    B6,X7
          PX7    X7 
          DX7    X5*X7
          IX6    X6-X7
          SA6    RNDKY
          SA5    HMB
          IX3    X6-X5             CHECK IF KEY IN RANGE
          NG     X3,KEYOK 
          MESSAGE BADKY,,R
          ABORT 
 KEYOK    SA3    FWARC             FWA OF RECORD IN CORE
          SA4    X3-1              SAVE LOCATION CLOBBERED BY KEY 
          BX7    X4 
          SA7    SVA2 
          SA6    A4                STORE HASHED KEY 
          SA2    AREC 
          SX6    X2+10             ADD ONE WORD FOR HASHED-KEY
SORT45    IFEQ   SORT45,4 
          SA6    GETREC+B1
SORT45    ELSE
          SA6    RL 
SORT45    ENDIF 
          SA1    FCALL
          NZ     X1,NEWREC
          SX6    B1 
          SA6    FCALL             SET FIRST CALL COMPLETE FLAG 
SORT45    IFEQ   SORT45,4 
          SX1    B0 
          RJ     =XS.SRTSZ
          SORT   MAXCM=0
          KEY    1,1,10,60,LOGICAL
 GETREC   OWNCODE (MRL,0),(1,RECSORT),(3,SORTREC),(4,ENDCRT)
          EQ     NEWREC 
SORT45    ELSE
          SA1    PARAM1 
          RJ     =XSMSORT 
          SA1    PARAM3 
          RJ     =XSMOWN
          SA1    PARAM4 
          RJ     =XSMKEY
          RJ     =XSMEND
* 
PARAM1    VFD    60/RL
          VFD    60/0 
* 
PARAM3    VFD    60/P31 
          VFD    60/RECSORT 
          VFD    60/P33 
          VFD    60/SORTREC 
          VFD    60/P34 
          VFD    60/ENDCRT
          VFD    60/0 
P31       DATA   1
P33       DATA   3
P34       DATA   4
* 
PARAM4    VFD    60/P31 
          VFD    60/P31 
          VFD    60/P410
          VFD    60/*+2      POINTER TO 0 
          VFD    60/LOGICS
          VFD    60/0 
LOGICS    DATA   10HLOGICAL 
P410      DATA   10 
* 
SORT45    ENDIF 
 RECSORT
          SA2    SORTC
          SB1    1
          NZ     X2,NEWREC         EXIT IF NOT NEW RECORD 
          SA3    FWARC
          SA4    SVA2              RESTORE DATA CLOBBERED BY KEY
          BX6    X4 
          SA6    X3-1 
          SA1    KYADD
          ZR     X1,SDACRT         FORM EXIT
          EQ     SDACRTU           USER CALL EXIT 
 NEWREC   SX7    B0 
          SA7    SORTC             SET OLD RECORD FLAG
          SA3    AREC              GET RECORD LENGTH
          SA2    FWARC             RECORD LOCATION
SORT45    IFEQ   SORT45,4 
          SX0    X3+10             REC+KEY
          LX0    30 
          SA2    X2-1              RECORD LOCATION FOR SORT 
          EQ     RECSORT
SORT45    ELSE
          SX6    X3+10
          SA6    RL 
          SX6    X2-1        REC FWA
          SA6    PARAM5+1 
          SA1    PARAM5 
          RJ     =XSMRTN
* 
PARAM5    VFD    60/*+3      POINTER TO 0 
          VFD    60/0        REC FWA
          VFD    60/RL
          VFD    60/0 
RL        DATA   0
SORT45    ENDIF 
 SDAENDC
          MESSAGE STFL
          SB1    1
          SA3    WSADD             CHECK FOR USER CALL
          NZ     X3,UCALL 
          SA2    CCOM              LOAD FIT ADDRESS 
          FETCH  X2,WSA,X3
 UCALL    BSS    0
          SA5    AREC 
          SX0    X5+10             REC LENGTH+KEY FOR SORT
          LX0    30 
          SA2    X3 
SORT45    IFEQ   SORT45,4 
          SA1    RECSORT           SET RETURN ADDRESS FOR BEGINNING 
          SX2    3
          LX2    30 
          IX6    X1+X2             START SORT/MERGE FASE
          SA6    A1 
          RJ     CLSTCK      CLEAR THE OPERATION STACK
 CLSTCK   BSSZ   1
          EQ     RECSORT
SORT45    ELSE
*ABOVE TEN INSTRUCTIONS PROBABLY MEANINGLESS
          SA1    PARAM6 
          RJ     =XSMRTN
* 
PARAM6    VFD    60/P33 
          VFD    60/0 
SORT45    ENDIF 
 SORTREC
          SB1    1
SORT45    IFEQ   SORT45,4 
          SX2    A2+B1
SORT45    ELSE
          SX2    X1+B1
          SA1    A1+B1
          SA1    X1 
          BX0    X1 
SORT45    ENDIF 
          STORE  OUTF,WSA=X2       SET WSA ADDRESS FOR DA FILE
SORT45    IFEQ   SORT45,4 
          AX0    30 
SORT45    ENDIF 
          SX3    X0-10             TRUE RECORD LENGTH FOR SDA 
          SA0    OUTF              RESTORE FIT ADDRESS
          FETCH  A0,FWB,X1
          SB7    X1                RESTORE FSTT ADDRESS 
          SX5    A0 
          PUT    X5,,X3            WRITE RECORD 
SORT45    IFEQ   SORT45,4 
          SA1    SORTREC
          AX1    30 
          SB5    X1                DELETE RECORD FROM OUTPUT
          JP     B5+1 
SORT45    ELSE
          SA1    PARAM7 
          RJ     =XSMRTN
* 
PARAM7    VFD    60/P31 
          VFD    60/0 
SORT45    ENDIF 
 ENDCRT 
          CLOSEM  OUTF
          RJ     =XCMM.GSS         GET JOB STATISTICS 
          SA1    X1+1 
          SB2    COREUSE
          RJ     SD$BIND
          MESSAGE COREUSE,,R
SORT45    IFNE   SORT45,4 
*         HERE WE RETURN TO USER WITHOUT GIVING SORT A CHANCE TO DO A 
*         FINAL TIDY-UP E.G. RELEASING CAPSULES.
SORT45    ENDIF 
          EQ     SDAENDC
* 
**********THIS ROUTINE CONVERTS OCTAL VALUES TO DISPLAY CODE**********
* 
*  INPUT PARAMETERS-
*         X1 = WORD TO BE CONVERTED(OCTAL)
*         B1 = 1
*         B2 = ADDRESS TO RETURN DISPLAY CODE EQUIVALENT OF X1
* 
 SD$BIND  EQ     *+1S17 
          MX0    3           *SET UP A 3-BIT MASK IN X0 
          SX6    B0          *ZERO OUT THE RESULT REGISTER, X6
          LX0    3           *3-BIT MASK RIGHT JUSTIFIED IN X0
          SB5    B0          *USE B5 AS SHIFT COUNT - INTIALLY 0
          SB3    10 
          SB4    6
          SX7    33B         *33B RIGHT JUSTIFIED IN X7 
 OCTDIS1  SB3    B3-1        *B3 REGISTERS THE NO. OF DIGITS LEFT 
          BX3    X1*X0       *MASK OFF NEXT DIGIT FROM SOURCE 
          NZ     X3,OCTDIS2 
          NZ     X1,OCTDIS2 
          SX3    22B         *REPLACES LEADING ZEROS WITH BLANKS
 OCTDIS2  IX4    X3+X7       *CONVERT DIGIT TO DISPLAY CODE 
          LX4    B5          *SHIFT THE DISPLAY CODED DIGIT 
          SB5    B5+B4       *ADD 6 TO THE SHIFT COUNT
          BX6    X6+X4       *MASK INTO RESULT REGISTER, X6 
          AX1    3           *DROP THE PROCESSED DIGIT FROM SOURCE
          NZ     B3,OCTDIS1 
          SA6    B2 
          EQ     SD$BIND
* 
*  HERE THE RUN IS ABORTED WHEN A FATAL ERROR CONDITION IS ENCOUNTERED. 
* 
 ABT      BSS    0
          MESSAGE BPARM,,R
          ABORT 
          END 
