/MERGE VERSION 2 FOR OS/8 / /SEPTEMBER, 1977, BRYAN FREDRICK, MINNESOTA POLLUTION CONTROL AGENCY / *200 MRGST, JMS I (INITAL /INITIALIZE OUTPUT POINTERS DCA FILNUM /CLR FILE INDICATOR TAD (-12 /READ IN FILE BUFFERS DCA INDX DCA FILES RDLOOP, JMS I GETPTR /GET FILE POINTERS JMS I (CHKSEG /CHECK SEGMENT OVERFLOW TAD I DIRPTR /STORE DEVICE NUMBER AND K17 /AFTER ANDING IT OFF SNA JMP END /ZERO DEVICE NUMBER IS THE END DCA DEVCDE TAD I DIRPTR /GET STARTING BLOCK NUMBER DCA BLKNO TAD I DIRPTR SNA /SET LENGTH = +1 FOR NON-FILE STRUCTURED FILES IAC DCA BLEFT /STORE LENGTH DCA EOFLG /CLR EOF FLAG DCA CLEFT /CLR CHARACTER COUNT IN BUFFER JMS I STRPTR /STORE POINTERS JMS I (READBF /READ A RECORD NOP ISZ FILNUM /BUMP TO NEXT FILE ISZ FILES /AND FILE COUNT ISZ INDX /CHECK FOR ALL DONE JMP RDLOOP /CONTINUE ON SKP CLA END, CLA CMA /BACKUP POINTER TO DIRECTORY TAD DIRPTR DCA DIRPTR TAD I DIRPTR SNA CLA IAC DCA DNEFLG /SET CLR DONE FLAG CLA CMA TAD DIRPTR DCA DIRPTR /RESTORE DIRECTORY POINTER TAD PASSES /CHECK IF WE HAVE ALREADY OPENED OUTPUT FILE SZA CLA JMP DOMRG1 /YES, GO DO MERGE TAD DNEFLG /CHECK FOR DONE SZA CLA JMP ENTFNL /YES, WE CAN ENTER FINAL OUTPUT FILE DCA LSTPAS /CLEAR LAST PASS FLAG TAD DSKNUM /ENTER INTERMEDIATE FILE JMS ENTROU INTNAM /NAMED "SRTINT.AB" DOMRG1, TAD DSKNUM /BUILD UP INTERMEDIATE FILE DCA I DIROUT TAD WRTBLK /ADD IN WRITE BLOCK DCA I DIROUT DCA FLENGT /CLEAR OUTPUT INTERMEDIATE LENGTH JMP I (DOMRG /GO DO MERGE ENTFNL, TAD OUTNAM /GET POINTER TO OUTPUT FILE DCA FTEMP TAD OUTNUM /GET OUTPUT DEVICE NUMBER JMS ENTROU /ENTER FINAL OUTPUT FILE FTEMP, 0 ISZ LSTPAS /SET LAST PASS FLAG JMP I (DOMRG ENTROU, 0 JMS I (SETABS /FIX UP DEVICE RESIDENT TABLE DCA DEVNUM /STORE DEVICE NUMBER TAD I ENTROU /GET FILE NAME POINTER ISZ ENTROU /BUMP RETURN DCA NAMFLD /STORE IN NAME FIELD TAD NAMFLD /STORE FOR CLOSE DCA CLSNAM CIF 10 /BRING DOWN THE USR JMS I (USRIN 10 TAD DEVNUM /ENTER OUTPUT FILE CIF 10 JMS I USR 3 NAMFLD, ZBLOCK 2 ERRHLT+6 /"ENTER ERROR" TAD NAMFLD DCA WRTBLK /STORE BLOCK NUMBER TAD I OADDR2 /AND OUTPUT ENTRY DCA WRTENT TAD NAMFLD+1 /AND FILE LENGTH SNA IAC /SET LENGTH OF 4095 FOR NON-FILE STRUCTURED OUTPUT DCA WLENG DCA WRTEN CIF 10 JMS I USR 11 /RESTORE PREVIOUS USR AREA JMP I ENTROU /EXIT DEVNUM, 0 CLOSE, 0 CIF 10 JMS I (USRIN 10 /FETCH THE USR TAD WRTEN DCA CLSNAM+1 /STORE NUMBER OF OUTPUT BLOCKS WRITTEN TAD DEVNUM /GET DEVICE NUMBER JMS I (SETABS /SET UP FIELD 1 DEVICE RESIDENCY TABLE CIF 10 /CLOSE OUTPUT FILE JMS I USR 4 CLSNAM, ZBLOCK 2 ERRHLT+7 /"CLOSE ERROR" JMP I CLOSE PAGE DOMRG, DCA FILNUM /CLEAR FILE NUMBER TAD FILES /GET -FILE COUNT CIA DCA INDX /STORE AS INDEX LOOP1, JMS CHKEOF /CHECK EOF FLAG ON THIS FILE JMP LOOP1EN /EOF ALREADY HAS BEEN READ ON THIS FILE TAD FILNUM /A GOOD FILE TO START WITH DCA FILE1 /STORE POINTER TO FILE NUMBER JMS PTRFND /FIX UP POINTERS TO RECORD INFO TAD I X10 /GET BUFFER FIELD CDF DCA CDF1 TAD I X10 DCA ADDR1 /STORE ADDRESS POINTER TAD I X10 DCA LEN1 JMP LOOP2E /GO TO IT LOOP1E, ISZ FILNUM /BUMP FILE NUMBER ISZ INDX /BUMP COUNTER JMP LOOP1 /NOT DONE YET JMP ENDPAS /ALL DONE WITH PASS, FINISH IT OFF CHKEOF, 0 TAD FILNUM /MULTIPLY FILE NUMBER BY 9 RTL CLL RAL TAD FILNUM TAD (FILSTR /ADD IN FILE STORAGE OFFSET DCA PTRFND TAD I PTRFND /GET EOF FLAG SNA CLA ISZ CHKEOF /RETURN AT P+2 IF NO EOF JMP I CHKEOF /RETURN PTRFND, 0 TAD FILNUM /MULTPLY FILE NUMBER BY 5 RTL CLL TAD FILNUM TAD (RECSTR-1 /ADD IN RECORD OFFSET-1 DCA X10 /STORE IN AUTO INDEX JMP I PTRFND /EXIT LOOP2, JMS CHKEOF /CHECK FOR EOF ON THIS FILE JMP LOOP2E /EOF FOUND, EXIT JMS PTRFND /GET POINTERS TAD I X10 DCA CDF2 /STORE AS SECOND RECORD POINTERS TAD I X10 DCA ADDR2 TAD I X10 DCA LEN2 JMS I (COMPAR /GO COMPARE RECORDS AT ADDR1 AND ADDR2 LOOP2E, ISZ FILNUM /BUMP FILE COUNT ISZ INDX /AND COUNTER JMP LOOP2 /CONTINUE IF NOT DONE TAD CDF1 /STORE LAST RECORD DCA CDFSTR TAD LEN1 SNA CLA JMP ENDLNE /A MERE CR-LF CDFSTR, CDF TAD I ADDR1 ISZ ADDR1 CDF JMS CMPRSP /PACK OUTPUT CHARACTER ISZ LEN1 /CHECK FOR DONE WITH RECORD JMP CDFSTR /CONTINUE ENDLNE, TAD (215 /ALL DONE OUTPUT CR-LF JMS CMPRSP TAD (212 JMS CMPRSP ISZ RECMRG+1 /BUMP OUTPUT RECORD COUNT SKP CLA ISZ RECMRG TAD FILE1 DCA FILNUM /READ NEXT RECORD ON FILE JMS I (READBF NOP JMP DOMRG /CONTINUE MERGING BUFFER ENDPAS, TAD (232 /ADD IN ^Z JMS CMPRSP /PACK IT IN BUFFER TAD (600 /FILL REMAINDER OF BLOCK WITH ZEROS TAD WRTCNT /CHECK FOR FINISHED BLOCK SZA CLA JMP ENDPAS+1 /FILL BLOCK OUT WITH ZEROS TAD FLENGT /STORE LENGTH IN DIRECTORY AREA CIA DCA I DIROUT DCA FLENGT /CLEAR INTERMEDIATE LENGTH JMS I (RECOUT /PRINT-CLEAR RECORD COUNTS ISZ PASSES /BUMP PASSES COUNT TAD DNEFLG /CHECK FOR DONE SNA CLA JMP I K200 /GET NEXT SET OF INTERMEDIATES JMP I (PASDNE / /SUBROUTINE TO CHECK OVERFLOW TO NEXT DIRECTORY SEGMENT / CHKSEG, 0 TAD DIRBUF /GET BUFFER ADDRESS TAD (376 /ADD IN OFFSET TO END CIA /COMPLEMENT ADDRESS TAD DIRPTR /ADD IN DIRECTORY POINTER SZA CLA JMP I CHKSEG /NOT AT END, RETURN ISZ DIRSEG /INCREMENT SEGMENT NUMBER JMS I (RWDIR /GET DIRECTORY SEGMENT CLA CMA TAD DIRBUF /SET DIRECTORY POINTER BACK TO THE BEGINNING DCA DIRPTR JMP I CHKSEG /AND RETURN TO MAIN LINE CRMSG, 3700 PAGE PASDNE, DCA DIRSEG /CLEAR SEGMENT NUMBER JMS I (RWDIR /READ FIRST BLOCK BACK IN JMS I (CLOSE /CLOSE CURRENT OUTPUT FILE CDF 10 /CLEAR /S OPTION TAD I (7644 AND (7737 DCA I (7644 CDF TAD DSKNUM /FIX UP DEVICE RESIDENCY TABLE JMS I (SETABS CLA JMS I (SYSRD /READ DOWN THE OVERLAY TAD LSTPAS /CHECK IF ALL DONE SNA CLA JMP WRITNW /NOT YET, WRITE NEW DIRECTORY TAD DSKNUM JMS I (LOOKUP /LOOKUP FILE DIRNAM JMS I (RENAME /RENAME FILE SO PURGE WILL KILL IT TAD DSKNUM /GET DSK: DEVICE NUMBER JMS PURGE CLA STL RTR CDF 10 AND I (7644 /CHECK /N OPTION CDF SZA CLA JMP PEXIT /SET, EXIT JMS I (MSGA /TYPE OUT "RECORDS WRITTEN =" WRITN TAD RECMRG /MOVE NUMBER OF RECORDS TO TYPE BUFFER DCA RECIN TAD RECMRG+1 DCA RECIN+1 JMS I (NUMPNT /TYPE OUT NUMBER OF OUTPUT RECORDS JMS I (MSGA /TYPE OUT CRLF CRMSG PEXIT, CDF CIF JMP I (7600 /GO BACK TO SYSTEM ALL DONE WRITNW, TAD DIRBUF TAD (27 /GET COPY ADDRESS DCA X10 TAD X10 DCA DIRPTR /SET UP DIRECTORY READ AUTO-INDEX TAD (INTMED-1 DCA X11 TAD X11 /ALSO ZERO INTERMEDIATE AREA DCA X13 TAD (-200 DCA INDX /SET UP TO COPY TAD I X11 /PUT NEW INTERMEDIATE DATA IN FILE DCA I X10 DCA I X13 /CLEAR AREA ISZ INDX JMP .-4 /COMPLETE IT STL RAR CLA JMS I (RWDIR /REWRITE DIRECTORY SEGMENT TAD DSKNUM /GET DSK: DEVICE NUMBER JMS PURGE /KILL OFF THE PREVIOUS INTERMEDIATES TAD DSKNUM /NOW RENAME THE INTERMEDIATE JMS I (LOOKUP INTNAM JMS I (RENAME DCA PASSES /CLEAR PASSES COUNT DCA RECMRG /CLR OUTPUT RECORD COUNTS DCA RECMRG+1 JMP I (MRGST /CONTINUE WITH OPERATION / /DELETE ANY FILES WITH THE NAME "SRTINT.AA" /MUST BE DONE RECURSIVELY DUE TO THE POSSIBLITY OF MUTIPLE FILES / PURGE, 0 DCA TEMP /STORE DEVICE NUMBER TAD CLSNA /RESTORE LOOKUP DCA LOOK TAD TEMP CIF 10 JMS I USR /LOOKUP THE FILE 2 LOOK, OLDNAM 0 JMP I PURGE /NO MORE FOUND, CAN EXIT ROUTINE TAD CLSNA /ENTER TEMPORARY WITH THE SAME NAME DCA ENTNAM TAD TEMP CIF 10 JMS I USR 3 ENTNAM, ZBLOCK 2 ERRHLT+6 /"ENTER ERROR" TAD TEMP CIF 10 /CLOSE WITH ZERO BLOCKS (A PURGE) JMS I USR 4 CLSNA, OLDNAM 0 ERRHLT+7 /"CLOSE ERROR" JMP PURGE+2 OLDNAM, FILENAME SRTINT.AA SETABS, 0 DCA AC1 TAD AC1 TAD (7646 DCA OADDR1 TAD AC1 TAD (DEVTAB-1 DCA OADDR2 TAD I OADDR2 /STORE ENTRY POINT IN OUTPUT TABLE CDF 10 DCA I OADDR1 CDF TAD AC1 /LEAVE WITH AC VALUE CALLED WITH JMP I SETABS PAGE / /SUBROUTINE TO TYPE OUT RECORD COUNTS FOR MERGE INPUT FILES / RECOUT, 0 CDF 10 TAD I (7644 /PICK UP OPTION WORD(/S) CDF AND (40 /AND OFF BIT OF INTEREST DCA TYPIT TAD TYPIT SZA CLA JMS SYSRD /READ IN SYSTEM OVERLAY IF OPTION IS SET TAD FILES /SET UP LOOP INDEX CIA DCA INDX DCA FILNUM /CLEAR FILE INDICATOR LOOP3, TAD PASSES /FILE NUMBER = PASSES *10 + FILNUM + 1 RTL CLL TAD PASSES RAL CLL TAD FILNUM IAC DCA RECIN+1 /STORE IN OUTPUT WORD TAD FILNUM RTL CLL /GET RECORD COUNT TAD FILNUM TAD (RECSTR+3 DCA TEMP /STORE TEMPORARILY TAD I TEMP /PICKUP VALUE LOWEST BITS DCA CLEFT /STORE IN A SAFE PLACE DCA I TEMP /CLEAR OUT THE WORD ISZ TEMP /BUMP TO HIGH ORDER BITS TAD I TEMP /GET HIGH ORDER BITS DCA EOFLG DCA I TEMP TAD TYPIT /CHECK TO SEE IF WE WANT STATISTICS SNA CLA JMP XEND JMS I (MSGA RECFLS JMS I (NUMPNT /PRINT OUT FILE NUMBER TAD CLEFT /MOVE RECORD COUNT INTO NUMBER BUFFER DCA RECIN+1 TAD EOFLG /MOVE HIGH ORDER BITS DCA RECIN JMS I (MSGA /TYPE OUT " = " EQLS JMS I (NUMPNT /TYPE OUT THE COUNT XEND, ISZ FILNUM ISZ INDX JMP LOOP3 /CONTINUE UNTIL DONE JMP I RECOUT /RETURN TO CALLER SYSRD, 0 /SUBROUTINE TO READ DOWN SYSTEM OVERLAY JMS I (7607 400 RENAME 33 HLT /IRRECOVERABLE I-O ERROR JMP I SYSRD EQLS, TEXT " = " RECFLS, TEXT "_RECORDS READ, FILE #" TYPIT, 0 ENTER9, 0 ENTER8, ISZ ERRCD ENTER7, ISZ ERRCD ENTER6, ISZ ERRCD ENTER5, ISZ ERRCD ENTER4, ISZ ERRCD ENTER3, ISZ ERRCD ENTER2, ISZ ERRCD ENTER1, ISZ ERRCD ENTER0, ISZ ERRCD CLA TAD ERRCD CIA TAD (ENTER0 DCA TYPIT /STORE ENTRY ADDRESS TAD ERRCD TAD (MSGLST DCA MSGB TAD I MSGB /PICKUP MESSAGE ADDRESS FROM LIST DCA MSGB /STORE IN REQUEST TAD OVRLAY /CHECK IF OVERLAY IS IN CORE SNA CLA JMS SYSRD /READ IN OVERLAY JMS I (MSGA MSGB, 0 TAD I TYPIT /GET ADDRESS OF ERROR JMS I (OCTLIO /TYPE IT OUT CDF CIF JMP I ERROR /EXIT TO ERROR ROUTINE *1200 INTMED, ZBLOCK 200 /STORAGE SPACE FOR NEW INTERMEDIATE DIRECTORY DIROUT=15 /DIRECTORY OUTPUT POINTER AUTO-INDX *1400 COMPAR, 0 TAD SRTKEY /STORE LOOP INDEX DCA LPTR TAD CDF2 /PICKUP RECORD BUFFER FIELD CDFS DCA CDFA /STORE IN COMPARISON ROUTINES TAD CDF1 DCA CDFB 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 SPA CLA JMP I COMPAR /RECORD IN ADDR1 STILL EXTREME STOR1, TAD CDF2 /RECORD AT ADDR2 COMES FIRST, REVERSE PTRS DCA CDF1 TAD FILNUM /SAVE FILE IDENTIFIER FOR NEXT READ REQUEST DCA FILE1 TAD ADDR2 /CHANGE WITH DCA ADDR1 TAD LEN2 DCA LEN1 JMP I COMPAR LOOPE, ISZ LPTR /MOVE TO NEXT KEY JMP LOOPT 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 TAD P1 /AND OFF LENGTH OF KEY AND (3777 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 CDFA, CDF TAD I CHAR2 CIA CDFB, CDF 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 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 *1600 / /SUBROUTINE TO READ RECORDS FROM FILE AND RETURN TO RECORD BUFFER / READBF, 0 JMS I GETPTR /GET FILE POINTERS FROM BUFFER JMS CCHCK /CHECK FOR ^C TAD EOFLG /CHECK FOR EOF READ ON THIS FILE SZA CLA JMP I READBF DCA LENGTH /CLEAR RECORD LENGTH INDICATOR TAD UNBLOC DCA I (PICKA /STORE UNBLOCKING ADDRESS IN UNPACK ROUTINE NEXTCH, CLA CMA /AND AWAY WE GO DCA JMPFLG /SET JMP FLAG TAD CLEFT /CHECK NUMBER OF CHARACTERS LEFT IN BUFFER SZA CLA JMP OKAY /EVERYTHING IS HONKY-DORY UNPACK THE RECORD TAD BLEFT /CHECK REMAINING FILE LENGTH SNA CLA JMP EOFRD /ZERO LENGTH REMAINING, EOF TAD DEVCDE /CHECK IF DEVICE HANDLER IS IN CORE TAD (DEVTAB-1 DCA KCHR /STORE ADDRESS IN TABLE TAD I KCHR /PICKUP VALUE SZA JMP INCORE /MUST BE IN CORE CIF 10 /TOUGH LUCK, MUST DO A BUNCH OF USR WORK JMS I (USRIN /GO GET IT 10 TAD DEVCDE /CHECK FOR ALREADY IN CORE CIF 10 JMS I USR 12 LOCATN, 0 ERRHLT /"NO DEVICE" TAD LOCATN /CHECK FOR IN CORE SZA CLA JMP USROUT /ALREADY RESIDENT, CAN PROCEED CIF 10 JMS I USR 13 /DO A RESET RETAINING TENTATIVE FILES 0 TAD INPHNL /GET INPUT HANDLER PAGES DCA ARG1 /STORE IN FETCH TAD DEVCDE /FETCH BY NUMBER CIF 10 JMS I USR 1 ARG1, 0 ERRHLT /"NO DEVICE" TAD ARG1 DCA LOCATN /STORE POINTER TO HANDLER USROUT, CIF 10 /RESTORE USR AREA JMS I USR 11 SKP /JUMP OVER IN CORE CASE INCORE, DCA LOCATN TAD STBUF /SET UP READ REQUEST DCA REQRD+2 TAD BLKNO DCA REQRD+3 REQRD, JMS I LOCATN /GO TO DEVICE HANDLER 210 /ALL INPUT BUFFERS RESIDE IN FLD 1 KCHR, ZBLOCK 2 SNA CLA /ZERO RETURNS ARE OKAY BY ME SKP ERRHLT+4 /"I-O ERROR ON INPUT FILE" ISZ BLKNO /BUMP BLOCK NUMBER ISZ BLEFT /AND REMAINING LENGTH M600, CLA /WITH NO PROBLEM ON SKIP TAD M600 /SET UP REMAINING CHARACTER COUNT DCA CLEFT TAD (PICK1 DCA I (PICKA /FIX UP UNBLOCKING ROUTINE TAD STBUF /AND UNPACKING ADDRESS DCA PICKAX OKAY, JMS I (PICK /GET A CHARACTER ISZ CLEFT /BUMP CHARACTER COUNT MRUB, 7401 /A NOP ALSO -RUBOUT ISZ JMPFLG JMP I (CHKZER /CHECK FOR A RUBOUT DCA KCHR /STORE NEXT CHARACTER TAD KCHR /GET IT BACK TAD (-232 /CHECK FOR ^Z SNA JMP EOFRD /YES, DO EOF THING TAD (232-215 /CHECK FOR A CR SNA JMP EOL /YES, DO END OF LINE ROUTINE TAD (215-211 /CHECK FOR A TAB SNA JMP I (TAB /EXPAND OUT TABS TAD (211-240 /CHECK FOR ANOTHER CONTROL CHARACTER SPA CLA JMP NEXTCH /YES, IGNORE ALL OTHER CONTROLS TAD CMPRS /CHECK FOR A RUBOUT IF IN /C MODE SZA CLA TAD MRUB TAD KCHR SNA CLA JMP NEXTCH+1 /THIS CHARACTER IS A RUBOUT, TRAP EXPANSION COUNT PUTCHR, TAD KCHR /PUT CHARACTER IN BUFFER JMS I (PUTCH JMP NEXTCH EOFRD, ISZ EOFLG /EOF READ, SET FLAG TAD I (PICKA /STORE PICK ADDRESS IN POINTER LIST DCA UNBLOC JMS I STRPTR /STORE IN FILE TABLE LIST JMP I READBF /EXIT TO CALLER EOL, ISZ READBF /BUMP RETURN TO NORMAL TAD LENGTH /STORE RECORD LENGTH IN RECORD POINTER LIST CIA JMS I (SETREC JMP EOFRD+1 /GO TO EXIT ROUTINE JMPFLG, 0 *2000 RWDIR, 0 TAD K200 /ADD IN TO WRITE 1 BLOCK DCA FUN /STORE AS FUNCTION CODE TAD DIRBLK /GET DIRECTORY STARTING BLOCK TAD DIRSEG /ADD ON DIRECTORY SEGMENT DCA FUN+2 /STORE AS BLOCK NUMBER TAD DIRBUF /PUT BUFFER ADDRESS IN REQUEST DCA FUN+1 JMS I DSKENT /READ-WRITE DIRECTORY BLOCK FUN, ZBLOCK 3 ERRHLT+3 /"I-O ERROR ON DSK:" JMP I RWDIR /ALL SYSTEMS GO TAB, TAD P240 /EXPAND OUT TABS JMS PUTCH TAD LENGTH /CHECK FOR LENGTH A MULTIPLE OF 8 RAR CLL SNL RAR SNL RAR SZL CLA JMP TAB JMP I (NEXTCH /MULTIPLE OF 8, GET NEXT CHARACTER CHKZER, SNA JMP I (PUTCHR /RUBOUT,0 MEANS AN ACTUAL RUBOUT CIA /COMPLEMENT COUNT DCA RWDIR /STORE IN A SAVE PLACE TAD P240 JMS PUTCH ISZ RWDIR /LOOP TILL DONE JMP .-3 JMP I (NEXTCH /GO TO NEXT CHARACTER PUTCH, 0 DCA LCHAR /STORE CHARACTER TEMPORARILY TAD FILNUM /COMPUTE RECORD POINTERS RTL CLL TAD FILNUM TAD (RECSTR-1 /ADD IN OFFSET DCA X13 TAD I X13 /PICKUP CDF RECORD BUFFER FIELD DCA RECDF /STORE IN LINE TAD LENGTH /COMPUTE ADDRESS FOR STORING CHARACTER TAD I X13 /PICK UP ADDRESS OF RECORD BUFFER DCA ADDR TAD LCHAR /GET THE CHARACTER BACK AGAIN RECDF, 0 DCA I ADDR /STORE IN RECORD BUFFER CDF ISZ LENGTH /BUMP LENGTH TAD LENGTH /CHECK FOR RECORD OVERFLOW TAD (-400 /RECORD SIZE LIMIT IS 400 OCTAL CHARACTERS SNA CLA ERRHLT+5 JMP I PUTCH /EXIT X13=13 ADDR, 0 LCHAR, 0 SETREC, 0 DCA LCHAR /STORE THE LENGTH TEMPORARILY TAD FILNUM /MULTIPLY BY 5 RTL CLL TAD FILNUM TAD (RECSTR+1 /ADD OFFSET FOR LENGTH WORD DCA X13 TAD LCHAR /STORE RECORD LENGTH DCA I X13 ISZ I X13 /BUMP LOWER RECORD COUNT SKP CLA ISZ I X13 /BUMP IF OVERFLOW JMP I SETREC /RETURN TO CALLER K600, -600 INITAL, 0 TAD K600 /SET UP WRITE CHARACTER COUNT DCA WRTCNT TAD OUTBUF /SET UP BUFFER ADDRESS DCA ADDROT TAD (PACK1 /SET PACKING ADDRESS DCA I (PACKA JMP I INITAL /RETURN / /SUBROUTINE TO PACK OUTPUT 1 CHARACTER AT A TIME / PACKC, 0 JMS I (PACK /PACK CHARACTER IN BUFFER ISZ WRTCNT /CHECK FOR FULL BUFFER JMP I PACKC /BUFFER NOT FULL, RETURN TAD WLENG /CHECK FOR OVERFLOW SNA CLA ERRHLT+11 /"NO ROON FOR OUTPUT FILE" TAD OUTBUF /STORE OUTPUT BUFFER ADDRESS IN WRITE COMMAND DCA BLOC-1 TAD WRTBLK /AND WRITE BLOCK NUMBER DCA BLOC JMS I WRTENT /WRITE THE BLOCK 4200 0 BLOC, 0 ERRHLT+10 /"WRITE ERROR" ISZ WRTBLK ISZ WRTEN ISZ FLENGT ISZ WLENG /CHECK FOR FILE OVERFLOW K177, 177 /A GOOD NOP JMS INITAL /REINITIALIZE POINTERS JMP I PACKC /EXIT INTNAM, FILENAME SRTINT.AB RETURN, 0 DCA INITAL /STORE CHARACTER TAD CMPRS /CHECK FOR /C MODE SET SZA CLA JMP EXIT /SET, RETURN WITH AC ON CALL TAD INITAL /NOT SET, MASK OFF CHARACTER AND K177 TAD K200 /SET PARITY BIT SKP EXIT, TAD INITAL /GET BACK AC JMP I RETURN /RETURN TO SENDER *2200 / /ODDS AND ENDS OF NECESSARY CORE-RESIDENT CODE / / /ROUTINES TO GET AND STORE FILE POINTERS / STRFLS, 0 JMS SETUP /SET UP AUTO-INDX AND LOOP INDX TAD I X10 DCA I X11 ISZ PICK /MOVE PAGE 0 BUFFER TO FILE LOCATIONS JMP .-3 /CONTINUE UNTIL DONE WITH BUFFER JMP I STRFLS /EXIT GETFLS, 0 JMS SETUP /SET UP TO COPY FROM FILE BUFFER TO PAGE 0 TAD I X11 DCA I X10 ISZ PICK JMP .-3 JMP I GETFLS SETUP, 0 TAD NFILE DCA X10 TAD FILNUM RTL CLL /MULTIPLY BY 9 WORDS/FILE RAL TAD FILNUM TAD KSTOR /ADD IN STORAGE ADDRESS - 1 DCA X11 TAD MN11 /SET UP INDEX TO -9 DCA PICK /A GOOD PLACE TO STORE IT JMP I SETUP /SET-UP COMPLETE, EXIT PICK, 0 CDF 10 JMP I PICKA PICKA, PICK1 AND K377 /MASK OFF CHARACTER JMS I RETRN1 /CHECK FOR FURTHER MASK REQUIRED CDF 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 PACK, 0 AND K377 /AND OFF THE CHARACTER CDF JMP I PACKA PACKA, PACK1 JMP I PACK PACK1, DCA I ADDROT JMS PACKA DCA CHAR 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 CHAR DCA I ADDROT ISZ ADDROT JMS PACKA JMP PACK1 CHAR, 0 KSTOR, FILSTR-1 RETRN1, RETURN *2325 DEVTAB, ZBLOCK 17 /STORAGE FOR DEVICE RESIDENT TABLE KEYSTR, ZBLOCK 20 /STORAGE AREA FOR SORT KEYS RECSTR, ZBLOCK 12^5 /POINTER STORAGE AREA FOR RECORDS FILSTR, ZBLOCK 12^11 /POINTER STORAGE AREA FOR FILES ENTAB=. *5600 / /MERGE INITIALIZATION PROCEDURE (LATER OVERLAID BY BUFFERS) / BEGIN, CLA IAC /AC=1 IF PROGRAM STARTED BY A ".R MRGV2" JMS I (NOSTRT /FIX UP JOB STATUS WORD CIF 10 JMS I (USRIN /READ IN USR 10 CIF 10 JMS I USR /RESET SYSTEM TABLES BEFORE STARTING 13 JMS ALLOC /FETCH DSK: HANDLER DEVICE DSK DCA DSKENT TAD N1+1 /GET DEVICE NUMBER DCA DSKNUM /SAVE AS DSKNUM TAD DSKNUM JMS I (LOOKUP /LOOKUP SORT DIRECTORY DIRNAM TAD I (STBLK1 /GET BLOCK FOR POSTERITY DCA DIRBLK DCA DIRSEG /CLEAR DIRECTORY SEGMENT POINTER JMS GET400 /GET 2 PAGE BUFFER DCA DIRBUF JMS I (RWDIR /READ FIRST DIRECTORY SEGMENT TO DIRBUF CLA CMA TAD DIRBUF /SET UP TO BUILD TABLES DCA DIRPTR /USING AUTO-INDEX TAD I DIRPTR DCA SRTKEY /STORE NUMBER OF KEYS TAD (KEYSTR-1 DCA LSTPTR TAD (-20 DCA INDX TAD I DIRPTR /MOVE KEYS FROM DIRECTORY TO BUFFER DCA I LSTPTR ISZ INDX JMP .-3 /UNTIL DONE ISZ DIRPTR /JUMP OVER DEVICE TYPE TAD I DIRPTR /PICK UP DEVICE NAME DCA CALL2+1 TAD I DIRPTR DCA CALL2+2 CLA IAC TAD DIRPTR /STORE POINTER TO FILE NAME IN DIRECTORY BLOCK DCA OUTNAM CLA CLL IAC RTL /JUMP OVER OUTPUT FILE NAME TO INPUT SPECS TAD DIRPTR DCA DIRPTR TAD SRTKEY /COMPUTE CONSTANT TO LAST OF KEYS CIA CLL RAL TAD (KEYSTR DCA KYPTR /STORE IT FOR FUTURE USE TAD (INTMED-1 DCA DIROUT CALL2, JMS ALLOC /ALLOCATE OUTPUT DEVICE HANDLER ZBLOCK 2 DCA OUTENT /STORE ENTRY VALUE TAD N1+1 DCA OUTNUM /AND DEVICE NUMBER JMS I (BATFIX /FIX UP I-O AND ABORT ROUTINES IF BATCH IS RUNNING DCA PASSES /CLEAR NUMBER OF PASSES JMS GET400 /GET 2 PAGES FOR INPUT FILE HANDLER AREA IAC DCA INPHNL JMS GET400 /AND OUTPUT FIELD DCA OUTBUF STL RAR CLA CDF 10 /AND OFF /A OPTION BIT AND I (7643 CDF SZA CLA JMS I (ALTERM /SET ALTERNATE TERMINAL I/O JMP I (BUILDT /GO BUILD REMAINING SYSTEM TABLES ALLOC, 0 TAD I ALLOC /GET DEVICE NAME ISZ ALLOC DCA N1 TAD I ALLOC ISZ ALLOC DCA N1+1 CIF 10 JMS I USR 12 N1, ZBLOCK 2 LOC1, 0 ERRHLT TAD LOC1 /GET ENTRY SZA /CHECK IF ALREADY IN CORE JMP I ALLOC /ALREADY IN CORE, EXIT FETCH, JMS GETPAG /GET 1 PAGE DCA LOC3 TAD N1+1 CIF 10 JMS I USR /TRY TO ALLOCATE ONLY 1-PAGE 1 /A FETCH LOC3, 0 JMP TWOPAG /FAILURE, WE MUST NEED TWO PAGES TAD LOC3 /SUCESS, EXIT WITH ENTRY IN AC JMP I ALLOC TWOPAG, JMS GETPAG /GET 1 MORE PAGE IAC /SET TWO-PAGE BIT JMP FETCH+1 /GO DO FETCH GETPAG, 0 TAD NLOC TAD MN200 /SUBTRACT 200 DCA NLOC /STORE AS NEW NLOC TAD NLOC /GET VALUE JMP I GETPAG NLOC, CLA I GET400, 0 JMS GETPAG MN200, CLA I JMS GETPAG JMP I GET400 PAGE / /FIX UP ABORT AND TYPE OUT ROUTINES IF BATCH IS IN CORE / BATFIX, 0 STL RTR CLA /AC=2000 AND I M1 SNA CLA JMP I BATFIX /NO CHANGES NECESSARY TAD I M1 AND (70 /GET BATCH FIELD TAD (CIF DCA I (FLDCH1 TAD I (FLDCH1 IAC /CHANGE TO CDF CIF BATCH FIELD DCA I (FLDCH2 TAD (BATYP /CHANGE TYPE OUT ROUTINES DCA TYPE TAD (FLDCH2 /AND ABORT ROUTINES DCA ERROR JMP I BATFIX /EXIT / /ROUTINES TO INITIALLY BUILD FILE TABLES / BUILDT, TAD (-5 DCA INDX B1LP, TAD (CDF /BUILD RECORD LIST DCA I LSTPTR JMS I (GET400 DCA I LSTPTR /STORE RECORD BUFFER DCA I LSTPTR /AND RECORD LENGTH DCA I LSTPTR /AND RECORD COUNT DCA I LSTPTR ISZ INDX /UNTIL DONE JMP B1LP TAD K200 DCA BUFSTA /SET UP FIELD 1 BUFFERS TAD (-5 DCA INDX B2LP, TAD (CDF 10 DCA I LSTPTR TAD BUFSTA DCA I LSTPTR TAD BUFSTA TAD (400 DCA BUFSTA DCA I LSTPTR DCA I LSTPTR DCA I LSTPTR ISZ INDX JMP B2LP TAD (-12 DCA INDX /SET UP FOR FILE INFO DCA FILNUM /CLEAR FILE NUMBER POINTER DCA EOFLG /CLEAR E-O-F FLAG DCA CLEFT /CLR CHARACTER LEFT COUNT B3LP, TAD BUFSTA DCA STBUF /SET STARTING BUFFER LOCATION JMS I STRPTR /STORE IT IN FILSTR TAD BUFSTA TAD (400 DCA BUFSTA ISZ FILNUM ISZ INDX JMP B3LP TAD (-17 DCA INDX TAD (DEVTAB-1 DCA X10 /COPY DEVICE RESIDENCY TABLE TO PROGRAM TAD (7646 DCA X11 CPYTB, CDF 10 TAD I X11 CDF DCA I X10 ISZ INDX JMP CPYTB JMS I (7607 /WRITE I/O OVERLAY TO SYSTEM SCRATCH 4400 RENAME 33 /AT BLOCK 33 ERRHLT+2 /SYS ERROR DCA OVRLAY /CLEAR OVERLAY FLAG CDF 10 /CHECK FOR /C OPTION TAD I (7643 CDF AND (1000 /AND OFF BIT OF INTEREST DCA CMPRS /STORE ON PAGE 0 JMP I K200 USRIN=7700 X10=10 X11=11 DIRPTR=17 LSTPTR=16 BUFSTA, 0 NOSTRT, 0 DCA BATFIX /STORE AC ON ENTRY CDF TAD I (7746 /SET BIT 2 OF JOB STATUS WORD SO NO ".ST" COMMANDS CMA AND (6777 /WILL WORK CMA DCA I (7746 TAD BATFIX /CHECK AC ON ENTRY SNA CLA JMP I NOSTRT /GO BACK CIF 10 /PROGRAM STARTED WITH A ".R MRGV2", GET CD FOR OPTIONS JMS I (USRIN 10 CIF 10 JMS I USR /GET CD 5 0 JMP I NOSTRT /RETURN TO CALLER *2600 / /SUBROUTINE TO CHANGE EXTENSION ON FILE TO "AA" /ASSUMES LOOKUP HAS ALREADY BEEN PERFORMED ON THE FILE / RENAME, 0 CLA CMA /AC=-1 CDF 10 TAD I (1404 /PICKUP MINUS THE NUMBER OF ADDITIONAL INFO WORDS TAD I K17 /GET PTR TO EXTENSION DCA PTR TAD AA /GET NEW EXTENSION DCA I PTR TAD I K7 AND K7 /GET DIRECTORY BLOCK NUMBER DCA SEGNO TAD I K51 /GET DEVICE ENTRY PT DCA PTR CDF JMS I PTR /GO WRITE DIRECTORY SEGMENT 4210 1400 /ADDRESS OF DIRECTORY BLOCK IN USR SEGNO, 0 SKP CLA JMP I RENAME /EXIT CIF 10 JMS I USR /ERROR ON WRITE K7, 7 2 PTR, 0 K51, 51 AA, TEXT "AA" *.-1 /STRIP OFF TRAILING ZEROS / /ROUTINE TO LOOKUP FILE /POINTER TO FILENAME IS PARAMETER /DEVICE NUMBER IS PASSED IN AC / LOOKUP, 0 DCA PTR TAD I LOOKUP DCA STBLK1 TAD PTR CIF 10 JMS I USR 2 STBLK1, 0 0 ERRHLT+1 ISZ LOOKUP /BUMP OVER FILE NAME JMP I LOOKUP BATERR, TYPEA, 7000 /ADDRESS OF BATCH ERROR IN HIGHEST FLD OR TYPE ROUTINE TLS TSF /TYPE THE CHARACTER JMP .-1 /WAIT TILL DONE CLA /EXIT WITH CLEAN AC BATYP, JMP I TYPEA /ENTRY OF BATCH TYPE OUT OR EXIT OF TYPE ROUTINE CDF FLDCH1, CIF /CHANGED TO CIF BATCH FIELD IN INITIALIZATION JMS I BATOUT /7400 OF BATCH FIELD CLA JMP I BATYP FLDCH2, CDF CIF /BATCH ABORT ROUTINE JMP I BATERR /7000 OF BATCH FIELD / /SUBROUTINE TO WRITE OUT AN OCTAL NUMBER ON THE OUTPUT DEVICE /AC ON CALL = NUMBER TO TYPE OUT / OCTLIO, 0 DCA RENAME /STORE NUMBER TAD (-4 /LOOP INDEX DCA LOOKUP LPOCTO, TAD RENAME RTL CLL RAL /ROTATE AC DOWN DCA RENAME TAD RENAME RAL AND (7 TAD (260 JMS I TYPE /TYPE OUT THE DIGIT ISZ LOOKUP /CHECK FOR DONE JMP LPOCTO JMP I OCTLIO WRITN, TEXT "_OUTPUT RECORDS WRITTEN = " DIRNAM, FILENAME SRTINT.DI ALTERM, 0 TAD ALTCDE /GET ALTERNATE TERMINAL DEVICE CODES AND (77 /THIS TIME ONLY CONCERNED WITH OUTPUT CODE RTL CLL RAL /MOVE UP 1 DIGIT DCA OCTLIO /STORE IN A SAFE PLACE TAD TYPEA+1 /REPLACE OLD TTY COMMAND AND (7007 TAD OCTLIO DCA TYPEA+1 TAD TYPEA+2 AND (7007 TAD OCTLIO DCA TYPEA+2 JMP I ALTERM PAGE / /SUBROUTINE TO PRINT OUT A DECIMAL NUMBER / 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 INDX1, 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 INDX1 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 INDX1 /CHECK FOR ALL DONE JMP LOOPX /NOT YET ISZ DIVIDE /ADJUST RETURN JMP I DIVIDE /EXIT / / 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 PAGE ERR0, TEXT "_NO DEVICE FOUND AT " ERR1, TEXT "_LOOKUP ERROR AT " ERR2, TEXT "_SYS: I-O ERROR AT " ERR3, TEXT "_DSK: I-O ERROR AT " ERR4, TEXT "_INPUT FILE I-O ERROR AT " ERR5, TEXT "_RECORD OVERFLOW AT " ERR6, TEXT "_ENTER ERROR AT " ERR7, TEXT "_CLOSE ERROR AT " ERR10, TEXT "_WRITE ERROR AT " ERR11, TEXT "_NO ROOM FOR OUTPUT FILE AT " MSGLST, ERR0;ERR1;ERR2;ERR3;ERR4;ERR5;ERR6;ERR7;ERR10;ERR11 / /PAGE ZERO FOR MERGE / *0 ALTCDE, 0304 /ALTERNATE TERMINAL DEVICE CODES HLT MN240, -240 SPACNT, 0 M1, -1 K377, 377 JPACK, PACKC P240, 240 *20 FILINF=. EOFLG, 0 CLEFT, 0 PICKAX, 0 TEMP, 0 UNBLOC, 0 DEVCDE, 0 STBUF, 0 BLKNO, 0 BLEFT, 0 /********************************************************** SRTKEY, 0 FILNUM, 0 DSKENT, 0 DSKNUM, 0 OUTENT, 0 OUTNUM, 0 OUTNAM, 0 DIRBLK, 0 DIRSEG, 0 ERROR, 7600 TYPE, TYPEA BATOUT, P7400, 7400 PASSES, 0 OVRLAY, 1 INPHNL, 0 OUTBUF, 0 DIRBUF, 0 INDX, 0 USR, K200, 200 ADDROT, 0 STRPTR, STRFLS GETPTR, GETFLS RECIN, ZBLOCK 2 KYPTR, 0 K17, NFILE, FILINF-1 CMPRS, 0 MN11, -11 FILES, 0 LENGTH, 0 CDF1, 0 ADDR1, 0 LEN1, 0 CDF2, 0 ADDR2, 0 LEN2, 0 WRTBLK, 0 WRTENT, 0 WLENG, 0 WRTCNT, 0 WRTEN, 0 FILE1, 0 FLENGT, 0 DNEFLG, 0 LSTPAS, 0 ERRHLT=JMS I . ENTER0;ENTER1;ENTER2;ENTER3;ENTER4;ENTER5;ENTER6;ENTER7;ENTER8;ENTER9 ERRCD, 0 OADDR1, 0 OADDR2, 0 RECMRG, ZBLOCK 2 AC1, 0 CCHCK, 0 KRS /READ CHARACTER TAD M203 /CHECK FOR ^C SNA CLA KSF /IT IS A ^C, CHECK FOR KEYBOARD FLAG JMP I CCHCK /^C NOT TYPED CDF CIF JMP I ERROR /ERROR EXIT ON ^C M203, -203 CMPRSP, 0 DCA CCHCK TAD LSTPAS /CHECK FOR ON LAST PASS SNA CLA /YES, DON'T DO COMPRESSION TAD CMPRS /CHECK FOR /C OPTION SET SNA CLA JMP ENDOK /EITHER LAST PASS OR /C OPTION NOT SET TAD CCHCK /GET BACK CHARACTER TAD MN240 /CHECK FOR A SPACE SZA CLA JMP NTBLNK /NOT A SPACE ISZ SPACNT /SPACE, BUMP COUNT JMP I CMPRSP /EXIT NTBLNK, TAD SPACNT /NOT BLANK, CHECK FOR NON-ZERO COUNT SNA JMP ENDOK /ZERO COUNT, JUST OUTPUT CHARACTER TAD M1 /CHECK FOR ONLY 1 SPACE SNA CLA JMP SPACOT /ONE ONLY - JUST OUTPUT A SPACE TAD K377 /OUTPUT A RUBBOUT JMS I JPACK /PACK IT IN THE BUFFER TAD SPACNT /THEN THE SPACE COUNT SKP SPACOT, TAD P240 /OUTPUT A SPACE JMS I JPACK /PACK SPACE OR SPACE COUNT IN BUFFER ENDOK, DCA SPACNT /CLEAR SPACE COUNT TAD CCHCK /PUT CURRENT CHARACTER IN BUFFER JMS I JPACK JMP I CMPRSP /RETURN (A\Ab z\~"({]}(\v| /]({ /B,Ad\z" zy\&\(/;x"@wb 0z&Q(P* (;*>z\= `9zUQ($\"QP`>XP&9 ABJ]v({FLu(Yzt+8pNILS^ Q{8~s+VD,rA, o]