..LIB	= 1
	..L$$	= 1
	.INCLUDE	"QF.MAC"

	.mcall		 .ttyout .print .ttinr  ; .rofdf
;	.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	.prog
.asm	dupr2	BYTE.
	movb	(r5)+,r0
1$:	movb	(r5),(r2)+	
	sob	r0,1$
brk$1:	inc	r5
	end.
.asm	strr2	asciz.
1$:	bitb	#177,(r5)
	beq	brk$1
	movb	(r5)+,(r2)+
	br	1$

	.RESTORE
	ISASM	= TRUE
	
.cod	nextr2
	dupr2	<1,40>
	dupr2	<1,'=>
	dupr2	<8.,40>
	end.
	.rem %
	.psect	.strn
	.ascii	/****************/
	.ascii	/****************/
	.ascii	/****************/
	.ascii	/****************/
	.ascii	/                /
	.ascii	/   FMZ V03.02   /
	.ascii	/                /
	.ascii	/ Track  =       /
	.ascii	/ Side   =       /
	.ascii	/ AbsPos =       /
	.ascii	/ Sector =       /
	.ascii	/ Block  =       /
	.ascii	/                /
	.ascii	/****************/
	.ascii	/****************/
	.ascii	/****************/
	%
.cod	MZnum
	pushb	curdev
	print	< MZ>
	pusb	'0
	addbs
	putch
	ttyout	':
	end.
	.psect	.prog
m$copy:	
	mov	r2,r4
	add	(r3)+,r4	; offset
	mov	(r3)+,r1	; adress
	mov	(r3),r3		; NWORDS
1$:	mov	(r1)+,(r4)+	; copy
	sob	r3,1$
	tst	(sp)+
	mov	(sp)+,r3
	add	#1000,r2
2$:	cmp	r4,r2
	bhis	3$
	mov	#^rNIL,(r4)+
	br	2$
3$:	return
	.psect	.data
b1.1:
	.WORD	0	;ADRESS
	.WORD	4	;WCNT
	.WORD	0,170000,7777,unicum

	.WORD	700
	.WORD	1
	.WORD	177777

	.WORD	210
	.WORD	11.
	.WORD	1,0,14,1000,54137,23364,136642,3065
	.WORD	0,7123,4000

	.WORD	722
	.WORD	3.
	.WORD	1,6,107123

	.word	-1		; end table
b1.5:	
	.ascii	/FMZ  Oleg H./
	.word	0,0

DIR:	.WORD	3,0,1,0
blk$1:	.word	14,1000
	.RAD50	"NEWFIL MZ"
d$SIZE:	.blkw	2
c.date::
	.word	0,4000
e$dir:
	.psect	.prog
	; r2 - Адрес блока
	; r0 - номер блока
genblk::
	mov	r3,-(sp)
	call	l$blk
	tst	r3
	bne	10$
	jsr	r3,m$copy		; Emulator boot
	.word	0, EmBoot,EmSize/2	; offset addr nwords 
10$:	dec	r3			; 1-й блок
	bne	20$

	mov	r2,r1
	mov	#400,r3
	clr	(r1)+
	sob	r3,.-2
	mov	#b1.1,r1
11$:	mov	(r1)+,r5		; offset
	bmi	12$
	add	r2,r5
	mov	(r1)+,r4		; nwrd
	mov	(r1)+,(r5)+
	sob	r4,.-2
	br	11$
12$:	jsr	r2,a$parm
	.word	labvol
	mov	r2,r3
	add	#730,r3
	mov	#24.,r1
	movb	(r5)+,(r3)+
	sob	r1,.-2
	
	jsr	r3,m$copy		;
	.word	760,b1.5,8.

20$:	cmp	r3,#6-1
	bne	30$
		; 6-й блок - каталог
	jsr	r2,a$parm
	.word	segdir
	movb	(r5),r4
	mov	r4,dir
	asl	r4	;  Сколько блоков займет каталог
	add	#6.,r4
	mov	r4,blk$1	; Откуда нач. файлы
	jsr	r2,a$parm
	.word	ntrk
	movb	(r5),r3
	mul	#10.,r3
	jsr	r2,a$parm
	.word	no$up
	tstb	(r5)
	beq	22$
	asl	r3
