



		    bootload_0.alm                  11/11/89  1136.5r w 11/11/89  0837.1       23076



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1982 *
" *                                                         *
" ***********************************************************

" BOOTLOAD_0 -- First program to run appended in Bootload Multics
" This program is derived variously from FWLOAD and bootstrap1.
" 10/03/80, W. Olin Sibert
" 04/21/81, Chris Jones
" 1982-06-29 BIM
" 1982-11-17 CAH
" 84-05-17 KPL renamed from bootload_1

	name	bootload_0

	include	bootload_equs
" 
" Here is storage for a stack for calls in the collection 0 environment.
" The Bentry and Breturn macros in bootload_equs.incl.alm manage it,
" using id and di modifiers. Max depth is entry_stack_size.
" The segdef is provided for debuggers.

	equ	entry_stack_size,16

	segdef	entry_stack,entry_stack_ptr

	arg	-1			" make sure no one pops this
entry_stack:
	bss	,entry_stack_size

entry_stack_ptr:
	vfd	18/entry_stack,12/entry_stack_size,6/0
" 
" Here begins the main portion of collection 0 bootload. It basically falls
" through a set of subroutine calls until it is finally done and then
" transfers to bootload_1 to get the environment set up. Most of the real
" work is done outside this program -- bootload_0 is mostly just a driver.

	segdef	begin

begin:
	tsx2	bootload_io$preinit		" make sense of the bootload program

	tsx2	bootload_flagbox$preinit	" Make BOS work with us, not against us.

	tsx2	bootload_faults$init	" Set up fault_vector

	tsx2	bootload_slt_manager$init_slt	" set up an initial SLT,

	tsx2	bootload_io$init		" Set up primitive I/O mechanism

	tsx2	bootload_console$init	" and the console

	tsx2	bootload_loader$init	" we can now initialize it

	tsx2	bootload_tape_fw$boot	" boot tape F/W if needed

	tsx2	bootload_loader$load_collection " Load collection 1.0

	tsx2	bootload_loader$finish	" clean up linkage

	tsx2	bootload_linker$prelink	" snap all the links

" copy bootload_info

	sdbr	bootload_info$bce_dbr

	epbp6	bootload_info$sys_boot_info_ptr,*
	epp5	bootload_info$structure_start	
	lda	bootload_info$structure_size
	als	2			" Convert to character count
	mlr	(pr,rl),(pr,rl)		" Move the contents
	desc9a	pr5|0,al
	desc9a	pr6|0,al

	epplb	bootload_info$lot_ptr,*	" this is the one thing it can't do
	tra	bootload_info$bootload_1_ptr,* " Prepare to go on to the next segment

	end	bootload_0




		    bootload_abs_mode.alm           11/11/89  1136.5rew 11/11/89  0837.1       37701



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1982 *
" *                                                         *
" ***********************************************************
	name	bootload_abs_mode

" Created, from fwload, bootstrap1, and assorted other oddments, on the
"   19th day of October, 1980, W. Olin Sibert.
" Modified April and May, 1981, by Chris Jones for simplified bootloader I/O
" Rewritten October 1982 by C. Hornig
" Modified September 1983 by Keith Loepere for adp and paged segments.
" Modified July 1984 by Keith Loepere to set breakpoint page sentinel.

" This is the first program in bound_bootload_0 to be invoked.
" Its purpose is to get into appending mode and to transfer to bootload_0.
" 
	include	bce_breakpoint_page
	include	bootload_equs
	include	slt
	include	unpaged_page_tables
" 
my_zero:
	lda	0
	ana	=o770000,du
	sta	system_type-*,ic	non-zero for IOX

" clear collection 0 segments to zero

	lda	template_slt_$dseg_absloc+bbl0_absloc
				" clear from dseg begin
clr_loop:	stz	0,al
	ada	1,dl		" on to next
	cmpa	template_slt_$t_slt+slt.free_core_start+bbl0_absloc
	tmi	clr_loop-*,ic	" done?

" Initialize descriptor segment

	szn	system_type-*,ic
	tnz	3,ic
	eax1	template_slt_$dseg+bbl0_absloc
				" X1 -> template dseg
	tra	2,ic
	eax1	template_slt_$adp_dseg+bbl0_absloc

	lxl2	template_slt_$dseg_absloc+bbl0_absloc
				" X2 -> dseg
	lxl3	template_slt_$t_slt+slt.last_sup_seg+bbl0_absloc
	adx3	1,du		" include dseg sdw itself
dseg_sup_loop:
	ldaq	0,x1
	staq	0,x2
	eax1	2,x1
	eax2	2,x2
	eax3	-1,x3
	tnz	dseg_sup_loop-*,ic

	lda	template_slt_$t_slt+slt.first_init_seg+bbl0_absloc
	als	1
	ada	template_slt_$dseg_absloc+bbl0_absloc
	eax2	0,al		" X2 -> init segs in dseg

	lda	template_slt_$t_slt+slt.last_init_seg+bbl0_absloc
	sba	template_slt_$t_slt+slt.first_init_seg+bbl0_absloc
	ada	1,dl
	eax3	0,al
dseg_init_loop:
	ldaq	0,x1
	staq	0,x2
	eax1	2,x1
	eax2	2,x2
	eax3	-1,x3
	tnz	dseg_init_loop-*,ic

" Copy unpaged_page_tables

	szn	system_type-*,ic
	tnz	adp_upt-*,ic

	lxl3	template_slt_$upt+bbl0_absloc+upt.current_length
	eax1	template_slt_$upt+bbl0_absloc	x1 -> upt template
	eax2	upt_absloc			x2 -> upt
	tra	move_upt-*,ic

adp_upt:	lxl3	template_slt_$adp_upt+bbl0_absloc+upt.current_length
	eax1	template_slt_$adp_upt+bbl0_absloc
	eax2	upt_absloc

move_upt:
	ldaq	0,x1
	staq	0,x2
	eax1	2,x1
	eax2	2,x2
	eax3	-2,x3
	tnz	move_upt-*,ic

	szn	system_type-*,ic
	tnz	adp_iupt-*,ic

	lxl3	template_slt_$init_upt+bbl0_absloc+upt.current_length
	eax1	template_slt_$init_upt+bbl0_absloc	x1 -> iupt template
	eax2	iupt_absloc			x2 -> iupt
	tra	move_iupt-*,ic

adp_iupt:	lxl3	template_slt_$adp_init_upt+bbl0_absloc+upt.current_length
	eax1	template_slt_$adp_init_upt+bbl0_absloc
	eax2	iupt_absloc

move_iupt:
	ldaq	0,x1
	staq	0,x2
	eax1	2,x1
	eax2	2,x2
	eax3	-2,x3
	tnz	move_iupt-*,ic

" zero the breakpoint_page

	eax1	bkpt_absloc
	eax2	bkpt_lth
	fld	0,dl
bkpt_loop:
	staq	0,x1
	eax1	2,x1
	eax2	-2,x2
	tnz	bkpt_loop-*,ic

	lda	BKPT_page_sentinel-*,ic	" sentinel into bkpt_page
	sta	bkpt_absloc+bkpt_page.sentinel

	tsx2	initial_prs-*,ic	" fill in the pointer registers

	eax0	*+2		" rel addr in segment of instr after tra
	tra	seg|0,x0		" start appending

" WE ARE NOW IN APPENDING MODE

	tra	bootload_0$begin

BKPT_page_sentinel:
	aci	"bkpt"
" 
"	tsx2	bootload_abs_mode$initial_prs
"
"	This entry loads up the pointer registers.
"
	segdef	initial_prs
initial_prs:
	szn	system_type-*,ic
	tnz	3,ic
	ldbr	template_slt_$dsbr+bbl0_absloc	" load up
	tra	2,ic
	ldbr	template_slt_$adp_dsbr+bbl0_absloc

	epp	ds,template_slt_$dseg_ptr+bbl0_absloc,*
	epp	mb,template_slt_$iom_mailbox_ptr+bbl0_absloc,*
	epp	slt,template_slt_$slt_ptr+bbl0_absloc,*
	epp	nt,template_slt_$name_table_ptr+bbl0_absloc,*
	epp	prb,template_slt_$physical_record_buffer_ptr+bbl0_absloc,*
	epp	seg,template_slt_$bound_bootload_0_ptr+bbl0_absloc,*
	epp	fv,template_slt_$fault_vector_ptr+bbl0_absloc,*
	tra	0,x2

system_type:
	oct	0

	end




		    bootload_console.alm            11/11/89  1136.5rew 11/11/89  0837.1      103239



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1982 *
" *                                                         *
" ***********************************************************

" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"
" BOOTLOAD_CONSOLE 
"
"  console io for collection 0 (bound_bootload_0)
"
"

" HISTORY COMMENTS:
"  1) change(85-09-09,Farley), approve(85-09-09,MCR6979),
"     audit(86-03-04,GDixon), install(86-03-21,MR12.0-1033):
"      Support IMU and FIPS.
"                                                      END HISTORY COMMENTS

	name	bootload_console
"
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
" BIM 1982-08-08
" Modified 830622 for multiple OPC cards, (and consoles)... -E. A. Ranzenbach
" Modified 9/83 for adp by Keith Loepere.
" Modified 840306 for IPC-CONS-2 IDCW I/O... -E. A. Ranzenbach
" Modified June-July 1984 by Paul Farley to get IPC-CONS-2 to work.
" Modified June 1985 by Paul Farley to remove tape mpc reset/mask-connect.

	include	bootload_equs
	include	bootload_cpu_macros
	include_nolist	make_data_macros
	include_nolist	iom_word_macros
	include	console_io_commands
	include	config_deck
	include	config_prph_opc_card
	include	coll0_segnos
	include	system_types
"

"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
"
"	tsx2	bootload_console$write
"	arg	line_to_write
"	arg	length_in_chars
"
"
"	tsx2	bootload_console$write_alert
"
"	tsx2	bootload_console$init	
"
"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""


	mod	16
	bss	pr_save,16
	bss	register_save,8

	segdef	in_bootload_console
	bss	in_bootload_console,1

	macro	Centry
	Bentry	&F1

	macro	&1_return          " redefine
	stz	in_bootload_console
	lreg	register_save
	lpri	pr_save
	Breturn	&<&K,2&[0&;&2&]
&&end

&1:	Bpush
	stc1	in_bootload_console
	sreg	register_save
	spri	pr_save
&end


" WRITE entry begins here

	Centry	write,2

	szn	bootload_info$console_available
	tmi	write.okay
	write_return
write.okay:

	absa_au	0,x2*		" address of the string
	stca	write_ascii_ddcw,70

	lda	1,x2*		" length
	ada	3,dl		" round up
	ars	2                   " divide by 4, console dont unnerstand
				" chars.
	stca	write_ascii_ddcw,03	" bottom 6 bits is tally.

	tsx2	bootload_io$connect
	arg	bootload_info$console_iom_number
	arg	bootload_info$console_channel_number
	arg	write_pcw_ptr,*
	arg	write_dcw_list_ptr,*

	cana	bootload_info$status_mask
	tnz	console_write_error			" x2 destroyed

	write_return

"

" WRITE_NL

	Centry	write_nl
	eax5	0
	tra	nl_alert_common

" WRITE_ALERT entry begins here

	Centry	write_alert
	eax5	1
nl_alert_common:
	szn	bootload_info$console_available
	tmi	write_alert.okay
	write_alert_return

write_alert.okay:
	cmpx5	1,du
	tnz	nl
	tsx2	bootload_io$connect
	arg	bootload_info$console_iom_number
	arg	bootload_info$console_channel_number
	arg	write_alert_pcw_ptr,*
	arg	write_alert_dcw_list_ptr,*

	tra	nl_alert.check_status

nl:
	tsx2	bootload_io$connect
	arg	bootload_info$console_iom_number
	arg	bootload_info$console_channel_number
	arg	write_pcw_ptr,*
	arg	write_nl_dcw_list_ptr,*

nl_alert.check_status:
	cana	bootload_info$status_mask
	tnz	console_write_error			" x2 destroyed

	write_alert_return
"

"
" READ_LINE
"
"	tsx2	bootload_console$read_line
"	arg	buffer_to_read_to
"	arg	length_to_read
"	<return with the goods>

	equ	read_buffer,0
	equ	read_length,1

" We do not set the "in console package" flag.
" thus an error on input will provoke an attempt to
" do output for a message, which might even work.

	Bentry	read_line,2

read_line:
	Bpush
	epp6	read_buffer,x2*
	lda	read_length,x2*

	absa_au	pr6|0		" note the buffer address
	stca	read_line_ddcw,70

	lda	1,x2*		" length (round DOWN)
	ars	2                   " divide by 4, console dont unnerstand
				" chars.
	stca	read_line_ddcw,03	" bottom 6 bits is tally.

REREAD:
	mlr	(),(pr,rl),fill(040)   " clear out buffer
	desc9a	0
	desc9a	pr6|0,al

	tsx2	bootload_io$connect
	arg	bootload_info$console_iom_number
	arg	bootload_info$console_channel_number
	arg	read_line_pcw_ptr,*
	arg	read_line_dcw_list_ptr,*

	staq	last_console_status

	cana	=o200000770000         " power off or central or channel
	tnz	read_error
	ana	=o770000,du	" only major status
	cmpa	=o400000,du	" READY
	tze	read_succeeded
	cmpa	=o430000,du	" might be operator error or timeout
	tnz	read_error	" error based on major

" Now analyze minor status

	lda	last_console_status
	cana	=o000400,du	" OPERATOR ERROR
	tze	not_oper_err
	tsx2	write
	arg	operator_error_message
	arg	operator_error_length
	tra	REPROMPT_REREAD

not_oper_err:
	cana	=o001000,du	" TIMEOUT
	tze	not_timeout	
	tsx2	write
	arg	timeout_message
	arg	timeout_length
	tra	REPROMPT_REREAD

not_timeout:
	cana	=o004000,du
	tze	read_error
	tsx2	write_nl
	tsx2	write
	arg	too_long_message
	arg	too_long_length

REPROMPT_REREAD:
	tsx2	write_nl
	tsx2	write
	arg	reprompt_message
	arg	reprompt_length
	tra	REREAD

	" message	name,(TEXT OF MESSAGE)

	macro	message
&1_message:
	aci	~&2~
&1_length:
	dec	&l2
&end
	message	operator_error,( * Line ignored.)
	message	timeout,( * Console timeout.)
	message	too_long,( * Input too long.)
	message	reprompt,(Answer: )

read_succeeded:
	read_line_return

"
" INIT entry begins here

	Centry	init

	absa_au	cr
	stca	write_nl_ddcw,70			" relocate DCW

" If there is a config deck, expect a PRPH OPC.  If not, find the console.

	szn	bootload_info$assume_config_deck
	tze	poll_for_console

" Search config deck.

	epp	seg,=its(config_segno_,0),*	" seg -> config_deck
	eax1	0			" for skipping them

config_console.next_card:

	ldaq	seg|0,x1			" get word and name
	cmpaq     config_console.FREE_CARD	" is it a fence?...
	tze	poll_for_console		" yes, find the console...
	eraq	config_console.OPC_CARD	" or in the card...
	anaq	config_console.MASK_CARD	" mask it...
	tze	config_console.found_card

	eax1	config_card_size,x1		" skip it...
	tra	config_console.next_card

	even
config_console.OPC_CARD:
	aci	"prphopc ",8		" first two words
config_console.FREE_CARD:
	dec	-1			" all 7's...
	dec	-1
config_console.MASK_CARD:
	oct	777777777777		"777777777777777777777000
	oct	777777777000

	even
config_console.STATE:
	aci	"on  ",4			" console must be "on"...

" When we get here, seg|0 -> config_deck$, seg|0,x1 -> prph opc card.

config_console.found_card:

	epp	seg2,seg|0,x1		" point at base of OPC card
	lda	seg2|prph_opc_card.state	" -> status...
	cmpa	config_console.STATE	" is it on?...
	tze	config_console.active_console	" yes, start initialization...
	eax1	config_card_size,x1		" no, skip card...
	tra	config_console.next_card	" here we go again...

config_console.active_console:
	lda	seg2|prph_opc_card.iom         " multiple IOM's -- some day
	sta	bootload_info$console_iom_number
	lda	seg2|prph_opc_card.chan         " channel   
	sta	bootload_info$console_channel_number
	lda	seg2|prph_opc_card.model        " determines PCW vs. IDCW
	sta	bootload_info$console_model
	tra	find.got_it

poll_for_console:
	lda	bootload_info$system_type
	cmpa	ADP_SYSTEM,dl
	tze	ssf

	lda	8,dl			prepare to find operator's console
	sta	bootload_info$console_channel_number
	lda	bootload_info$tape_iom_number
	sta	bootload_info$console_iom_number

find.next:
	tsx2	bootload_io$connect_timeout
	arg	bootload_info$console_iom_number
	arg	bootload_info$console_channel_number
	arg	write_alert_pcw		" might be an EMC
	arg	write_alert_idcw		" or an IPC-CONS
	tra	find.skip_this_channel

	cana	bootload_info$status_mask
	tze	find.got_it

find.skip_this_channel:
	aos	bootload_info$console_channel_number
	lda	bootload_info$console_channel_number
	cmpa	64,dl
	tmi	find.next		try next one
	tra	poll_for_console	keep trying... hope lcc wakes up
" 
" We have a console. Now figure out what kind.

ssf:	stz	bootload_info$console_iom_number
	stz	bootload_info$console_channel_number
	tra	init.lcc

find.got_it:

" Short pause for ipc-cons-2 console to settle down

	even
	lda	=o40000,dl		" about a second
	sba	1,dl
	tpl	-1,ic

	tsx2	bootload_io$connect
	arg	bootload_info$console_iom_number
	arg	bootload_info$console_channel_number
	arg	read_id_pcw		" might be an EMC
	arg	read_id_idcw		" or an IPC-CONS

	cana	bootload_info$status_mask
	tnz	init.emc

init.lcc:	lda	6601,dl			" LCC model #
	sta	bootload_info$console_model

	mlr	(),()			" set up to use IDCW's
	desc9a	idcw_ptrs,n_dcw_ptrs*4
	desc9a	dcw_ptrs,n_dcw_ptrs*4

" Short pause for ipc-cons-2 console to settle down

	even
	lda	=o40000,dl		" about a second
	sba	1,dl
	tpl	-1,ic

	lda	=o400000,du
	sta	bootload_info$console_available	" set us up.
	sta	bootload_info$console_pcw_check " let's chk to see if PCWs are used
	sta	bootload_info$console_uses_pcw  " set the default to YES

	tsx2	bootload_io$connect		" bootload_io will make the final desision.
	arg	bootload_info$console_iom_number
	arg	bootload_info$console_channel_number
	arg	write_pcw_ptr,*
	arg	write_nl_dcw_list_ptr,*
	tra	init.model_join

init.emc:
	lda	6001,dl
	sta	bootload_info$console_model

	mlr	(),()			" use PCW's
	desc9a	pcw_ptrs,n_dcw_ptrs*4
	desc9a	dcw_ptrs,n_dcw_ptrs*4
	lda	=o400000,du
	sta	bootload_info$console_available	" set us up.

init.model_join:
	tsx2	bootload_error$first_message		" let them know

	init_return
"
console_write_error:
	staq	last_console_status
read_error:
	stz	bootload_info$console_available
	tra	bootload_error$console_failure

	even
	segdef	last_console_status
last_console_status:
	bss	,2

dcw_ptrs:
write_pcw_ptr:		arg	0
write_alert_pcw_ptr:	arg	0
read_line_pcw_ptr:		arg	0
write_dcw_list_ptr:		arg	0
write_nl_dcw_list_ptr:	arg	0
write_alert_dcw_list_ptr:	arg	0
read_line_dcw_list_ptr:	arg	0
	equ	n_dcw_ptrs,*-dcw_ptrs

pcw_ptrs:
	arg	write_pcw		" write
	arg	write_alert_pcw	" write_alert
	arg	read_line_pcw	" read_line
	arg	write_ascii_ddcw	" write
	arg	write_nl_ddcw	" write_nl
	arg	0		" write_alert
	arg	read_line_ddcw	" read_line

idcw_ptrs:
	arg	reset_status_p_pcw	" reset & proceed
	arg	reset_status_p_pcw  " reset & proceed
	arg	reset_status_p_pcw	" reset & proceed
	arg	write_ascii_idcw	" write
	arg	write_nl_idcw	" write_nl
	arg	write_alert_idcw	" write_alert
	arg	read_line_idcw	" read_line

	even

	make_pcw	write_pcw,
		CONSOLE.write_ASCII,
		0,0,
		record,terminate

	make_pcw	write_alert_pcw,
		CONSOLE.write_alert,
		0,0,
		nondata,terminate

	make_pcw	read_line_pcw,
		CONSOLE.read_ASCII,
		0,0,
		record,terminate

	make_pcw	reset_status_pcw,
		CONSOLE.reset_status,
		0,0,nondata,terminate

	make_pcw	reset_status_p_pcw,
		CONSOLE.reset_status,
		0,0,nondata,proceed,1

	make_pcw	read_id_pcw,
		CONSOLE.read_id,
		0,0,nondata,terminate

	null				" make room for pcw inserted 
					" as idcw in IOX case
	make_idcw	read_id_idcw,
		CONSOLE.read_id,
		0,
		record,
		terminate

	null
	make_idcw	write_ascii_idcw,
		CONSOLE.write_ASCII,
		0,
		record,
		terminate
	make_ddcw write_ascii_ddcw,
		0,0,iotd,word

	null
	make_idcw	write_alert_idcw,
		CONSOLE.write_alert,
		0,
		record,
		terminate

	null
	make_idcw	write_nl_idcw,
		CONSOLE.write_ASCII,
		0,
		record,
		terminate
	make_ddcw write_nl_ddcw,
		0,1,iotd,word

	null
	make_idcw	read_line_idcw,
		CONSOLE.read_ASCII,
		0,
		record,
		terminate
	make_ddcw	read_line_ddcw,
		0,0,iotd,word

cr:	vfd	o9/012,o9/015,18/0
	end




		    bootload_dseg.alm               11/11/89  1136.5r w 11/11/89  0837.1       53568



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1982 *
" *                                                         *
" ***********************************************************

"
"	BOOTLOAD_DSEG
"
"	This program is called periodically to set up SDWs for the
"	collection 1 segments as they are read in.
"
" Created  10/04/80, W. Olin Sibert, from bootstrap1
" Modified 12/16/80, WOS, to construct both ADP and L68 SDWs, and for
"   bootload_dseg$make_sdw
" Modified 01/16/81, WOS, to remove references to processor_utility_segment, and fix bugs
" Modified sometime in May, 1981, by Chris Jones to cause it to accept system type in x0
" Modified BIM 8/82 to run appended as soon as possible, by receiving a
" bbl0-relative return address. All ic-rel's removed from make_sdw.
" Modified October 1982 by C. Hornig for canned dseg.
" Modified September 1983 by K. Loepere for adp and for make_core_ptw.

	name	bootload_dseg

	include	bootload_equs

	include	adp_sdw
	include	sdw_info
	include	l68_sdw
	include	system_types
"
"	tsx2	bootload_dseg$make_sdw
"
"	This entry is called by bootload_loader to create SDWs for collection 1
"	segments. It is entered via tsx2, and expects PR6 to point to an sdw_info
"	block. It returns with the SDW in the AQ.


ret_sdw:	bss	,2

	segdef	make_sdw

make_sdw:	stz	ret_sdw		" Clear the SDW to be returned
	stz	ret_sdw+1

	lda	pr6|sdw_info.bound	" Adjust the bound appropriately
	ldq	pr6|sdw_info.flags	" for paged or unpaged segment
	canq	sdw_info.paged,du
	tze	adjust_bound_unpaged
	ada	1023,dl			" Page boundary
	arl	10
	als	10
	tra	have_bound

adjust_bound_unpaged:
	ada	15,dl
	arl	4
	als	4

have_bound:
	ars	4			" Divide by 16
	tpnz	have_nonzero_bound	" Bound is positive
	lda	1,dl			" Pretend, instead
	ldq	sdw_info.faulted,du 	" but fault the SDW if bound was
	orsq	pr6|sdw_info.flags	" supposed to be zero

have_nonzero_bound:
	sba	1,dl			" subtract to convert to offset
	ldq	bootload_info$system_type
	cmpq	ADP_SYSTEM,dl
	tnz	l68_bound

	ldq	pr6|sdw_info.flags		" If it's paged, we should remove
	canq	sdw_info.paged,du		" the low order bits for the ADP
	tze	2,ic			" since bound is measured in pages.
	ana	=o777700,dl		" Bound was divided by 16 already.
	ana	adp_sdw.bound_mask,dl
	als	adp_sdw.bound_shift 	" Save it
	orsa	ret_sdw+adp_sdw.bound_word
	tra	bound_setup

l68_bound:
	ana	l68_sdw.bound_mask,dl
	als	l68_sdw.bound_shift 	" Save it
	orsa	ret_sdw+l68_sdw.bound_word
" 
bound_setup:
	lda	bootload_info$system_type
	cmpa	ADP_SYSTEM,dl
	tnz	l68_address

	lda	pr6|sdw_info.address	" Adjust and shift. Don't bother
	als	adp_sdw.add_shift		" masking this one because it's
	orsa	ret_sdw+adp_sdw.add_word " too large for a ,DL mask

	lda	pr6|sdw_info.access	" Pick up four access bits
	arl	36-4			" Put in low end of word
	als	adp_sdw.access_shift	" Must be in the order: REWP
	orsa	ret_sdw+adp_sdw.access_word

	lda	pr6|sdw_info.rings	" Pick up the ring brackets
	arl	36-3*3
	als	adp_sdw.rings_shift
	orsa	ret_sdw+adp_sdw.rings_word

	lda	pr6|sdw_info.gate_entry_bound " Is it a gate?
	tnz	set_adp_entry_bound

	ldq	adp_sdw.not_a_gate,dl	" Get the not-a-gate flag
	orsq	ret_sdw+adp_sdw.not_a_gate_word " and set it
	tra	set_adp_sdw_flags

