	..LIB	= 1
	..L$$	= 1
	.INCLUDE	"QF.MAC"
	.mcall	.rofdf .csigen .ttyout .print .ttinr .Settop 
	.mcall	.serr
	.rofdf
	
.LASM	PUTCH
.LASM	PRINT	ASCIZ.
.LASM	EXTRB	BYTE2.
.LASM	PUSB	BYTE.
.LASM	PUSHB	var.

.LCOD	EXTR0
.LCOD	TTYOUT	BYTE.

.lcod	SHOW 
.lasm	P$PAR	byte.
.lasm	PUTDUp	byte.
.lcod	NOINVERS
.lcod	INVERSe
.lasm	DECOD
.lasm	CURON
.lcod	CUROFF
.lasm	COLON	byte.
.lasm	ADDBS
.lcod	cursor	byte.
.lcod	author
.lasm	do	byte.
.lasm	enddo
.lcod	clr$R
.lcod	clr$M
.lcod	clr$D
.lcod	list$D
.lcod	subscr
.lcod	nosubscr
.lcod	ret$m2
.lcod	ed$cur

.macro	mput	addr
	TRAP	2
	.word	addr
.endm
.macro	mwait
	trap	1
.endm
.macro	strmenu	str
.ascii	`str`<200>
.endm

	.psect	.data
r$side:	.byte	0,10
tdev:	.blkb	1
ndev:	.blkb	1
trck:	.blkb	1
sect:	.blkb	1
cpadr:	.blkw	1
nwrd:	.blkw	1
write2:	.byte	0,20,1
w2ndev:	.blkb	1
w2trck:	.blkb	1
	.byte	1
w2adr:	.blkw	1
	.word	10.*400
	.psect	.prog

frmcyl::
	mput	execute
	mwait
f..cmd:	return
	clrb	write2
	mput	write2
	mwait
	tstb	write2
	beq	1$
	movb	write2,@#0
1$:	mov	#207,f..cmd
	return
r$area:
	movb	drive,ndev
	movb	track,trck
	clrb	r$side
	movb	#1,sect
	mov	#memcpu,cpadr
	mov	#10.*400,nwrd	; читаем дорожку
	cmp	c$cyl,precyl	; Если тот же цилиндр - не читать
	beq	t1
	mput	r$side
	Trap	4		; ^C^C ?
	.forth
	cursor	<21.,12.>
	print
	.byte	33,'K,200
	cursor	<21.,74.>
	ttyout	'є
	cursor	<10.,45.>
	print
	.ascii	/Чтение дорожки/
	.byte	33,'K,200
	cursor	<10.,74.>
	ttyout	'є
;	cursor	<12.,45.>
;	print	< Формат :>
	cursor	<12.,58.>
	print	<Чтение>
	.quit
;	call	l.trk
	mwait
	mov	c$cyl,(pc)+
precyl:	.blkw	1
t1:	tstb	r$side		; Как прочитали дорожку ?
	bne	50$		; Ошибка - прочитаем по сектору
f.cont=:.+2
	tst	#0		; Какой saveformat ?
	beq	100$		; Полный - продолжим
	sec
	return
50$:	mov	#400,nwrd	; читаем 1 сектор
1$:
	mov	#5.,r4
3$:	mput	r$side
	Trap	4		; ^C^C ?
	mwait
	tstb	r$side
	beq	4$
	sob	r4,3$
	.forth
	cursor	<21.,16.>
	print	<Ошибка чтения сектора N# >
	.quit
	movb	sect,r0
	call	putint
	mov	#240,retcmd
	jsr	r0,errmen
	.word	er.prc
	.ttinr
	bcc	.-2
retcmd=:.
	.blkw	1
4$:	add	#1000,cpadr
	incb	sect
	cmpb	sect,#10.
	ble	1$
100$:
	mov	#memcpu,r0
sortir::			; расстановка секторов
	movb	drive,w2ndev
	movb	track,w2trck
	mov	r0,w2adr
	mov	#240,f..cmd
	trap	0
	mov	buff,r5
	asl	r5
	mov	#10.,r4		; Счетчик исх. секторов
1$:	mov	#10.,r3
2$:	cmpb	r4,subsec-1(r3)	; Ищем, куда копировать
	beq	4$
	sob	r3,2$
	br	10$		; Не нашли...
