" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1982 *
" *                                                         *
" ***********************************************************
" prog to test multics storage devices
" args are:
" device address range as in save and restor
" PATERN 1 to 4 octal words
" CHECK to read and check pattern
" WRITE to write pattern or marks
" MARK to read or write each record with its addr
" REWRIT to rewrite error records
" default will read but not check data


	name	test


"  ******************************************************
"  *                                                    *
"  *                                                    *
"  * Copyright (c) 1972 by Massachusetts Institute of   *
"  * Technology and Honeywell Information Systems, Inc. *
"  *                                                    *
"  *                                                    *
"  ******************************************************

	bool	bsize,40000	buffer size


	include	bosequ

" 
	stx2	x2
	tsx2	init_io
	tsx2	ttyinit		get tty requests
	arg	ttyrequest

	eaa	bsize		make buffer
	tsx2	makesdw		following this program
	 tra	x2		core clobbering considerations
	staq	ds|tmp*2+1	..
	cams

	ldx2	x2		get command line and scan it ourselves
	lxl7	mem|0,2
	eax6	0
odd;	rpd	14,1
	lda	mem|0,7
	sta	line,6

	tsx2	scan		now scan to get dec numbers too

	eax0	1		start arg scan
	tsx2	argmul		look at partition card
	tra	x2		error
	eax1	0,0		place arg index in X1

arglp:	lda	arg,1
	eax7	0
	rpt	nargtab/2,2,tze
	cmpa	argtab,7		search for parameter
	ttn	arger
	xec	-1,7		execute table entry
nxtarg:	eax1	1,1		step to next arg
	tra	arglp

argtab:
	bci	' check'
	stc1	checksw
	bci	'  mark'
	stc1	marksw
	bci	' write'
	stc1	writsw
	bci	'rewrit'
	stc1	rewritsw
	bci	' brief'
	stc1	disk_brief,*
	bci	'patern'
	tra	argpatern
	oct	777777777777
	tra	argend

	equ	nargtab,*-argtab


argpatern:eax1	1,1		here to fetch pattern
	lda	arg,1
	cana	=o770000,du	check for alpha
	tze	*+3
	cmpa	darg,1
	tze	arglp		if no more numbers
	sta	patern
	sta	patern+1
	sta	patern+2
	sta	patern+3

	eax1	1,1		if two, use for every other
	lda	arg,1
	cana	=o770000,du	check for alpha
	tze	*+3
	cmpa	darg,1
	tze	arglp		if no more numbers
	sta	patern+1
	sta	patern+3

	eax1	1,1		if three, use first twice
	lda	arg,1
	cana	=o770000,du	check for alpha
	tze	*+3
	cmpa	darg,1
	tze	arglp		if no more numbers
	sta	patern+2

	eax1	1,1		if four, use each once
	lda	arg,1
	cana	=o770000,du	check for alpha
	tze	*+3
	cmpa	darg,1
	tze	arglp		if no more numbers
	sta	patern+3

	tra	nxtarg

arger:	tsx2	erpt		else, print error
	acc	'^g unknown'	arg unknown
	arg	arg,1
	tra	x2

" 

argend:	szn	writsw		if writing, prepare buffer
	tze	noprime

	tsx2	query_disk	see if disk is storage system volume
	arg	amdvt,*
	tra	x2
	tra	prime		if not, proceed

	tsx2	ask_disk		ask if it can be overwritten
	tra	x2		if not, quit now

prime:	lda	(bsize-4)*4,dl	copy pattern into buffer
cpatern:	mlr	(),(pr,al)
	desc9a	patern,4*4
	desc9a	tmp|0,4*4
	sbla	4*4,dl
	tpl	cpatern

noprime:	lxl0	amdvt,*		Device type in X0.
	anx0	=o17,du		..

l1:	szn	writsw		if reading, clear buffer first
	tnz	noclear

	lda	bsize*4,dl
	mlr	(),(pr,rl),fill(0)
	desc9a	*,0
	desc9a	tmp|0,al
	tra	doio

noclear:	eax7	wdev		set proper procedure
	stx7	iocall

	szn	marksw		if not checking, should we change pattern
	tze	doio

	lda	amdvt,*		Get device type word
	ana	=-1,du		Leave only subsystem data.
	ora	amfirst,*		yes, fill first word of each page
	eax7	0		with did,addr
	sta	tmp|0,7
	ada	=1,dl
	eax7	1024,7
	cmpx7	bsize,du
	tmi	*-4

" 

doio:	ldq	amfirst,*		compute how much we can read
	div	amaxio,*0		can't read past one unit
	neg
	ada	amaxio,*0		number left in unit
	cmpa	(bsize/1024),dl	can't read more than buffer
	tmi	*+2
	lda	(bsize/1024),dl

	eaq	0,al		can't read more than amlast
	qrl	18
	adq	amfirst,*	
	cmpq	amlast,*
	tmoz	not_last
	lda	amlast,*		if attempted, read only to amlast
	sba	amfirst,*	
	ada	1,dl
not_last:
	als	4		scale to bos sizes
	sta	iolen
	tze	iodone

	lda	amfirst,*		convert mul addr to bos addr
	tsx2	mulbos
	arg	amdvt,*
	tra	x2
	stca	iolen,74		store bos addr

	lda	iolen
	tsx2	ioproc
	tra	s64
	tra	iod

