/COS 300 PIP EDITED 10/15/73 / /COPYRIGHT 1972, 1973 /DIGITAL EQUIPMENT CORPORATION /MAYNARD, MASS. 01754 / /SGW / / /THIS SOFTWARE IS FURNISHED TO PURCHASER UNDER A LICENSE FOR USE /ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH INCLUSION /OF DEC'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT /AS MAY OTHERWISE BE PROVIDED IN WRITING BY DEC. / /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT /NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL /EQUIPMENT CORPORATION. / /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY /OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. / FIELD 0 /TO HELP POSSIBLE BIN LOADER /*** DEFINITIONS FROM EDP-8 MONITOR *** P7400= 2 XR10= 10 XR11= 11 XR12= 12 XR13= 13 INXR= XR13 XR14= 14 OUTXR= XR14 XR15= 15 XR16= 16 XR17= 17 P77= 20 CTCFG= 21 KMOVE= 23 KGETC= 24 KPUTC= 25 KRDOIO= 26 KCDOIO= 27 /KCDOIO MUST BE KRDOIO+1 TTYIN= 30 TTYOUT= 31 CDIN= 32 PPOUT= 33 PRIN= 34 LPOUT= 35 P7= 40 KPTRST= 43 LENGTH= 44 M1= 45 W0= 46 W1= 47 W2= 50 W3= 51 W4= 52 W5= 53 U0= 54 U1= 55 U2= 56 GET= 57 PUT= 60 TEMP= 61 COUNT= 62 NMBR= 63 P17= 64 P70= 65 M4= 66 HANDLR= 67 P7600= 70 PCDF= 71 KINIT= 72 KCTRLO= 73 KOTOPD= 74 KCLOSE= 75 KSPLIT= 76 SYSHND= 77 /*** DEFINITIONS IN MONITOR THAT MAY CHANGE *** CTCFIX= 5011 /WATCH THIS ONE ESPECIALLY PICHR= 5163 /ALSO THIS ONE PF0= 6200 DTA= 6610 RK8= 6410 CTBL= 6540 / RF0= 7640 IODIE= 7702 /WATCH THIS ONE ESPECIALLY PIPFX1= 7706 /...AND THESE PIPFX2= 7707 /... FLAGS= 7772 SYSDEV= 7774 BIGCDF= 7775 SWITCH= 7776 DATE= 7777 /*** PARAMETERS *** EDPSIZ= 140 /FIRST FREE BLOCK ON SYSTEM TAPE FOR FILE STORAGE WASTE= -1 /# OF AUXILLIARY WORDS IN DIRECTORY ENTRIES /CURRENTLY, OPTION E ASSUMES THIS IS -1. /IF YOUR CHANGE, THIS, CHANGE OPTION E! /NOW SOME MICROPROGRAMMED AC ZINGERS / AC7777= CLA CMA AC7776= CLA CMA CLL RAL AC7775= CLA CMA CLL RTL AC0001= CLA IAC AC0002= CLA CLL CML RTL AC2000= CLA CLL CML RTR AC4000= CLA CLL CML RAR MQL= 7421 DXAL= 6643 DIMA= 6616 DCLA= 6751 DLDC= 6732 *100 /AND NOW SOME JMS DEFINITIONS /TO MAKE THE LISTING UNINTELLIGABLE JSORTW= JMS I . SORTW JLGET= JMS I . LGET JLPRIN= JMS I . LPRIN JNMBR= JMS I . NUMBR JSCAN= JMS I . SCAN /AND NOW ALL THE GOODIES, VARIABLES, AND NOT-SO VARIABLES JLIST, 0 /SET UP BY "SORTW" TO WHATEVER THE MATCH SPECIFIES NAM1, 0 /SET UP BY CALLS TO "SCAN", AMONG OTHER THINGS NAM2, 0 NAM3, 0 NAMEXT, 0 /FOR USE BY DIRECTORY STUFF NUMBER, 0 /ALSO SET UP BY SCAN, MAYBE FCNT, -1 /(-) # OF FIELDS ABOVE 4K CCNT, 0 /# OF CHARS IN ANSWER INDEV, 0 /HANDLER ADDR, INPUT UNIT INUNIT, 0 /PHYSICAL UNIT # FOR INPUT OUTDEV, 0 /...SIMILAR FOR OUTPUT OUTUNT, 0 INCNT, 0 OUTCNT, 0 INCLAS, 0 /0 = RDOIO CLASS DEVICE, 1 = CDOIO CLASS OUTCLS, 0 INAC, 0 OUTAC, 0 INBLK, 0 /USED BY "E" COMMAND OUTBLK, 0 / " RECCNT, 0 / " MORESW, 0 KASKIN, ASKIN KASKOP, ASKOPT UNIT, 0 DAVICE, 0 DBLOCK, 0 FILSZ, 0 PDCNT, DIRECT PDORG, DIRECT+1 PDLINK, DIRECT+2 PDWSTE, DIRECT+4 EPTR, 0 ETMP, 0 REM, 0 TABSET, -10 OUDLEN, 0 IZERO, 0 FORMSW, 0 /SWITCH TO PRINT A FORMFEED OR NOT OUTDSG, 0 /USED BY "E" FNMBR, 0 KFRIOP, FRIEOP /POINTER TO WORD TO TURN OFF "/F" L7700, 7700 K777, 777 OLDDAT, 0 /HOLDS OLD PROGRAM DATE FOR ENTER OPTION, 0 /0031 IF /Y GIVEN FOR REPLACE *200 /START HERE... START, JMP I (INITCD /DO INITIALIZATION CODE IN BUFFER ASKOPT, DCA MORESW /0 JLPRIN OPTMES /"OPT-" JLGET AC0002 /"CCNT" IS (-) # OF CHARS -1... TAD CCNT /GET COUNT OF # OF CHARS IN ANSWER SZA CLA JMP ASKOPT /ONLY 1 CHAR. PERMITTED AC7777 JSORTW /SET UP WORD "JLIST" ACCORDING TO OPTION CHARACTER LINBUF-1 OPTLST-1 /LIST OF GOOD CHARACTERS JLIST1 /LIST OF PLACES TO GO JMP ASKOPT /NOT IN LIST TAD JLIST /PRESERVE THIS VALUE SPA /ONLY OPTION X IS NEG... JMP I P7600 /JUST FOR YOU, ERIC DCA RECIN TAD I (FLAGS SMA CLA /FGBG ACTIVE? JMP ASKIN /NOPE - ALL OPTIONS OK TAD RECIN CIA DCA LGET AC7777 JSORTW /SEE IF CHOSEN OPTION IS OK WITH FGBG LGET-1 JLIST1-1 JLIST8 HLT /NO WAY! ISZ JLIST JMP NO /ILLEGAL WITH FGBG ASKIN, JLPRIN INMES /"IN-" JLGET JMP I RECIN /DISPATCH ACCORDING TO OPTION CHARACTER / LGET, 0 JMS I KCDOIO INBUF-1 JMP I KASKOP /IF ^Z SEEN TAD (LINBUF-1 DCA XR12 AC7777 /START CCNT OFF AT -1 DCA CCNT DCA GRELC GGET, TAD (INBUF JMS I KGETC GRELC, 0 ISZ GRELC SNA JMP LGEXIT /END OF LINE SEEN TAD M1 SNA JMP GGET /SQUISH OUT SPACES TAD (-74 SNA JMP GGET /AND TABS TAD (75+237 DCA I XR12 AC7777 /BUMP CCNT DOWN BY 1 TAD CCNT DCA CCNT JMP GGET /ROUTINE TO READ A RECORD FROM SOMEPLACE, ANYPLACE RECIN, 0 TAD INAC DCA ACWRD TAD INCLAS /0 = RDOIO, 1 = CDOIO JMS RCCODE JMP I RECIN RECOUT, 0 TAD OUTAC DCA ACWRD TAD OUTCLS SZA CLA JMP CDOUT /SPECIAL CDOIO ON OUTPUT TO GIVE GOOD TABS JMS RCCODE RORET, JMP I RECOUT RCCODE, 0 TAD (JMS I KRDOIO DCA SUBCAL TAD ACWRD SPA /IF /F SPECIFIED, A NEG. WORD IS GIVEN JMP FRIDEN /GO DO THE THING FOR FRIDEN PAPER TAPE SUBCAL, HLT RECBUF-1 FRZ, JMP I (CFMORE FRCR, JMP I RCCODE ACWRD, 0 GETYES, 0 TAD M4 DCA LENGTH JMS I KCDOIO /CAN'T USE "LGET" HERE - ON REPLACE MESSAGE, DIRECTORY IS IN CORE MEOVLS-1 KNOP, NOP TAD KNOP DCA LENGTH /RESET LENGTH TO FULL 512-WORD RECORD TAD I (MEOVLS+1 AND L7700 TAD (-7200 JMP I GETYES FRIDEN, CLA CDF 10 DCA I (FRELC /SET REL CHAR 0 CDF 0 FCGET, JMS I PRIN /GET CHAR FROM RDR CIF CDF 10 JMP I (FDECOD /GO DECODE EBSILLYDIC, OR WHATEVER IT IS / PAGE IOGET, 0 JSCAN JMP I KASKIN /NO ANSWER SEEN TO "IN-" AC7776 /-2 JSORTW /SORT NAME GOTTEN AGAINST ALL LEGAL DEVICES NAM1-1 /NAME GOTTEN IS HERE ULIST-1 /LIST OF LEGAL DEVICES IS HERE JLIST2 /LIST OF HANDLER ADDRESSES FOR ALL DEVICES JMP I KASKIN /NAME OF DEVICE NOT FOUND TAD JLIST /GET MAXIMUM PHYSICAL UNIT # FOR DEVICE AND P7 /GET PHYSICAL UNIT # DCA INUNIT TAD JLIST AND TABSET /EXTRACT HANDLER ADDRESS DCA INDEV ASKOUT, JLPRIN OUTMES /"OUT-" JLGET JSCAN JMP ASKOUT /NO RESPONSE AC7776 JSORTW /NOW SORT SPECIFIED OUTPUT DEVICE NAM1-1 ULIST-1 /AGAINST LIST OF LEGAL DEVICE NAMES JLIST2 JMP ASKOUT /NOT THERE TAD JLIST AND P7 DCA OUTUNT /PHYSICAL OUTPUT UNIT TAD JLIST AND TABSET DCA OUTDEV /HANDLER ADDRESS FOR OUTPUT JMP I IOGET COPT, JMS IOGET /COME HERE FOR "C" (COPY) OPTION TAD OUTDEV CIA TAD INDEV /OUTDEV MUST BE SAME AS INDEV! SNA CLA /NO FAIR COPYING DT TO RK - DT TO DT, RK TO RK ONLY! JMP OKUNIT JLPRIN BADTYP /"COPY ONLY WORKS BETWEEN SIMILAR DEVICES" JMP I KASKOP OKUNIT, AC7777 JSORTW /NOW GET MAXIMUM SIZE OF DEVICE INDEV-1 DEVLST-1 JLIST3 C10, 10 /IMPOSSIBLE TO GET ERROR RETURN HERE TAD JLIST CMA /- # OF SEGS TO TRANSFER -1 DCA INCNT /STORE AS COUNTER FOR INPUT READS DCA INSEG /START AT SEG #0 TAD INCNT /...SET UP SAME FOR OUTPUT DCA OUTCNT DCA OUTSEG DCA REM DCA INAC DCA OUTAC JMS CLOOP JMP I KASKOP /SUPER IMAGE COPY /TO USE, FIRST SET UP: /FCNT = HIGHEST FIELD # /INUNIT = PHYSICAL DEV # FOR INPUT /INCNT = # OF SEGMENTS TO READ-1 /INAC = STARTING BLOCK WITHIN STARTING SEGMENT /INDEV = INPUT HANDLER ADDRESS /INSEG = STARTING SEGMENT TO READ /REM = # OF BLOCKS IN LAST (PARTIAL) SEGMENT - MAY BE 0 - IN BITS 1-4 /OUTUNT, OUTCNT, OUTAC, OUTDEV, OUTSET, SAME AS "IN" COUNTERPARTS. /*** N.B. OUTCNT OUGHT TO EQUAL INCNT!!! *** /ROUTINE USES ANY EXTRA CORE FIELDS FOR BUFFERS. /THIS IS NOT OF ANY PARTICULAR BENEFIT EXCEPT ON LINCTAPE AND RK8'S. CLOOP, 0 TAD REM /SHIFT THIS OVER SO IT'LL ADD RIGHT CLL RTR RTR RTR DCA REM DCA I KFRIOP /TURN OFF /F, SINCE THIS WILL DESTROY CODE CLPLUP, TAD FCNT /COUNT # OF AVAILABLE FIELDS DCA FNMBR TAD INUNIT TAD C10 /START FIELD 1 DCA INCTL IN, ISZ INCNT /ANOTHER SEG TO DO? JMP INDO /YUP TAD REM SNA /NO MORE FULL SGS - IS THE9E A PARTIAL? JMP DOWRI /NOPE TAD INCTL /YES - SET THAT # OF BLOCKS DCA INCTL INDO, TAD INAC /GET OFFSET IN SEGMENT (IF ANY) JMS I (R5R /PUT WHERE HANDLER WANTS IT JMS I INDEV INCTL, 0 CINBUF, 0 /= 0, ALWAYS ZERO=CINBUF INSEG, 0 TAD C10 TAD INCTL DCA INCTL /SET TO READ INTO NEXT HIGHER FIELD ISZ INSEG /BUMP SEG TO READ TAD INCNT /SEE IF ANY MORE LEFT SNA CLA JMP DOWRI /NOPE ISZ FNMBR /CAN WE READ INTO ANOTHER 3IELD? JMP IN /YES - DO SO DOWRI, TAD FCNT /SET UP FOR WRITE DCA FNMBR AC4000 /FOR WRITE TAD OUTUNT TAD C10 DCA OUTCTL OUT, ISZ OUTCNT /ANOTHER SEG TO DO? JMP OUTDO /YUP TAD REM /NO, IS THERE A PARTIAL SEG? SNA JMP I CLOOP /SURE HAVE IT TRANSFERRED! TAD OUTCTL DCA OUTCTL OUTDO, TAD OUTAC JMS I (R5R /SHIFT OVER FOR HANDLER JMS I OUTDEV OUTCTL, 0 COUTBF, 0 OUTSEG, 0 TAD C10 /BUMP TO NEXT FIELD TAD OUTCTL DCA OUTCTL ISZ OUTSEG /BUMP TO WRITE NEXT SEGMENT TAD OUTCNT /ANY MORE TO WRITE? SNA CLA JMP I CLOOP /BEE BE DEE DEE DE DEE, THAT'S ALL FOLKS! ISZ FNMBR /SHOULD WE WRITE ANOTHER FIELD? JMP OUT /YES JMS I (CTRLZC /LOOK FOR ^Z IN KEYBOARD BUFFER CZCNP, JMP I KASKOP /WE GOT ONE (THIS INSTRUCTION MAY CHANGE) JMP CLPLUP /NONE SEEN / PAGE DIN, 0 JSCAN JMP I KASKIN /NO ANSWER DCA INCLAS TAD NAM1 AND L7700 TAD (-5700 SZA CLA /CHECK FOR "/" OPTION JMP FINIT /NOPE AC7777 /WE GOT A NAME... JSORTW /CHECK TO SEE IF IT'S A DEVICE SWITCH NAM1-1 CIN-1 /LIST OF LEGAL CHARACTER INPUT SWITCHES JLIST4 /LIST OF "CDOIO" DEVICE NUMBERS CORRESPONDING JMP BADSW /NOT A DEVICE SWITCH AC0001 DCA INCLAS /INPUT IS FROM A "CDOIO" CLASS OF DEVICE TAD JLIST /GET INPUT DEVICE # DCA INAC JMP I DIN FINIT, JNMBR /GET DEFAULT LOGICAL UNIT # (IF ANY) TAD NUMBER DCA I IZERO DCA I KFRIOP /TURN OFF /F; THIS CODE DESTROYS THAT CODE JMS I (FIXUP AC0001 /INIT A FILE FOR INPUT JMS I KINIT INBLKS, 2010 /--- CHANGES IF 12K --- DINBUF, 0 /ALWAYS 0 NAM1-1 AC0001 DCA INAC JMP I DIN DOPT, DCA INCLAS /COME HERE FOR "D" (DATA) OPTION DCA OUTCLS ISZ MORESW JMS DIN JLPRIN OUTMES /"OUT-" JLGET JSCAN JMP I KASKIN /NO RESPONSE TO "OUT-" ISZ FORMSW /SET "PRINT FORMFEED IF LPT OUT" TAD NAM1 AND L7700 /CHECK FOR "/" TAD (-5700 SZA CLA JMP FINOUT AC7777 JSORTW /LOOK FOR OUTPUT CHARACTER-DEVICE SWITCH NAM1-1 COUT-1 /LIST OF OUTPUT CHAR. DEV. SWITCHES JLIST5 /LIST OF "CDOIO" DEVICE #S JMP BADSW /BAD SWITCH AC0001 DCA OUTCLS /OUTPUT DEVICE IS OF "CDOIO" CLASS TAD JLIST /GET OUTPUT DEVICE # DCA OUTAC JMP DDO FINOUT, JNMBR /GET DEFAULT LOGICAL UNIT # (IF ANY) TAD NUMBER DCA I IZERO /PLUNK IT IN FOR OUTPUT JMS I (FIXUP AC0002 /INIT IFN #2 FOR OUTPUT JMS I KINIT OUTBKS, 6010 /--- CHANGES IF 12K --- DOUTBF, 4000 /--- CHANGES IF 12K --- NAM1-1 AC0002 DCA OUTAC DDO, JMS RECIN JMS RECOUT JMS I (CTRLZC /LOOK FOR ^Z JMP CLOSD /^Z SEEN JMP DDO CFMORE, TAD OUTCLS SZA CLA /IF RDOIO, IGNORE THIS CHECK TAD OUTAC TAD (-5 /SEE IF LPT IS OUTPUT DEVICE SZA CLA JMP .+3 TAD (214 JMS I LPOUT /IF LPT OUT, EJECT AT END OF FILE TAD MORESW /SEE OF IT'S LEGAL TO COMBINE SNA CLA JMP CLOSD /NOPE - CLOSE OUTPUT JLPRIN MORMES /"MORE?" JMS GETYES /LOOK FOR A "Y" SZA CLA /Y? JMP CLOSD /NOPE, CLOSE OUTPUT TAD INCLAS SZA CLA JMP MORIN /IF CDOIO CLASS, DON'T TRY TO CLOSE IT! AC0001 JMS I KCLOSE /CLOSE INPUT FILE / MORIN, JLPRIN INMES /ASK FOR MORE INPUT JLGET JMS DIN JMP DDO BADSW, JLPRIN NSWITC /"ILLEGAL DEVICE SWITCH" JMP I KASKIN CLOSD, TAD OUTCLS SZA CLA JMP TRYINC AC0002 JMS I KCLOSE TRYINC, TAD INCLAS SZA CLA JMP I KASKOP AC0001 JMS I KCLOSE JMP I KASKOP / / PAGE FOPT, TAD (0406-0415 /COME HERE FOR "F" (FGBG FORM) OPTION MOPT, TAD (0415-0402 /COME HERE FOR "M" (MULTI-DIBOL) OPTION BOPT, TAD (0402-0123 /COME HERE FOR "B" (BINARY) OPTION SOPT, TAD (0123-2326 /COME HERE FOR "S" (SOURCE ASCII) OPTION VOPT, TAD (2326 /COME HERE FOR "V" (SV TRANSFER) OPTION DCA NAMEXT JMS NAMPIC /GET INPUT NAME JMP I KASKIN /IF PROBLEMS, GO HERE... JMP INSYS /OR HERE... JMP I KASKIN /OR HERE GOTIN, JMS NAMRES /RESTORE OLD NAME TAD JLIST AND P7 /GET GOODIES ABOUT DEVICE DCA UNIT /LIKE THE PHYSICAL DEVICE # TAD JLIST AND TABSET /AND THE HANDLER ADDR DCA DAVICE JMS I (LOOKUP NAM1-1 JMP NOTFND DCA INSEG /ACTUALY, A BLOCK # AT THIS POINT TAD UNIT DCA INUNIT TAD DAVICE DCA INDEV TAD FILSZ DCA TENTR BVOUT, JLPRIN OUTMES /ASK FOR OUTPUT JLGET JMS NAMPIC /NOW GET OUTPUT NAME JMP BVOUT JMP OUTSYS JMP BVOUT GOTOUT, JMS NAMRES TAD JLIST AND P7 DCA UNIT TAD JLIST AND TABSET DCA DAVICE TAD TENTR JMS I (ENTER DCA OUTSEG TAD UNIT DCA OUTUNT TAD DAVICE DCA OUTDEV TAD TENTR CLL RTR RTR DCA FILSZ TAD FILSZ AND K777 CMA /NEG -1 DCA INCNT /# OF SEGS TO READ -1 TAD INCNT DCA OUTCNT /# OF SEGS TO WRITE -1 TAD TENTR AND P17 DCA REM /LEFTOVER TAD INSEG DCA INAC TAD OUTSEG DCA OUTAC TAD INSEG CLL RTR RTR AND K777 DCA INSEG /STARTING SEG ON DEVICE TAD OUTSEG CLL RTR RTR AND K777 DCA OUTSEG JMS CLOOP /CLOOP, CLOOP, CLOOP! JMP I KASKOP /DUN NAMPIC, 0 /PICK UP A NAME JSCAN JMP I NAMPIC /NO ANSWER TAD NAM1 AND L7700 TAD (-5700 SNA CLA /NAME CAN'T BEGIN WITH SLASH! JMP I NAMPIC /IF SO, PRETEND IT WASN'T THERE ISZ NAMPIC /NOW BUMP TO 2ND RETURN JMS NAMSAV TAD CCNT SNA CLA /ANYTHING AFTER THE NAME? JMP I NAMPIC /NOPE - SO ASSUME SYSTEM DEVICE JSCAN /GET WHATEVER IT WAS JMP I NAMPIC /APPENTLY JUST A COMMA - ASSUME SYS ISZ NAMPIC AC7776 JSORTW /SEE WHAT DEVICE NAM1-1 ULIST-1 JLIST2 JMP I NAMPIC /NOTHING WE KNOW ABOUT ISZ NAMPIC JMP I NAMPIC TENTR, 0 OUTSYS, TAD I (PF0 DCA JLIST JMP GOTOUT INSYS, TAD I (PF0 DCA JLIST JMP GOTIN NOTFND, JLPRIN NOTHER /"FILE NOT FOUND" JMP I KASKOP / PAGE EOPT, JMS I (IOGET /GET INPUT, OUTPUT DEVICES XSQUIS, TAD INUNIT /...AND S Q I S H THE BEJEEBERS OUT OF THE INPUT TAD E200 DCA I (INDCTL ASKSKP, JLPRIN SKPMSG /"TYPES OF FILES TO BE SKIPPED: (S,B,V,F,M)" JLGET TAD M4 DCA TCRLF TAD (SKPLST-1 DCA XR15 SCNLUP, JSCAN JMP DOEOPT AC7777 JSORTW NAM1-1 FILTYP-1 JLIST7 JMP ASKSKP /IF NOT IN LIST TAD JLIST /GET EXTENSION TO SKIP DCA I XR15 /SAVE IN LIST TO LOOK AT LATER ISZ TCRLF /GOTTEN FOUR? JMP SCNLUP /NOT YET...TRYING FOR 5 IS RIDICULOUS DOEOPT, TAD OUTUNT TAD OUTDEV CIA TAD SYSHND SZA CLA JMP LENGET TAD I (FLAGS SPA CLA JMP NO /IF FGBG, NO SQUISH DE SYS! TAD I (PF0+2 CIA JMP ROTSIZ LENGET, AC7777 JSORTW /FIND LENGTH OF OUTPUT DEVICE OUTDEV-1 DEVLST-1 JLIST3 /LIST OF SIZES E200, 200 /NO WAY TO GET ERROR RET. TAD JLIST /GET LENGTH, IN SEGMENTS ROTSIZ, CLL RTL /CONVERT TO BLOCK # RTL CIA DCA OUDLEN TAD (SKP DCA I (CTCFIX /DISABLE ^C DCA I (CZCNP /TURN OFF ^Z IN CLOOP TAD INUNIT TAD INDEV CIA TAD OUTDEV TAD OUTUNT SNA CLA /CHECK IF SQUISHING ONTO YOURSELF AC0001 DCA MORESW /SET FLAG IF YES JMS I (XCHK /SEE IF BIN SCRATCH AREA IS TO BE EXPANDED AC7777 DCA I (SQBUF2 /MAKE DUMMY INPUT SEG EMPTY AC0001 DCA I (SQBUF2+2 /SET UP DUMMY INPUT SEGMENT DCA OUTDSG JMP I (NEWOUT TCRLF, 0 TAD (215 JMS I TTYOUT TAD (212 JMS I TTYOUT JMP I TCRLF FIXUP, 0 /REPLACES "00" CHARS IN NAME WITH "01" TAD (NAM1 /SO CDOIO WILL NOT GET PREMATURE END-OF-MESSAGE DCA GET AC7775 DCA COUNT FIXLUP, TAD I GET AND L7700 SZA TAD (4000 TAD (100 DCA TEMP TAD I GET AND P77 SZA TAD L40 IAC AND P77 TAD TEMP DCA I GET ISZ GET ISZ COUNT JMP FIXLUP JMP I FIXUP R5R, 0 AND P17 CLL RTR RTR RAR JMP I R5R NO, AC0001 JMS I KCDOIO NOMES-1 L40, 40 JMP I KASKOP NOMES, -7 /NOT WITH FGBG 5760 6501 7052 6551 0147 5043 5002 / PAGE /NOTE WELL: THE STUFF IN HERE TO SELECTIVELY MOVE FILES /ASSUMES WASTE = -1, SO WATCH IT IF YOU CHANGE WASTE. / NEWIN, JMS RDDBLK /READ DIRECTORY BLOCK DCA INBLK TAD (SQBUF2+4 DCA INXR SGETIN, TAD I INXR SNA JMP SEMPTY /GOT AN EMPTY ENTRY! S L O W L Y SQUEEZE IT TO DEATH DCA I OUTXR /GOT A GOOD ENTRY, MOVE OUT NEW OUTPUT DIRECTORY TAD OUTXR DCA OUSAVE TAD M4 /THIS IS OFFICIALLY THE CODE BELOW... / TAD (WASTE-3 /"WASTE" = # OF WASTE WORDS - USUALLY -1 FOR EDP-8 DCA TEMP NAMELP, TAD INXR DCA RECCNT /THIS IS THE ADDR.-1 OF LAST THING MOVED TAD I INXR DCA I OUTXR ISZ TEMP JMP NAMELP TAD I (SQBUF2+4 CMA /THIS IS OFFICIALLY THE TWO LINES BELOW... / CIA / TAD (WASTE TAD INXR DCA INXR TAD (SKPLST-1 /PREPARE TO LOOK AT EXTENSIONS DCA XR15 SKPLUP, TAD I XR15 SNA JMP ENDSKP /WE'VE CHECKED ALL EXTENSIONS TO IGNORE TAD I RECCNT /GET EXT. OF CURRENT NAME SZA CLA JMP SKPLUP /KEEP GOING AC7777 /THIS ONE IS TO BE IGNORED TAD OUSAVE /BACK UP THE OUTPUT POINTER DCA OUTXR JMP SEMPTY /AND MAKE LIKE IT WAS A DELETED "HOLE" ENDSKP, TAD I INXR /CHECK FOR TEMPORARY FILE SNA /(NEVER HAPPEN IN EDP-8, BUT GUY MIGHT JMP SNULL /TRY TO SQUISH PS/8 TAPE THAT HAD ONE) DCA RECCNT /THIS IS - THE LENGTH OF FILE TAD RECCNT CLL CIA TAD OUTBLK TAD OUDLEN SZL CLA /WILL IT OVERFLOW OUTPUT DEVICE? JMP SNULER /IT CERTAINLY WILL TAD RECCNT DCA I OUTXR AC7777 TAD I (SQBUF1 /BUMP COUNT OF FILE OUTPUTTED DCA I (SQBUF1 TAD INBLK CIA TAD OUTBLK SNA CLA /IS FILE IN SAME PLACE AFTER SQUISH, TAD MORESW /ON SAME DEVICE? SNA CLA /IF SO, DON'T MOVE IT ONE DAM' INCH! MOVFIL, JMS I (SQTRA /...ON THE OTHER HAND...DO THE MOVE TAD RECCNT /BUMP OUTPUT BLOCK POINTER CIA TAD OUTBLK DCA OUTBLK TAD RECCNT DMTX, CIA /NOW BUMP INPUT BLOCK POINTER TAD INBLK DCA INBLK TAD OUTXR CIA TAD (WASTE+WASTE TAD (SQBUF1+365 SMA CLA /DO WE HAVE ROOM FOR TWOMORE ENTRIES? JMP NEXTIN /DIRECTORY SEGMENT OVERFLOW ON OUTPUT ISZ OUTDSG TAD OUTDSG IAC DCA I (SQBUF1+2 /STORE LINK TO NEXT SEGMENT TAD I (SQBUF1+2 TAD (-7 SMA CLA JMP I (SQIDX /TOO MANY SEGMENTS JMS I (OUTDIR /OUTPUT THIS SEGMENT NEWOUT, TAD (SQBUF1-1 DCA OUTXR /INIT FOR NEXT OUTPUT SEG DCA I OUTXR TAD OUTBLK DCA I OUTXR DCA I OUTXR DCA I OUTXR AC7777 /THIS IS OFFICIALLY THE CODE BELOW... IFNZRO WASTE+1 / TAD (WASTE DCA I OUTXR NEXTIN, ISZ I (SQBUF2 JMP SGETIN TAD I (SQBUF2+2 SNA /ANY MORE INPUT SEGS? JMP I (SQOVER /NO! JMP NEWIN SNULER, AC0001 JMS I KCDOIO NOROOM-1 /"NO ROOM - CONTINUING" NOP SNULL, AC7777 TAD OUSAVE DCA OUTXR JMP NEXTIN SEMPTY, TAD I INXR JMP DMTX OUSAVE, 0 RDDBLK, 0 /ENTER WITH BLK # IN AC JMS I KSPLIT JMS I INDEV INDCTL, 0 SQBUF2 /READ A HUNK OF INPUT DIRECTORY 0 TAD I (SQBUF2+1 JMP I RDDBLK / PAGE SQOVER, DCA I OUTXR TAD OUDLEN TAD OUTBLK SNA JMP CKZERO DCA I OUTXR AC7777 TAD I (SQBUF1 DCA I (SQBUF1 CKZERO, TAD I (SQBUF1 SZA CLA JMP ZEROK AC4000 JMS OUTDIR /READ IN LAST SEG DCA I (SQBUF1+2 /ZERO OUT LINK WORD SKP ZEROK, ISZ OUTDSG JMS OUTDIR /WRITE IT BACK OUT JMP I P7600 /HAVE TO REBOOT, SINCE "E" DESTROYS PART OF MONITOR SQIDX, DCA I (SQBUF1+2 SQIDER, JMS OUTDIR KAC1, AC0001 KJMS, JMS I KCDOIO OUTOVR-1 /"OUTPUT DIRECTORY OVERFLOW" NOP JMP I P7600 OUTDIR, 0 TAD OUTUNT TAD (4200 DCA OUDCTL TAD OUTDSG JMS I KSPLIT JMS I OUTDEV OUDCTL, 0 SQBUF1 0 JMP I OUTDIR SQIOER, AC0001 JMS I KCDOIO IOMSG-1 /"I/O ERROR - CONTINUING" JMP I SQTRA /FORGET ABOUT THIS TRANSFER SQTRA, 0 /SET UP CLOOP TAD RECCNT CIA CLL RTR RTR AND K777 CMA DCA INCNT /# OF SEGS-1 TAD INCNT DCA OUTCNT TAD RECCNT CIA AND P17 DCA REM /LEFTOVER BLOCKS TAD INBLK CLL RTR RTR AND K777 DCA INSEG TAD INBLK DCA INAC TAD OUTBLK CLL RTR RTR AND K777 DCA OUTSEG TAD OUTBLK DCA OUTAC TAD (SQIOER /SET "FATAL I/O ERROR " TO GO TO SPECIAL ROUTINE DCA I (PIPFX2 TAD (PIPFX2&177+5600/"JMP I PIPFX2" IN DISGUISE DCA I (PIPFX1 JMS I (CLOOP /DO THE TRANSFER ZEROKS, TAD KAC1 /PATCH BACK "FATAL I/O ERROR" ROUTINE DCA I (PIPFX1 TAD KJMS DCA I (PIPFX2 JMP I SQTRA XCHK, 0 /LOOK FOR NUMERICAL SWITCH OPTION 0-9 TAD I (SWITCH /AND IF FOUND, EXPAND BINARY SCRATCH AREA TAD (-7200 /BY (20*N + EDPSIZ), OCTAL CLL TAD (1200 SNL JMP NONMOP /NON-NUMERICAL SWITCH CLL RTR /THIS GIVES (#*20) TAD (EDPSIZ /ADD IN MINIMUM DCA OUTBLK /TENATIVE TRY - CHECK FOR SPECIAL CASES TAD MORESW SZA CLA /CHECK FOR SQUISHING ONTO YOURSELF JMP MINMIZ /IN WHICH CASE, OUTSIZ MUST BE <= INSIZ MAXMIZ, TAD OUTBLK TAD (-EDPSIZ /MAKE SURE IT'S >= 140 IN ANY CASE SPA CLA TAD (EDPSIZ SZA DCA OUTBLK JMP I XCHK NONMOP, AC4000 /SET OUTBLK BIG DCA OUTBLK /FOR EVENTUAL MINIMIZATION MINMIZ, AC0001 JMS I (RDDBLK /READ DIRECTORY BLOCK 1 CIA /RETURN WITH BLK # IN AC TAD OUTBLK SMA CLA TAD I (SQBUF2+1 /MINIMIZE OUTBLK & INBLK SZA DCA OUTBLK JMP MAXMIZ /NOW CHECK FOR >= 140 / PAGE /JMS SCAN / SCAN, 0 TAD CCNT SNA CLA JMP I SCAN /NO ANSWER DCA NAM1 DCA NAM2 DCA NAM3 TAD (NAM1 DCA NUMBR AC7775 DCA NUMCHK AC7777 DCA PASSSW GETTWO, JMS GETC JMP I SCAN ISZ PASSSW SKP ISZ SCAN /POINT TO GOOD EXIT, NOW THAT WE HAVE AT LEAST ONE CHAR. JMS R6L DCA I NUMBR JMS GETC JMP I SCAN TAD I NUMBR DCA I NUMBR ISZ NUMBR /POINT TO NEXT ISZ NUMCHK /DONE 6 CHARS? JMP GETTWO /NOPE JMS GETC /SCAN TO DELIMITER OR END-OF-LINE JMP I SCAN CLA JMP .-3 NUMBR, 0 DCA NUMBER NLOOP, JMS NUMCHK SNL JMP NEXIT DCA TEMP TAD NUMBER CLL RTL TAD NUMBER RAL SZL JMP BADNUM TAD TEMP SZL JMP BADNUM DCA NUMBER JMP NLOOP NEXIT, CLA JMP I NUMBR GETC, 0 ISZ CCNT SKP JMP BACK1 /RESET "END-OF-LINE" CONDITION TAD I XR12 AND P77 TAD (-54 SNA JMP I GETC /TERMINATE ON COMMA TAD (54-57 SNA JMP GOTSL RESSL, TAD (57 ISZ GETC JMP I GETC GOTSL, TAD NAM1 SNA CLA JMP RESSL /WE'RE ON THE FIRST CHAR ISZ CCNT SKP JMS BACK1 TAD I XR12 AND P77 DCA OPTION AC7777 TAD XR12 DCA XR12 BACK1, AC7777 TAD CCNT DCA CCNT JMP I GETC /TERMINATE IF SLASH NOT FIRST CHAR SEEN NUMCHK, 0 JMS GETC CLA /TEST WILL FAIL NOW TAD (-72 CLL TAD (12 JMP I NUMCHK R6L, 0 CLL RTL RTL RTL JMP I R6L /THRILLING BADNUM, JLPRIN NUMBAD /"NUMBER TOO LARGE" JMP I KASKOP PASSSW, 0 CTRLZC, 0 /LOOKS FOR ^Z IN KEYBOARD BUFFER TAD (200 KRS TAD (-232 SZA CLA ISZ CTRLZC JMP I CTRLZC SKPLST, 0;0;0;0;0 /0 AT END OF LIST / PAGE /ROUTINE TO MATCH TWO LISTS OF WORDS AND SELECT AN OPTION WORD FROM /A THIRD LIST. /CALL: /TAD (# OF WORDS IN STRING TO MATCH, NEGATIVE) /JSORTW /POINTER-1 TO STRING OF WORDS TO MATCH /POINTER-1 TO LIST OF GOOD STRINGS, ENDING WITH 0 /POINTER TO LIST OF OPTION WORDS / /