set_adp_entry_bound:
	sba	1,dl			" Convert into actual offset
	ana	adp_sdw.entry_bound_mask,dl	" for entry bound in SDW
	als	adp_sdw.entry_bound_shift
	orsa	ret_sdw+adp_sdw.entry_bound_word

set_adp_sdw_flags:
	ldq	pr6|sdw_info.flags	" Get the flags (ignore cache for ADP)

	lda	adp_sdw.unpaged,dl		" Get the unpaged flag
	canq	sdw_info.paged,du
	tnz	2,ic			" If not paged, don't seg unpaged
	orsa	ret_sdw+adp_sdw.unpaged_word

	lda	adp_sdw.valid,dl		" Get the valid flag
	canq	sdw_info.faulted,du 	" See if it should NOT be set
	tnz	2,ic			" If faulted, don't set valid to 1.
	orsa	ret_sdw+adp_sdw.valid_word
	tra	address_setup
" 
l68_address:
	lda	pr6|sdw_info.address	" Adjust and shift. Don't bother
	als	l68_sdw.add_shift		" masking this one because it's
	orsa	ret_sdw+l68_sdw.add_word " too large for a ,DL mask

	lda	pr6|sdw_info.access	" Pick up four access bits
	arl	36-4			" Put in low end of word
	als	l68_sdw.access_shift	" Must be in the order: REWP
	orsa	ret_sdw+l68_sdw.access_word

	lda	pr6|sdw_info.rings	" Pick up the ring brackets
	arl	36-3*3
	als	l68_sdw.rings_shift
	orsa	ret_sdw+l68_sdw.rings_word

	lda	pr6|sdw_info.gate_entry_bound " Is it a gate?
	tnz	set_l68_entry_bound	" Not unless this is nonzero

	ldq	l68_sdw.not_a_gate,dl	" Get the not-a-gate flag
	orsq	ret_sdw+l68_sdw.not_a_gate_word " and set it
	tra	set_l68_sdw_flags

set_l68_entry_bound:
	sba	1,dl			" Convert into actual offset
	ana	l68_sdw.entry_bound_mask,dl	" for entry bound in SDW
	als	l68_sdw.entry_bound_shift
	orsa	ret_sdw+l68_sdw.entry_bound_word

set_l68_sdw_flags:
	ldq	pr6|sdw_info.flags	" Get the flags (ignore cache for ADP)

	lda	l68_sdw.unpaged,dl		" Get the unpaged flag
	canq	sdw_info.paged,du
	tnz	2,ic			" If not paged, don't seg unpaged
	orsa	ret_sdw+l68_sdw.unpaged_word

	lda	l68_sdw.valid,dl		" Since Level 68 segment fault is
	canq	sdw_info.faulted,du 	" DF0, there is no need to set df_no
	tnz	2,ic
	orsa	ret_sdw+l68_sdw.valid_word

	lda	l68_sdw.cache,dl		" Get the encacheability flag
	canq	sdw_info.cache,du
	tze	2,ic			" If not paged, don't seg unpaged
	orsa	ret_sdw+l68_sdw.cache_word

address_setup:
	ldaq	ret_sdw
	tra	0,x2
"
"	tsx2	bootload_dseg$make_core_ptw
"
" called with a memory address in a.  Returns a ptw for this in q.

	segdef	make_core_ptw

make_core_ptw:
	sta	core_addr
	ldq	bootload_info$system_type
	cmpq	ADP_SYSTEM,dl
	tnz	l68_ptw

	ldq	core_addr
	qls	18-10
	orq	=o010064,dl
	tra	0,x2

l68_ptw:	ldq	core_addr
	qls	18-6
	orq	=o420025,dl
	tra	0,x2

core_addr:
	dec	0
	end




		    bootload_early_dump.alm         11/11/89  1136.5r w 11/11/89  0837.1       65943



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1984 *
" *                                                         *
" ***********************************************************
	segdef	bootload_early_dump
	segdef	flagbox_message

" This collection 0 program (also findable in collection 1 through the toehold)
" is capable of saving the low 512k of memory to tape when a crash occurs in
" early initialization.
" Keith Loepere, November 1983.
"
	include	adp_sdw
"
	include	bootload_cpu_macros
"
	include	bootload_equs
"
	include	coll0_segnos
"
	include	fault_vector
"
	include	flagbox
"
	include	io_status_word
"
	include	iom_word_macros
"
	include	l68_sdw
"
	include	make_data_macros
"
	include	system_types
"
	include	tape_io_commands
"
bootload_early_dump:
	inhibit	on
	tra	2,ic*		force into appending mode
	nop
	vfd	18/bbl0_segno_,18o/43
	vfd	18/now_appended,18/0
now_appended:
	lda	bootload_info$system_type
	cmpa	ADP_SYSTEM,dl
	tze	iox_setup

	decor	dps8
	eax1	7*64		set all controller masks
	fld	0,dl		mask all interrupts
	sscr	2*8,x1		..
	eax1	-64,x1		SSCR will do nothing for unassigned masks
	tpl	-2,ic		..
	tra	setup

iox_setup:
	decor	adp
	inhibit	on
	lda	=0,dl	mask interrupts
	limr
	decor	dps8

setup:	ldt	-1,du		Prevent timer runout
	inhibit	off

	epp	ds,template_slt_$dseg_ptr,*
	epp	mb,template_slt_$iom_mailbox_ptr,*
	epp	slt,template_slt_$slt_ptr,*
	epp	nt,template_slt_$name_table_ptr,*
	epp	prb,template_slt_$physical_record_buffer_ptr,*
	epp	fv,template_slt_$fault_vector_ptr,*

          epp6	bootload_early_dump$ignore_scu " Now, change to treat lockup faults and
          spri6	fv|fv.f_scu_ptr+FAULT_NO_TRO*2 " timer runouts like interrupts
	spri6	fv|fv.f_scu_ptr+FAULT_NO_LUF*2

          epp6	bootload_early_dump$ignore_fault
          spri6	fv|fv.f_tra_ptr+FAULT_NO_TRO*2
          spri6	fv|fv.f_tra_ptr+FAULT_NO_LUF*2

	epp	seg,template_slt_$flagbox_ptr,*
	lda	seg|fgbx.rtb
	ana	fgbx.mess,du		" look for fgbx msg
	tze	get_drive_num

	mlr	(pr),()
	desc9a	seg|fgbx.message,64
	desc9a	flagbox_message(1),64
	tsx2	bootload_error$flagbox_message

get_drive_num:
	tsx2	bootload_console$write_nl
	tsx2	bootload_error$early_dump_prompt
	tsx2	bootload_console$read_line
	arg	ascii_drive_num
	arg	ascii_drive_num_len
	tsx2	bootload_console$write_nl

	lda	ascii_drive_num
	cmpa	die_msg
	tze	die

	lrl	27			" convert to decimal
	qrl	27
	llr	36			" 1st char in q, 2nd in a
	sbq	=o60,dl
	tmi	get_drive_num
	cmpq	9,dl
	tpnz	get_drive_num		" 1st digit

	cmpa	0,dl
	tze	got_drive_num		" single digit

	sba	=o60,dl
	tmi	get_drive_num
	cmpa	9,dl
	tpnz	get_drive_num
	sta	ascii_drive_num		" 2nd digit

	mpy	10,dl
	adq	ascii_drive_num
got_drive_num:
	qls	24
	stcq	write_tape_idcw,20
	stcq	tape_density_idcw,20
	stcq	tape_rewind_idcw,20
	stcq	tape_backspace_idcw,20
	stcq	tape_erase_idcw,20

	absa_au	tape_buffer		" Initialize
	stca	write_tape_ddcw,70

	tsx2	bootload_io$connect		" try setting density
	arg	bootload_info$tape_iom_number
	arg	bootload_info$tape_channel_number
	arg	tape_io_pcw
	arg	tape_rewind_idcw

	staq	bootload_tape_fw$erstat	" check for success
	cana	bootload_info$status_mask
	tnz	tape_error

	tsx2	bootload_io$connect
	arg	bootload_info$tape_iom_number
	arg	bootload_info$tape_channel_number
	arg	tape_io_pcw
	arg	tape_density_idcw

	staq	bootload_tape_fw$erstat	" check for success
	cana	bootload_info$status_mask
	tnz	tape_error
"
	epbp6	memory_ptw_ptr,*
	lda	ds|2*ed_segno_		" find ptw for early_dump
	ldq	bootload_info$system_type	" (used to read memory pages)
	cmpq	ADP_SYSTEM,dl
	tze	3,ic
	arl	l68_sdw.add_shift
	tra	2,ic
	arl	adp_sdw.add_shift
	sba	iupt_absloc,dl	" ptw is addr(page_table) - addr(iupt)
	epp6	6|0,al
	spri6	memory_ptw_ptr	" within iupt

	sdbr	dbr		" save info so we can find 
	lda	bootload_info$system_type " our way around memory
	sta	system_type

	lda	0,dl
"
dump_memory_page:			" fetch page of memory
	sta	address		
	tsx2	bootload_dseg$make_core_ptw
	stq	memory_ptw_ptr,*
	lda	bootload_info$system_type
	cmpa	ADP_SYSTEM,dl
	tze	3,ic
	decor	l68
	camp
	tra	2,ic
	decor	adp
	camp1
	decor	l68

	epp	seg,=its(ed_segno_,0),*
	lda	4*1024,dl
	mlr	(pr,rl),(rl)
	desc9a	seg|0,al
	desc9a	memory_record,al
	lca	16,dl
	sta	error_count

write_record:
	tsx2	bootload_io$connect
	arg	bootload_info$tape_iom_number
	arg	bootload_info$tape_channel_number
	arg	tape_io_pcw
	arg	write_tape_idcw

	staq	bootload_tape_fw$erstat	" check for success
	cana	bootload_info$status_mask
	tze	next_page			" record written
	aos	error_count
	tpl	tape_error		" too many errors - give up

" error recovery - try backspace, erase, rewrite

	cana	io_st_word.initiate,du	" tape didn't move
	tnz	erase			" don't backspace

	tsx2	bootload_io$connect
	arg	bootload_info$tape_iom_number
	arg	bootload_info$tape_channel_number
	arg	tape_io_pcw
	arg	tape_backspace_idcw

	staq	bootload_tape_fw$erstat
	cana	bootload_info$status_mask
	tnz	tape_error

erase:	tsx2	bootload_io$connect
	arg	bootload_info$tape_iom_number
	arg	bootload_info$tape_channel_number
	arg	tape_io_pcw
	arg	tape_erase_idcw

	staq	bootload_tape_fw$erstat
	cana	bootload_info$status_mask
	tnz	tape_error

	tra	write_record

next_page:
	lda	address
	ada	1024,dl
	cmpa	2,du			" 512k
	tmi	dump_memory_page
"
	tsx2	bootload_io$connect		" rewind
	arg	bootload_info$tape_iom_number
	arg	bootload_info$tape_channel_number
	arg	tape_io_pcw
	arg	tape_rewind_idcw

	tsx2	bootload_error$early_dump_done

	inhibit	on
die:	dis			" die!
	tra	-1,ic
	inhibit	off

tape_error:
	tsx2	bootload_error$tape_dump_error
	tra	get_drive_num
"
	even
tape_buffer:
magic_number:
	oct	654365234214		" label record as early_dump
address:	oct	0
dbr:	oct	0,0
system_type:
	oct	0
	even
memory_record:
	bss	,1024
tape_buffer_end:

memory_ptw_ptr:
	its	iupt_segno_,0

ascii_drive_num_len:
	vfd	36/4

ascii_drive_num:
	vfd	36/0

die_msg:	aci	"die"

error_count:
	dec	0

	make_pcw	tape_io_pcw,TAPE.reset_status,0,0,nondata,terminate,1

	make_idcw	write_tape_idcw,TAPE.write_binary_record,0,record,terminate,0,0

	make_ddcw	write_tape_ddcw,0,tape_buffer_end-tape_buffer,iotd

	make_idcw	tape_density_idcw,TAPE.set_1600_bpi,0,nondata,terminate,1,0

	make_idcw	tape_rewind_idcw,TAPE.rewind,0,nondata,terminate,1,0

	make_idcw	tape_backspace_idcw,TAPE.backspace_record,0,nondata,terminate,1,0

	make_idcw	tape_erase_idcw,TAPE.erase,0,nondata,terminate,1,0
"
" Following is the data area for ignoring faults, and the instruction to do it.
"

          segdef    ignore_scu
          segdef    ignore_fault

          eight                         " Align for SCU data
ignore_scu:
          bss       ,8
pointers_and_lengths:
	bss	,8

          inhibit   on                  <+><+><+><+><+><+><+><+><+><+><+><+><+><+><->
ignore_fault:                           " Come here to do nothing
	spl	bbl0_absloc+pointers_and_lengths
	lpl	bbl0_absloc+pointers_and_lengths
          rcu       bbl0_absloc+ignore_scu " Complicated, isn't it?
          inhibit   off                 <-><-><-><-><-><-><-><-><-><-><-><-><-><-><->

flagbox_message:
	vfd	9/64,27/0
	bss	,64		acc string copy of fgbx.message for warning msg
	end




		    bootload_error.alm              11/11/89  1136.5r w 11/11/89  0830.0      158562



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1982 *
" *                                                         *
" ***********************************************************

" HISTORY COMMENTS:
"  1) change(86-05-13,GJohnson), approve(86-05-13,MCR7387),
"     audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056):
"     Correct error message documentation.
"                                                      END HISTORY COMMENTS


" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " 
"
"         BOOTLOAD_ERROR
"
"         This program is entered to report an error. It saves all registers,
"         and prints a message, possibly including the invalid data. For the
"         unexpected_fault entry, it also describes the fault.
"
"	Modified 9/83 by Keith Loepere for adp.
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " 
	name	bootload_error

	include		adp_scu
          include             bootload_equs
	include_nolist	bootload_formline
	include		coll0_segnos
	include		fault_vector
	include		flagbox
	include_nolist	slte
	include		system_types
	include		toe_hold

" RECURSION PROTECTION -- in case an error encounters processing an error.
" set nonzero when any entrypoint here is entered.

	bss	in_bootload_error,1

          inhibit   on        <+><+><+><+><+><+><+><+><+><+><+><+><+><+><+>
"
" This code all runs inhibited, just in case.
"

" Called as 
"		tsx2	write_message
"
" writes message currently in message buffer to console, if there is one.
"

write_message:
	Bpush

	tsx2	bootload_console$write
	arg	message_buffer
	arg	message_length
write_message.return:
	Breturn


" This location shows what error we came in on in the case of a failure.

	segdef	current_error_number

	bss	current_error_number,1

" When calling error_common, x2 is first saved here so it can
" be put into the machine conditions.

	bss	save_x2,1

"
" Stores machine conditions as available for most errors
" Assumption is that there is a unique entrypoint for each
" error call, so that entry via tra is reasonable.
" 
"  Called by:
"
"	tsx2	error_common
"
error_common:
	Bpush
	spri	mc_area+mc.prs	" Save everything
	ldx2	save_x2
	sreg	mc_area+mc.regs_word
	spl	mc_area+mc.eis_info
	lda	=o400000,du
	sta	in_bootload_error
          tsx2      save_rest_of_registers
	tsx2	clear_buffer
	tsx2	bootload_console$write_nl
	tsx2	bootload_console$write_alert

error_common.return:
	Breturn


	macro	IOA
	maclist	off,save
	formline	(^A&1),
		message_buffer,80,bootload_0_string&>&K,1&[,
		&Fq2&]
	sta	message_length
	tsx2	write_message
	maclist	restore
	&end

	set	unique_errorx,0

	macro	error_comment
	maclist	on
	null	***** ERROR &1 error number is &2
	maclist	off
&end
	
          macro     error
	maclist	off,save
	equ	&1_errorx,unique_errorx
	error_comment &1,unique_errorx

          segdef    &1
&1:	szn	in_bootload_error
	tze	&U.okay

	staq	disaster_AQ
	lda	&1_errorx,dl
	tra	recursion.die	
&U.okay:

	stx2	save_x2		" so that it can be put in machine 
				" conditions.
	ldx2	unique_errorx,du
	stx2	current_error_number
	tsx2	error_common
	IOA	&Fq2
	lda	unique_errorx,dl
          tra       finish_with_error


	set	unique_errorx,unique_errorx+1
	maclist	restore
&end

" disaster_AQ is used to safe_store the AQ on a recursive error.

recursion.die:
	oraq	RECURSION_PATTERN
	odd
	dis	*
	tra	-1,ic

	even
	segdef	disaster_AQ
	bss	disaster_AQ,2
RECURSION_PATTERN:
	oct	666666000000
	oct	666666000000

	macro	warning
	maclist	off,save
	segdef	&1
&1:
	Bpush
	IOA	&Fq2
	tsx2	bootload_console$write_nl
	Breturn
	maclist	restore
	&end

	macro	warning_nnl
	maclist	off,save
	segdef	&1
&1:
	Bpush
	IOA	&Fq2
	Breturn
	maclist	restore
	&end

bootload_0_string:
	acc	"bootload_0: "
message_buffer:
	aci	"",80
message_length:
	bss	,1

clear_buffer:
	Bpush
	mlr	(),(),fill(000)
	desc9a	0,0
	desc9a	message_buffer,80
	Breturn
" 
          mod       16                  " Data areas for error status
	segdef	mc
mc:
mc_area:            bss       ,48
          equ       mc_area_size,*-mc_area


          segdef    unexpected_scu      " Must be externally addressable
unexpected_scu:     bss       ,8        " Data is copied from here into mc_area

	segdef	current_segment
current_segment:	bss	,1	" Segno of current segment being loaded

" 

" OUT_OF_STACK is handled specially. There is no stack left
" for internal calls, so we do the best we can

	segdef	out_of_stack

out_of_stack:
	oraq	OUT_OF_STACK_PATTERN
	odd
	dis	*
	tra	-1,ic

	even
OUT_OF_STACK_PATTERN:
	oct	555555000000
	oct	555555000000
" 

" ORDINARY ERRORS

	error	shutdown,(Shutdown)

	error	console_failure,(Console status ^w ^w),
		bootload_console$last_console_status,
		bootload_console$last_console_status+1

          error     bad_cw,(Unexpected control word on tape.)

	error	tape_error,(Tape read error: ^w ^w),
                    bootload_loader$tape_status,
                    bootload_loader$tape_status+1

          error     bad_mst,(Bad MST format.)

          error     bad_sequence,(Improper text/link/def sequence for seg ^o),
                    current_segment

          error     out_of_main_memory,(Out of main memory for seg ^o),
                    current_segment

	error	too_many_segs,(Too many supervisor segments.)

	error	upt_overflow,(An unpaged page table overflowed for seg ^o),
		current_segment

          warning	first_message,(Booting system ^a^a generated ^a^a ^a^a ^a ^a.),
		bootload_info$sysid,
		bootload_info$sysid+1,
		bootload_info$creation_time_string,
		bootload_info$creation_time_string+1,
		bootload_info$creation_time_string+2,
		bootload_info$creation_time_string+3,
		bootload_info$creation_time_string+4,
		bootload_info$creation_time_string+5

	warning_nnl tape_fw_prompt,(Enter boot tape MPC model: )

	warning_nnl early_dump_prompt,(Enter tape drive number for memory dump: )

	warning	early_dump_done,(Early dump finished.)

	warning	tape_mpc_help_1,(Enter controller type as Annn.)
	warning	tape_mpc_help_2,(For list of controller types enter '?'.)
	warning	tape_mpc_type_list,(Valid controller types are:)

	warning	no_such_tape_fw,(Unknown tape MPC model ^a),
		bootload_info$tape_mpc_fw_name

	warning	booting_tape_mpc,(Booting ^a ^a ^d. with ^b ^b firmware.),
		bootload_info$tape_mpc_fw_name,
		bootload_tape_fw$iom_name,
		bootload_info$tape_channel_number,
		bootload_tape_fw$fwid,
		bootload_tape_fw$fwrev

	warning	booted_tape_mpc,(Booted tape MPC.)

	warning	tape_mpc_boot_error,(Error status ^w ^w booting ^a firmware.),
		bootload_tape_fw$erstat,
		bootload_tape_fw$erstat+1,
		bootload_tape_fw$fwtype

	warning	tape_dump_error,(Excessive tape errors: status ^w ^w.),
		bootload_tape_fw$erstat,
		bootload_tape_fw$erstat+1

	warning	flagbox_message,(^A),
		bootload_early_dump$flagbox_message

	warning	no_sym,(External symbol not found: ^a^a^a^a^a^a^a^a$^a^a^a^a^a^a^a^a.),
		bootload_linker$segname,
		bootload_linker$segname+1,
		bootload_linker$segname+2,
		bootload_linker$segname+3,
		bootload_linker$segname+4,
		bootload_linker$segname+5,
		bootload_linker$segname+6,
		bootload_linker$segname+7,
		bootload_linker$ename,
		bootload_linker$ename+1,
		bootload_linker$ename+2,
		bootload_linker$ename+3,
		bootload_linker$ename+4,
		bootload_linker$ename+5,
		bootload_linker$ename+6,
		bootload_linker$ename+7
" 

	segdef	unexpected_fault		" This entry is special, and does its own saving
unexpected_fault:
	szn	in_bootload_error
	tze	unexpected_fault.okay

	odd
	dis	*
	tra	*-1

unexpected_fault.okay:
	spri	mc_area+mc.prs
	sreg	mc_area+mc.regs_word
	spl	mc_area+mc.eis_info

	lda	=o400000,du
	sta	in_bootload_error
	ldx2	-1,du
	stx2	current_error_number	" -1 = fault
	
	tsx2	save_rest_of_registers	" Put anything else interesting in

	mlr	(),()			" Copy in the SCU data
	desc9a	unexpected_scu,8*4
	desc9a	mc_area+mc.scu,8*4

	tsx2	bootload_abs_mode$initial_prs	" restore the PR's

	tsx2	bootload_console$write_nl	" In case of mid-line

	lda	bootload_info$system_type
	cmpa	ADP_SYSTEM,dl
	tze	adp_fault_name

	lda	mc_area+mc.scu+1		" Get the fault/interrupt number
	ana	scu.fi_num_mask,dl
	ars	scu.fi_num_shift
	sta	fault_number

	ldq	mc_area+mc.scu+1		" See if the fault flag is set
	anq	scu.fi_flag,dl	 	" If not, print a different message
	tze	unexpected_interrupt_actually " otherwise, skip it

	als	1			" double fault number (still in A)
	ldaq	bootload_info$l68_fault_names,al
	tra	have_fault_name

adp_fault_name:
	lda	mc_area+mc.scu+adp_scu.fi_num_word " Get the fault/interrupt number
	ana	adp_scu.fi_num_mask,du
	ars	adp_scu.fi_num_shift
	sta	fault_number

	ldq	mc_area+mc.scu+adp_scu.fi_flag_word " See if the fault flag is set
	anq	adp_scu.fi_flag,du	 	" If not, print a different message
	tnz	unexpected_interrupt_actually " otherwise, skip it

	als	1			" double fault number (still in A)
	ldaq	bootload_info$adp_fault_names,al

have_fault_name:
	staq	fault_name		" store it so it can be printed
	IOA	(Unexpected ^a^a fault.),fault_name,fault_name+1
	tra	describe_unexpected_fault

unexpected_interrupt_actually:
	IOA	(Uexpected interrupt number ^oo.),fault_number

" 
describe_unexpected_fault:
	tsx2	bootload_console$write_nl

	lda	bootload_info$system_type
	cmpa	ADP_SYSTEM,dl
	tze	adp_scu_data

	lda	mc_area+mc.scu+scu.ppr_word	" Get the PSR
	ana	scu.psr_mask,du
	ars	scu.psr_shift
	sta	args.ppr.psr

	lda	mc_area+mc.scu+scu.ilc	" Get the IC tracker
	ars	18
	sta	args.ppr.ic

	lda	mc_area+mc.scu+scu.tsr_word	" Get the TSR
	ana	scu.tsr_mask,du
	ars	scu.tsr_shift
	sta	args.tpr.tsr

	lda	mc_area+mc.scu+scu.ca	" Get the computed address
	ars	18
	sta	args.tpr.ca
	tra	got_scu_data

adp_scu_data:
	lda	mc_area+mc.scu+adp_scu.psr_word " Get the PSR
	ana	adp_scu.psr_mask,du
	ars	adp_scu.psr_shift
	sta	args.ppr.psr

	lda	mc_area+mc.scu+adp_scu.ilc	" Get the IC tracker
	ars	18
	sta	args.ppr.ic

	lda	mc_area+mc.scu+adp_scu.tsr_word	" Get the TSR
	ana	adp_scu.tsr_mask,du
	ars	adp_scu.tsr_shift
	sta	args.tpr.tsr

	lda	mc_area+mc.scu+adp_scu.ca	" Get the computed address
	ana	=o777777,dl
	sta	args.tpr.ca

