Directory of image this file is from
This file as a plain text file

/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 <VERYSAFE=0>

/FOR NO SECURITY AT ALL DEFINE SQSAFELY=0

	IFNZRO VERYSAFE <SQSAFELY=1>
	IFNDEF SQSAFELY <SQSAFELY=1>

/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 <SYSOK=1>

/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
	$$$$$$