22$:	sub	r4,r3
	mov	r3,d$size
	jsr	r3,m$copy		; Directory
	.word	0,dir,E$dir-dir/2

30$:	mov	(sp)+,r3
	.forth
	dupr2	<64.,^B01100110>
	dupr2	<19.,40>
	strr2	<FMZ V03.02>
	dupr2	<20.,40>
	strr2	<Track >
	nextr2
	strr2	<Side  >
	nextr2
	strr2	<AbsPos>
	nextr2
	strr2	<Sector>
	nextr2
	strr2	<Block >
	nextr2
	dupr2	<15.,40>
	dupr2	<48.,^B01100110>
	.quit
	
	mov	r2,r0
	mov	r2,-(sp)
	sub	#400-172,r0	; Указ. на параметр track
	mov	#5.,r5
1$:
	mov	r5,r1
	asl	r1
	call	@t$lst-2(r1)
	mov	#5.,r1		; field size
	call	utoa
	movb	#40,4(r0)
	add	#20,r0		; к след. параметру
	sob	r5,1$
	mov	(sp)+,r2
	mov	#200,r0
4$:	mov	#^B0011001100110011,(r2)+
	sob	r0,4$
	return
	.psect	.data
t$lst:	.word	l$blk,l$sec,l$abs,l$sid,l$trck
	.psect	.prog
l$trck:
	movb	track,r3
	return
l$sid:	clr	r3
	bisb	drive,r3	; Старший байт - 0 
	ash	#-7,r3		; 200 -> 1
	return
l$abs:	mov	cblk,r3
	return
l$sec:
	mov	cblk,r3
	movb	subsec-1(r3),r3
	return
l$blk:	movb	track,r1
	mul	#20.,r1
	tstb	drive		; Если верх, то +10.
	bpl	1$
	add	#10.,r1
1$:	call	l$sec
	add	r1,r3
	dec	r3	
ret$:	return

genare::
	trap	0
	mov	buff,r2
	asl	r2
	clr	(pc)+
cblk:	.blkw	1
1$:	inc	cblk
	cmp	cblk,#10.
	bgt	ret$
	call	genblk
	br	1$

listrk:	; вывод номера дорожки и поверхности
	.forth
	cursor	<12.,55.>
	.quit
l.trk::	mov	c$cyl,r0
	clr	r4
	asr	r0
	rol	r4
	call	putint
	asl	r4
	.print	strtab(r4)
1$:	return

ifnoup:
	mov	c$cyl,r0	; set current cylinder
	bit	#1,r0		; Четная дор. - выполнить
	beq	1$
	jsr	r2,a$parm
	.word	no$up
	tstb	(r5)
	beq	2$		; Нет верхней стороны - пропустить
1$:	tst	(pc)+
2$:	sec
	return
	; При входе из меню r1 гарантировано не NULL
q$disk::
	clr	r1
	br	.13$
f$disk::
	mov	#3,r1
.13$:	mov	r1,repeat
	mov	#genare,genprc
	trap	0
	call	bounds
	.forth
	clr$D
	clr$R
	cursor	<10.,36.>
	print	<Форматирование устройства>
	.quit
quest::	
	.forth
	MZnum
	cursor	<13.,45.>
	subscr
	print	<Вы уверены ?>
	nosubscr
	cursor	<19.,7.>
	print	<Y, D - Продолжить>
	cursor	<20.,7.>
	print
	.asciz	<224>/    - Отказаться/
	.quit
nextdi:
	trap	3
	cmpb	r0,#'Y
	beq	frmdsk
	cmpb	r0,#'D
	beq	frmdsk
tomenu::
	mput	restMZ
	.forth
	curoff
	ret$m2
	.quit
	return
bounds::
	clr	(pc)+
s$cyl:	.blkw	1		; start cylinder
	jsr	r2,a$parm
	.word	ntrk
	movb	(r5),r5
	asl	r5
	mov	r5,(pc)+