got_scu_data:
	epp6	mc_area			" Get the MC pointer
	epaq	pr6|0
	ana	=o077777,du		" Extract the segno
	ars	18
	sta	args.mcp.segno
	anq	=o777777,du
	qrs	18
	stq	args.mcp.word

	IOA	(PPR = ^o|^o, TPR = ^o|^o, MC at ^o|^o),
		args.ppr.psr,
		args.ppr.ic,
		args.tpr.tsr,
		args.tpr.ca,
		args.mcp.segno,
		args.mcp.word
	tsx2	bootload_console$write_nl
	tra	finish_with_error

		even
fault_name:	aci	"",8
fault_number:	dec	0
args.ppr.psr:	dec	0
args.ppr.ic:	dec	0
args.tpr.tsr:	dec	0
args.tpr.ca:	dec	0
args.mcp.segno:	dec	0
args.mcp.word:	dec	0

" 

save_rest_of_registers:
	Bpush
	ldi	0,dl

	lda	bootload_loader$segptr	" Record during what it happened
	arl	18
	sta	current_segment

	Breturn

finish_with_error:                      " Come here when it's all over
	tra	bootload_early_dump$0
" 

	even

" 

" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"							"
"	Error message documentation.				"
"							"
"							"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

"BEGIN MESSAGE DOCUMENTATION


"         Message:
"         HALT with octal 6's in the upper half of the AQ.

"         S:    $crash

"         T:    $init

"         M:    A recursive error condition was encountered: that is,
"         the collection zero error handler was called recursively.
"         The low half of the A contains the unique error number
"         of the recursive error. See the listing of bootload_error.alm
"         for error numbers. bootload_error$disaster_AQ contains the
"         AQ at the time of recursive entry.

"         A:    This error indicates a logic error or a hardware problem.
"         Use execute switches to return to BOS.
"         Try a different tape. Failing that, look for a CPU problem.


"         Message:
"         HALT with octal 5's in the upper half of the AQ.

"         S:   $crash

"         T:   $init

"         M:   The collection zero call stack has overflowed. This
"         indicates a logic error in the collection zero
"         supervisor, or a hardware problem (possibly with
"         id or di modifiers).

"         A:   Try another tape, and/or look for a CPU bug.


"         Message:
"         bootload_0: Shutdown

"         S:    $crash

"         T:    $init

"         M:    The operator answered "shut" when asked for the bootload 
"         tape mpc information.

"         A:    $reboot


"         Message:
"         bootload_0: Console status WORD1 WORD2

"         S:    $crash

"         T:    $init

"         M:    An I/O error was encountered on the console. WORD1 and WORD2
"         are the two words of the status returned.

"         A:    Run T&D on the console.


"         Message:
"         bootload_0: Unexpected control word on tape CONTROL_WORD.

"         S:    $crash

"         T:    $init

"         M:    An unexpected Multics system tape control word was encountered.

"         A:    The system tape was generated improperly; use another copy
"         of the system tape.


"         Message:
"         bootload_0: Tape read error: WORD1 WORD2

"         S:    $crash

"         T:    $init

"         M:    An I/O error was encountered when reading the MST tape.  WORD1
"         and WORD2 are the two words of the status returned.

"         A:    $reboot


"         Message:
"         bootload_0: Bad MST format.

"         S:    $crash

"         T:    $init

"         M:    The records on the MST tape were out of sequence.

"         A:    Try another tape.


"         Message:
"         bootload_0: Improper text/link/def sequence.

"         S:    $crash

"         T:    $init

"         M:    Text, linkage, or definitions appeared out of proper sequence
"	on the Multics system tape.

"         A:    The system tape was generated improperly; use another copy
"	of the system tape.


"         Message:
"         bootload_0: Out of main memory.

"         S:    $crash

"         T:    $init

"         M:    Not enough main memory is configured in order to load
"	collection 1.

"         A:    Configure more main memory and boot again.


"         Message:
"         bootload_0: Too many supervisor segments.

"         S:    $crash

"         T:    $init

"         M:    More than 256 supervisor segments were declared on the MST.

"         A:    The system tape was generated improperly; use another copy 
"         of the system tape.


"         Message:
"         bootload_0: An unpaged page table overflowed for seg N.

"         S:    $crash

"         T:    $init

"         M:    The size of the page table needed for "unpaged" segment N
"         exceeded the area left for such page tables.

"         A:    The system tape was generated improperly; use another copy
"         of the system tape.


"         Message:
"         bootload_0: Booting system SYSID generated CREATION_TIME

"         S:     $info

"         T:     $init

"         M:     This is the first message printed by Multics, announcing the
"         sysid and creation date/time of the system tape.


"         Message:
"         bootload_0: Enter boot tape MPC model: 

"         S:    $info

"         T:    $init

"         M:    This query requests the operator to identify the bootload tape
"         mpc so that firmware may be loaded.  Refer to the MOH for details.


"         Message:
"         bootload_0: Enter tape drive number for memory dump: 

"         S:    $info

"         T:    $crash

"         M:    An initialization failure occured when the toehold was not active.
"         The system is requesting the number of a tape drive on the bootload
"         tape mpc on which to write a dump of memory.


"         Message:
"         bootload_0: Unknown tape MPC model NAME.

"         S:    $info

"         T:    $init

"         M:    The operator entered an unrecognizable mpc identifier.

"         A:    Try another mpc identifier.


"         Message:
"         bootload_0: Booting FWNAME IOM CHAN with FWID FWREV firmware.

"         S:    $info

"         T:    $init

"         M:    The system is about to boot firmware into the bootload
"         tape mpc.


"         Message:
"         bootload_0: Booted tape MPC.

"         S:    $info

"         T:    $init

"         M:    The system succeeded in booting the bootload tape mpc.


"         Message:
"         bootload_0: Error status WORD1 WORD2 booting FWTYPE firmware.

"         S:    $info

"         T:    $init

"         M:    An error occured when attempting to boot firmware into
"         the bootload tape mpc.  WORD1 and WORD2 are the status
"         returned.

"         A:    Try another firmware identifier.


"         Message:
"         bootload_0: Excessive tape errors: status WORD1 WORD2.

"         S:    $info

"         T:    $crash

"         M:    An excessive number of write errors occured when trying
"         to write an early dump tape.  The dump to this tape will
"         be aborted.

"         A:    Try another tape.


"         Message:
"         bootload_0: External symbol not found: SEG$ENTRY

"         S:    $info

"         T:    $init

"         M:    The entrypoint ENTRY was not found within the existant
"         segment SEG during pre-linking of collection 1.  This 
"         may indicate that the system tape was generated improperly.

"         END MESSAGE DOCUMENTATION

	end




		    bootload_faults.alm             11/11/89  1136.5rew 11/11/89  0837.2       41256



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1982 *
" *                                                         *
" ***********************************************************

" HISTORY COMMENTS:
"  1) change(86-04-03,Fawcett), approve(86-04-03,MCR7246),
"     audit(86-04-03,Farley), install(86-04-07,MR12.0-1036):
"     Correct ignore_fault to work in append mode.
"                                                      END HISTORY COMMENTS


"
"         BOOTLOAD_FAULTS
"
"         This module is used to initialize the fault and interrupt vectors
"         for running in bound_bootload_0. It ignores all interrupts, and
"         some faults. All other faults are directed to bootload_error.
"
" Created from bootstrap1 and FWLOAD, 10/04/80 W. Olin Sibert
" Cleaned up and modified for bootload_error, 12/14/80 WOS
"
" Entrypoint:       tsx2      bootload_faults$init
" Ignore SCU data at:         bootload_faults$ignore_scu
" Interrupts ignored by:      bootload_faults$ignore_fault
"

	name	bootload_faults
	decor	L68

          include   bootload_equs
          include   fault_vector

"

" Initialize all fault and interrupt pairs to SCU, TRA pair.
" Increment addresses in each instruction to reference different
" ITS pairs later in fault_vector.
"
          even

          inhibit   on                  <+><+><+><+><+><+><+><+><+><+><+><+><+><+>
interrupt_pair:                         " SCU/TRA pair for interrupts, executed in
          scu       fv.i_scu_ptr,*	 " absolute mode.
          tra       fv.i_tra_ptr,*
fault_pair:                             " and another pair for faults
          scu       fv.f_scu_ptr,*
          tra       fv.f_tra_ptr,*
          inhibit   off                 <-><-><-><-><-><-><-><-><-><-><-><-><-><->


          segdef    init
init:     Bpush

          eax7      0                   " X7 is offset of current vector. We set
                                        " up all the vectors and ITS pairs in parallel

loop:     eaa       0,x7                " Put the offset in the AQ, to and pick up the
          eaq       0,x7                " instruction pair. Each vector pair indirects
          adlaq     interrupt_pair      " through a different set of ITS pairs later in
          staq      fv|fv.ipair,x7      " the fault_vector, one for the SCU and one for
                                        " the transfer. The addresses in the vector
          eaa       0,x7                " instructions are all absolute, relative to the
          eaq       0,x7                " known absolute location of the fault_vector
          adlaq     fault_pair          " segment. These instructions never change from
          staq      fv|fv.fpair,x7      " now on -- only the pointers are modified.

          epp6      bootload_error$unexpected_scu " Now, initialize the ITS pointers for the
          spri6     fv|fv.f_scu_ptr,x7  " SCUs and transfers
          epp6      bootload_error$unexpected_fault
          spri6     fv|fv.f_tra_ptr,x7

          epp6      bootload_faults$ignore_scu " Fake external references, which will be
          spri6     fv|fv.i_scu_ptr,x7  " fixed up by the binder.
          epp6      bootload_faults$ignore_fault
          spri6     fv|fv.i_tra_ptr,x7

          adlx7     2,du                " On to the next vector
          cmpx7     64,du               " (of which there are but 32)
          tnz       loop

" 

          epp6      bootload_faults$ignore_scu " Now, change to treat lockup faults and
          spri6     fv|fv.f_scu_ptr+FAULT_NO_TRO*2 " timer runouts like interrupts

          epp6      bootload_faults$ignore_fault
          spri6     fv|fv.f_tra_ptr+FAULT_NO_TRO*2

	Breturn

"
" Following is the data area for ignoring faults, and the instruction to do it.
"

          segdef    ignore_scu
          segdef    ignore_fault

          eight                         " Align for SCU data
ignore_scu:
          bss       ,8
pointers_and_lengths:
	bss	,8

          inhibit   on                  <+><+><+><+><+><+><+><+><+><+><+><+><+><+><->
ignore_fault:                           " Come here to do nothing
	spl	pointers_and_lengths
	lpl	pointers_and_lengths
          rcu       ignore_scu	" Complicated, isn't it?
          inhibit   off                 <-><-><-><-><-><-><-><-><-><-><-><-><-><-><->

          end




		    bootload_flagbox.alm            11/11/89  1136.5r w 11/11/89  0837.2       21402



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1982 *
" *                                                         *
" ***********************************************************

" BOOTLOAD_FLAGBOX
"
" This program initializes the segment "flagbox", used for communication
" between bce/Multics.
"
" 11/04/80, W. Olin Sibert
" 83-84, Keith Loepere for the MR11 bce.

	name	bootload_flagbox
	decor	L68

	include	bootload_equs
	include	flagbox
	include	toe_hold
" 
"
" This code is executed just after we have created the bootload DSEG,
" before anything else is done. 

	segdef	preinit

preinit:	Bpush
	epp	seg,template_slt_$toehold_ptr,*
	epp	seg2,template_slt_$bos_toehold_ptr,*

	mlr	(),(pr),fill(000)	" Clear out the flagbox
	desc9a	0,0
	desc9a	seg|fgbx.flags_word,fgbx_size*4

	sdbr	seg|fgbx.hc_dbr

	ldx7	template_slt_$slt_ptr
	stx7	seg|fgbx.slt_segno

	szn	bootload_info$assume_config_deck " see if info from
	tze	bos_absent	" IOM suggests BOS

" We were booted either from BOS or an IIOC.  Check for BOS sentinel.

	cmpc	(pr),()
	desc9a	seg2|20,32		" BOS sentinel in flagbox
	desc9a	test_sentinel,32
	tnz	bos_absent

	stz	bootload_info$cold_disk_mpc   " BOS loaded this

	mlr	(),(pr)			" save BOS entries
	desc9a	BOS_entries,3*2*4
	desc9a	seg|TOE_HOLD_BOS_ENTRY*2,3*2*4
	tra	return

bos_absent:
	stz	bootload_info$assume_config_deck

	lda	=o400000,du
	sta	bootload_info$cold_disk_mpc	" we must load

	ldaq	seg|TOE_HOLD_CRASH_ENTRY*2	" make goto BOS -> goto bce
	staq	seg|TOE_HOLD_BOS_ENTRY*2
	staq	seg|TOE_HOLD_BOS_NO_SAVE_ENTRY*2
	staq	seg|TOE_HOLD_BOS_MULTICS_ENTRY*2

return:	ldaq	seg|TOE_HOLD_CRASH_ENTRY	" make 10000 -> goto bce
	staq	seg2|0
	staq	seg2|2
	staq	seg2|4
	Breturn

	bool	bos_origsetup,10000
	bool	bos_switchentry,7
	bool	bos_bos_entry,10
	bool	bos_mulentry,11
	bool	bos_tscu,370

	inhibit	on			<><><>ON<><><>
BOS_entries:
	scu	bos_origsetup+bos_tscu
	ret	bos_origsetup+bos_switchentry

	scu	bos_origsetup+bos_tscu
	ret	bos_origsetup+bos_bos_entry

	scu	bos_origsetup+bos_tscu
	ret	bos_origsetup+bos_mulentry
 
	inhibit	off			<><><>OFF<><><>

test_sentinel:
	aci	"Flagbox & Toehold Valid",32
	end




		    bootload_formline.alm           11/11/89  1136.5r w 11/11/89  0837.2       85626



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1982 *
" *                                                         *
" ***********************************************************

" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"
"
"
"    BOOTLOAD_FORMLINE
"
"
"    This is a primitive string mainpulator, on the lines of formline_,
"    for use before collection 1 is prelinked, and the real formline_
"    available.
"
"    It always formats into a supplied string, since console i/o is another
"    story.
"
"    Like the rest of bbl0, it is impure (we have no stack).
"
"    CALLING SEQUENCE
"    tsx2		bootload_formline
"    arg	control_string
"    arg  output_string
"    dec  maximum output string length
"    dec  nargs
"    arg  arg_one_addr   (offset in bound_bootload_0)
"    arg  arg_two_addr   (ditto)
"
"    areg contains length of rtrim'd string on return
"
"    actual invocation is with the formline macro ---
"
"    formline	(control string),output,arg1,arg2,arg3,...argN
"
"    SUPPORTED ^ thingies:
"
"     ^a one word of ascii chars
"     ^b one word of BCD chars    (^g for you bos fans)
"     ^A acc string
"     ^o octal number, leading zero suppression
"     ^w octal number, simple fullword
" 


	name	bootload_formline
	segdef	bootload_formline

	include	eis_micro_ops
	include	bootload_equs

" 

	mod	8
register_save_area:
	bss	,8
pointer_register_save_area:
	bss	,16


" Arg list definition
	equ	control_string,0
	equ	output_string,1
	equ	output_string_limit,2
	equ	n_args,3
	equ	args,4

	bss	return_address,1	" temp for calculation
	bss	arg_count,1	" to record usage of them
bootload_formline:
	sreg	register_save_area
	spri	pointer_register_save_area

" Calculate return address
" Don't push return address on stack until it has been bumped

	stx2	return_address
	lxl2	n_args,x2		" get n substitutions
	sxl2	arg_count		" for check of ^ count
	adlx2	return_address	" skip them
	eax2	4,x2		" skip fixed arguments

	Bpush

	ldx2	return_address	" restore to first arg

" Set up for input and output strings
" set registers that we will use

	epp5	control_string,x2*
	tsx7	get_input_char      " count in a
	ana	=o000777,dl	" go away, spaces
	eax1	0,al		" count in x1

	epp7	output_string,x2*   " assumed word aligned
	lxl4	output_string_limit,x2 " dont scribble randomly
	sxl4	return.output_length
	

	eax2	args,x2		" Advance X2 to first arg
 
" 

" Now we loop down characters
" This is dumb, but compact

main_char_loop:
	sbx1	1,du
	tmi	return_to_caller
	tze	main_char_loop.get_last_char
	tsx7	get_input_char

	cmpa	=o000136,dl		" ^
	tze	main_char_loop.special_char
main_char_loop.circumflex:
	tsx7	put_one_char
	tra	main_char_loop

main_char_loop.get_last_char:
	tsx7	get_input_char
main_char_loop.last_char_in_A:
	tsx7	put_one_char	" trailing ^ is just left
	tra	return_to_caller

main_char_loop.special_char:
	tsx7	get_input_char
	sbx1	1,du
	cmpa	=o000136,dl		" ^
	tze	main_char_loop.circumflex
	ldq	arg_count			 " progressively reduced
	tze	main_char_loop.unknown_control " just print it
	sbq	1,dl
	stq	arg_count		           " use one up

	cmpa	=o000141,dl		" a
	tze	main_char_loop.word_ascii
	cmpa	=o000101,dl		" A
	tze	main_char_loop.acc_string
	cmpa	=o000142,dl		" b
	tze	main_char_loop.word_bcd
	cmpa	=o000144,dl		" d
	tze	main_char_loop.word_decimal
	cmpa	=o000157,dl		" o
	tze	main_char_loop.octal_word_sup
	cmpa	=o000167,dl		" w
	tze	main_char_loop.octal_word

" no such thingie
	aos	arg_count			" don't use it up after all
main_char_loop.unknown_control:
	sta	main_char_loop.save_char
	lda	=o000136,dl		" ^
	tsx7	put_one_char
	lda	main_char_loop.save_char
	tsx7	put_one_char
	tra	main_char_loop

main_char_loop.save_char:
	bss	,1
" 

main_char_loop.word_ascii:

	tsx7	get_arg_address		" to x6
	epp1	0,x6*			" pr1 -> word of chars
	lda	4,dl		" count

	tra	ascii_common

main_char_loop.acc_string:

	tsx7	get_arg_address
	epp1	0,x6*			" word with count
	stz	acc_string.temp
	mlr	(pr),()
	desc9a	1|0,1
	desc9a	acc_string.temp(3),1	" grab count to LOWER
	eax3	1
	a9bd	1|0,x3			" skip count
	lda	acc_string.temp
	tra	ascii.no_trim

acc_string.temp:
	bss	,1

main_char_loop.word_bcd:

	tsx7	get_arg_address		" in x6
	epp1	0,x6*			" eis wants chars in index
	mvt	(pr),(),fill(040)
	desc6a	pr1|0,6
	desc9a	string_temp,6
	arg	bcd_to_ascii_table
	epp1	string_temp		" word aligned
	lda	6,dl	" length
	tra	ascii_common

main_char_loop.decimal_temp:
	bss	,3

main_char_loop.word_decimal:
	tsx7	get_arg_address
	epp1	0,x6*
	btd	(pr),()
	desc9a	pr1|0,4
	desc9ls	main_char_loop.decimal_temp,12

	mvne	(),(),()			" flush leading zeros
	desc9ls	main_char_loop.decimal_temp,12		
	desc9a	main_char_loop.decimal_mops,5
	desc9a	string_temp,12

	epp1	string_temp
	lda	12,dl	" length
	tra	ascii_common

	bool	blank,040
	macro	mop_string
	vfd	&R1&(0009/&i&<&x,&k&[,&]&)
	&end


main_char_loop.decimal_mops:
	mop_string  lte+3,blank,mfls,mfls,mfls


main_char_loop.octal_word_sup:
	eax0	1		" flag -- suppress
	tra	octal.common
main_char_loop.octal_word:
	eax0	0
octal.common:
	tsx7	get_arg_address
	ldq	0,x6*		" get the word
	tnz	octal.nonzero
	lda	=o000060,dl	" A zero
	tsx7	put_one_char	" and that's it
	tra	main_char_loop

octal.nonzero:
	eax5	12		" digits
	lda	0,dl
	
octal_loop:
	llr	3		" 3 bits into q
	canx0	1,du		" suppressing?
	tze	octal_loop.no_suppress
	cmpa	0,dl		" zero?
	tze	octal_loop.suppress
octal_loop.no_suppress:
	eax0	0		" turn off suppression
	ada	=o000060,dl	" Ascii !
	tsx7	put_one_char	" output directly
octal_loop.suppress:
	lda	0,dl		" clean
 	sbx5	1,du
	tze	main_char_loop
	cmpx5	6,du		" used up half?
	tnz	octal_loop
	canx0	1,du
	tnz	octal_loop	" if still suppressing, no need.
	lda	=o000040,dl	" space
	tsx7	put_one_char
	lda	0,dl
	tra	octal_loop

" 

" tra here with pr1 -> string to be trimmed and inserted,
" a contains length to be considered

ascii_common:

" LTRIM

	tct	(pr,rl)
	desc9a	pr1|0,al
	arg	ascii.tct_table
	arg	ascii.tct_count

	ldq	ascii.tct_count
	anq	=o000077777777  " remove trash
	stq	ascii.tct_count
	a9bd	1|0,ql	      " move past trash
	sba	ascii.tct_count " reduce length
	tze	ascii.just_spaces

" RTRIM

	tctr	(pr,rl)
	desc9a	pr1|0,al
	arg	ascii.tct_table
	arg	ascii.tct_count

	ldq	ascii.tct_count
	anq	=o000077777777
	stq	ascii.tct_count
	sba	ascii.tct_count	" trim length
	tnz	ascii.not_just_spaces
ascii.just_spaces:
	lda	=o000040,dl
	tsx7	put_one_char
	tra	main_char_loop

ascii.not_just_spaces:
ascii.no_trim:
	mvt	(pr,rl),(pr,rl),fill(040)     " we will do some useless filling
	desc9a	pr1|0,al
	desc9a	pr7|0,x4
	arg	ascii.bad_char_trans
	ttn	ascii.truncated

	a9bd	7|0,al
	als	18
	sta	ascii.tct_count	"  so we can subtract 
 	sbx4	ascii.tct_count	" cant be negative, since no truncation
	tmoz	return_to_caller	" but be safe
	tra	main_char_loop

ascii.truncated:
	eax4	0		" none left
	tra	return_to_caller.no_trim
ascii.tct_count:
	bss	,1
	macro	wc
	maclist	object,save
	vfd	&R1&(o9/&=&i,0&[000&;777&]&<&x,&k&[,&]&)
	maclist	restore
	&end
ascii.tct_table:
	wc	0,0,0,0	" 0 1 2 3
	wc	0,0,0,0	" 4 5 6 7
	wc	0,0,0,0	" 10 11 12 13
	wc	0,0,0,0	" 14 15 16 17
	wc	0,0,0,0	" 20 21 22 23
	wc	0,0,0,0	" 24 25 26 27
	wc	0,0,0,0	" 30 31 32 33
	wc	0,0,0,0	" 34 35 36 37
	wc	0,1,1,1	" 40 41 42 43  (space, ...)
	wc	1,1,1,1	" 44 45 46 47
	wc	1,1,1,1	" 50 51 52 53
	wc	1,1,1,1	" 54 55 56 57
	wc	1,1,1,1	" 60 61 62 63
	wc	1,1,1,1	" 64 65 66 67
	wc	1,1,1,1	" 70 71 72 73
	wc	1,1,1,1	" 74 75 76 77
	wc	1,1,1,1	" 100 101 102 103
	wc	1,1,1,1	" 104 105 106 107
	wc	1,1,1,1	" 110 111 112 113
	wc	1,1,1,1	" 114 115 116 117
	wc	1,1,1,1	" 120 121 122 123
	wc	1,1,1,1	" 124 124 126 127
	wc	1,1,1,1	" 130 131 132 133
	wc	1,1,1,1	" 134 135 136 137
	wc	1,1,1,1	" 140 141 142 143
	wc 	1,1,1,1	" 144 145 146 147
	wc	1,1,1,1	" 150 151 152 153
	wc	1,1,1,1	" 154 155 156 157
	wc	1,1,1,1	" 160 161 162 163
	wc	1,1,1,1	" 164 165 166 167
	wc	1,1,1,1	" 170 171 172 173
	wc	1,1,1,0	" 174 175 176 177
	dup	128/4
	wc	0,0,0,0
	dupend
ascii.bad_char_trans:
	dup	8
	oct	077077077077
	dupend
	set	char.c,32
	dup	95
	vfd	9/char.c,9/char.c+1,9/char.c+2,9/char.c+3
	set	char.c,char.c+4
	dupend
	vfd	o9/174,o9/175,o9/176,o9/077
	dup	128
	aci	"????"
	dupend

return_to_caller:
	mlr	(),(pr,rl),fill(040)
	desc9a	0
	desc9a	7|0,x4
return_to_caller.no_trim:
	sxl4	return.count_temp
	lda	return.output_length
	sba	return.count_temp
	sta	return.count_temp
	lreg	register_save_area
	lpri	pointer_register_save_area
	lda	return.count_temp
	Breturn
return.count_temp:
	bss	,1
return.output_length:
	bss	,1

" 

" Subroutine to fetch next input char into A

get_input_char:
	mlr	(pr),()
	desc9a	5|0,1
	desc9a	get_input_char.temp(3),1	" in bottom of word
	lda	1,dl
	a9bd	5|0,al			" add 1 to pr5
	lda	get_input_char.temp
	tra	0,x7			" and return
put_one_char.temp:
get_input_char.temp:
	dec	0

" Subroutine to stuff out the next character

