/SORT VERSION II FOR OS/8 / /BRYAN FREDRICK, MINNESOTA POLLUTION CONTROL AGENCY /SEPTEMBER, 1977 / CLA1=7600 /GROUP 1 CLA - ALSO USED AS CONSTANT LISTPT=15 /AUTO INDEX PTR FOR LIST BUFPTR=16 /AUTO INDEX STORAGE REGISTER X10=10 X11=11 INPLEN=4032 /INPUT FILE LENGTH FROM SORTCD USR=200 /FOR FUTURE REFERENCES USRIN=7700 INPDEV=INPLEN-2 /INPUT DEVICE NUMBER INPBLK=INPLEN-1 OUTDEV=4022 /OUTPUT DEVICE NAME FROM SORTCD SPECS=4000 DIRPTR=17 /DIRECTORY POINTER AUTO-INDEX *165 KOKAY, ISOK JPACK, PACKC SPACNT, 0 MN240, -240 CMPRS1, 0 DCA CCHCK /STORE CHARACTER TAD CMPRS /CHECK FOR /C SNA CLA JMP I KOKAY /OPTION NOT SET TAD CCHCK /SET, CHECK FOR A SPACE TAD MN240 SZA CLA JMP NTBLNK /NOT A BLANK ISZ SPACNT /A SPACE, BUMP SPACE COUNT JMP I CMPRS1 /AND EXIT NTBLNK, TAD SPACNT /GET THE COUNT SNA JMP ISOK /ZERO SPACE COUNT, OKAY TAD M1 /CHECK FOR ONLY 1 SPACE SNA CLA JMP SPACOT TAD K377 /OUTPUT A RUBOUT JMS I JPACK TAD SPACNT /THEN THE SPACE COUNT SKP SPACOT, TAD P240 /OUTPUT A SPACE FOR 1 JMS I JPACK ISOK, DCA SPACNT /CLEAR COUNT TAD CCHCK /OUTPUT CHARACTER JMS I JPACK JMP I CMPRS1 /EXIT K377, 377 /THE FOLLOWING CODE SHOULD BE INCLUDED SOMEWHERE IN THE RESIDENT SORT CODE / /ENTER TEMPORARY FILE ON OUTPUT DEVICE /AC ON CALL = POINTER TO FILE NAME /ASSUMES USR IN CORE ON CALL / ENTER, 0 DCA NAMPTR /STORE NAME POINTER IN REQUEST TAD OUTNUM /GET OUTPUT DEVICE NUMBER CIF 10 JMS I (USR /ENTER FILE 3 NAMPTR, STBLK, 0 FLENG, 0 /OUTPUT FILE LENGTH ERRHLT /ERROR ON CALL JMP I ENTER / /SORT KEY STORAGE AREA / STORG, 0 /SUBROUTINE TO SET UP ALTERNATE TERMINAL CODES DCA ENTER /STORE TERMINAL CODE IN A SAFE PLACE TAD I JTYPE1 AND K7007 /AND OFF ACTION CODES TAD ENTER /ADD IN DEVICE CODE DCA I JTYPE1 /STORE IN I-O REQUEST TAD I JTYPE2 AND K7007 TAD ENTER DCA I JTYPE2 JMP I STORG /EXIT K7007, 7007 JTYPE1, TYPEA+1 JTYPE2, TYPEA+2 ZBLOCK STORG+20-. PACK, 0 AND (377 JMP I PACKA PACKA, PACK1 JMP I PACK PACK1, DCA I ADDROT JMS PACKA DCA CHART JMS PACKA RTL CLL RTL DCA PACKA TAD PACKA AND P7400 TAD I ADDROT DCA I ADDROT ISZ ADDROT TAD PACKA RTL CLL RTL AND P7400 TAD CHART DCA I ADDROT ISZ ADDROT JMS PACKA JMP PACK1 / /SUBROUTINE TO CLOSE CURRENT SRTINT.AA / CLOSE, 0 TAD WRTEN /GET NUMBER OF BLOCKS ACTUALLY WRITTEN TO DISK DCA FLXLEN TAD OUTNUM /GET DEVICE NUMBER CIF 10 JMS I (USR /CLOSE CURRENT OUTPUT FILE 4 FAKNAM /DUMMY FILE NAME NEEDED TO PRESERVE CURRENT "SRTINT.AA" FLXLEN, 0 ERRHLT-1 /ERROR ON CLOSE ISZ FILES /INCREMENT NUMBER OF INTERMEDIATES ALLOCATED TAD WRTEN TAD BLKSW /STORE NUMBER OF BLOCKS WRITTEN DCA BLKSW DCA WRTEN /CLEAR NUMBER WRITTEN TO FILE JMP I CLOSE RWDIR, 0 TAD (200 DCA IOREQ+1 TAD OUTBUF DCA IOREQ+2 TAD DIRBLK DCA IOREQ+3 IOREQ, JMS I OUTENT /READ-WRITE DIRECTORY SEGMENT ZBLOCK 3 ERRHLT-2 JMP I RWDIR INITAL, 0 TAD M600 DCA WRTCNT TAD OUTBUF DCA ADDROT TAD (PACK1 DCA PACKA JMP I INITAL PACKC, 0 JMS PACK /PACK IT INTO BUFFER ISZ WRTCNT /CHECK FOR DONE WITH BLOCK JMP I PACKC /NO, GET MORE CHARACTERS TAD WRTBLK DCA BLOCK JMS I OUTENT /WRITE BLOCK ON INTERMEDIATE 4200 OUTBUF BLOCK, 0 ERRHLT-2 ISZ WRTBLK ISZ WRTEN JMS INITAL /RE-INITIALIZE PACK ROUTINE JMP I PACKC PAGE PRGST, CLA CMA /CLR ADDRESS FOR STORING RECORDS DCA BUFPTR DCA ADDRES TAD (LIST-1 DCA LISTPT DCA LINES /CLEAR NUMBER OF LINES PROCESSED READRC, JMS I (READBF /READ A RECORD JMP I (EOFND /EOF RETURN ISZ RECIN+1 /INCREMENT RECORD IN COUNT SKP ISZ RECIN ISZ LINES /COUNT NUMBER OF LINES IN THIS BUFFER TAD ADDRES /STORE ADDRESS AND LINE LENGTH IN LIST DCA I LISTPT TAD LENGTH DCA I LISTPT DCA LENGTH /CLEAR LINE LENGTH CLA IAC /FIND NEXT ADDRESS FOR STORING TAD BUFPTR /BY ADDING 1 TO BUFFER POINTER AUTO-INDEX DCA ADDRES CLA IAC CLL TAD LISTPT /CHECK FOR LINE LIST OVERFLOW CIA TAD OUTBUF /INTO OUTPUT BUFFER AREA SNA CLA JMP SORTIT /YES, DICONTINUE OPERATION AND DO SORT CLA STL TAD (-7300 /CHECK FOR FULL TEXT BUFFER TAD ADDRES SZL CLA JMP READRC /NOT FULL CONTINUE READING SORTIT, TAD LISTPT /SET UPPER LIST BOUND FROM LISTPTR DCA UPPRLM TAD (LIST /SETUP LOWER LIST BOUND DCA LOWRLM PASS1, CLA CMA /SET LIST STORE PTR TAD LOWRLM DCA X10 JMS CCHCK /CHECK FOR A ^C TYPED ON KEYBOARD TAD X10 /AND LIST POINTER DCA LISTPT TAD I LISTPT /READ FIRST RECORD INFO DCA ADDR1 TAD I LISTPT DCA LEN1 DCA SWITCH /CLEAR PERMUTATION COUNT DCA DIRECT /AND DIRECTION POINTER READUP, TAD LISTPT /CHECK FOR DONE (I.E. LISTPT >= UPPRLM) CIA STL TAD UPPRLM SZL SNA CLA JMP DNEUP /LISTPT >= UPPRLM ALL DONE WITH THIS PASS TAD I LISTPT /PICKUP SECOND RECORD ARGS DCA ADDR2 TAD I LISTPT DCA LEN2 JMS I (COMPAR /CHECK THIS PAIR OF RECORDS JMP READUP /COMPARISON COMPLETE, GET NEXT RECORD DNEUP, TAD X10 /STORE NEW UPPER LIMIT DCA UPPRLM TAD ADDR1 /AND STORE EXTREME REMAINING VALUE DCA I X10 TAD LEN1 DCA I X10 TAD SWITCH /CHECK FOR ALL DONE (I.E. ZERO PERMUTATIONS) SNA CLA JMP I (PACKIT /ALL DONE PACK OUT THIS BUFFER DCA SWITCH /CLR PERMUTATION COUNT FOR NEXT TIME THRU STL RAR /SET DIRECTION TO DOWNWARD DCA DIRECT CLA CMA /GET STARTING LOCATION TO DOWN SORT TAD UPPRLM DCA PTR1 STA CLL RAL TAD UPPRLM /AND LIST STORAGE ADDRESS DCA X10 TAD I PTR1 /PICKUP FIRST ARGS DCA ADDR1 ISZ PTR1 TAD I PTR1 DCA LEN1 DWNLP, CLA CLL CMA RTL /AC=-3 TAD PTR1 /SUBTRACT 3 FROM PTR1 TO GET NEW POINTER DCA PTR1 TAD PTR1 /CHECK FOR DONE (I.E. PTR1 < LOWRLM) CIA STL TAD LOWRLM SNL SZA CLA JMP DNEDWN TAD I PTR1 DCA ADDR2 ISZ PTR1 TAD I PTR1 DCA LEN2 JMS I (COMPAR /COMPARE THIS PAIR OF RECORDS TAD (-4 /MOVE STORING POINTER DOWN TO NEXT POSITION TAD X10 DCA X10 JMP DWNLP /CONTINUE TO PROCESS SORT DNEDWN, TAD ADDR1 /STORE LOWEST VALUE DCA I X10 TAD LEN1 DCA I X10 IAC /LOWEST LIMIT=X10 +1 TAD X10 DCA LOWRLM TAD SWITCH /CHECK FOR ALL DONE SNA CLA JMP I (PACKIT JMP PASS1 /NOT DONE CONTINUE FAKNAM, FILENAME SRTINT.DI /DIRECTORY FILE FOR SORT PUTBF, 0 CDF 10 /SORT BUFFER IS IN FLD 1 DCA I BUFPTR CDF ISZ LENGTH /AND INCREMENT LINE LENGTH JMP I PUTBF PAGE COMPAR, 0 TAD SRTKEY /STORE LOOP INDEX DCA LPTR LOOPT, TAD LPTR /COMPUTE SORT SPECIFICATION ADDRESS RAL CLL TAD KYPTR JMS COMPA1 /COMPARE THE TWO RECORDS ON THIS KEY SNA JMP LOOPE /RECORDS COMPARE EQUAL SMA CLA JMP OUTOF /MUST PERMUTE RECORDS STOR1, TAD ADDR1 /RECORDS IN ORDER, NO CHANGES REQUIRED DCA I X10 /STORE PTRS TAD LEN1 DCA I X10 TAD ADDR2 /CHANGE WITH DCA ADDR1 TAD LEN2 DCA LEN1 JMP I COMPAR LOOPE, ISZ LPTR /MOVE TO NEXT KEY JMP LOOPT JMP STOR1 /EQUAL, PRESERVE ORGINAL SEQUENCE OUTOF, ISZ SWITCH /SET PERMUTE SWITCH NOP TAD ADDR2 DCA I X10 TAD LEN2 DCA I X10 JMP I COMPAR COMPA1, 0 /SUBROUTINE TO COMPARE 1 KEY AT A TIME DCA SRTCH /SAVE ADDRESS OF SORT SPECIFICATION TAD I SRTCH DCA P1 /STORE FIRST WORD CLA CLL CMA RAR /AC=3777 AND P1 /AND OFF LENGTH OF KEY CIA DCA INDA ISZ SRTCH /BUMP PTR TO NEXT WORD CLA CMA TAD I SRTCH /GET CHARACTER NUMBER DCA SRTCH LPAR, JMS SHORT /CHECK FOR SHORT RECORDS TAD ADDR1 /COMPUTE CHARACTER ADDRESS OF NEXT COMPARE TAD SRTCH DCA CHAR1 TAD ADDR2 TAD SRTCH DCA CHAR2 CDF 10 TAD I CHAR2 CIA TAD I CHAR1 CDF /DATA FIELD BACK TO LOCAL SZA JMP NOEQL /CHARACTERS ARE NOT EQUAL ISZ SRTCH /CHARACTERS ARE EQUAL, MOVE TO NEXT IN STRING ISZ INDA /CHECK FOR ALL DONE WITH KEY JMP LPAR /NOT YET JMP I COMPA1 /DONE AND STRINGS ARE EQUAL NOEQL, SPA CLA CLA CMA CLL RAL IAC /AC = +1 IF KEY AT ADDR1+SRTCH > KEY AT ADDR2+SRTCH /AC= -1 IF KEY AT ADDR1+SRTCH < KEY AT ADDR2+SRTCH DCA INDA /TEMP STORE TAD P1 /CHECK ASCENDING/DESCENDING BIT AND DIRECTION OF SORT TAD DIRECT CLL RAL CLA TAD INDA /PICKUP ARG AGAIN SZL /COMPLEMENT IF LINK SET CIA JMP I COMPA1 /NOT EQUAL EXIT P1, 0 CHAR1, 0 CHAR2, 0 INDA, 0 SRTCH, 0 SHORT, 0 /SUBROUTINE TO CHECK FOR SHORT RECORDS CLA STL TAD LEN1 SNA JMP .+3 TAD SRTCH /CHECK FOR LEN2 < THIS CHARACTER # SNL CLA IAC DCA SHRT1 /SET IF RECORD IS SHORT CLA STL TAD LEN2 SNA JMP .+3 TAD SRTCH /CHECK THIS RECORD FOR SHORT SNL CLA IAC DCA SHRT2 TAD SHRT1 SNA CLA JMP FALSE /NOT SET TAD SHRT2 /RECORD 1 IS TOO SHORT, CHECK RECORD 2 SZA CLA JMP I COMPA1 /BOTH TOO SHORT, EXIT COMPARISON AS EQUAL CMA JMP NOEQL /RECORD 1 TOO SHORT, BUT RECORD 2 OKAY FALSE, TAD SHRT2 SNA JMP I SHORT /BOTH RECORDS LONG ENOUGH JMP NOEQL /RECORD 1 LONG ENOUGH, BUT RECORD 2 TOO SHORT SHRT1, 0 SHRT2, 0 LPTR, 0 EOFND, ISZ EOFLG /SET EOF FLAG CLA CLL CMA TAD LINES /CHECK FOR ZERO OR 1 LINES IN BUFFER SNL JMP ZERECS /ZERO RECORDS LEFT, CHECK DISPOSITION SZA CLA JMP I (SORTIT /MORE THAN 1 RECORD IN BUFFER, SORT THE BUFFER JMP I (PACKIT /EXACTLY 1 RECORD, PACK IT OUT ZERECS, TAD SEGMNT /CHK # OF SEGMENT WRITTEN TO DSK SZA CLA JMP I (CHAIN /HAVE ALREADY WRITTEN SOME, CAN IGNORE THIS ONE JMP I (PACKIT /MUST PACK AN EOF FOR NULL FILE INTNAM, FILENAME SRTINT.AA PAGE / /SUBROUTINE TO READ RECORDS, ADJUST POINTERS AND STORE IN BUFFER / READBF, 0 NEXTCH, CLA CMA /SET JMP FLAG DCA JMPFLG TAD BUFCNT /CHECK NUMBER OF CHARACTERS LEFT IN BUFFER SZA CLA JMP OKAY /STILL SOME CHARACTERS LEFT TAD INLEN /CHECK FOR ANY MORE BLOCKS TO BE READ ON INPUT SNA CLA JMP I READBF /ZERO BLOCKS LEFT, DO EOF EXIT TAD INPBUF /SOME BLOCKS LEFT TO READ, GO GET THEM DCA REQRD+2 TAD INBLOC DCA REQRD+3 REQRD, JMS I INPENT /READ INPUT FILE 200 CHAR, ZBLOCK 2 SNA CLA /ZERO RETURNS ARE ACCEPTABLE (EOF'S) SKP ERRHLT-3 ISZ INBLOC /BUMP INPUT BLOCK NUMBER ISZ INLEN /AND REMAINING INPUT LENGTH MONITR, CLA I /CLA I=7600=MONITOR JUMP ADDRESS TAD M600 /FIX UP NUMBER OF CHARACTERS TO READ DCA BUFCNT TAD (PICK1 /AND UNPACKING ROUTINE DCA PICKA TAD INPBUF /AND PUT POINTER AT BEGINNING OF BUFFER DCA PICKAX OKAY, JMS PICK /GET 1 CHARACTER ISZ BUFCNT /BUMP BUFFER COUNT MRUB, 7401 /WITH NO PROBLEM ON SKIP (7401=NOP, ALSO = -RUBOUT) ISZ JMPFLG /TEST IF AN UNPACK COUNT JMP CHKZER /AN UNPACK COUNT, CHECK FOR 0 DCA CHAR /STORE CHARACTER TAD CHAR /EDIT CHARACTER TAD (-232 /CHECK FOR ^Z SNA JMP I READBF /EQUAL, TAKE EOF EXIT TAD (232-215 /CHECK FOR CR (END-OF-LINE) SNA JMP EOL /EQUAL, DO EOL PROCESSING TAD (215-211 /CHECK FOR HORIZONTAL TAB SNA JMP TAB /EXPAND TABS OUT TO APPRORIATE NUMBER OF SPACES TAD (211-240 /THROW AWAY ALL OTHER CONTROL CHARACTERS SPA CLA JMP NEXTCH /GET NEXT CHARACTER ON CONTROL CHARACTER TAD CMPRS /CHECK IF COMPRESS MODE SPECIFIED SZA CLA TAD MRUB /COMPRESS MODE SET, CHECK FOR A RUBOUT TAD CHAR SNA CLA JMP NEXTCH+1 /CHARACTER IS A RUBOUT AND COMPRESS MODE SET, GET COUNT PUTCHR, TAD CHAR /NOT A CONTROL CHARACTER, PUT IN SORT BUFFER JMS I PUTCH JMP NEXTCH /AND GET NEXT CHARACTER EOL, ISZ READBF /EXIT TO P+2 TAD LENGTH /COMPLEMENT RECORD LENGTH CIA DCA LENGTH JMP I READBF /TAKE END OF RECORD EXIT TAB, TAD P240 /EXPAND TABS OUT WITH SPACES JMS I PUTCH TAD LENGTH /UNTIL MULTIPLE OF 8 COLUMNS HAS BEEN REACHED RAR CLL SNL RAR SNL RAR SZL CLA JMP TAB /COLUMN NUMBER NOT YET DIVISIBLE BY 8, CONTINUE INSERTING SPACES JMP NEXTCH /EVERYTHING IS HONKY-DOREY GET NEXT CHARACTER CHKZER, SNA /ZERO COUNT MEANS AN ACTUAL RUBOUT JMP PUTCHR /PUT IT IN RECORD CIA /COMPLEMENT UNPACK COUNT JMP UNPACK /GO UNPACK (AC) SPACES / /SUBROUTINE TO UNPACK CHARACTERS 1 AT A TIME FROM OS/8 FILE BUFFER / PICK, 0 CDF JMP I PICKA PICKA, PICK1 AND (177 TAD (200 JMP I PICK PICK1, TAD I PICKAX AND P7400 DCA TEMP TAD I PICKAX ISZ PICKAX JMS PICKA TAD I PICKAX AND P7400 RTR CLL RTR TAD TEMP RTR CLL RTR DCA TEMP TAD I PICKAX ISZ PICKAX JMS PICKA TAD TEMP JMS PICKA JMP PICK1 TEMP, 0 PICKAX, 0 CHAIN, CIF 10 /BRING BACK THE USR JMS I (USRIN 10 JMS I (CLOSE /CLOSE CURRENT OUTPUT FILE JMS SYSRD /READ DOWN SYSTEM OVERLAY JMS I STATS /TYPE OUT STATISTICS TAD SLASHH /CHECK FOR /H OPTION SET SZA CLA JMP I MONITR /SET, RETURN TO OS/8 MONITOR CIF 10 JMS I (USR /NOW CHAIN TO MERGE 6 MRGCH, 0 PAGE / /SUBROUTINE TO PACK OUTPUT BUFFER AND WRITE TO DISK / PACKIT, TAD LINES /DETERMINE NUMBER OF BLOCKS TO BE WRITTEN RAL CLL IAC /MULTIPLY BY 2 AND ADD 2 (FOR ^Z AND CR-LF) TAD BUFPTR /ADD IN NUMBER OF CHARACTERS IN THE BUFFER. DCA SYSRD /GIVING NUMBER OF CHARACTERS TO BE OUTPUT DCA LEN1 /CLEAR BLOCK COUNTER RAL /GET OVERFLOW LOOP0, DCA LEN2 /STORE IT TAD LEN2 /CHECK FOR ALL DONE SPA JMP OUT SZA CLA JMP LOOP3 TAD SYSRD SNA CLA JMP OUT LOOP3, JMP SUBTR2 /SUBTRACT 600 FROM NUMBER OF CHARACTERS TO BE WRITTEN OUT, CLL CLA TAD OLENG /CHECK TO SEE IF THIS SECTION WILL FIT TAD LEN1 DCA OLENG /STORE UPDATED LENGTH SNL CLA JMP HVERM /WE HAVE ENOUGH ROOM ON CURRENT SRTINT CIF 10 /NO ROOM, CLOSE THIS FILE AND BRING ENTER A NEW ONE JMS I (USRIN /AFTER FIRST BRINGING IN USR TO CORE 10 JMS I (CLOSE /GO DO CLOSE OF FILE TAD (INTNAM /NOW ENTER NEW FILE JMS I (ENTER CIF 10 JMS I (USR /RESTORE USR AREA 11 DCA WRTEN /CLEAR NUMBER OF BLOCKS WRITTEN TAD I (FLENG /FIX UP NEW LENGTH DCA OLENG TAD I (STBLK /AND START BLOCK DCA WRTBLK CLL /CHECK IF SEGMENT WILL FIT THIS TIME TAD OLENG TAD LEN1 SZL CLA ERRHLT-4 /NO ROOM HVERM, STL RAR CLA /SET FIRST DIGIT=4=SRTINT TAD OUTNUM /CONSTRUCT DIRECTORY SEGMENT DCA I DIRPTR TAD WRTBLK DCA I DIRPTR TAD LEN1 CIA DCA I DIRPTR STL RAR CLA /AC=4000 FOR WRITE DIRECTORY SEGMENT JMS I (RWDIR /WRITE DIRECTORY SEGMENT JMS I (INITAL /INITIALIZE PACK OPERATION TAD LINES /CHECK NUMBER OF LINES TO PACK SNA JMP ENDIT /ZERO LINES, JUST NEED TO DO A EOF CIA DCA LINES TAD (LIST-1 /INITIALIZE LIST PTR DCA LISTPT LOOP1, TAD I LISTPT /GET ADDRESS OF LINE DCA ADDR1 TAD I LISTPT SNA JMP EOL1 /ZERO LENGTH = JUST CR-LF DCA LEN2 /STORE LINE LENGTH LOOP2, CDF 10 TAD I ADDR1 /PICK UP CHARACTER FROM BUFFER CDF ISZ ADDR1 /BUMP ADDRESS POINTER JMS CMPRS1 AROUND, ISZ LEN2 /INCREMENT LINE LENGTH JMP LOOP2 /NOT DONE YET EOL1, TAD (215 /DONE WITH LINE, PACK IN CR-LF JMS CMPRS1 TAD (212 JMS CMPRS1 ISZ LINES /CHECK FOR ALL DONE WITH BUFFER JMP LOOP1 /NO GET NEXT LINE ENDIT, TAD (232 JMS CMPRS1 TAD I (WRTCNT TAD (600 /CHECK FOR BUFFERING COMPLETE SZA CLA JMP ENDIT+1 /CONTINUE PACKING CHARACTERS ISZ SEGMNT /BUMP NUMBER OF SEGMENTS CLA CMA TAD INPBUF /CHECK TO SEE IF WE HAVE FILLED DIRECTORY SEGMENT CIA TAD DIRPTR SNA CLA JMP ZERDIR /HAVE FILLED, ZERO DIRECTORY AREA REJN, JMS I (RWDIR /READ SEGMENT BACK TO OUTPUT BUFFER TAD EOFLG SNA CLA JMP I (PRGST /NOT ENDED YET, READ SOME MORE JMP I (CHAIN /EOF FOUND, DO CHAIN TO MERGE ZERDIR, CLA CMA TAD OUTBUF DCA X10 TAD P7400 /ZERO ALL OF NEW DIRECTORY SEGMENT DCA LINES ISZ LINES /CHECK FOR DONE JMP .-2 CLA CMA TAD OUTBUF DCA DIRPTR ISZ DIRBLK /THEN WRITE AS NEW DIRECTORY SEGMENT STL RAR JMP REJN PAGE / /STORAGE BUFFER FOR LINE INFO EXTENDS FROM HERE DOWN TO LIST+2*(#LINES IN /BUFFER). ABSOLUTELY CANNOT EXTEND PAST BEGINNING OF OUTPUT BUFFER (WHOSE /LOCATION MAY BE FOUND IN LOCATION OUTBUF. / LIST=. *4400 / /STORAGE ALLOCATION FOR SORT -- LATER OVERLAID WITH SORT TABLES /DYNAMICALLY ALLOCATES HANDLERS TO UPPER CORE AND DETERMINES /LOCATIONS FOR INPUT AND OUTPUT BUFFERS. / BEGIN, CLA IAC /START UP JMS I (ALTERM /CHECK FOR ALTERNATE TERMINAL CIF 10 JMS I (USRIN /LOCK USR INTO CORE 10 CIF 10 JMS I (USR /RESET SYSTEM TABLES SO NO PROBLEMS DEVELOP 13 TAD (0423 /MAKE DEVICE NAME "DSK" DCA N1 TAD (1300 DCA N2 TAD I (INPLEN /STORE LENGTH OF INPUT FILE SNA /STORE 1 FOR 0 (NON-FILE STRUCTURED INPUT) IAC DCA INLEN TAD I (INPBLK /AND STARTING BLOCK OF INPUT FILE DCA INBLOC JMS ASSIGN /GO DO FETCH DYNAMICALLY SYSCOR, DCA OUTENT /STORE ENTRY PT TAD N2 DCA OUTNUM /STORE OUTPUT DEVICE NUMBER JMP INPFLE /DO THE SAME FOR INPUT DEVICE INPFLE, TAD I (INPDEV /GET INPUT DEVICE NUMBER DCA N2 TAD N2 CIF 10 JMS I (USR /DO "INQUIRE" ABOUT INPUT DEVICE 12 LOC3, 0 ERRHLT-5 /ERROR RETURN TAD LOC3 /CHECK FOR DEVICE HANDLER ALREADY IN CORE SNA JMS FETCH /NOT IN CORE, GO TO IT DCA INPENT /SAVE INPUT DEVICE ENTRY PT JMS GETPAG /NOW LOCATE INPUT AND OUTPUT BUFFERS IN CORE CLA JMS GETPAG DCA INPBUF /STORE INPUT BUFFER STARTING LOCATION JMS GETPAG CLA JMS GETPAG DCA OUTBUF /STORE OUTPUT BUFFER BEGINNING LOCATION DCA I (INPDEV /CLEAR OUTPUT DIRECTORY AREA DCA I (INPBLK DCA I (INPLEN JMS I (FIXFLS /ENTER DIRECTORY AND FIRST INTERMEDIATE FILE TAD I (STBLK /STORE START AS BEGINNING OF DIRECTORY DCA WRTBLK TAD (SPECS-INPDEV /MOVE SORT DATA TO OUTPUT AREA DCA LOC3 TAD (SPECS-1 DCA X10 CLA CMA TAD OUTBUF /PUT OUTPUT BUFFER ADDRESS-1 INTO DIRPTR AUTO-INDX DCA DIRPTR COPYIT, TAD I X10 /MOVE DATA TO NEW POSITION DCA I DIRPTR ISZ LOC3 /CHECK FOR ALL DONE JMP COPYIT /NOT YET JMS I (FILZER /HAVE COPIED INFO, FILL REMAINDER WITH ZEROS TAD I (FLENG /CHECK FILE SIZE DCA OLENG /STORE LENGTH OF WRITEABLE INTERMEDIATE AREA TAD (SPECS-1 DCA X10 /SET UP TO COPY SORT KEYS TO LOWER CORE TAD I X10 DCA SRTKEY /SAVE NUMBER OF SORT KEYS TAD (STORG-1 DCA X11 TAD (-20 DCA LOC2 TAD I X10 DCA I X11 ISZ LOC2 JMP .-3 /COPY SORT KEYS TO LOWER CORE JMP I (MOVKYS /MOVE KEYS TO LOWER CORE ASSIGN, 0 CIF 10 JMS I (USR /DO "INQUIRE" ABOUT DEVICE 12 N1, 0 N2, 0 LOC1, 0 ERRHLT-5 TAD LOC1 /CHECK FOR DEVICE HANDLER IN CORE SZA JMP I ASSIGN /ALREADY PRESENT, EXIT WITH ENTRY PT IN AC JMS FETCH /NOT PRESENT FETCH IT JMP I ASSIGN /EXIT WITH ENTRY PT IN AC FETCH, 0 JMS GETPAG /FIND SPACE FOR HANDLER DCA LOC2 FETRY, TAD N2 CIF 10 JMS I (USR /FETCH DEVICE HANDLER 1 LOC2, 0 JMP TWOPAG /MUST BE A TWO-PAGE HANDLER TAD LOC2 JMP I FETCH /EXIT WITH ENTRY IN AC TWOPAG, CLA I JMS GETPAG IAC /GRUDGINGLY MAKE SPACE FOR TWO-PAGE HANDLER JMP FETRY-1 /AND GO GET IT GETPAG, 0 TAD TWOPAG TAD LOCNUM DCA LOCNUM /SUBTRACT 200 OCTAL FROM LAST LOCATION TAD LOCNUM /LEAVE WITH IT IN THE AC JMP I GETPAG LOCNUM, CLA I PAGE MOVKYS, DCA BUFCNT /MAKE SURE BUFFER COUNTER IS EMPTY DCA RECIN /CLR NUMBER OF INPUT RECORDS DCA RECIN+1 / /FIX UP OUTPUT AND ERROR ROUTINES DEPENDENT ON BATCH BEING IN CORE / BATCR, STL RTR CLA /MASK FOR BATCH-IN-PROGRESS BIT AND I M1 /AND WITH STATUS WORD SNA CLA JMP NOBAT /NO BATCH PRESENT, PROCEED NORMALLY TAD I M1 /PICK UP BATCH FIELD AND (70 /FROM STATUS WORD TAD (CIF /CONSTRUCT CIF BATCHFLD DCA I (FLDCH1 TAD I (FLDCH1 /CONSTRUCT CDF CIF BATCHFLD IAC DCA I (FLDCH2 TAD (BATYP /MAKE OUTPUT ROUTINE BATCH OUTPUT ROUTINE DCA TYPE TAD (FLDCH2 /MAKE BATCH ABORT ERROR EXIT. DCA ERROR NOBAT, TAD SRTKEY /SET UP INDEX TO SORT KEYS CIA RAL CLL TAD (STORG /ADD IN TABLE ADDRESS DCA KYPTR /POINTER TO END OF TABLE JMS I SYSENT /WRITE OUT I-O OVERLAY 4400 STATYP 33 /SYSTEM SCRATCH BLOCKS ERLOC, ERRHLT-6 /SYSTEM ERROR TAD OUTBUF /STORE OUTPUT BUFFER ADDRESS IN OUTPUT ROUTINE DCA I (BLOCK-1 CLA IAC /LOOKUP MERGE ON SYS: CIF 10 JMS I (USR 2 BLKCH, MRGFL 0 ERRHLT-7 TAD BLKCH /STORE FOR CHAIN DCA I (MRGCH CDF 10 /CHECK FOR /C OPTION ON TAD I (7643 CDF AND (1000 DCA CMPRS /STORE /C OPTION SET WORD JMP I (PRGST /JUMP TO START OF SORT ROUTINE NKEYS, 0 / /DELETE ANY PREVIOUS FILES WITH SAME NAME /MUST BE DONE RECURSIVELY DUE TO POSSIBLITY OF MULTIPLE FILES /WITH THE SAME NAME. / PURGE, 0 TAD CLSNAM /RESTORE NAME IN LOOKUP COMMAND DCA LOOKUP TAD OUTNUM /ADD OUTPUT FILE NUMBER SO LOOKUP DONE ON RIGHT DEVICE CIF 10 JMS I (USR /LOOKUP "DSK:SRTINT.AA" 2 LOOKUP, INTNAM 0 JMP I PURGE /NO MATCH CAN EXIT ROUTINE TAD CLSNAM /ENTER TEMPORARY WITH SAME NAME JMS I (ENTER TAD OUTNUM /NOW DO CLOSE WITH ZERO LENGTH (A DELETE) CIF 10 JMS I (USR 4 CLSNAM, INTNAM 0 /LENGTH MUST EQUAL ZERO FOR PURGE ERRHLT-1 /ERROR JMP PURGE+1 /LOOK FOR MORE INTERMEDIATES FILZER, 0 TAD DIRPTR /ZERO FROM CURRENT POINTER POSITION TO END OF BLOCK DCA X10 TAD (INPDEV-SPECS-400 DCA NKEYS DCA I X10 /CLEAR OUTPUT AREA ISZ NKEYS /UNTIL END OF BLOCK JMP .-2 JMP I FILZER /EXIT WHEN ALL DONE FIXFLS, 0 JMS PURGE /DELETE OLD INTERMEDIATES TAD OUTNUM /SET UP A FILE ENTER OF 5 BLOCKS DCA PURGE /STORE DEVICE # TEMPORARILY TAD PURGE AND (17 /AND OFF DEVICE # TAD (120 /ADD IN 5 BLOCKS IN BITS 0-7 DCA OUTNUM /STORE FOR ENTER TAD (FAKNAM /GET DIRECTORY FILE NAME JMS I (ENTER TAD I (STBLK /PICKUP START BLOCK DCA DIRBLK TAD PURGE /RESTORE DEVICE NUMBER DCA OUTNUM TAD (5 DCA WRTEN /5 BLOCKS SHOULD HOLD ALL OF DIRECTORY JMS I (CLOSE /CLOSE DIRECTORY FILE DCA I (FAKNAM /CLEAR SO NO OTHER CLOSES DELETE TAD (INTNAM /LOOKUP FIRST INTERMEDIATE JMS I (ENTER /ENTER IT JMP I FIXFLS /EXIT BACK TO ROUTINE MRGFL, FILENAME MRGV2.SV CHNXIT, NOCHN EXITWR=JMP I CHNXIT PAGE /****************************************************************************** / * / /THE FOLLOWING SECTION OF CODE (05000-05777) IS THE SYSTEM I-O OVERLAY * /CODE IN THIS AREA IS WRITTEN INTO OS/8 SYSTEM SCRATCH AREA (BLOCK 33) * /DURING JOB INITIALIZATION. IT IS READ BACK INTO MEMORY ON EITHER AN * /ERROR OR SUCESSFUL SORT TERMINATION. EXTREME CAUTION SHOULD BE USED * /WHEN PLACING CODE IN THIS AREA SINCE THESE LOCATIONS MAY OR MAY NOT * /BE CODE RESIDENT. * / * /****************************************************************************** /SUBROUTINE TO PRINT OUT A DECIMAL NUMBER / STATYP, 0 CLA STL RTR CDF 10 AND I (7644 /PICKUP /N OPTION CDF SZA CLA JMP I STATYP /OPTION SET, DO NOT TYPE OUT ANY STATS JMS I MSG /TYPE OUT "RECORDS READ" RECS JMS NUMPNT /TYPE OUT NUMBER OF RECORDS JMS I MSG /TYPE OUT "SEGMENTS WRITTEN" SEGS TAD SEGMNT DCA RECIN+1 JMS NUMPNT /TYPE OUT NUMBER OF SEGMENTS JMS I MSG /TYPE OUT "FILES ALLOCATED" ALLOC TAD FILES DCA RECIN+1 JMS NUMPNT /TYPE OUT NUMBER OF FILES WRITTEN JMS I MSG /TYPE OUT "TOTAL BLOCKS WRITTEN" BLOCKW TAD BLKSW DCA RECIN+1 JMS NUMPNT /TYPE OUT NUMBER OF BLOCKS WRITTEN JMP I STATYP /EXIT STATISTICS ROUTINE NUMPNT, 0 TAD (-10 /NUMBER CAN BE 8 DECIMAL DIGITS LONG DCA INDX2 JMP DVD /MAKE SURE THAT WE PRINT AT LEAST 1 ZERO FOR A ZERO NLP, TAD RECIN+1 /CHECK FOR A ZERO NUMBER SZA CLA JMP DVD /NON-ZERO DO NEXT DIVISION TAD RECIN /LOWER BITS ARE ZERO, CHECK HIGHER ORDER ONES SNA CLA JMP XIT /ALL ZERO, DISCONTINUE OPERATION DVD, JMS DIVIDE /DIVIDE NUMBER BY 10 RECIN /ADDRESS OF DIVIDEND -12 /DIVISOR TAD QUO+1 /SUBSTITUTE QUOTIENT FOR DIVIDEND DCA RECIN+1 TAD QUO DCA RECIN TAD INDX2 /COMPUTE LOCATION FOR STORING THIS DIGIT CIA TAD (TYPSTR-1 DCA DIV1 TAD REM /CALCULATE NEXT DIGIT FROM REMAINDER TAD (260 /ADD IN ASCII OFFSET DCA I DIV1 /STORE IN BUFFER ISZ INDX2 /INCREMENT COUNT JMP NLP /CONTINUE OPERATION XIT, TAD INDX2 /ALL DONE WITH DIVISIONS, NOW PRINT BUFFER CIA TAD (-10 /CALCULATE NUMBER OF DIGITS TO PRINT DCA INDX2 TYPOUT, TAD I DIV1 /PICK UP DIGIT ISZ DIV1 /BUMP POINTER TO NEXT JMS I TYPE /PRINT THE DIGIT ISZ INDX2 /CHECK FOR ALL DONE JMP TYPOUT /NOT YET JMP I NUMPNT /ALL DONE QUO, ZBLOCK 2 DIVDND, 0 DIV1, 0 REM, 0 INDX, 0 INDX2, 0 TYPSTR, ZBLOCK 10 /DIGITS BUFFER / /SUBROUTINE TO DIVIDE A DOUBLE PRECISION ARGUMENT BY A SINGLE PRECISION ONE / CALLING SEQUENCE: / JMS I (DIVIDE / (ADDRESS OF DIVIDEND - DOUBLE PRECISION) / (MINUS THE DIVISOR) / / RETURNS QUOTIENT IN AND REMAINDER IN REM / DIVIDE, 0 TAD I DIVIDE /PICKUP ADDRESS OF DIVIDEND DCA DIV1 TAD I DIV1 DCA DIVDND /PICK UP VALUE ISZ DIV1 /IT IS A DOUBLE WORD VALUE TAD I DIV1 DCA DIV1 ISZ DIVIDE /BUMP TO NEXT PARAMETER DCA QUO DCA QUO+1 /CLEAR TEMP CELLS DCA REM TAD (-30 /SET NUMBER OF BITS TO DO DCA INDX LOOPX, TAD DIV1 /START SHIFTING UPWARD RAL CLL DCA DIV1 TAD DIVDND RAL DCA DIVDND TAD REM RAL DCA REM TAD REM TAD I DIVIDE /CHECK REMAINDER VERSUS DIVISOR SMA DCA REM CLA /CLEAR JUNK TAD QUO+1 /ROTATE BIT TO QUOTIENT RAL DCA QUO+1 TAD QUO RAL DCA QUO ISZ INDX /CHECK FOR ALL DONE JMP LOOPX /NOT YET ISZ DIVIDE /ADJUST RETURN JMP I DIVIDE /EXIT PAGE / / MESSAGE SUBROUTINE FOR PDP-8 / /CALLING SEQUENCE: / JMS I (MSGA / (ADDR OF MESSAGE) / MSGA, 0 TAD I MSGA ISZ MSGA DCA XX LPAX, TAD I XX BSW JMS TYPECH TAD I XX JMS TYPECH ISZ XX JMP LPAX XX, 0 TYPECH, 0 AND (77 SNA JMP I MSGA TAD (-37 SNA JMP CRLF SPA TAD (100 TAD (237 RJN3, JMS I TYPE JMP I TYPECH CRLF, TAD (215 JMS I TYPE TAD (212 JMP RJN3 / /SUBROUTINE TO WRITE OUT AN OCTAL NUMBER ON THE OUTPUT DEVICE /AC ON CALL = NUMBER TO TYPE OUT / OCTLIO, 0 DCA XX /STORE NUMBER TAD (-4 /LOOP INDEX DCA MSGA LPOCTO, TAD XX RTL CLL RAL /ROTATE AC DOWN DCA XX TAD XX RAL AND (7 TAD (260 JMS I TYPE /TYPE OUT THE DIGIT ISZ MSGA /CHECK FOR DONE JMP LPOCTO JMP I OCTLIO ERR8, TEXT "_MRGV2.SV NOT FOUND AT " ALTERM, 0 DCA TYPEA /STORE AC ON CALL DCA BLKSW /CLEAR BLOCKS WRITTEN TAD I (7746 /SET JOB STATUS BIT SO NO .ST COMMANDS CAN BE USED CMA AND (6777 CMA DCA I (7746 STL RAR CLA CDF 10 AND I (7643 /PICK UP /A OPTION CDF SNA CLA JMP CHKHOP /NOT SET, CHECK /H OPTION TAD ALTCDE /GET ALTERNATE TERMINAL CODES AND (77 /AND OFF OUTPUT CODE RTL CLL RAL JMS I (STORG CHKHOP, CDF 10 TAD I (7643 /PICKUP OPTION WORD CDF AND (20 /AND OFF /H BIT DCA SLASHH /STORE IN A SAVE PLACE TAD TYPEA /CHECK FOR INITIAL VALUE =1 SNA CLA JMP I ALTERM /EXIT TAD EXIT1 DCA I (NOBAT JMP I (BATCR NOCHN, JMS I MSG CHAINR JMP I ERROR /EXIT BATYP, 0 CDF /MAKE SURE DATA FIELD SET SO RETURN IS HERE FLDCH1, CIF /REPLACED TO CDF BATCHFLD IN INTIALIZATION JMS I BATOUT /OUTPUT CHARACTER IN BATCH LOG CLA JMP I BATYP /RETURN TO SENDER FLDCH2, CDF CIF /CHANGED TO CDF CIF BATCHFLD IN INTIALIZATION JMP I BATERR /ABORT BATCH BATERR, 7000 BATOUT, 7400 TYPEA, 0 TLS TSF JMP .-1 CLA JMP I TYPEA EXIT1, EXITWR PAGE MSGLST, ERR1;ERR2;ERR3;ERR4;ERR5;ERR6;ERR7;ERR8 ERR1, TEXT "_ENTER ERROR AT " ERR2, TEXT "_CLOSE ERROR AT " ERR3, TEXT "_I/O ERROR ON DSK: AT " ERR4, TEXT "_READ ERROR AT " ERR5, TEXT "_NO ROOM FOR OUTPUT FILE AT " ERR6, TEXT "_UNDEFINED DEVICE AT " ERR7, TEXT "_I/O ERROR ON SYS: AT " RECS, TEXT "_RECORDS READ - " SEGS, TEXT "_SEGMENTS WRITTEN - " ALLOC, TEXT "_FILES ALLOCATED - " BLOCKW, TEXT "_TOTAL BLOCKS WRITTEN - " CHAINR, TEXT @_".R SORTV2" IS ILLEGAL - PROGRAM MUST BE CHAINED FROM SORTCD_@ *0 ALTCDE, JMPFLG, 0304 HLT /PROTECT AGAINST SPURIOUS INTERRUPTS UNPACK, DCA JMPFLG /STORE UNPACKING COUNT TAD P240 /UNPACK WITH SPACES JMS I PUTCH ISZ JMPFLG JMP .-3 /NOT DONE, CONTINUE PACKING WITH SPACES JMP I NEXT1 *20 TYPE, TYPEA ERROR, 7600 DIRBLK, 0 WRTBLK, 0 OLENG, 0 INLEN, 0 INBLOC, 0 OUTNUM, 0 OUTENT, 0 INPENT, 0 OUTBUF, 0 INPBUF, 0 SRTKEY, 0 LENGTH, 0 BUFCNT, 0 ADDRES, 0 RECIN, ZBLOCK 2 LINES, 0 EOFLG, 0 KYPTR, 0 UPPRLM, 0 LOWRLM, 0 DIRECT, 0 ADDR1, 0 LEN1, 0 ADDR2, 0 LEN2, 0 SEGMNT, 0 SWITCH, 0 WRTEN, 0 FILES, 0 CHART, 0 ADDROT, 0 P7400, 7400 WRTCNT, 0 BLKSW, 0 / /SYSTEM ERROR ROUTINES /CALLS DOWN OVERLAY AND EXECUTES ERROR MESSAGE IO AND EXIT / ERRCD, 0 PTR1, 0 OVRLAY, 1 SLASHH, ENTR7, 0 ISZ ERRCD ISZ ERRCD ISZ ERRCD ISZ ERRCD ISZ ERRCD ISZ ERRCD ERRHLT=JMS . ENTER0, ISZ ERRCD M600, CLA /CLEAR JUNK TAD ERRCD /COMPUTE MESSAGE ADDRESS TAD MSGADR DCA MSGX TAD I MSGX DCA MSGX TAD OVRLAY SNA CLA /CHECK IF WE MUST BRING OVERLAY DOWN JMS SYSRD JMS I MSG /TYPE OUT ERROR MESSAGE NEXT1, MSGX, NEXTCH TAD ERRCD /COMPUTE CALLING ADDRESS CIA TAD KENTR DCA MSGX /ADDRESS OF JMS TAD I MSGX /GET VALUE JMS I OCTL BXIT, CDF CIF /DO ERROR EXIT JMP I ERROR OCTL, OCTLIO MSG, MSGA M203, -203 KENTR, ENTER0 CCHCK, 0 KRS TAD M203 SNA CLA KSF JMP I CCHCK JMP BXIT SYSRD, 0 JMS I SYSENT /READ SYSTEM DEVICE 400 /2 BLOCKS TO FLD 0 STATS, STATYP /ADDRESS=5000 33 /SCRATCH BLOCKS HLT /IRRECOVERABLE SYS I-O ERROR JMP I SYSRD SYSENT, 7607 /SYSTEM HANDLER ENTRY PT SUBTR2, ISZ LEN1 /BUMP LENGTH INDICATOR CLA CLL TAD SYSRD TAD M600 DCA SYSRD RAL TAD M1 TAD LEN2 JMP I LOOP0A LOOP0A, LOOP0 M1, -1 MSGADR, MSGLST CMPRS, 0 P240, 240 PUTCH, PUTBF