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

"	Operator Segment for pl/1
"	Barry Wolman
"	March, 1969
"
"	Modified: 10 April, 1971 by BLW
"	Modified: 25 April, 1971 by BLW to have entry operator in text section
"	Modified: June, 1972 by RBS for followon
"	Modified: July, 1973 by RBS to see if stac working
"
	name	pl1_operators
"
	segdef	operator_table
	segdef	pl1_operator_begin
	segdef	pl1_operators_end
	segdef	ext_entry
	segdef	int_entry
	segdef	ext_entry_desc
	segdef	desc_ext_entry
	segdef	int_entry_desc
	segdef	desc_int_entry
	segdef	val_entry
	segdef	val_entry_desc
	segdef	desc_val_entry
	segdef	call_out



	include	stack_header
	include	stack_frame
	include	mc
"
"	Definitions of variables used by operators.  Since all
"	of the operators execute using the stack frame of the
"	pl/1 program for their temporary storage, locations 32-61
"	of the pl/1 stack frame are reserved for operator use.
"
	equ	pl1_code,1	code identifying pl/1 compiled prog
	equ	maxpr,71		max precision of double fixed
"
"
	equ	length,15		timer in SREG storage
	equ	count,15
	equ	bit_op,6
	equ	n,6
	equ	display_ptr,32
	equ	int_static_ptr,34
	equ	linkage_ptr,36
	equ	on_unit_mask,31
	equ	temp_pt,40
	equ	temp_aq,42
	equ	single_bit_temp,44
	equ	double_temp,46
	equ	temp_size,48
	equ	extend_size,49
	equ	lg1,50
	equ	str1,51
	equ	a1,52
	equ	rem1,53
	equ	xr2,53
	equ	a2,54
	equ	old_lg1,55
	equ	qmask,55
	equ	arg_list,56
	equ	save_regs,56
	equ	move_return,56
	equ	label_var,56
	equ	free_pt,56
	equ	save_x23,57
	equ	rpd_pt,58
	equ	free_amt,58
	equ	lv,60
	equ	pad_it,60
	equ	num,60
	equ	lg2,61
	equ	temp,62
	equ	str2,63
"
	bool	stba,5511
	bool	stbq,5521
	bool	stca,7511
	bool	stcq,7521
"
pl1_operator_begin:
	null
"
" THE FOLLOWING SECTION IS DIRECTLY REFERENCED FROM PL/1 PROGRAMS BY MEANS OF
" ab|offset.  FOR THIS REASON, PL1_OPERATORS MUST BE THE FIRST COMPONENT OF
" ANY BOUND SEGMENT IN WHICH IT APPEARS AND THE ORDER OF THE FOLLOWING
" INSTRUCTIONS MUST NOT BE CHANGED!
"
"	shift table for 9 bit bytes
"
shift_9:	vfd	18/0,18/0
	vfd	18/9,18/0
	vfd	18/18,18/0
	vfd	18/27,18/0
"
"	shift table for 6 bit bytes
"
shift_6:	vfd	18/0,18/0
	vfd	18/6,18/0
	vfd	18/12,18/0
	vfd	18/18,18/0
	vfd	18/24,18/0
	vfd	18/30,18/0
"
"	store table from a, 9 bit
"					OFFSET	SIZE
"
store_a9:	vfd	o18/200000,o12/stba,o6/40 0	1
	vfd	o18/200000,o12/stba,o6/20 1
	vfd	o18/200000,o12/stba,o6/10 2
	vfd	o18/200000,o12/stba,o6/04 3
	vfd	o18/200000,o12/stba,o6/60 0	2
	vfd	o18/200000,o12/stba,o6/30 1
	vfd	o18/200000,o12/stba,o6/14 2
	vfd	o18/200000,o12/stba,o6/04 3
	vfd	o18/200000,o12/stba,o6/70 0	3
	vfd	o18/200000,o12/stba,o6/34 1
	vfd	o18/200000,o12/stba,o6/14 2
	vfd	o18/200000,o12/stba,o6/04 3
	sta	bp|0		0	4
	vfd	o18/200000,o12/stba,o6/34 1
	vfd	o18/200000,o12/stba,o6/14 2
	vfd	o18/200000,o12/stba,o6/04 3
	sta	bp|0		0	5
	vfd	o18/200000,o12/stba,o6/34 1
	vfd	o18/200000,o12/stba,o6/14 2
	vfd	o18/200000,o12/stba,o6/04 3
"
"	store table from q, 9 bit
"					OFFSET	SIZE
"
store_q9:	nop	0,dl		0	2
	nop	0,dl		1
	nop	0,dl		2
	vfd	o18/200001,o12/stbq,o6/40 3
	nop	0,dl		0	3
	nop	0,dl		1
	vfd	o18/200001,o12/stbq,o6/40 2
	vfd	o18/200001,o12/stbq,o6/60 3
	nop	0,dl		0	4
	vfd	o18/200001,o12/stbq,o6/40 1
	vfd	o18/200001,o12/stbq,o6/60 2
	vfd	o18/200001,o12/stbq,o6/70 3
	vfd	o18/200001,o12/stbq,o6/40 0	5
	vfd	o18/200001,o12/stbq,o6/60 1
	vfd	o18/200001,o12/stbq,o6/70 2
	stq	bp|1		3
"
"	store table from a, 6 bit
"					OFFSET	SIZE
"
store_a6:	vfd	o18/200000,o12/stca,o6/40 0	1
	vfd	o18/200000,o12/stca,o6/20 1
	vfd	o18/200000,o12/stca,o6/10 2
	vfd	o18/200000,o12/stca,o6/04 3
	vfd	o18/200000,o12/stca,o6/02 4
	vfd	o18/200000,o12/stca,o6/01 5
	vfd	o18/200000,o12/stca,o6/60 0	2
	vfd	o18/200000,o12/stca,o6/30 1
	vfd	o18/200000,o12/stca,o6/14 2
	vfd	o18/200000,o12/stca,o6/06 3
	vfd	o18/200000,o12/stca,o6/03 4
	vfd	o18/200000,o12/stca,o6/01 5
	vfd	o18/200000,o12/stca,o6/70 0	3
	vfd	o18/200000,o12/stca,o6/34 1
	vfd	o18/200000,o12/stca,o6/16 2
	vfd	o18/200000,o12/stca,o6/07 3
	vfd	o18/200000,o12/stca,o6/03 4
	vfd	o18/200000,o12/stca,o6/01 5
	vfd	o18/200000,o12/stca,o6/74 0	4
	vfd	o18/200000,o12/stca,o6/36 1
	vfd	o18/200000,o12/stca,o6/17 2
	vfd	o18/200000,o12/stca,o6/07 3
	vfd	o18/200000,o12/stca,o6/03 4
	vfd	o18/200000,o12/stca,o6/01 5
	vfd	o18/200000,o12/stca,o6/76 0	5
	vfd	o18/200000,o12/stca,o6/37 1
	vfd	o18/200000,o12/stca,o6/17 2
	vfd	o18/200000,o12/stca,o6/07 3
	vfd	o18/200000,o12/stca,o6/03 4
	vfd	o18/200000,o12/stca,o6/01 5
	sta	bp|0		0	6
	vfd	o18/200000,o12/stca,o6/37 1
	vfd	o18/200000,o12/stca,o6/17 2
	vfd	o18/200000,o12/stca,o6/07 3
	vfd	o18/200000,o12/stca,o6/03 4
	vfd	o18/200000,o12/stca,o6/01 5
	sta	bp|0		0	7
	vfd	o18/200000,o12/stca,o6/37 1
	vfd	o18/200000,o12/stca,o6/17 2
	vfd	o18/200000,o12/stca,o6/07 3
	vfd	o18/200000,o12/stca,o6/03 4
	vfd	o18/200000,o12/stca,o6/01 5
"
"	store table from q, 6 bit
"					OFFSET	SIZE
"
store_q6:	nop	0,dl		0	2
	nop	0,dl		1
	nop	0,dl		2
	nop	0,dl		3
	nop	0,dl		4
	vfd	o18/200001,o12/stcq,o6/40 5
	nop	0,dl		0	3
	nop	0,dl		1
	nop	0,dl		2
	nop	0,dl		3
	vfd	o18/200001,o12/stcq,o6/40 4
	vfd	o18/200001,o12/stcq,o6/60 5
	nop	0,dl		0	4
	nop	0,dl		1
	nop	0,dl		2
	vfd	o18/200001,o12/stcq,o6/40 3
	vfd	o18/200001,o12/stcq,o6/60 4
	vfd	o18/200001,o12/stcq,o6/70 5
	nop	0,dl		0	5
	nop	0,dl		1
	vfd	o18/200001,o12/stcq,o6/40 2
	vfd	o18/200001,o12/stcq,o6/60 3
	vfd	o18/200001,o12/stcq,o6/70 4
	vfd	o18/200001,o12/stcq,o6/74 5
	nop	0,dl		0	6
	vfd	o18/200001,o12/stcq,o6/40 1
	vfd	o18/200001,o12/stcq,o6/60 2
	vfd	o18/200001,o12/stcq,o6/70 3
	vfd	o18/200001,o12/stcq,o6/74 4
	vfd	o18/200001,o12/stcq,o6/76 5
	vfd	o18/200001,o12/stcq,o6/40 0	7
	vfd	o18/200001,o12/stcq,o6/60 1
	vfd	o18/200001,o12/stcq,o6/70 2
	vfd	o18/200001,o12/stcq,o6/74 3
	vfd	o18/200001,o12/stcq,o6/76 4
	stq	bp|1		5
"
" THE FOLLOWING SECTION IS DIRECTLY REFERENCED FROM PL/1 PROGRAMS BY MEANS OF
" ap|offset.  FOR THIS REASON, THE ORDER OF THE FOLLOWING INSTRUCTIONS MUST
" NOT BE CHANGED.
"
	even
operator_table:
bit_mask:
	vfd	0/-1,72/0
	vfd	1/-1,71/0
	vfd	2/-1,70/0
	vfd	3/-1,69/0
	vfd	4/-1,68/0
	vfd	5/-1,67/0
	vfd	6/-1,66/0
	vfd	7/-1,65/0
	vfd	8/-1,64/0
	vfd	9/-1,63/0
	vfd	10/-1,62/0
	vfd	11/-1,61/0
	vfd	12/-1,60/0
	vfd	13/-1,59/0
	vfd	14/-1,58/0
	vfd	15/-1,57/0
	vfd	16/-1,56/0
	vfd	17/-1,55/0
	vfd	18/-1,54/0
	vfd	19/-1,53/0
	vfd	20/-1,52/0
	vfd	21/-1,51/0
	vfd	22/-1,50/0
	vfd	23/-1,49/0
	vfd	24/-1,48/0
	vfd	25/-1,47/0
	vfd	26/-1,46/0
	vfd	27/-1,45/0
	vfd	28/-1,44/0
	vfd	29/-1,43/0
	vfd	30/-1,42/0
	vfd	31/-1,41/0
	vfd	32/-1,40/0
	vfd	33/-1,39/0
	vfd	34/-1,38/0
	vfd	35/-1,37/0
ones:	vfd	36/-1,36/0
	vfd	36/-1,1/-1,35/0
	vfd	36/-1,2/-1,34/0
	vfd	36/-1,3/-1,33/0
	vfd	36/-1,4/-1,32/0
	vfd	36/-1,5/-1,31/0
	vfd	36/-1,6/-1,30/0
	vfd	36/-1,7/-1,29/0
	vfd	36/-1,8/-1,28/0
	vfd	36/-1,9/-1,27/0
	vfd	36/-1,10/-1,26/0
	vfd	36/-1,11/-1,25/0
	vfd	36/-1,12/-1,24/0
	vfd	36/-1,13/-1,23/0
	vfd	36/-1,14/-1,22/0
	vfd	36/-1,15/-1,21/0
	vfd	36/-1,16/-1,20/0
	vfd	36/-1,17/-1,19/0
	vfd	36/-1,18/-1,18/0
	vfd	36/-1,19/-1,17/0
	vfd	36/-1,20/-1,16/0
	vfd	36/-1,21/-1,15/0
	vfd	36/-1,22/-1,14/0
	vfd	36/-1,23/-1,13/0
	vfd	36/-1,24/-1,12/0
	vfd	36/-1,25/-1,11/0
	vfd	36/-1,26/-1,10/0
	vfd	36/-1,27/-1,9/0
	vfd	36/-1,28/-1,8/0
	vfd	36/-1,29/-1,7/0
	vfd	36/-1,30/-1,6/0
	vfd	36/-1,31/-1,5/0
	vfd	36/-1,32/-1,4/0
	vfd	36/-1,33/-1,3/0
	vfd	36/-1,34/-1,2/0
	vfd	36/-1,35/-1,1/0
"
mask_bit:
	vfd	0/0,36/-1,36/-1
	vfd	1/0,35/-1,36/-1
	vfd	2/0,34/-1,36/-1
	vfd	3/0,33/-1,36/-1
	vfd	4/0,32/-1,36/-1
	vfd	5/0,31/-1,36/-1
	vfd	6/0,30/-1,36/-1
	vfd	7/0,29/-1,36/-1
	vfd	8/0,28/-1,36/-1
	vfd	9/0,27/-1,36/-1
	vfd	10/0,26/-1,36/-1
	vfd	11/0,25/-1,36/-1
	vfd	12/0,24/-1,36/-1
	vfd	13/0,23/-1,36/-1
	vfd	14/0,22/-1,36/-1
	vfd	15/0,21/-1,36/-1
	vfd	16/0,20/-1,36/-1
	vfd	17/0,19/-1,36/-1
	vfd	18/0,18/-1,36/-1
	vfd	19/0,17/-1,36/-1
	vfd	20/0,16/-1,36/-1
	vfd	21/0,15/-1,36/-1
	vfd	22/0,14/-1,36/-1
	vfd	23/0,13/-1,36/-1
	vfd	24/0,12/-1,36/-1
	vfd	25/0,11/-1,36/-1
	vfd	26/0,10/-1,36/-1
	vfd	27/0,9/-1,36/-1
	vfd	28/0,8/-1,36/-1
	vfd	29/0,7/-1,36/-1
	vfd	30/0,6/-1,36/-1
	vfd	31/0,5/-1,36/-1
	vfd	32/0,4/-1,36/-1
	vfd	33/0,3/-1,36/-1
	vfd	34/0,2/-1,36/-1
	vfd	35/0,1/-1,36/-1
	vfd	36/0,36/-1
	vfd	37/0,35/-1
	vfd	38/0,34/-1
	vfd	39/0,33/-1
	vfd	40/0,32/-1
	vfd	41/0,31/-1
	vfd	42/0,30/-1
	vfd	43/0,29/-1
	vfd	44/0,28/-1
	vfd	45/0,27/-1
	vfd	46/0,26/-1
	vfd	47/0,25/-1
	vfd	48/0,24/-1
	vfd	49/0,23/-1
	vfd	50/0,22/-1
	vfd	51/0,21/-1
	vfd	52/0,20/-1
	vfd	53/0,19/-1
	vfd	54/0,18/-1
	vfd	55/0,17/-1
	vfd	56/0,16/-1
	vfd	57/0,15/-1
	vfd	58/0,14/-1
	vfd	59/0,13/-1
	vfd	60/0,12/-1
	vfd	61/0,11/-1
	vfd	62/0,10/-1
	vfd	63/0,9/-1
	vfd	64/0,8/-1
	vfd	65/0,7/-1
	vfd	66/0,6/-1
	vfd	67/0,5/-1
	vfd	68/0,4/-1
	vfd	69/0,3/-1
	vfd	70/0,2/-1
	vfd	71/0,1/-1
"
blanks:	oct	040040040040,040040040040
	oct	000040040040,040040040040
	oct	000000040040,040040040040
	oct	000000000040,040040040040
	oct	000000000000,040040040040
	oct	000000000000,000040040040
	oct	000000000000,000000040040
	oct	000000000000,000000000040