put_one_char:
	sta	put_one_char.temp
	mlr	(),(pr)
	desc9a	put_one_char.temp(3),1
	desc9a	pr7|0,1
	lda	1,dl
	a9bd	7|0,al
	sbx4	1,du
	tze	return_to_caller	" no more space
	tra	0,x7

" Subroutine to use up an argument

get_arg_address:
	eax6	0,x2		" x6 -> actual location of arg pointer
	eax2	1,x2		" use up arg
	tra	0,x7

string_temp:
	aci	"",64
bcd_to_ascii_table:
	aci	X0123456789[#@:>?X
	aci	X abcdefghi&.](<\X
	aci	X^jklmnopqr-$*);'X
	aci	X+/stuvwxyz_,%="!X

	end




		    bootload_info.cds               11/11/89  1136.5rew 11/11/89  0837.2       89442



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Bull Inc., 1987                *
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */

/* HISTORY COMMENTS:
  1) change(85-09-09,Farley), approve(85-09-09,MCR6979),
     audit(86-03-06,GDixon), install(86-03-21,MR12.0-1033):
     Support IMU.
  2) change(86-01-07,Fawcett), approve(86-04-11,MCR7383),
     audit(86-05-12,Coppola), install(86-07-17,MR12.0-1097):
     Add support for subvolumes on MSU3380 and MSU3390.
  3) change(87-10-02,Farley), approve(88-02-26,MCR7794),
     audit(88-03-04,Fawcett), install(88-03-15,MR12.2-1035):
     Added imu_style_iom flag, so that init_early_config can create the proper
     IOM config entry.
  4) change(87-10-19,Farley), approve(88-02-26,MCR7795),
     audit(88-03-04,Fawcett), install(88-03-15,MR12.2-1035):
     Added default_time_zone and default_time_zone_delta, so that predefined
     time zone information can be available at boot time.
  5) change(87-10-19,Farley), approve(88-02-26,MCR7796),
     audit(88-03-04,Fawcett), install(88-03-15,MR12.2-1035):
     Added default_rpv_data, so that predefined RPV information can be
     available at boot time.
                                                   END HISTORY COMMENTS */
/* format: style2 */
bootload_info:
     procedure;

/* *	This is a CDS which is used to generate the bootload_info segment, used in
   *	bound_bootload_0 and various later parts of collection 1 and 2 bootload.
   *      In a later release, it will ask questions to allow certain
   *      configuration info to be "canned" onto the MST. For now,
   *      none of the answers are used, so all that is commented out/
   *      skipped.
   *
   *	11/02/80, W. Olin Sibert
   *      8/82 BIM
   *      x/83 Keith Loepere for various values, including bce_sst_sizes
   *	4/84 Keith Loepere for bce_intk_card.
   *	3/85 Keith Loepere for safe_config_deck_frec.
   */
%page;
	dcl     1 bootload_info	 aligned,		/* Data used by collection 1 bootload, mostly */
		2 structure_start	 pointer init (null ()),
						/* Beginning of this structure */
		2 structure_size	 fixed bin init (0),/* And its length in words, for use in copying */
		2 status_mask	 bit (36) aligned init ("370000770000"b3),
						/* Mask to check status word against */
		2 bce_dbr		 bit (72) aligned,	/* double word aligned */
		2 iom_boot_info	 (8) fixed bin (71) init ((8) - 1),
						/* Information copied from that left in low memory by the */
						/* IOM Bootload Program. */
		2 boot_without_query bit (1) aligned init ("0"b),
						/* info is here */
		2 iom_port_table	 (4) fixed bin (35) init ((4) - 1),
						/* SCU port for each IOM */
		2 imu_style_iom	 bit (1) aligned init ("0"b),
						/* Bootload IOM is an IMU */
		2 cold_tape_mpc	 bit (1) aligned init ("1"b),
						/* F/W in tape MPC */
		2 tape_iom_number	 fixed bin (3) init (-1),
						/* Bootload tape IOM number */
		2 tape_channel_number
				 fixed bin (6) init (-1),
						/* Bootload tape channel number */
		2 tape_device_number fixed bin (6) init (-1),
						/* Bootload tape device number, once known */
		2 tape_mpc_fw_name	 char (32) unal init (""),
		2 cold_disk_mpc	 bit (1) aligned init ("1"b),
		2 default_rpv_data	 char (24) unaligned init (""),
						/* Predefined RPV information */
		2 disk_mpc_chanid	 char (8) aligned init (""),
		2 disk_device_has_sv bit (1) aligned init ("0"b),
		2 disk_device_sv     fixed bin (17) init (-1),
		2 disk_device_number fixed bin (6) init (-1),
						/* Bootload disk device number, once known */
		2 disk_model_number	 fixed bin init (-1),
						/* Bootload disk canonical device model number */
		2 disk_mpc_model_number
				 fixed bin init (-1),
						/* Bootload disk MPC type, possibly default. */
		2 system_type	 fixed bin,	/* As in l68 vs adp */
		2 disk_mpc_fw_rev_bcd
				 bit (36) aligned init (""b),
		2 bce_part_frec	 fixed bin,
		2 bce_part_nrec	 fixed bin,
		2 mst_past_bce_frec	 fixed bin,	/* first record on rpv for mst area used for segments past bce usage (i.e. collections 2 and 3) */
		2 config_part_frec	 fixed bin,
		2 safe_config_deck_frec
				 fixed bin,
		2 console_iom_number fixed bin (3) init (0),
						/* IOM Numbers */
		2 console_channel_number
				 fixed bin (6) init (-1),
						/* Channel number of bootload console */
		2 console_model	 fixed bin (35) init (0),
		2 console_pcw_check  bit (1) aligned init ("0"b),
		2 console_uses_pcw   bit (1) aligned init ("1"b),
		2 bootload_mem_size	 fixed bin (35) init (512 * 1024),
						/* Size of bootload memory for collection 1 */
		2 contig_mem_size	 fixed bin (35) init (0),
		2 bootload_1_ptr	 pointer,		/* Pointer to base of bootload_1 */
		2 lot_ptr		 pointer,		/* Pointer to base ot lot */
		2 sys_boot_info_ptr	 pointer,		/* Pointer to our sister segment */
		2 assume_config_deck bit (1) aligned init ("1"b),
		2 config_has_been_modified
				 bit (1) aligned init ("0"b),
						/* oper should perform a reinit */
						/* assume BOS or whatever has left a valid config deck around in the canonical place */
		2 console_available	 bit (1) aligned init ("0"b),
						/* early console support turned on */
		2 sysid		 char (32) unaligned init (""),
						/* MST magic fills this in. */
		2 creation_time	 fixed bin (71) init (-1),
						/* Time this structure was created */
		2 creation_time_string
				 char (24) unaligned init (""),
						/* Character representation of the above */
		2 creator		 char (32) unaligned init (""),
						/* User who created this segment */
		2 creation_site_id	 char (32) unaligned init (""),
						/* Installation ID of site where it was created */
		2 default_time_zone  char (4) unaligned init ("gmt"),
						/* Time zone to use before config available */
		2 default_time_zone_delta
				 fixed bin (71) init (0),
						/* Binary offset of the above */
		2 rpv_cold_boot	 bit (1) aligned init ("0"b),
						/* Turned on in cold boot until RPV is formatted */
		2 bce_intk_card	 aligned like intk_card,
		2 at_bce_cl	 bit (1) aligned init ("0"b),
						/* controlled by bce_get_to_command_level */
		2 pad_align_2	 fixed bin (71) init (0),
		2 l68_fault_names	 (32) char (8) aligned init (
						/** **/
				 "shutdown", "store   ", "mme1    ", "ft1     ", "timer-ro", "command ",
				 "derail  ", "lockup  ", "connect ", "parity  ", "ipr     ", "onc     ",
				 "startup ", "overflow", "divcheck", "execute ", "segment ", "page    ",
				 "df2     ", "df3     ", "acv     ", "mme2    ", "mme3    ", "mme4    ",
				 "linkage ", "ft3     ", "fault26 ", "fault27 ", "fault28 ", "fault29 ",
				 "fault30 ", "trouble "),
		2 adp_fault_names	 (32) char (8) aligned init (
						/** **/
				 "shutdown", "store   ", "mme1    ", "ft1     ", "timer-ro", "command ",
				 "derail  ", "lockup  ", "connect ", "memsys  ", "ipr     ", "onc     ",
				 "startup ", "overflow", "divcheck", "execute ", "mme2    ", "mme3    ",
				 "segment ", "mme4    ", "page    ", "page-wrt", "acv     ", "fault23 ",
				 "linkage ", "ft3     ", "fault26 ", "fault27 ", "hype-dis", "hype-cio",
				 "hype-tro", "trouble "),
		2 bce_sst_sizes	 (0:3) fixed bin init (64, 32, 8, 8),
						/* size of sst pools for bce */
		2 end_of_bootload_info
				 pointer init (null ());
						/* Last location in the structure */


	dcl     1 cds_data		 aligned like cds_args;
						/* arguments to create_data_segment_ subr */

	dcl     code		 fixed bin (35);

	dcl     com_err_		 entry () options (variable);
	dcl     create_data_segment_	 entry (pointer, fixed binary (35));
	dcl     get_group_id_	 entry () returns (char (32));
	dcl     ioa_		 entry options (variable);
	dcl     system_info_$installation_id
				 entry (char (*));



	dcl     PAD		 (1) char (32) init ("pad*") int static options (constant);
	dcl     WHOAMI		 char (32) internal static options (constant) init ("bootload_info");


	dcl     (addr, null, size, string, unspec)
				 builtin;


	bootload_info.creator = get_group_id_ ();
	call system_info_$installation_id (bootload_info.creation_site_id);

	unspec (bootload_info.bootload_1_ptr), unspec (bootload_info.sys_boot_info_ptr),
	     unspec (bootload_info.lot_ptr) = "077777000043000000000000"b3;
						/* ring 0 pointers to base of segment -1 */

/* For the first release, ask no questions, just fill in the */
/* salient values */

	bootload_info.boot_without_query = "0"b;
	bootload_info.tape_mpc_fw_name = "";
	bootload_info.disk_mpc_chanid = "";
	bootload_info.disk_device_has_sv = "0"b;
	bootload_info.disk_device_sv = -1;
	bootload_info.disk_device_number = 0;
	bootload_info.disk_model_number = 0;
	bootload_info.disk_mpc_model_number = 0;

	bootload_info.structure_size = size (bootload_info);
						/* set it up for copying */

	cds_data.sections (1).p = addr (bootload_info);
	cds_data.sections (1).len = size (bootload_info);
	cds_data.sections (1).struct_name = WHOAMI;

	cds_data.seg_name = WHOAMI;

	cds_data.num_exclude_names = 1;
	cds_data.exclude_array_ptr = addr (PAD);

	string (cds_data.switches) = "0"b;
	cds_data.switches.have_text = "1"b;		/* only create text section */

	call create_data_segment_ (addr (cds_data), code);

	if code ^= 0
	then do;					/* Nothing can be done */
		call com_err_ (code, WHOAMI);
		return;
	     end;

	cds_data.seg_name = "sys_boot_info";		/* Create the unbound copy */

	call ioa_ ("^a: Generating sys_boot_info copy of bootload_info.", WHOAMI);

	call create_data_segment_ (addr (cds_data), code);

	if code ^= 0
	then do;					/* Nothing can be done */
		call com_err_ (code, WHOAMI);
		return;
	     end;

	return;

/* format: off */
%page; %include cds_args;
%page; %include config_intk_card;
/* format: on */
     end bootload_info;




		    bootload_io.alm                 11/11/89  1136.5rew 11/11/89  0837.2      110070



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1984 *
" *                                                         *
" ***********************************************************

" HISTORY COMMENTS:
"  1) change(85-09-09,Farley), approve(85-09-09,MCR6979),
"     audit(86-03-05,GDixon), install(86-03-21,MR12.0-1033):
"      Support IMU.
"  2) change(86-05-13,GJohnson), approve(86-05-13,MCR7387),
"     audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056):
"     Correct error message documentation.
"  3) change(87-10-02,Farley), approve(88-02-26,MCR7794),
"     audit(88-03-04,Fawcett), install(88-03-15,MR12.2-1035):
"     Added code to set the new flag bootload_info$imu_style_iom.
"  4) change(88-02-12,Farley), approve(88-03-18,MCR7859),
"     audit(88-04-11,Fawcett), install(88-04-19,MR12.2-1037):
"     Added code to $init entry to properly setup the fault and special
"     interrupt channel mailboxes to handle the storing of statuses in the
"     proper places (instead of overwritting the interrupt vectors).
"                                                      END HISTORY COMMENTS

	name	bootload_io

" The bootload I/O package.
" Rewritten October 1982 by C. Hornig
" Modified September 1983 by Keith Loepere for adp.
" Modified July 1984 by Paul Farley for IMU.

	equ	imw_size,128
	equ	iom_mailbox_size,256
	equ	channel_mailbox.lpw,0
	equ	channel_mailbox.scw,2
	equ	channel_mailbox.dcw,3
	equ	fault_status_base,32
	equ	special_status_base,80
	equ	status_queue_size,12
	bool	IOTP,010000		" DU
	bool	cold_tape_mpc_mask,400000 	" DU
	bool	imu_bit_mask,200000 	" DU
	equ	imu_bit_shift,1

	mod	16
status:	bss	,16
ignore_status:
	bss	,16
save_regs:bss	,8

	even
pcw:	bss	,2

esw:	bss	,1
temp:	bss	,1
" 
" This routine copies the bootload program and sets up bootload_info
"
"	tsx2	bootload_io$preinit
"
	segdef	preinit

preinit:	epp	seg,bootload_info$iom_boot_info
	mlr	(pr),(pr),fill(0)		" copy the boot program
	desc9a	fv|0,64
	desc9a	seg|0,64

	lda	seg|0
	ana	=o770000,du	" check for adp vs l68 iom => system
	tnz	adp_init

	lda	L68_SYSTEM,dl
	sta	bootload_info$system_type

	lda	seg|2		" interrupt base
	ana	=o777770,dl
	cmpa	template_slt_$iom_mailbox_absloc
	tnz	bad_iom_interrupt_base

	lda	seg|2		" IOM number
	ana	=o7,dl
	sta	bootload_info$tape_iom_number
	aos	bootload_info$tape_iom_number
	als	8		" offset in mailbox
	ada	seg|2		" absolute address in AL
	ana	=o777770,dl
	eax7	imw_size,al
	cmpx7	seg|2		" compare with IOM base
	tnz	bad_iom_base

	lda	seg|3		" get the device number
	arl	24
	ana	=o77,dl
	sta	bootload_info$tape_device_number

	ldq	seg|1
	qrl	27		" and the channel
	anq	=o77,dl
	stq	bootload_info$tape_channel_number

	ldq	bootload_info$tape_iom_number
	lda	seg|1		" get the port number
	ana	=o7,dl
	sta	bootload_info$iom_port_table-1,ql

" Make initial guesses about the presence of BOS.  If thsi test succeeds,
" then bootload_flagbox will check the BOS flagbox for the sentinel.

	lda	seg|7		" get cold boot flag
	ana	cold_tape_mpc_mask,du
	sta	bootload_info$cold_tape_mpc
	era	=o400000,du	" not flag
	sta	bootload_info$assume_config_deck

	lda	seg|7		" get imu flag
	ana	imu_bit_mask,du
	als	imu_bit_shift
	sta	bootload_info$imu_style_iom

	tra	0,x2		" return

adp_init:
	lda	ADP_SYSTEM,dl
	sta	bootload_info$system_type

	lda	seg|4		" IOX number and channel
	sba	8,dl
	lrs	7
	ana	=o7,dl
	sta	bootload_info$tape_iom_number
	aos	bootload_info$tape_iom_number
	qrs	36-7
	stq	bootload_info$tape_channel_number

	lda	seg|0		" get the device number
	arl	24
	ana	=o77,dl
	sta	bootload_info$tape_device_number

	stz	bootload_info$cold_tape_mpc

	tra	0,x2		" return

bad_iom_interrupt_base:
	lda	=o777777000001
	dis
	tra	-1,ic

bad_iom_base:
	lda	=o777777000002
	dis
	tra	-1,ic
" 
" This routine initializes the bootload I/O package.
"
"	tsx2	bootload_io$init
"
	segdef	init

init:	sreg	save_regs
	lda	imw_size+4*64*4,dl
	mlr	(),(pr,rl),fill(0)		" clear everything
	desc9a	0,0
	desc9a	mb|0,al

	lda	bootload_info$tape_iom_number " IOM tag (1-4)
	als	8			" 256 words/mailbox
	eax3	imw_size-iom_mailbox_size,al	" X3 -> IOM mailbox
	ldq	bootload_info$tape_iom_number " IOM tag (1-4)
	mpy	status_queue_size,dl
	eax4	-status_queue_size,ql	" X4 -> status Q index

	absa	mb|fault_status_base,x4	" get address of status Q
	als	6
	ora	IOTP+status_queue_size,dl	" setup status DCW
	sta	mb|1*4+channel_mailbox.dcw,x3 " save DCW in fault chnl mbx
	sta	mb|1*4+channel_mailbox.scw,x3 " save DCW for refresh
	absa	mb|1*4+channel_mailbox.scw,x3 " get address of refresh DCW
	als	6
	ora	=o020001,dl		" setup LPW
	sta	mb|1*4+channel_mailbox.lpw,x3 " save LPW in fault chnl mbx

	absa	mb|special_status_base,x4	" get address of status Q
	als	6
	ora	IOTP+status_queue_size,dl	" setup status DCW
	sta	mb|6*4+channel_mailbox.dcw,x3 " save DCW in spec-stat mbx
	sta	mb|6*4+channel_mailbox.scw,x3 " save DCW for refresh
 	absa	mb|6*4+channel_mailbox.scw,x3 " get address of refresh DCW
	als	6
	ora	=o020001,dl		" setup LPW
	sta	mb|6*4+channel_mailbox.lpw,x3 " save LPW in spec-stat mbx

	lreg	save_regs
	tra	0,x2
" 
" This routine issues a connect to the IOM using the caller's PCW
" and DCW lists.  The caller must insure a spare word in front of the 
" dcw list so that, in the iox case, we can insert his pcw (made non-
" terminate) as another idcw in front.
"
"	tsx2	bootload_io$connect
"	arg	iom_no
"	arg	channel_no
"	arg	PCW_address
"	arg	DCW_address
"
"	tsx2	bootload_io$connect_timeout
"	arg	iom_no
"	arg	channel_no
"	arg	PCW_address
"	arg	DCW_address
"	tra	timeout_return
"
" The status from the IOM is returned in the AQ.
"
	equ	con.iom,0
	equ	con.channel,1
	equ	con.pcw,2
	equ	con.dcw,3
	equ	con.nargs,4
	equ	con_t.timeout,4
	equ	con_t.nargs,5

	segdef	connect

connect:	stc1	esw
	tra	join

	segdef	connect_timeout

connect_timeout:
	stz	esw

join:	sreg	save_regs
	lda	bootload_info$system_type
	cmpa	ADP_SYSTEM,dl
	tze	adp_connect

" Make check to see if the connect is for the console.
" If so we need to wait fifteen milliseconds after the status
" returns, so that the console adapter will have time
" to properly do the terminate interrupt.
" If not the console then set the wait time to one millisecond.

	stz	doing_console_io
	szn	bootload_info$console_available
	tze	not_console_io	" Haven't found one, yet!
	lda	con.iom,x2*
	cmpa	bootload_info$console_iom_number
	tnz	not_console_io
	lda	con.channel,x2*
	cmpa	bootload_info$console_channel_number
	tnz	not_console_io
	lda	fifteen_millisec
	sta	wait_time+1	" set wait time
	lda	=o400000,du
	sta	doing_console_io	" set console IO flag
	tra	connect_continue
not_console_io:
	lda	one_millisec
	sta	wait_time+1
connect_continue:
	lda	con.iom,x2*	" IOM tag (1-4)
	eax1	-1,al		" IOM number in X1
	als	8		" 256 words/mailbox
	eax3	imw_size-iom_mailbox_size,al
				" X3 -> IOM mailbox
	stx3	temp		" save it

	ldq	con.channel,x2*	" channel number
	qls	2		" 4 words/channel
	eax4	0,ql		" in X4
	adx4	temp

	qls	27-2		" now in high byte
	lda	con.pcw,x2*	" get caller's PCW
	staq	pcw		" save it

	absa	con.dcw,x2*	" get address of DCW list
	als	6		" in AU
	sta	mb|channel_mailbox.lpw,x4
	stz	mb|channel_mailbox.lpw+1,x4
				" store LPW

	absa	status		" get address of status area
	als	6		" in AU
	sta	mb|channel_mailbox.scw,x4
				" set SCW

	absa	pcw		" get address of PCW
	als	6		" in AU
	ora	=o020001,dl	" set bits for connect LPW
	sta	mb|2*4+channel_mailbox.lpw,x3

	stz	status
	ldx7	=o100000,du	" set status timer
	lda	pcw		" look at the PCW
	cana	=o040000,dl	" was it a mask?
	tze	connect_n_wait	" no, must wait for status
	cioc	bootload_info$iom_port_table,x1 " fire up the IOM
	tra	no_status		" don't wait for status
connect_n_wait:
	cioc	bootload_info$iom_port_table,x1 " fire up the IOM
status_wait:
	lda	status		" status yet?
	tmi	got_status
	adlx7	-1,du		" count down to timeout
	tnz	status_wait
	szn	esw		" timer running?
	tnz	status_wait

	stc1	esw		" pretend we are not $timeout

" IMU only does single precision stores, so after status word
" arrives we need to wait for the second word to be stored...
"
" IMU adapters also take awhile, after the status service, to do the
" status interrupt. Must wait for this, so a new connect will not cause
" the adapter to be faulted.
"
" The IMU console does not use PCWs and if the opcode in the IDCW causes
" a status return to have bit 16 (initiate) on then it needs to be processed.
" The LCC on an IOM does use the PCW, which has a opcode of reset-status, and
" the status will have bit 16 on. This status can be ignored and a better one,
" from the IDCW will come along.

got_status:
	szn	doing_console_io
	tze	pause_for_status	" not console IO

	szn	bootload_info$console_pcw_check
	tze	pause_for_status	" no...
	stz	bootload_info$console_pcw_check " reset the check flag
	era	initiate_status	" only sync & initiate bits ON?
	tze	pause_for_status	" yes, console uses the PCW
	stz	bootload_info$console_uses_pcw " no, console didn't use it.

pause_for_status:
	rscr	32		" get current time
	staq	status_time

	rscr	32
	sbaq	status_time
	cmpaq	wait_time
	tmi	-3,ic

	ldaq	status		" should be there now!!
	staq	save_regs+4	" save the status

	szn	doing_console_io
	tze	no_status
	szn	bootload_info$console_uses_pcw
	tze	no_status		" pcw isn't used, so don't worry.
	era	initiate_status	" only sync & initiate bits ON?
	tnz	no_status		" no, don't try for another one.
	stz	status		" zero out status
	ldx7	=o100000,du	" reset timer
	tra	status_wait	" and wait for good status

no_status:
	absa	ignore_status	" make sure no more status arrives
	als	6
	sta	mb|channel_mailbox.scw,x4

	lreg	save_regs
	szn	esw
	tnz	con.nargs,x2	" return
	tra	con_t.nargs,x2
"
adp_connect:
	eax0	con.dcw,x2*	" address of dcw list
	lda	con.pcw,x2*	" get pcw
	ora	=o020000,dl	" turn on proceed
	sta	-1,x0		" insert in front of list

	absa	-1,x0		" get address of DCW list
	als	8		" in AU
	sta	iox_mailbox_lpw	" store LPW

	lda	con.iom,x2*	" IOX tag (1-4)
	ada	-1,dl
	als	7		" 128 channels / iox
	ada	con.channel,x2*	" channel number
	ada	8,dl		" iox channel index
	ora	=o700000,du	" form cioc word

	stz	iox_mailbox_status	" zero status
	cioc	iox_mailbox	" fire up the IOM

	lda	con.pcw,x2*	" look at the PCW
	cana	=o040000,dl	" was it a mask?
	tnz	adp_no_status	" yes, no status

	ldx7	=o100000,du	" timer
adp_status_wait:
	ldaq	iox_mailbox_status	" status yet?
	tmi	adp_got_status
	adlx7	-1,du		" count down to timeout
	tnz	adp_status_wait
	szn	esw		" timer running?
	tnz	adp_status_wait

	stc1	esw		" pretend we are not $timeout

adp_got_status:
	staq	save_regs+4	" save the status

adp_no_status:
	lreg	save_regs
	szn	esw
	tnz	con.nargs,x2	" return
	tra	con_t.nargs,x2

	mod	8
iox_mailbox:
	vfd	36o/0		" base addresses for 256k blocks
	vfd	36o/1000000
	vfd	36o/2000000
	vfd	36o/3000000
	vfd	18o/777777,18o/777777
	vfd	18o/777777,18o/777777
	vfd	24/0,12o/5034
iox_mailbox_lpw:
	vfd	36/0		" lpw
iox_mailbox_status:
	bss	,16		" status

	even
status_time:
	bss	,2
wait_time:
	bss	,2
fifteen_millisec:
	dec	15000
one_millisec:
	dec	1000
doing_console_io:
	bss	,1
initiate_status:
	oct	400002000000	" sync and initiate bits
" 
	include	bootload_equs
	include	system_types

" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"							"
"	Error message documentation.				"
"							"
"							"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

"BEGIN MESSAGE DOCUMENTATION


"         Message:
"         HALT with octal 777777000001 in the A register.

"         S:    $crash