4$:	mov	r4,r2
	dec	r2		; 1..10 -> 0..9
	dec	r3
	ashc	#9.,r2
	add	r0,r2		; Откуда
	add	r5,r3		; Куда
	mov	#400,r1
	mov	(r2)+,(r3)+
	sob	r1,.-2
10$:	sob	r4,1$
	clc
	return
r.file:
	trap	0
	call	cc$r1

	mov	r1,r5
	mul	#10.,r1
	cmp	r1,lenfil
	blt	2$
	jmp	genare
2$:	mov	(pc)+,r1	; N первого цилиндра в буфере
b1cyl:	.blkw	1
	cmp	r5,r1
	blt	2$
1$:	add	cyls,r1		; N последнего цилиндра в буфере + 1
	cmp	r5,r1
	blt	3$
2$:	call	readbf
3$:
	sub	b1cyl,r5	; Смещение в цилиндрах в буфере
	mul	#10.*1000,r5	; Смещение в байтах
	add	memdwn,r5
	mov	r5,r0
	br	sortir

	.psect	.data
er.prc:	.word	r.new,r.ret,r.ign,r.brk
	.psect	.prog
r.new:	movb	#1,sect
	jmp	new
r.brk:	mov	sp,c$cyl
	mov	#207,retcmd
r.ret:	decb	sect
	sub	#1000,cpadr
r.ign:	sec
	return

	
sf0::	clr	r1
sf1::	mov	r1,f.cont
	mov	sp,precyl
	mov	#memcpu+<10.*400.>,r1
	call	settop
	bcc	1$
	return
1$:
	mov	#2,repeat
	mov	#r$area,genprc
	trap	0
	call	bounds
	.forth
	clr$D
	clr$R
	cursor	<10.,37.>
	print	<Восстановление диска на>
	.quit
;	jsr	r2,a$parm
;	.word	no$up
	call	clc.up
	movb	(r5),r0
	incb	r0
	movb	r0,tdev
	jmp	quest

	.psect	.data
devext:	.rad50	/DSK/
	.word	0,0,0
	.word	interr
	.word	interr
	.word	interr
	.word	interr
	.word	interr
	.word	interr
	.word	direrr,no.dev,interr
csierr:	.word	illcmd,no.dev,interr,interr,no.fil
cstat$:	.byte	3,27
	.word	disk
	.psect	.strn
illcmd:	.asciz	/Синт. ошибка/
no.dev:	.asciz	/Нет устройства/
no.fil:	.asciz	/Нет файла/
direrr:	.asciz	/Ошибка чтения каталога/
	.psect	.prog

f$copy::
	mov	#2,repeat
; ╣╣╣╣╣╣╣╣╣ Захват памяти в ЦП ╣╣╣╣╣╣╣╣╣╣╣╣╣╣
	trap	0
	mov	@#sysptr,r0
	bit	#^b1000000000,config(r0)	; ? USR is NoSwap
	beq	3$
	mov	$usrlc(r0),r0
	tst	-(r0)
3$:	.settop
	mov	r0,memtop
	mov	#r.file,genprc
	mov	#-300,b1cyl		; В буфере ничего нет !!!
	jsr	r2,a$parm
	.word	fnam	
	mov	#600,r4
	mov	#labvol-fnam,r0
5$:	movb	(r5)+,(r4)+
	sob	r0,5$
7$:	mov	#600,r5
	jsr	r2,str$ed
	.byte	labvol-fnam
	.byte	-1
	.byte	12.,40.
	.byte	0
	.asciz	/FCopy из :/
	.even
	bcc	10$
99$:	jmp	tomenu
10$:	call	bounds
	.serr
	mov	#600,r1
	mov	r1,r4
	mov	#labvol-fnam,r0
11$:	cmpb	(r1)+,#40
	beq	12$
	sob	r0,11$
	inc	r1
12$:	clrb	-(r1)
	.csigen	memdwn,#devext,r4
	bcc	4$		; Без ошибок - уйдем дальше
	.forth
	curoff
	cursor	<14.,40.>
	print
	.ascii	/?CSI-E-/<7><200>
	.quit
	movb	@#52,r0
	asl	r0
	.print	csierr(r0)