s64:	szn	disk_brief,*
	tnz	s64a
	tsx2	erpt
	acc	'start of 64 word i/o'
s64a:	lxl1	iolen		if error, read each 64 words
	anx1	=o7777,du		..

sloop:	lda	iolen
	ana	=o777777770000
	ora	=1,dl
	tsx2	ioproc
	tra	*+2
	tra	sle

	lda	iolen		if error, print multics address
	tsx2	bosmul
	arg	amdvt,*
	tra	*
	sta	sect

	tsx2	erpt
	acc	'error at ^a ^o'
	arg	cvnamla,*0
	arg	sect

	szn	writsw		if reading
	tnz	sle
	szn	rewritsw		and rewriting
	tze	sle

	tsx2	erpt		then rewrite sector
	acc	'rewriting'

	lda	iolen
	ana	=o777777770000
	ora	=1,dl
	tsx2	wdev
	arg	amdvt,*
	arg	tmp|0
	tra	*+1		ignore errors

sle:	lda	=o10000,dl	bump addr
	asa	iolen
	epp1	tmp|64		bump pr to data
	eax1	-1,1
	tnz	sloop

	szn	disk_brief,*
	tnz	e64a
	tsx2	erpt
	acc	'end of 64 word i/o'
e64a:	epbp1	tmp|0		reset pr to base of segment

" 

iod:	szn	checksw		if checking, check data
	tze	iodone

	lda	iolen		if buffer needs checking, get length
	ana	=o7777,dl
	als	6		in words
	eax1	0,al

	szn	marksw		what kind of check should be made
	tze	ckpat		tra to check pattern

	stx1	ckmklim		set limint
	eax1	0
	lda	amdvt,*		Get device type info.
	ana	=-1,du		Leave subsystem data.
	ora	amfirst,*	
	ldq	patern
ckmklp:	cmpa	tmp|0,1
	tze	*+2
	tsx2	cker
	stq	tmp|0,1		make look like regular pattern
	ada	=1,dl		bump addr
	eax1	1024,1
ckmklim:	cmpx1	*,du
	tmi	ckmklp
	ldx1	ckmklim		restor x1

ckpat:	eax1	-2,1
	tmi	iodone
	ldaq	patern+2		check pattern in buffer
	cmpaq	tmp|0,1
	tze	*+2
	tsx2	cker
	eax1	-2,1
	ldaq	patern
	cmpaq	tmp|0,1
	tze	*+2
	tsx2	cker
	tra	ckpat

iodone:	tsx2	check_status	poll for special int on tty
	arg	=0
	tra	*+2
	tra	*+1

	lda	iolen		io done and checked, bum addrs
	ana	=o7777,dl
	arl	4
	asa	amfirst,*	
	lda	amfirst,*		check for being done
	cmpa	amlast,*
	tmoz	l1

" 

ttyrequest:
x2:	eax2	*
	lca	=1,dl		return no command to bos
	tra	mem|1,2

cker:	stx2	ckerx2		subr to print errors found while checking read
	staq	sb		should be
	ldaq	tmp|0,1
	staq	is
	eax7	0,1		get offset
	anx7	=o1777,du
	sxl7	off
	eaa	0,1		and sector number
	arl	18+10
	ada	amfirst,*	
	sta	sect

	tsx2	erpt
	acc	'^o ^o sb ^w ^w is ^w ^w'
	arg	sect
	arg	off
	arg	sb
	arg	sb+1
	arg	is
	arg	is+1
	ldaq	sb		restore aq
ckerx2:	tra	*

sect:	oct	0
off:	oct	0
	even
sb:	oct	0,0
is:	oct	0,0

ioproc:	stx2	iopx2

	tsx2	iocall,*		perform disk I/O
	arg	amdvt,*
	arg	tmp|0
	tra	ioperr

iopx2:	eax2	*
	tra	1,2

ioperr:	ldx2	iopx2		take error return
	tra	0,2

iocall:	arg	rdev

checksw:	oct	0
writsw:	oct	0
rewritsw:	oct	0
marksw:	oct	0
iolen:	oct	0

	even
	bss	patern,4



	include	qdisk

	include	config_cards

" 

	include	fs_vol_label

" 

	include	bos_sdw
	include	bos_tv
	include	bos_common

	end
"
"
"                                          -----------------------------------------------------------
"
"
"
" Historical Background
"
" This edition of the Multics software materials and documentation is provided and donated
" to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. 
" as a contribution to computer science knowledge.  
" This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology,
" Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull
" and Bull HN Information Systems Inc. to the development of this operating system. 
" Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970),
" renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership
" of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for
" managing computer hardware properly and for executing programs. Many subsequent operating systems
" incorporated Multics principles.
" Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., 
" as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. .
"
"                                          -----------------------------------------------------------
"
" Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without
" fee is hereby granted,provided that the below copyright notice and historical background appear in all copies
" and that both the copyright notice and historical background and this permission notice appear in supporting
" documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining
" to distribution of the programs without specific prior written permission.
"    Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc.
"    Copyright 2006 by Bull HN Information Systems Inc.
"    Copyright 2006 by Bull SAS
"    All Rights Reserved
"
"