"
ptr_mask:	oct	077777000077,777777077077
"
"	operator to convert single fixed to double fixed
"
	even
fx1_to_fx2:
	llr	36
	lrs	36
"
"	operators to convert fixed to float
"
	odd
fx1_to_fl2:
	xed	fx1_to_fx2
"
	even
fx2_to_fl2:
	lde	=71b25,du
	fad	=0.,du
	tra	lp|0
"
"	operator to reset next stack pointer
"	this operator is executed via an xed from object code.
"
	even
reset_stack:
	ldx0	sp|5		get new stack offset
	xed	xed_escape-*,ic	set up next sp and stack end pointers
"
"	operators to convert indicators into relations
"
r_l_a:	tmi	true
	lda	0,dl
	tra	lp|0
"
r_g_s:	tze	2,ic
	trc	true
	lda	0,dl
	tra	lp|0
"
r_g_a:	tze	2,ic
	tpl	true
	lda	0,dl
	tra	lp|0
"
r_l_s:	tnc	true
	lda	0,dl
	tra	lp|0
"
r_e_as:	tze	true
	lda	0,dl
	tra	lp|0
"
r_ne_as:	tnz	true
	lda	0,dl
	tra	lp|0
"
r_le_a:	tmi	true
	tze	true
	lda	0,dl
	tra	lp|0
"
r_ge_s:	trc	true
	lda	0,dl
	tra	lp|0
"
r_ge_a:	tpl	true
	lda	0,dl
	tra	lp|0
"
r_le_s:	tnc	true
	tze	true
	lda	0,dl
	tra	lp|0
"
true:	lda	=o400000,du
	tra	lp|0
