|
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: 14592 (0x3900)
Types: TextFile
Names: »t2901proc«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »t2901proc«
procedure jump_addrs;
<*******************>
begin
if alu_function_performed or jump_sekvens_performed or
jump_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_addrs_operands;
end;
jump_addrs_performed := true; code_generated:=true;
end 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_condition_operands;
end;
jump_sekvens_performed := true; code_generated:=true;
end jump_sekevens;
procedure load_counter;
<**********************>
begin
jump_addrs;
end load_counter;
procedure special;
<****************>
begin
long spec_number;
integer op_value1,op_value2,index,
kind_1,kind_2;
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.
1 bit is cleared or set depending of nametable
nametable(index,4) specifi the number. *>
<* only last bit of nametable(number,2) is used *>
present(
extend( name_table(number,2) extract 1),
extend 1 shift (47 - name_table(number,4)));
end case 4;
end of all cases;
code_generated:=true;
next;
if class = comma_class then
next;
end special;
procedure scan_sekvens_operands(addrs_performed);
<************************************************>
boolean addrs_performed;
begin
integer type;
next;
for class := class while class <> right_par_class
and class <> stop_line_class do
begin
if class = text_class and name_table(number,0) = condition_type then
begin
<* condition *>
type:= name_table(number,0);
if type <> condition_type then
error(illegal_type,line_no,element_no)
else
present(name_table(number,2),
name_table(name_table(number,4),2));
<* write(out,<:<10>test mask :>,<<-d>,
name_table(number,2),
name_table(number,4),
name_table(name_table(number,4),2) shift (-24),
name_table(name_table(number,4),2) extract 24,"nl",1);
*>
end
else
if class = unknown_name_class or class = number_class or
class = apost_class or
( class = text_class and name_table(number,0) =label_type) then
begin
<* addrs. ref. *>
if class = apost_class then
next;
if look_ahead_class = right_par_class then
begin
if addrs_performed then error(plus_addrs_def,line_no,element_no);
if class = unknown_name_class or class = text_class then
addrs_ref(name,instr_index,line_no,element_no)
else
present(number,addrs_mask);
addrs_performed := true;
end else
error(operand,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 -, addrs_performed then error(minus_addrs_def,line_no,element_no);
end scan_sekvens_operands;
procedure scan_addrs_operands;
<****************************>
begin
scan_sekvens_operands(false);
end scan_addrs_operands;
procedure scan_condition_operands;
<*********************************>
begin
scan_sekvens_operands(true);
end scan_condition_operands;
procedure alufunction;
<********************>
begin
integer type_of_operands;
if alu_function_performed or jump_addrs_performed then
error(multiple_function,line_no,element_no);
present(name_table(number,2),
alu_func_mask);
type_of_operands := name_table(number,3);
case type_of_operands of
begin
internal_operands(0);
internal_operands(1);
internal_and_external(0);
internal_and_external(1);
zero_one_operand(0);
one_operand(0);
one_operand(1);
end;
next;
code_generated:=true; alu_function_performed:=true;
end alu_function;
integer procedure set_alu_dest(op_value);
<********************************>
value op_value; integer op_value;
begin
<* result 0 = ok
-1 = operand error
-3 = impossiple *>
integer dest_value;
set_alu_dest := 0;
dest_value := noload;
if op_value > 15 then
dest_value := no_load
else
if op_value = q_regs_value then
dest_value := q_reg
else
if op_value < 16 and op_value >= 0 then
dest_value := ramf
else
set_alu_dest := 3;
present(extend dest_value,alu_dest_mask);
end set alu_dest;
integer procedure set_alu_source(op_value_1,op_value_2);
<******************************************************>
value op_value_1,op_value_2; integer op_value_1,op_value_2;
begin
integer source_value;
set_alu_source := 0; <* for o.k. *>
<* -1 for 1. operand error
-2 for 2. operand error
-3 for impossible error *>
if op_value_1 = not_used or op_value_2 = not_used then
begin
if op_value_1 = not_used then op_value_1 := op_value_2;
if op_value_1 = q_regs_value then
source_value := z_and_q
else
if op_value_1 > 15 then
source_value := d_and_z
else
if op_value_1 <15 and op_value_1 >= 0 then
begin
if op_value_2 = not_used then
source_value := z_and_b
else
source_value := z_and_a;
end
else
set_alu_source := if op_value_2 = not_used then -1 else -2;
end
else
if op_value_1 = q_regs_value or op_value_2 = q_regs_value then
begin
if op_value_1 = q_regs_value then op_value_1 := op_value_2;
if op_value_1 > 15 then
source_value := d_and_q
else
if op_value_1 >= 0 and op_value_1 <= 15 then
source_value := a_and_q
else
begin
set_alu_source := if op_value_2 = q_regs_value then -1 else -2;
end
end
else
if op_value_1 > 15 or op_value_2 > 15 then
begin
source_value := d_and_a;
end
else
if op_value_1 >= 0 and op_value_2 >= 0 then
begin
source_value := a_and_b;
end
else
set_alu_source := -3 ; <* schould be impossiple *>
present(extend source_value,alu_source_mask);
end set_alu_source;
procedure internal_operands(carry);
<*********************************>
value carry; integer carry;
begin
integer op_value_1,op_value_2,op_value_3,
kind_1,kind_2,kind_3,no_of_op,set_result,
dest_value,source_value;
no_of_op := get_all_reg_operands(op_value_1,kind_1,
op_value_2,kind_2,
op_value_3,kind_3);
case no_of_op + 1 of
begin
begin <* case 0 operands *>
end;
begin <* case 1 operands *>
set_result := set_alu_dest(op_value_1);
set_result := set_alu_source(op_value_1,not_used);
source_value := dest_value := op_value_1;
end;
begin <* case 2 operands *>
set_result := set_alu_dest(op_value_1);
set_result := set_alu_source(op_value_1,op_value_2);
dest_value := op_value_1;
source_value := if op_value_2 = q_regs_value
then op_value_1 else op_value_2;
end;
begin <* case 3 operands *>
set_result := set_alu_dest(op_value_1);
set_result := set_alu_source(op_value_2,opvalue_3);
if op_value_1 = q_regs_value then
begin
dest_value := if op_value_2 > 15 then op_value_3 else op_value_2;
source_value := if op_value_2 > 15 then op_value_2 else op_value_3;
end
else
if op_value_2 = q_regs_value or op_value_3 = q_regs_value then
begin
dest_value := op_value_1;
source_value := if op_value_2 = q_regs_value then op_value_3 else
opvalue_2;
end
end;
end all case;
if dest_value <> q_regs_value then
present( extend dest_value,dest_mask);
if source_value <> q_regs_value then
present(extend source_value,source_mask);
present(extend( if source_value > 15 then 1 else 0) ,
special_source_mask);
present(extend( if source_value > 15 then 1 else 0),
control_enable_mask);
present(extend carry,carry_mask);
end internal operands;
procedure internal_and_external(carry);
<**************************************>
value carry; integer carry;
begin
integer op_value_1,op_value_2,op_value_3,
kind_1,kind_2,kind_3,no_of_op,set_result;
no_of_op := get_all_reg_operands(op_value_1,kind_1,opvalue_2,kind_2,
op_value_3,kind_3);
if no_of_op = 2 then
begin
if op_value_1 <> q_regs_value then
present(extend op_value_1,dest_mask);
if op_value_2 <> q_regs_value then
present(extend op_value_2,source_mask);
if op_value_2 > 15 then
begin
present(extend 1,special_source_mask);
present(extend 1,control_enable_mask);
end;
set_alu_dest(op_value_1);
set_alu_source(not_used,op_value_2);
end else
error(illegal_dest_and_source,line_no,element_no);
present(extend carry,carry_mask);
end internal_and_external;
procedure zero_one_operand(carry);
<*******************************>
value carry; integer carry;
begin
integer op_value,kind,op_value_1,kind_1,op_value_2,kind_2,
op_value_3,kind_3,no_of_op,set_result;
no_of_op := get_all_reg_operands(op_value,kind,op_value_2,kind_2,
op_value_3,kind_3);
if op_value <> q_regs_value then
present(extend op_value,dest_mask);
present(z_and_q,alu_source_mask);
if op_value > 15 then
present(no_load,alu_dest_mask)
else
if op_value = q_regs_value then
present(q_reg,alu_dest_mask)
else
present(ramf,alu_dest_mask);
present(extend carry, carry_mask);
end zero_one_operand;
procedure one_operand(carry);
<***************************>
value carry; integer carry;
begin
integer op_value,kind,op_value_1,kind_1,op_value_2,kind_2,
op_value_3,kind_3,no_of_op,set_result;
no_of_op := get_all_reg_operands(op_value,kind,op_value_2,kind_2,
op_value_3,kind_3);
if op_value>15 then
error(operand_type,line_no,element_no - 2);
present(extend op_value,short_dest_mask);
present(extend op_value,short_source_mask);
if op_value = q_regs_value then
begin
present(q_reg,alu_dest_mask);
present(z_and_q,alu_source_mask);
end
else
begin
present(ramf,alu_dest_mask);
present(z_and_b,alu_source_mask);
end;
present(extend carry,carry_mask);
end one_operand;
long procedure std_mask(mask_no);
<*******************************>
value mask_no; long mask_no;
begin
<* uses mask_no to select among the standard
hc2901 mask *>
std_mask := case mask_no of
(
parity_mask,
sekvens_mask,
condition_enable_mask,
condition_select_mask,
condition_pol_mask,
status_reg_enable_mask,
interupt_enable_mask,
spare_1_mask,
control_enable_mask,
control_code_mask,
dest_extern_mask,
source_extern_mask,
carry_mask,
alu_dest_mask,
alu_source_mask,
alu_func_mask,
short_dest_mask,
short_source_mask,
addrs_mask,
dest_mask,
source_mask,
alu_addrs_mode_mask,
alu_full_length_mask,
control_full_mask
);
end std_mask;
▶EOF◀