Directory of image this file is from
This file as a plain text file
/SORT COMMAND DECODER VERSION II FOR OS/8 / /OCTOBER, 1977. /BRYAN FREDRICK, MINNESOTA POLLUTION CONTROL AGENCY / /THIS PROGRAM HAS TWO MODES OF OPERATION: / NORMAL MODE: FORMATTED SORT SPECIFICATIONS ARE READ FORM AN INPUT FILE / SPECIFIED TO THE COMMAND DECODER. / / INTERACTIVE MODE: QUESTIONS ARE ASKED AND ANSWERED INTERACTIVELY ON THE / CONSOLE OR AN ALTERNATE ASCII TERMINAL. THIS MODE IS / TRIGGERED BY SPECIFYING /I TO THE COMMAND DECODER. / / / OUTPUT TABLES ARE GENERATED INTO LOCATIONS 04000-4377 AND ARE PASSED TO / THE SORT OR MERGE EITHER BY BEING LEFT IN CORE ACROSS THE CHAIN (FOR THE / SORT) OR BY BEING WRITTEN TO THE FILE DSK:SRTINT.DI (FOR THE MERGE). / / / OUTPUT TABLE FORMAT: / WORD 0 - MINUS THE NUMBER OF SORT KEYS / WORD 1 - SORT KEY #1 (MOST SIGNIFICANT) / BIT 0 = DIRECTION OF SORT 0=ASCENDING, 1=DESCENDING / BITS 1-11 = LENGTH OF SORT KEY IN BYTES / WORD 2 - STARTING CHARACTER POSITION (BEGINNING OF RECORD = 1) / WORDS 3,4 - SORT KEY #2 / WORDS 5,6 - SORT KEY #3 / WORDS 7,10 - SORT KEY #4 / WORDS 11,12 - SORT KEY #5 / WORDS 13,14 - SORT KEY #6 / WORDS 15,16 - SORT KEY #7 / WORDS 17,20 - SORT KEY #8 (LEAST SIGNIFICANT) / / WORD 21 - UNUSED / WORDS 22,23 - OUTPUT DEVICE NAME / WORDS 24,25,26,27 - OUTPUT FILE NAME AND EXTENSION / / WORDS 30-376 - INPUT FILE SPECIFICATIONS (3 WORDS/FILE) / EACH FILE TAKES 3 WORDS AS FOLLOWS: / WORD 1 - INPUT DEVICE NUMBER / WORD 2 - FILE STARTING BLOCK NUMBER / WORD 3 - MINUS FILE LENGTH / / THIS SCHEME GIVES ROOM FOR 77 (DECIMAL) INPUT FILES IN THE FIRST BLOCK /
MPCA=0 /SET FOR CONDITIONAL ASSEMBLY OF MPCA PECULIARITIES BUFKBD=2000 CUR=0 BUFINP=BUFKBD+400 / /BEGINNING OF SORT COMMAND DECODER - PROGRAM IS CONFIGURED TO FACILITATE /CCL "SORT" COMMAND. / *200 SKP CLA /PROG CALLED WITH ".R SORTCD", MUST DO COMMAND DECODER JMP CCLSRT /PROG CALLED WITH CCL "SORT" COMMAND CD WORK DONE USRIN=7700 CIF 10 /FETCH USR JMS I (USRIN /MIGHT AS WELL LEAVE THE USR IN MEMORY 10 CIF 10 JMS I USR /CALL COMMAND DECODER 5 0 CCLSRT, CDF 10 /CD WORK DONE, PICKUP OPTIONS AND FILE SPECS TAD I (7643 /FIRST OPTION WORD DCA OPTN1 BSW IAC /AND OFF /R OPTION ON SECOND WORD AND I (7644 DCA OPTN2 /STORE IT CDF JMS I (BATFIX /FIX I/O FOR BATCH AND ALTERNATE TERMINAL TAD (SRTKEY+27 DCA INPPTR /STORE POINTER TO INPUT FILE STORAGE CIF 10 /FETCH DSK: HANDLER (JUST IN CASE) JMS I USR 1 DEVICE DSK ARG3, 6601 /PUT IN A GOOD PLACE ERRHLT /FETCH ERROR, DSK: TAD ARG3-1 /GET DEVICE NUMBER DCA DSKNUM /STORE NUMBER TAD ARG3 /STORE ENTRY PT DCA DSKENT TAD OPTN2 /CHECK FOR /R OPTION SET SZA CLA JMP I (RESTAR /DO RESTART OF SYSTEM TAD OPTN1 /NOW CHECK FOR /I OPTION SET AND (10 SZA CLA JMP I (INTRAC /GO DO INTERACTIVE DIALOGUE CDF 10 TAD I (7617 /NORMAL MODE, PICKUP CD INFO DCA WRD1 /DEVICE #, LENGTH TAD I (7620 /START BLOCK DCA STBLKI CDF TAD WRD1 /FETCH INPUT DEVICE HANDLER SNA ERRHLT-17 /NO INPUT FILE SPECIFIED CIF 10 JMS I USR 1 INPENT, 7201 ERRHLT /FETCH ERROR, INPUT DEVICE TAD WRD1 /EXTEND SIGN BITS ON LENGTH WORD AND (7760 TAD (7 STL RTR RTR DCA LENGI /STORE AS INPUT LENGTH DCA CLEFT /CLEAR CHARACTER LEFT IN BUFFER COUNTER JMP I (DECODE /DECODE INPUT FILE PICKC, 0 TAD CLEFT /CHECK NUMBER OF CHARACTERS LEFT IN BUFFER SZA CLA JMP PICOK /STILL SOME LEFT TAD LENGI /CHECK INPUT LENGTH REMAINING SNA CLA ERRHLT-1 /"FILE OVERFLOW" JMS I INPENT /READ A BLOCK 0210 /TO FIELD 1, ADDRESS BUFINP BUFINP STBLKI, 0 SNA CLA SKP ERRHLT-2 /"INPUT ERROR" ISZ LENGI /BUMP REMAINING LENGTH M600, CLA /WITH NO PROBLEMS ON OVERFLOW ISZ STBLKI /BUMP BLOCK # TAD M600 /ADJUST CHARACTER COUNT DCA CLEFT TAD (PICK1 /INITIALIZE PICK ROUTINE DCA PICKA TAD (BUFINP DCA PICKAX PICOK, JMS PICK /GET A CHARACTER JMP I PICKC PICK, 0 CDF 10 JMP I PICKA PICKA, PICK1 AND (177 TAD K200 CDF JMP I PICK PICK1, TAD I PICKAX AND (7400 DCA T1 TAD I PICKAX ISZ PICKAX JMS PICKA TAD I PICKAX AND (7400 RTR CLL RTR TAD T1 RTR CLL RTR DCA T1 TAD I PICKAX ISZ PICKAX JMS PICKA TAD T1 JMS PICKA JMP PICK1 PAGE DECODE, JMS RDLNE /READ INPUT LINE TO BUFFER CLA CMA DCA CPOS CLA CMA JMS GETNUM /GET 1 NUMERIC CHARACTER (CARD TYPE) JMP I NUMERR /ILLEGAL CHARACTER OR END OF LINE TAD M1 /CHECK FOR A 1 SNA JMP I (CRD1 /GO PROCESS CARD TYPE 1 TAD M1 /CHECK FOR CARD TYPE 2 SNA JMP I (CRD2 TAD (2-11 /CHECK FOR A CARD TYPE 9 (EOF) SNA JMP CRD9 JMP I NUMERR /AN ILLEGAL INPUT VALUE CRD9, JMS GET1 /CONTINUE TYPING OUT REMAINDER OF CARD SKP JMP CRD9 EOFRD, TAD I (SRTKEY /CHECK TO MAKE SURE WE HAVE AT LEAST 1 SORT KEY SMA CLA ERRHLT-6 /NO SORT KEYS SPECIFIED CLA CMA TAD OUTFLS /CHECK FOR 1 AND ONLY 1 OUTPUT FILE SZA CLA ERRHLT-4 /"MORE THAN 1 OUTPUT FILE SPECIFIED" CLA CMA /CHECK FOR AT LEAST 1 INPUT FILE TAD INPUTF SPA ERRHLT-5 /"ILLEGAL NUMBER OF INPUT FILES" SNA CLA JMP I (CHAIN /ONE INPUT FILE IS ALWAYS OK TAD SRTMRG /IF MORE THAN 1 INPUT MUST BE A MERGE SNA CLA ERRHLT-5 /"ILLEGAL NUMBER OF INPUT FILES"(MORE THAN 1 SORT INPUT) JMP I (CHAIN /CHAIN TO SORT OR MERGE / /SUBROUTINE TO READ 1 LINE FROM INPUT FILE AND PUT IN BUFFER / X10=10 RDLNE, 0 TAD (BUFKBD-1 /SET UP BUFFER POINTER DCA X10 LOOPX, JMS I (PICKC /GET A CHARACTER TAD (-232 /CHECK FOR EOF SNA JMP EOFRD /GO TO EOF ROUTINE TAD (232-215 /CHECK FOR A CR SNA JMP EOL /END OF LINE TAD (215-240 /CHECK FOR ANY CONTROL CHARACTERS SMA JMP STR1 /NOT A CONTROL, STORE IN BUFFER CLA JMP LOOPX /IGNORE CONTROL CHARACTERS STR1, TAD (240 /RE-CONSTRUCT CHARACTER CDF 10 DCA I X10 /STORE IN FLD 1 BUFFER CDF JMP LOOPX /CONTINUE TO READ EOL, CDF 10 DCA I X10 /STORE A ZERO AS A TERMINATOR CDF TAD (BUFKBD-1 DCA X10 /RESET INPUT POINTER TO BEGINNING OF LINE JMP I RDLNE /EXIT GET1, 0 JMS CCHCK CDF 10 TAD I X10 /GET THE NEXT CHARACTER CDF DCA TCHAR /STORE IT TAD TCHAR SNA JMP EOL1 /ZERO, DO CRLF AND EXIT P+1 JMS I (TYPX /NOT A ZERO, TYPE LAST CHARACTER ISZ CPOS /BUMP INPUT POSITION NOP ISZ GET1 /TAKE NORMAL RETURN P+2 JMP I GET1 EOL1, JMS I (CRLFX /DO CR-LF JMP I GET1 /TAKE RETURN AT P+1 GETNUM, 0 DCA NSTRNG /STORE LENGTH OF FIELD DESIRED TAD NSTRNG /STORE AS LOOP INDEX DCA INDX1 GLOOP, DCA VALUE /STORE COMPUTED VALUE TAD INDX1 /CHECK FOR ALL DONE SNA CLA JMP NUMXIT /DONE, EXIT JMS GET1 JMP NUMXIT+1 /CR READ ISZ INDX1 /BUMP INDEX NOP TAD TCHAR /GET THE CHARACTER TAD (-240 SNA JMP RJN1 TAD (240-260 SPA JMP I GETNUM /ERROR CHARACTER < "0" RJN1, TAD (-12 /CHECK FOR CHARACTER TOO LARGE SMA JMP I GETNUM /ERROR CHARACTER > "9" TAD (12 DCA TCHAR /STORE NUMERIC VALUE TAD VALUE /GET ACCUMULATED VALUE RTL CLL TAD VALUE /MULTIPLY BY 10(DECIMAL) RAL CLL TAD TCHAR /ADD IN LAST CHARACTER JMP GLOOP /NOT DONE, CONTINUE NUMXIT, ISZ GETNUM /NORMAL RETURN, P+2 TAD VALUE /EXIT WITH VALUE IN AC JMP I GETNUM PAGE ERRN, DCA DIRECT /STORE AC ON ENTRY CLA CMA TAD INDX1 /PREPARE TO OUTPUT REMAINDER OF LINE AND ERROR INDICATOR CIA TAD NSTRNG /GET TO BEGINNING OF FIELD TAD CPOS CIA DCA INDX1 /THIS IS THE NUMBER OF SPACES TO BEGINNING OF FIELD TAD DIRECT /GET BACK ENTRY VALUE SZA CLA /CLEAR ANY JUNK JMS I (GET1 SKP /TYPE OUT REMAINDER OF LINE JMP .-2 TAD INDX1 /OUTPUT APPROPRIATE NUMBER OF SPACES SNA CLA JMP PUTARW TAD (240 JMS I TYPE ISZ INDX1 JMP .-3 PUTARW, TAD ("^ JMS I TYPE /TYPE OUT ARROWS UNDER FIELD IN ERROR ISZ NSTRNG JMP PUTARW ERRHLT-3 /"ILLEGAL INPUT CHARACTER" SRTKEY=4000 CRD1, ISZ ONECRD /CHECK FOR ONLY 1 TYPE 1 CARD ERRHLT-7 /"TOO MANY TYPE 1 CARDS" CLA CMA JMS I (GETNUM /GET THE SORT/MERGE INDICATOR JMP I NUMERR /INPUT ERROR TAD M1 SPA JMP I NUMERR /ZERO IS ILLEGAL DCA SRTMRG TAD SRTMRG TAD M1 /CHECK FOR 1 OR 2 SMA SZA CLA JMP I NUMERR /GT 2 ERROR DCA SRTKY TAD KEYS DCA X11 X11=11 KEYIN, CLA CMA JMS I (GETNUM /GET ASCENDING DESCENDING BIT JMP ENDCHK /CHECK FOR END OF DATA SNA /CHECK FOR ZERO OR BLANK JMP DNE /REST OF CARD IS A COMMENT TAD M1 SNA /CHECK FOR ASCENDING (1) JMP STRE /STORE IT TAD M1 SZA /CHECK FOR 2 (DESCENDING) JMP I NUMERR /NOT 1 OR 2, ERROR STL CLA RAR /AC=4000 STRE, DCA DIRECT TAD (-4 JMS I (GETNUM JMP I NUMERR /GET 4 DIGIT NUMBER TAD DIRECT /ADD IN THE DIRECTION DCA I X11 TAD (-4 JMS I (GETNUM JMP I NUMERR /BAD NUMBER DCA I X11 /STORE IN TABLE ISZ SRTKY /BUMP NUMBER OF KEYS JMP KEYIN /CONTINUE OPERATION DNE, JMS I (GET1 /TYPE OUT REMAINDER OF LINE SKP CLA JMP DNE JMP DNE1 ENDCHK, SZA JMP I NUMERR /ZERO=CR EXIT DNE1, TAD SRTKY CIA DCA I KEYS /STORE NUMBER OF SORT KEYS JMP I (DECODE SRTKY, 0 CHAIN, TAD SRTMRG SNA CLA JMP CHN2 /DON'T HAVE TO ENTER FILE FOR SORT TAD (20 TAD DSKNUM /ENTER 1 BLOCK TEMP CIF 10 JMS I USR 3 BLKO, XNAME 0 ERRHLT-11 TAD BLKO /WRITE OUTPUT TO DSK: DCA BLKOUT JMS I DSKENT 4200 KEYS, SRTKEY BLKOUT, 0 ERRHLT-12 /"OUTPUT ERROR" TAD DSKNUM /CLOSE ON DSK: CIF 10 JMS I USR 4 XNAME /CLOSE DIRECTORY FILE WITH 1 BLOCK LENGTH 1 ERRHLT-13 /"CLOSE ERROR" CHN2, TAD SRTMRG RTL CLL TAD (FILEN /GET POINTER TO FILE NAME DCA NAME1 /STORE IN LOOKUP CLA IAC /LOOKUP ON SYS: CIF 10 JMS I USR 2 NAME1, ZBLOCK 2 ERRHLT-10 /"LOOKUP ERROR" TAD NAME1 /GET BLOCK NUMBER DCA CHABLK /STORE IN CHAIN CIF 10 JMS I USR 6 CHABLK, 0 PAGE / /BUFFERED KEYBOARD HANDLER / /READS INPUT FROM TTY AND PUTS CHARACTERS IN KEYBOARD BUFFER STARTING AT BUFKBD /IN FIELD 1. RECOGNIZES THE FOLLOWING SPECIAL CHARACTERS: / / CR= LINE TERMINATOR, PLACES A ZERO IN BUFFER AND EXITS TO CALLER / LF=PRINTS CONTENTS OF BUFFER ON TTY / RUBOUT=ERASE 1 CHARACTER ECHO A "/" ON THE TTY / ^U=DELETE INPUT LINE ECHO "^U" CR-LF ON TTY / ^C=ABORT PROGRAM EXIT TO MONITOR, ECHOS "^C" ON TTY / / XINPUT, 0 KCC TAD (BUFKBD DCA PTR1 XINLP, KSF JMP .-1 KRB DCA CHAR TAD CHAR TAD (-210 /CHECK FOR A BACKSPACE BEFORE TYPING SNA CLA JMP BACKSP /YES TAD CHAR /GET THE CHARACTER REJN, JMS I TYPE /TYPE IT OUT TAD CHAR /GET THE CHARACTER BACK TAD (-215 SNA JMP ENDINP TAD (215-377 SNA JMP BACKUP TAD (377-225 SNA JMP TERM1 TAD (225-212 SNA JMP PRNTBF TAD (212-203 SNA CLA JMP ABORT1 TAD CHAR CDF 10 DCA I PTR1 CDF CUR ISZ PTR1 JMP XINLP BACKUP, JMS BACK1 /BACKUP POINTER TAD ("/ JMS I TYPE JMP XINLP BACK1, 0 CLA CMA TAD PTR1 DCA PTR1 TAD PTR1 TAD (-BUFKBD SNA CLA JMP TERMIN JMP I BACK1 BACKSP, STL RTR CLA AND OPTN1 /CHECK FOR /B OPTION SET SNA CLA IFZERO MPCA <JMP REJN> /TYPE IF NOT SET IFNZRO MPCA <JMP REJN+1> /ADJUST FOR BEEHIVE PECUILARITY IFZERO MPCA <TAD CHAR /TYPE THE CHARACTER IF NOT THE BEEHIVE JMS I TYPE> TAD P240 /OUTPUT A SPACE JMS I TYPE /TYPE IT TAD CHAR /BACKUP TERMINAL AGAIN JMS I TYPE JMS BACK1 /BACKUP POINTER JMP XINLP /GO TO GETTING MORE CHARACTERS TERM1, TAD ("^ JMS I TYPE TAD ("U JMS I TYPE TERMIN, TAD (BUFKBD DCA PTR1 JMS CRLF JMP XINLP ABORT1, TAD ("^ JMS I TYPE TAD ("C JMS I TYPE CAF CDF CIF JMP I ABORT ENDINP, CDF 10 DCA I PTR1 CDF CUR JMS CRLF TAD (BUFKBD-1 /SET UP X10 DCA X10 JMP I XINPUT PRNTBF, TAD (215 JMS I TYPE IFNZRO MPCA <TAD OPTN1 /CHECK /A OPTION SMA CLA /DON'T TYPE NULL ON BEEHIVE> JMS I TYPE /TIME FOR CR TAD (BUFKBD DCA NBF P1LOOP, TAD NBF CIA TAD PTR1 SNA CLA JMP XINLP CDF 10 TAD I NBF CDF CUR JMS I TYPE ISZ NBF JMP P1LOOP CRLF, 0 TAD (215 JMS I TYPE TAD (212 JMS I TYPE JMP I CRLF PTR1, 0 NBF, CHAR, 0 P240, " FLDCH2, CDF CIF /CHANGED TO CDF CIF BATCH FIEDL JMP I BATERR /DO BATCH ABORT BATERR, 7000 PAGE CTYPE, BATYP CDF JMS I TYPA /TYPE OUT THE CHARACTER CLA JMP I CTYPE TYPA, TYPEA /MAY BE CHANGED TO BATCH TYPE OUT ROUTINE TYPEA, 7000 TLS /TYPE THE CHARACTER TSF JMP .-1 CLA JMP I TYPEA BATFIX, 0 STL RTR CLA /AC=2000 AND I (7777 /PICKUP BATCH IN PROGRESS BIT SNA CLA JMP ALTCDE /BATCH NOT RUNNING CHECK FOR ALTERNATE TERMINAL TAD I (7777 AND (70 /GET BATCH FIELD TAD (CIF /MAKE A CIF BATCH FIELD DCA I (FLDCH1 /STORE TAD I (FLDCH1 /NOW CONVERT TO A CDF CIF BATCH FIELD IAC DCA I (FLDCH2 TAD CTYPE /ADJUST BATCH TYPE OUT ROUTINE DCA TYPA TAD (FLDCH2 /AND ABORT ROUTINES DCA ABORT ALTCDE, TAD OPTN1 SMA CLA JMP BATXIT /OPTION NOT SET TAD (INLIST DCA TEMP TAD ALTERM /CHANGE INPUT IOT'S BSW JMS PUTIT /PUT IN IO COMMANDS TAD (OUTLST /DO THE SAME FOR OUTPUT IOT'S DCA TEMP TAD ALTERM JMS PUTIT /PUT IN IO COMMANDS BATXIT, JMS I (NOPRNT /CHECK FOR /D OPTIONS JMP I BATFIX /RETURN PUTIT, 0 AND (77 RTL CLL RAL DCA CTYPE /STORE ALTERNATE DEVICE NUMBER LPUT, TAD I TEMP SNA /ZERO TERMINATES LIST JMP I PUTIT DCA TEMP1 /STORE ADDRESS ISZ TEMP /BUMP LIST POINTER TAD I TEMP1 /GET IOT AND K7007 /AND OFF FUNCTION BITS TAD CTYPE /ADD NEW DEVICE CODE DCA I TEMP1 JMP LPUT /CONTINUE WITH DEBACLE TEMP, 0 TEMP1, 0 K7007, 7007 INLIST, XINPUT+1;XINLP;XINLP+2;0 OUTLST, TYPEA+1;TYPEA+2;0 / / 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 CRLF1 SPA TAD (100 TAD (237 JMS I TYPE JMP I TYPECH CRLF1, JMS I (CRLF /TYPE OUT CR-LF JMP I TYPECH /EXIT / /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 PAGE FILEN, FILENAME SORTV2.SV FILENAME MRGV2.SV XNAME, FILENAME SRTINT.DI / / /SUBROUTINE TO PULL OFF DEVICE AND FILENAMES FROM INPUT BUFFER / ASSUMES DEFAULT DEVICE OF DSK /BUFFER STARTS AT LOCATIN BUFKBD IN FIELD 1 /CUR=CURRENT FIELD *10 /USES AUTO-INDX REGISTER 10 / / FILNM, 0 DCA ICOLN DCA IPER DCA OUTPTR+3 TAD (0423 /SET DEFAULT DEVICE TO DSK DCA FLNM TAD (1300 DCA FLNM+1 DEVLP, DCA OUTPTR DCA OUTPTR+1 DCA OUTPTR+2 NAMELP, TAD (-6 /GET SIX CHARS JMS GETNM OUTPTR CLA CMA CLL RAL /AC=-2 JMS GETNM OUTPTR+3 JMP I FILNM ICOLN, 0 IPER, 0 FLNM, ZBLOCK 2 OUTPTR, ZBLOCK 4 GETNM, 0 DCA INDX TAD I GETNM ISZ GETNM DCA NOUT GLOOX, JMS I (GET1 /GET A CHARACTER JMP I FILNM /ALL THROUGH TAD TCHAR /GET LAST CHARACTER TAD (-" SZA CLA /CHECK FOR A SPACE JMP CONT /NOT A SPACE TAD (10 /CHECK IF /I OPTION SET AND OPTN1 SZA CLA JMP GLOOX /YES, JUST IGNORE THIS CHARACTER JMP I FILNM /NOT SET, FIRST BLANK TERMINATES CONT, TAD (10 AND OPTN1 /CHECK FOR /I SNA CLA JMP CONT3 TAD TCHAR /STORE CHARACTER IN OUTPUT BUFFER JMS I (PACKC CONT3, TAD TCHAR /GET THE CHARACTER BACK TAD (-": SNA JMP DEVEND TAD (":-". SNA JMP END TAD (". AND (77 DCA KCHR TAD INDX SNA JMP GLOOX RAR CLL CLA TAD KCHR SNL BSW TAD I NOUT DCA I NOUT ISZ INDX NOP SZL ISZ NOUT JMP GLOOX JINDX, NOUT, 0 INDX, 0 KINDX, KCHR, 0 END, TAD IPER SZA CLA JMP ERROR CLA CMA DCA IPER CLA CMA DCA ICOLN JMP I GETNM DEVEND, TAD ICOLN SZA CLA JMP ERROR TAD OUTPTR DCA FLNM TAD OUTPTR+1 DCA FLNM+1 CLA CMA DCA ICOLN JMP DEVLP ERROR, ERRHLT-14 /"ILLEGAL FILENAME" ZNAME, FILENAME SRTINT.AB PAGE CRD2, CLA CMA CLL RAL /SET UP FOR ERROR ROUTINE DCA NSTRNG CLA CMA CLL RAL DCA INDX1 JMS I (GET1 /GET A PAIR OF CHARACTERS JMP I NUMERR /BAD DATA TAD TCHAR /GET THIS CHARACTER AND (77 BSW /PAIR UP THE CHARACTERS DCA WRD1 ISZ INDX1 JMS I (GET1 /GET THE SECOND CHARACTER JMP I NUMERR /PREMATURE CR TAD TCHAR /GET SECOND CHARACTER ISZ INDX1 NOP AND (77 TAD WRD1 TAD (-1116 /CHECK FOR "IN" SNA JMP INPFL /GO DO INPUT FILE THING TAD (1116-1725 /CHECK FOR "OU" SZA JMP I NUMERR /ERROR ON INPUT OUTFL, JMS I (FILNM /GET OUTPUT FILE NAME AND ADDRESS ISZ OUTFLS /BUMP COUNT NOP TAD (FLNM-1 /COPY FILE NAME TO OUTPUT TABLE DCA X15 X15=15 TAD (SRTKEY+21 DCA X11 TAD (-6 DCA INDX1 TAD I X15 DCA I X11 ISZ INDX1 JMP .-3 TAD (FLNM-1 JMS INQUIR /INQUIRE ABOUT DEVICE CLA JMP COMMEN /GET NEXT CARD INQUIR, 0 DCA X15 TAD I X15 /COPY NAME TO INQUIRE REQUEST DCA INQ TAD I X15 DCA INQ+1 CIF 10 JMS I USR 12 INQ, ZBLOCK 3 ERRHLT-13 /"UNDEFINED DEVICE" TAD INQ+1 /RETURN WITH DEVICE NUMBER IN AC JMP I INQUIR /EXIT INPFL, JMS FIXINP /FIX UP THIS INPUT FILE COMMEN, CLA CMA TAD X10 DCA X10 CDF 10 TAD I X10 CDF SZA CLA JMS I (GET1 /TYPE OUT REMAINDER OF COMMENT FIELD SKP JMP .-2 JMP I (DECODE /GO GET NEXT CARD INPPTR=16 NOPRNT, 0 TAD I (TYPA /SAVE OLD TYPE ROUTINE DCA OLDTYP /FOR ERROR ROUTINE TAD OPTN1 /GET BACK FIRST OPTION WORD AND (400 /AND OFF /D OPTION SNA CLA JMP I NOPRNT /NOT SET, EXIT TAD (NOTYPE /SET UP DUMMY TYPE ROUTINE DCA I (TYPA JMP I NOPRNT /EXIT NOTYPE, 0 CLA JMP I NOTYPE RWDIR, 0 DCA DSKBLK /STORE BLOCK NUMBER RAR /MOVE LINK TO BIT 0 TAD K200 /SET UP TO READ/WRITE DIRECTORY BLOCK DCA .+2 JMS I DSKENT /READ DIRECTORY 200 SRTKEY /READ 1 BLOCK TO SRTKEY IN FLD 0 DSKBLK, 0 ERRHLT-2 /"INPUT ERROR" JMP I RWDIR /EXIT FIXINP, 0 JMS I (FILNM /GET INPUT FILE NAME TAD (OUTPTR DCA NAME3 /STORE INPUT FILE NAME IN LOOKUP TAD (FLNM-1 JMS INQUIR /INQUIRE ABOUT DEVICE DCA I INPPTR /STORE IT IN TABLE TAD INQ+1 /GET DEVICE NUMBER CIF 10 JMS I USR /LOOKUP FILE 2 NAME3, ZBLOCK 2 ERRHLT-15 /"UNDEFINED INPUT FILE" TAD NAME3 DCA I INPPTR TAD NAME3+1 DCA I INPPTR ISZ INPUTF /BUMP NUMBER OF INPUT FILES JMP I FIXINP /EXIT PAGE / /SUB-PROGRAM TO RESTART SORT - READS DIRECTORY FILE, ADJUSTS DIRECTORY FILE /FOR CHANGING STARTING BLOCKS AND WRITES NEW DIRECTORY. THEN CHAINS TO MERGE / /WOULD BE CALLED AFTER MERGE RAN OUT OF SPACE TO RESTART MERGE PROCEDURE / RESTAR, CLA IAC /SET UP TO CHAIN TO MERGE DCA SRTMRG TAD DIRBLK /LOOKUP DIRECTORY FILE JMS LOOKUP ERRHLT-10 /"LOOKUP ERROR" TAD INPBLK DCA DIRBLK DCA OLDBLK TAD (BUFINP-1 DCA X10 /SET UP TO FIND ALL SEGMENTS DCA SEGMNT /CLEAR COUNTER TAD DIRBLK /SET UP READ DCA RDBLK READ, TAD RDBLK /READ DIRECTORY CLL JMS I (RWDIR /GO READ DIRECTORY BLOCK ISZ RDBLK /BUMP READ BLOCK NXT1, TAD I INPPTR /GET INPUT FILE SPEC SNA CLA /ZERO MEANS END OF FILES JMP PART2 /DO SECOND PART OF PROCEDURE TAD I INPPTR /STORE BLOCK NUMBER DCA LOOKUP TAD LOOKUP /CHECK FOR STILL IN SAME INTERMEDIATE CIA TAD OLDBLK SNA CLA JMP NEXT /STILL IN THE SAME OLD ONE TAD LOOKUP /WE HAVE A NEW FILE CDF 10 DCA I X10 /STORE IN SORT LIST TAD SEGMNT /WITH POSITION DCA I X10 CDF ISZ SEGMNT /BUMP SEGMENT COUNT TAD LOOKUP /STORE NEW BLOCK NUMBER DCA OLDBLK NEXT, TAD I INPPTR /GET MINUS THE FILE LENGTH CIA TAD OLDBLK DCA OLDBLK /LOOK AHEAD TO NEXT BLOCK TAD INPPTR /CHECK FOR DONE WITH THIS SEGMENT TAD (-SRTKEY-376 SZA CLA JMP NXT1 /NOT YET DONE, CONTINUE TAD (SRTKEY-1 /SET UP FOR NEXT BLOCK DCA INPPTR JMP READ /READ NEXT DIRECTORY BLOCK OLDBLK, 0 / /SUBROUTINE TO LOOKUP FILE ON DSK /EXITS P+1 IF FILE NOT FOUND /EXITS P+2 IF FILE FOUND / LOOKUP, 0 DCA INPBLK /STORE POINTER TO FILE NAME TAD DSKNUM /LOOKUP ON DSK: CIF 10 JMS I USR /DO LOOKUP 2 INPBLK, 0 INLEFT, 0 JMP I LOOKUP /NOT FOUND ISZ LOOKUP /NORMAL RETURN, FILE FOUND JMP I LOOKUP / /SUBROUTINE TO RENAME A FILE /EXTENSION IS IN PARAMETER / RENAME, 0 CLA CMA CDF 10 TAD I (1404 /GET PTR TO EXTENSION TAD I K17 DCA LOOKUP CDF TAD I RENAME /GET NEW EXTENSION ISZ RENAME CDF 10 DCA I LOOKUP /STORE NEW EXTENSION TAD I K7 /GET BLOCK # AND K7 DCA SEGNO TAD I (51 DCA LOOKUP CDF JMS I LOOKUP /RE-WRITE DIRECTORY SEGMENT 4210 1400 /ADDRESS WHERE USR STORES DIRECTORY SEGMENTS SEGNO, 0 SKP CLA JMP I RENAME /OK EXIT CIF 10 /ERROR- DO MONITOR ERROR ROUTINE JMS I USR K7, 7 K17, 17 PART2, JMS I (SRTCRY TAD SEGMNT /SET UP FOR LOOKING UP INTERMEDIATES CIA DCA WRD1 DCA WRD2 CONT1, TAD (YNAME /LOOKUP "SRTINT.AA" JMS LOOKUP ERRHLT-10 /"LOOKUP ERROR" -NOT FOUND JMS RENAME /RENAME TO "SRTINT.AB" 0102 /ASCII "AB" TAD (BUFINP-1 /SET UP TO RELOCATE BLOCK NUMBERS DCA X10 TAD (SRTKEY+400 DCA LOOKUP KLOOP, ISZ X10 /BUMP OVER BLOCK NUMBER CDF 10 TAD I X10 /GET THE SEGMENT NUMBER CIA CDF TAD WRD2 /COMPARE WITH THIS SEGMENT SNA CLA JMP FOUND ISZ LOOKUP /BUMP OUTPUT ADDRESS JMP KLOOP /AND CONTINUE TO LOOK FOR THIS SEGMENT FOUND, TAD INPBLK DCA I LOOKUP /STORE BLOCK NUMBER FOR MAPPING THIS SEGMENT ISZ WRD2 /BUMP SEGMENT COUNTER ISZ WRD1 /CHECK FOR DONE JMP CONT1 /NOT DONE CONTINUE JMP I (ADJUST /HAVE FOUND ALL SEGMENTS PAGE / /SUBROUTINE TO SORT ARRAY WITH 1 CARRY WORD / SRTCRY, 0 IAC DCA K /SET UP K TAD K /CHECK FOR K >= SEGMNT STL CIA TAD SEGMNT SZL SNA CLA JMP I SRTCRY /K >= SEGMNT, ALL THRU TAD K IAC DCA L /COMPUTE L LPIN, TAD SEGMNT /CHECK FOR L > SEGMNT CIA STL TAD L SNL SZA CLA JMP LPND /L > SEGMNT, CONTINUE TO BUMP K TAD L RAL CLL /COMPUTE POINTERS TO ARRAY TAD (BUFINP-2 DCA IARRYL TAD K RAL CLL TAD (BUFINP-2 DCA IARRYK CDF 10 /COMPARE VALUES TAD I IARRYL STL CIA TAD I IARRYK SZL SNA CLA JMP LPND1 /ARRAY(L) > ARRAY(K), CONTINUE TAD I IARRYK /ARRAY(K) > ARRAY(L), INTERCHANGE DCA WRD1 ISZ IARRYK TAD I IARRYK DCA WRD2 CLA CMA /BACK UP POINTER TAD IARRYK DCA IARRYK TAD I IARRYL DCA I IARRYK ISZ IARRYL ISZ IARRYK /BUMP POINTERS TAD I IARRYL DCA I IARRYK TAD WRD2 DCA I IARRYL CLA CMA TAD IARRYL DCA IARRYL TAD WRD1 DCA I IARRYL LPND1, CDF ISZ L NOP /BUMP L WITH NO SKIP PROBLEM JMP LPIN /CONTINUE LPND, TAD K /GET K IN AC FOR INCREMENTING JMP SRTCRY+1 /CONTINUE WITH SORT L, 0 K, 0 IARRYK, 0 IARRYL, 0 / /ROUTINE FOR ADJUSTING STARTING BLOCKS FOR RESTART / ADJUST, TAD (SRTKEY+377 /SET UP POINTER TO OLD BLOCK NUMBERS DCA X15 DCA PSTBLK /CLEAR PAT BLOCK INDICATOR TAD DIRBLK /START FROM THE BEGINNING DCA RDBLK TAD (SRTKEY+27 READ2, DCA INPPTR /SET UP TO ADJUST BLOCK NUMBERS TAD RDBLK /GET BLOCK NUMBER CLL /FOR READ OPERATION JMS I (RWDIR /READ IN BLOCK TLOOP, TAD I INPPTR /GET DEVICE NUMBER SNA CLA JMP DNEOP /ZERO MEANS THRU TAD I INPPTR /GET BLOCK NUMBER (OLD) DCA BLK1 TAD BLK1 /CHECK FOR CHANGE CIA TAD PSTBLK /COMPARE WITH NEXT SEGMENT SNA CLA JMP CONT2 /NO CHANGE, STILL THE SAME OLD SEGMENT TAD BLK1 /CHANGE OLD BLOCK NUMBER TO NEW BLOCK NUMBER DCA PSTBLK TAD I X15 /PICK UP BLOCK TO MAP IT TO DCA NWBLK /STORE IT CONT2, TAD INPPTR /STORE INPUT POINTER DCA BLK1 TAD NWBLK /MOVE IN NEW BLOCK # DCA I BLK1 TAD I INPPTR /ADJUST FOR LENGTH OF THIS SEGMENT CIA DCA BLK1 TAD BLK1 /BUMP OLD BLOCK COUNT TAD PSTBLK DCA PSTBLK /SHOULD BE START FOR NEXT ONE TAD BLK1 TAD NWBLK DCA NWBLK /ALSO ADJUST NEW BLOCK COUNTER TAD INPPTR /CHECK FOR DONE WITH BLOCK TAD (-SRTKEY-376 SZA CLA JMP TLOOP /NOT DONE YET TAD RDBLK /WRITE OUT THIS BLOCK STL JMS I (RWDIR ISZ RDBLK /BUMP TO NEXT BLOCK TAD (SRTKEY-1 JMP READ2 DNEOP, TAD RDBLK /WRITE OUT LAST BLOCK STL JMS I (RWDIR LLOOP, TAD (ZNAME /NOW RENAME ALL SRTINT.AB BACK TO SRTINT.AA JMS I (LOOKUP JMP I (CHN2 /NO FILE FOUND, NOW CHAIN TO MERGE JMS I (RENAME /RENAME THIS FILE 0101 /ASCII CODE FOR "AA" JMP LLOOP /CONTINUE RENAMING PAGE / /SUB-PROGRAM TO DO INTERACTIVE MODE OF COMMAND DECODER / INTRAC, TAD OPTN1 /CHECK FOR /F OPTION SET AND (100 DCA OUTPTF /STORE IT TAD OUTPTF SNA CLA JMP I (STRQST /NOT SET, CAN START WITH REQUESTS CDF 10 /SET, CHECK COMMAND DECODER AREA FOR OUTPUT FILE SPECIFIED TAD I (7600 CDF SNA JMP DEFLT /NO FILE SPECIFIED, SET UP DEFAULTS DCA OUTNUM /STORE OUTPUT DEVICE NUMBER TAD (FILOUT-1 /SET UP FOR COPYING FILE NAME DCA X15 TAD (7600 DCA X10 TAD (-4 DCA T1 CPYNM, CDF 10 /GET NAME DOWN FROM COMMAND DECODER TAD I X10 CDF DCA I X15 ISZ T1 /CONTINUE UNTIL DONE JMP CPYNM RJN4, TAD OUTNUM /NOW ENTER OUTPUT FILE CIF 10 JMS I USR /FETCH OUTPUT DEVICE BY NUMBER 1 OUTENT, 7201 ERRHLT /"FETCH ERROR" - OUTPUT DEVICE TAD OUTNUM CIF 10 /ENTER TENTATIVE FILE JMS I USR 3 OUTBLK, FILOUT OUTLEN, 0 ERRHLT-11 /"ENTER ERROR" TAD OUTLEN /CHECK FOR NON-FILE STRUCTURED SNA IAC /SET LENGTH = 4095 BLOCKS DCA OUTLEN DCA WRTEN /CLEAR # BLOCKS ACTUALLY WRITTEN JMS INITAL /INITIALIZE PACK ROUTINE JMP I (STRQST /GO GET COMMANDS DEFLT, TAD DSKNUM /SET NAME TO DSK:SORT.SP DCA OUTNUM JMP RJN4 /RETURN TO USR WORK FILOUT, FILENAME SORT.SP INITAL, 0 TAD (PACK1 /SET UP PACK ROUTINE DCA PACKA TAD (BUFINP DCA ADDROT TAD MN600 /INITIALIZE CHARACTER COUNT DCA WRTCNT JMP I INITAL WRTCNT, 0 / /SUBROUTINE TO PACK CHARACTERS 1 AT A TIME, WRITES BUFFER AND RE-INITALIZES ON /FULL BUFFER. / PACKC, 0 DCA WRTBLK TAD OUTPTF /CHECK IF /F OPTION SET SNA CLA JMP I PACKC /NOT SET, EXIT TAD WRTBLK /GET CHARACTER BACK JMS PACK /PACK OUTPUT CHARACTER ISZ WRTCNT /CHECK FOR DONE WITH BLOCK JMP I PACKC /NO, EXIT TAD OUTLEN /CHECK FOR OUTPUT AREA FULL SNA CLA ERRHLT-16 /"NO ROOM FOR OUTPUT FILE" TAD OUTBLK /SET UP WRITE BLOCK DCA WRTBLK JMS I OUTENT /WRITE BUFFER 4210 BUFINP WRTBLK, 0 ERRHLT-12 ISZ OUTBLK /BUMP OUTPUT BLOCK ISZ WRTEN /BUMP NUMBER OF BLOCKS ACTUALLY WRITTEN ISZ OUTLEN MN600, CLA JMS INITAL JMP I PACKC /EXIT / /SUBROUTINE TO PACK CHARTACTERS INTO STANDARD OS/8 FORMAT ONE AT A TIME / PACK, 0 AND (377 CDF 10 JMP I PACKA PACKA, PACK1 CDF 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 CHART, 0 ADDROT, 0 P7400, 7400 PAGE STRQST, TAD (TYPEA /WE MUST HAVE A CHARACTER ORIENTED I-O DEVICE DCA I (TYPA NLOOP, IFNZRO MPCA <TAD OPTN1 /CHECK FOR /A OPTION SET SMA CLA JMP .+5 TAD (233 //A OPTION SET CLEAR SCREEN JMS I TYPE TAD (305 JMS I TYPE> TAD (-10 /SET UP INDEX TO KEYS DCA INDX4 JMS I MSG /ASK FOR SORT OR MERGE INTMS1 JMS I INPUT /GET INPUT JMS I (GET1 /GET 1ST CHARACTER JMP NLOOP /A CARRIAGE RETURN HERE NOT KOSHER TAD TCHAR TAD (-"S SNA JMP SRT /"S(ORT)" FOUND TAD ("S-"M SZA CLA JMP NLOOP /ILLEGAL CHARACTER IAC CLA /"M(ERGE)" FOUND SRT, DCA SRTMRG /STORE AS SORT/MERGE INDICATOR TAD (SRTKEY /SET UP TO BUILD KEY TABLE DCA X15 RLOOP, TAD I (NUMSTG /GET STRING AND (7700 /AND OFF CHARACTER TAD INDX4 /FIX UP KEY NUMBER TAD (71 DCA I (NUMSTG /STORE IN MESSAGE JMS I MSG /ASK ASCENDING/DESCENDING INTMS2 JMS I INPUT JMS I (GET1 /GET THE FIRST CHARACTER JMP JXIT /CR = FIRST CHARACTER LAST KEY TAD TCHAR /GET THE CHARACTER TAD (-"A /CHECK FOR "A(SCENDING)" SNA JMP ASCD TAD ("A-"D /CHECK FOR "D(ESCENDING)" SZA CLA JMP RLOOP /NOT TOO GOOD, FELLA STL RAR /AC=4000 ASCD, DCA DIRECT /STORE DIRECTION OF SORT JMS I MSG /ASK LENGTH OF KEY INTMS3 JMS I INPUT IAC JMS I (GETNUM /GET A NUMBER JMS I (CHKDNE /WILL ALWAYS RETURN HERE JMP ASCD+1 /ZERO NOT LEGAL TAD DIRECT /GET DIRECTION INDICATOR DCA I X15 /ADD IN LENGTH AND STORE IN TABLE BDATA, JMS I MSG /ASK STARTING POSITION INTMS4 JMS I INPUT IAC JMS I (GETNUM JMS I (CHKDNE JMP BDATA DCA I X15 /STORE IN TABLE ISZ INDX4 /CHECK FOR DONE JMP RLOOP JXIT, TAD INDX4 /GET NUMBER OF KEYS CIA TAD (-10 SNA JMP RLOOP /ZERO KEYS SPECIFIED DCA INDX4 TAD (261 /OUTPUT CARD TYPE 1 JMS I (PACKC TAD (261 /OUTPUT SORT/MERGE INDICATOR TAD SRTMRG JMS I (PACKC TAD INDX4 DCA I (SRTKEY /STORE NUMBER OF KEYS IN TABLE TAD (SRTKEY /SET UP TO BUILD CARD DCA X15 BLIST, TAD I X15 DCA T1 /STORE FIRST WORD STL RAR /AC=4000 AND T1 /AND OUT ASCENDING/DESCENDING BIT SZA CLA IAC TAD (261 /OUTPUT THE CHARACTER JMS I (PACKC CLA CMA CLL RAR /AC=3777 AND T1 /MASK OFF LENGTH DCA T1 TAD (-4 JMS I (NUMPNT T1 TAD I X15 DCA T1 TAD (-4 JMS I (NUMPNT /OUTPUT STARTING CHARACTER T1 ISZ INDX4 JMP BLIST JMS I (CRLF77 /OUTPUT A CR-LF JMP I (TWOCRD /GO GET TYPE TWO DATA INDX4, 0 PAGE YNAME, FILENAME SRTINT.AA CRLF77, 0 TAD (215 JMS I (PACKC TAD (212 JMS I (PACKC JMP I CRLF77 CRLFX, 0 TAD (215 JMS I (TYPX TAD (212 JMS I (TYPX JMP I CRLFX TWOCRD, TAD ("2 JMS I (PACKC /PACK OUT CARD TYPE TAD ("O /AND "OU" JMS I (PACKC TAD ("U JMS I (PACKC JMS I MSG /ASK OUTPUT FILE INTMS5 JMS I INPUT /GET INPUT JMS I (FILNM /GET THE FILENAME JMS CRLF77 /ADD CR-LF TAD (SRTKEY+21 /PACK INTO TABLES DCA X11 TAD (-6 DCA CRLF77 TAD (FLNM-1 DCA X15 TAD I X15 /GET DEV: FILENAME DCA I X11 /STORE IN TABLE ISZ CRLF77 JMP .-3 /CONTINUE TILL DONE TAD (FLNM-1 /MAKE SURE OUTPUT DEVICE EXISTS JMS I (INQUIR CLA /IF WE RETURNED, THINGS ARE OKAY TAD (SRTKEY+27 /SET UP FOR INPUT FILES DCA INPPTR JLP2IN, TAD ("2 JMS I (PACKC TAD ("I JMS I (PACKC TAD ("N JMS I (PACKC JMS I MSG /ASK FILE NAME INTMS6 JMS I INPUT /GET INPUT JMS I (GET1 /CHECK FOR END JMP KXIT /FIRST CHARACTER = CR...ALL DONE CLA CMA TAD X10 DCA X10 /NOT DONE, NEED TO BACK UP X10 JMS I (FIXINP /FIX INPUT TABLES JMS CRLF77 /ADD IN A CR-LF TAD SRTMRG /IF A SORT, WE CAN HAVE BUT 1 INPUT SZA CLA JMP JLP2IN /A MERGE, LOOP THRU INPUT FILES KXIT, TAD OPTN1 /CHECK /F SET AND (100 SNA CLA JMP I (CHAIN /NOT SET, DO CHAIN TO SORT OR MERGE TAD ("9 /OUTPUT A TYPE 9 CARD JMS I (PACKC JMS CRLF77 TAD (232 /ADD IN A ^Z JMS I (PACKC TAD I (WRTCNT /FILL OUT REMAINDER OF BLOCK WITH ZEROS TAD (600 SNA CLA JMP CLSIT /DONE, CLOSE OUTPUT FILE JMS I (PACKC /FILL WITH ZEROS JMP .-5 CLSIT, TAD WRTEN /CLOSE SORT SPECIFICATION FILE DCA CALL+3 TAD OUTNUM /ADD IN OUTPUT DEVICE # CIF 10 CALL, JMS I USR /DO CLOSE 4 FILOUT 0 ERRHLT-13 /"CLOSE ERROR" JMP I (CHAIN /CHAIN TO SORT OR MERGE CHKDNE, 0 SNA /ZERO AC IS AN ERROR JMP I CHKDNE /GO ASK QUESTION AGAIN DCA CRLF77 /STORE VALUE CLA CMA /BACKUP AUTO INDEX TAD X10 DCA X10 JMS I (GET1 /GET LAST CHARACTER TO SEE IF A CR JMP .+3 /A CR, EVERTHING IS HONKY-DORY CLA /CLEAR JUNK JMP I CHKDNE /SORRY FELLA, ILLEGAL INPUT ISZ CHKDNE /BUMP TO GOOD RETURN TAD CRLF77 /GET VALUE ON CALL JMP I CHKDNE /RETURN TO SENDER BATYP, 0 FLDCH1, CIF /CHANGED TO CIF BATCH FIELD JMS I BATOUT /OUTPUT CHARACTER IN BATCH LOG JMP I BATYP PAGE / /SUBROUTINE TO PRINT OUT A DECIMAL NUMBER / NUMPNT, 0 DCA LENOT /STORE LENGTH OF FIELD TAD I NUMPNT /GET ADDRESS OF VALUE DCA DIVIDE /A GOOD PLACE TO PUT IT ISZ NUMPNT /BUMP RETURN OVER PARAMETER TAD I DIVIDE /GET VALUE DCA RECIN+1 /STORE IN OUTPUT FIELD DCA RECIN 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 TAD INDX2 /COMPUTE NUMBER OF LEADING SPACES CIA TAD LENOT SZA JMS SPACR /TYPE OUT THOSE SPACES TYPOUT, TAD I DIV1 /PICK UP DIGIT ISZ DIV1 /BUMP POINTER TO NEXT JMS I (PACKC /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 INDX3, 0 INDX2, 0 TYPSTR, ZBLOCK 10 /DIGITS BUFFER RECIN, ZBLOCK 2 LENOT, 0 SPACR, 0 DCA DIVIDE /STORE COUNT TAD (240 JMS I (PACKC /PACK IN A SPACE ISZ DIVIDE /BUMP COUNT JMP .-3 /NOT DONE, CONTINUE JMP I SPACR /DONE, EXIT / /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 <QUO;QUO+1> 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 INDX3 LOOPY, 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 INDX3 /CHECK FOR ALL DONE JMP LOOPY /NOT YET ISZ DIVIDE /ADJUST RETURN JMP I DIVIDE /EXIT TYPX, 0 DCA DIVIDE /STORE CHARACTER TAD OPTN1 /PICK UP /I OPTION AND (10 SZA CLA JMP I TYPX /SET, NO NEED TO TYPE THIS CHARACTER TAD DIVIDE /NOT SET TYPE CHARACTER JMS I TYPE JMP I TYPX /EXIT PAGE ERR0, TEXT "_FETCH ERROR AT " ERR1, TEXT "_FILE OVERFLOW AT " ERR2, TEXT "_INPUT ERROR AT " ERR3, TEXT "_ILLEGAL INPUT CHARACTER AT " ERR4, TEXT "_TOO MANY OUTPUT FILES AT " ERR5, TEXT "_ILLEGAL NUMBER OF INPUT FILES AT " ERR6, TEXT "_NO SORT KEYS SPECIFIED AT " ERR7, TEXT "_TOO MANY TYPE 1 CARDS AT " ERR10, TEXT "_LOOKUP ERROR AT " ERR11, TEXT "_ENTER ERROR AT " ERR12, TEXT "_OUTPUT ERROR AT " ERR13, TEXT "_UNDEFINED DEVICE AT " ERR14, TEXT "_ILLEGAL FILENAME AT " ERR15, TEXT "_UNDEFINED INPUT FILE AT " ERR16, TEXT "_NO ROOM FOR OUTPUT FILE AT " ERR17, TEXT "_NO INPUT FILE SPECIFIED AT " ERRTAB, ERR0;ERR1;ERR2;ERR3;ERR4;ERR5;ERR6;ERR7;ERR10;ERR11;ERR12;ERR13;ERR14 ERR15;ERR16;ERR17 *4000 SRTKEY, ZBLOCK 400 INTMS1, TEXT /_SORT (S) OR MERGE (M)? / INTMS2, TEXT /__KEY #/ NUMSTG=.-1 TEXT /_ASCENDING (A) OR DESCENDING (D)? / INTMS3, TEXT /LENGTH OF KEY IN CHARACTERS? / INTMS4, TEXT /STARTING CHARACTER POSITION (FIRST=1)? / INTMS5, TEXT "_OUTPUT DEVICE/FILENAME? " INTMS6, TEXT "_INPUT DEVICE/FILENAME? " *0 ALTERM, IFZERO MPCA <0304> IFNZRO MPCA <3031> HLT *20 OPTN1, 0 OPTN2, 0 TYPE, CTYPE ABORT, 7600 DSKNUM, 0 DSKENT, 0 LENGI, 0 WRD1, 0 WRD2, 0 SEGMNT, 0 CLEFT, 0 CPOS, 0 SRTMRG, 0 INDX1, 0 INPUTF, 0 OUTFLS, 0 TCHAR, 0 NUMERR, ERRN NSTRNG, 0 ONECRD, -1 BATOUT, 7400 VALUE, 0 MSG, MSGA INPUT, XINPUT OUTNUM, 0 WRTEN, 0 OUTPTF, 0 T1, 0 PICKAX, 0 DIRECT, 0 OLDTYP, 0 BLK1, 0 PSTBLK, 0 NWBLK, 0 RDBLK, 0 DIRBLK, XNAME ERRCD, 0 ENTR17, 0 ISZ ERRCD ISZ ERRCD ISZ ERRCD ISZ ERRCD ISZ ERRCD ISZ ERRCD ISZ ERRCD ISZ ERRCD ISZ ERRCD ISZ ERRCD ISZ ERRCD ISZ ERRCD ISZ ERRCD ISZ ERRCD ERRHLT=JMS . ENTER0, ISZ ERRCD CLA TAD ERRCD CIA TAD (ENTER0 DCA T1 TAD (ERRTAB TAD ERRCD DCA MSGB TAD I MSGB DCA MSGB TAD OLDTYP DCA I (TYPA JMS I MSG MSGB, 0 TAD I T1 JMS I (OCTLIO CDF CIF JMP I ABORT K200, USR, 200 CCHCK, 0 KRS /READ KEYBOARD BUFFER TAD M203 /CHECK FOR ^C SNA CLA KSF /CHECK IF KEYBOARD FLAG SET JMP I CCHCK /^C HAS NOT BEEN TYPED CDF CIF JMP I ABORT M1, -1 M203, -203 .5 2.1 999999 999999 999999 999999 999999 4.4 999999 999999 134.0 999999 999999 0310770908 999999 999999 999999 45.0 1.6 999999 999999 999999 999999 999999 3.1 999999 999999