|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 17664 (0x4500)
Types: TextFile
Names: »t2903proc«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »t2903proc«
procedure jump_addrs;
<******************>
begin
if alu_function_performed or jump_sekvens_performed or
jump_addrs_performed or addrs_performed then
error(multiple_function,line_no,element_no);
present(name_table(number,2),
sekvens_mask);
present(name_table(number,3),
condition_enable_mask);
next;
if class = left_par_class then
begin
scan_sekvens_operands(false);
end;
addrs_performed := jump_addrs_performed := code_generated:=true;
end of jump_addrs;
procedure jump_sekvens;
begin
if jump_addrs_performed or jump_sekvens_performed then
error(multiple_function,line_no,element_no);
present(name_table(number,2),
sekvens_mask);
present(name_table(number,3),
condition_enable_mask);
next;
if class=left_par_class then
begin
scan_sekvens_operands(true);
end;
jump_sekvens_performed := true; code_generated:=true;
end of jump_sekevens;
procedure load_counter;
begin
jump_addrs;
end of load_counter;
procedure special;
<*****************>
begin
long spec_number;
integer kind_1,op_value1,op_value2,kind_2,index;
if name_table(number,3) < special_min or
name_table(number,3) > special_max then
error(special_def_type,line_no,element_no)
else
case name_table(number,3) of
begin
begin
<* case 1 is
value by name_table(number,2)
mask by a mask entry given by
nametable(nametable(number,4),2)
*>
present(
name_table(number,2),
name_table(name_table(number,4),2));
end of case 1;
begin
<* case 2 is no parameters and mask
Is pointed out by name_table(name,4),
among the fixed mask values,
from left to rigth in the format
*>
present(
name_table(number,2),
std_mask(name_table(number,4)));
end of case 2;
begin
<* case 3.
set or clear depending on value,
the bits taken from argument 1 to
argument 2 *>
spec_number:=number;
next1;
if class1 <> left_par_class then
error(delimiter,line_no,element_no)
else
begin
if name_table(spec_number,4) = 2 then
get_2_reg_operands(op_value_1,op_value_2)
else
begin
get_a_reg_operand(op_value_1,kind_1);;
op_value_2 := op_value_1;
end;
for index:= op_value_1 step 1 until op_value_2 do
present(name_table(spec_number,2),
(extend 1 ) shift (47 - index));
next;
if class <> right_par_class then
error(delimiter,line_no,element_no)
end;
end case 3;
begin
<* case 4 one bit is set or cleared acording to
the bit number specicfied by nametable(number,4) *>
present(extend ( name_table(number,2)
extract 1) , extend 1 shift (47 -
name_table(number,4)));
end case 4;
begin
<* case 5
load counter from internal register
pointed out by
pointed out by s address field or q reg.
s address field second bit is set
and w_reg enable is set *>
if jump_addrs_performed or jump_sekvens_performed or
alu_function_performed or addrs_performed then
error(multiple_function,line_no,element_no);
jump_addrs_performed := jump_sekvens_performed :=
alu_function_performed := addrs_performed :=true;
<* first the function of the 2910 is masked in *>
present(name_table(number,2),
sekvens_mask);
<* if condition schould be forced to true then
name_table(number,4) is 1 *>
present(name_table(number,4),
condition_enable_mask);
class1:=getnext_element(name_1,number1);
if class1 <> left_par_class then
begin
error(missing_operand,line_no,element_no);
end
else
begin
get_a_reg_operand(op_value_1,kind_1);
if op_value_1 >=0 and op_value_1 <16 then
begin
<* an reg. from alu source *>
present(extend op_value_1,
short_source_mask);
present(extend 0,
not_ea_mask);
present(extend 6,
alu_function_mask);
present(extend 0,
carry_control_mask);
end else
if op_value_1 = q_regs_value then
begin
present(extend 1,
alu_special_control_mask);
present(extend 4,
alu_function_mask);
end else
error(illegal_type,line_no,element_no);
present(extend 1,
w_reg_enable_mask);
present(extend 2,
dest_mask);
present(extend 6,
alu_short_dest_mask);
present(extend 0,
alu_both_i5_mask);
next;
if class <> right_par_class then
error(minus_delim,line_no,element_no);
end;
end case 5;
begin
<* case 6
load counter from internal register
pointed out by
pointed out by s address field or q reg.
s address field second bit is set
and w_reg enable is set *>
if jump_addrs_performed or jump_sekvens_performed
then
error(multiple_function,line_no,element_no);
jump_addrs_performed := jump_sekvens_performed := true;
<* first the function of the 2910 is masked in *>
present(name_table(number,2),
sekvens_mask);
<* if condition schould be forced to true then
name_table(number,4) is 1 *>
present(name_table(number,4),
condition_enable_mask);
present(extend 1,
w_reg_enable_mask);
present(extend 2,
dest_mask);
end case 6;
end of all cases;
code_generated:=true;
next;
if class = comma_class then
next;
end of special;
procedure scan_sekvens_operands(use_of_addrs_field);
<***********************************************>
value use_of_addrs_field; boolean use_of_addrs_field;
begin
next;
for class := class while class <> right_par_class
and class <> stop_line_class do
begin
if class = text_class and type = condition_type then
begin
<* condition *>
present(name_table(number,2),
condition_select_mask);
end
else
if class = unknown_name_class or class = number_class or
class = apost_class or
class = text_class then
begin
<* addrs. ref. *>
if class = apost_class then next;
if look_ahead_class = right_par_class then
begin
if use_of_addrs_field then error(plus_addrs_def,line_no,element_no);
if class = unknown_name_class or
(class = text_class <*and name_table(number,0) = label_type*>) then
addrs_ref(name,instr_index,line_no,element_no)
else
present(number,
addrs_and_imm_mask);
use_of_addrs_field := true;
end else
error(unknown,line_no,element_no);
end
else
begin
error(missing_operand,line_no,element_no);
end;
next;
if class = comma_class then next;
end;
if class = right_par_class then next;
if -, use_of_addrs_field then error(minus_addrs_def,line_no,element_no);
end of scan_addrs_operands;
procedure alu_function;
<*********************>
begin
integer type_of_operands;
if alu_function_performed then
error(multiple_function,line_no,element_no);
present(name_table(number,2),
alu_function_mask);
type_of_operands := name_table(number,3);
class := look_ahead_class;
if class = left_par_class then
begin
case type_of_operands of
begin
normal_function(0);
normal_function(1);
special_function(0);
special_function(1);
special_function(2);
end; <*
end of case *>
next;
end;
code_generated:=true; alu_function_performed:=true;
end of alu_function;
procedure normal_function(carry);
value carry; integer carry;
begin
integer dest_value,dest_kind,no_of_operands;
no_of_operands := scan_alu_operands(dest_value,dest_kind);
if no_of_operands > 0 then
begin
present(extend carry,
carry_control_mask);
set_alu_output(dest_value,dest_kind,0,element_no -
( if no_of_operands = 1 then
1 else no_of_operands+2));
end;
end procedure normal_function;
procedure special_function(carry);
<********************************>
value carry; integer carry;
begin
long spec_value;
integer dest_value,dest_kind,no_of_operands;
spec_value := name_table(number,2);
no_of_operands := scan_alu_operands(dest_value,dest_kind);
if no_of_operands > 0 then
begin
end;
present(extend carry,
carry_control_mask);
present(extend 0,
alu_full_function_mask);
present(spec_value,
alu_dest_mask);
end procedure special_function;
integer procedure scan_alu_operands(dest_val,dest_kind);
<******************************************************>
integer dest_val,dest_kind;
begin
integer no_of_op,val_1,kind_1,val_2,kind_2,val_3,kind_3;
no_of_op :=
get_all_reg_operands(val_1,kind_1,val_2,kind_2,val_3,kind_3);
if no_of_op > 3 then no_of_op :=3;
scan_alu_operands:= no_of_op;
if no_of_op > 0 then
begin
dest_val := val_1;
dest_kind := kind_1;
end
else
begin
dest_val := 0;
dest_kind := 0;
no_of_op := 0;
end;
case no_of_op + 1 of
begin
begin <* 0 operands *>
end;
begin <* 1 operand *>
if kind_1 <> text_class then
error(illegal_dest,line_no,element_no-1)
else
set_alu_dest(val_1,kind_1,element_no - 1 );
end;
begin <* 2 operands *>
if val_1 > 15 and kind_2 <> number_class then
begin
set_alu_dest(val_2,kind_2,element_no - 1);
end
else
if ( val_2 <= 15 and val_2 >= 0 )
or kind_2 = number_class then
begin
set_alu_source(val_2,kind_2,element_no - 1);
set_alu_dest(val_1,kind_1,element_no -3);
end
else
if ( val_1 = w_index_value or val_1 = w_pre_index_value) and
val_2 = q_regs_value then
begin
set_alu_dest(val_1,kind_1,element_no -3);
present(extend 1,
alu_special_control_mask);
end
else
begin
set_alu_dest(val_2,kind_2,element_no - 1);
end;
end case 2 operands;
begin <*case 3 operands *>
if kind_2 = number_class or
( kind_3 = text_class and (val_3 = q_regs_value or
val_3 = w_pre_index_value or val_3 = w_index_value)) then
begin
set_alu_source(val_2,kind_2,element_no -3);
set_alu_dest(val_3,kind_3,element_no - 1);
end
else
begin
set_alu_source(val_3,kind_3,element_no -1);
set_alu_dest(val_2,kind_2,element_no - 3);
end;
end;
end case loop;
end scan_alu_operands;
procedure set_alu_output(op_value,op_kind,special,element_no);
<************************************************************>
value op_value,op_kind,special,element_no;
integer op_value,op_kind,special,element_no;
begin
if op_kind = text_class then
begin
if op_value = q_regs_value then
begin
present( extend 3,
alu_short_dest_mask);
present(extend 0,
alu_both_i5_mask);
end
else
if op_value = w_index_value or op_value = w_pre_index_value then
begin
present(extend 2,alu_short_dest_mask);
present(extend 0,alu_both_i5_mask);
present(extend 1,w_reg_enable_mask);
present(if op_value = w_index_value then extend 0 else extend 1,
dest_mask);
end
else
if op_value > 15 then
begin
present(extend 1,
write_2901_reg_mask);
present( extend 0,
not_oeb_mask);
present(extend 6,
alu_short_dest_mask);
present(extend 0,
alu_both_i5_mask);
end
else
if op_value >=0 and op_value <=15 then
begin
present(extend 2,
alu_short_dest_mask);
present(extend 0,
alu_both_i5_mask);
present(extend op_value,
dest_mask);
end
else
error(illegal_dest,line_no,element_no);
end else
error(illegal_dest,line_no,element_no);
end set_alu_output;
procedure set_alu_source(op_value,op_kind,element_no);
<****************************************************>
value op_value,op_kind,element_no;
integer op_value,op_kind,element_no;
begin
if op_kind = number_class then
begin
if addrs_performed then
error(multiple_function,line_no,element_no);
addrs_performed := true;
present(extend 1,
not_ea_mask);
present(extend op_value,
addrs_and_imm_mask);
end
else
if op_kind = text_class then
begin
if op_value > 16 then
error(illegal_source,line_no,element_no)
else
begin
present(extend 0,
not_ea_mask);
present(extend op_value,
short_source_mask);
end;
end
else
error(illegal_source,line_no,element_no);
end of set_alu_source;
procedure set_alu_dest(op_value,op_kind,element_no);
<***************************************************>
value op_value,op_kind,element_no;
integer op_value,op_kind,element_no;
begin
if op_kind = text_class then
begin
if op_value = q_regs_value then
begin
present(extend 1,
alu_special_control_mask);
present(extend 0,
dest_mask);
end
else
if op_value = w_index_value
or op_value = w_pre_index_value then
begin
present(extend 1,
w_reg_enable_mask);
present(
if op_value = w_index_value then
extend 0 else extend 1,
dest_mask);
present(extend 0,
not_oeb_mask);
present(extend 0,
alu_special_control_mask);
end
else
if op_value > 15 then
begin
present(extend 1,
not_oeb_mask);
present(extend 0,
alu_special_control_mask);
present(extend 0,
dest_mask);
end
else
if op_value >= 0 and op_value < 16 then
begin
present(extend 0,
not_oeb_mask);
present( extend 0,
alu_special_control_mask);
present(extend op_value,
dest_mask);
end
else
error(illegal_dest,line_no,element_no);
end
else
error(illegal_dest,line_no,element_no);
end set_alu_dest;
long procedure std_mask(mask_no);
<******************************>
value mask_no; long mask_no;
begin
std_mask := case mask_no of
(
condition_enable_mask,
sekvens_mask,
cond_my_reg_enable_mask,
cond_m_reg_enable_mask,
condition_select_mask,
condition_full_mask, <* select and kind *>
alu_full_length_mask,
alu_dest_mask, <* alu bit i8 to both i5 *>
alu_short_dest_mask,
alu_i5_left_mask,
alu_i5_rigth_mask,
alu_both_i5_mask,
alu_function_mask, <* alu bit i4 to i1 *>
alu_full_function_mask, <* alu bit i4 to i0 *>
alu_special_control_mask, <* alu bit i0 *>
carry_control_mask,
set_2904_shift_mask,
not_ea_mask,
w_reg_enable_mask,
w_reg_enable_sel_mask,
not_oeb_mask,
read_2901_reg_mask,
write_2901_reg_mask,
alu_full_source_mask, <* not ea and not oeb and alu bit i0 *>
source_extern_mask,
dest_extern_mask,
short_source_mask,
short_dest_mask,
source_mask,
dest_mask,
addrs_mask,
addrs_and_imm_mask, <* addrs and immidiate mask *>
cond_kind_set_mask,
not_half_w_move_enable_mask,
half_w_move_dir_mask,
half_word_move_mask,
shift_control_2904_mask, <* controls the 2904 instr bit i6 to i9 *>
all_m_reg_enable_mask, <* all bits to control great m reg *>
select_m_reg_enable_mask, <* only to select th bits *>
select_interupt_bit_mask,
instr_full_length); <* all bits in instr *>
end procedure std_mask;
▶EOF◀