"         T:    $init

"         M:    The interrupt base set on the bootload IOM is not 1200 octal.

"         A:    Set the switches correctly.


"         Message:
"         HALT with octal 777777000002 in the A register.

"         S:   $crash

"         T:   $init

"         M:   The iom base set on the bootload IOM is not correct. I.e.,
"         for IOM's 0, 1, 2 and 3 it should be 1400, 2000, 2400 and 3000 octal
"         respectively.

"         A:   Set the switches correctly.

"         END MESSAGE DOCUMENTATION

	end	bootload_io




		    bootload_linker.alm             11/11/89  1136.5r w 11/11/89  0837.2       45873



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1984 *
" *                                                         *
" ***********************************************************
	name	bootload_linker

" Prelinker for collection 1.
" Stolen from pre_link_(1 2), November 1982, by C. Hornig

	include	bootload_equs
	include_nolist	slt
" 
new_link:	bss	,2
type_pair:bss	,2
link_ptr:	bss	,2
def_ptr:	bss	,2
segno:	bss	,1
linkp:	bss	,1
limit:	bss	,1
last_pair:bss	,1
exp_word:	bss	,1
pass:	bss	,1
segname:	aci	"",32
ename:	aci	"",32

	segdef	prelink
	segdef	segname
	segdef	ename

prelink:
	Bpush

	lxl0	slt|slt.first_init_seg	" prelink the init segs
	lxl1	slt|slt.last_init_seg
	tsx2	scan_sltes

	lxl0	slt|slt.first_sup_seg	" and the sup segs
	lxl1	slt|slt.last_sup_seg
	tsx2	scan_sltes

	Breturn				" that's all, folks
" 
scan_sltes:
	Bpush

	sxl0	segno
	stx1	limit			" save the limit

scan_loop:
	szn	bootload_info$lot_ptr,*x0
	tnz	check_links

scan_next:
	aos	segno			" next segment
	lxl0	segno
	cmpx0	limit			" done?
	tmoz	scan_loop			" no

	Breturn				" yes
" 
" We have a linkage section.

check_links:
	lprp	seg2,bootload_info$lot_ptr,*x0 " SEG2 -> linkage
	spri1	link_ptr
	epp	seg,seg2|0,*		" SEG -> definitions
	spri6	def_ptr

	lxl7	seg2|6			" last link pair
	stx7	last_pair

	ldx1	seg2|6			" X1 -> 1st link pair

link_loop:
	cmpx1	last_pair			" done?
	tpl	scan_next			" yes

	stx1	linkp
	epp	seg2,link_ptr,*		" SEG2 -> linkage
	epp	seg,def_ptr,*		" SEG -> definitions

	lxl7	seg2|0,x1			" look at tag field
	cmpx7	=o46,du			" FT2?
	tnz	next_pair			" no

" start work on the link

	ldx7	seg2|1,x1			" get exp_ptr
	lda	seg|0,x7			" get expression word
	sta	exp_word			" save it

	ldq	seg|1,au			" get type pair
	lda	seg|0,au			" get type pair
	staq	type_pair			" save it

	tra	*+1,au			" dispatch
	tra	next_pair			" (0) unknown
	tra	type_1a			" (1) *|exp,m
	tra	next_pair			" (2)
	tra	type_3a			" (3)
	tra	type_4a			" (4)
	tra	next_pair			" (5)
	tra	type_6a			" (6)

type_1a:	tra	*+1,qu			" dispatch
	tra	t1_text
	tra	t1_link
	tra	next_pair

t1_text:	ldx7	seg2|7			" get the segment number
	easp	seg,0,x7			" pointer
	spri6	new_link
	tra	done

t1_link:	spri1	new_link			" linkage ptr
	tra	done

type_3a:	tsx2	find_seg			" find the segment
	tra	next_pair
	spri6	new_link
	tra	done

type_4a:	tsx2	find_seg			" find the segment
	tra	next_pair
	tsx2	find_def
	tra	next_pair
	tra	done

type_6a:	ldx7	seg|0,ql			" look at acc length
	canx7	=o777000,du		" null?
	tnz	type_4a
	tra	type_3a

done:	epp	seg2,link_ptr,*		" restore link ptr
	ldx1	linkp			" and offset
	lxl7	seg2|1,x1			" get the modifier
	sxl7	new_link+1		" store it
	lxl7	exp_word			" get exp
	asx7	new_link+1		" add it in

	ldaq	new_link			" get the new ptr
	staq	seg2|0,x1			" store it

next_pair:
	ldx1	linkp			" and offset
	eax1	2,x1			" on to the next
	tra	link_loop
" 
find_seg:
	Bpush

	epp	seg,seg|0,qu		" get ptr to segname
	lda	seg|0			" get length
	arl	9			" in AU
	mlr	(pr,rl),(),fill(040)	" copy it
	desc9a	seg|0(1),au
	desc9a	segname,32

	tsx2	bootload_slt_manager$get_seg_ptr
	arg	segname
	tra	find_seg_error
	Breturn	1
find_seg_error:
	Breturn	0
" 
find_def:
	Bpush

	stz	pass			" first pass
	spri6	new_link			" save the text pointer
	lxl7	type_pair+1
	epp	seg2,def_ptr,*x7		" SEG2 -> ename
	lda	seg2|0			" get length
	arl	9			" in AU
	mlr	(pr,rl),(),fill(040)	" copy it
	desc9a	seg2|0(1),au
	desc9a	ename,32

	ldx7	new_link			" get segment number
	szn	bootload_info$lot_ptr,*x7	" segment?
	tze	find_def_error	

	lprp	seg2,bootload_info$lot_ptr,*x7 " get linkage ptr
	epp	seg,seg2|0,*		" SEG -> definitions
	ldx3	seg|0			" start with first def
	tze	find_def_error	

next_def_3:
	ldx7	seg|2,x3			" get name ptr
	epp	seg2,seg|0,x7		" in SEG2
	lda	seg2|0			" get length
	arl	9			" in AU
	cmpc	(pr,rl),(),fill(040)
	desc9a	seg2|0(1),au
	desc9a	segname,32
	tze	found_def3

	ldx3	seg|1,x3			" go to next type-3
	tnz	next_def_3

pass_2:	szn	pass			" already done?
	tnz	find_def_error		" yes
rescan:	ldx3	seg|0			" start from scratch
	stc1	pass			" make full search
	tra	next_def

found_def3:
	lxl3	seg|2,x3			" check other defs
	tze	pass_2

next_def:	ldx7	seg|2,x3			" get name ptr
	epp	seg2,seg|0,x7		" in SEG2
	lda	seg2|0			" get length
	arl	9			" in AU
	cmpc	(pr,rl),(),fill(040)
	desc9a	seg2|0(1),au
	desc9a	ename,32
	tnz	def_no_match

	lxl7	seg|1,x3			" get the class
	anx7	=o7,du
	tra	*+1,x7			" dispatch
	tra	d_text			" 0
	tra	d_link			" 1
	tra	find_def_error		" 2
	tra	type_3			" 3
	tra	find_def_error		" 4

type_3:	szn	pass			" full search?
	tze	rescan			" no

def_no_match:
	ldx3	seg|0,x3			" get next def
	tnz	next_def
	tra	pass_2


d_link:	ldx7	new_link
	lprp	seg2,bootload_info$lot_ptr,*x7 " linkage
	spri1	new_link

d_text:	ldx7	seg|1,x3			" value
	asx7	new_link+1
	Breturn	1

find_def_error:
	tsx2	bootload_error$no_sym
	Breturn	0

	end	bootload_linker




		    bootload_loader.alm             11/11/89  1136.5rew 11/11/89  0830.0      177084



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1982 *
" *                                                         *
" ***********************************************************

" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"							"
"	BOOTLOAD_LOADER: Subroutine to read			"
"	collection 0.5 (tape fw) or collection 1.		"
"							"
"	tsx2	bootload_loader$load_collection		"
"         tsx2	bootload_loader$skip_collection		"
"	tsx2	bootload_loader$init			"
"							"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

" HISTORY COMMENTS:
"  1) change(85-09-09,Farley), approve(85-09-09,MCR6979),
"     audit(86-03-05,GDixon), install(86-03-21,MR12.0-1033):
"      Support IMU and FIPS.
"  2) change(87-03-12,Farley), approve(87-07-06,MCR7717),
"     audit(87-07-15,Fawcett), install(87-07-17,MR12.1-1043):
"     Corrected adjust_tape_device routine to only alter the IDCW if dealing
"     with a non-cold MPC.  Also added reset&mask to POF retry.
"  3) change(87-07-23,Farley), approve(87-07-23,PBF7717),
"     audit(87-07-24,Fawcett), install(87-07-28,MR12.1-1047):
"     Changed POF retry to only unwedge the tape controller one time.  Found
"     that more than once causes the IMU to fault..
"                                                      END HISTORY COMMENTS


" Created  10/02/80, W. Olin Sibert, from bootstrap1 and assorted oddments
" Modified 11/12/80, WOS, to add automatic tape firmware finder/loader.
" Modified 12/16/80, WOS, to construct SDWs for both ADP and Level 68, and
"  to eliminate check_overflow, on the assumption that the MST checker
"  should do that checking instead.
" Modified 04/21/81, Chris Jones for simplified I/O
" Modified 9/83, Keith Loepere for adp and paged wired segs.
" Modified 12/83, Keith Loepere for breakpoint_page support.
" Modified June-July 1984 by Paul Farley for IMU support.
" Modified 7/84, Keith Loepere to not clobber bkpt page.
" Modified 5/85, Chris Jones to calculate position of trailer correctly for
"  padded records.
	
	name	bootload_loader

	include	bootload_equs
	include	bootload_cpu_macros
	include	coll0_segnos
	include	hc_definitions_seg
	include	hc_linkage_seg
	include_nolist	iom_word_macros
	include_nolist	make_data_macros
	include	mstr
	include	sdw_info
	include	slt
	include	slte
	include	system_types
	include_nolist	tape_io_commands
	include	unpaged_page_tables
" 
	equ	prb.ctl,0
	equ	prb.data,1
	equ	prb.nameptr,1041
	equ	prb.hdr,1042


	Bentry	init
init:
	Bpush

	absa_au	prb|prb.data
	stca	read_tape_ddcw,70
	neg	0		" adjust prb pointer
	sba	mst_label.head,du	" correct for MSTRH
	asa	prb|prb.ctl

" Note (ahem) that the following code depends on the fact that:
"  1. data_bits_used and data_bit_len are in the same word (upper and lower),
"  2. they are both multiples of 36 so the division leaves word oriented values
"     in qu and ql, and
"  3. the upper half of ndata is the amount of real data, BUT
"     the lower half is the actual amount of data read (including the pad)

	ldq	prb|prb.data+mstr_header.data_bits_used
	div	36,dl
	stq	ndata

	lda	prb|prb.data+mstr_header_size+mstr_trailer.tot_rec_word,ql
				" current record
	ada	1,dl
	sta	exprec
	stz	unwedged		" reset flag word
	Breturn


	segdef	finish

finish:	eax7	3*2
setclr:	epp	seg,clptrs,x7*
	epbp	seg2,seg|0
	spri6	seg2|hc_linkage_seg.next_free_ptr
	eax7	-2,x7		" on to next
	tpl	setclr

	epp	seg,cdptr,*
	epbp	seg2,seg|0
	spri6	seg2|definitions.next_free_ptr

	tra	0,x2
"
	Bentry	skip_collection

skip_collection:
	Bpush

	tsx2	adjust_tape_device

skip_next:
	tsx2	readcw		" Look at next control word
	tra	something_to_skip	" data
	tsx0	bootload_error$bad_cw

load.cmark:
	tsx2	skip		" skip the collection mark
	arg	k1
	Breturn

something_to_skip:			" First skip the SLTE
	tsx2	skip		" grab the header
	arg	cw

	tsx2	readcw		" Now read the CW
	tsx0	bootload_error$bad_cw
	tra	skip.data
	tsx0	bootload_error$bad_cw

skip.data:tsx2	skip
	arg	cw
	tra	skip_next		" and again
" 
	Bentry	load_collection

load_collection:
	Bpush

	tsx2	adjust_tape_device

load.text:tsx2	read_header	" read the header
	tra	load.cmark	" we are done

	lda	prb|prb.hdr-1+slte.link_sect_word
				" make sure this is the text
	cana	slte.link_sect+slte.defs,dl
	tnz	bootload_error$bad_sequence

	tsx2	bootload_slt_manager$build_entry	" build the SLTE
	arg	hcw
	arg	hdrp,*
	tra	bootload_error$too_many_segs

	spri1	segptr			" save pointer to it
	spri6	lastsltptr

"	check to see if this is an 'interesting' segment.

	ldx7	seg|slte.names_ptr
	lda	nt|segnam.name,x7	get first 2 words of first name.
	ldq	nt|segnam.name+1,x7	"
	eax6	interesting_names	" x6 -> table of interesting names
	rpt	no_interesting_names,4,tze	search the table
	cmpaq	0,x6		compare first 8 characters
	ttn	load_segment	skip if no compare

	lxl0	seg|slte.segno		get segment number again
	stx0	-1,x6*		store segment number for later use

"	Make SDW for segment and load it.

load_segment:
	tsx7	allocate		routine to allocate core

	tsx2	read  		" read the segment from tape
	arg	segptr,*
	arg	cw		and store it in

	tsx7	setaccess  	now set access on loaded segment

	lda	prb|prb.hdr-1+slte.link_provided_word
	cana	slte.link_provided,dl " linkage to read?
	tze	load.text		" no
" 
"	Process linkage segment.

	tsx2	read_header
	tsx0	bootload_error$bad_sequence

	lda	prb|prb.hdr+slte.link_sect_word-1 test for linkage segment
	cana	slte.link_sect,dl	..
	tze	bootload_error$bad_sequence

	eax7	lastsltptr,*	get index of text SLT entry
	eax0	0		X0 will contain index to combined lkg ptr
	lda	slt|slte.init_seg_word,x7	init_seg?
	cana	slte.init_seg,dl	..
	tze	*+2		if so,
	eax0	4,x0		increment index
	lda	slt|slte.link_sect_wired_word,x7  wired linkage?
	cana	slte.link_sect_wired,dl  ..
	tze	*+2		if so,
	eax0	2,0		increment index

	epp	seg,clptrs,x0*	pr6 -> correct linkage segment free 
				" word
	spri6	tempptr		" save it
	lxl1	slt|slte.segno,x7	X1 contains segment number of text segment
	sprp	seg,bootload_info$lot_ptr,*x1	set lot entry

	lxl6	cw		length of linkage in X6
	adx6	1,du		add one to size of this linkage
	anx6	=o777776,du	rounded up to next even
	asx6	clptrs+1,x0	" update pointer

	tsx2	read		" read in the linkage
	arg	tempptr,*
	arg	cw

	ldx7	segptr		segment number of text in X7
	epp	seg,tempptr,*	linkage header
	stx7	seg|7		set text pointer in linkage header
" 
"	Process definitions segment.

	tsx2	read_header
	tsx0	bootload_error$bad_sequence

	lda	prb|prb.hdr+slte.defs_word-1 test for defs segment
	cana	slte.defs,dl	..
	tze	bootload_error$bad_sequence

	epbp	seg,cdptr,*	get ptr to base of defs
	lda	cw		get length of defs section
	ana	=o777777,dl	..
	ora	cdptr+1		insert offset of place for defs
	ldx7	segptr		segment number of text in X7
	sta	seg|0,x7		add entry to definitions offset table

	epp	seg,cdptr,*	pr6 -> place for defs
	spri6	tempptr,*		" save it in linkage
	spri6	tempptr		" and for reading
	lxl6	cw		get length of defs in X6
	asx6	cdptr+1		set pointer for next time

	tsx2	read  		" read the defs
	arg	tempptr,*
	arg	cw

	tra	load.text		and loop
" 
"	read in segment header information

read_header:
	Bpush
	tsx2	readcw		" read the control word
	tra	rh.header
	tsx0	bootload_error$bad_cw

	Breturn

rh.header:lda	cw		" save away CW
	sta	hcw
	tsx2	read		  " read in the logical segment header.
	arg	hdrp,*
	arg	hcw		number of words wanted

	tsx2	readcw		  " get cw of the segment
	tsx0	bootload_error$bad_cw
	tra	read_header_returns
	tsx0	bootload_error$bad_cw

read_header_returns:
	Breturn	1


readcw:	Bpush
	tsx2	read
	arg	cw
	arg	k1
	ldx7	cw		" get CW type
	tze	rcw.0		" type 0
	ersx7	cw		" clear the word
	cmpx7	1,du
	tze	rcw.1		" type 1
	cmpx7	2,du		" type 2
	tnz	bootload_error$bad_cw
	Breturn	2
rcw.1:	Breturn	1
rcw.0:	Breturn	0
" 
	segdef	segptr

	even
segptr:	its	-1,1
tempptr:	its	-1,1
lastsltptr:
	its	-1,1
clptrs:	its	-1,hc_linkage_seg.free_area	active_sup_linkage
	its	-1,hc_linkage_seg.free_area	wired_sup_linkage
	its	-1,hc_linkage_seg.free_area	active_init_linkage
	its	-1,hc_linkage_seg.free_area	wired_init_linkage
cdptr:	its	-1,definitions.first_free_word  definitions_

hdrp:	itp	prb,prb.hdr-1

si:	bss	,sdw_info_size
hcw:	dec	0		control word for logical header
cw:	dec	0		control word
k1:	dec	1		" constant one
bit_count_mask:
	oct	000077777777	" mask for slte.bit_count
" 
	macro	int_name
	maclist	object,save
	aci	@&1@,8
	zero	&l2,0
	arg	&3
	maclist	restore
&end

"	Table of 'interesting' names.

	even
interesting_names:

	int_name	bootload,bootload_1,bootload_info$bootload_1_ptr

	int_name	lot,lot,bootload_info$lot_ptr

	int_name	as_linka,as_linkage,clptrs
	int_name	ws_linka,ws_linkage,clptrs+2
	int_name	ai_linka,ai_linkage,clptrs+4
	int_name	wi_linka,wi_linkage,clptrs+6

	int_name	definiti,definitions_,cdptr

	int_name	sys_boot,sys_boot_info,bootload_info$sys_boot_info_ptr

	equ	no_interesting_names,(*-interesting_names)/4
" 
"	ALLOCATE
"
"	This subroutine is called (via TSX7) to allocate storage for the segment
"	described by the SLTE currently in the headersegment buffer. An sdw_info
"	is constructed (si), and bootload_dseg$make_sdw is called to fabricate
"	the SDW. The SDW is initially constructed with RW access, so the segment
"	contents can be read in. After the segment is read in, the set_access
"	entrypoint is called, the SDW is refabricated with the appropriate access,
"	and is stored into the DSEG again. The sdw_info is constructed in the area
"	called "si".
"
"	Segments are allocated according to the following rules. X1 is used
"	as a flag to indicate where the segment is to be allocated.
"
"	 * If the segment is zero length on the tape, it gets an all zero
"	   SDW. This case is handled first.
"
"	 * If the segment is a paged supervisor segment, or any sort of
"	   init-seg, it is allocated in a contiguous region of high order
"	   memory, on a 1024 word boundary.  Its page table is put in
"	   int_unpaged_page_tables.
"
"	 * If the segment is an unpaged supervisor segment, it is allocated
"	   on a 1024 word boundary starting from the low end of memory.  Its
"	   page table is put in unpaged_page_tables.
"
"	If the segment has e access, we add the breakpoint_page as an
"	extra page to the end.

running_address:
	dec	0
seg_text_length:
	dec	0

allocate:
	mlr	(),(),fill(000)	" Clear out sdw_info
	desc9a	0,0
	desc9a	si,4*sdw_info_size

	ldq	seg|slte.bit_count_word " Find out how big it is
	anq	bit_count_mask
	adq	35,dl		" Round up to a word
	div	36,dl		" and figure out how many words it is

	tze	allocate_empty_seg	" If nothing there, give up now

	adq	1023,dl		" round up to 1024 words
	anq	=o776000,dl
	stq	si+sdw_info.bound	" Save the length
	stq	seg_text_length	" amount to clear (doesn't count bkpt page)

	lda	slt|slt.free_core_size " See if we've got room
	sba	si+sdw_info.bound
	sba	1024,dl		" subtract a page to allow for slop
	tmi	bootload_error$out_of_main_memory

	lda	seg|slte.firmware_seg_word
	cana	slte.firmware_seg,du
	tnz	allocate_seg_low

	lda	seg|slte.paged_word " Is seg to be paged?
	cana	slte.paged,du
	tnz	allocate_seg_high

	lda	seg|slte.init_seg_word	" Or is it an init-seg, maybe?
	cana	slte.init_seg,dl
	tnz	allocate_seg_high	" Yup, place with paged segments

allocate_seg_low:
	lda	slt|slt.free_core_start	" Get space in low memory
	sta	running_address	 	" Save the address
	ada	si+sdw_info.bound		" Add the length, and adjust the
	sta	slt|slt.free_core_start	" beginning of free core
	lda	slt|slt.free_core_size	" Also adjust the size
	sba	si+sdw_info.bound
	sta	slt|slt.free_core_size
	epp	seg2,=its(upt_segno_,0),*
	tra	have_seg_address

allocate_seg_high:
	lda	slt|slt.free_core_start	" Assume these are already
	ada	slt|slt.free_core_size	" 1024 word aligned.
	sba	si+sdw_info.bound		" Adjust down by the seg lth.
	sta	running_address	 	" Save the address
	sba	slt|slt.free_core_start	" and calculate the new size
	sta	slt|slt.free_core_size	" of free core -- free_core_start
	epp	seg2,=its(iupt_segno_,0),*
	tra	have_seg_address		" is unchanged

have_seg_address:				" pr(seg2) -> upt (unpaged page table)
	lda	seg|slte.access_word " see if we should add breakpoint_page
	ana	=o200000,du	" e permission
	tze	non_bkpt
	lda	slte.breakpointable,du
	orsa	seg|slte.breakpointable_word
	lda	1024,dl		" lengthen for bkpt page
	asa	si+sdw_info.bound
	lda	1,dl
	als	slte.cur_length_shift
	adla	seg|slte.cur_length_word
	sta	seg|slte.cur_length_word " record as lengthened
	lda	1,dl
	als	slte.max_length_shift
	adla	seg|slte.max_length_word
	sta	seg|slte.max_length_word
non_bkpt:
	ldq	seg2|upt.current_length
	lda	si+sdw_info.bound
	ars	10			" # of pages
	eax3	0,al

	ada	3,dl
	ars	1
	als	1			" round to next size upt entry
	ada	seg2|upt.current_length
	sta	seg2|upt.current_length	" allocated page table
	cmpa	seg2|upt.max_length
	tmoz	2,ic
	tsx0	bootload_error$upt_overflow
	epp	seg2,seg2|0,ql		" -> upt_entry

	lda	segptr
	ars	18			" segno
	sta	seg2|upt_entry.segno
	stz	seg2|upt_entry.size
	sxl3	seg2|upt_entry.size
	epp	seg2,seg2|upt_entry.ptws
	absa_al	seg2|0
	sta	si+sdw_info.address

	lda	seg|slte.breakpointable_word
	cana	slte.breakpointable,du
	tze	2,ic
	eax3	-1,x3			" last ptw is special for bkpt page

	lda	running_address
gen_ptw:
	tsx2	bootload_dseg$make_core_ptw
	stq	seg2|0
	ada	1024,dl
	epp	seg2,seg2|1
	eax3	-1,x3
	tnz	gen_ptw

	lda	seg|slte.breakpointable_word " add bkpt ptw if necessary
	cana	slte.breakpointable,du
	tze	no_add_bkpt_ptw
	lda	bkpt_absloc,dl
	tsx2	bootload_dseg$make_core_ptw
	stq	seg2|0

no_add_bkpt_ptw:
	lda	sdw_info.paged,du
	orsa	si+sdw_info.flags

	lda	sdw_info.read+sdw_info.write,du " Set RW access
	sta	si+sdw_info.access

	epp	seg,si
	tsx2	bootload_dseg$make_sdw

	ldx3	segptr		" segno * 2 in X3
	adlx3	segptr
	staq	ds|0,x3		" Ka-ching!
	lda	bootload_info$system_type
	cmpa	ADP_SYSTEM,dl
	tze	2,ic
	cams	0

	lda	seg_text_length	" now clear the segment
	als	2		" characters
	epp	seg,segptr,*
	mlr	(),(pr,rl),fill(0)
	desc9a	0
	desc9a	seg|0,al
	tra	0,x7		" and return


allocate_empty_seg:
	lda	sdw_info.faulted,du " Make the segment empty
	sta	si+sdw_info.flags	" All the rest of si is still zero
	ldx3	segptr		" segno * 2 in X3
	adlx3	segptr
	stz	ds|0,x3		" Ka-ching!
	stz	ds|1,x3		" Ka-ching!
	tra	0,x7		" and return
" 
"	SETACCESS
"
"	This entry is called to set the proper access for the segment, once it
"	has been read in. This is also where the encacheable bit is set.
"

