/SQUASH DECSYSTEM-8 DEVICES /THIS PROGRAM IS FOR THE IMPLEMENTATION OF THE MONITOR /LEVEL COMMAND ".SQ". THIS IS AN IMPROVED VERSION OF /THE OLD PIP "/S" (SQUISH) OPTION, IN THAT THERE IS A /LITTLE MORE FILE INTEGRETY MAINTAINED AND THERE ARE /MORE REASONABLE OPTIONS AVAILABLE. THIS PROGRAM HAS /TWO MODES OF TRANSFER, NORMAL, AND ONE WHICH MAINTAINS /FILE INTEGRETY. THAT IS, WHEN MAINTAINING FILE INTEGRETY, /WHENEVER A FILE WILL OVERLAP ITSELF DURRING A SQUASH IT IS /FIRST COPYED TO ANOTHER EMPTY SPACE ON THE DEVICE, AND THEN /IF THERE ARE NO ERRORS, SQUASHING CONTINUES AS NORMAL. /THE SEQURE MODE OF TRANSFER IS THE DEFAULT MODE FOR DISKS /ONLY, HOWEVER, IT MAY BE SELECTED BY AN OPTION /FOR NON-DISK DEVICES. WHENEVER THERE IS AN INTEGRETY /CONFLICT THAT CANNOT BE RESOLVED THE OPERATOR IS NOTIFIED /SO THAT HE MAY QUIT OR CONTINUE DANGEROUSLY. /ALSO THE OPERATOR MAY SELECT TO SQUASH ONLY UNTIL A /SPECIFIED NUMBER OF CONTIGUOUS FREE BLOCKS ARE AVAILABLE. /(ONLY FOR SELF SQUASHES.) /A ^C AT THE CONSOL WILL TERMINATE THE SQUASH AFTER THE /CURRENT FILE BEING TRANSFERRED IS COMPLETE. THE FILES /WHICH HAVE NOT BEEN TRANSFERRED (IN THE CASE OF SQUASHES /TO ITSELF) WILL REMAIN IN THE DIRECTORY. I.E. FILES /WILL NOT BE LOST. /SYNTAX: / .SQ ODEV:[_IDEV:][ USING TDEV:][UNTIL XXXX][ SAVE N][ WAIT] /USING - USES INTERMEDIATE SCRATCH TAPE /UNTIL - STOPS ON SELF SQ WHEN THAT MANY FREE BLOCKS /SAVE N - SAVES N WASTE WORDS 0<=N<=9 /WAIT - WAITS FOR USER TO MOUNT BEFORE STARTING /LOADING INFORMATION / .CO SQUASH/L / *(89)=3000$ / .SA SYS SQUASH /CONDITIONAL ASSEMBLIES: /THERE ARE SEVERAL LEVELS OF FILE INTEGRITY AVAILABLE /WITH CONDITIONAL ASSEMBLIES. THE DEFAULT CONDITIONS ARE /TO MAINTAIN FILE INTEGRITY ON DF32'S, RF08'S, AND RK-8'S. /FOR SEQURE TRANSFERS ON ALL DEVICES DEFINE VERYSAFE=1 IFNDEF VERYSAFE /FOR NO SECURITY AT ALL DEFINE SQSAFELY=0 IFNZRO VERYSAFE IFNDEF SQSAFELY /WHEN A NON-ZEROABLE DEVICE IS "USED" FOR A SELF SQUASH /THEN THE BIGGEST EMPTY SPACE IS USED. THIS OF COURSE /PRECLUDES THE POSSIBILITY OF FILE INTEGRITY. THUS IF /ONE WANTS TO EXCLUDE THIS MODE SYSOK MUST BE DEFINED ZERO. IFNDEF SYSOK /CORE LAYOUT /0000-0200 /PAGE ZERO /2000-2400 /IN DIR SEGMENT /2400-3000 /IN HANDLER /2600-3000 /HD CODING (OUSEG NOT USED) /3000-6577 /SQUASH CODING /6600-7200 /OUT DIR SEGMENT /7200-7600 /OUT HANDLER /FIELD 1 IS USED FOR THE BUFFER. INSIZE=17 /#BLOCKS/TRANSFER INCTL=3610 /HANDLER CONTROL WORD INSEG=2000 OUSEG=6600 /DEFINES DEPENDENT ON THE MONITOR GNAME= 25 LXR= 13 NM1= 34 NM2=NM1+1;NM3=NM2+1;NM4=NM3+1 SYSTEM= 22 TEMP1= 40 TEMP2= 21 TM1= 41 TMP1= 42 /SOME PAGE ZERO REFERENCES *52 INHAND=.;*.+1 OUHAND=.;*.+1 LSHAND=.;*.+1 /THESE ARE USED BY NXTFIL EMPTY=. ;*.+1 /-#EMPTIES FILST=. ;*.+1 /BLK # WHERE WERE WE ARE (STRT OF FILE) FILPNT=.;*.+1 /POINTS TO CURRENT FILENAME FILLEN=.;*.+1 /-LENGTH OF FILE SELF=. ;*.+1 /=0 IF IDEV: NOT = ODEV: OUSEGP=.;*.+1 /OUT SEG POINTER SECURE=.;*.+1 /NON 0 FOR SEQURE SQUASH FUNHND=.;*.+1 /=OUHAND EXCEPT FOR SPECIAL USING MODE ENTCNT=.;*.+1 OFREE=. ;*.+1 OWASTE=.;*.+1 OSTART=.;*.+1 INTSTR=.;*.+1 INTLEN=.;*.+1 USHAND=.;*.+1 FILCNT=.;*.+1 USOSTR=.;*.+1 USOLEN=.;*.+1 USISTR=.;*.+1 USILEN=.;*.+1 SQUHND=.;*.+1 /ENDS UP IN FUNHND CHKSTR=.;*.+1 /START OF NEXT FILE LSTDEV. /USED BY HSTD TFREE=. ;*.+1 /TOTAL FREE BLOCKS LARGST=.;*.+1 /LARGEST FREE BLOCK SEG. FRAGME=.;*.+1 /# SEG. FREE BLOCKS HSTBEG=.;*.+1 /BEG OF DEVICE SEGCNT=.;*.+1 /-#ENTRYS LEFT THIS SEGMENT SEGPNT=.;*.+1 /POINTER WITHIN SEGMENT SEGST=. ;*.+1 /START OF NEXT ENTRY FILWAS=.;*.+1 /+#WASTE WORDS PAGE *3000 SQUASH, CLA CLL /ALLOW A RUN?? TAD NM1 /REMEMBER IF HD OR SQ DCA SQUASH JMS I GNAME /DECODE FIRST NAME JMP SQSYS /SQ SYS TO SELF JMS I (SAVNAM NOUT JMS GDEVN /GET A DEVICE NUMBER DECL3, DCA OUTDEV /SAVE TAD OUTDEV /START BY SETTING DCA LSTDEV /LAST DEV=ODEV TAD OUTDEV DCA INDEV /AND INDEV=ODEV JMS I (SPNOR /IGNORE ":" AND SPACES; GET NEXT TAD (-"_ /ALLOW "_" SNA JMP DECL1 /O.K. TAD ("_-"< /AND "<" SZA /SKP IF YES JMP DECL2-2 /OUTDEV=INDEV DECL1, JMS I GNAME /GET NEXT NAME JMP I (SYNTAX /WHAT?? _ TERM JMS GDEVN /GET A DEVICE HANDLER DCA INDEV /FOR IN DEVICE JMS I (SAVNAM NIN DECL2, JMS I (SPNOR /NEXT NON-SPACE NON ":" JMS BMPLXR /BACK UP LXR JMS I GNAME /GET NEXT ARG JMP I (SYNTAX /BAD CHARACTER TAD NM1 /CHECK FOR USING TAD (-2523 /-"US"ING SNA /SKIP IF NO USING JMP USING /GO CHECK MORE TAD (2523-2301 /-"SA"VE SNA JMP SAVER /SAVE SOME WASTE WORDS TAD (2301-2701 /"WA"IT SNA JMP WAITR TAD (2701-2516 /-"UN"TILL SZA CLA /SKIP IF UNTILL JMP I (SYNTAX /THAT'S ALL THAT'S ALLOWED DCA FREEBL /CLEAR FOR DEC TO BIN CONV. JMS I (SPNOR /WILL GET FIRST CHAR SKP UNTIL1, TAD I LXR /NEXT CHAR TAD (-272 /FOR RANGE CHECK SMA /BETTER BE NEG. JMP DECL2 /MAY STILL BE "USING" TAD (272-260 /KEEP CHECKING FOR RANGE SPA /BETTER BE POSITIVE JMP DECL2 /MUST BE DONE DCA TEMP1 /STASH FOR NOW TAD FREEBL /NOW TO MULT BY 10 CLL RAL DCA FREEBL /*2 TAD FREEBL CLL RTL /*8 TAD FREEBL /*8+*2=*10 TAD TEMP1 DCA FREEBL JMP UNTIL1 /LOOP FOR SIZE USING, JMS I GNAME JMP I (SYNTAX /HAS TO BE ONE JMS I (SAVNAM NUSING JMS GDEVN /FETCH DEV NUMBER DCA OUTDEV /IS INTERMEDIATE DEVICE TAD INDEV /INDEV BETTER=LSTDEV CIA TAD LSTDEV SNA CLA /SKIP IF NOT JMP DECL2 /MIGHT HAVE "UNTIL" OPTION JMP I (SYNTAX /BAD SYNTAX SAVER, JMS I (SPNOR /TO NON-SPACE TAD (-272 /TEST FOR NEUMERIC SMA /SKIP IF NOT ALPHA JMP I (SYNTAX TAD (272-260 /CHECK REST OF WAY SPA /SKIP IF OK JMP I (SYNTAX DCA SAVE /SET WASTE WORDS ISZ LXR /PAST CHAR JMP DECL2 /CONTINUE SAVE, -1 WAITR, STA DCA WAIT JMP DECL2 WAIT, 0 /BACK UP LXR BY ONE BMPLXR, 0 STA TAD LXR DCA LXR JMP I BMPLXR /SUBROUTINE TO GET A DEVICE HANDLER GDEVN, 0 DCA DEVCE+2 /STASH HANDLER ADDRESS TAD NM1 DCA DEVCE /STASH 2 CHARS NAME TAD NM2 DCA DEVCE+1 /AND SECOND TWO CIF 10 JMS I SYSTEM 12 /INQUIRE DEVCE, 0;0 /DEVICE NAME 0 /ADDRESS JMP NODEV /NO DEVICE TAD DEVCE+1 /HANDLER ADDRESS JMP I GDEVN INDEV, 0 /FIRST IN DEVICE OUTDEV, 0 /POSSIBLE USING DEVICE LSTDEV, 0 /FINAL OUTPUT DEVICE FREEBL, -1 /REQUESTED NUMBER OF FREE BLOCKS PAGE /DECODING OF COMMAND LINE DONE. /NO LONGER ANY NEED TO PROTECT MONITOR DECDON, CIF 10 /LETS LOAD UP SOME HANDLERS TAD I (OUTDEVN /THE OUTHAND JMS I SYSTEM 1 7201 /2-PAGE ALLOWED JMP I (ERRHND /HANDLER ERROR TAD .-2 /ENTRY DCA OUHAND /SAVE ENTRY TAD I (INDEV /NOW FOR INDEV CIF 10 JMS I SYSTEM /LOAD IT 1 2401 /ALLOW TWO PAGERS JMP I (ERRHND /HANDLER ERROR TAD .-2 /ENTRY DCA INHAND /STASH ENTRY POINT TAD I (LSTDEV /LAST DEV MUST BE LOADED CIF 10 /SO JUST FIGURE OUT WHICH ONE JMS I SYSTEM 12 /INQUIRE 0 /WON'T LOAD JMP I (SYNTAX /SYNTAX ERROR TAD .-2 DCA LSHAND /STASH ENTRY. TAD I (INDEV /CHECK ALL THE DEVICES FOR JMS GETDCB /FILE STRUCTURED. NOP TAD I (OUTDEV JMS GETDCB NOP TAD I (SQUASH /SEE IF "HD" COMMAND TAD (-1004 /-"HD SNA CLA /SKIP IF "SQ" COMMAND JMP I (HD /IS "HOW'S THE DEVICE" JMS I (WAITER /WAIT IF REQUESTED TAD I (INDEV /IF INDEV AND LSTDEV CIA /ARE NOT THE SAME THEN TAD I (LSTDEV /IT IS A NORMAL SQUISH. SZA CLA /SKIP IF NOT JMP I (NORMAL /IS FROM ONE TO ANOTHER. TAD I (OUTDEV /IF OUTDEV AND INDEV CIA /ARE THE SAME THEN TAD I (INDEV /A SELF SQUASH WITH NO INTERMEDIATE SNA CLA /DEVICE. JMP I (SQSELF /YEP; IT IS. DCA SECURE TAD OUHAND /IF "SYS" USE LARGEST TAD (-7607 /EMPTY NO-MATTER-WHAT SZA CLA /SKIP IF SYS JMP I (SQUSING /IS SELF SQUASH USING ANOTHER DEVICE. JMP I (FUNNY /USE BIGGEST EMPTY /GET BLOCK 6 INTO INSEG AND CHECK /BLOCK 6 FOR A VALID PARAMETER BLOCK. /ENTER WITH HANDLER ADDRESS IN AC. /CALL: TAD (HANDADD / JMS GETPAR / RET1 /NO PARAMETER BLOCK / RET2 /PARAMETER BLOCK GETPAR, 0 DCA TEMP2 /STASH FOR ENTER JMS I (CNTCFIX JMS I TEMP2 /READ THE DIRECTORY 0200 /INTO INSEG INSEG 0006 JMP I (SERRHND /HANDLER ERROR TAD I (INSEG /CHECK BLK 6 FOR VALIDITY TAD (-0427 /"DW" SZA CLA JMP I GETPAR /TAKE FIRST EXIT TAD I (INSEG+1 /AND NEXT WORD TAD (-1203 /"JC" SZA CLA JMP I GETPAR /NO PARAM BLOCK ISZ I (INSEG+2 /SHOULD SKIP JMP I GETPAR ISZ GETPAR /HAS PARAM BLOCK JMP I GETPAR /TAKE SECOND RETURN /PICK UP DCB WORD; RETURN ACCORDING TO /DISK OR NOT. /CALL: JMS GETDCB / RET1 /IS DSK / RET2 /IS OTHER DCB=7760 GETDCB, 0 TAD (DCB-1 /CALC ADDRESS DCA TEMP1 CDF 10 TAD I TEMP1 /PICK UP DCB WORD CDF 0 SMA /SKP IF FILE STRUCTURED JMP I (ERNFS /NOT FILE STRUCTURED DEVICE AND (770 /MASK FOR TYPE TAD (-160 /MUST BE BELOW HERE FOR DSK SMA CLA /SKIP IF SOME KIND OF DISK ISZ GETDCB /TAKE SECOND RETURN = TAPE JMP I GETDCB /SUBROUTINE TO IGNORE SPACES AND ":" SPNOR, 0 JMS I (BMPLXR TAD I LXR SNA JMP DECDONE /END OF LINE TAD (-": /CHECK FOR ":" SNA JMP .-5 TAD (-240+": SNA JMP .-3 TAD (240 /GET CHAR BACK JMP I SPNOR PAGE /SUBROUTINE TO GET NEXT FILE ENTRY FROM IN DIRECTORY. /TO INITIALIZE SEGCNT=-1;SEG01=0202. /RETURNS THE FOLLOWING PAGE-ZEROS / EMPTY =PRECEEDING EMPTY-1 / FILST =BLK START OF NEXT FILE / FILPNT =POINTER TO FILENAME NEXT FILE / FILLEN =-LENGTH NEXT FILE /CALL: JMS I (NXTFIL / RET1 /DONE WITH FILES / RET2 /PAGE ZERO'S SET NXTFIL, 0 STA /INIT FOR NO EMPTY DCA EMPTY ISZ SEGCNT /SKP IF DONE THIS SEGMENT JMP NXTFL1 /NO: GET NEXT TAD I (INSEG+2 /LINK TO NEXT SEG SNA /SKIP IF ANOTHER JMP I NXTFIL /NO: TAKE DONE RETURN DCA NXTFL0 /FOR READ JMS I (CNTCFIX JMS I INHAND /READ IN NEXT 0200 /ONE BLOCK INSEG /IN THERE NXTFL0, 0000 /THE SEGMENT BLOCK # JMS FATERR /DIRECTORY ERROR TAD I (INSEG /GET NUMBER OF ENTRIES DCA SEGCNT /SET COUNTER TAD I (INSEG+1 /START OF FILES DCA SEGST /INIT START OF FILE TAD (INSEG+5 /START OF FILE NAMES DCA SEGPNT /MAKE SEG POINTER TAD I (INSEG+4 /-WASTE WORDS CIA /#WASTE DCA FILWAST /SET WASTE CONSTANT NXTFL1, TAD I SEGPNT /PICK UP NM1 SZA CLA /SKIP IF AN EMPTY JMP NXTFL2 /NO: IS FILE ISZ SEGPNT /AN EMPTY; POINT TO -LENGTH TAD I SEGPNT /PICK IT UP TAD EMPTY /TO RETURN EMPTY-1 DCA EMPTY /AND SET EMPTY TAD I SEGPNT /NOW UPDATE START OF FILE CIA TAD SEGST /BY ADDING EMPTY DCA SEGST /BLOCKS ISZ SEGPNT /POINT TO NEXT ENTRY JMP NXTFIL+3 /KEEP LOOKING NXTFL2, TAD SEGPNT /GOT A FILE DCA FILPNT /STASH POINTER TO ENTRY TAD I SEGPNT DCA NM1 ISZ SEGPNT TAD I SEGPNT DCA NM2 ISZ SEGPNT TAD I SEGPNT DCA NM3 ISZ SEGPNT TAD I SEGPNT DCA NM4 ISZ SEGPNT TAD FILWAS /+WASTE WORDS TAD SEGPNT /TO -LENGTH DCA SEGPNT TAD I SEGPNT /PICK UP -LENGTH DCA FILLEN /STASH -LENGTH OF FILE TAD SEGST /AND SET START OF FILE DCA FILST TAD FILLEN /UPDATE SEGST FOR NEXT TIME CIA /BY ADDING LENGTH OF THIS FILE TAD SEGST DCA SEGST /UPDATED. ISZ SEGPNT /POINT TO NEXT FILE TAD FILLEN /UNLESS IS TENATIVE SNA CLA /SKIP IF NOT TENATIVE FILE JMP NXTFIL+3 /IS TENATIVE=GET NEXT ISZ NXTFIL /TAKE NORMAL RETURN JMP I NXTFIL /THIS IS THE SQUASH PROCESSOR FOR SELF SQUASH /WITH A USING DEVICE. MULTIPLE PASSES ARE MADE /ON THE USING DEVICE FOR THE CASE THAT IT IS SMALLER /THAN THE DEVICE BEING SQUASHED. A FILE TRANSFER /COUNTER IS MAINTAINED (FILCNT) FOR THE TRANSFER BACK. /A SELF SQUASH WITH A USING DEVICE REQUIRES THAT BOTH /DEVICES HAVE A PARAMETER BLOCK. THIS SHOULD NOT BE /REQUIRED FOR THE INPUT DEVICE (SEE SQSELF) HOWEVER /IT MAKES THE CODING EASIER. SOMEONE MAY WISH TO FIX /THIS UP LATER. SQUSIN, TAD OUHAND /OUT DEV MUST BE ZEROABLE JMS I (GETPAR JMP FUNNY /NO PARAMETER BLOCK IFZERO SYSOK <*.-1 JMP I (NOPARO /MUST HAVE A PARAMETER BLOCK> ISZ I (INSEG+4 /ZERO MUST BE ALLOWED SKP /O.K. JMP FUNNY /USE BIGGEST EMPTY:IS NOT ZEROABLE IFZERO SYSOK <*.-1;JMP I (ERRUSI> TAD I (INSEG+10 /START OF FILE STORAGE DCA USOSTRT /START OF FILES ON USING TAD I (INSEG+3 /LENGTH TAD USOSTRT /SUBT OFF START DCA USOLENT /SAVE FILE AREA TAD OUHAND /ALLOW WRITING DIRCTORY DCA I (SQUHND JMP I (SQUSCM /GO DO COMMON CODE FUNNY, JMS I (CNTCFIX TAD I (OUTDEV CIF 10 /LOOKUP LARGST EMPTY JMS I SYSTEM 3 /ENTER SQSTT, SQIOER /IS ILLEGAL FILENAME 0 /FILED BY -LENGTH HLT /CAN'T HAPPEN?? TAD SQSTT /START OF BIGGEST EMPTY DCA USOSTRT TAD SQSTT+1 /LENGTH OF EMPTY DCA USOLENT TAD (NULHND /DO NOT WRITE USING DIRECTORY DCA I (SQUHND JMP I (SQUSCM /GO TO COMMON CODE /ROUTINE TO CHECK FOR ^C /CALL: JMS I (CNTCHK / RETURN IF ^C / RETURN IF NO ^C CNTCHK, 0 TAD I (CNTCFLAG /PICK UP FLAG SZA CLA JMP I CNTCHK /YEP THERE WAS ONE KRS /IN THE READER? TAD (-"C+100 SNA CLA /SKIP IF YES JMP .+3 ISZ CNTCHK /NO: SECOND RET. JMP I CNTCHK TAD CNTCHK DCA I (CNTCFIX JMP I (CNTC PAGE /SUBROUTINE TO TRANSFER A FILE FROM THE INDEV TO THE OUTDEV. /ALSO CHECKS TO SEE IF IT IS NECESSARY. I.E. BLK#S = AND /INDEV=ODEV. REQUIRES SELF BE SET CORRECTLY. /CALL: JMS I (IMAGE / INBLK # / OUBLK # / -#BLKS / ERROR RETURN /HANDLER ERROR / NORMAL RETURN IMAGE, 0 ISZ FILCNT /FOR USING SQUASH TAD I IMAGE /PICK UP START OF INPUT DCA IMINBL /STASH IN BLOCK # ISZ IMAGE /POINT TO OUT BLOCK TAD I IMAGE /PICK UP START OF OUT FILE DCA IMOUBL /SET FOR HANDLER ISZ IMAGE /POINT TO BLOCK COUNT TAD I IMAGE /GET BLOCK COUNT DCA IMBLCNT /SET BLOCK COUNT ISZ IMAGE /POINT TO ERR RET. TAD SELF /SEE IF SQUASH TO ITSELF SNA CLA /SKIP IF YES JMP IMAGE1 /NO:MUST TRANSFER TAD IMOUBL /NOW CHECK FOR CIA /NO NEED TO TRANSFER TAD IMINBL /SINCE EXACT OVERLAP SZA CLA /SKIP IF SO JMP IMAGE1 /NO: MUST TRANSFER IMEXIT, ISZ IMAGE /NORMAL EXIT CLA CLL /ERR EXIT NEEDS THIS JMP I IMAGE /RETURN IMAGE1, JMS I (PATCHM /STOP ^C'S DCA I (ANYTRANS /SIGN A TRANSFER TAD IMBLCNT /TO SEE HOW BIG TAD (INSIZE /THE TRANSFER IS SMA /SKIP IF NOT LAST TRANSFER JMP IMAGE2 /LAST TRANSFER DCA IMBLCNT /UPDATE BLK CNT JMS I (CNTCFIX IMAGE3, JMS I INHAND /READ IT INCTL /ALL OF FIELD 1 0000 IMINBL, 0 JMP IMEXIT+1 /HANDLER ERROR JMS I (CNTCFIX JMS I OUHAND /WRITE IT INCTL!4000 0000 IMOUBL, 0 JMP IMEXIT+1 /HANDLER ERROR JMS I (CNTCHK NOP /JUST FOR THE MESSAGE TAD IMINBL /UPDATE IMBL TAD (INSIZE DCA IMINBL /NEW START TAD IMOUBL /AND OUT BLOCK # TAD (INSIZE DCA IMOUBL /NEW START JMP IMAGE1 /CONTINUE IMAGE2, CLA CLL /DO THE LAST TRANSFER TAD IMBLCNT /CALC FINAL TRANSFER CIA /CONTROL WORD CLL RTR;RTR;RTR TAD (10 /FIELD 1 TRANSFER DCA IMAGE4 TAD IMINBL /AND WHERE DCA IMAGE4+2 IMAGE5, CLA STL RAR /4000 TAD IMAGE4 DCA IMAGE6 TAD IMOUBL DCA IMAGE6+2 JMS I (CNTCFIX JMS I INHAND /READ LAST TRANSFER IMAGE4, 0;0;0 JMP IMEXIT+1 /HANDLER ERROR JMS I (CNTCFIX JMS I OUHAND /WRITE LAST TRANSFER IMAGE6, 0;0;0 JMP IMEXIT+1 /HANDLER ERROR JMP IMEXIT /DONE=NORMAL RETURN IMBLCN, 0 /ROUTINE TO CHECK ON "HOW'S THE DEVICE". /SETS "TFREE" TO TOTAL FREE BLOCKS AVAILABLE /SETS "LARGST" TO SIZE OF LARGEST FREE EMPTY /SETS "FRAGME" TO NUMBER OF FRAGMENTS. /OPERATES ON INDEV. HSTD, 0 DCA TFREE /INITIALIZE DCA LARGST DCA FRAGMENT JMS I (INITSEG /INITIALIZE SEGMENTS JMS I (NXTFIL /READ 1ST SEG JMP HSTDE /A ZERO DEVICE TAD I (INSEG+1 /START OF STORAGE DCA HSTBEG /SET START JMP .+3 /AND CONTINUE JMS I (NXTFIL JMP HSTDE /DONE JMS HSTDS /UPDATE STUFF JMP .-3 /CONTINUE HSTDE, JMS HSTDS /UPDATE STUFF JMP I HSTD /RETURN HSTDS, 0 ISZ EMPTY /ANY EMPTIES? SKP /YEP JMP I HSTDS /NOPE TAD EMPTY /UPDATE #FREE BLKS CIA TAD TFREE /IN TFREE DCA TFREE ISZ FRAGME /ONE MORE TAD LARGST /LARGEST SO FAR CLL /NOW SEE IF THIS BIGGER TAD EMPTY SZL CLA /SKIP IF EMPTY LARGER JMP I HSTDS /RETURN TAD EMPTY CIA /UPDATE LARGEST DCA LARGST JMP I HSTDS PAGE /SQUASH TO SELF - NO USING DEVICE. SQSELF, TAD OUHAND /GET PARAMETER BLOCK JMS I (GETPAR /FOR DEVICE JMP SQSLF2 /NO PRARM BLOCK-BUT ALLOW IT ISZ I (INSEG+6 /SKIP IF NO SELF SQUASH ALLOWED SKP JMP I (ERROR2 /A FUNNY DEVICE TAD I (INSEG+3 /LAST BLK # DCA OFREE /TOTAL SIZE JMS I (HSTD /FOR UNTIL CHECK SQSLF1, JMS SQSLFS /CHECK UNTIL. TAD I (INSEG+1 /START OF STORAGE DCA OSTART /INTIT START OF OUT STORAGE TAD OSTART /NOW TO MAKE TRUE OFREE TAD OFREE DCA OFREE /CORRECTED FOR RESERVE TAD OSTART /FOR FILE INTEGRITY DCA INTSTR /STUFF TAD OFREE DCA INTLEN JMS I (SLFWST /GET WASTE WORDS STA /INDICATE SELF SQ DCA SELF NOP;NOP IFZERO VERYSAFE <*.-2 TAD I (INDEV JMS I (GETDCB> CLA CLL IFNZRO SQSAFELY <*.-1;STA> DCA SECURE /DO SEQURE SQUASH IF CONDITIONAL ASSEMBLY JMS I (INITSEG /REINITIALIZE SEGMENTS TAD OSTART /FOR UNTIL CHECK DCA CHKSTR JMS I (NORMSQ SKP /^C OR UNTIL OK JMP I (ENDSQU ISZ I (NORMEX /SKIP IF UNTIL SATISFIED JMP SQSLFC /^C TERMINATION SQSLFU, JMS I (SYPHON /SYPHON REST DOWN JMS I (PRMSG /TELL HIM WE GOT IT USEMSG JMS I (CRLF JMP I (ENDSQU SQSLFC, JMS I (NXTFIL /WAS ^C GET NEXT JMP I (NORMDN /WAS DONE ANYWAY JMS I (SYPHON JMP I (ENDSQU /IS SELF SQUISH OF DEVICE WITH NO PARMETER BLOCK. /ALLOW IT BUT WE MUST FIGURE OUT HOW LONG THE DEVICE IS. SQSLF2, JMS I (HSTD /GET INFO ABOUT INDEV. TAD SEGST /LAST BLOCK # CIA DCA OFREE /-TOTAL SIZE JMP SQSLF1 /GOT IT. SQSLFS, 0 CLL CLA IAC TAD FREEBL /CHECK FOR CORRECT "UNTIL" OPTION SZA /FOR NO USING GIVEN CIA /MAKE -REQUEST TAD TFREE /TOTAL AVAILABLE SNL CLA /L=1 IF O.K. SKIP IF BLOCKS AVAILABLE JMP I (SERR1 /BAD "UNTIL" REQUEST. TAD LARGST /L=1 FROM ABOVE CIA /L=1 STILL LARGEST#0 TAD FREEBL /SEE IF ALREADY HAVE ENOUGH SZL CLA /SKIP IF NO: JMP I (AVAIL /ALREADY AVAILABLE JMS CNTCFIX JMS I INHAND /GET FIRST DIR SEGMENT 200 /FOR START OF FILE STORAGE INSEG 0001 JMP I (SERRHN /HANDLER ERROR - DIRECTORY O.K. JMP I SQSLFS /ROUTINE EXECUTED WHEN ^C RECEIVED. /SETS CNTCFLAG NON ZERO WHEN FOUND. CONTINUES /LAST TRANSFER TO COMPLETION. CNTC, STA DCA CNTCFLAG JMS I (CRLF JMS I (PRMSG PREMAT KCC /CLEAR THE FLAG TAD CNTCFIX SZA CLA /IF ZERO FORGET IT JMP I CNTCFIX HLT CNTCFL, 0 CNTCFIX,0 JMP I CNTCFIX /ROUTINE TO WAIT FOR TAPE MOUNT WAITER, 0 TAD I (WAIT /SEE IF WAIT REQUESTED SNA CLA /SKIP IF YES JMP I WAITER /NO JUST RETURN JMS I (CRLF JMS I (PRMSG MWAIT /WAITING MESSAGE JMS I (CRLF KCC KSF /ANY KEY STRUCK JMP .-1 JMS CNTCHK /AND CHK FOR ^C JMP I (7600 /RETURN IMMEDIATE KCC /GET RID OF FLAG JMP I WAITER PAGE /PATCH MONITOR TO INTERCEPT ^C PATCHM, 0 CLA CLL /NO MISTAKES HERE TAD (5601 /JMP I .+1 DCA I (7600 TAD (CNTC /BRANCH TO DCA I (7601 /CNTC TAD (5200 /ALSO TRAP 7605 DCA I (7605 JMP I PATCHM /UNPATCH THE MONITOR UNPATC, 0 CLA CLL TAD (4207 /JMS SYSHAND DCA I (7600 TAD (5000 /WRITE 1 K DCA I (7601 TAD (6213 /AND CDF CIF 10 DCA I (7605 JMP I UNPATCH CMPR, 0 /COMPARE DISPATCH ROUTINE DCA CMPRTM /STORE ACC ARG TAD I CMPR ISZ CMPR SNA JMP CMPREX /END OF DISPATCH TABLE TAD CMPRTM SNA CLA JMP CMPRND /GOT A MATCH ISZ CMPR JMP CMPR+2 /KEEP LOOKING CMPRND, TAD I CMPR /GET JUMP ADDRESS DCA CMPRTM JMP I CMPRTM /GO TO IT CMPREX, CLA CLL JMP I CMPR CMPRTM, 0 PRNM, 0 TAD NM1 JMS PRWD TAD NM2 JMS PRWD TAD NM3 JMS PRWD TAD NM4 SNA CLA JMP I PRNM TAD (256 JMS PCH TAD NM4 JMS PRWD JMP I PRNM JMS PCHAR PCH, 0 TLS TSF JMP .-1 CLA CLL JMP I PCH PCHAR, 0 AND (77 SNA JMP I PCHAR TAD (-40 SPA TAD (100 TAD (240 JMS PCH JMP I PCHAR PRWD, 0 DCA PRWDTM TAD PRWDTM RTR;RTR;RTR JMS PCHAR TAD PRWDTM JMS PCHAR JMP I PRWD PRWDTM, 0 CRLF, 0 TAD (215 JMS PCH TAD (212 JMS PCH JMP I CRLF PRMSG, 0 CLA CLL TAD I PRMSG ISZ PRMSG DCA CMPRTM /MESSAGE LOC PRMGLP, TAD I CMPRTM JMS PRWD TAD I CMPRTM AND (77 /LAST HALF ZERO? SNA CLA JMP I PRMSG /END OF MESSAGE ISZ CMPRTM JMP PRMGLP NOFIT, ISZ NOFITB /SKIP IF SQUASH USING BRANCH SKP /NORMAL OR SELF SQUASH JMP I (SQUSBR JMS I (PRMSG /TELL HIM IT WON'T FIT MNOFIT JMS I (PRNM /WHICH ONE JMS CRLF JMP I (NORMSQ+1 /CONTINUE NOFITB, 0 PAGE SQUSBR /MUST BE FIRST LOC ON PAGE /ROUTINE TO HANDLE A NORMAL SQUASH FROM ONE DEVICE /TO ANOTHER. BOTH DEVICES MUST HAVE A PARAMETER BLOCK. /^C MAY INTERRUPT AT ANY TIME SINCE NO CHANGES ARE MADE /TO THE INPUT DEVICE. NORMAL, DCA SECURE /ALL WILL BE SEQURE ANYWAY DCA SELF /IND NOT SELF TAD OUHAND /GET PARAMETER BLOCK FOR JMS I (GETPAR /OUTPUT DEVICE FIRST JMP I (NOPARO /MUST HAVE A PARAMETER BLOCK ISZ I (INSEG+5 /SKIP IF NOT ALLOWED SKP JMP I (ERROR3 /NO SQUASH FROM OTHER DEVICES TAD I (INSEG+3 /PICK UP THE SIZE(-) TAD I (INSEG+10 /START OF FILE STORAGE DCA OFREE /TOTAL AVAILABLE BLOCKS OUT TAD I (INSEG+10 /START OF FILES AGAIN DCA OSTART /STASH. JMS I (NRMWST /GET WASTE WORDS STA /FREE BLOCKS MEAN NOTHING DCA FREEBL JMS I (INITSEG /INIT SEGMENTS JMS NORMSQ /DO IT JMP NORMDN /^C FOUND JMP ENDSQU /NORMAL END ENDSQU, JMS I (CRLF ISZ ANYTRANS TAD (MENDSQ-NOMOVE TAD (NOMOVE DCA .+2 JMS I (PRMSG MENDSQ JMP I (SQOVER /GO WAIT IF REQUIRED ANYTRA, -1 /NORMAL SQUASHING ROUTINE THAT ACTUALLY DOES /THE DIRECTORY WORK. NXTFIL AND ENTFIL MUST HAVE BEEN /PREVIOUSLY INITIALLIZED AS USER DESIRES. THIS SUB. /WILL PICK UP FROM THAT POINT AND DO THE TRANSFERRING. /CALL: JMS NORMSQ / RET1 /SOME PREMATURE EXIT CONDITION / RET2 /NORMAL EXIT. /ON RET1 EXIT "NORMEX" IS SET AS FOLLOWS: / NORMEX=-1 /UNTIL SATISFIED. / NORMEX=-2 /^C DETECTED LAST FILE TRANS. NORMSQ, 0 JMS I (NXTFIL /GET SOME POINTERS JMP NORMDN /DONE. JMS CHKUNTIL /CHECK FOR ROOM REQUEST TAD FILST /START OF FILE DCA NORM1 /FOR TRANSFER TAD FILLEN /#BLOCKS DCA NORM1+2 /STASH TAD OSTART /WHERE TO PUT IT DCA NORM1+1 /DESTINATION TAD FILLEN /-FILE LENGTH CIA CLL /MAKE POSITIVE TAD OFREE /CHECK FOR FITTING SZL CLA /LINK OVERFLOW MEANS IT WONT FIT NORM2, JMP I (NOFIT /FILE WON'T FIT JMS I (INTEGR /FILE INTEGRITY CHECK JMS I (IMAGE /TRANSFER IT NORM1, 0;0;0 JMP I (IOERROR /COPY I/O ERROR JMS I (ENTFIL /ENTER FILENAME ETC. JMS I (CNTCHK /CHECK FOR ^C JMP CNTCFN /ONE FOUND JMP NORMSQ+1 /CONTINUE /FINISH UP. NORMDN, DCA I OUSEGP /THE LAST IS AN EMPTY ISZ OUSEGP TAD OFREE DCA I OUSEGP /STICK IN LAST EMPTY TAD I (OUSEG+2 /THIS BLKNO DCA NORMD1 DCA I (OUSEG+2 /END OF SEGMENTS STA /ALSO AN EMPTY ENTRY TAD I (OUSEG /= 1 MORE ENTRY DCA I (OUSEG /IN SEGMENT HEADER. JMS I (PATCHM JMS I (CNTCFIX JMS I FUNHND /WRITE OUT LAST SEGMENT 4200 OUSEG NORMD1, 0 JMP I (FATERR ISZ NORMSQ /TAKE SECOND EXIT JMP I NORMSQ /RETURN CNTCFN, STA CLL RAL /-2 DCA NORMEX JMP I NORMSQ NORMEX, 0 /ROUTINE TO CHECK UNTIL OPTION. /NOTE THAT A SPECIAL START OF NEXT FILE IS KEPT INTERNAL /TO THIS ROUTINE FOR THE CASE OF SQ SELF USING XXX UNTIL XXX CHKUNT, 0 /CHECK UNTIL ROUTINE TAD CHKSTR /SPECIAL START NEXT FILE CIA /SUBT FROM START INPUT FILE TAD FILST /AC=+FREE BLOCKS CLL CIA /L=0 AC=-FREE (IF AC=0 THEN L=1) TAD I (FREEBL /REQUESTED STOP SZA /SKIP IF EXACT MATCH SNL CLA /SKIP IF NOT YET JMP CHKOK /HAVE ENOUGH TAD FILLEN /CALC NEXT FILE START CIA TAD CHKSTR /UPDATE CHKST DCA CHKSTR /UPDATED. JMP I CHKUNTIL CHKOK, STA JMP CNTCFN+1 /PREMATURE EXIT PAGE /CONTINUATION OF SQUASH USING /COMMON CODE. SQUSCM, JMS I (HSTD TAD INHAND /NOW CHECK INDEV JMS I (GETPAR /FOR SQUASHABILITY JMP SQUS0 /ALLOW NO PARAM BLOCK ISZ I (INSEG+6 /SKIP IF NO SELF SQUASH SKP JMP I (ERROR3 /A FUNNY DEVICE TAD I (INSEG+3 /LAST BLK NUMB SQUS1, DCA USILEN /STASH TEMP JMS NRMWST /GET WAIST WORDS JMS I (SQSLFS /CHECK FOR AVAILABILITY(UNTIL) TAD I (INSEG+1 /START OF FILES DCA USISTRT /SAVE TAD USILEN /LENGTH TAD USISTRT /GET FREE NUMBER DCA USILEN /SAVE FREE LENGTH TAD OUHAND /SAVE OUTHAND DCA LSTDEV /SINCE SWITCHING TAD INHAND DCA USHAND /ALSO SAVE INHANDLER ADD. DCA SELF /WANT TO TRANSFER ALL SQUSL1, TAD USOSTRT /INIT OUT DEVICE DCA OSTART /FOR DIRECTORY WORK TAD USOLEN DCA OFREE TAD USISTR /FOR UNTIL CHECK DCA CHKSTR TAD LSTDEV /ARE GOING TO USING DEVICE DCA OUHAND /THIS TIME TAD USHAND DCA INHAND /MAKE SURE INHANDLER RIGHT JMS I (SQUSSB /GO UNTIL EMPTY TAD SQUHND /NULL HANDLER, OR USING HANDLER DCA FUNHND /NO OUTPUT DIRECTORY TAD FILST /CALC FILE START FOR TAD EMPTY /FOR UNTIL CHECK DCA CHKSTR DCA FILCNT /COUNT THE FILES TRANSFERRED TAD (SQUSL3 DCA I (NORMSQ /FAKE OUT NORMSQ TAD (5600 /PATCH NOFIT STUFF DCA I (NORM2 JMP I (NORMSQ+3 /AS HAVE ALREADY LOOKED UP ONE SQUSBR, JMS I (SQUSS2 SKP SQUSL3, JMP I (SQUSL2 /^C EXIT OR "UNTIL" SATISFIED TAD OSTART /HOW MUCH WE TRANSFERED CIA TAD USOSTRT /AC=DIFFERENCE SNA /SKIP IF USING DEVICE SMALLER JMP I (NOGO /THAN THE LAST FILE DCA SQUSL4+2 /STASH FOR IMAGE TAD USISTRT DCA OSTART /INIT FOR GOING TO SELF TAD USILEN DCA OFREE TAD INHAND DCA OUHAND /SWITCH HANDLERS JMS I (INITSEG /REINITIALIZE JMS I (NXTFIL /GET NEXT NAME HLT /CAN'T HAPPEN ISZ EMPTY /UNTIL WE FIND AN EMPTY JMP .+3 /FOUND ONE JMS I (ENTFIL /PUT LAST IN DIRECTORY JMP .-5 /KEEP GOING TAD FILCNT /NOW UPDATE DIRECTORY FOR CORRECT CIA /NUMBER OF NAME ENTRIES DCA FILCNT TAD OSTART /WERE TO START TRANSFERRING DCA SQUSL4+1 /TO OUT DEVICE JMP SQUSL5 /HAVE DONE FIRST SQUSDN, JMS I (SQUSS2 /WRITE OUT LAST DIRECTORY BLOCK JMP SQUSL7 /SUBROUTINE TO GET NUMBER OF WASTE WORDS WHEN AN INDEV /SEGMENT IS IN CORE. USES INDEV #WASTE WORDS IF "SAVE" /ARGUMENT NOT SPECIFIED SLFWST, 0 TAD I (SAVE /PICK UP SAVE ARGUMENT SMA CLA /SKIP IF NOT SPECIFIED JMP SLFWS1 /USE SPECIFIED TAD I (INSEG+4 /USE WASTE FOR INDEV. SNA /UNLESS ZERO STA /IN WHICH CASE USE 1 DCA OWASTE JMP I SLFWST /AND RETURN SLFWS1, TAD I (SAVE /USE SPECIFIED CIA JMP .-4 /GET WASTE WORDS WHEN INSEG NOT IN CORE. /DO HSTD TO GET A SEGMENT. NRMWST, 0 JMS I (HSTD /GET SEGMENT AND DO HSTD JMS SLFWST /USE COMMON ROUTINE JMP I NRMWST /NO PARAMETER BLOCK SO GET SIZE FROM HSTD RESULTS SQUS0, TAD SEGST /NO PARAM BLOCK SO USE FROM HSTD CIA JMP SQUS1 /CONTINUE /NO NAME ("SQUASH") MEANS DSK TO SELF. SQSYS, CIF 10 JMS I SYSTEM /WHO IS DSK 12 /INQUIRE DEVICE DSK 0 DECL3 /ERROR CAN'T HAPPEN JMS I (BMPLXR /BACK UP FOR CASE OF ALTMODE TAD .-4 /GET DEV# JMP I .-3 /RETURN WITH DEV# PAGE CHECKP, CHECKK /MUST BE FIRST LOCATION IN PAGE /SOME ROUTINES USED BY SQUASH USING SQUSL6, JMS I (NXTFIL HLT /CAN'T HAPPEN SQUSL5, JMS I (ENTFIL /ENTER NEXT ISZ FILCNT /DONE? JMP SQUSL6 /NO: NEXT FILENAME JMS I (NXTFIL JMP SQUSDN JMS I (SYPHON /SYPHON REST OF FILENAMES DOWN SQUSL7, TAD LSTDEV /COMING FROM USING DEVICE DCA INHAND TAD USOSTRT /WHERE USING DEVICE STARTS DCA SQUSL4 JMS I (IMAGE /TRANSFER ALL THAT STUFF SQUSL4, 0;0;0 JMS I (SERR4 /THE GOOD FILES ARE ON USING DEVICE ISZ NORMEX /MAY HAVE UNTIL SATISFIED JMP SQUSL1 /CONTINUE JMP I (ENDSQU /"UNTIL" SATISFIED=QUIT /WRITE OUT LAST DIRECTORY BLOCK SQUSS2, 0 TAD (.+2 DCA NORMSQ JMP I (NORMDN JMP I SQUSS2 /SUBROUTINE TO SKIP THROUGH FILE TO AN EMPTY SQUSSB, 0 JMS I (INITSEG /INITIALIZE DIR. JMS I (NXTFIL /FIRST WE IGNORE UNTIL AN EMPTY JMP I (ENDSQU /DONE. ISZ EMPTY /SKIP IF NO EMPTY JMP I SQUSSB JMP .-4 /KEEP GOING /SYPHON DOWN THE REST OF THE DIRECTORY TO THE OUTPUT /DEVICE. USED ONLY BY SELF SQUASH WHEN ^C IS GIVEN /OR WHEN "UNTIL" IS SATISFIED. /ENTER AFTER A "NXTFIL" WHEN AN "ENTFIL" HAS NOT BEEN DONE. SYPHON, 0 /SYPHON THE REST TAD FILST /FIRST A BIG EMPTY CIA /CALC -EMPTY TAD OSTART /FIRST TIME SNA /IF ZERO NO EMPTY JMP SYPHN1 /NO EMPTY-CONTINUE DCA EMPTY /NEW SIZE OF EMPTY SYPHN2, JMS SYPHNE /SYPHON AN EMPTY SYPHN1, JMS I (ENTFIL /STICK IN FILENAME JMS NXTFIL /GET NEXT JMP SYPHN3 /NO NEXT ISZ EMPTY /SKIP IF NO EMPTY JMP SYPHN2 /PUT IN EMPTY & FILE NAME JMP SYPHN1 /ONLY FILE-NAME SYPHN3, ISZ EMPTY /SKIP IF NO EMPTY JMS SYPHNE /PUT IN THE EMPTY TAD I (OUSEG+2 /GET WHICH SEG DCA SYPHN4 /PUT IN FOR WRITE DCA I (OUSEG+2 /LAST SEGMENT JMS I (CNTCFIX JMS I FUNHND /WRITE IT OUT 4200 OUSEG SYPHN4, 0 JMP I (FATERR /DIRECTORY WRITE ERROR JMP I SYPHON /SYPHON AN EMPTY SYPHNE, 0 NOP /CHANGED BY INTEGRETY CHECKER DCA I OUSEGP /INDICATE AN EMPTY ISZ OUSEGP TAD EMPTY /SIZE DCA I OUSEGP /PUT IN SIZE ISZ OUSEGP STA TAD I (OUSEG /ONE MORE FILE DCA I (OUSEG TAD EMPTY CIA /UPDATE START OF NEXT OUT TAD OSTART /FILE TO TAKE CARE OF DCA OSTART /THIS EMPTY JMP I SYPHNE /FILE INTEGRETY CONFLICT INTEGC, KCC /WANT A NEW CHAR JMS I (PRMSG /FILE INTEGRITY CONFLICT MCONFLCT JMS I (PRNM /WHICH FILE JMS I (CRLF /NEW LINE JMS I (PRMSG /PROCEED ANYWAY? MPROCEED KSF /WAIT FOR ANSWER JMP .-1 KRB /READ IT TAD (-"Y /CHECK HIS ANSWER SZA CLA /SKIP IF "YES" JMP .+5 /ANYTHING ELSE=NO JMS I (PRMSG MYES JMS I (CRLF JMP I (INTRET /(YES ANSWER) JMS I (PRMSG MNO CHKEND, JMS I (SYPHON /(IF NO ANSWER) JMP I (ENDSQU PAGE /SUBROUTINE TO CHECK FILE INTEGRITY /CALLED FROM "NORMSQ" INTEGR, 0 DCA OVERLAP /INIT OVERLAP TAD OSTART /START OF OUTPUT CIA /NEGATE TAD FILST /+OFSETT SNA /SKIP IF NOT EXACT MATCH JMP I INTEGR /RETURN: EXACT MATCH CLL /FOR CHECK TAD FILLEN /TO SEE IF OVERLAP SZL CLA /SKIP IF VIOLATION OF INTEGRITY JMP I INTEGR STA /SET OVERLAP: A VIOLATION DCA OVERLAP TAD SECURE /CHECK TO SEE IF WE ARE CHECKING SNA CLA /SKIP IF YES. INTRET, JMP I INTEGR /NO:DO IT ANYWAY /WE HAVE A FILE INTEGRITY PROBLEM. FIRST TRY TO WRITE /THE FILE OUT SOMEPLACE ELSE ON THE DEVICE. JMS I (CNTCHK /CHECK FOR ^C JMP I (CHKEND /YEP - END IT TAD LARGST /LARGEST FREE BLOCK CLL /INCASE >2048 BLOCK FILE??? TAD FILLEN /SEE IF WILL FIT SNL CLA /SKIP IF WILL FIT JMP INTEGCON /IS A FILE INTEGRITY CONFLICT TAD (-200 /AT LEAST ENOUGH FOR WASTE WORDS DCA TEMP1 /USED FOR COUNTER TAD FILPNT /GET POINTER TO NAME DCA TEMP2 TAD (1600 /COPY IT THERE DCA TMP1 TAD I TEMP2 /SO COPY IT DCA I TMP1 ISZ TEMP2 ISZ TMP1 ISZ TEMP1 /DONE? JMP .-5 /NOT YET DCA OVERLAP /WE ARE DOING IT SEQURELY TAD (5600 /PATCH TO USE SYPHON ROUTINE DCA I (SYPHNE+1 JMS I (SYPHON /USE SYPHON ROUTINE JMS I (HSTD /FIND NEW BIGGEST EMPTY TAD INTSTR DCA OSTART /RESET START OF DEVICE TAD INTLEN DCA OFREE /AND SIZE OF DEVICE JMS I (INITSEG /INITIALIZE DIRECTORY JMS I (NXTFIL /SKIP TO EMPTY HLT /CAN'T HAPPEN ISZ EMPTY /LOOK FOR FIRST EMPTY JMP .+3 /FOUND IT JMS I (ENTFIL /KEEP IT JMP .-5 /KEEP GOING TAD OSTART /FOR "UNTIL" OPTION DCA CHKSTR JMS I (CNTCHK /CHECK FOR ^C JMP I (CHKEND /YEP - END IT JMP NORMSQ+1 /DO MORE /COME HERE ON EMPTY FROM SYPHON. CHECKK, TAD EMPTY /TO SEE IF IT FITS CIA CLL /LINK MUST BE ZERO TAD I (NORM1+2 /L=1 IF IT FITS SNL CLA JMP I (SYPHNE+2 /CONTINUE TAD (NOP DCA I (SYPHNE+1 /RESTORE SYPHON ROUTINE TAD I (NORM1 /SOURCE BLOCK DCA CHECK1 TAD OSTART /WHERE IT GOES DCA CHECK1+1 TAD I (NORM1+2 /SIZE DCA CHECK1+2 JMS I (IMAGE /TRANSFER IT CHECK1, 0;0;0 JMP CHECK2 /I/O ERROR=QUIT JMS I (CNTCHK /CHECK FOR ^C JMP I (CHKEND /YEP - END IT TAD FILPNT /SAVE NEXT ENTRY DCA TEMP1 TAD (1600 /CHANGE FOR OLD FILENAME DCA FILPNT TAD FILLEN DCA TEMP2 /SOVE THIS SIZE TAD I (NORM1+2 /SIZE DCA FILLEN JMS I (ENTFIL /ENTER FILENAME TAD FILLEN /MAKE EMPTY CIA /SMALLER TO ACCOUNT TAD EMPTY /FOR NEW ENTRY DCA EMPTY /FOR SYPHON. TAD TEMP1 /AND RESTORE THESE POINTERS DCA FILPNT TAD TEMP2 DCA FILLEN JMP I (SYPHNE+2 /CONTINUE CHECK2, JMS I (SYPHON /ERROR TRANSFERRING FILE JMP I (IOERROR /BUT EVERYTHING IS GROOVY. OVERLA, 0 PAGE /SUBROUTINE TO INITIALIZE SEGMENTS. FOR SUBS "NXTFIL" /AND "ENTFIL". INITSE, 0 STA /INIT NXTFIL FOR START UP DCA SEGCNT /BY SEGCNT_-1 IAC DCA I (INSEG+2 /NEXT SEG IS BLK 1 DCA I (OUSEG /NO FILES SO FAR TAD OSTART DCA I (OUSEG+1 /START OF STORAGE IAC /IND THIS IS BLOCK 1 DCA I (OUSEG+2 /CHANGED BEFORE WRITING SEG. DCA I (OUSEG+3 /NO TENATIVE TAD OWASTE /WASTE WORDS DCA I (OUSEG+4 TAD (OUSEG+5 /START OF FILES DCA OUSEGP /SET OUT SEG POINTER TAD OUHAND /RESET FUNHND TO OUTHND DCA FUNHND JMP I INITSEG /ENTER A FILE POINTED TO BY FILPNT IN OUT DIRECTORY SEGMENT /WRITE A SEGMENT IF NECESSARY AND INITIATE A NEW ONE ENTFIL, 0 TAD (-4 /FOR NAME DCA ENTCNT TAD I FILPNT /GET NAME DCA I OUSEGP /STASH ISZ OUSEGP ISZ FILPNT ISZ ENTCNT /DONE? JMP .-5 TAD OWASTE /EXTRA INFORMATION WORDS SNA /IF ZERO:QUIT JMP ENTFL1 /NO MORE DCA ENTCNT /TOTAL WASTE OUT TAD FILWAS /WASTE IN INPUT SNA /SKIP IF ANY JMP ENTFL2 /NONE:FILL WITH ZEROS CIA DCA CNTR /SET IN COUNTER ENTFL4, TAD I FILPNT /USE IN WASTE WORDS DCA I OUSEGP /AS LONG AS THERE ARE ANY ISZ FILPNT ISZ OUSEGP /NEXT ISZ CNTR /SKIP IF NO MORE SKP JMP ENTFL3 /FILL REST WITH ZERO'S ISZ ENTCNT /ALL DONE? JMP ENTFL4 /NO JMP ENTFL1 /YES ENTFL2, DCA I OUSEGP /PUT IN A ZERO ISZ OUSEGP ENTFL3, ISZ ENTCNT /ALL DONE? JMP ENTFL2 /NO:MORE ZEROS ENTFL1, TAD FILLEN /PUT IN LENGTH DCA I OUSEGP ISZ OUSEGP /POINT TO NEXT TAD FILLEN /NOW UPDATE LENGTH CIA /MAKE POSITIVE TAD OFREE /NEW -FREE DCA OFREE TAD FILLEN /UPDATE START CIA TAD OSTART /OF NEXT FILE DCA OSTART STA TAD I (OUSEG DCA I (OUSEG /ONE MORE ENTRY TAD OWASTE /NOW SEE IF NEED NEW SEGMENT CIA /WASTE WORDS RAL CLL /*2 TAD (-OUSEG-400+12 /MUST HAVE 5+N WORDS LEFT IN SEG TAD OUSEGP /AFTER NEXT ENTRY SPA CLA /SKIP IF NEED NEW SEGMENT JMP I ENTFIL /NOPE TAD I (OUSEG+2 /BLOCK # THIS SEG DCA NORM3 ISZ I (OUSEG+2 /LINK TO NEXT SEG TAD OFREE /SPECIAL CASE. IF NO FREE BLOCKS SNA CLA /WE WILL NOT NEED ANOTHER SEGMENT DCA I (OUSEG+2 /END OF SEGMENTS JMS I (CNTCFIX JMS I (PATCHM /AND PATCH MONITOR JMS I FUNHND 4200 /WRITE OUT THE DONE SEGMENT OUSEG NORM3, 0 JMP I (FATERR /FATAL ERROR TAD OSTART DCA I (OUSEG+1 DCA I (OUSEG /NO FILES YET TAD (OUSEG+5 DCA OUSEGP /RESET SEGMENT POINTER JMP I ENTFIL /AND RETURN CNTR, 0 /A NULL DEVICE HANDLER NULHND, 0 TAD (4 TAD NULHND /GO TO NORMAL RETURN DCA NULHND JMP I NULHND /PRETEND WE DID IT /THIS IS THE EXIT FROM SQUASH SQOVER, JMS I (WAITER /WAIT IF HE WANTS JMS I (UNPATC /RESTORE MONITOR JMP I (7600 SQNULL, JMS I (CRLF JMS I (PRMSG NULLSQ JMP I (7600 SQNUL2, JMS I (CRLF JMS I (PRMSG NULLSQ JMP SQOVER /AND WAIT PAGE /ERROR MESSAGE ROUTINES AND GENERATION NOGO, JMS I (PRNM JMS I (PRMSG MNOGO JMS I (PRMSG NUSING JMP I (ENDSQU NODEV, JMS I (PRNM JMS I (PRMSG ERRND JMP SQNULL ERNFS, JMS I (PRNM JMS I (PRMSG NFSERR JMP SQNULL ERRHND, JMS I (PRMSG HNDERR JMP SQNULL NOPARO, JMS I (PRMSG ERRPAR JMS I (PRMSG NOUT JMP SQNUL2 NOPARI, JMS I (PRMSG ERRPAR JMS I (PRMSG NIN JMP SQNUL2 ERUSIN, JMS I (PRMSG NUSING JMS I (PRMSG ERRUSI JMP SQNUL2 ERROR2, JMS I (PRMSG ERR2M JMS I (PRMSG NIN JMP SQNUL2 ERROR3, JMS I (PRMSG ERR3M JMS I (PRMSG NOUT JMP SQNUL2 SYNTAX, JMS I (PRMSG SYNERR JMP SQNULL SERRHN, JMS I (PRMSG HNDERR JMP SQOVER FATERR, JMS I (PRMSG FERR1 JMP SQOVER SERR1, JMS I (PRMSG SQERR1 JMS I (PRMSG NOUT JMP SQNULL IOERRO, JMS I (PRMSG SQIOER JMS I (PRNM /TELL HIM WHICH ONE JMS I (CRLF JMS I (SYPHON /KEEP REST OF DIRECTORY JMS I (PRMSG MFILE ISZ OVERLAP /SKIP IF OVERLAP JMP .+3 /NO: FILE OK JMS PRMSG /NOT NECESSARILY MNOTNES JMS PRMSG MSEQURE JMP SQOVER SERR4, JMS I (PRMSG HNDERR JMS I (PRMSG SQER4A JMS I (CRLF JMS I (PRMSG SQER4B JMP SQOVER SQUSL2, JMS I (CNTCHK /^C OR UNTIL JMP .+4 /REALLY A ^C JMS I (PRMSG /TELL HIM ABOUT FREE BLOCKS USEMSG JMP I (SQUSL3+1 /AND FINISH UP JMS I (PRMSG MSQUS1 TAD USOSTR DCA I (OUSEG+1 DCA I (OUSEG+2 /ONLY ONE BLK DCA I (OUSEG+5 /A BIG EMPTY TAD USOLEN DCA I (OUSEG+6 STA DCA I (OUSEG /ONE EMPTY JMS I (CNTCFIX JMS I FUNHND /WRITE IT 4200 OUSEG 1 JMP SERRHND JMP I (ENDSQU /REQUESTED FREE BLOCKS ALREADY AVAILABLE AVAIL, JMS I (CRLF JMS I (PRMSG MAVAIL JMP I (SQNUL2 PAGE MAVAIL, TEXT \FREE BLOCKS CURRENTLY AVAILABLE\ MNOGO, TEXT \ WILL NOT FIT ON \ NOMOVE, TEXT \DEVICE PACKED ... \ *.-1 NULLSQ, TEXT \NULL SQUASH\ MSQUS1, TEXT \REQUESTED EXIT - FILES O.K.\ SQER4A, TEXT \FILES ON USING DEVICE O.K.\ SQER4B, TEXT \DUPLICATE FILES ON SQ DEVICE ARE BAD\ FERR1, TEXT \DIRECTORY ERROR - FILES MAY BE LOST\ SQERR1, TEXT \REQUESTED FREE BLOCKS NOT AVAILABLE ON \ SQIOER, TEXT \I/O ERROR TRANSFERRING \ MFILE, TEXT \FILE\ MNOTNE, TEXT \ NOT NECESSARILY\ MSEQUR, TEXT \ SECURE\ MWAIT, TEXT \WAITING...\ MENDSQ, TEXT \END SQUASH\ MNOFIT, TEXT \NO ROOM FOR \ SYNERR, TEXT \SYNTAX ERROR\ ERR3M, TEXT \NO SQUASH FROM OTHER DEVICES ALLOWED ON \ ERR2M, TEXT \SELF SQUASH NOT ALLOWED ON \ ERRUSI, TEXT \BAD "USING" DEVICE\ ERRPAR, TEXT \NO PARAMETER BLOCK ON \ HNDERR, TEXT \HANDLER ERROR - NO FILES LOST\ NFSERR, TEXT \ IS NOT FILE STRUCTURED\ ERRND, TEXT \ DOES NOT EXIST\ PREMAT, TEXT \PREMATURE EXIT...WAIT...\ USEMSG, TEXT \SPECIFIED FREE BLOCKS AVAILABLE\ MCONFL, TEXT \FILE INTEGRITY CONFLICT \ MPROCE, TEXT \PROCEED ANYWAY? \ MYES, TEXT \YES\ MNO, TEXT \NO\ NIN, TEXT \DSK \ NOUT, TEXT \DSK \ NUSING, ZBLOCK 3 PAGE *6610 /PAST HEADER /THIS CODING IS FOR THE "HD" (HOW'S THE DEVICE) COMMAND /AND RESIDES WHERE THE OUT DIRECTORY SEGMENT GOES FOR /SQUASH COMMANDS. THERE IS NO CONFLICT SINCE THERE IS /NO OUT DIRECTORY SEGMENT IN A "HD" COMMAND. HD, JMS I (HSTD JMS I (CRLF /NEW LINE TAD I (TFREE /TOTAL FREE BLOCKS JMS DECPRN /PRINT IT JMS I (PRMSG MFREEB / XXX FREE BLOCKS IN TAD I (FRAGME JMS DECPRN /XXX STA TAD I (FRAGME /TO SEE ABOUT PLURAL SZA CLA JMP HDCC /PRINT IT TAD (2440 /ONLY 1 FRAGMENT DCA MFRAG+4 /"TS" OR "T " DCA MFRAG+5 /DON'T PRINT LARGEST HDCC, JMS I (PRMSG MFRAG /XXX FRAGMENTS: LARGEST IS TAD MFRAG+5 SNA CLA /SKIP IF LARGEST TO BE PRINTED JMP I (7600 /NO: BACK TO MONITOR TAD I (LARGST JMS DECPRN /XXX JMP I (7600 MFREEB, TEXT \ FREE BLOCKS IN \ MFRAG, TEXT \ FRAGMENTS: LARGEST IS \ /SUBROUTINE TO SAVE NM1 AND NM2 IN ADDRESS SPECIFIED /BY CALL. USED TO SAVE DEVICE NAMES. /CALL: JMS I (SAVNAM / ADDRESS SAVNAM, 0 TAD I SAVNAM DCA DECPRN ISZ SAVNAM TAD NM1 DCA I DECPRN ISZ DECPRN TAD NM2 DCA I DECPRN JMP I SAVNAM /DIGITAL 8-22-U /UNSIGNED DECIMAL PRINT /CALL WITH NUMBER TO BE TYPED IN C(AC) /RETURN TO LOCATION FOLLOWING THE JMS DECPRN, 0 CDF 0 DCA VALUE /SAVE INPUT CLA STL RAR /INIT NO LEADING SPACES PRINT DCA ASCDIG /START WITH LEADING SPACES DCA DIGIT /CLEAR TAD CNTRZA DCA CNTRZB /SET COUNTER TO FOUR TAD ADDRZA DCA ARROW /SET TABLE POINTER SKP DCA VALUE /SAVE CLL TAD VALUE ARROW, TAD TENPWR /SUBTRACT POWER OF TEN SZL ISZ DIGIT /DEVELOP BCD DIGIT SZL JMP ARROW-3 /LOOP CLA /HAVE BCD DIGIT TAD DIGIT /TAKE CARE OF LEADING ZEROS SNA CLA /SKIP IF NOT ZERO JMP .+3 /MAINTAIN SPACES OR ZERO TAD K260 DCA ASCDIG /CHANGE TO NEUMERIC TAD DIGIT /GET DIGIT TAD ASCDIG /MAKE IT ASCII SMA /NO PRINT IF LEADING ZERO JMS I (PCH /PRINT IT CLA DCA DIGIT /CLEAR ISZ ARROW /UPDATE POINTER ISZ CNTRZB /DONE ALL FOUR? JMP ARROW-1 /NO: CONTINUE TAD ASCDIG /SEE IF ALL SPACES SMA CLA /SKIP IF NO OUTPUT JMP I DECPRN /YES: EXIT TAD K260 JMS I (PCH /PRINT ONE ZERO JMP I DECPRN ADDRZA, TAD TENPWR CNTRZA, -4 TENPWR, -1750 /ONE THOUSAND -0144 /ONE HUNDRED -0012 /TEN -0001 /ONE K260, 260 VALUE, 0 DIGIT, 0 CNTRZB, 0 ASCDIG, 4000 PAGE $$$$$$