/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=30 LXR=14 NM1=31 NM2=NM1+1;NM3=NM2+1;NM4=NM3+1 SYSTEM=25 TEMP1=21 TEMP2=22 TM1=23 TMP1=24 /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 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 SLFWST /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 $$$$$$