setaccess:
	lda	si+sdw_info.flags	" Is it worth it?
	cana	sdw_info.faulted,du
	tnz	0,x7		" Nope, SDW is unusable

	epp	seg,prb|prb.hdr-1	" PR6 -> slte

	lda	seg|slte.cache_word " Set the encacheability bit
	ana	slte.cache,du
	tze	3,ic
	lda	sdw_info.cache,du
	orsa	si+sdw_info.flags

	lda	seg|slte.access_word " Set the correct access
	arl	slte.access_shift	" To low 4 bits
	als	36-4		" Now to high 4 bits
	sta	si+sdw_info.access	" and store it

	epp	seg,si		" Make the SDW again
	tsx2	bootload_dseg$make_sdw

	ldx3	segptr		" segno * 2 in X3
	adlx3	segptr
	staq	ds|0,x3		" Ka-ching!
	lda	bootload_info$system_type
	cmpa	ADP_SYSTEM,dl
	tze	2,ic
	cams	0
	tra	0,x7		" and return
" 
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"							"
"	read: subroutine to read the input.			"
"							"
"	calling sequence:	tsx2	read	 		"
"			arg	loc			"
"			arg	=nwords			"
"							"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

	even
	segdef	tape_status
tape_status:
	bss	,2
ndata:	bss	,1
exprec:	dec	0
length:	dec	0
read_skip:dec	0

read:	stc1	read_skip		" this is read
	epp	seg,0,x2*		" get ptr to data loc
	lxl7	1,x2*		get length
	tra	read_join

skip:	stz	read_skip		" this is skip
	lxl7	0,x2*		" length

read_join:
	stx7	length
	Bpush

readloop:
	ldx6	ndata		get data length of tape record
	sblx6	prb|prb.ctl	compute # of words remaining in buffer
	tze	readp		read next record if no more words left
	cmpx6	length		get min (length, words_remaining)
	tmoz	*+2		..
	ldx6	length		..

	szn	read_skip		" reading?
	tze	no_read		" no

	ldq	prb|prb.ctl	tape buffer offset in QU
	eaa	0,x6		words to copy in AU
	lls	2		generate character count and offset
	mlr	(pr,rl,qu),(pr,rl)	copy data from tape buffer
	desc9a	prb|prb.data+mstr_header_size,au
	desc9a	seg|0,au

	epp	seg,seg|0,x6	bump pr6 by # of words copied

no_read:
	eaa	0,x6		words copied in AU
	asa	prb|prb.ctl	bump record index
	neg	0		complement
	asa	length		decrement length
	tpnz	readloop		loop if more data to copy

read_return:
	szn	read_skip		" return to caller
	tze	skip.return	" skip
	Breturn	2
skip.return:
	Breturn	1
" 
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"							"
"	Subroutine to read one physical record from tape		"
"							"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

readp:	rscr	32			" get time
	staq	io_start_time		" and save it
	stz	prb|prb.ctl		reset pointer on PRB to zero wds xmitted.
	stz	prb|prb.data+mstr_header.c1	and smash the magic word
try_readp_again:
	tsx2	bootload_io$connect 	" Read a record
	arg	bootload_info$tape_iom_number
	arg	bootload_info$tape_channel_number
	arg	tape_io_pcw
	arg	read_tape_idcw

	staq	tape_status
	cana	bootload_info$status_mask
	tnz	tape_error
	canq	=o7777,dl			" tally residue?
	tnz	readp			" yes, skip it

	ldq	prb|prb.data+mstr_header.c1	" a quick spot check of the record.
	cmpq	magic_first		we know the first and last words.
	tnz	readp			it is probably just noise

" See the longish comment earlier about the dependencies between data_bits_used
" and data_bit_len, and why the following code works despite its bad habits.

	ldq	prb|prb.data+mstr_header.data_bits_used	" get bit count of data bits
	div	36,dl		compute data word count
	stq	ndata		and save

	eax2	0,ql		x2 is trailer pointer
	ldq	prb|prb.data+mstr_header_size+mstr_trailer.c2,x2
	cmpq	magic_last
	tnz	readp		" bad record

	lda	prb|prb.data+mstr_header_size+mstr_trailer.tot_rec_word,x2 currec
	cmpa	exprec		expected record?
	tnz	bootload_error$bad_mst

	aos	exprec		save for next read
	tra	readloop		" keep reading

tape_error:
	ana	=o770000,du	" get just major/minor status
	cmpa	=o440000,du	" EOF?
	tze	readp		" yes, skip it
	cmpa	=o600000,du	" POF?
	tze	retry_pof		" try again
	tra	bootload_error$tape_error

retry_pof:
	szn	bootload_info$cold_tape_mpc	" F/W yet?
	tze	chk_pof_time	" yes, leave it alone
	szn	unwedged		" has unwedging been done
	tnz	chk_pof_time	" yes, just chk time & retry I/O
	tsx2	bootload_tape_fw$reset_and_mask " no, do the unwedging
	stc1	unwedged		" show that it has been done

chk_pof_time:
	rscr	32		" get the time
	sbaq	io_start_time	" rel-a-tize
	cmpaq	thirty_sec_limit	" is thirty seconds up?
	tmi	try_readp_again	" NO, try one mo time
	tra	bootload_error$tape_error " report error

adjust_tape_device:

	szn	bootload_info$cold_tape_mpc	" F/W yet?
	tnz	0,x2			" no, leave it alone
	lda	bootload_info$tape_device_number
	als	24
	stca	read_tape_idcw,20
	lda	=o3000,dl
	stca	read_tape_idcw,2
	tra	0,x2		" return
" 
magic_first:
	oct	670314355245	magic number at word 1 of record
magic_last:
	oct	265221631704	magic number at end of record

unwedged: bss	,1
	even
io_start_time:
	bss	,2
thirty_sec_limit:
	dec	0,30000000	" thirty seconds (in micros)

	make_pcw	tape_io_pcw,	" PCW to reset status before tape I/O
		TAPE.reset_status,
		0,
		0,
		nondata,
		terminate,
		1

read_tape_idcw:
	vfd	6/TAPE.read_binary_record,6/0,6/0,3/7,1/0,2/0,6o/0,6/0

	make_ddcw	read_tape_ddcw,	" DDCW describing physical_record_buffer
		0,
		mstr_header_size+1024+mstr_trailer_size,
		iotd

	end




		    bootload_slt_manager.alm        11/11/89  1136.5r w 11/11/89  0837.2       75942



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1984 *
" *                                                         *
" ***********************************************************
	name	bootload_slt_manager

" SLT management functions for bootload Multics.
" Stolen from slt_manager November 1982 by C. Hornig

	include	bootload_equs
	include	slt
	include	slte
" 
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"							"
"	Initialize the Segment Loading Table.			"
"							"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

	segdef	init_slt

init_slt:
	epp	seg,template_slt_$t_slt

" Calculate size of header+sup segs

	lda	seg|slt.last_sup_seg	" this many 
	als 	4			" 4 words each
	ada	4*(slt.seg+4),dl		" header length (zero base adds 1)

	mlr	(pr,rl),(pr,rl)		copy SLT header and entries for sup segs
	desc9a	seg|0,al
	desc9a	slt|0,al

" Now get init segs

	lda	slt|slt.last_init_seg	" LENGTH
	sba	slt|slt.first_init_seg	" This many entries
	ada	1,dl			" at least one entry
	als	4			" 4 words, to chars

	ldq	slt|slt.last_sup_seg	" LOCATION FROM
	adq	1,dl			" this many entries
	qls	2			" this many words
	epp	seg,seg|slt.seg,ql		" gotcha
	
	ldq	slt|slt.first_init_seg	" LOCATION TO
	qls	2			" words
	epp	seg2,slt|slt.seg,ql		" gotcha

	mlr	(pr,rl),(pr,rl)
	desc9a	seg|0,al
	desc9a	seg2|0,al

" Name table

	epp	seg,template_slt_$t_name_table
	lda	template_slt_$name_table_length
	als	2			" chars

	mlr	(pr,rl),(pr,rl)		copy segment and path names
	desc9a	seg|0,al
	desc9a	nt|0,al

" compute free core size

	lda	bootload_info$bootload_mem_size
          sba       slt|slt.free_core_start       " Subtract those already used, and
          sta       slt|slt.free_core_size        " save it.

" now hash in names for these template segs

	lxl1	slt|slt.first_init_seg	" do init segs first
	lda	slt|slt.first_init_seg
init_seg_hash_loop:
	als	2			" length of slte
	epp	seg,slt|slt.seg,al		" slte to consider
	ldx3	seg|slte.names_ptr		" names ptr
	tze	next_init_seg_hash
	epp	seg,nt|0,x3
	tsx5	hash_in
next_init_seg_hash:
	eax1	1,x1			" next init_seg
	eaa	0,x1
	ars	18
	cmpa	slt|slt.last_init_seg
	tmoz	init_seg_hash_loop	

	lxl1	slt|slt.first_sup_seg	" now do sup segs
	lda	slt|slt.first_sup_seg
sup_seg_hash_loop:
	als	2			" length of slte
	epp	seg,slt|slt.seg,al		" slte to consider
	ldx3	seg|slte.names_ptr		" names ptr
	tze	next_sup_seg_hash
	epp	seg,nt|0,x3
	tsx5	hash_in
next_sup_seg_hash:
	eax1	1,x1			" next init_seg
	eaa	0,x1
	ars	18
	cmpa	slt|slt.last_sup_seg
	tmoz	sup_seg_hash_loop	

	tra	0,x2			" return
" 
"	tsx2	bootload_slt_manager$build_entry
"	arg	slte CW
"	arg	slte
"	tra	error
"	(pr1 -> segment base)
"	(pr6 -> new SLTE)

	segdef	build_entry

build_entry:
	epp	seg2,1,x2*		" seg2 -> SLTE

	lxl1	nt|name_seg.next_loc  X1 contains first unused location
	stx1	seg2|slte.names_ptr	set name pointer in SLT entry
	epp	seg,nt|0,x1

	lda	0,x2*		" get header control word
	sba	slte_size,dl	" size of names
	asa	nt|name_seg.next_loc" bump name table pointer
	als	18+2		" characters in AU

	mlr	(pr,rl),(pr,rl)	" copy the names & path
	desc9a	seg2|slte_size,au
	desc9a	seg|0,au

	lda	seg2|slte.init_seg_word is this an initialization segment?
	cana	slte.init_seg,dl	..
	tze	sup		if zero, supervisor segment

	aos	slt|slt.last_init_seg otherwise, init segment
	ldq	slt|slt.last_init_seg segment number in Q
	tra	jn		..

sup:	aos	slt|slt.last_sup_seg	supervisor segment
	ldq	slt|slt.last_sup_seg	segment number in Q
	cmpq	slt|slt.first_init_seg are we overlapping the init segs?
	trc	2,x2		fatal error if so

jn:
	eax0	0,ql		" save segment number
	sxl0	seg2|slte.segno	" in the SLTE
	mpy	slte_size,dl	multiply by length of SLT entry
	epp	seg,slt|slt.seg,ql	" get ptr to new SLTE

	mlr	(pr),(pr)		fill in the SLT entry
	desc9a	seg2|0,slte_size*4
	desc9a	seg|0,slte_size*4

	lda	seg|slte.branch_required_word Look for branch-required switch
	cana	slte.branch_required,dl Is path provided
	tze	no_copy_path

	ldq	seg2|slte_size+segnam.count	count of names in Q
	mpy	9,dl		multiply by length of each name
	eax7	1,ql		add 1 for name count itself
	adx7	seg|slte.names_ptr	" add offset of names
	sxl7	seg|slte.path_ptr	" save it

no_copy_path:

" now hash in names for segment

	ldx3	seg|slte.names_ptr	" at segnam
	epp	seg,nt|0,x3
	eax1	0,x0		" setup registers as needed
	tsx5	hash_in

	epp	seg2,0		" make a ring-0 pointer
	easp	seg2,0,x0		" to the segment
	eaq	0,x0		" now restore pr(seg) -> slte
	mpy	slte_size,dl
	epp	seg,slt|slt.seg,qu
	tra	3,x2		" return
" 
"	tsx2	bootload_slt_manager$get_seg_ptr
"	arg	name
"	tra	error
"	(seg -> segment)
"	(a = segment number)

	segdef	get_seg_ptr

get_seg_ptr:
	epp	seg2,0,x2*	" pts at name
	xec	spris+seg2	" done so can get spri seg2,name_arg
	tsx3	hash_index_
	arg	name_arg
	arg	=32
	arg	=0
	arg	=128
	arg	hash_value	" got where should hash
	epp	seg2,0,x2*	" restore pr(seg2) -> name
	lxl3	hash_value
	epp	seg,nt|name_seg.ht,x3*	" first entry in hash list
hash_search_loop:
	eax4	seg|0
	tze	1,x2		" ran off end => not found
	cmpc	(pr),(pr)
	desc9a	seg2|0,32		" does name match?
	desc9a	seg|1,32
	tze	get_seg_found
	ldx4	seg|0
	eawp	seg,0,x4		" next in list
	tra	hash_search_loop
get_seg_found:
	lda	seg|0		" get segno
	ana	segnam.segno_mask,dl
	epp	seg,0		" get a pointer
	easp	seg,0,al
	tra	2,x2		" return

spris:	spri0	name_arg		" table to xec to get spri seg2,name_arg
	spri1	name_arg
	spri2	name_arg
	spri3	name_arg
	spri4	name_arg
	spri5	name_arg
	spri6	name_arg
	spri7	name_arg
"
"   local routine hash_in
"	hashes in to lists all names for given segment
"   uses pr(seg), pr(seg2), x3, x4, x6, x7, a, q: tsx5'd to
"   assumes pr(seg) points to a segnam entry (from name table)
"   and x1 is segment number to put in slot
"

	even
name_arg:	its	0,0		place for address of name
hash_value: dec	0		place for hash return result

hash_in:
	lxl6	seg|segnam.count	get number of names to hash
	tze	0,x5		nothing to do
hash_in_loop:
	epp	seg2,seg|segnam.name
	xec	spris+seg2	point at name to hash
	tsx3	hash_index_	get hash value
	arg	name_arg
	arg	=32
	arg 	=0	
	arg	=128
	arg	hash_value
	lxl7	hash_value	thread into hash -list
	ldx3	nt|name_seg.ht,x7
	stx3	seg|segnam.hp
	eax3	seg|segnam.hp
	stx3	nt|name_seg.ht,x7
	eaa	0,x1		put segno onto right bits
	ars	18
	stca	seg|segnam.hp,03	save segno in segnam entry
	epp	seg,seg|9		advance to next segnam entry
	eax6	-1,x6
	tnz	hash_in_loop
	tra	0,x5		return to caller
"
"   local routine hash_index_
"   stolen from hash_index_.alm
"   for bootload0 environment
"   uses pr(seg2), x3, x4, a, q: tsx3'd to
"
"	tsx3	hash_index_
"	arg	string_ptr
"	arg	string_length
"	arg	bias
"	arg	hash_table_size
"	arg	hash_value
"
	set	string,0
	set	length,1
	set	bias,2
	set	tablesize,3
	set	index,4
hash_index_:
	epp	seg2,string,x3*	get pointer to pointer to string
	epp	seg2,seg2|0,*	get pointer to string
	szn	tablesize,x3*	check for zero divide
	tze	err		trouble
	eaa	0		clear the a register
	ldq	length,x3*	get length of string
	cmpq	=32,dl		is it an entry name?
	tnz	compare		no, go to compare
	qrs	2		yes, ignore trailing blanks
strip:	lda	seg2|-1,ql	get end word
	cmpa	blanks		all blanks?
	tnz	add1		no, go to compare
	sbq	=1,dl		yes, backup 1 word
	tra	strip		loop back and try again
compare:	llr	70		divide by 4 and save remainder
	arl	16		shift remainder to upper a
	eax4	0,au		divisible by 4?
	tze	add1		yes go to compare
	lda	seg2|0,ql		no, make blanks out of last chars
	ana	mask,4
	ora	bits,4
	tra	add2
add1:	eaa	0		zero a reg-init sum
add2:
	qls	0		set sign of q
	tze	noadd		no words to be added in
	adla	seg2|-1,ql
	sblq	1,dl		go to next word
	tpl	add2
noadd:	sta	index,x3*		save temporarily
	ldq	bias,x3*		get bias
	mpy	=99991,dl		multipy by large prime number
	adq	index,x3*		add in sum of the words
	div	tablesize,x3*	divide by hash table size
	als	0		set zero indicator from remainder (in a-reg)
	tpl	*+2		must be positive answer
	neg
	sta	index,x3*		return the remainder of the division
.rt:	tra	5,x3		return to caller

err:	stz	index,x3*		return zero as hash index if error
	tra	.rt

blanks:	aci	"    "
mask:	oct	0,777000000000,777777000000,777777777000
bits:	oct	0,000040040040,000000040040,000000000040

	end	bootload_slt_manager




		    bootload_tape_fw.alm            11/11/89  1136.5rew 11/11/89  0837.2      100440



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1982 *
" *                                                         *
" ***********************************************************

" HISTORY COMMENTS:
"  1) change(85-09-09,Farley), approve(85-09-09,MCR6979),
"     audit(86-03-05,GDixon), install(86-03-21,MR12.0-1033):
"      Support IMU and FIPS.
"                                                      END HISTORY COMMENTS


" BOOTLOAD_TAPE_FW
"
"  0) use bootload_loader to load firmware files.
"     They are init segs.
"  1) see if bootload_info$boot_without_query is set
"  2) if so, skip 3.
"  3) use bootload_console to ask for an MPC model
"  4) search collection 0.5 for that firmware
"  5) if none, complain and go to 3.
"  6) reset slt pointer to reuse firmware space,
"     and zero the sdw's for the firmware files.
" Note that we assume that the controller model name is the
" a segnam on each firmware file.

" Benson Margulies now admits to writing this.
" Modified November 1982 by C. Hornig.

	name	bootload_tape_fw

	even
	bss	fw_seg_ptr,2
	bss	saved_free_core_start,1
	bss	saved_free_core_size,1
	bss	saved_last_init_seg,1
	bss	first_fw_seg,1
	bss	last_fw_seg,1
	bss	RW_length,1
	bss	RW_index,1
	bss	CS_length,1
	bss	bs.start_addr,1
" 
	include	bootload_equs
	include_nolist	bootload_cpu_macros
	include_nolist	slt
	include	system_types
   	equ	segnam.names.name,1  " CIF is USELESS for level 3
	equ	segnam.names_size,9  " 32 chars + 1 word

	include_nolist	slte
	include_nolist	make_data_macros
	include_nolist	iom_word_macros
	include_nolist	tape_io_commands
	include	firmware_trailer
" 
" This subroutine is used to actually bootload the firmware.
"
"    Usage:
"
"	tsx2	bootload_tape_fw$boot
"

	Bentry	boot
boot:	Bpush

	szn	bootload_info$cold_tape_mpc	" F/W loaded?
	tnz	must_boot			" no

	tsx2	bootload_loader$skip_collection " skip the F/W
	tra	boot_return_		" and return

must_boot:
	lda	slt|slt.last_init_seg
	sta	saved_last_init_seg
	ada	1,dl
	sta	first_fw_seg
	stz	last_fw_seg
	lda	slt|slt.free_core_start
	sta	saved_free_core_start
	lda	slt|slt.free_core_size
	sta	saved_free_core_size

" Now we are prepared to un-load the firmware when we are done
" after the loader loads it.

" The next call will load up a bunch of firmware segments as init segments
" we load low to avoid 256K bug in MPC 
" (no firmware above 256K on unpaged IOM)

	tsx2	bootload_loader$load_collection

	lda	slt|slt.last_init_seg
	sta	last_fw_seg

" now find out what firmware is the correct firmware.

	szn	bootload_info$boot_without_query
	tze	query

	epp	seg2,bootload_info$tape_mpc_fw_name
	cmpc	(pr),()		" is it "-none"?
	desc9a	seg2|0,32
	desc9a	no_fw_specified,32
	tnz	have_fw_name

query:
	epp	seg2,bootload_info$tape_mpc_fw_name
	mlr	(),(pr),fill(040)
	desc9a	0,0
	desc9a	seg2|0,32

	tsx2	bootload_error$tape_fw_prompt
	tsx2	bootload_console$read_line
	arg	bootload_info$tape_mpc_fw_name
	arg	fwid_length
	tsx2	bootload_console$write_nl

	epp	seg2,bootload_info$tape_mpc_fw_name 
	cmpc	(),(pr)
	desc9a	help_string,4
	desc9a	seg2|0,4
	tnz	not_help

help:
	tsx2	bootload_error$tape_mpc_help_1
	tsx2	bootload_error$tape_mpc_help_2
	tra	query

not_help:
	cmpc	(),(pr)
	desc9a	ipc_string,3
	desc9a	seg2|0,3
	tnz	not_ipc
	tra	release_fw_return
not_ipc:
	cmpc	(),(pr)
	desc9a	shut_string,4
	desc9a	seg2|0,4

	tze	bootload_error$shutdown

	cmpc	(),(pr)
	desc9a	question_mark,1
	desc9a	seg2|0,1
	tnz	have_fw_name

	tsx2	list_fw_names
	tra	query
	
NO_MORE_SLTES:
	tsx2	bootload_error$no_such_tape_fw
	tra	query

have_fw_name:
	epp	seg2,bootload_info$tape_mpc_fw_name " copy name for 
	mlr	(pr),()		                " local convienience.
	desc9a	seg2|0,32-5
	desc9a	fw_name_wanted+1(1),32-5	" make fwid.NAME

" here with an ID. Now check out the SLTE's

	tsx2	bootload_slt_manager$get_seg_ptr
	arg	fw_name_wanted
	tra	NO_MORE_SLTES	" couldn't find it

	spri6	fw_seg_ptr	" save it
	als	2		" 4 words in SLTE
	ldq	slt|slt.seg+slte.bit_count_word,al
	div	36,dl		" turn it into a word count

" The first thing we do is adjust the length, by looking backward for the
" word which says "mpcbot".
"
	eaq	-64,ql		QU contains address of last 64 words
	lda	=hmpcbot		look for "mpcbot"
LOOP_FOR_END_OF_FW:
	cmpa	seg|0,qu		..
	tze	FOUND_END
	eaq	1,qu		..
	tra	LOOP_FOR_END_OF_FW

FOUND_END:
	epp6	seg|-(fw_trailer_size-1),qu
				" point to beginning of trailer

	lda	seg|fw_trailer.id_name
				" Get info for message
	sta	fwid
	lda	seg|fw_trailer.rev_level
	sta	fwrev		" save for printing

	ldx7	seg|fw_trailer.rw_start " get address of R/W mem part
	tnz	RW_present	    " x7 is the CS length
	eax7	seg|0		    " CS is all but trailer
				    " and seg|0 is 1 beyond CS
	stz	RW_length		    " no RW
	tra	RW_no_RW_common
RW_present:
	stx7	RW_index
	eax6	seg|0		" one word back of trailer is 
	sblx6	RW_index		" last word of RW.
	sxl6	RW_length
RW_no_RW_common:
	stx7	CS_length
	lxl1	bootload_info$tape_iom_number
	mlr	(x1),()		iom_number starts at 1, so start one
	desc9a	TAGS-1(3),1	char back.
	desc9a	iom_name(3),1

	tsx2	bootload_error$booting_tape_mpc
" 
" BOOT THE CONTROL STORE

	tsx2	reset_and_mask

	ldq	cs_idcw		" boot CS first
	stq	w.idcw

	epp	seg,fw_seg_ptr,*        
	absa_au	seg|0		" CS addr
	ldx7	CS_length		" CS length in X7

	tsx2	boot_a_section
	tra	cs_error		" Error return

	ldq	rw_idcw
	stq	w.idcw

	lxl7	RW_length		" length
	tze	NO_RW
	ldx3	RW_index
	absa_au	seg|0,x3		" address of RW part

	tsx2	boot_a_section
	tra	rw_boot_err

NO_RW:

" All done with booting.

	tsx2	bootload_error$booted_tape_mpc

	
" Now wipe the firmware out of memory

release_fw_return:
	stz	bootload_info$cold_tape_mpc	" F/W is now loaded

	lda	saved_free_core_start
	sta	slt|slt.free_core_start
	lda	saved_free_core_size
	sta	slt|slt.free_core_size
	lda	saved_last_init_seg
	sta	slt|slt.last_init_seg

	lda	first_fw_seg
	als	1		" segno * 2 LOWER
	eax1	0,al

	lda	last_fw_seg
	als	19		" segno * 2 UPPER
	sta	zero_limit
	
	eaa	0
	eaq	0
ZERO_SDWS:
	staq	ds|0,x1
	eax1	2,x1
	cmpx1	zero_limit
	tmi	ZERO_SDWS
	
boot_return_:
	boot_return
" 
boot_a_section:
	Bpush

	stca	w.dcw_1,70	" first DCW starts there
	sta	bs.start_addr	" save it UPPER
	eaa	0,x7		" grab the length
	arl	18		" to AL
	cmpa	=o010000,dl	" fits in one?
	tpl	bs.big_firmware
	tnz	bs.easy_small	" 4095 or less
	lda	0,dl		" 0 --> 4096!
bs.easy_small:			" 4095 or less, in A
				" clear out the IOTP to an IOTD 
	stca	w.dcw_1,07	" and store low half
	tra	bs.connect	" all set
bs.big_firmware:
	ldq	=o010000,dl	" max tally with IOTP type
	stcq	w.dcw_1,07	" store flags and tally
	sba	=o010000,dl	" reduce tally by amt used
	stca	w.dcw_2,03	" leave IOTD bit off
	lda	bs.start_addr	" UPPER
	ada	=o010000,du	" bump addr by amount used
	stca	w.dcw_2,70	" store address

bs.connect:		" Guaranteed to fit in 2 * 7777(8)
	rscr	32		" get the time
	staq	io_start_time	" save it
	ldaq	w.dcw_1		" get current dcws (1 & 2)
	staq	dcw_save_area	" and save for POF retry