77$:	trap	3
	br	7$
4$:				; Повытаскиваем ключи
	mov	(sp)+,r1
	beq	40$
14$:	asl	(sp)+
	adc	r1
	sob	r1,14$	
40$:
	mov	r0,memdwn	; Нижняя граница динамич. буфера
	mov	#cstat$,r0
	emt	375		; .cstat на #DISK
	bcc	41$
	.forth
	curoff
	cursor	<14.,40.>
	print
	.ascii	/Не указано имя файла/<7><200>
	.quit
	br	77$
41$:	mov	(pc)+,r1
memtop:	.blkw	1
	sub	memdwn,r1	; r1 - размер буфера в байтах
	ash	#-9.,r1		; r1 - размер буфера в блоках
	clr	r0
	div	#10.,r0		; r0 - размер буфера в цилиндрах
	mov	r0,(pc)+
cyls:	.blkw	1		; размер буфера в цилиндрах
	ble	nomem
	mov	disk+4,(pc)+
lenfil:	.blkw	1
	tst	disk+2
	bne	10$		; Это файл
	mov	#disk+12,r0	; disk+12 - Имя устройства в rad50
	mov	#disk+14,-(sp)	; disk+14 - area для .dstatus
	emt	342
	mov	disk+14+6,lenfil; Размер устройства в блоках
	asrb	disk+15		; Разрешен .spfun 373 ?
	bcc	10$
	mov	#spfun,r0
	emt	375
10$:	jmp	frmdsk
	.psect	.data
spfun:	.byte	3,32
	.word	0,lenfil,1
	.byte	377,373
	.word	0
	.psect	.prog
settop::
	.settop	r1
	cmp	r0,r1
	bhis	$$1$
nomem:	.forth
	clr$D
	clr$R
	cursor	<11.,40.>
	print
	.ascii	/?FMZ-E-Нет памяти в ЦП/<7><200>
	.quit
	trap	3
	sec
$$1$:	rts	pc

	.psect	.data
reabuf:	.byte	3,10
blk$$:	.blkw	1
buf$$:
memdwn:	.word	memcpu
wcnt$$:	.blkw	1
	.word	0
	.psect	.prog
readbf:
	trap	0
	.forth
	cursor	<10.,45.>
	print	<Чтение  буфера>
	.quit
	call	cc$r1
	mov	r1,b1cyl
	mul	#10.,r1
	mov	r1,blk$$

	mov	r1,r2		; Начальный блок
	mov	cyls,r5
	mul	#10.,r5
	add	r5,r1
	cmp	r1,lenfil
	blt	2$
	mov	lenfil,r5
	sub	r2,r5
2$:	swab	r5
	mov	r5,wcnt$$
	mwait
	mov	#reabuf,r0
	emt	375		; .readw
	bcc	$$1$
	mov	#400,wcnt$$	; Перейдем к поблочному чтению
	mov	buf$$,-(sp)
	mov	#240,r.abo
	mov	cyls,r5
	mul	#10.,r5
.5$:	mov	#3,r4
6$:	mov	#reabuf,r0
	emt	375		; .readw
	bcc	7$
	sob	r4,6$
	.forth
	cursor	<21.,16.>
	print	<Ошибка чтения блока N# >
	.quit
	mov	blk$$,r0
	mov	#5,siz$$
	call	putint
	mov	#3,siz$$
	jsr	r0,errmen
	.word	er.rbf
	.ttinr
	bcc	.-2
7$:	add	#1000,buf$$
	inc	blk$$
r.abo:	.blkw	1
	sob	r5,.5$
	mov	(sp)+,buf$$
	return

	.psect	.data
er.rbf:	.word	rb.new,rb.ret,rb.ign,rb.brk
	.psect	.prog

rb.new:	call	new
	br	tmp1
rb.brk:	mov	sp,c$cyl
tmp1:	mov	#5727,r.abo	; tst (pc)+
rb.ret:	sub	#1000,buf$$
	dec	blk$$

rb.ign:	sec
	return
cc$r1:
	mov	c$cyl,r1
;	jsr	r2,a$parm
;	.word	no$up
;	tstb	(r5)
;	bne	1$
	call	clc.up
	bcc	1$
	asr	r1
1$:	return


	.end
                                                                                                                                                                                                                                       