e$cyl:	.blkw	1		; end cylinder
	return
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
f$area::
	trap	0
	mov	#2,repeat	; Не спрашивать след. диска
	.forth
	clr$R
	cursor	<8.,36.>
	print	<Привод>
	putdup	<11.,40>
	print	<сторонний>
	cursor	<9.,29.>
	ttyout	'╠
	putdup	<44.,'╨>
	ttyout	'╩
	cursor	<10.,51.>
	print	<Укажите область>
	cursor	<11.,29.>
	ttyout	'╔
	putdup	<44.,'╣>
	ttyout	'═
	cursor	<13.,29.>
	ttyout	'╔
	putdup	<44.,'╣>
	ttyout	'═
	cursor	<14.,32.>
	print	<Дорожка>
	cursor	<15.,32.>
	print	<Блок>
	cursor	<11.,45.>
	colon	<1,'╚>
	colon	<4.,'╥>
	ttyout	'║
	clr$D
	.quit
	trap	3
	
	jmp	tomenu
.rem %
	mov	#genare,genprc
	mov	#600,r5
	clr	(r5)
	jsr	r2,str$ed
	.byte	7
	.byte	-1
	.byte	12.,34.
	.byte	0
	.asciz	/Задайте границы области НД-КД :/
	.even
	bcs	tomenu
	call	bounds
	sub	#2,e$cyl	; "Прекоррекция"
	mov	#2,repeat	; Не спрашивать след. диска
	mov	#7.,r4		; макс. длина строки
	mov	#600,r5
	jsr	r3,a$i
	.word	s$cyl
	beq	10$
	mov	s$cyl,e$cyl
	bne	10$
	cmpb	600,#'0
	bne	tomenu
10$:	jsr	r3,a$i
	.word	e$cyl
	add	#2,e$cyl
	cmp	s$cyl,e$cyl
	bhi	tomenu
	.forth
	curoff
	clr$D
	.quit
%	
frmdsk::
	clr	(pc)+
numbad:	.blkw	1		; number on bad block
	.forth
	curoff
	clr$D
	clr$R
	cursor	<10.,46.>
	print	<Форматирование>
	cursor	<12.,45.>
	print	<Дорожка : разгон>
	.quit
	.ttinr
	bcc	.-2
	mput	unhead
	mput	slowMZ
	call	new	; Установим нач. значения
nextcl:	
	call	ifnoup
	bcs	11$	; Нет верхней стороны - пропустить
	call	setprm
	clrb	@#0
genprc == :.+2 
	call	@#-1	;////////////////
	bcs	20$
	call	listrk
;	mput	execute
;	mwait
	call	frmcyl
	jsr	r2,e$proc
	.word	0
	bcc	to$nxt
11$:	mov	c$cyl,r1	; Только что сформатировали верх ?
	asr	r1
	bcc	20$		; Нет - перейдем к верх. стороне
				; Контрольное чтение
	tst	repeat
	beq	20$
	movb	r1,trk$
	mov	#<19.*400>+1,nw$rd
	jsr	r2,a$parm
	.word	no$up
	movb	(r5),typdr$
	bne	1$
	asr	nw$rd
1$:	incb	typdr$
	movb	curdev,drive$
	clrb	mptst
	.forth
	cursor	<12.,58.>
	print	<Тест>
	.quit
	mput	mptst
	mwait
	jsr	r2,e$proc
	.word	mptst
	bcc	to$nxt
20$:	inc	(pc)+
c$cyl::	.blkw	1

to$nxt:	cmp	c$cyl,e$cyl
	blo	nextcl
	cmp	c$cyl,pc
	bhis	1$
	cmp	repeat,#2
	bne	2$
1$:	jmp	tomenu
2$:	.forth
	cursor	<12.,40.>
	print	<Повторить фоматирование ?>
	cursor	<10.,40.>
	print	<Емкость диска>
	putdup	<6,40>
	print	<блоков>
	cursor	<10.,54.>
	.quit
	mov	d$size,r0
	mov	#5.,siz$$
	call	putint
	mov	#3.,siz$$
	tst	numbad
	beq	3$
	call	wribad
3$:	jmp	nextdi

	.psect	.data
mptst:	.byte	0,10
typdr$:	.blkb	1
drive$:	.blkb	1
trk$:	.blkb	1
	.byte	1
	.word	buf$wr
nw$rd:	.blkw	1

strtab:	.word	t1,t2
	.psect	.strn
t1:	.asciz	/ Низ /
t2:	.asciz	/ Верх/
	.psect	.prog

e$proc:
	movb	@(r2)+,r0
	bne	2$
	.ttinr
	bcc	1$
	rts	r2