bs.try_again:
	ldaq	dcw_save_area	" load old dcws (1 & 2)
	staq	w.dcw_1		" refresh the dcws (1 & 2)
	tsx2	bootload_io$connect
	arg	bootload_info$tape_iom_number
	arg	bootload_info$tape_channel_number
	arg	w.pcw
	arg	w.idcw

	cana	bootload_info$status_mask
	tze	bs.good_status	" status OK, now take short pause
	cmpa	=o600000,du	" Power Off Status?
	tze	bs.retry_pof	" OK to retry POFs
	tra	bs.error		" abort
bs.good_status:
	lda	=40000,dl		" should be about 1 second
	sbla	1,dl
	tze	bs.waited
	tra	*-2

" Power off faults should be retried for upto 20 seconds, because
" the new controllers and I/O units that contain micro processors require
" extra time to complete the RESET initiated via the reset_and_mask routine.
" The I/O Multiplexer will continue to return power-off (POF) until the
" controller signals that it is ready to accept the next I/O sequence.

bs.retry_pof:
	ldq	=o1000,dl		" small pause
	sblq	1,dl
	tpl	-1,ic
	rscr	32		" get the time
	sbaq	io_start_time	" rel-a-tize
	cmpaq	twenty_sec_limit	" is twenty seconds up?
	tmi	bs.try_again	" NO, try one mo time
	Breturn	0		" give up....

bs.waited:
	Breturn	1  " SKIP
bs.error:
	Breturn	0
" 
cs_error:
	staq	erstat
	lda	=a  cs
	tra	boot_err_join

rw_boot_err:
	staq	erstat
	lda	=a  rw
	tra	boot_err_join

boot_err_join:
	sta	fwtype
	tsx2	bootload_error$tape_mpc_boot_error
	tra	query 		" Ounce Agan
" 
	Bentry	reset_and_mask
reset_and_mask:
	Bpush

	tsx2	bootload_io$connect
	arg	bootload_info$tape_iom_number
	arg	bootload_info$tape_channel_number
	arg	reset_and_mask_pcw
	arg	0

	lda	=40000,dl			" should be about 1 second
	odd
	sba	1,dl
	tpl	-1,ic
	Breturn

	make_idcw	reset_and_mask_pcw,
		TAPE.reset_status,
		0,
		nondata,marker,,,mask    " for mask, marker means reset
" 
list_fw_names:
	Bpush

	tsx2	bootload_error$tape_mpc_type_list
	epp	seg2,slt|slt.seg	" first slte
	lda	first_fw_seg	" segno
	als	2		" * 4 for slte offset
	eax1	0,al		" seg2|0,x1 -> slte
	lda	last_fw_seg
	als	20		" make it * 4 DU
	sta	last_slte_offset

list.LOOP_ON_SLTES:
	ldx3	seg2|slte.names_ptr,x1	" DU
	epp	seg,nt|0,x3		" seg|0 -> segnam

" Only print first name with prefix fwid.

	lxl4	seg|segnam.count
	eax5	0
	epp	seg,seg|segnam.names  " Point to the array

list.LOOP_ON_NAMES:

	cmpc	(pr,x5),()
	desc9a	seg|segnam.names.name,5
	desc9a	fw_name_wanted,5

	tnz	list.NOT_FWID

	mlr	(pr,x5),(),fill(040)
	desc9a	seg|segnam.names.name+1(1),27
	desc9a	name_to_print.name,32

	tsx2	bootload_console$write
	arg	name_to_print
	arg	fwid_length
	tsx2	bootload_console$write_nl

	tra	list.NEXT_SLTE

list.NOT_FWID:			" next name, please
	eax4	-1,x4
	tze	list.NEXT_SLTE
	eax5	segnam.names_size*4,x5  " character offset
	tra	list.LOOP_ON_NAMES

list.NEXT_SLTE:
	eax1	4,x1
	cmpx1	last_slte_offset
	tmoz	list.LOOP_ON_SLTES
	Breturn

name_to_print:
name_to_print.spaces:
	aci	"    ",4   " 4 spaces indent
name_to_print.name:
	aci	"",32	 " name goes in here

" 

	segdef	fwid,fwrev,fwtype,erstat,iom_name

fwid:	bss	,1		F/W module ID
fwrev:	bss	,1		F/W module revision

fwtype:	bss	,1		for error messages
iom_name:	aci	"",4		for printing boot message
	even
erstat:	bss	,2		error status
TAGS:	aci	"ABCD",4		for IOM name

no_fw_specified:
	aci	"-none",32
fw_name_wanted:
	aci	"fwid.",32
zero_limit:
last_slte_offset:
	bss	,1
question_mark:
	aci	"?",4
help_string:
	aci	"help",4
ipc_string:
	aci	"ipc ",4
shut_string:
	aci	"shut",4

fwid_length:
	vfd	36/6		" FWID's are only 6 chars long

" WORKSPACE for booting the MPC

	even
	bss	dcw_save_area,2
	bss	io_start_time,2
twenty_sec_limit:
	dec	0,20000000	" twenty seconds (in micros)

	make_idcw	cs_idcw,
		TAPE.control_store_overlay,
		0,
		record,
		terminate
	make_idcw	rw_idcw,
		TAPE.main_memory_overlay,
		0,
		record,
		terminate

	make_idcw	w.pcw,
		TAPE.reset_status,
		0,
		nondata,
		proceed		
	bss	w.idcw,1			" stored for RW versus CS
	make_ddcw	w.dcw_1,0,0,iotp		" patched to IOTD if short
	make_ddcw	w.dcw_2,0,0,iotd              " always IOTD if used at all

" The data is in the firmware segment

	end




		    template_slt_.alm               11/11/89  1136.5r w 11/11/89  0837.2      122994



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1983 *
" *                                                         *
" ***********************************************************
	name	template_slt_

" Modified '82 for bootload Multics 10.2
" Modified '83 for adp by Keith Loepere.

	include	bootload_equs
	include	slt
	include	slte
	include	unpaged_page_tables
" 
	segdef	slt_length
	segdef	name_table_length
	segdef	t_slt
	segdef	t_name_table
	segdef	dseg,adp_dseg
	segdef	upt,init_upt,adp_upt,adp_init_upt
	segdef	dsbr,adp_dsbr

" This "program" generates the slt, name_table, dseg and unpaged page tables
" corresponding to the collection 0 segments.  All of this is done through 
" three main macros.  

" seg starts the declaration of a segment.  It takes two arguments.  One is
" the segment name.  The second is either "sup" or "init", specifying whether
" this is a supervisor (permanent) or initialization segment.

" paged_seg ends the declaration of a segment.  It takes three arguments.  The
" first is the repeat of the segment name.  The second is either "init" or 
" "sup", specifying whether the page table is permanent (corresponding to a
" "unpaged" supervisor segment) or is for initialization only.  The third 
" argument is either "norm" or "abs_seg".  A "norm" type is given a page table
" and is allocated memory according to the size of the segment.  An "abs_seg"
" type uses the max_length to determine the page table size (but cur_length to
" determine memory allocation).

" unpaged_seg ends the description of a segment whose sdw will specify it as
" unpaged.  The second argument here is ignored.

" Between the seg and either the unpaged_seg or the paged_seg calls appears 
" various calls that set attributes of the segment.

	macro	seg

" start the description of a segment

	set	s.1,0
	set	s.2,0
&=&2,sup&[

" use low segment nos for supervisor (permanent) segments

	set	sup_segno,sup_segno+1
	set	s.segno,sup_segno
&;
" initialization segments use high segnos

	set	init_segno,init_segno+1
	set	s.segno,init_segno
	set	s.2,s.2+slte_uns.init_seg
&]
	equ	&1_seg_num,s.segno

	use	names

" We just set one name for these template_slt_ segments.

	dec	1		" count
	vfd	18/0,1/0,5/0,12/s.segno
	aci	"&1",32

" Set up the defaults for this segment.  These are overridden by other macro
" calls.

	set	s.path,0
	set	s.rings,0
	set	s.max_length,0
	set	s.cur_length,0
	set	s.absloc,0
	set	s.access,0
	set	sf.abs_seg,0

	set	seg_index,seg_index+1
	equ	&1_index,seg_index
	&end


	bool	a.read,10
	bool	a.execute,04
	bool	a.write,02
	bool	a.privileged,01

	macro	access

" Set the bits to be set into slte.access

&R&(	set	s.access,s.access+a.&i
&)
	&end


	macro	flags

" Set the bits that will be set into slte.flags.

&R&(	set	s.1,s.1+slte_uns.&i
	set	sf.&i,1
&)
	&end


	macro	flags2

" Set the bits that will ve set into slte.flags2.

&R&(	set	s.2,s.2+slte_uns.&i
&)
	&end


	macro	absloc

" Declare the segment to have a fixed (absolute) memory range.  This macro
" used here in template_slt_ is the only way to achieve this.
" Arguments are the starting address and the length.

	set_o	s.cur_length,&2
	set	s.max_length,(s.cur_length/1024)
	set_o	s.absloc,&1
	&end


	macro	allocate

" Allocate a specified number of words, using the slt allocation pointers.
" (The slt header will receive the updated values later.)

	set_o	s.cur_length,&1
	set	s.max_length,(s.cur_length/1024)
	set	s.absloc,first_free_word
	set	first_free_word,first_free_word+s.cur_length
	&end


	macro	branch

" Remember a path to add to the name_table.  Assume rings of 0 5 5.

	set	s.2,s.2+slte_uns.branch_required
	set	s.path,name_seg_size
	set	s.rings,R055
	&end


	macro	unpaged_seg

" Generate the objects for an unpaged (sdw-wise) segment.

	maclist	on
	use	sltes
	maclist	object

" Generate the slt entry.

	zero	name_seg_size+sl1_path_size+10*seg_index,s.path
	vfd	4/s.access,14/s.1,18/s.2
	vfd	9/((s.cur_length+1023)/1024),9/s.rings,18/s.segno
	vfd	3/0,9/s.max_length,24/36*s.cur_length

	maclist	on

" Generate sdw's for both DPS-8 and ADP systems.

	use	template_dseg
	maclist	object
	vfd	24/s.absloc,9/s.rings,1/(1-sf.abs_seg),2/0
	vfd	1/0,14/(s.cur_length/16-1),4/s.access,1/1,1/1,1/0,14/0

	maclist	on
	use	adp_template_dseg
	maclist	object
	vfd	22/(s.absloc/16),4/0,1/(1-sf.abs_seg),9/s.rings
	vfd	14/(s.cur_length/16-1),4/0,12/0,4/s.access,1/1,1/1

	maclist	on
	use	definitions

" Add entries so collection zero programs can look up attributes of this
" segment.

	maclist	off
	segdef	&1_ptr
	segdef	&1_absloc
	segdef	&1_lth

	even
	maclist	on
&1_ptr:	its	s.segno,0
&1_absloc: vfd	36/s.absloc
&1_lth:	vfd	36/s.cur_length
	maclist	off
	&end


	macro	paged_seg

" Generate the objects for a paged (sdw-wise) segment.
" Start by finding the page table location.

&=&2,sup&[
	use	template_upt
	set	s.upt_address,upt_end+upt_absloc+upt_entry.ptws
&;
	use	template_init_upt
	set	s.upt_address,iupt_end+iupt_absloc+upt_entry.ptws
&]
	maclist	on
	use	sltes
	maclist	object

" Generate the slt entry.

	zero	name_seg_size+sl1_path_size+10*seg_index,s.path
	vfd	4/s.access,14/s.1,18/s.2
	vfd	9/((s.cur_length+1023)/1024),9/s.rings,18/s.segno
	vfd	3/0,9/s.max_length,24/36*s.cur_length

	maclist	off

" Find the page table length.

&^=&3,norm&[
	set	s.page_table_length,s.max_length
&;
	set	s.page_table_length,(s.cur_length/1024)
&]

" Generate the sdw's for the segment (DPS-8 and ADP).  The bound set 
" corresponds to the page table length.

	maclist	on
	use	template_dseg
	maclist	object
	vfd	24/s.upt_address,9/s.rings,1/1,2/0
	vfd	1/0,14/(s.page_table_length*64-1),4/s.access,1/0,1/1,1/0,14/0

	maclist	on
	use	adp_template_dseg
	maclist	object
	vfd	26/s.upt_address,1/1,9/s.rings
	vfd	8/(s.page_table_length-1),10/0,12/0,4/s.access,1/0,1/1

	maclist	off

" Update the unpaged page table running pointers and add entries to them
" to describe the page table to follow.

&=&2,init&[
	set	iupt_end,iupt_end+upt_entry.ptws+(((s.page_table_length)+1)/2)*2
	maclist	on
	use	template_init_upt
&;	set	upt_end,upt_end+upt_entry.ptws+(((s.page_table_length)+1)/2)*2
	maclist	on
	use	template_upt
&]	maclist	object
	vfd	36/s.page_table_length
	vfd	36/s.segno

" Generate the ptw's for this segment.  The two dups correspond to the ptws
" for which memory is allocated followed by those simply described by max 
" length.  As of this writing, all segments have either all of their ptws 
" describe memory locations or they have none of them do.  AT one time, though,
" a segment of mixed type did exist.

	maclist	off		
&^=&3,abs_seg&[
	set	s.running_absloc,s.absloc
	dup	(s.cur_length/1024)
	maclist	object
	vfd	18/(s.running_absloc/64),4o/10,1/1,1/0,2/0,1/0,1/0,1/0,1/0,1/0,1/1,1/0,1/1,2/1
	maclist	off
	set	s.running_absloc,s.running_absloc+1024
	dupend
&;&]
&^=&3,norm&[
	dup	(s.max_length-(s.cur_length/1024))
	maclist	object			" pad with bad pages
	vfd	18/0,4o/10,1/1,1/0,2/0,1/0,1/0,1/0,1/0,1/0,1/1,1/0,1/0,2/1
	dupend
&;&]
	even

	maclist	on
&=&2,init&[	use	adp_template_init_upt
&;	use	adp_template_upt
&]	maclist	object
	vfd	36/s.page_table_length
	vfd	36/s.segno
	maclist	off
&^=&3,abs_seg&[
	set	s.running_absloc,s.absloc
	dup	(s.cur_length/1024)
	maclist	object
	vfd	2/0,16/(s.running_absloc/1024),4/0,1/0,1/1,1/0,1/0,1/0,3/0,1/1,1/1,1/0,1/1,1/0,1/0
	maclist	off
	set	s.running_absloc,s.running_absloc+1024
	dupend
&;&]
&^=&3,norm&[
	dup	(s.max_length-(s.cur_length/1024))
	maclist	object			" pad with bad pages
	vfd	2/0,16/0,4/0,1/0,1/1,1/0,1/0,1/0,3/0,1/1,1/0,1/0,1/0,1/0,1/0
	dupend
&;&]
	even

	maclist	on

" Add entries here so that programs may look up the attributes of this segment.

	use	definitions
	maclist	off
	segdef	&1_ptr
	segdef	&1_absloc
	segdef	&1_lth

	even
	maclist	on
&1_ptr:	its	s.segno,0
&1_absloc: vfd	36/s.absloc
&1_lth:	vfd	36/s.cur_length
	maclist	off
	&end
" 
	equ	FIRST_SUP_SEG,0
	equ	FIRST_INIT_SEG,256
	bool	R055,055

" Initial values for counters.

	set	sup_segno,FIRST_SUP_SEG-1
	set	init_segno,FIRST_INIT_SEG-1
	set	upt_end,upt.first_entry
	set	iupt_end,upt.first_entry
	set	seg_index,-1
	set	first_free_word,prb_absloc+prb_lth

	use	template_dseg
dseg:
	use	adp_template_dseg
adp_dseg:

" Start unpaged page tables past the header.  We will go back and fill them in
" later.

	use	template_upt
	org	upt.first_entry

	use	template_init_upt
	org	upt.first_entry

	use	adp_template_upt
	org	upt.first_entry

	use	adp_template_init_upt
	org	upt.first_entry

	use	names
sl1_path:
	dec	17		" count
	aci	">system_library_1",17
	dec	0		" ACL
	equ	sl1_path_size,*-sl1_path

	maclist	off

" START of segment descriptions.

	seg	dseg,sup		" The DSEG must be segment 0.
	access	read,write
	flags	wired,paged,per_process
	allocate	2000
	set	s.max_length,8
	paged_seg	dseg,init,norm	" dseg is perm but page table is temp
				" since it becomes paged

" Generate the dbr's to be used.  These dbr's reflect the dseg sdw's.

	use	.text
dsbr:	vfd	24/s.upt_address,12/0
	vfd	1/0,14/(1024/16-1),4/0,1/0,4/0,12/0

adp_dsbr:	vfd	26/s.upt_address,10/0
	vfd	8/(1024/1024-1),6/0,4/0,12/0,4/0,1/0,1/0

	seg	bos_toehold,sup
	access	read,write
	flags	wired,layout_seg
	absloc	10000,2000
	paged_seg	bos_toehold,sup,norm

	seg	config_deck,sup
	access	read,write
	absloc	12000,10000
	flags	abs_seg,paged
	branch
	paged_seg	config_deck,init,norm	becomes paged

	seg	dn355_mailbox,sup
	access	read,write
	flags	wired,layout_seg
	absloc	3400,3000
	unpaged_seg dn355_mailbox,sup

	seg	fault_vector,sup
	access	read,write
	flags	wired,layout_seg
	absloc	0,600
	unpaged_seg fault_vector,sup

	seg	flagbox,sup
	access	read,write
	flags	wired,layout_seg
	absloc	fgbx_absloc,fgbx_lth
	paged_seg	flagbox,sup,norm

	seg	name_table,sup
	access	read,write
	flags	paged
	allocate	14000
	set	s.max_length,12
	branch
	paged_seg	name_table,init,norm

	seg	slt,sup		" The SLT must be segment 7.
	access	read,write
	flags	paged
	allocate	4000
	branch
	paged_seg	slt,init,norm

	seg	toehold_data,sup
	access	read,write
	flags	wired,layout_seg
	absloc	toedata_absloc,toedata_lth
	paged_seg	toehold_data,sup,norm

	seg	iom_mailbox,sup
	access	read,write
	flags	wired,layout_seg
	absloc	1200,2200
	unpaged_seg iom_mailbox,sup

	seg	unpaged_page_tables,sup
	access	read,write
	flags	wired,layout_seg
	absloc	upt_absloc,upt_lth
	paged_seg	unpaged_page_tables,sup,norm

	seg	toehold,sup
	access	read,write
	flags	wired,layout_seg
	absloc	toe_absloc,toe_lth
	paged_seg	toehold,sup,norm

	seg	breakpoint_page,sup
	access	read,write
	flags	wired,layout_seg
	absloc	bkpt_absloc,bkpt_lth
	paged_seg	breakpoint_page,sup,norm

	seg	bound_bootload_0,init
	access	read,execute,write,privileged
	flags	paged,abs_seg	" we destroy ourselves
	absloc	bbl0_absloc,bbl0_lth
	paged_seg	bound_bootload_0,init,norm

	seg	physical_record_buffer,init
	access	read,write
	flags	paged
	absloc	prb_absloc,prb_lth
	paged_seg	physical_record_buffer,init,norm

	seg	abs_seg0,init
	access	read,execute,write,privileged
	flags	abs_seg
	set	s.max_length,256
	set	s.cur_length,0
	paged_seg abs_seg0,init,abs_seg

	seg	int_unpaged_page_tables,init
	access	read,write
	flags	paged,abs_seg	" we destroy ourselves
	absloc	iupt_absloc,iupt_lth
	paged_seg	int_unpaged_page_tables,init,norm

	seg	early_dump,init
	access	read,execute,write,privileged
	flags	abs_seg
	set	s.max_length,1
	set	s.cur_length,0
	paged_seg early_dump,init,abs_seg

" Fill in the slt header.

	use	slt_header
t_slt:	its	name_table_seg_num,0
	vfd	36/first_free_word
	vfd	36/FIRST_SUP_SEG
	vfd	36/sup_segno
	vfd	36/FIRST_INIT_SEG
	vfd	36/init_segno
	dec	0

" And the name_table header.

	equ	name_words,name_seg_size+sl1_path_size+(seg_index+1)*10

	use	name_header
t_name_table:
	zero	0,name_words
	bss	,name_seg_size-1


	use	template_header
name_table_length:
	vfd	36/name_words
slt_length:
	vfd	36/slt.seg+(seg_index+1)*slte_size

" This is so the checker can find things in this segment.

	use	map
	even
	zero	t_slt,t_name_table
	zero	-1,-1

" unpaged page table's headers.

	use	template_upt
	org	0
upt:	vfd	36/0			" sst_absloc
	vfd	36/0			" sst_last_loc
	vfd	36/upt_absloc		" upt_absloc
	vfd	36/upt_absloc+upt_lth-1 	" upt_last_loc
	vfd	36/iupt_absloc		" iupt_absloc
	vfd	36/iupt_absloc+iupt_lth-1 	" iupt_last_loc
	vfd	36/upt_end
	vfd	36/upt_lth

	use	template_init_upt
	org	0
init_upt:	vfd	36/0			" sst_absloc
	vfd	36/0			" sst_last_loc
	vfd	36/upt_absloc		" upt_absloc
	vfd	36/upt_absloc+upt_lth-1 	" upt_last_loc
	vfd	36/iupt_absloc		" iupt_absloc
	vfd	36/iupt_absloc+iupt_lth-1 	" iupt_last_loc
	vfd	36/iupt_end
	vfd	36/iupt_lth

	use	adp_template_upt
	org	0
adp_upt:	vfd	36/0			" sst_absloc
	vfd	36/0			" sst_last_loc
	vfd	36/upt_absloc		" upt_absloc
	vfd	36/upt_absloc+upt_lth-1 	" upt_last_loc
	vfd	36/iupt_absloc		" iupt_absloc
	vfd	36/iupt_absloc+iupt_lth-1 	" iupt_last_loc
	vfd	36/upt_end
	vfd	36/upt_lth

	use	adp_template_init_upt
	org	0
adp_init_upt: vfd	36/0			" sst_absloc
	vfd	36/0			" sst_last_loc
	vfd	36/upt_absloc		" upt_absloc
	vfd	36/upt_absloc+upt_lth-1 	" upt_last_loc
	vfd	36/iupt_absloc		" iupt_absloc
	vfd	36/iupt_absloc+iupt_lth-1 	" iupt_last_loc
	vfd	36/iupt_end
	vfd	36/iupt_lth

" Put everything together.

	join	/text/template_header
	join	/text/slt_header,sltes
	join	/text/name_header,names
	join	/text/template_dseg
	join	/text/adp_template_dseg
	join	/text/definitions
	join	/text/template_upt
	join	/text/adp_template_upt
	join	/text/template_init_upt
	join	/text/adp_template_init_upt

	join	/text/map			" this MUST be last

	end




		    toehold.alm                     11/11/89  1136.5rew 11/11/89  0830.0      198441



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1984 *
" *                                                         *
" ***********************************************************

" HISTORY COMMENTS:
"  1) change(85-09-09,Fawcett), approve(85-09-09,MCR6979),
"     audit(86-01-31,GDixon), install(86-03-21,MR12.0-1033):
"     Support for FIPS.
"  2) change(87-04-14,Farley), approve(87-07-06,MCR7717),
"     audit(87-07-15,Fawcett), install(87-07-17,MR12.1-1043):
"     Added test for unequal dcw list lengths.  In some cases save_dcws will
"     be longer than handler_dcws.
"                                                      END HISTORY COMMENTS


	name	toehold

" This wired, privileged program resides in the low 256K
" of memory at a known absolute location (toe_absloc). It is
" 
" *** IMPURE
" *** MODIFIED BY OTHER PROGRAMS
" *** PRIVILEGED
" *** RUNS IN ABSOLUTE MODE
"  
" Started by Olin Sibert and Benson Margulies.
" Finished by Keith Loepere in the glow of a maintenance panel.
" Modified by Paul Farley and Rich Fawcett for large MSU3380 cylinders.
" Modified by Keith Loepere to delay (AAARGHHH!!!) after status for DAU.
	
"
	include	bootload_equs
"
	include	coll0_segnos
"
	include	fault_vector
"
	include	flagbox
"
	include	iom_data
"
	include	scr
"
	include	stack_frame
"
	include	toehold_save_dcls_

" *******************************************************************
" Enter at the following in ABSOLUTE MODE, via processor switches   *
" or derail.					        *
" *******************************************************************

	inhibit	on			<><><>ON<><><>

" Entry sequences: each one saves the machine state and then transfers to
" the correct code.  The ret instruction allows some indicators to be set
" at the same time so as to give us a flag saying what entry was made.

	org	TOE_HOLD_CRASH_ENTRY*2
	scu	toe_absloc+temp_scu		" Operator Crash
	ret	toe_absloc+switch_entry

	org	TOE_HOLD_ESD_ENTRY*2
	scu	toe_absloc+temp_scu		" ESD
	ret	toe_absloc+esd_entry

	org	TOE_HOLD_DUMP_ENTRY*2
	scu	toe_absloc+temp_scu		" DUMP entry
	ret	toe_absloc+dump_entry

	org	TOE_HOLD_MULTICS_ENTRY*2
	scu	toe_absloc+temp_scu		" Multics Crash
	ret	toe_absloc+multics_crash_entry

	org	TOE_HOLD_RESTART_ENTRY*2
	scu	toe_absloc+temp_scu		" Multics restart point
	ret	toe_absloc+multics_restart_entry

	org	TOE_HOLD_BOOT_ENTRY*2
	nop				" boot entry
	tra	bootload_abs_mode$0+toe_absloc

	org	toehold.flagbox