"
"	operator to set stack ptr to that of block N static
"	levels above the current block.  Entered with N in q.
"	(should not be called with N = 0, but will work anyway.)
"
set_stack:
	tsx0	display_chase	get ptr to proper frame
	eppsp	bp|0		into sp
	tra	set_stack_extend-*,ic do three more instructions (added later
"				and since compiled code knows offsets in this area,
"				couldn't add the code inline)
"
"
"	tables for use by mod2_bit and mod4_bit operations
"
mod2_tab:	dec	0,18
"
mod4_tab:	dec	0,9,18,27
"
"	transfer vector for operators not referenced directly
"	by the pl/1 program.  new operators may be added at the
"	end of the list only.
"
op_vector:
	tra	alloc_char_temp	0
	tra	alloc_bit_temp	1
	tra	alloc_temp	2
	tra	realloc_char_temp	3
	tra	realloc_bit_temp	4
	tra	save_string	5
	tra	load_chars	6
	tra	load_bits		7
	tra	move_chars	8
	tra	move_chars_aligned	9
	tra	move_bits		10
	tra	move_bits_aligned	11
	tra	chars_move	12
	tra	chars_move_aligned	13
	tra	bits_move		14
	tra	bits_move_aligned	15
	tra	move_not_bits	16
	tra	move_not_bits_aligned 17
	tra	ext_and_1		18
	tra	ext_and_2		19
	tra	comp_bits		20
	tra	cpbs3		21
	tra	cpbs3_aligned	22
	tra	cpbs4		23
	tra	cpcs_ext1		24
	tra	cpcs_ext2		25
	tra	cpbs_ext1		26
	tra	cpbs_ext2		27
	tra	store_string	28
	tra	cat_realloc_chars	29
	tra	cat_realloc_bits	30
	tra	cp_chars		31
	tra	cp_chars_aligned	32
	tra	cp_bits		33
	tra	cp_bits_aligned	34
	tra	enter_begin_block	35
	tra	leave_begin_block	36
	tra	call_ent_var_desc	37
	tra	call_ent_var	38
	tra	call_ext_in_desc	39
	tra	call_ext_in	40
	tra	call_ext_out_desc	41
	tra	call_ext_out	42
	tra	call_int_this_desc	43
	tra	call_int_this	44
	tra	call_int_other_desc	45
	tra	call_int_other	46
	tra	begin_return_mac	47
	tra	return_mac	48
	tra	cat_move_chars	49
	tra	cat_move_chars_aligned 50
	tra	cat_move_bits	51
	tra	cat_move_bits_aligned 52
	tra	cat_chars		53
	tra	cat_chars_aligned	54
	tra	cat_bits		55
	tra	cat_bits_aligned	56
	tra	set_chars		57
	tra	set_chars_aligned	58
	tra	set_bits		59
	tra	set_bits_aligned	60
	tra	and_bits		61
	tra	and_bits_aligned	62
	tra	or_bits		63
	tra	or_bits_aligned	64
	tra	move_label_var	65
	tra	make_label_var	66
	tra	fl2_to_fx1	67
	tra	fl2_to_fx2	68
	tra	longbs_to_fx2	69
	tra	tra_ext_1		70
	tra	tra_ext_2		71
	tra	so_mac		72
	tra	longbs_to_bs18	73
	tra	stac_mac		74
	tra	sign_mac		75
	tra	bound_ck_signal	76
	tra	allot_based	77
	tra	free_based	78
	tra	copy_words	79
	tra	mpfx2		80
	tra	mpfx3		81
	tra	dvfx2		82	obsolete
	tra	dvfx3		83	obsolete
	tra	sr_check		84
	tra	chars_move_vt	85
	tra	chars_move_vta	86
	tra	bits_move_vt	87
	tra	bits_move_vta	88
	tra	mdfl1		89
	tra	mdfl2		90
	tra	mdfx1		91
	tra	mdfx2		92
	tra	mdfx3		93
	tra	mdfx4		94
	tra	move_dope		95
	tra	string_store	96
	tra	get_chars		97
	tra	get_bits		98
	tra	pad_chars		99
	tra	pad_bits		100
	tra	signal_op		101
	tra	enable_op		102
	tra	index_chars	103
	tra	index_chars_aligned	104
	tra	index_bits	105
	tra	index_bits_aligned	106
	tra	exor_bits		107
	tra	exor_bits_aligned	108
	tra	alloc_bit_temp_q	109
	tra	realloc_bit_temp_q	110
	tra	move_bits_q	111
	tra	move_bits_aligned_q	112
	tra	bits_move_q	113
	tra	bits_move_aligned_q	114
	tra	move_not_bits_q	115
	tra	move_not_bits_aligned_q 116
	tra	cpbs3_q		117
	tra	cpbs3_aligned_q	118
	tra	cat_realloc_bits_q	119
	tra	cp_bits_q		120
	tra	cp_bits_aligned_q	121
	tra	cat_move_bits_q	122
	tra	cat_move_bits_aligned_q 123
	tra	cat_bits_q	124
	tra	cat_bits_aligned_q	125
	tra	set_bits_q	126
	tra	set_bits_aligned_q	127
	tra	and_bits_q	128
	tra	and_bits_aligned_q	129
	tra	or_bits_q		130
	tra	or_bits_aligned_q	131
	tra	bits_move_vt_q	132
	tra	bits_move_vta_q	133
	tra	index_bits_q	134
	tra	index_bits_aligned_q 135
	tra	exor_bits_q	136
	tra	exor_bits_aligned_q	137
	tra	get_bits_q	138
	tra	io_signal		139
	tra	ix_cs_1		140
	tra	ix_cs_1_aligned	141
	tra	shorten_stack	142
"
"	The following section is not referenced directly by
"	the compiled pl/1 program and may be changed as
"	desired.
"
"	N.B. ANY BIT OPERATOR WHOSE NAME ENDS IN "_q" TAKES THE SIZE IN
"	THE q.  ALL OTHER BIT OPERATORS TAKE THE SIZE IN X6.
"
"	allocation operators
"	these are entered with the size in x6 (or q)
"	The char and bit allocation operators reserve two extra words
"	the temporary is stored in the second of these.
"
alloc_char_temp:
	eaq	0,6		number of chars to qu
	qrl	18		and then into ql
	mpy	9,dl		form number of bits
	tra	alloc_bit_temp_q	join common
"
alloc_bit_temp:
	eaq	0,6		number of bits to qu
	qrl	18		and then into ql
"
alloc_bit_temp_q:
	stq	sp|lg1		set length of temp
	div	36,dl		form number of words
	qls	18		in qu
	stq	sp|str1		save
	sta	sp|rem1		save number of bits in last word
	stz	sp|a1		temp will be an aligned string
	adq	2,du		allow for header
	cmpa	0,dl		update word count
	tze	2,ic		if remainder is non-zero
	adq	1,du		..
	tsx0	alloc		allocate N+2 words
	eppbp	bp|2		skip over the extra words (make temp even)
	stz	bp|-1		save size of temp just before temp
	sxl6	bp|-1		..
abt:	spribp	sp|temp_pt	save pointer to temp
	tra	lp|0		and return to pl/1 program
"
alloc_temp:
	eaq	0,6		number of words to qu
	eax0	abt		alloc N words and go save ptr
"				fall into alloc coding
"
"	routine to allocate N words at end of stack.
"	entered with N in qu.
"
alloc:	stq	sp|temp_size	save number of words
	eppbp	sb|stack_header.stack_end_ptr,* get ptr to extension
	adq	=15,du		make size a multiple of 16
	anq	=o777760,du	..
	stq	sp|extend_size
	asq	sb|stack_header.stack_end_ptr+1 reset stack end ptr
	asq	sp|stack_frame.next_sp+1 reset next ptr
	tra	0,0		return to pl1 program
"
"	reallocation operators
"	these are entered with the size in x6 (or q)
"	allowance is made for the two words at the head of the string
"
cat_realloc_bits:
	eaq	0,6
	qrl	18		get size in q
"
cat_realloc_bits_q:
	lda	sp|str1		set for following concat
	sta	sp|str2		..
	lda	sp|rem1		..
	sta	sp|a2		..
	tra	realloc-1		and go reallocate space
"
realloc_bit_temp:
	eaq	0,6		number of bits to qu
	qrl	18		and then into ql
"
realloc_bit_temp_q:
	tsx0	realloc		call realloc subroutine
	stz	sp|pad_it		set padding word
	tra	zero_it		go clear temp extension
"
cat_realloc_chars:
	ldq	sp|str1		set for following concat
	stq	sp|str2		..
	ldq	sp|rem1		..
	stq	sp|a2		and join realloc_char_temp
"
realloc_char_temp:
	eaq	0,6		number of chars to qu
	qrl	18		and then into ql
	mpy	9,dl		form number of bits
	eax0	abt+1		fall into realloc then exit
"
realloc:	ldx1	sp|temp_size	save end position of current temp
	stq	sp|lg1		save bit size of temp
	div	36,dl		calculate number of whole words
	qls	18		in qu
	stq	sp|str1		..
	sta	sp|rem1		save number of bits in last word
	stz	sp|a1		the temp is aligned
	adq	2,du		allow for two extra words
	cmpa	0,dl		update word count
	tze	2,ic		if remainder is non-zero
	adq	1,du		..
realloc_1:
	eppbp	sp|temp_pt,*	get ptr to temp
	sxl6	bp|-1		set new size (left side should be zero)
	stq	sp|temp_size	set new size of temp
	sbq	sp|extend_size	subtract size of extension
	tmi	0,0		return if no extension needed
	adq	=15,du		make increment a multiple of 16
	anq	=o777760,du	..
	asq	sp|extend_size	update extension size
	asq	sb|stack_header.stack_end_ptr+1 reset stack end ptr
	asq	sp|stack_frame.next_sp+1 reset next ptr
	tra	0,0		return to caller
"
"	this operator shortens the stack frame to its original length
"
shorten_stack:
	ldx0	sp|5
	stx0	sb|stack_header.stack_end_ptr+1
	stx0	sp|stack_frame.next_sp+1 update next sp
	tra	lp|0
"
"	code added here to handle escape out of xed sequence at reset_stack
"
	even
xed_escape:
	stx0	sb|stack_header.stack_end_ptr+1 update end pointer
	stx0	sp|stack_frame.next_sp+1 update next pointer too
"
"	code added here to handle 2 extra instructions needed at set_stack
"
set_stack_extend:
	eppbp	sp|stack_frame.next_sp,* set up stack end pointer correctly
	spribp	sb|stack_header.stack_end_ptr ..
	tra	lp|0		and return to pl1 program
"
"	operator to save the string in the aq in stack so it is
"	accessable to long string operators.  entered with bit_size
"	in x6 and string in aq
"
save_string:
	staq	sp|double_temp	save the string
	eppbp	sp|double_temp	load ptr to string, fall into set_bits_aligned
"
"	operators to save info about a string in the stack.
"	entered with pointer in bp, unit size in x6, and offset in x7
"
set_bits_aligned:
	eaq	0,6		bit size to qu
	qrl	18		and then into ql
"
set_bits_aligned_q:
	stz	sp|a1		offset is zero
"
sba:	spribp	sp|temp_pt	save pointer to string
	stq	sp|lg1		save bit size
	div	36,dl		compute number of whole words
	qls	18		in qu
	stq	sp|str1		..
	sta	sp|rem1		save number of bits in last word
	tra	lp|0		return to pl/1 program
"
set_bits:
	eaq	0,6
	qrl	18		bit size to q
"
set_bits_q:
	eaa	0,7		offset to qu
	sta	sp|a1		save offset
	tra	sba		join common section
"
set_chars_aligned:
	stz	sp|a1		offset is zero
	eaq	0,6		char size to qu
	qrl	18		and then into ql
	mpy	9,dl		convert to bits
	tra	sba		join common section
"
set_chars:
	eaq	0,7		offset to qu
	stq	sp|a1		save offset
	tra	set_chars_aligned+1	join common section
"
"	operator to store a string when size+offset > 72
"	entered with string to be stored in aq, bit_size+offset-72 in x6,
"	offset in x7, and ptr to destination in bp
"
store_string:
	stq	sp|temp		save right part of string
	lrl	0,7		shift to proper position
	era	bp|0		insert in first two words
	stq	bp|1		of destination
	ana	mask_bit_one,7	mask has no trailing zeros
	ersa	bp|0
	lda	sp|temp		get right part of string
	ldq	0,dl		clear q register
	lrl	0,7		shift into position
	erq	bp|2		insert into third word
	anq	bit_mask_one,6	mask has no leading zeros
	ersq	bp|2
	tra	lp|0		return to pl1 program
"
"	operator to store a string with an adjustable bit offset.
"	entered with bit_size in x6, bit_offset in x7, and pointer
"	to destination in bp.
"
string_store:
	eax1	0,7		offset to x1
	cmpx1	36,du		is it greater than 36?
	tmi	3,ic		no
	eppbp	bp|1		yes, adjust destination ptr
	eax1	-36,1		and correct offset
	eax0	0,6		size to x0
	stx1	sp|temp		so we can form
	adx0	sp|temp		size+offset
	cmpx0	73,du		is this difficult case
	trc	ss_3		> 72 bits causes problems
	lrl	0,1		no, shift string to position
	era	bp|0		combine first word of destination
	ana	mask_bit_one,1	mask has no trailing zeros
	cmpx0	37,du		is this 1 or 2 word case
	trc	ss_2		..
ss_1:	ana	bit_mask_one,0	1 word only, trim to size
	ersa	bp|0		insert in destination
	tra	lp|0		and return to pl1 program
ss_2:	erq	bp|1		2 words, combine second word
	anq	bit_mask_one-36,0	trim to size
	ersa	bp|0		insert in destination
	ersq	bp|1		..
	tra	lp|0		and return
ss_3:	stq	sp|temp		3 word case, save right part
	lrl	0,1		shift to position
	era	bp|0		insert in first two words
	stq	bp|1		..
	ana	mask_bit_one,1	..
	ersa	bp|0		..
	lda	sp|temp		get right part
	ldq	0,dl		clear q
	lrl	0,1		shift to position
	erq	bp|2		insert in third word
	anq	bit_mask_one-72,0	..
	ersq	bp|2		..
	tra	lp|0		return to caller
"
"	operator to return in aq the first 72 bits of an adjustable char
"	string. if length is less than 72 bits, string is padded.
"	entered with char_size in x6, bit_offset in x7, and pointer in bp.
"
get_chars:
	eaq	0,6		number of chars to qu
	qrl	18		and then into ql
	mpy	9,dl		form number of bits
	stq	sp|temp+1		save so we
	stz	sp|temp		save offset in rhs
	sxl7	sp|temp
	adq	sp|temp		then form offset+bit_size
	lda	sp|temp+1		then get
	als	1		2*bit_size
	eax1	0,al		into x1
	cmpq	73,dl		is this hard case
	trc	gc_3
	lda	bp|0		easy, get first word
	cmpq	37,dl		is there another word
	tnc	2,ic
	ldq	bp|1		yes, so load it
	lls	0,7		shift to position
gc_1:	eraq	blanks		pad with blanks
	anaq	bit_mask,1
	eraq	blanks
	tra	lp|0		and return to pl/1 program
gc_3:	lda	bp|1		get
	ldq	bp|2		second word
	lls	0,7		into position
	sta	sp|temp		and save
	lda	bp|0		get first
	ldq	bp|1		word
	lls	0,7		into position
	ldq	sp|temp		get back second word
	lxl0	sp|temp+1		get bit_size
	cmpx0	72,du		is string 8 chars or longer
	trc	lp|0		yes, return to caller
	tra	gc_1		no, go save
"
"	operators to load a string with adjustable offset.  entered with
"	bit_size in q, offset in x7 and ptr to string in bp. (Note: these
"	operators are actually the same as get_bits which follows.
"
load_chars:
load_bits:
"
"	get_bits is same as get_bits_q execpt size is in x6
"
get_bits:
	eaq	0,6		get size into qu
	qrl	18		and then into ql
"
"	operator to return in aq the first 72 bits of an adjustable bit
"	string. if length is less than 72 bits, string is padded.
"	entered with bit_size in q, bit_offset in x7, and pointer in bp.
"
get_bits_q:
	stq	sp|temp+1		save size
	stz	sp|temp		save offset in rhs
	sxl7	sp|temp
	adq	sp|temp		form offset+size
	cmpq	73,dl		is this hard case
	trc	gb_3
	lda	sp|temp+1		get back size
	als	1		times 2
	eax1	0,al		and thence of x1
	lda	bp|0		load first word
	cmpq	37,dl		is there a second
	tnc	2,ic
	ldq	bp|1		yes, so load it
	lls	0,7		shift to position
	anaq	bit_mask,1	apply mask
	tra	lp|0		return to pl/1 program
gb_3:	lda	bp|1		get second
	ldq	bp|2		word
	lls	0,7		into position
	sta	sp|temp		save
	lda	bp|0		get first
	ldq	bp|1		word
	lls	0,7		into position
	ldq	sp|temp		get second part
	lxl0	sp|temp+1		get bit size
	cmpx0	72,du		is string 72 bits or longer
	trc	lp|0		yes, return to caller
	anq	bit_mask_one-36,0	apply mask
	tra	lp|0		return to pl1 program
"
"	operator to pad the char string temporary to 8 chars.
"
pad_chars:
	ldq	sp|lg1		get bit length of temp
	cmpq	73,dl		is it already long enough
	trc	lp|0		yes, return
	adq	sp|lg1		no, form 2*bit_length
	eax0	0,ql		and place in index reg
	ldaq	blanks		get blanks
	eraq	sp|temp_pt,*	insert into end of temp
	anaq	mask_bit,0
	eraq	sp|temp_pt,*
	staq	sp|temp_pt,*	replace padded string
	tra	lp|0		and return to pl/1 program
"
"	operator to pad the bit string temporary to 72 bits.
"
pad_bits:
	ldq	sp|lg1		get bit length of temp
	cmpq	73,dl		is it already long enough
	trc	lp|0		yes, return
	adq	sp|lg1		no, form 2*bit_length
	eax0	0,ql		and place in index reg
	ldaq	sp|temp_pt,*	mask string
	anaq	bit_mask,0
	staq	sp|temp_pt,*	replace padded string
	tra	lp|0		and return to pl/1 program
"
"	The operators which follow are the same as their similarly
"	named counterparts below, except the size comes in the q.
"
and_bits_q:
	lda	ana_op
	tra	move_bits_q+1
"
or_bits_q:
	lda	1,dl
	sta	sp|pad_it
	lda	ora_op
	tra	log
"
exor_bits_q:
	lda	1,dl
	sta	sp|pad_it
	lda	era_op
	tra	log
"
cat_move_bits_q:
	lda	1,dl
	sta	sp|pad_it
	lda	nop_op
	tra	log
"
move_not_bits_q:
	lda	1,dl
	sta	sp|pad_it
	lda	not_op
	tra	log
"
move_bits_q:
	lda	nop_op
	stz	sp|pad_it
	tra	log
"
"	operator to AND an unaligned string into the aligned string
"	temporary pointed at by sp|temp_pt.  the string being ANDED
"	is guaranteed to be no bigger than the space in the stack.
"	entered with bit_size in x6, bit_offset in x7, and pointer
"	to source in bp.
"
and_bits:
	lda	ana_op		pickup logical function to do
	tra	logical		join common section
"
"	operator to OR an unaligned string into the aligned string
"	temporary pointed at by sp|temp_pt.  the string being ORED
"	is guaranteed to be no bigger and the space in the stack.
"	entered with bit_size in x6, bit_offset in x7, and pointer
"	to source in bp.
"
or_bits:
	lda	ora_op		pickup logical function to do
	ldq	1,dl		set switch for no padding
	stq	sp|pad_it		..
	tra	logical+1		join common section
"
"	operator to EXCLUSIVE OR an unaligned string into the aligned string
"	temporary pointed at by sp|temp_pt.  the string being EXORed
"	is guaranteed to be no bigger than the space in the stack.
"	entered with bit_size in x6, bit_offset in x7, and pointer
"	to source in bp.
"
exor_bits:
	lda	era_op		pickup logial function to do
	tra	or_bits+1		and treat like OR case
"
"	operator to MOVE an unaligned string into the aligned string
"	temporary pointed at by sp|temp_pt.  the string being MOVED
"	is guaranteed to be no bigger than the space in the stack.
"	since this operator is always followed by concatenation, no
"	padding is done.  entered with bit_size in x6, bit_offset in x7,
"	and pointer to source in bp
"
cat_move_bits:
	lda	nop_op		pickup logical function
	tra	or_bits+1		join common section
"
"	operator to MOVE the COMPLEMENT of an unaligned string into
"	the aligned string temporary pointed at by sp|temp_pt.  the string
"	being moved is guaranteed to be the same size as the
"	destination.  entered with bit_size in x6, bit_offset in x7, and
"	pointer to source in bp.
"
move_not_bits:
	lda	not_op		pickup logical function to do
	tra	or_bits+1		join common section
"
"	operator to MOVE an unaligned string into the aligned string
"	temporary pointed at by sp|temp_pt.  the string being MOVED
"	is guaranteed to be no bigger than the size of the destination.
"	entered with bit_size in x6, bit_offset in x7, and pointer
"	to source in bp.
"
move_bits:
	lda	nop_op		pickup logical function to do
"
logical:	stz	sp|pad_it		set switch for padding
	eaq	0,6		bit_size to qu
	qrl	18		and then into ql
log:	sta	sp|bit_op		set operation to perform
	stq	sp|length		save for concatenation operator
	div	36,dl		get number of whole words in string
	qls	18		in qu
	stq	sp|str2		save number of whole words
	sta	sp|a2		save number of bits in last word
	eax1	0		initialize loop
	eppap	sp|temp_pt,*	..
	cmpx7	36,du		adjust if offset > 36 bits
	tmi	3,ic
	sbx7	36,du
	eawpbp	bp|1
"
bit_loop:
	cmpx1	sp|str2		are we done with whole word part
	trc	bit_done		yes, go check last part
	lda	bp|0,1		get words from string
	ldq	bp|1,1		..
	lls	0,7		shift to proper position
	xec	sp|bit_op		perform logical function
	sta	ap|0,1		and store word
	eax1	1,1		update counter
	tra	bit_loop		do next word
bit_done:	lcq	sp|a2		is there any remainer in last word
	tze	bit_fill		no, fill rest of temporary
	eax0	36,ql		form 36-number of bits in last
	lda	bp|0,1		get last incomplete word
	ldq	bp|1,1		..
	lls	0,7		into position
	ars	0,0		shift out garbage
	ldq	sp|pad_it		get padding word
	lls	0,0		shift back padded word
	xec	sp|bit_op		perform logical function
	sta	ap|0,1		and store word
	eax1	1,1		update counter
bit_fill:
	eppbp	ap|0		get pointer to temp
	eppap	operator_table	restore ap setting
	ldq	sp|pad_it		get padding word
	cmpq	1,dl		should we pad rest of temp
	tze	lp|0		no, we are done
	tra	zero_it		yes, go do it
"
"	logical functions...
"
nop_op:	nop	0,du		move
ana_op:	ana	ap|0,1		and
ora_op:	ora	ap|0,1		or
era_op:	era	ap|0,1		exclusive or
"
"	operator to MOVE an unaligned string into the aligned string
"	temporary pointed at by sp|temp_pt.  the string being MOVED
"	is guaranteed to be nor bigger than the space in the stack.
"	if this is cat_move_chars, no padding will be done since
"	operator is always followed by concat.  entered with chars in x6,
"	bit_offset in x7, and pointer to source in bp.
"
move_chars:
	lda	blanks		get padding word
	tra	cat_move_chars+1	join common section
"
cat_move_chars:
	lda	1,dl		set for no padding
	sta	sp|pad_it		save padding word
	eaq	0,6		number of chars to qu
	qrl	18		and then into ql
	mpy	9,dl		convert to bits
	lda	nop_op		get move operator
	tra	log		join common section
"
"	operator to AND a single length bit string into the string
"	temporary pointed at by sp|temp_pt.  words 1,2,3,... of the
"	temporary are cleared.
"
ext_and_1:
	ldq	0,dl		clear q and join ext_and_2
"
"	operator to AND a double length bit string into the string
"	temporary pointed at by sp|temp_pt.  words 2,3,... of the
"	temporary are cleared.
"
ext_and_2:
	eppbp	sp|temp_pt,*	get ptr to string
	ansa	bp|0		AND in the string
	ansq	bp|1		..
	eax1	2		clear starting at word 2
	stz	sp|pad_it		..
	tra	zero_it		..
"
"	operator to complement the bit string temporary pointed
"	at by sp|temp_pt
"
comp_bits:
	eppbp	sp|temp_pt,*	get pointer to source
	ldx1	sp|str1		get number of whole words
	lxl0	sp|rem1		and number of bits in last word
comp:	eppap	sp|temp_pt,*	get pointer to destination
	tze	comp_loop+1	skip if no partial word at end
	lda	bp|0,1		get last partial word
not_op:	era	ones		complement it
	ana	bit_mask_one,0	mask out tail end
comp_loop:
	sta	ap|0,1		deposit complemented word
	eax1	-1,1		count down
	tmi	cb_done+1		return if last word done
	lda	bp|0,1		get previous word
	era	ones		complement it
	tra	comp_loop		and loop
"
"	operator to MOVE the COMPLEMENT of an aligned string into
"	the aligned string temp pointed at by sp|temp_pt.  entered
"	with bit_size in x6 (or q) and pointer to source in bp.
"
move_not_bits_aligned:
	eaq	0,6		number of bits to qu
	qrl	18		and then into ql
"
move_not_bits_aligned_q:
	div	36,dl		get number of whole words
	eax1	0,ql		into xr1
	eax0	0,al		and number bits in last into xr0
	tra	comp		join common section
"
"	routine to execute a RPD loop, based on MOVE by Noel I. Morris.
"	at entry:
"		sp|rpd_pt	points at operation to perform
"		ap	points at destination
"		bp	points at source
"		qu	holds number of words to process
"		x0	holds return point
"	at exit:
"		ap|0,1	points at next word of destination
"		bp|0,2	points at next word of source
"
	bool	rpd,5602		RPD instruction
	bool	rpd_bits,001400	bits for RPD instruction (A,B)
"
rpd_op:	eax1	0		initialize counters
	eax2	0		..
	lda	0,dl		clear a
	eaq	0,qu		clear right side of q
	lls	10		get num 256 word blocks in al, rem.ls.10 in qu
	qls	0		set indicators from q
	tnz	3,ic		if even multiple of 256
	sbla	1,dl		count down number of blocks
	tmi	0,0		and refuse to move zero words
	stx0	sp|temp		save return point
	eax0	rpd_bits,qu	set up for remainder block
rpd_loop:	tra	sp|rpd_pt,*	execute the RPD function
	sbla	1,dl		any more blocks to do
	tpl	rpd_loop		if so, repeat until done
	ldx0	sp|temp		restore return
	tra	0,0		and go back
"
	odd
rpd_copy:	vfd	18/0,12/rpd,6/1	RPD
	ldq	bp|0,2		to move a block
	stq	ap|0,1		..
	tra	rpd_loop+1
	odd
rpd_or:	vfd	18/0,12/rpd,6/1	RPD
	ldq	bp|0,2		to or a block
	orsq	ap|0,1		into destination
	tra	rpd_loop+1
	odd
rpd_and:	vfd	18/0,12/rpd,6/1	RPD
	ldq	bp|0,2		to and a block
	ansq	ap|0,1		into destination
	tra	rpd_loop+1
	odd
rpd_exor:	vfd	18/0,12/rpd,6/1	RPD
	ldq	bp|0,2		to exclusive or a block
	ersq	ap|0,1		into destination
	tra	rpd_loop+1
"
"	routine to zero rest of string temp
"	this routine returns directly to pl/1 program
"	at entry:
"		bp|0,1	points at first word to be cleared
"		sp|temp_size holds total size of temporary
"
	bool	rpt,5202		RPT instruction
	bool	rpt_bits,0	bits for RPT instruction
"
zero_it:	eaa	0,1		current position to au
	neg	0		negate so we subtract
	ada	sp|temp_size	get number of words left to zero
	tze	lp|0		return if zero
	tmi	lp|0		or negative
	lrs	36		shift number into q
	lls	10		get number of 256 word blocks in al and remainder in qu
	qls	0		set indicators from q
	tnz	2,ic		update 256 block count
	sbla	1,dl		if no remainder
	eax0	0,qu		init RPT loop
	stx3	sp|save_regs	save x3 just in case it is needed
	qrl	10		right justify initial word cnt in qu
	eax3	0,qu		init incrementer index
	ldq	sp|pad_it		get padding word
z_loop:	vfd	18/0,12/rpt,6/1	RPT instruction
	stq	bp|0,1		pad storage
	eax1	0,3		update x1 in case not done yet
	eax3	256,1		update incrementer index too
	sbla	1,du		count down number of blocks
	tpl	z_loop		continue if more
	ldx3	sp|save_regs	refetch x3
	tra	lp|0		return to pl/1 program
"
"	The operators which follow are the same as their similarly
"	named counterparts below, except the size comes in the q.
"
and_bits_aligned_q:
	eppap	rpd_and
	tra	move_bits_aligned_q+1
"
or_bits_aligned_q:
	eppap	rpd_or
	lda	1,dl
	sta	sp|pad_it
	tra	baj
"
exor_bits_aligned_q:
	eppap	rpd_exor
	tra	or_bits_aligned_q+1
"
cat_move_bits_aligned_q:
	eppap	rpd_copy
	tra	or_bits_aligned_q+1
"
move_bits_aligned_q:
	eppap	rpd_copy
	stz	sp|pad_it
	tra	baj
"
"	operator to move an aligned char string into the aligned
"	string temporary pointed at by sp|temp_pt.  if this is
"	cat move, no padding will be done since concat always follows.
"	entered with char_size in x6 and pointer to source
"	in bp.
"
move_chars_aligned:
	lda	blanks		get padding word
	tra	cat_move_chars_aligned+1
"
cat_move_chars_aligned:
	lda	1,dl		set for no padding
	sta	sp|pad_it		..
	eaq	0,6		number of chars to qu
	qrl	18		and then into ql
	mpy	9,dl		convert to bits
	eppap	rpd_copy		set copy loop
	tra	baj		join common section
"
"	operator to AND an aligned string into the aligned string
"	temporary pointed at by sp|temp_pt.  the string being ANDED
"	is guaranteed to be no bigger than the space in the stack.
"	entered with bit_size in x6 and pointer to source in bp.
"
and_bits_aligned:
	eppap	rpd_and		get ptr to function to do
	tra	move_bits_aligned+1	join common section
"
"	operator to OR an aligned string into the aligned string
"	temporary pointed at by sp|temp_pt.  the string being ORED
"	is guaranteed to be no bigger than the space in the stack.
"	entered with bit_size in x6 and pointer to source in bp.
"
or_bits_aligned:
	eppap	rpd_or		get ptr to function to do
	lda	1,dl		set for no padding
	tra	ba_join		join common section
"
"	operator to EXCLUSIVE OR an aligned string into the aligned string
"	temporary pointed at by sp|temp_pt.  the string being EXORed
"	is guaranteed to be no bigger than the space in the stack.
"	entered with bit_size in x6 and pointer to source in bp.
"
exor_bits_aligned:
	eppap	rpd_exor		get ptr to function to do
	tra	or_bits_aligned+1	then treat like OR case
"
"	operator to MOVE an aligned string into the aligned string
"	temporary pointed at by sp|temp_pt.  the string being MOVED
"	is guaranteed to be no bigger than the string in the stack.
"	since this operator is always followed by concatenation, no
"	padding is done.  entered with bit_size in x6 and pointer to
"	source in bp.
"
cat_move_bits_aligned:
	eppap	rpd_copy		get ptr to function to do
	tra	or_bits_aligned+1	join common section
"
"	operator to MOVE an aligned string into the aligned string
"	temporary pointed at by sp|temp_pt.  the string being MOVED
"	is guaranteed to be no bigger than the string in the stack.
"	entered with bit_size in x6 and pointer to source in bp.
"
move_bits_aligned:
	eppap	rpd_copy		get ptr to function to do
	lda	0,dl		set for padding of string
"
ba_join:	sta	sp|pad_it		save padding word
	eaq	0,6		number of bits to qu
	qrl	18		and then into ql
baj:	spriap	sp|rpd_pt		set RPD function
	stx2	sp|save_x23	save x2 for user
	eppap	sp|temp_pt,*	get pointer to destination
	stq	sp|length		save for concatenation
	div	36,dl		get number of whole words
	qls	18		in qu
	stq	sp|str2		save number of words
	sta	sp|a2		save number of bits in last word
	tsx0	rpd_op		operate on whole word part
	lxl0	sp|a2		are there any bits in last word
	tze	ba_fill		skip if none
	ldq	bp|0,2		get last word of source
	lls	0,0		shift out good bits
	ldq	sp|pad_it		get padding word
	lrl	0,0		shift back good bits
	eaa	2		execute function
	xec	sp|rpd_pt,*au	on last word
	eax1	1,1		update pointer to destination
ba_fill:	ldx2	sp|save_x23	restore x2 for user
	tra	bit_fill		go check padding
"
"	operators to move unaligned bit string_1 into unaligned bit
"	string_2.  These operators perform the same functions as
"	bits_move and bits_move_aligned, except the size comes in
"	the q register.  This lets us move an entire segment.
"
bits_move_vt_q:
	stq	bp|-1		store size of string
"
bits_move_q:
	stz	sp|a2		save offset
	sxl7	sp|a2		..
	tra	bits_move_aligned_q+1
"
bits_move_vta_q:
	stq	bp|-1		store size of string
"
bits_move_aligned_q:
	stz	sp|a2		zero offset
	cmpq	0,dl		return if string 2
	tze	lp|0		return if string 2 zero length
	tra	cb_move-1		join common section
"
"	operator to move unaligned string_1 into unaligned string_2
"	based on procedure MOVSTR by Ruth Weiss.
"
"	string_1 is specified by the variables temp_pt, lg1, and a1
"	which were stored by a previous operator.  entered with unit
"	size of string_2 in x6, bit_offset in x7, and pointer in bp.
"
chars_move_vt:
	stz	bp|-1		store size of string
	sxl6	bp|-1
"
chars_move:
	stz	sp|a2		save offset
	sxl7	sp|a2		in rhs
	tra	chars_move_aligned+1
"
chars_move_vta:
	stz	bp|-1		store size of string
	sxl6	bp|-1		..
"
chars_move_aligned:
	stz	sp|a2		zero offset
	eaq	0,6		number of chars to qu
	tze	lp|0		exit if string 2 zero length
	qrl	18		into ql
	mpy	9,dl		convert to bits in ql
	lda	blanks		get padding word
	tra	cb_move		join common section
"
bits_move_vt:
	stz	bp|-1		store size of string
	sxl6	bp|-1		..
"
bits_move:
	stz	sp|a2		save offset
	sxl7	sp|a2		in rhs
	tra	bits_move_aligned+1
"
bits_move_vta:
	stz	bp|-1		store size of string
	sxl6	bp|-1		..
"
bits_move_aligned:
	stz	sp|a2		zero offset
	eaq	0,6		number of bits to qu
	tze	lp|0		exit if string 2 zero length
	qrl	18		shift to ql
	lda	0,dl		get padding word
"
cb_move:	sreg	sp|save_regs	save regs (including padding word and lg2)
	cmpq	sp|lg1		is lg2 > lg1
	tnc	2,ic		no
	ldq	sp|lg1		yes, get lg1
	eppap	sp|temp_pt,*	get pointer to source
	tsx0	move_it		call string mover
cb_done:	lreg	sp|save_regs	restore registers
	eppap	operator_table
	tra	lp|0
"
"	operators to perform concatenation.  this is done by moving
"	the second string into the stack just after the first string.
"	entered with unit size of suffix string in x6, bit_offset in x7
"	(if unaligned), and pointer in bp
"
cat_chars:
	eaa	0,7		save offset
	tra	cat_chars_aligned+1
"
cat_chars_aligned:
	lda	0,dl		zero offset
	eaq	0,6		get number of chars
	tze	cat_done		return if none
	sta	sp|a1		save source offset
	qrl	18		shift char count to ql
	mpy	9,dl		convert chars to bits
	lda	blanks		get padding word
	tra	cat		join common section
"
cat_bits_q:
	eaa	0,7		offset to au
	tra	cbq
"
cat_bits_aligned_q:
	lda	0,dl		zero offset
cbq:	cmpq	0,dl		set indicators from length 
	tra	cba		join common section
"
cat_bits:
	eaa	0,7		save offset
	tra	cat_bits_aligned+1
"
cat_bits_aligned:
	lda	0,dl		zero offset
	eaq	0,6		get number of bits
	qrl	18		into ql
cba:	tze	cat_done		return if none
	sta	sp|a1		save source offset
	lda	0,dl		get padding word
"
cat:	sta	sp|n		save a temporarily
	lda	sp|lg1		save value of lg1
	sta	sp|old_lg1	..
	stq	sp|lg1		set new value
	eppap	bp|0		get pointer to source
	ldx0	sp|str2		get pointer to destination
	eppbp	sp|temp_pt,*0	..
	lda	sp|n		get padding word back
	sreg	sp|save_regs	save regs (including padding word and lg2)
	tsx0	move_it		call string mover
	lreg	sp|save_regs	restore registers (including lg2)
	lda	sp|old_lg1	restore value of lg1
	sta	sp|lg1		..
	eppap	operator_table
cat_done:	eppbp	sp|temp_pt,*	get ptr to result
	stz	sp|a1		restore offset of answer to 0
	tra	lp|0		exit
"
"	routine to move an unaligned string
"	entered with:
"		sp|lg1	length of source in rhs
"		sp|lg2	length of destination in rhs
"		sp|a1	bit offset of source in lhs
"		sp|a2	bit offset of destination in rhs
"		ap	points at source
"		bp	points at destination
"		ql	number of bits to move
"
"	the following index registers are used:
"		xr0	counter for source (lp)
"		xr1	- offset of source
"		xr2	counter for destination (bp)
"		xr3	- offset of destination
"		xr4	source offset - destination offset
"		xr5	36 - number of bits in last word of source
"		xr6	number of bits in last word of destination
"
move_it:
	stx0	sp|move_return	save return
	adq	sp|a2		length+a2
	div	36,dl		compute num words to move
	qls	18		..
	stq	sp|length		..
	neg	0		- num bits in last word moved
	eax5	36,al		36 - num bits in last word
	ldq	sp|lg2
	adq	sp|a2
	div	36,dl		number of words in destination
	qls	18		in qu
	stq	sp|str2		..
	eax6	0,al		number of bits in last word of destination
	lcq	sp|a2		get - a2
	eax3	0,ql		into x3
	eax4	0,ql		and x4
	adlx4	sp|a1		form a1 - a2
	eax0	0		init for source
	lcx1	sp|a1		..
	eax2	0		init for destination
"
	szn	sp|lg1		is source zero length
	tze	move_2		yes, do not load it
	lda	ap|0,0		load first word of source
	ldq	sp|a1		get offset in lhs
	qrs	18		shift to ql
	adq	sp|lg1
	cmpq	37,dl		is source contained in 1 word
	tnc	2,ic
	ldq	ap|1,0		no, load second word
	lrl	36,1		shift start of source to q
move_2:
	lda	bp|0,2		load first word of destination
	arl	36,3		clear space for source
	lls	36,3		move altered word back
	cmpx0	sp|length		should only a partial word be moved
	tze	move_nend		yes, go adjust
	eax4	36,4		36 + a1 - a2
	cmpx4	36,du		is a1 - a2 > 0
	tze	move_noup
	tmi	move_noup
	eax4	-36,4		if a1 > a2, update word offset of source
	eax0	1,0		..
	ldq	1,du		and update word count
	asq	sp|length		of source
	tra	move_noup
"
move_loop:
	ldq	ap|0,0		load word 2 of source
	lls	0,4		shift left 36+a1-a2
move_noup:
	sta	bp|0,2		store word in destination
	eax2	1,2		update ptr to destination
	lda	ap|0,0		load word 1 of source
	eax0	1,0		update ptr to source
	cmpx0	sp|length		more words in source
	tmi	move_loop		yes, repeat
	stx5	sp|temp
	cmpx4	sp|temp		does string overlap next word
	tmi	3,ic		no, don't load
	tze	2,ic		..
	ldq	ap|0,0
	lls	0,4
"
move_nend:
	arl	0,5		last word of source,
	ldq	sp|save_regs+4	so eliminate
	lls	0,5		extraneous bits
	cmpx2	sp|str2		is this last word of destination
	trc	move_nend2	yes, go finish up
move_6:
	sta	bp|0,2		not last word of destination, save
	lda	sp|save_regs+4	get padding word
	tra	move_loop2+1
"
move_loop2:
	sta	bp|0,2		pad word
	eax2	1,2		update ptr
	cmpx2	sp|str2		are we done
	tmi	move_loop2	no, continue padding
move_nend2:
	cmpx6	0,du		yes, is there a partial word
	tze	move_done		no, we're done
	era	bp|0,2		insert in last word
	ana	bit_mask_one,6	..
	ersa	bp|0,2		..
move_done:
	ldx0	sp|move_return	return to caller
	tra	0,0		..
"
"	operators to compare unaligned bit string_1 with unaligned
"	bit string_2.  These operators perform the same function as
"	cp_bits and cp_bits_aligned except the size comes in the q
"	register.  This lets us compare an entire segment.
"
cp_bits_q:
	eaa	0,7		save offset
	sta	sp|a2		..
	tra	cp_start-1	join common section
"
cp_bits_aligned_q:
	stz	sp|a2		zero offset
	tra	cp_start-1	join common section
"
"	operator to compare unaligned string_2 with unaligned string_1
"	based on procedure STRCMP by Ruth Weiss.
"
"	string_1 is specified by the variables temp_pt, lg1, and a1
"	which were stored by a previous operator.  entered with unit
"	size of string_2 in x6, bit_offset in x7, and pointer in bp.
"
"	the following index registers are used:
"		xr0	counter for string_1
"		xr1	a1 (offset of string_1)
"		xr2	counter for string_2
"		xr3	a2 (offset of string_2)
"		xr4	rest1 (number of unused bits in last word of string_1)
"		xr5	rest2 (number of unused bits in last word of string_2)
"
cp_chars:
	eaa	0,7		save offset
	sta	sp|a2		..
	tra	cp_chars_aligned+1
"
cp_chars_aligned:
	stz	sp|a2		zero offset
	eaq	0,6		number of chars to qu
	qrl	18		and then into ql
	mpy	9,dl		convert to bits
	lda	blanks		get padding word
	tra	cp_start		join common section
"
cp_bits:
	eaa	0,7		save offset
	sta	sp|a2		..
	tra	cp_bits_aligned+1
"
cp_bits_aligned:
	stz	sp|a2		zero offset
	eaq	0,6		number of bits to qu
	qrl	18		and then into ql
	lda	0,dl		get padding word
"
cp_start:
	sreg	sp|save_regs	save regs (including padding word and lg2)
	div	36,dl		calculate word length of string_2
	qls	18		..
	stq	sp|str2		..
	neg	0		form rem2 = 36 - num bits in
	eax5	36,al		last word of string_2
cp_join:	lcq	sp|rem1		form rest1 = 36 - num bits in
	eax4	36,ql		last word of string_1
	eax0	0		initialize
	ldx1	sp|a1		..
	eax2	0		..
	ldx3	sp|a2		..
	eppap	sp|temp_pt,*
"
cp_back:	lda	ap|0,0		get next word of string_1
	cmpx0	sp|str1		is string_1 finished
	tze	cp_fag		yes
	ldq	ap|1,0		no, get next word
	lls	0,1		shift into position
	sta	sp|temp		save for later
	lda	bp|0,2		get next word of string_2
	cmpx2	sp|str2		is string_2 finished
	tze	cp_cag		yes
	ldq	bp|1,2		no, get next word
	lls	0,3		shift into position
	cmpa	sp|temp		string_2 : string_1
	tnz	cb_done		exit if not equal
	eax0	1,0		update string_1 pointer
	eax2	1,2		update string_2 pointer
	tra	cp_back		and keep checking
"
"	string_1 done
"
cp_fag:	cmpx4	sp|a1		compare rest1 with a1
	tpl	2,ic		if .ge., do not load next word
	ldq	ap|1,0		yes
	lls	0,1		shift to position
	arl	0,4		erase unused bits
	ldq	sp|save_regs+4	get padding bits
	lls	0,4		shift word back to position
"
cp_bag:	sta	sp|temp		at end of string_1, continue with string_2
	lda	bp|0,2
	cmpx2	sp|str2		is string_2 finished
	tze	cp_cag		yes
	ldq	bp|1,2		no, get next word
	lls	0,3		into position
	cmpa	sp|temp		string_2 : last of string_1 or padding
	tnz	cb_done		exit if not equal
	eax2	1,2		update string_2 pointer
	lda	sp|save_regs+4	get padding word for comparison
	tra	cp_bag		and keep looking
"
"	string_2 done
"
cp_cag:	cmpx5	sp|a2		compare rem2 with a2
	tpl	2,ic		if .ge., do not load next word
	ldq	bp|1,2		yes
	lls	0,3		shift to position
	arl	0,5		erase unused bits
	ldq	sp|save_regs+4	get padding word
	lls	0,5		shift word back to position
	cmpa	sp|temp		end of string_2 : string_1
	tnz	cb_done		exit if not equal
"
	cmpx0	sp|str1		has string_1 been finished
	tze	cb_done		yes, exit with zero indicators
"
cp_eag:	eax0	1,0		no, update for next word
	lda	ap|0,0		at end of string_2 continue with string_1
	cmpx0	sp|str1		is this last word in string_1
	tze	cp_gag		yes
	ldq	ap|1,0		no, get next word
	lls	0,1		into position
	sta	sp|temp		save for comparison
	lda	sp|save_regs+4	with padding word
	cmpa	sp|temp		padding : string_1
	tnz	cb_done		exit if not equal
	tra	cp_eag		go continue checking
"
cp_gag:	cmpx4	sp|a1		compare rest1 with a1
	tpl	2,ic		if .ge., do not load next word
	ldq	ap|1,0		get last word
	lls	0,1		into position
	arl	0,4		erase unused bits
	ldq	sp|save_regs+4	get padding word
	lls	0,4		shift padded word back
	sta	sp|temp		save for comparsion
	lda	sp|save_regs+4	with padding word
	cmpa	sp|temp
	tra	cb_done		exit with indicators set
"
"	operators to compare single (double) word string in a-reg (aq_reg)
"	with unaligned string specified by temp_pt, lg1, and a1.
"
cpcs_ext1:
	ldq	blanks		convert to double length string
"
cpcs_ext2:
	staq	sp|double_temp	save string in aq
	lda	blanks		get padding word
	tra	cpbs_ext2+2	join common section
"
cpbs_ext1:
	ldq	0,dl		convert to double length string
"
cpbs_ext2:
	staq	sp|double_temp	save string in aq
	lda	0,dl		get padding word
"
	sreg	sp|save_regs	save regs (including padding word)
	ldq	2,du		set number of words
	stq	sp|str2		in string 2
	stz	sp|a2		offset is zero
	eax5	36
	eppbp	sp|double_temp
	tra	cp_join		join regular comparison
"
"	operator to check an unaligned string for any non-zero bits.
"	entered with bit_size in x6, bit_offset in x7, and pointer
"	to source in bp.
"
cpbs3:
	eaq	0,6		get number of bits
	qrl	18		and then into ql
"
cpbs3_q:
	cmpx7	0,du		is offset zero?
	tze	cpbs3_aligned_q	if so, use aligned section
	stz	sp|a1
	stx7	sp|a1		save bit offset
	div	36,dl		get number of whole words
	eax1	0,ql		into xr1
	eax0	0,al		and number bits in last word
	tze	cpbs3_loop+1	skip if last word full
	neg	0		- num bits in last word
	eaq	36,al		num unused bits in last word
	lda	bp|0,1		get last word
	cmpq	sp|a1		does word overlap
	tpl	2,ic		..
	ldq	bp|1,1		yes, get rest of it
	lls	0,7		into position
	ana	bit_mask_one,0	clear unused bits on right
cpbs3_loop:
	tnz	lp|0		return if non-zero
	eax1	-1,1		count down
	tmi	zero_ind		done if first word passed
	lda	bp|0,1		not done, get previous word
	ldq	bp|1,1		into position
	lls	0,7		..
	cmpa	0,dl		is it zero
	tra	cpbs3_loop	yes, keep looking
"
"	operator to check an aligned string for any non_zero bits.
"	entered with bit_size in x6 and pointer to source in bp.
"
cpbs3_aligned:
	eaq	0,6		number of bits to qu
	qrl	18		and then into ql
"
cpbs3_aligned_q:
	div	36,dl		get number of whole words
	eax1	0,ql		into xr1
	eax0	0,al		number of bits in last word
	tra	cpbs4_a		join common section
"
"	operator to check the aligned string temp pointed at by
"	sp|temp_pt for any non_zero bits.
"
cpbs4:	eppbp	sp|temp_pt,*	get pointer to string
	ldx1	sp|str1		size in words
	lxl0	sp|rem1		num bits in last word
cpbs4_a:
	tze	cpbs4_loop+1	skip if last word full
	lda	bp|0,1		get last word
	ana	bit_mask_one,0	erase unused bits
cpbs4_loop:
	tnz	lp|0		return if non-zero
	eax1	-1,1		count down
	tmi	zero_ind		done if first word passed
	szn	bp|0,1		check previous word
	tra	cpbs4_loop	..
zero_ind:
	lda	0,dl		set zero indicator
	tra	lp|0		and return
"
"	operator to compute index(str1,str2).  entered with str1 specified
"	by previous set operator, length of str2 in x6, bit offset of str2 in x7,
"	and pointer to str2 in bp.
"
index_chars_aligned:
	eaq	0,6		get number of chars in str2
	tze	lp|0		zero means index = 0
	qrl	18		shift num chars to ql
	mpy	9,dl		get bit length
	lda	9,du		get element size
	tra	ixjoin_a		join common section
"
index_bits_aligned_q:
	cmpq	0,dl		are there any bits
	tra	index_bits_aligned+2 go find out
"
index_bits_aligned:
	eaq	0,6		get number of bits in str2
	qrl	18		shift to ql
	tze	lp|0		zero means index = 0
	lda	1,du		get element size
"
ixjoin_a:	sreg	sp|save_regs	save arithmetic registers
	eax7	0		get zero offset
	lda	bp|0		get first 36 bits of str2
	tra	ixix		join common section
"
index_chars:
	eaq	0,6		get number of chars in str2
	tze	lp|0		zero means index = 0
	qrl	18		shift num chars to ql
	mpy	9,dl		get bit length
	lda	9,du		get element size
	tra	ixjoin		join common section
"
index_bits_q:
	cmpq	0,dl		are there any bits
	tra	index_bits+2	go find out
"
index_bits:
	eaq	0,6		get number of bits in str2
	qrl	18		and then to ql
	tze	lp|0		zero means index = 0
	lda	1,du		get element size
"
ixjoin:	sreg	sp|save_regs	save arithmetic registers
	eaq	0,7		form length + offset
	qrl	18		of
	adq	sp|lg2		str2
	lda	bp|0		get first word of str2
	cmpq	37,dl		should we
	tmi	2,ic		load second word?
	ldq	bp|1		yes, fetch it
	lls	0,7		shift to position
"
ixix:	ldq	sp|lg1		get length of str1
	tze	lp|0		zero means index = 0
	cmpq	sp|lg2		is lg1 < lg2
	trc	3,ic
zix:	ldq	0,dl		yes, so index = 0
	tra	lp|0		and return to caller
"
	sta	sp|temp		save first 36 bits of str2
	eppap	sp|temp_pt,*	get ptr to str1
	eax0	0		init str1 counter
	ldx2	sp|a1		get offset of str1
	ldx4	sp|num		get shift register
	stz	sp|count		init index count
	ldq	sp|lg2
	cmpq	37,dl		is lg2 >= 37 bits
	tpl	longindex		yes, must use different sequence
	ldq	36,dl		form n = 36 - lg2 + num in lhs
	sbq	sp|lg2
	qls	18
	adq	sp|num
	stq	sp|n
"
	lda	sp|lg2		form comparison mask
	lcq	1,dl
	qrl	0,al
	stq	sp|qmask
"
ixbegin:	ldq	sp|lg1		are there more than 36 bits left
	cmpq	37,dl
	tpl	ib		yes, 2 words can be fetched
	sbq	sp|lg2		no, form n = lg1 - lg2 + num in lhs
	tmi	ziy		negative means we've failed
	qls	18
	adq	sp|num
	stq	sp|n
	eaq	0,2		are size + offset > 36
	qrs	18
	adq	sp|lg1
	cmpq	37,dl
	tmi	2,ic		yes, skip load of second word
ib:	ldq	ap|1,0		load word 2
	lda	ap|0,0		load word 1
	lls	0,2		shift to position
	ldq	sp|qmask		get mask
	lcx3	sp|n		init count
"
ixloop:	cmk	sp|temp		compare
	tze	succ		on match, get index and exit
	als	0,4		shift by 1 or 9
	aos	sp|count		update counter
	adlx3	sp|num		increment loop counter
	tmi	ixloop		and repeat
"
	lcq	sp|n		update length remaining
	qrs	18
	asq	sp|lg1
	tze	ziy		zero means we've failed
	tmi	ziy		neg too, just to be safe
"
	adlx2	sp|n		compute new offset
	cmpx2	36,du		but don't exceed 36
	tnc	ixbegin
	sblx2	36,du		ready for new word
	adlx0	1,du
	tra	ixbegin
"
ziy:	lreg	sp|save_regs	failure, restore arith regs
	eppap	operator_table	and ptr to operator table
	tra	zix		and take failure exit
"
succ:	aos	sp|count		match, update count
	lreg	sp|save_regs	restore arith regs
	ldq	sp|count		get index in ql
	eppap	operator_table	restore table pointer
	tra	lp|0		and exit
"
longindex:
	ldq	sp|lg1
	stq	sp|n
"
jb:	lda	ap|0,0		load two words of str1
	ldq	ap|1,0
	lls	0,2		shift to position
"
jxloop:	cmpa	sp|temp		compare with str2
	tnz	jxnext		no match, keep looking
"
trycmp:	sprilp	sb|stack_header.stack_end_ptr,* save return ptr
	epplp	sb|stack_header.stack_end_ptr,* get new stack frame of size 64
	sprisp	lp|stack_frame.prev_sp
	epplp	lp|64
	sprilp	sb|stack_header.stack_end_ptr update end pointer
	sprilp	lp|stack_frame.next_sp-64
	eppsp	lp|-64
	epplp	sp|stack_frame.prev_sp,* get ptr to old frame
	eaq	0,2		get offset of str1
	stq	sp|a1		and save
	eppap	ap|0,0		get ptr to current word
	spriap	sp|temp_pt	ans save for set op
	ldq	lp|lg2		get lg2 for use as lg1
	tsplp	sba+1		jump into set operator
	eaq	0,7		get offset of str2
	stq	sp|a2		and save
	ldq	sp|lg1		get new lg1 = old lg2
	lda	0,dl		get filler word
	tsplp	cp_start		go compare strings
"
	epplp	sp|0,*		restore return ptr
	even			"see note at label 'alm_return'
	sprisp	sb|stack_header.stack_end_ptr set up stack end pointer
	eppsp	sp|stack_frame.prev_sp,* pop stack back
	tze	succ		exit if match ok
	eppap	sp|temp_pt,*	restore ptr to str1
"
jxnext:	aos	sp|count		update index counter
	adlx2	sp|num		update loop counter
	lcq	sp|num
	qrs	18
	asq	sp|n
	ldq	sp|n
	cmpq	sp|lg2		do we have enough bits left?
	tnc	ziy		no, we've failed
	cmpx2	36,du		do not shift more than 1 word
	tnc	jb		< 36, try again
	sblx2	36,du		adjust shift amount
	adlx0	1,du		update str1 counter
	tra	jb		and try again
"
"	operator to compute index(str1,str2) when str2 is a single char.
"	entered with pointer to str1 in bp, size of str1 in x6, bit offset
"	of str1 in x7 and value of str2 in a register.
"
ix_cs_1:
	stz	sp|a1		save bit offset
	sxl7	sp|a1		..
	tra	ix_cs_1_aligned+1	and join common section
"
ix_cs_1_aligned:
	stz	sp|a1		offset is zero
"
	eaq	0,6		char size to qu
	tze	lp|0		return if zero length
"
	sta	sp|temp		save str2 for later
	qrl	18		shift size to ql
	mpy	9,dl		convert chars to bits
	adq	sp|a1		add bit offset
	div	36,dl		get words and bits
	lls	18		save word count for loop
	stq	sp|str1		..
	sta	sp|rem1		save number bits in last word
"
	lda	sp|temp		get back char
	ora	mask_bit_one+9	=o000777777777
	ldq	mask_bit_one+9	form char mask in q
	stz	sp|count		init counter
	eax0	0		init word counter
	lxl1	sp|a1		get bit offset of str1
	cmpx1	36,du		is is greater than 36 ?
	tmi	3,ic		no
	eax0	1		yes, adjust word counter
	eax1	-36,1		and bit offset
	lrl	0,1		shift mask to position
	cmpx0	sp|str1		check for end of string
	trc	ix_cs_1b		go finish up
	eax1	-36,1		form a1 - 36
"
ix_cs_1a:	aos	sp|count		update char pos
	cmk	bp|0,0		compare masked char
	tnz	3,ic		skip of no match
"
succ2:	ldq	sp|count		match, get char pos
	tra	lp|0		and return
"
	lrl	9		shift mask right
	adlx1	9,du		update shift count
	tnz	ix_cs_1a		repeat if end of word not reached
"
	lls	36		shift char & mask back to left
	ldq	mask_bit_one+9
	adlx0	1,du		update word count
	cmpx0	sp|str1		check for end of string
	trc	ix_cs_1b
	eax1	-36		reset shift position
	tra	ix_cs_1a		and repeat loop
"
ix_cs_1b:	sblx1	sp|rem1		get number bits in last word
	tze	fail2		exit if nothing more to do
"
ix_cs_1c:	aos	sp|count		update char pos
	cmk	bp|0,0		compare with last (partial) word
	tze	succ2
	lrl	9		shift char & mask right
	adlx1	9,du		update shift
	tnz	ix_cs_1c		and repeat if more to do
"
fail2:	ldq	0,dl		index fails
	tra	lp|0		too bad

"
"	operator to enter a begin block
"	calling sequence is:
"
"		eax7	stack_size
"		tspbp	ap|enter_begin_block
"		vfd	36/on_unit_mask
"
enter_begin_block:
	epplp	sp|linkage_ptr,*	get linkage pointer from parent frame
	spribp	sb|stack_header.stack_end_ptr,* save pointer to entry
	eppbp	sb|stack_header.stack_end_ptr,* get ptr to next stack frame
	sprisp	bp|stack_frame.prev_sp set back pointer of new frame
	eax7	15,7		make sure stack size is 0 mod 16
	anx7	=o777760,du	..
	eppap	bp|0,7		get ptr to end of frame
	spriap	sb|stack_header.stack_end_ptr set new stack end
	spriap	bp|stack_frame.next_sp set next pointer of new frame
	sreg	sp|8		save live registers
	eppsp	bp|0		update sp
"
	eppbp	sp|stack_frame.prev_sp,* get ptr to previous frame
	spribp	sp|display_ptr	set display pointer
	ldaq	null		set arg list pointer to null
	staq	sp|stack_frame.arg_ptr ..
	sprilp	sp|int_static_ptr	save pointer to int static
	sprilp	sp|linkage_ptr	and pointer to linkage segment
	eppbp	sp|0,*		restore return pointer
	eppbp	bp|-2		get entry pointer
	spribp	sp|stack_frame.entry_ptr save in stack
	tra	init_stack_join	go init rest of stack frame
"
"	operator to leave a begin block.
"
leave_begin_block:
	even			"see note at label 'alm_return' of pl1_operators_
	sprisp	sb|stack_header.stack_end_ptr reset stack end pointer
	eppsp	sp|stack_frame.prev_sp,* pop the stack
	lreg	sp|8		reload active registers
	tra	lp|0		return to pl1 program
"
"	operator to do a procedure return from inside a begin block.
"	entered with number of nested begin blocks in ql.
"
begin_return_mac:
	even			"see note at label 'alm_return' of pl1_operators_
	sprisp	sb|stack_header.stack_end_ptr reset stack end pointer
	eppsp	sp|stack_frame.prev_sp,* pop stack
	sbq	1,dl		count down number of blocks
	tnz	-3,ic		repeat until all done
"
"	operator to do a procedure return
"
return_mac:
	even			"see note at label 'alm_return' of pl1_operators_
	sprisp	sb|stack_header.stack_end_ptr reset stack end pointer
	eppsp	sp|stack_frame.prev_sp,* pop stack
fast_return:
	epbpsb	sp|0		set sb up
	eppap	sp|stack_frame.operator_ptr,* set up operator pointer
	ldi	sp|stack_frame.return_ptr+1	restore indicators for caller
	rtcd	sp|stack_frame.return_ptr continue execution after call
"
"	operators to call an entry variable
"	entered with pointer to entry in bp and number
"	of arguments in position in aq
"
call_ent_var_desc:
	eaq	0,au		there are descriptors
"
call_ent_var:
	ora	8,dl		insert pl1 code
	staq	sp|64		save at head of list
	sprilp	sp|0		save return point
	sreg	sp|8		save registers
	eppap	bp|2,*		get display pointer
	eppbp	bp|0,*		and ptr to entry
save_display:
	spriap	sp|66,au		put at end of arg list
	eppap	sp|64		get ptr to arg list
	epplp	sp|linkage_ptr,*	restore ptr to linkage segment
actual_call:
"At this point we would like to save the indicators in the return_ptr variable
"of the stack frame. However the STCD does not allow us to do this.
"Therefore we save the indicators in the timer/ring-alarm cell of the registers.
	sti	sp|15		"Sorry...
	stcd	sp|stack_frame.return_ptr set so control will come back to operators
"
"	This label is 'segdef'ed but is never transfered to directly. The segdef is
"	merely to allow default_error_handler to see if a fault occured as a result
"	of this particular instruction so that it can print a more informative
"	error message.
"
call_out:
	callsp	bp|0		transfer to callee
"
"	control comes back here after callee returns
"
	lreg	sp|8		restore the registers
	ldi	sp|15		restore our indicators
	epbpab	ap|0		set up operator base pointer
	rtcd	sp|0		return to caller thru saved lp
"
"
"	operator to call an external procedure (same or diff seg).
"	entered with pointer to entry in bp and number of args
"	in position in aq.
call_ext_in_desc:
call_ext_out_desc:
	eaq	0,au		there are descriptors
"
call_ext_in:
call_ext_out:
	ora	4,dl		insert pl1 code
	staq	sp|64		save at head of list
	sprilp	sp|0		save return point
	sreg	sp|8		save registers
	eppap	sp|64		get pointer to arg list
	epplp	sp|linkage_ptr,*	reload ptr to linkage segment
	tra	actual_call	go do call work
"
"	operator to call an internal procedure defined in the
"	same block as the call.  entered with pointer to entry in
"	bp and number of args in position in aq.
"
call_int_this_desc:
	eaq	0,au		there are descriptors
"
call_int_this:
	ora	8,dl		insert pl1 code
	staq	sp|64		save at head of list
	sprilp	sp|0		save return point
	sreg	sp|8		save registers
	sprisp	sp|66,au		save display pointer
	eppap	sp|64		get pointer to arg list
	tra	actual_call	transfer to entry
"
"	operator to call an interal procedure defined K blocks
"	above the call.  entered with pointer to entry in bp,
"	K in x7, and number of args in position in aq.
"
call_int_other_desc:
	eaq	0,au		there are descriptors
"
call_int_other:
	ora	8,dl		insert pl1 code
	staq	sp|64		save at head of list
	sprilp	sp|0		save return point
	sreg	sp|8		save registers
	eppap	sp|display_ptr,*	walk back K levels
	eax7	-1,7		..
	tze	save_display	then go save display
	eppap	ap|display_ptr,*	take another step
	tra	-3,ic		and check again
"
"	operator to move the label variable pointed at by sp|temp_pt
"	into the label variable pointed at by bp
"
move_label_var:
	ldaq	sp|temp_pt,*	move first two words
	staq	bp|0		..
	eax0	2		and second two words
	ldaq	sp|temp_pt,*0	..
	staq	bp|2		..
	tra	lp|0		return to pl1 program
"
"	operator to make a label variable in the stack.  entered
"	with pointer to label in bp, number of static blocks to walk
"	back in q.  sp|temp_pt is set to point to the label variable
"
make_label_var:
	spribp	sp|label_var	save pointer to label
	tsx0	display_chase	get pointer to stack frame
	spribp	sp|label_var+2	and save in label var
	eppbp	sp|label_var	get pointer to label var
	spribp	sp|temp_pt	set temp_pt
	tra	lp|0		return to pl1 program
"
"	subroutine to walk N levels back along the display chain.
"	entered with N in q register, exit with pointer in bp.
"	NB: indicators must be set from q register at time of entry.
"
display_chase:
	eppbp	sp|0		get pointer to current frame
	tze	0,0		return if N = 0
	eppbp	bp|display_ptr,*	take a step back the chain
	sbq	1,dl		and decrease count
	tra	-3,ic		and check again
"
"	operator to form mod(fx2,fx2)
"	entered with first arg in aq, bp pointing at second
"
mdfx4:	lde	=71b25,du		set for double precision
	tra	mdfx2+2		join mod(fx1,fx2) case
"
"	operator to form mod(fx2,fx1)
"	entered with first arg in aq, bp pointing at second
"
mdfx3:	lde	=71b25,du		float first d.p. arg
	fad	=0.,du
	dfst	sp|temp		and save
	lda	bp|0		get second s.p. arg
	ldq	0,dl
	lde	=35b25,du		set for single precision
	tra	mdfx2a		join mod(fx1,fx2) case
"
"	operator to form mod(fx1,fx2)
"	entered with first arg in q, bp pointing at second
"
mdfx2:	llr	36		shift q into a
	lde	=35b25,du		float
	fad	=0.,du
	dfst	sp|temp		and save
	ldaq	bp|0		get second arg
	lde	=71b25,du		float it
mdfx2a:	fad	=0.,du		..
	tnz	3,ic		continue if non-zero
	dfld	sp|temp		get first arg
	tra	fl2_to_fx2	and return as answer
	dfst	sp|a1		save second arg
	dfdi	sp|temp		divide first/second
	dfad	k71b25		drop digits to right of decimal pt
	dfmp	sp|a1		multiply by second arg
	fneg
	dfad	sp|temp		form remainder
	tpl	fl2_to_fx2	go fix result if pos
	fszn	sp|a1		correct sign to pos
	tpl	3,ic
	dfsb	sp|a1
	tra	fl2_to_fx2
	dfad	sp|a1		fall into fl2_to_fx2
"
"	operator to convert floating to fixed
"
fl2_to_fx1:
fl2_to_fx2:
	fad	=0.,du
	tmi	3,ic
	ufa	=71b25,du
	tra	lp|0
	fneg
	ufa	=71b25,du
	negl
	tra	lp|0
"
"	stac operator.  entered with word in a and pointer
"	to destination in bp.
"
stac_mac:	stac	bp|0		store a conditionally
	tze	stac_debug	see if stac worked DEBUGGING
	lda	0,dl		..
	tra	lp|0		and return
stac_debug:
	cmpa	bp|0		see if stac worked DEBUGGING
	tze	true		yes DEBUGGING
	oct	0		bomb DEBUGGING
"
"	sign operator.  entered with indicators set via load
"
sign_mac:	tze	lp|0		return zero if zero
	tmi	3,ic		skip if negative
	ldq	1,dl		return +1
	tra	lp|0		..
	lcq	1,dl		return -1
	tra	lp|0		..
"
"	operator to perform block copy.  entered
"	with block size in ql, ptr to destination in sp|temp_pt and ptr
"	to source in bp.
"
copy_words:
	eppap	rpd_copy		set rpd instruction
	spriap	sp|rpd_pt		..
	eppap	sp|temp_pt,*	get ptr to destination
	qls	18		move size to qu
	tsx0	rpd_op		call rpd routine
	eppap	operator_table	reset ap
	tra	lp|0		and return to caller
"
"	operator to copy dope template into stack.  entered with
"	pointer to template in bp and vfd 18/stack_offset,18/size
"	sitting at lp|0
"
move_dope:
	eppap	rpd_copy		set rpd instruction
	spriap	sp|rpd_pt		..
	ldq	lp|0		get offset,size
	eppap	sp|0,qu		get pointer to destination
	qlr	18		shift count to qu
	tsx0	rpd_op		call rpd routine
	eppap	operator_table	restore pointer to op table
	tra	lp|1		and return to pl/1 program
"
"	operator to multiply single precision fixed number in q
"	by double precision fixed number pointed at by bp
"
mpfx2:	eax0	0		set for positive sign
	llr	36		shift multiplier to a
	tpl	3,ic		skip if positive
	neg	0		neg, force positive
	eax0	1		flip sign of result
	sta	sp|temp		save multiplier
	ldaq	bp|0		get multiplicand
	tpl	3,ic		skip if positive
	negl	0		neg, force positive
	erx0	1,du		flip sign of answer
	llr	1		get high order bit of q into q
	qrl	1		get zero in s bit of q
	ana	mask_bit+2	and zero in s bit of a
	sta	sp|rem1		save upper half
	mpy	sp|temp		form lower product
	staq	sp|lv		save for later
	ldq	sp|rem1		get upper half
	mpy	sp|temp		form upper product
	lda	0,dl		clear a
	lls	35		and shift to position
	adaq	sp|lv		add lower product
	cmpx0	0,du		check result of answer
	tze	lp|0		return if +
	negl	0		negate
	tra	lp|0		and return to pl/1 program
"
"	operator to multiply double precison fixed integer in aq
"	by double precsion fixed number pointed at by bp.
"
mpfx3:	eax0	0		set positive sign
	cmpa	0,du		skip if number positive
	tpl	3,ic
	negl	0		neg, force positive
	eax0	1		flip sign of answer
	llr	1		split into 2 35 bit pos numbers
	qrl	1
	ana	mask_bit+2
	sta	sp|a1		save for later
	stq	sp|a2
	ldaq	bp|0		get multplier
	tpl	3,ic		force positive
	negl	0
	erx0	1,du		and set answer sign
	llr	1		split
	qrl	1
	ana	mask_bit+2
	sta	sp|str1		save for later
	stq	sp|str2
	mpy	sp|a2		form lower product
	staq	sp|lv		and save
	ldq	sp|str1		form first upper product
	mpy	sp|a2
	lda	0,dl		and add to lower
	lls	35
	adaq	sp|lv
	staq	sp|lv		save partial answer
	ldq	sp|a1		form second upper product
	mpy	sp|str2
	lda	0,dl		shift to position
	lls	35
	adaq	sp|lv		add previous part
	cmpx0	0,du		should answer be neg
	tze	lp|0		no, return
	negl	0		set minus sign
	tra	lp|0		and return
"
"	operator to perform string range check.  entered with
"		length of string (k) in x6
"		bp|0	pointing at i' (also in q)
"		bp|1	pointing at j
"
sr_check:
	stq	bp|0		save i'
	stz	sp|lg1		save k
	sxl6	sp|lg1		..
	cmpq	0,dl
	tmi	sr_1		signal if i' < 0
	cmpq	sp|lg1		signal if i' >= k
	tpl	sr_2
	ldq	bp|1		get j
	tmi	sr_3		signal if j < 0
	cmpq	sp|lg1		signal if j > k
	tmi	2,ic
	tnz	sr_3
	adq	bp|0		form i + j
	cmpq	sp|lg1		return if i + j < k
	tmi	lp|0
	tze	lp|0
"
sr_3:	tsx0	string_signal
	ldq	sp|lg1		get min(k-i+1,j)
	sbq	bp|0
	cmpq	bp|1
	tmi	2,ic
	ldq	bp|1
set_j:	cmpq	0,dl		use zero if q < 0
	tpl	2,ic
	ldq	0,dl
	stq	bp|1		set new value of j
	tra	lp|0		return
"
sr_2:	tsx0	string_signal
	stz	bp|1		set new value of j = 0
	tra	lp|0		return
"
sr_1:	tsx0	string_signal
	adq	bp|1		form j+i-1
	stz	bp|0		set new value of i' = 0
	cmpq	sp|lg1		get min(j+i-1,k)
	tmi	set_j		and go set value of j
	ldq	sp|lg1
	tra	set_j
"
string_signal:
	stx0	sp|temp		save x0
	spribp	sp|lv		and bp
	lxl6	11,dl		get length of condition
	eppbp	strg		get ptr to condition name
	tsx1	call_signal_	signal "stringrange"
	ldx0	sp|temp		restore x0
	eppbp	sp|lv,*		and bp
	tra	0,0		and return
strg:	aci	"stringrange"
"
"	non-local transfer operator.  entered with bp pointing
"	at destination and number of stack levels to pop in q.
"
tra_ext_1:
	spribp	sp|lv		save ptr to destination
	tsx0	display_chase	get ptr to stack frame
	spribp	sp|lv+2		finish the label variable
	eppbp	sp|lv		fall into unwinder_ call
"
"	non-local transfer operator.  entered with bp pointing
"	at a label variable.
"
tra_ext_2:
	spribp	sp|arg_list+2	save ptr to label var
	fld	2*1024,dl		there are 2 args
	staq	sp|arg_list	..
	eppap	sp|arg_list	get ptr to arg_list
	tsx1	get_our_lp	get ptr to our linkage in lp
	tra	<unwinder_>|[unwinder_] go unwind stack
"
"	operator to assign auto adjustable variables at end of stack
"	frame.  entered with number of words in q, exit with pointer
"	to storage in bp.
"
so_mac:	eaq	15,ql		make size a multiple of 16
	anq	=o777760,du	..
	eppbp	sb|stack_header.stack_end_ptr,* get ptr to storage
	asq	sb|stack_header.stack_end_ptr+1 reset stack end ptr
	asq	sp|stack_frame.next_sp+1 reset next ptr
	asq	sp|5		and set to remember this storage
	tra	lp|0		return to caller
"
"	floating point mod operators entered with x in eaq and
"	bp pointing at y.  mod(x,y) = if y = 0 then x else x - ceil(x/y)*y
"
mdfl1:	fszn	bp|0		is y = 0
	tze	lp|0		yes, return with x in eaq as answer
	fst	sp|temp		save x
	fdv	bp|0		divide x/y
	fad	=71b25,du		get ceiling
	fmp	bp|0		form ceil(x/y)*y
	fneg
	fad	sp|temp		form answer
	tpl	lp|0		return if pos
	fszn	bp|0		correct sign
	tpl	3,ic
	fsb	bp|0
	tra	lp|0
	fad	bp|0
	tra	lp|0		and return
"
mdfl2:	fszn	bp|0		is y = 0
	tze	lp|0		yes, return with x in eaq as answer
	dfst	sp|temp		save x
	dfdv	bp|0		divide x/y
	dfad	k71b25		get ceiling
	dfmp	bp|0		form ceil(x/y)*y
	fneg
	dfad	sp|temp		form answer
	tpl	lp|0		return if pos
	fszn	bp|0		correct sign
	tpl	3,ic
	dfsb	bp|0
	tra	lp|0
	dfad	bp|0
	tra	lp|0		and return
	even
k71b25:	oct	216000000000,000000000000
"
"	fixed point mod operator entered with x in q and bp pointing at y.
"	if y = 0 then answer is x
"
mdfx1:	szn	bp|0		is y = 0
	tze	lp|0		yes, return with x in q as answer
	div	bp|0		form quotient
	lrs	36		shift remainder to q, set indicators
	tpl	lp|0		positive remainder is ok
	szn	bp|0		check sign of divisor
	tpl	3,ic		and adjust sign of remainder
	sbq	bp|0		..
	tra	lp|0		..
	adq	bp|0		..
	tra	lp|0		..
"
"	operator to convert a long bit string to double precision fixed.
"	entered with pointer to string in sp|temp_pt, and a1, lg1, str1 set.
"	based on bsfx_ by C. Garman and D. Wagner.
"
longbs_to_fx2:
	fld	0,dl		clear aq
	szn	sp|lg1		test bit length of string
	tze	lp|0		return immediately if zero length
	staq	sp|double_temp	initialize result
	eax0	maxpr		x0 = min(length,maxpr)
	ldq	sp|lg1
	cmpq	maxpr,dl		..
	tpl	2,ic		..
	lxl0	sp|lg1		..
	ldq	sp|str1		get num whole words in string
	lda	sp|rem1		and num bits in last word
	als	18
	ada	sp|a1		add bit offset of string
	cmpa	36,du		greater than 36?
	tmi	3,ic		no, skip
	sba	36,du		yes, adjust
	adq	1,du		..
	eppbp	sp|temp_pt,*qu	get ptr to last word of string
	sta	sp|temp		save spare
	neg
	eax1	36,au		get amount of shift needed
	ldq	bp|0		get last 36-temp bits of string
	qrl	0,1		..
	stq	sp|double_temp+1	and save
	eaa	-2,0		quit if min(length,maxpr) <= 36-temp
	cmpa	sp|temp		..
	tmi	lbfx_done		..
	lda	bp|-1		get next to last word
	ldq	0,du		clear q
	lrl	0,1		..
	orsa	sp|double_temp	combine with last part
	orsq	sp|double_temp+1	..
	eaa	-38,0		quit if min(length,maxpr) <= 72-temp
	cmpa	sp|temp		..
	tmi	lbfx_done		..
	lda	bp|-2		get first part
	ldq	0,du
	lrl	0,1		put high order bits in q
	orsq	sp|double_temp	drop high order bits into result
lbfx_done:
	ldaq	mask_bit		mask out any garbage
	lls	0,0		which may have gotten into result
	eraq	mask_bit		..
	anaq	sp|double_temp	..
	tra	lp|0		return to caller
"
"	operator to convert a long bit string to bit 18 (used for ptr built-ins).
"	entered with pointer to string in sp|temp_pt and lg1, str1, a1 set.
"
longbs_to_bs18:
	fld	0,dl		clear aq
	szn	sp|lg1		test bit length of string
	tze	lp|0		if zero length, return 0
	eppbp	sp|temp_pt,*	get ptr to string
	lda	bp|0		get first word of string
	ldq	sp|a1		form length + offset
	ars	18
	adq	sp|lg1
	cmpq	37,dl		should second word beloaded
	tmi	2,ic		..
	ldq	bp|1		yes, load it
	lls	sp|a1,*		shift to position
	ldq	sp|lg1		get length of string
	cmpq	18,dl
	tpl	2,ic		dont mask if lg1 >= 18
	ana	bit_mask_one,ql
	anaq	mask_bit+36	mask to length 18
	tra	lp|0		return to caller
"
"	operator to enable a condition.  calling sequence is:
"		eapbp	name
"		lxl6	name_size
"		tsplp	ap|enable
"		tra	on_unit_body
"		arg	on_unit
"		tra	skip_around_body
"	body of on unit starts here
"
	equ	on_name,0
	equ	on_body,2
	equ	on_size,4
	equ	on_next,5
	equ	on_file,6
"
enable_op:
	lda	=o100,dl		is there a valid on_unit_list
	cana	sp|stack_frame.prev_sp check bit 29 of prev sp
	tnz	3,ic		non-zero means ok
	stz	sp|stack_frame.on_unit_rel_ptrs init ptr
	orsa	sp|stack_frame.prev_sp and set bit
"
	ldx1	sp|stack_frame.on_unit_rel_ptrs get rel ptr to first enabled unit
	tze	add_on		zero means chain empty
on_1:	cmpx1	lp|1		is this the unit we want
	tze	have_on		yes, go process
	ldx1	sp|on_next,1	no, get ptr to next on chain
	tnz	on_1		and repeat if end not reached
add_on:	ldx1	lp|1		get rel ptr to new unit
	ldx0	sp|stack_frame.on_unit_rel_ptrs get rel ptr to first unit
	stz	sp|on_next,1	clear next ptr rhs
	stx0	sp|on_next,1	set next ptr of new unit
	stx1	sp|stack_frame.on_unit_rel_ptrs make new unit first on chain
have_on:	spribp	sp|on_name,1	set name of new unit
	sprilp	sp|on_body,1	set ptr to body
	stz	sp|on_size,1	clear size field
	sxl6	sp|on_size,1	set size of unit name
	tra	lp|2		return to pl2 program
"
"	operator to signal a condition.  entered with ptr to name in bp
"	and size of name in x6.
"
signal_op:
	tsx1	call_signal_	call signal_
	tra	lp|0		and return
"
"	operator to signal "subscriptrange" condition
"
bound_ck_signal:
	stx6	sp|temp		save x6
	lxl6	14,dl		get size of condition
	eppbp	subrg		get ptr to name
	tsx1	call_signal_	call signal_
	ldx6	sp|temp		restore x6
	tra	lp|0		and return
subrg:	aci	"subscriptrange"
"
"	internal subroutine to signal a condition.  entered with
"	bp pointing at name and x6 holding size of name
"
"
call_signal_:
	sprilp	sp|temp_pt	save return pointer
	eppap	sb|stack_header.stack_end_ptr,* get ptr to end of stack frame
	eax0	48+16		increase stack frame size by mc size + arg list size
	asx0	sb|stack_header.stack_end_ptr+1 ..
	asx0	sp|stack_frame.next_sp+1 ..
	spri	ap|mc.prs		save bases
	spribp	ap|mc.scu.tpr.tsr_word	set ptr to name as tsr value
call_signal_1:
	spriap	ap|48+12		save ptr to machine conditions
	eppap	ap|48		get ptr to argument list
	spribp	ap|2		set ptr to name as first arg
	eppbp	ap|12		get ptr to machine conditions
	spribp	ap|4		as second arg
	ldq	=o10100,du	get char string descriptor code
	stq	ap|10		make descriptor for first arg
	sxl6	ap|10		..
	eppbp	ap|10		set ptr to descriptor
	spribp	ap|6		..
	eppbp	=o150000000	get ptr to pointer descriptor code
	spribp	ap|8		set ptr to descriptor
	eax0	sig		get offset of link to signal_
	fld	2*2048,dl		set number of args

signal_common:
	sreg	ap|mc.regs-48	save registers in pseudo_scu
	epplp	lp|-1		move lp back to tspbp instruction
	sprilp	ap|mc.scu.ppr.psr_word-48 set psr in pseudo_scu data
	eaq	0,au		and descriptors
	ora	4,dl		from a pl1 call
	staq	ap|0		set head of arglist
	sreg	sp|8		save regs for call
	tsx1	get_our_lp	get ptr to our linkage in lp
	stcd	sp|stack_frame.return_ptr call pl1 written signal program
	tra	lp|0,0*		..
	xed	reset_stack	reset stack frame
	epplp	sp|temp_pt,*	restore lp
	eppap	operator_table	and pointer to operators
	lreg	sp|8		get the regs back
	tra	0,1		and return

get_our_lp:
	epbpsb	sp|0		make sure sb is set up
	epaq	*		get ptr to ourselves
	lprplp	sb|stack_header.lot_ptr,*au get packed ptr to linkage from lot
	tra	0,1		return with lp loaded to our linkage
"
"	operator to signal io condition, same as signal except sp|40 holds
"	pointer to file name.
"
io_signal:
	sprilp	sp|temp_pt	save return point
	eppap	sb|stack_header.stack_end_ptr,* get pointer to end of stack frame
	eax0	48+32		bump frame by (mc size+arg list size) 0 mod 16 words
	asx0	sb|stack_header.stack_end_ptr+1 ..
	asx0	sp|stack_frame.next_sp+1 ..
	spri	ap|mc.prs		store bases
	spribp	ap|mc.scu.tpr.tsr_word	set ptr to name as tsr value
	spriap	ap|48+16		set ptr to machine conditions
	eppap	ap|48		get ptr to argument list
	spribp	ap|2		save ptr to name as first arg
	eppbp	ap|16		get ptr to machine conditions ptr
	spribp	ap|4		save as second arg
	eppbp	sp|40		get ptr to file name ptr
	spribp	ap|6		save as third arg
	ldq	520,du		get char string descriptor code
	stq	ap|14		make descriptor
	sxl6	ap|14		..
	eppbp	ap|14		set ptr to first descriptor
	spribp	ap|8		..
	eppbp	=o15000000	get ptr to ptr code
	spribp	ap|10		set descriptor for second arg
	spribp	ap|12		and third
	eax0	io_sig		get offset of link to signal_|io_signal
	fld	3*2048,dl		there are 3 args
	tsx1	signal_common	jump into common section to signal
	tra	lp|0		and return
"
"	Following are dummies in place of operators not as yet implemented
"	The condition "unimplemented_pl1_operator" is signalled 
"
dvfx2:
dvfx3:
allot_based:
free_based:
	sprilp	sp|temp_pt	save return point
	eppap	sb|stack_header.stack_end_ptr,* get ptr to end of stack
	eax0	48+16		increase stack frame size by mc size + arg list size
	asx0	sb|stack_header.stack_end_ptr+1 ..
	asx0	sp|stack_frame.next_sp+1 ..
	spri	ap|mc.prs		save prs
	sreg	ap|mc.regs	and registers
	epplp	lp|-1		move back lp to tsplp instruction
	sprilp	ap|mc.scu.ppr.psr_word	set psr in pseudo-scu data
	lda	lp|0		pickup the tsplp instruction
	epplp	operator_table,au	get ptr to transfer table entry
	sprilp	ap|mc.scu.tpr.tsr_word	set tsr in psuedo-scu data
	stx6	sp|temp		save x6
	lxl6	26,dl		get size of condition
	eppbp	unimp_pl1_op	get ptr to name
	tsx1	call_signal_1	call signal_
	ldx6	sp|temp		restore x6
	epplp	temp_pt,*		restore return point
	tra	lp|0		and return

unimp_pl1_op:
	aci	"unimplemented_pl1_operator"
"
"	Single word mask arrays are used only by operators
"
bit_mask_one:
	vfd	0/-1,36/0
	vfd	1/-1,35/0
	vfd	2/-1,34/0
	vfd	3/-1,33/0
	vfd	4/-1,32/0
	vfd	5/-1,31/0
	vfd	6/-1,30/0
	vfd	7/-1,29/0
	vfd	8/-1,28/0
	vfd	9/-1,27/0
	vfd	10/-1,26/0
	vfd	11/-1,25/0
	vfd	12/-1,24/0
	vfd	13/-1,23/0
	vfd	14/-1,22/0
	vfd	15/-1,21/0
	vfd	16/-1,20/0
	vfd	17/-1,19/0
	vfd	18/-1,18/0
	vfd	19/-1,17/0
	vfd	20/-1,16/0
	vfd	21/-1,15/0
	vfd	22/-1,14/0
	vfd	23/-1,13/0
	vfd	24/-1,12/0
	vfd	25/-1,11/0
	vfd	26/-1,10/0
	vfd	27/-1,9/0
	vfd	28/-1,8/0
	vfd	29/-1,7/0
	vfd	30/-1,6/0
	vfd	31/-1,5/0
	vfd	32/-1,4/0
	vfd	33/-1,3/0
	vfd	34/-1,2/0
	vfd	35/-1,1/0
"
mask_bit_one:
	vfd	0/0,36/-1
	vfd	1/0,35/-1
	vfd	2/0,34/-1
	vfd	3/0,33/-1
	vfd	4/0,32/-1
	vfd	5/0,31/-1
	vfd	6/0,30/-1
	vfd	7/0,29/-1
	vfd	8/0,28/-1
	vfd	9/0,27/-1
	vfd	10/0,26/-1
	vfd	11/0,25/-1
	vfd	12/0,24/-1
	vfd	13/0,23/-1
	vfd	14/0,22/-1
	vfd	15/0,21/-1
	vfd	16/0,20/-1
	vfd	17/0,19/-1
	vfd	18/0,18/-1
	vfd	19/0,17/-1
	vfd	20/0,16/-1
	vfd	21/0,15/-1
	vfd	22/0,14/-1
	vfd	23/0,13/-1
	vfd	24/0,12/-1
	vfd	25/0,11/-1
	vfd	26/0,10/-1
	vfd	27/0,9/-1
	vfd	28/0,8/-1
	vfd	29/0,7/-1
	vfd	30/0,6/-1
	vfd	31/0,5/-1
	vfd	32/0,4/-1
	vfd	33/0,3/-1
	vfd	34/0,2/-1
	vfd	35/0,1/-1

"
"	pl1 entry operators
"	calling sequence is:
"
"		aci	"name of pl1 entry"
"		vfd	36/size_of_pl1_entry_string
"		vfd	72/parameter_description_string
"		eax7	stack_size
"		eax6	stack_offset_of_arg_list
"		tspbp	lp|ext_entry,*	lp -> linkage section of pl1 program
"		vfd	18/on_unit_mask,18/2*number_of_args_expected
"
"	the operators desc_ext_entry, desc_int_entry, and desc_val_entry
"	will only copy the number of args passed and no more than are
"	are expected--missing args will be set to a special pointer.
"
"	for int_entry, the A register will contain the first word
"	of the argument list.
"
"	for val_entry, the on_unit_mask will be followed with
"		nop	val_proc,dl
"	where val_proc is the location of the link to the validation
"	procedure to be called.
"
	bool	string_bit,200000
	bool	array_bit,100000
	bool	packed_bit,40000
	bool	varying_bit,2000
"
"
	odd			"this forces first rpd on odd loc
ext_entry:
	spribp	sb|stack_header.stack_end_ptr,* save pointer to entry
	eppbp	sb|stack_header.stack_end_ptr,* get ptr to next stack frame
	sprisp	bp|stack_frame.prev_sp set back ptr of new frame
	spriap	bp|stack_frame.arg_ptr save arg pointer
	eax7	15,7		make sure stack size is 0 mod 16
	anx7	=o777760,du	..
	eppap	bp|0,7		get ptr to end of frame
	spriap	bp|stack_frame.next_sp set next pointer of new frame
	spriap	sb|stack_header.stack_end_ptr update end ptr
	eppsp	bp|0		update sp
ee:	eppap	sp|stack_frame.arg_ptr,* restore arg pointer
	lda	ap|0		get 2*n_args in au, code in al
	eax7	0		this is ext entry
"
common_entry:
	ars	9		get number of pairs.ls.10 in al
	tze	save_link-*,ic	skip if no args
	eax0	rpd_bits,al	setup rpd instruction
	eax1	0		..
	odd
	vfd	18/0,12/rpd,6/2	RPD instruction
	ldaq	ap|2,1		copy arg list into stack
	staq	sp|0,6		..
save_link:
	eppbp	lp|0		remember lp value
	sprilp	sp|int_static_ptr	save pointer to int static
	sprilp	sp|linkage_ptr	and pointer to linkage seg of pl1 prog
init_stack:
	eppbp	sp|0,*		restore pointer to entry
	eppbp	bp|-3,7		get pointer to entry
	spribp	sp|stack_frame.entry_ptr store entry pointer in its frame (debugging)
init_stack_join:
	stz	sp|single_bit_temp+1
	lda	2,du		fill in translator ID for VERSION I
	sta	sp|stack_frame.translator_id
	epplp	sb|stack_header.stack_end_ptr,* get pointer to next frame
	eppap	operator_table	get pointer to operator table
	spriap	sp|stack_frame.operator_ptr save ptr to operators
	epbpab	pl1_operator_begin	get address of base of operators
	sprilp	sp|4		we will only store lp and that is because it points
"				to the next stack frame and we use this in adjusting
"				the current frame size up and resetting it.
	eppbp	sp|0,*		restore return pointer
	ldi	0,dl		preset all indicators
	tra	bp|1		return to pl1 program
"
int_entry:
	spribp	sb|stack_header.stack_end_ptr,* save pointer to entry
	eppbp	sb|stack_header.stack_end_ptr,* get ptr to next stack frame
	sprisp	bp|stack_frame.prev_sp set back ptr of new frame
	spriap	bp|stack_frame.arg_ptr save arg pointer
	eax7	15,7		make sure stack size is 0 mod 16
	anx7	=o777760,du	..
	eppap	bp|0,7		get ptr to end of frame
	spriap	bp|stack_frame.next_sp set next pointer of new frame
	spriap	sb|stack_header.stack_end_ptr update end ptr
	eppsp	bp|0		update sp
	eppap	sp|stack_frame.arg_ptr,* restore arg pointer
	lda	ap|0		get 2*n_args in au
	eppbp	ap|2,au*		get display pointer
	spribp	sp|display_ptr	and save
	eax7	-3		this is int entry
	tra	common_entry-*,ic	join common section
"
ext_entry_desc:
	ldx5	ap|0		get number of args actually passed
	tra	2,ic		and go do save
"
desc_ext_entry:
	lxl5	bp|0		get number of args expected
"
	spribp	sb|stack_header.stack_end_ptr,* save pointer to entry
	eppbp	sb|stack_header.stack_end_ptr,* get ptr to next stack frame
	sprisp	bp|stack_frame.prev_sp set back ptr of new frame
	spriap	bp|stack_frame.arg_ptr save arg pointer
	eax7	15,7		make sure stack size is 0 mod 16
	anx7	=o777760,du	..
	eppap	bp|0,7		get ptr to end of frame
	spriap	bp|stack_frame.next_sp set next pointer of new frame
	spriap	sb|stack_header.stack_end_ptr update end ptr
	eppsp	bp|0		update sp
eed:	eppap	sp|stack_frame.arg_ptr,* restore arg pointer
	lda	ap|0		get 2*n_args in au, code in al
	eax7	0		this is ext entry
"
desc_ce:
	cana	8+4,dl		is this an epl call
	tze	desc_epl_call-*,ic	yes, go convert to descriptors
	cmpx5	ap|0		compare number to copy with number passed
	tze	2,ic
	trc	desc_toofew-*,ic	too few, go to special section
	eaa	0,5		there are >= number expected, use number expected
	tze	save_link-*,ic	skip if none expected
	ars	9		get number of pairs.ls.10 in al
	eax0	rpd_bits,al	setup rpd instruction
	stx6	sp|temp		save x6 for later restoration
	eax1	2		..
	odd
	vfd	18/0,12/rpd,6/2	RPD instruction
	ldaq	ap|0,1		copy arg list into stack
	staq	sp|0,6		..
	eax6	0,5		get no words moved in x6
	adx6	sp|temp		make x6 point to word just after move
"
	ldx1	ap|0		get number of descriptors
	tze	no_desc-*,ic	skip if none
	adlx1	2,du		allow for stack header
	lda	ap|0		is there a stack pointer
	cana	8,dl		..
	tze	2,ic		no
	adlx1	2,du		yes, skip over it
	eaa	0,5		get number expected
	ars	9		get number of pairs.ls.10 in al
	eax0	rpd_bits,al	setup rpd instruction
	odd
	vfd	18/0,12/rpd,6/2	RPD instruction
	ldaq	ap|0,1		copy descriptor pointers
	staq	sp|0,6		into stack
	tra	save_link-*,ic	then join standard sequence
"
no_args:
	eaa	0,5		no args passed
	ars	9		fill in with special pointer
	eax0	rpt_bits,al	..
	stx6	sp|temp		save x6 for later restoration
	ldaq	dummy_arg-*,ic
	vfd	18/0,12/rpt,6/2	rpt instruction
	staq	sp|0,6		..
	eax6	0,5		get no words moved in x6
	adx6	sp|temp		make x6 point to word just after move
"
no_desc:	eaa	0,5		no desc passed, get number expected
	ars	9		shifted left 10 in al
	eax0	rpt_bits,al	set up rpt instruction
	stx6	sp|temp		save x6 for later restoration
	ldaq	dummy_desc-*,ic	get ptr to dummy descriptor
	vfd	18/0,12/rpt,6/2	rpt instruction
	staq	sp|0,6		store descriptor
	eax6	0,5		get no words moved in x6
	adx6	sp|temp		make x6 point to word just after move
	tra	save_link-*,ic	then join standard sequence
"
desc_toofew:
	eax1	2		not enough arguments
	lda	ap|0		get number of args passed and
	eax3	0,au		get number words to move in x3
	ars	9		copy as many as there are
	tze	no_args-*,ic	skipping if none
	eax0	rpd_bits,al	set up rpd instruction
	stx6	sp|temp		save x6 for later restoration
	odd
	vfd	18/0,12/rpd,6/2	rpd instruction
	ldaq	ap|0,1		copy args
	staq	sp|0,6		..
	eax6	0,3		get no words moved in x6
	adx6	sp|temp		make x6 point to word just after move
"
fill_args:
	eax4	0,5		compute number of missing args
	sbx4	ap|0		..
	eaa	0,4		get number missing in au
	ars	9		and fill in special pointer
	eax0	rpt_bits,al	..
	stx6	sp|temp		save x6 for later restoration
	ldaq	dummy_arg-*,ic	..
	vfd	18/0,12/rpt,6/2	rpt instruction
	staq	sp|0,6
	eax6	0,4		get no words moved in x6
	adx6	sp|temp		make x6 point to word just after move
"
	lda	ap|0		is there a stack pointer
	cana	8,dl		..
	tze	2,ic		no
	adlx1	2,du		yes, skip over it
	lda	ap|1		are there any descriptors
	tze	no_desc-*,ic	no, go fill in dummy
	eax3	0,au		save no words to be moved in x3
	ars	9		yes, copy as many as are given
	eax0	rpd_bits,al
	stx6	sp|temp		save x6 for later restoration
	odd
	vfd	18/0,12/rpd,6/2
	ldaq	ap|0,1		copy descriptor
	staq	sp|0,6
	eax6	0,3		get no words moved in x6
	adx6	sp|temp		make x6 point to word just after move
"
	eaa	0,4		get number of missing descriptors
	ars	9
	eax0	rpt_bits,al	set up rpt instruction
	ldaq	dummy_desc-*,ic	get pointer to dummy desc
	vfd	18/0,12/rpt,6/2	rpt instruction
	staq	sp|0,6		save dummy descriptor
	tra	save_link-*,ic	and join common section
"
desc_epl_call:
	eaa	0,au		erase right hand side
	tze	no_args-*,ic	skip if no args given
	eax2	0,5		compute where to store descriptors
	eppbp	sp|0,*		restore ptr to entry
	adx2	bp|-2,1		by adding in value in x6
	eax4	0,5		get number expected
	cmpx4	ap|0		take min(expected,passed)
	tnc	2,ic		..
	ldx4	ap|0		..
	stx4	sp|n		set loop bound
	sprilp	sp|2		save lp setting
	ldaq	sb|stack_header.stack_end_ptr initialize stack extension mechanism
	staq	sp|free_pt	..
	stz	sp|free_amt	..
	eax0	0		init arg checking loop
	ldq	bp|-4,1		get arg description string
	lda	bp|-5,1		..
"
desc_epl_call_1:
	eppbp	ap|2,0*		get ptr to argument
	tmi	have_dope-*,ic	should this be a specifier
	spribp	sp|0,6		no, set arg pointer
	epplp	dummy_desc-*,ic*	get special ptr for descriptor
set_desc_pt:
	sprilp	sp|0,2		set descriptor ptr
	adlx0	2,du		update arg counter
	cmpx0	sp|n		are we done
	tze	fill_arg_epl-*,ic	yes, go fill any missing args
	adlx2	2,du		no, update descriptor counter
	adlx6	2,du		and arg destination counter
	lls	1		shift to next description bit
	tra	desc_epl_call_1-*,ic and repeat
"
have_dope:
	epplp	bp|0,*		get ptr to datum
	sprilp	sp|0,6		save in unpacked form
	staq	sp|double_temp	save param description string
	ldaq	bp|2,*		get first two words of dope
	canq	string_bit,du	is this a string
	tnz	string-*,ic	yes
	als	18		no, shift add offset to au
	asa	sp|1,6		add into data pointer
	canq	array_bit,du	is this a non-string-array
	tnz	non_string_array-*,ic yes
"
non_string_scalar:
	lda	1,du		get a one word descriptor
	tsx3	get_desc-*,ic
nss:	qrs	27		isolate size in ql
	anq	7,dl		..
	stq	lp|0		set size of descriptor
	ldaq	sp|double_temp	restore param description string
	tra	set_desc_pt-*,ic	go set descriptor
"
non_string_array:
	lda	4,du		get a four word descriptor
	tsx3	get_desc-*,ic
	lda	bp|3		move multiplier
	sta	lp|3
	lda	bp|4		move lb
	sta	lp|1
	lda	bp|5		move ub
	sta	lp|2
	tra	nss-*,ic		join non_array sequence
"
string:
	canq	varying_bit,du	is it varying
	tnz	varying_string-*,ic	yes
	canq	packed_bit,du	is this packed string
	tnz	packed_string-*,ic	yes
	als	18		no, add word address offset
	asa	sp|1,6		into data ptr
	tra	string_1-*,ic	join common section
packed_string:
	lrs	36		shift bit address offset to ql
	div	36,dl		get number of words
	qls	18		into qu
	asq	sp|1,6		adjust data ptr
	als	9		set bit offset of data ptr
	orsa	sp|1,6		..
	ldaq	bp|2,*		reload first words of dope
string_1:
	canq	array_bit,du	is this an array
	tnz	string_array-*,ic	yes
s1:	lda	1,du		get a one word descriptor
	tsx3	get_desc-*,ic
ss:	stq	sp|length		save string size.
	ldaq	sp|double_temp	get pds
	lls	1		shift to c|b bit
	staq	sp|double_temp	save again
	ldq	sp|length		get size back
	anq	=o77777,dl	isolate size
	szn	sp|double_temp	is this a char string
	tpl	nss+2-*,ic	plus means bit
	div	9,dl		form size in chars
	tra	nss+2-*,ic	go save size
"
string_array:
	lda	4,du		get a four word descriptor
	tsx3	get_desc-*,ic	..
	lda	bp|4		move multiplier
	sta	lp|3
	lda	bp|5		move lb
	sta	lp|1
	lda	bp|6		move ub
	sta	lp|2
	tra	ss-*,ic		join non-array case
"
varying_string:
	canq	array_bit,du	is this varying-string-array
	tnz	set_desc_pt-1-*,ic	yes, use null ptr to descriptor
	ldaq	bp|0,*		get varying string info
	epplp	bp|4,*au		load free ptr into lp plus offset of string
	sprilp	sp|0,6		use as data ptr
	tra	s1-*,ic		now treat like non-varying string
"
fill_arg_epl:
	sbx5	ap|0		compute number of missing args
	tmi	desc_done-*,ic	skip if there are extra args
	tze	desc_done-*,ic	skip if none
	adlx2	2,du		update descriptor counter
	adlx6	2,du		update arg ptr counter
	eaa	0,5		init rpt loop
	ars	9
	eax0	rpt_bits,al
	ldaq	dummy_arg-*,ic	get dummy arg pointer
	vfd	18/0,12/rpt,6/2	fill missing positions
	staq	sp|0,6
	eaa	0,5		init rpt loop
	ars	9
	eax0	rpt_bits,al
	ldaq	dummy_desc-*,ic	get dummy desc pointer
	vfd	18/0,12/rpt,6/2	fill missing positions
	staq	sp|0,2
"
desc_done:
	epplp	sp|temp_pt,*	restore lp
	tra	save_link-*,ic	and join standard sequence
"
int_entry_desc:
	ldx5	ap|0		get number of args actually passed
	tra	2,ic		and go do save
"
desc_int_entry:
	lxl5	bp|0		get number of args expected
"
	spribp	sb|stack_header.stack_end_ptr,* save pointer to entry
	eppbp	sb|stack_header.stack_end_ptr,* get ptr to next stack frame
	sprisp	bp|stack_frame.prev_sp set back ptr of new frame
	spriap	bp|stack_frame.arg_ptr save arg pointer
	eax7	15,7		make sure stack size is 0 mod 16
	anx7	=o777760,du	..
	eppap	bp|0,7		get ptr to end of frame
	spriap	bp|stack_frame.next_sp set next pointer of new frame
	spriap	sb|stack_header.stack_end_ptr update end ptr
	eppsp	bp|0		update sp
	eppap	sp|stack_frame.arg_ptr,* restore arg pointer
	lda	ap|0		get 2*n_args in au
	eppbp	ap|2,au*		get display pointer
	spribp	sp|display_ptr	and save
	eax7	-3		this is int entry
	tra	desc_ce-*,ic	join common section
"
val_entry_desc:
	eax0	ved-*,ic		get destination
	tra	4,ic		go to save sequence
"
desc_val_entry:
	eax0	dev-*,ic		get destination
	tra	2,ic		go to save sequence
"
val_entry:
	eax0	ee-*,ic		get destination
	spribp	sb|stack_header.stack_end_ptr,* save pointer to entry
	eppbp	sb|stack_header.stack_end_ptr,* get ptr to next stack frame
	sprisp	bp|stack_frame.prev_sp set back ptr of new frame
	spriap	bp|stack_frame.arg_ptr save arg pointer
	eax7	15,7		make sure stack size is 0 mod 16
	anx7	=o777760,du	..
	eppap	bp|0,7		get ptr to end of frame
	spriap	bp|stack_frame.next_sp set next pointer of new frame
	spriap	sb|stack_header.stack_end_ptr update end ptr
	eppsp	bp|0		update sp
	eppbp	sp|0,*		reload ptr to entry
	eppbp	bp|-3		get pointer to first instruction of entry
	spribp	sp|stack_frame.entry_ptr store entry pointer in its frame (debugging)
	eppbp	sp|0,*		get entry ptr again
	eppap	sp|stack_frame.arg_ptr get ptr to arg pointer
	spriap	sp|arg_list+2	set as arg of val call
	fld	2*1024,dl		set head of arg list
	staq	sp|arg_list	..
	eppap	sp|arg_list	get ptr to arg list
	sprilp	sp|stack_frame.lp_ptr	store a valid ptr so returning pgm can
"					load valid info from here in standard return sequence
	spri	sp|0		save bases and regs
	sreg	sp|stack_frame.regs	..
	ldx1	bp|1		get offset of link to val proc
	stcd	sp|stack_frame.return_ptr call validate procedure
	tra	lp|0,1*		..
	lpri	sp|0		restore bases and regs
	lreg	sp|stack_frame.regs	..
	spribp	sp|0		save pointer to entry again
	tra	0,0		and transfer to ee|dev|ved
"
dev:	lxl5	bp|0		get number of args expected
	tra	eed-*,ic		and enter standard sequence
"
ved:	ldx5	ap|0		get number of args passed
	tra	eed-*,ic		and enter standard sequence
"
get_desc:
	cmpa	sp|free_amt	is there enough room
	tmi	gd_ok-*,ic	yes
	tze	gd_ok-*,ic	yes
	ldx4	8,du		no, extend stack by eight words
	asx4	sb|stack_header.stack_end_ptr+1 ..
	asx4	sp|stack_frame.next_sp+1 ..
	asx4	sp|free_amt	..
gd_ok:	epplp	sp|free_pt,*	return value of free_pt
	eppbp	bp|2,*		get ptr to dope
	asa	sp|free_pt+1	update free_pt
	neg
	asa	sp|free_amt	and free_AMT
	tra	0,3		return to caller
"
	even
null:	its	-1,1,n
dummy_arg:
	oct	077777000043,700000000000
dummy_desc:
	oct	0,0
"
	link	sig,<signal_>|[signal_]
	link	io_sig,<signal_>|[io_signal]
"
" The following line must appear after everything in text segment
"
pl1_operators_end:
	zero	0,*		marks end of pl1_operators
	end
"
"
"                                          -----------------------------------------------------------
"
"
"
" Historical Background
"
" This edition of the Multics software materials and documentation is provided and donated
" to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. 
" as a contribution to computer science knowledge.  
" This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology,
" Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull
" and Bull HN Information Systems Inc. to the development of this operating system. 
" Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970),
" renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership
" of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for
" managing computer hardware properly and for executing programs. Many subsequent operating systems
" incorporated Multics principles.
" Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., 
" as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. .
"
"                                          -----------------------------------------------------------
"
" Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without
" fee is hereby granted,provided that the below copyright notice and historical background appear in all copies
" and that both the copyright notice and historical background and this permission notice appear in supporting
" documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining
" to distribution of the programs without specific prior written permission.
"    Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc.
"    Copyright 2006 by Bull HN Information Systems Inc.
"    Copyright 2006 by Bull SAS
"    All Rights Reserved
"
"