1$:	clr	r0
2$:
	mov	r0,r5
	beq	4$
	bic	#1,c$cyl
	.forth
	cursor	<14.,47.>
	print	<Сбоев : >
	.quit
errcou = :.+2	
	inc	#0
	mov	errcou,r0
	call	putint
	mov	c$cyl,r1
	asr	r1
	cmp	r1,c..trk
	beq	23$	; Та же дорожка
	clr	rept.c
c..trk = :.+2
	mov	r1,#-1
rept.c = :.+2
23$:	inc	#0
repeat == :.+4
	cmp	rept.c,#0
	bhi	25$
	rts	r2
25$:
	.forth
	cursor	<20.,20.>
	print
	.ascii	<7>/Аппаратная ошибка N# /<200>
	.quit
	mov	r5,r4
	mov	#3,r1

3$:	mov	r4,r0
	ash	#-6,r0
	bic	#^c7,r0
	bis	#'0,r0
	.ttyout
	ash	#3,r4
	sob	r1,3$

	cmp	r5,#100
	blt	4$
	mov	#3,r5
4$:	asl	r5
	.forth
	cursor	<21.,5.>
	.quit
	mov	t$err(r5),r1
	clr	r4
5$:	cmpb	(r1)+,#200
	beq	6$
	sob	r4,5$
6$:	add	#54.,r4
	asr	r4
7$:	trap	5
	.word	40
	sob	r4,7$
	.print	t$err(r5)

	mov	#261,sec$	; Поставим SEC
	jsr	r0,errmen
	.word	err$pr

	.ttinr
	bcc	.-2
sec$:	.blkw	1
	rts	r2
errmen::
	mov	(r0)+,9$
	mov	r0,(sp)
	.forth
	cursor	<18.,59.>
	colon	<1,'╚>
	colon	<4,'╥>
	ttyout	'╢
	.quit
	clr	l..r
8$:	jsr	r1,intmen
	.word	err$m
9$:	.blkw	1
	tst	r0
	bne	10$
	call	abort
10$:	mov	sp,l..r
	mov	#work$P,ptr$c
	.forth
	cursor	<18.,59.>
	ttyout	'╣
	cursor	<23.,59.>
	ttyout	'╨
	clr$M
	clr$D
	.quit
	return
	
	.psect	.data
t$err:	.word	key$p,dat,pbl,a$mark,d$mark,no$sec,no$wri
	.word	no0trk,notrk,interr,interr,interr,noind
err$pr:	.word	new,rept,ignore,abort
	.psect	.strn
key$p:	.ascii	/Вмешательство оператора/<200>
dat:	.ascii	/Ошибка кода данных/<200>
pbl:	.ascii	/Ошибка кода заголовка/<200>
a$mark:	.ascii	/Нет адресного маркера/<200>
d$mark:	.ascii	/Нет маркера данных/<200>
no$sec:	.ascii	/Сектор не найден/<200>
no$wri:	.ascii	/Запрет записи/<200>
no0trk:	.ascii	/Нет выхода на 0 дорожку/<200>
notrk:	.ascii	/Дорожка не найдена/<200>
interr::.ascii	/Внутренняя ошибка/<200>
noind:	.ascii	/Не найден индекс/<200>

		; y  x  len na pos
err$m:	.byte	19.,60.,14.,^c3,1
	strmenu	<Сначала>
	strmenu	<Начать операцию сначала>
	strmenu	<Повторить>
	strmenu	<Попытаться еще раз>
	strmenu	<Игнорировать>
	strmenu	<Игнорировать ошибку и продолжить работу>
	strmenu	<Прервать>
	strmenu	<Прекратить операцию>
;/////////////////
	.psect	.prog
ignore:	cmp	repeat,#3
	bne	100$		; Не надо расставлять bad-блоки
	call	setbad	
100$:	add	#2,c$cyl
	br	e$clc
new::	.forth
	cursor	<14.,46.>
	putdup	<15.,40>
	.quit
	mov	s$cyl,c$cyl
	clr	errcou
	clr	numbad
	br	e$clc
abort::	mov	sp,c$cyl
rept:
e$clc:	mov	#241,sec$	; clc вместо sec
	sec
	return

a$i:
	clr	r1
1$:	movb	(r5)+,r0
	sub	#'0,r0
	bmi	8$
	cmp	r0,#9.
	bgt	8$
	mul	#10.,r1
	add	r0,r1
	sob	r4,1$
	br	9$	