flagbox:	bss	,64

	org	toehold.handler_mc
handler_mc:
	bss	,48

	org	toehold.paths		" io paths to use to save/
	equ	n_paths,4			" restore Multics memory
paths:	bss	,io_path_size*n_paths	" (and read us in)

	org	toehold.n_paths_used
n_paths_used:
	bss	,1			" no of slots above used

	org	toehold.memory_state
memory_state:				" key state of memory/Multics
	dec	0

	org	toehold.bce_dbr
bce_dbr:	bss	,2			" used to restart bce

	org	toehold.bce_mode_reg
bce_mode_reg:
	bss	,2			" and cache_mode reg

	org	toehold.esd_segnum
esd_segnum:
	bss	,1

	org	toehold.dcw_list_size
dcw_list_size:
	bss	,1			" dcw_list_size in upper
					" dcws_per_cly in lower
	org	toehold.seeks_used
seeks_used: 
	bss	,1
	
	org	toehold.save_dcws
save_dcws:
	bss	,260			" dcw lists for saving memory

	org	toehold.handler_dcws
handler_dcws:
	bss	,260			" dcw lists for reading bce
"
	org	toehold.handler_code	" toehold code
	mod	16
status:	
	bss	,16			" iom status area
ignore_status:
	bss	,16			" undesired iom status area

temp_scu:					" scu data saved before we
	bss	,8			" know if we want to save it
save_regs:				" regs saved before we have 
	bss	,8			" decided to save state
temp_mode_reg:
	bss	,2			" mode reg save
temp:	bss	,2

pcw:	bss	,2			" for disk i/o

new_cfg:	bss	,2			" scu config info

cfg_mask_mask:
	oct	000777777777	Mask out Mask A and Mask B
	oct	000777777777

status_mask:				" iom mask for finding good 
	vfd	o36/370000770000,36/0	" status

io_timer:	bss	,2			" clock timer for timout

thirty_secs:
	dec	0,30000000		" in microseconds

cow:	oct	0			" connect operand word

turn_off_hregs:
	oct	0
turn_off_cache:
	oct	3

which_entry:
	bss	,1

seeks_done:
	bss	,1			" in disk i/o

operation_type:				" read/write disk i/o
	bss	,1

operation_not_mask:				" for removing operation
	oct	007777777777		" code from idcw's

low_memory_save_size_in_chars:
	vfd	36/4*2048

	equ_o	mbx_absloc,1200

	bool	scr_mr.id.4mw,000002	" id for a 4mw scu

" Index register usage

	equ	rscr_index,7
	equ	last_controller_mask,6	" for mask setting
	equ	zap_smcm_return_index,5

				" for per cylinder i/o
	equ	iom,6		" Index Register to mailbox array
	equ	seek_dcws_index,5 " index off toehold for dcw_list for this seek
	equ	chn,4		" Index Register to channel_mailbox
	equ	dcws_index,3	" index off toehold for dcw_list
	equ	seek_return_index,2 " return from connect_timeout
	equ	io_return_index,1	" return from perform_io
	equ	io_path_index,0	" to io_path
"
	even

bbl0_ptr:	its	bbl0_segno_,0	" for finding early dumper

" operands for return instructions in entry sequences

switch_entry:
	vfd	18/toe_absloc+save_machine_conditions,18/scu.neg+scu.bm+scu.abs

multics_crash_entry:
	vfd	18/toe_absloc+save_machine_conditions,18/scu.bm+scu.abs

esd_entry:
	vfd	18/toe_absloc+save_machine_conditions,18/scu.zero+scu.bm+scu.abs

multics_restart_entry:
	vfd	18/toe_absloc+restore_machine,18/scu.bm+scu.abs

dump_entry:
	vfd	18/toe_absloc+go_to_dump,18/scu.bm+scu.abs

go_to_dump:
	ldt	-1,du
	tra	bootload_early_dump$0+toe_absloc
"
" Main entry to toehold.  Temporarily save state.  See if we need to save this
" state.  If so, copy temporary state into machine state, continue saving.  
" Otherwise, throw away state and proceed to read in bce.

save_machine_conditions:
	scpr	toe_absloc+temp_mode_reg,06
	lcpr	toe_absloc+turn_off_hregs,04
	lcpr	toe_absloc+turn_off_cache,02
	sreg	toe_absloc+save_regs
	sti	toe_absloc+temp
	ldt	-1,du			" no tro, please

	lda	toe_absloc+temp		" extract indicators that
	arl	12			" say how we entered toehold
	ana	=o77,dl
	sta	toe_absloc+which_entry
	tnz	toe_absloc+no_ilc_bump
	lda	1,du		" if Multics entry, must skip drl
	adla	toe_absloc+temp_scu+scu.ilc
	sta	toe_absloc+temp_scu+scu.ilc
no_ilc_bump:

" check to see if we should save memory (and state)

	lda	toe_absloc+memory_state
	tze	toe_absloc+save_state   " will later go to early dump
	cmpa	At_bce__early,dl
	tze	toe_absloc+save_state	" early bce crash
	cmpa	At_bce__boot,dl
	tze	toe_absloc+save_state	" real bce crash
	cmpa	Multics,dl
	tze	toe_absloc+save_state	" service crash/shut
	cmpa	Undefined_saving_state,dl
	tze	toe_absloc+just_save_mbx	" forget state but save mem
	cmpa	Undefined_saving_mem,dl
	tze	toe_absloc+just_write_Multics " state saved

	tsx	zap_smcm_return_index,toe_absloc+zap_smcm
	tra	toe_absloc+read_bce		" just_read_bce

just_save_mbx:
	tsx	zap_smcm_return_index,toe_absloc+zap_smcm
	tra	toe_absloc+done_regs

just_write_Multics:
	tsx	zap_smcm_return_index,toe_absloc+zap_smcm
	tra	toe_absloc+write_Multics

save_state:				" save total state
	lda	toe_absloc+memory_state
	sta	toe_absloc+multics_state+mc_state.old_memory_state
	lda	Undefined_saving_state,dl
	sta	toe_absloc+memory_state

	spri	toe_absloc+multics_state+mc_state.mc_+mc.prs
	spl	toe_absloc+multics_state+mc_state.mc_+mc.eis_info

	lda	toe_absloc+which_entry
	tze	toe_absloc+non_manual_flag

	ldq	fgbx.manual_crash,du	" manual entry
	orsq	fgbx_absloc+fgbx.rtb	" let bce know

non_manual_flag:
	orsa	fgbx_absloc+fgbx.rtb	" bce_entry field

	rscr	SC_ETC*8		" Read clock
	staq	toe_absloc+multics_state+mc_state.mc_+mc.fault_time

	rscr	SC_IC*8		" Read interrupt cells
	staq	toe_absloc+multics_state+mc_state.interrupt

" Next project is to grab an scu mask

	eax	rscr_index,7*64
	eax	last_controller_mask,7*2	" for last controller mask

smcm_loop:
	rscr	2*8,rscr_index	" Read mask
	staq	toe_absloc+multics_state+mc_state.masks,last_controller_mask " save it
	fld	0,dl		" ldaq 0,dl
	sscr	2*8,rscr_index	" zonk it
	eax	rscr_index,-64,rscr_index	" reduce
	eax	last_controller_mask,-2,last_controller_mask " reduce
	tpl	toe_absloc+smcm_loop

	inhibit	off		<><><>OFF<><><>
				" Why not?  We're masked.

	fld	0,dl
	staq	toe_absloc+multics_state+mc_state.cfg
	rscr	SC_MR*8
	canq	scr_mr.id.4mw,du	" we always have mask on 6000 sc
	tze	toe_absloc+skip_mask_set

	rscr	SC_CFG*8		" proceed to set mask A to us, B off
	staq	toe_absloc+multics_state+mc_state.cfg
	anaq	toe_absloc+cfg_mask_mask
	staq	toe_absloc+new_cfg
	lrl	scr_cfg2.port_no_shift+36
	anq	scr_cfg2.port_no_mask,dl	" port no. to QL
	lda	=o400000,du		" Mask A to port 0
	arl	0,ql			" Mask A to our port
	ldq	=o001000,du		" Mask B off
	oraq	toe_absloc+new_cfg
	sscr	SC_CFG*8

skip_mask_set:
	mlr	(),()			" copy temp save state
	desc9a	toe_absloc+temp_scu,8*4	" into real state
	desc9a	toe_absloc+multics_state+mc_state.mc_+mc.scu,8*4
	mlr	(),()
	desc9a	toe_absloc+save_regs,8*4
	desc9a	toe_absloc+multics_state+mc_state.mc_+mc.regs_word,8*4
	ldaq	toe_absloc+temp_mode_reg
	staq	toe_absloc+multics_state+mc_state.mode_reg

	sbar	toe_absloc+multics_state+mc_state.bar
	scpr	toe_absloc+temp,01		" store two words
	ldaq	toe_absloc+temp
	sta	toe_absloc+multics_state+mc_state.mc_+mc.fault_reg
	rsw	2		" what kind of CPU?
	arl	30		" -- AL
	ana	=o000003,dl	" just type
	eax4	0,al		" following expects that in X4
	lrl	mc.cpu_type_shift
	stcq	toe_absloc+multics_state+mc_state.mc_+mc.cpu_type_word,70 " and store

" Save history registers.
" The following is stolen from fim_util.

	ldq	2,du			get a 2 for stepping address
	eax6	4			4 blocks of
scpr1:	eax7	16			16 history registers
	eax3	0			set up for L68 CPU type initally
	cmpx4	1,du			is this a DPS8/70M CPU?
	tnz	toe_absloc+scpr2		xfer if no, it is L68
	eax3	48			yes, set up to skip first 48 hregs
scpr2:	lda	toe_absloc+scpr-1,6		get correct instruction
	sta	toe_absloc+temp		save in stack
scpr3:	xec	toe_absloc+temp		execute the instruction
	cmpx3	0,du			are we through skipping hregs?
	tze	toe_absloc+scpr5		yes, go increment address
	eax3	-1,3			no, skip another
	tra	toe_absloc+scpr3		and go execute scpr again

scpr5:	asq	toe_absloc+temp		increment address of instruction
	eax7	-1,7			count down
	tnz	toe_absloc+scpr3		more of this 16 double word block
	eax6	-1,6			count down
	tnz	toe_absloc+scpr1		another kind of hreg

	eax7	64			initially set clear count to 64
	cmpx4	1,du			is this a DPS8/70M CPU?
	tze	2,ic			yes, clear all 64 hregs
	eax7	16			no, clear only 16 hregs
	lcpr	0,03			set all history regs to zero
	eax7	-1,7			count down
	tpnz	-2,ic			xfer if more to do
	tra	toe_absloc+do_ams

scpr:	scpr	toe_absloc+multics_state+mc_state.ou_history_registers,40
"				OU History Regs for L68, OU/DU for DPS8
	scpr	toe_absloc+multics_state+mc_state.cu_history_registers,20
"					CU History Regs
	scpr	toe_absloc+multics_state+mc_state.du_history_registers,10
"			DU History Regs for L68, extended APU for DPS8
	scpr	toe_absloc+multics_state+mc_state.apu_history_registers,00
"					APU History Regs

do_ams:	sptp	toe_absloc+multics_state+mc_state.ptwam_ptrs	" associative memories
	sptr	toe_absloc+multics_state+mc_state.ptwam_regs
	ssdp	toe_absloc+multics_state+mc_state.sdwam_ptrs
	ssdr	toe_absloc+multics_state+mc_state.sdwam_regs
	cmpx4	1,du
	tnz	toe_absloc+done_regs		for dps8, we must save other three banks
	sptp	toe_absloc+multics_state+mc_state.ptwam_ptrs+16
	sptp	toe_absloc+multics_state+mc_state.ptwam_ptrs+32
	sptp	toe_absloc+multics_state+mc_state.ptwam_ptrs+48

	sptr	toe_absloc+multics_state+mc_state.ptwam_regs+16
	sptr	toe_absloc+multics_state+mc_state.ptwam_regs+32
	sptr	toe_absloc+multics_state+mc_state.ptwam_regs+48

	ssdp	toe_absloc+multics_state+mc_state.sdwam_ptrs+16
	ssdp	toe_absloc+multics_state+mc_state.sdwam_ptrs+32
	ssdp	toe_absloc+multics_state+mc_state.sdwam_ptrs+48

	ssdr	toe_absloc+multics_state+mc_state.sdwam_regs+32
	ssdr	toe_absloc+multics_state+mc_state.sdwam_regs+64
	ssdr	toe_absloc+multics_state+mc_state.sdwam_regs+96
"

done_regs:

" A transfer here in the normal case means that we are done saving state.
" This is not strictly correct.  Normally, it would not matter (except for
" certain obvious exceptions) in what order we saved state.  However, in the 
" case in which the toehold itself is interrupted, we must be very careful.
" If the toehold is interrupted, in general, the state saved will not be 
" correct.  It will not be possible to perform a go.  We must ensure, however,
" that an esd is possible.  To this end, we save certain toehold invariant
" state (information which the toehold doesn't change for its own purposes (as
" opposed to index registers, for instance)) which must be saved and restored
" for a successful esd.

" The idea is to first save the iom_mailbox (two pages containing)
" and then "fix" it for this program's needs. The saved ones
" can then be saved in the image.

	sdbr	toe_absloc+multics_state+mc_state.dbr

	ldq	toe_absloc+low_memory_save_size_in_chars
	mlr	(rl),(rl)
	desc9a	0,ql
	desc9a	toedata_absloc,ql

	eax0	bootload_early_dump$0
	lda	toe_absloc+multics_state+mc_state.old_memory_state
	tze	toe_absloc+bbl0_ptr,*x0
				" not valid, perform an early
				" dump- re-enter appending mode

	lda	Undefined_saving_mem,dl
	sta	toe_absloc+memory_state

write_Multics:

" write out Multics memory image

	lda	=o310000,du		" write
	sta	toe_absloc+operation_type
	eax	dcws_index,save_dcws
	tsx	io_return_index,toe_absloc+perform_io

	lda	Undefined_reading_bce,dl
	sta	toe_absloc+memory_state

read_bce:
	lda	toe_absloc+which_entry
	als	12
	ana	scu.zero,dl
	tnz	toe_absloc+perform_esd

" read in bootload Multics memory image

	lda	=o250000,du		" read
	sta	toe_absloc+operation_type
	eax	dcws_index,handler_dcws
	tsx	io_return_index,toe_absloc+perform_io

" now return to bootload Multics

	ldt	-1,du

	ldq	toe_absloc+low_memory_save_size_in_chars " restore fault_vector
	mlr	(rl),(rl)				" iom_mailbox from
	desc9a	toedata_absloc,ql			" toehold_data
	desc9a	0,ql

	ldbr	toe_absloc+bce_dbr			" restore regs
	lpl	toe_absloc+handler_mc+mc.eis_info
	lpri	toe_absloc+handler_mc+mc.prs
	ldaq	toe_absloc+handler_mc+mc.scu+4
	staq	pr6|stack_frame.return_ptr	" save_handler_mc saved these
					" pointers here for us to
					" reload.  This was because
					" they were stored into the
					" stack after it was saved
					" to disk.
	ldaq	toe_absloc+handler_mc+mc.scu+6
	staq	pr6|stack_frame.operator_ptr

	ldq	At_bce__crash,dl		" new state = crash
	lda	toe_absloc+multics_state+mc_state.old_memory_state
	cmpa	Multics,dl		" (will be refined during
	tnz	toe_absloc+set_new_state	" collection 1)
	lda	fgbx_absloc+fgbx.rtb
	ana	fgbx.shut,du		" = shutdown only if shut
	tze	toe_absloc+set_new_state	" and old state = Multics
	ldq	At_bce__shutdown,dl
set_new_state:
	stq	toe_absloc+memory_state

	lreg	toe_absloc+handler_mc+mc.regs_word
	ldi	toe_absloc+handler_mc+mc.scu+2
	epp0	toe_absloc+handler_mc+mc.scu+0,*
	lcpr	toe_absloc+bce_mode_reg,04	" mode and cache mode reg
	lcpr	toe_absloc+bce_mode_reg+1,02
	tra	pr0|1			" go to short_return in
					" save_handler_mc
"
" esd from switches

perform_esd:
	lda	toe_absloc+esd_segnum	" force to emergency_shutdown|0
	als	scu.psr_shift
	ada	scu.p,dl
	sta	toe_absloc+multics_state+mc_state.mc_+mc.scu+scu.ppr_word

	lda	scu.bm,dl
	sta	toe_absloc+multics_state+mc_state.mc_+mc.scu+scu.ilc

	fld	0,dl
	staq	toe_absloc+multics_state+mc_state.interrupt

	staq	toe_absloc+multics_state+mc_state.cfg

	tra	toe_absloc+restore_machine
"
" Restore the memory image

	inhibit	on			<><><>ON<><><>

restore_machine:
	ldt	-1,du			" no timer runout
	lda	Undefined_continue,dl
	sta	toe_absloc+memory_state

	tsx	zap_smcm_return_index,toe_absloc+zap_smcm  "mask us

	inhibit	off			<><><>OFF<><><>

" Read back Multics

	lda	=o250000,du		" read
	sta	toe_absloc+operation_type
	eax	dcws_index,save_dcws
	tsx	io_return_index,toe_absloc+perform_io

" Restore the IOM Mailbox

	ldq	toe_absloc+low_memory_save_size_in_chars
	mlr	(rl),(rl)
	desc9a	toedata_absloc,ql
	desc9a	0,ql

	ldbr	toe_absloc+multics_state+mc_state.dbr	" restore regs

	ldt	-1,du
	lbar	toe_absloc+multics_state+mc_state.bar

" Turn on cache and hregs here

	lcpr	toe_absloc+multics_state+mc_state.mode_reg,04
	lcpr	toe_absloc+multics_state+mc_state.mode_reg+1,02

" Restore system controllers

	inhibit	on			<><><>ON<><><>

	ldaq	toe_absloc+multics_state+mc_state.cfg
	tze	2,ic
	sscr	SC_CFG*8

	ldaq	toe_absloc+multics_state+mc_state.interrupt
	sscr	SC_IC*8		" restore interrupt cells

	eax	rscr_index,7*64
	eax	last_controller_mask,7*2

restore_mcm_loop:
	ldaq	toe_absloc+multics_state+mc_state.masks,last_controller_mask
	sscr	2*8,rscr_index
	eax	rscr_index,-64,rscr_index
	eax	last_controller_mask,-2,last_controller_mask
	tpl	toe_absloc+restore_mcm_loop

	lpl	toe_absloc+multics_state+mc_state.mc_+mc.eis_info
	lpri	toe_absloc+multics_state+mc_state.mc_+mc.prs

	lda	toe_absloc+multics_state+mc_state.old_memory_state
	sta	toe_absloc+memory_state

	lda	scu.rfi,dl		refetch instruction interrupted
	sta	toe_absloc+multics_state+mc_state.mc_+mc.scu+scu.rfi_word

	lreg	toe_absloc+multics_state+mc_state.mc_+mc.regs_word
	lra	toe_absloc+multics_state+mc_state.mc_+mc.regs_word+7
	ldt	=o40000,dl		wake up soon
	rcu	toe_absloc+multics_state+mc_state.mc_+mc.scu

	inhibit	off			<><><>OFF<><><>
"
perform_io:

" internal procedure to perform io given a dcw_list.
" inputs are operation_type and dcws_index
" For now there are a maximum of 4 paths to try to use to do I/O

try_first_path:
	lda	toe_absloc+low_memory_save_size_in_chars
	mlr	(),(rl),fill(000)	" zero mailboxes
	desc9a	0,0
	desc9a	0,al

	ldq	toe_absloc+n_paths_used
	sbq	1,dl
	mpy	io_path_size,dl
	eax	io_path_index,0,ql	" point to last io_path

try_another_path:
	lda	toe_absloc+paths+io_path.port_number_word,io_path_index
	tze	toe_absloc+bad_path

	eax	seek_dcws_index,dcw_list.seek_addresses,dcws_index " point into structure at first
	stz	toe_absloc+seeks_done	" remember the number we have done.

next_seek:
	szn	toe_absloc+dcw_list.seek_idcw,seek_dcws_index " check for valid idcw
	tze	0,io_return_index		" must be done
	ldt	-1,du			" try i/o through a path
	tsx	seek_return_index,toe_absloc+connect_timeout

	ldaq	toe_absloc+status		" check for error
	tze	toe_absloc+bad_path
	anaq	toe_absloc+status_mask
	tze	toe_absloc+done_seek

bad_path:
	eax	io_path_index,-io_path_size,io_path_index " down
	tpl	toe_absloc+try_another_path
	tra	toe_absloc+try_first_path

done_seek:
	adx	seek_dcws_index,toe_absloc+dcw_list_size " point to next list
	lda	toe_absloc+seeks_done
	ada	1,dl
	sta	toe_absloc+seeks_done
	cmpa	toe_absloc+seeks_used
	tmi	toe_absloc+next_seek
	tra	0,io_return_index		" finished  all seeks
"
" Subroutine to do the I/O
" inputs are operation type, io_path_index, seek_dcws_index

connect_timeout:
	lda	toe_absloc+paths+io_path.iom_number_word,io_path_index	" IOM tag (1-4)
	arl	io_path.iom_number_shift	" upper half
	ana	io_path.iom_number_mask,dl	" mask out port num
	sba	1,dl		" (0-3)
	als	8		" 256 words/mailbox
	eax	iom,iom_mailbox_seg.iom_mailbox,al

	ldq	toe_absloc+paths+io_path.channel_number,io_path_index " channel number
	anq	=o777777,dl	" lower half
	qls	2		" 4 words/channel
	eax	chn,0,ql
	stx	iom,toe_absloc+pcw	" (temp)
	adx	chn,toe_absloc+pcw	" point to the channel_mailbox

	qls	27-2		" now in high byte (invent PCW w/chan)
	lda	toe_absloc+paths+io_path.pcw,io_path_index " get caller's PCW
	staq	toe_absloc+pcw	" save it

	lda	toe_absloc+dcw_list.data_idcw,seek_dcws_index
	ana	toe_absloc+operation_not_mask
	ora	toe_absloc+operation_type	" make into appropriate idcw
	sta	toe_absloc+dcw_list.data_idcw,seek_dcws_index

	absa	toe_absloc+dcw_list.seek_idcw,seek_dcws_index	 " get address of DCW list
	als	6		" in AU
	sta	mbx_absloc+channel_mailbox.lpw,chn	" set DCW addr, clear rest
	stz	mbx_absloc+channel_mailbox.lpw+1,chn	" Unused
				" store LPW

 	absa	toe_absloc+status	" get address of status area
	als	6		" in AU
	sta	mbx_absloc+channel_mailbox.scw,chn " status there
				" set SCW

	absa	toe_absloc+pcw	" get address of PCW
	als	6		" in AU
	ora	=o020001,dl	" set bits for connect LPW
	sta	mbx_absloc+(connect_channel*4)+channel_mailbox.lpw,iom

	lda	toe_absloc+paths+io_path.port_number_word,io_path_index
	arl	io_path.port_number_shift	" port number on scu of iom
	ana	io_path.port_number_mask,dl	" into cow
	sta	toe_absloc+cow

	stz	toe_absloc+status
	cioc	toe_absloc+cow	" fire up the IOM

	lda	toe_absloc+pcw	" look at the PCW
	cana	=o040000,dl	" was it a mask?
	tnz	toe_absloc+no_status " yes, no status

	rscr	SC_ETC*8		" current time
	adaq	toe_absloc+thirty_secs
	staq	toe_absloc+io_timer	" timeout time

status_wait:
	ldaq	toe_absloc+status	" status yet?
	tmi	toe_absloc+got_status

	rscr	SC_ETC*8		" watch time go by
	cmpaq	toe_absloc+io_timer	" count down to timeout
	tmi	toe_absloc+status_wait " fall through on timeout
				" caller detects since status is 0
no_status:
	fld	0,dl		" make sure status is 0 on timeout
got_status:			" or mask PCW, for that matter
	staq	toe_absloc+status

	absa	toe_absloc+ignore_status " make sure no more status arrives
	als	6
	sta	mbx_absloc+channel_mailbox.scw,chn

" delay after status return so DAU/Dipper can reset themselves

	rscr	SC_ETC*8		" current time
	staq	toe_absloc+io_timer

status_delay:
	rscr	SC_ETC*8		" watch time go by
	sbaq	toe_absloc+io_timer	" time gone by
	cmpq	150,dl		" 150 usecs is good
	tmi	toe_absloc+status_delay

	tra	0,seek_return_index
"
	inhibit	on			<><><>ON<><><>

zap_smcm:					" mask all controllers
	eax	rscr_index,7*64
	eax	last_controller_mask,7*2	" for last controller mask

zap_smcm_loop:				" mask us
	fld	0,dl			" ldaq 0,dl
	sscr	2*8,rscr_index		" zonk it
	eax	rscr_index,-64,rscr_index	" reduce
	eax	last_controller_mask,-2,last_controller_mask " reduce
	tpl	toe_absloc+zap_smcm_loop
	tra	0,zap_smcm_return_index

	inhibit	off			<><><>OFF<><><>
	
	org	toehold.multics_state	" machine state of Multics
multics_state:
	bss	,mc_state_size
	end






		    bull_copyright_notice.txt       08/30/05  1008.4r   08/30/05  1007.3    00020025

                                          -----------------------------------------------------------


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