8$:
	cmp	r0,#40-'0
	beq	1$
	asl	r1
	beq	9$
	mov	r1,@(r3)
9$:	tst	(r3)+
	cmp	r0,#'--'0
	rts	r3
setbad:
	trap	0
	.forth
	clr$M
	cursor	<17.,25.>
	inverse
	print	< Идет сканирование BAD-блоков >
	noinverse
	.quit
	cmp	numbad,#35.
	bgt	300$
	movb	curdev,bndev
	mov	c$cyl,r3
	asr	r3
	movb	r3,btrck
	mov	#10.,r2		; Сколько секторов на дорожке
	mul	r2<r3		; Номер блока
	jsr	r2,a$parm
	.word	no$up
	movb	(r5),btdev
	beq	1$		; Диск односторонний
	ashc	#1,r2		; Для 2-х стор. - *2 
1$:	incb	btdev
	mov	r2,r5
2$:	clr	r4		; Номер сектора
3$:	inc	r4
	cmp	r4,#10.
	ble	5$
	bisb	#200,bndev
	br	2$
5$:	movb	r4,bsect
	clrb	r$bad
	mput	r$bad
	mwait
	tstb	r$bad
	beq	100$
	mov	r5,r1		; 20 или 10 - кол. секторов
	sub	r2,r1		; В каком секторе на дор. ошибка
	add	r3,r1		; В каком секторе на диске ошибка
	mov	numbad,r0
	movb	#1,memcpu-2000+100.(r0)
	asl	r0
;!!!!	mov	b1,memcpu-2000(r0)	; nblk
	tst	r0
	beq	50$			; Первый bad-блок
	sub	memcpu-2000-2(r0),r1
	asr	r0
	clr	-(sp)
	bisb	memcpu-2000+100.-1(r0),(sp)
	cmp	r1,(sp)+
	bgt	50$
	incb	memcpu-2000+100.-1(r0)
	br	100$
50$:	inc	numbad
100$:	sb	r2,3$
300$:	return

wribad:	trap	0
	mput	restMZ
	movb	curdev,wndev
	jsr	r2,a$parm
	.word	no$up
	movb	(r5),wtdev
	incb	wtdev
	mov	#dir,r5
	mov	#buf$wr,r4
	mov	#5,r1
	mov	(r5)+,(r4)+
	sob	r1,.-2
	clr	r5
	add	blk$1,d$size
1$:	mov	r5,r0
	asl	r0
	mov	memcpu-2000(r0),r1	; Позиция bad-области
	mov	r1,lenemp
	sub	blk$1,lenemp
	movb	memcpu-2000+100.(r5),r2	; Размер bad-области
	mov	r2,lenbad
	add	r2,r1
	mov	r1,blk$1
	mov	#<end$fb-filbad>/2,r2
	mov	#filbad,r3
	mov	(r3)+,(r4)+
	sob	r2,.=2
	inc	r5
	cmp	r5,numbad
	blt	1$
	sub	blk$1,d$size
	mov	d$size,lenemp
	mov	#filbad,r3
	mov	#<dat.1+2-filbad>/2,r2
	mov	(r3)+,(r4)+
	sob	r2,.-2
	mov	#4000,(r4)		; Конец каталога
	mov	#5,r3
3$:	clrb	w$bad
	mput	w$bad
	mwait
	tstb	w$bad
	beq	4$
	sob	r3,3$
4$:	return
;	.globl	memcpu
;	badpos = memcpu - 2000
;	badsiz = badpos + 50.

	.psect	.data
filbad:	.word	1000	; Пустая область
	.rad50	/EMPTY ARE/
lenemp:	.blkw	2
dat.1::	.blkw	1
	.word	2000	; BAD-файл
	.rad50	/file  bad/
lenbad:	.blkw	2
dat.2::	.blkw	1
end$fb:

w$bad:	.byte	0,20
wtdev:	.blkb	1
wndev:	.blkb	1
	.byte	0	; track 0
	.byte	7
	.word	buf$wr
	.word	400

r$bad:	.byte	0,10
btdev:	.blkb	1
bndev:	.blkb	1
btrck:	.blkb	1
bsect:	.blkb	1
	.word	buf$rd
	.word	1

	.end