|
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: 69120 (0x10e00)
Types: TextFile
Names: »t35mass«
└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
└─⟦093e2ad1c⟧
└─⟦this⟧ »t35mass«
job fh 1 1000 size 90000 area 10 buf 10 time 11 0 perm disc 300 300,
output 300000
mode list.yes
rc35mass=set 1 disc
if ok.no
finis
scope login rc35mass
rc35mass=algol connect.no fp.no list.no bossline.yes blocks.yes
begin
boolean expr_expected, printing, listing, bcdef, compress, disassemble,
warning, jump_table, printbin, genoutput, bossline, mess,
expl_bdest, expl_bsource, irdef, rcdef, fastregs, disasskneh, default1;
integer i, j, k, p, p1, swopcount, linelength, pass, kk, expr_pointer,
instr, map_k, reps,
fpnames, nextbossline, boss_line_no, sourceno, fpcount,
line_no, page_no, errors, warnings,
fbdest, fcond, fslop,
fsldest, fbsource, fslop1, fslop2, const_field_length, ra_def_length,
aq, ab, oq, ob, oa, da, dq, d0,
ar, fq, fn, bd;
long op1, op2, alufunc, areg, breg, bitword1, bitword2,
no_burn, word, symb_name,
data1, data2, sliceop, implc, cdef, radef, bfdef, name, binary,
r, q, ass, aluass, carshift, clr, comma, car, op, dofunc,
jump, cond_allowed, invert, line_end, vect, map, sign, undef, ir,
rc, minus, carry, cond;
long array symb(0:1999, 0:3), ext(1:30, 0:1), a(1:30),
bin_mem(0:2047, 0:1), fp_file, headname(1:2);
integer array line(1:200), char_pos(1:30), map_table(0:1023+4);
zone zin, bin(128, 1, stderror);
integer max_symb, entr_no;
\f
procedure examineparams(initmode);
value initmode;
boolean initmode;
begin
boolean first;
integer pno, j, i, type, paramfct, bits;
real array rarr(1:2), name(1:fpnames, 1:2);
integer array field ia;
procedure alarm(i);
value i;integer i;
begin
write(out,<:<10>params :>,pno);
goto slut1;
end alarm;
procedure set(boo);
boolean boo;
begin
if type=1 or type=4 then alarm(5);
if type<=3 == initmode then
boo:= type=2 or type=5 ;
paramfct:=fpnames+2; comment no more points may follow;
end set;
procedure set1(boo);
boolean boo;
begin
if type<>2 and type<>3 then alarm(5);
boo:= type=2;
paramfct:=fpnames+2; comment no more names may follow;
end;
for j:=1 step 1 until fpnames do name(j,1):=name(j,2):=real<::>;
for j:=1 step 1 until fpnames do name(j,1):=real (case j of(
<:bossl:> add 105, <:messa:> add 103, <:print:> add 98,
<:jumpt:> add 97, <:warni:> add 110, <:print:>, <:list:>,
<:map:>,<:compr:> add 101,<:disas:> add 115, <:disas:> add 115, <:fastr:> add 101,
<:defau:> add 108));
name(1,2):=real<:ne:>;
name(2,2):=real<:e:>;
name(3,2):=real<:in:>;
name(4,2):=real<:ble:>;
name(5,2):=real<:g:>;
name(9,2):=real<:ss:>;
name(10,2):=real<:emble:>;
name(11,2):=real<:kneh:>;
name(12,2):= real<:gs:>;
name(13,2):=real<:t1:>;
if initmode then
begin
boss_line_no:=fpcount:=0;
sourceno:=1;
bossline:=
genoutput:=printbin:=jumptable:=printing:=listing:=disassemble:=
compress:=fastregs:=disasskneh:=default1:=false;
mess:=warning:=true;
end;
if fpcount=0 then
begin
pno:=1;
if system(4,pno,rarr)=6 shift 12 + 10 then
begin comment name=;
pno:=pno+1;
genoutput:=true;
end;
end else pno:=fpcount;
rep:
for j:=system(4,pno,rarr) while j>=4 shift 12 do
begin
if j<>4 shift 12 + 10 then alarm(5);
for paramfct:=1 step 1 until fpnames do
if name(paramfct,1)=rarr(1) and
name(paramfct,2)=rarr(2) then goto ud; ud:
if system(4,pno+1,rarr)shift(-12)<>8 then
begin
pno:=pno+1;
goto if initmode then rep else fin;
end;
first:=true;
for i:=system(4,increase(pno)+1,rarr)while i shift(-12)=8 do
begin comment .param;
type:=if i extract 12=4 then 1 else if rarr(1)=real<:yes:>
then 2 else if rarr(1)=real<:no:> then 3 else
if rarr(1)=real<:on:> then 5 else
if rarr(1)=real<:off:> then 6 else 4;
\f
case paramfct of
begin
set(bossline);
set(mess);
set1(printbin);
set1(jumptable);
set(warning);
set(printing);
set(listing);
begin comment map.<filename> ;
if type=1 then alarm(5);
paramfct:=fpnames+2; comment no more points may follow;
end map;
set(compress);
set(disassemble);
set1(disasskneh);
set1(fastregs);
set1(default1);
alarm(5);comment not known;
alarm(5); comment no more points might follow;
end case paramfct;
first:=false;
end point loop;
comment terminate param;
case paramfct of
begin
; comment bossline;
; comment mess;
; comment printbin;
; comment jumptable;
; comment warning;
; comment print;
; comment list;
; comment map;
; comment compress;
; comment disassemble;
; comment disasskneh;
; comment fastregs;
; comment default1;
; comment not known;
; comment no more points might follow;
end;
end outer loop;
fin:
if -, initmode then fpcount:=pno;
end examineparams;
\f
boolean procedure opennextsource(z, sourceno);
integer sourceno;
zone z;
begin
integer k, j, count, pno, file, block;
boolean first;
real array field ra;
integer array arr(1:10);
real array rarr(1:2);
procedure alarm;
begin
write(out, <:<10>connect file:>, <<-d>, sourceno, <:<10>:>);
sourceno:=sourceno+1;goto slut;
end;
if sourceno>0 then
begin
nextbossline:=10;
lineno:=1000;
end;
start:
first:=true;
close(z,true);
opennextsource:=true;
pno:=1;
if system(4, pno, rarr)=6 shift 12 + 10 then pno:=pno+1;
count:=k:=0;
for j:=system(4, pno, rarr) while count<>sourceno and(j<>0 or k<>0) do
begin
if sourceno<0 and
system(4, pno-1, rarr)=4 shift 12 + 10 and j=8 shift 12 + 10 and
rarr(1)=real fpfile(1) and rarr(2)=real fpfile(2) then
begin
pno:=pno+1;
count:=-1;
end else
if k=4 shift 12 + 10 and (j shift(-12)=4 or j=0) then
count:=count+1;
k:=j;
pno:=pno+1;
end;
if count<>sourceno or pno<>2 and sourceno=0 then opennextsource:=false else
begin
system(4, pno-2, rarr);
if sourceno>0 then for j:=1, 2 do headname(j):=long rarr(j);
count:=0;
if sourceno<>0 and fpcount<=pno-2 then examineparams(false);
loop:
j:=1;
open(z, 4, string rarr(increase(j)), 0);
if monitor(42, z, j, arr)<>0 then
begin
if sourceno>0 then alarm;
for j:=1 step 1 until 10 do arr(j):=0; arr(1):=1;
if monitor(40,z,j,arr)<>0 then alarm;
goto out1;
end;
if first then
begin
file:=arr(7);
block:=arr(8);
first:=false;
end;
if arr(1)<0 then
begin
ra:=2;
rarr(1):=arr.ra(1);
rarr(2):=arr.ra(2);
end;
if arr(1)=1 shift 23 + 4 then
begin
count:=count+1;
if count=100 then alarm;
close(z, false);
goto loop;
end;
if arr(1)<0 then
begin
j:=arr(1) shift(-12) extract 11;
k:=arr(1) extract 12;
if k>20 or k extract 1=1 or arr(1)=0 or j extract 1=1 or
j>(if k=10 or k=12 then 6 else if k=16 then 4 else if
k=18 then 2 else 0) then alarm;
j:=arr(1)extract 23;
if k=20 then j:=j+(14-20);
close(z, false);
k:=1;
open(z, j, string rarr(increase(k)), 0);
end not bsarea;
k:=arr(1) extract 12;
if k<>10 and k<>16 then setposition(z,file,block);
if sourceno<>0 then sourceno:=sourceno+1;
end;
out1:
end opennextsource;
long procedure s(i, pos);
value i, pos;
integer i, pos;
begin
s:=0;
if pos<48 then bitword1:=logor(bitword1, extend i shift(47-pos))
else bitword2:=logor(bitword2, extend i shift(47+48-pos));
end s;
long procedure s1(i, pos);
value i, pos;
integer i, pos;
begin
s1:=extend i shift(47-pos);
end s1;
procedure outword(l1, l2);
value l1, l2;
long l1, l2;
begin
if pass=2 then
begin
if binmem(kk, 0)<>no_burn or binmem(kk, 1)<>no_burn then
error4(<:overwrite the old contents:>);
binmem(kk, 0):=l1 - l1 extract 16 + l1 extract 2 shift 14 +
l1 shift(-2) extract 14;
binmem(kk, 1):=l2;
print(l1, l2);
end;
kk:=(kk+1)extract 11;
end outword;
long procedure trihex(i);
value i;
integer i;
begin
integer j, k;
long word;
word:=0;
for j:=24 step 8 until 40 do
begin
k:=i extract 4;
i:=i shift (-4);
word:=word + extend(if k>9 then k+97-10 else k+48) shift j;
end;
trihex:=word;
end trihex;
long procedure outhex(i);
value i;
integer i;
begin
integer j, k, n;
long word;
boolean print;
print:=false;
n:=40;
word:=0;
for j:=-20 step 4 until 0 do
begin
k:=i shift j extract 4;
if -,print then print:=i shift(j+4)extract 4>9 or k<>0 or j=0;
if print then
begin
word:=word + extend(if k>9 then k+97-10 else k+48)shift n;
n:=n-8;
end;
end;
outhex:=word;
end outhex;
procedure find_items;
begin
integer pointer, linestart;
procedure pack;
begin
integer j, count, k, constval;
while line(linestart)=32 do linestart:=linestart+1;
charpos(pointer):=linestart;
j:=line(linestart);
linestart:=linestart+1;
ext(pointer, 0):=extend j shift 40;
ext(pointer, 1):=0;
k:=if j>96 then 1 <*letter*> else
if j=60 <* < *> or j=62 <* > *> or j=58 <* : *> then 2 else
if j=43 <* + *> or j=45 <* - *> then 3 else
if j=59 <* ; *> or j=61 <* = *> or j=10 or j=12 <* ff *> or
j=46 <* . *> or j=47 <* / *> or j=44 <* , *> then 4 else
if j>=48 and j<58 then 6 else 7;
if k>=6 then
begin
if k=7 then error1(<:syntax:>, charpos(pointer));
constval:=j-48;
for j:=line(linestart) while j>=48 and j<58 or
j>=97 and j<=102 do
begin
constval:=constval shift 4 +
(if j<58 then j-48 else j+10-97);
if constval>2047 then error1(<:constant too big:>, charpos(pointer));
linestart:=linestart+1;
end;
ext(pointer, 0):=outhex(constval);
a(pointer):=data2+sliceop+binary+constval;
goto ud;
end else
for count:=48 + 32 step -8 until -8 do
begin
j:=line(linestart);
if k=(if j>=48 and j<58 or j>96 then 1 <*letter*> else
if j=61 <* = *> or j=62 <* > *> or
j=60 <* < *> then 2 else
if j=43 <* + *> or j=45 <* - *> then 3 else 0)
then
begin
if count=-8 then
error1(<:name too long:>, charpos(pointer));
ext(pointer, 1-count//48):=ext(pointer, 1-count//48) +
extend j shift(count mod 48);
end else goto ud1;
linestart:=linestart+1;
end;
ud1:
search1(pointer); <*sets the a array *>
ud:
end pack;
linestart:=1;
for pointer:=1 step 1 until 30 do
begin
pack;
if pointer=2 then
begin
if ext(1, 0)=long<:.:> and ext(2, 0)=long<:m:> then goto ud;
end;
if logand(a(pointer), line_end)<>0 then goto ud;
end;
error1(<:too many fields:>, charpos(pointer));
ud:
end find items;
long procedure tab(i);
value i; integer i;
begin
tab:=case i of(
<*ext set bits + test bits*>
long<::=:>, ass + aluass + 3<*aludest*>,
long<::<62><62>:>,aluass + carshift +4<*aludest*>,
long<::=>:>, aluass + carshift + 5<*aludest*>,
long<::<<60>:>, aluass + carshift + 6<*aludest*>,
long<::=<60>:>, aluass + carshift + 7<*aludest*>,
long<:q:>, q + sliceop,
long<:,:>, comma,
long<:<10>:>, line_end,
long<:;:>, line_end,
long<:.:>, extend 0,
long<:::>, car + cdef + 2 shift 5<*carry cntrl*>,
long<:=:>, extend 0,
long<:<60>:>, car + cdef + carshift + 1 shift 5,
long<:>:>, car + cdef + carshift + 0 shift 5,
long<:+:>, s1(0,46) + op + sign,
long<:++:>, s1(0,46) + s1(1,47) + op,
long<:-:>, s1(2,46) + s1(1,47) + op + sign + minus,
long<:--:>, s1(2,46) + op + minus,
long<:ior:>, s1(3,46) + op,
long<:and:>, s1(4,46) + op,
long<:clr:>, s1(5,46) + op + clr,
long<:xor:>, s1(6,46) + op,
long<:equ:>, s1(7,46) + op,
long<:c:>, s(1,43) + carry,
long<:k:>, data2 + sliceop + binary,
long<:bus:>, data1 + 0,
long<:swp:>, data2 + sliceop + 1,
long<:ra:>, data1 + 7,
long<:zd:>, data1 + data2 + sliceop + cdef + radef +
6 shift 7 + 1 shift 5 + 2,
long<:zdx:>, data1 + data2 + sliceop + cdef + radef +
2 shift 7 + 1 shift 5 + 2,
long<:zdw:>, data1 + data2 + sliceop + cdef + radef +
0 shift 7 + 1 shift 5 + 2,
long<:zdc:>, data1 + data2 + sliceop + cdef + radef +
4 shift 7 + 1 shift 5 + 2,
long<:zd0:>, data1 + data2 + sliceop + cdef + radef + implc +
4 shift 7 + 1 shift 5 + 0 shift 3 + 2,
long<:zd1:>, data1 + data2 + sliceop + cdef + radef + implc +
4 shift 7 + 1 shift 5 + 1 shift 3 + 2,
long<:zd2:>, data1 + data2 + sliceop + cdef + radef + implc +
4 shift 7 + 1 shift 5 + 2 shift 3 + 2,
long<:zd3:>, data1 + data2 + sliceop + cdef + radef + implc +
4 shift 7 + 1 shift 5 + 3 shift 3 + 2,
long<:zm:>, data1 + cdef + radef +
6 shift 7 + 0 shift 5 + 2,
long<:zmx:>, data1 + cdef + radef +
2 shift 7 + 0 shift 5 + 2,
long<:zmw:>, data1 + cdef + radef + 0 shift 7 + 0 shift 5 + 2,
long<:zmc:>, data1 + cdef + radef + 4 shift 7 + 0 shift 5 + 2,
long<:zm0:>, data1 + cdef + radef + implc +
4 shift 7 + 0 shift 5 + 0 shift 3 + 2,
long<:zm1:>, data1 + cdef + radef + implc +
4 shift 7 + 0 shift 5 + 1 shift 3 + 2,
long<:zm2:>, data1 + cdef + radef + implc +
4 shift 7 + 0 shift 5 + 2 shift 3 + 2,
long<:zm3:>, data1 + cdef + radef + implc +
4 shift 7 + 0 shift 5 + 3 shift 3 + 2,
long<:zo:>, data1 + cdef + radef + 6 shift 7 + 2 shift 5 + 2,
long<:zox:>, data1 + cdef + radef + 2 shift 7 + 2 shift 5 + 2,
long<:zow:>, data1 + cdef + radef + 0 shift 7 + 2 shift 5 + 2,
long<:zoc:>, data1 + cdef + radef + 4 shift 7 + 2 shift 5 + 2,
long<:zo0:>, data1 + cdef + radef + implc +
4 shift 7 + 2 shift 5 + 0 shift 3 + 2,
long<:zo1:>, data1 + cdef + radef + implc +
4 shift 7 + 2 shift 5 + 1 shift 3 + 2,
long<:zo2:>, data1 + cdef + radef + implc +
4 shift 7 + 2 shift 5 + 2 shift 3 + 2,
long<:zo3:>, data1 + cdef + radef + implc +
4 shift 7 + 2 shift 5 + 3 shift 3 + 2,
long<:zz:>, data1 + cdef + radef + 6 shift 7 + 3 shift 5 + 2,
long<:zzx:>, data1 + cdef + radef + 2 shift 7 + 3 shift 5 + 2,
long<:zzw:>, data1 + cdef + radef + 0 shift 7 + 3 shift 5 + 2,
long<:zzc:>, data1 + cdef + radef + 4 shift 7 + 3 shift 5 + 2,
long<:zz0:>, data1 + cdef + radef + implc +
4 shift 7 + 3 shift 5 + 0 shift 3 + 2,
long<:zz1:>, data1 + cdef + radef + implc +
4 shift 7 + 3 shift 5 + 1 shift 3 + 2,
long<:zz2:>, data1 + cdef + radef + implc +
4 shift 7 + 3 shift 5 + 2 shift 3 + 2,
long<:zz3:>, data1 + cdef + radef + implc +
4 shift 7 + 3 shift 5 + 3 shift 3 + 2,
long<:rd:>, data1 + data2 + sliceop + cdef + radef +
7 shift 7 + 1 shift 5 + 2,
long<:rdx:>, data1 + data2 + sliceop + cdef + radef +
3 shift 7 + 1 shift 5 + 2,
long<:rdw:>, data1 + data2 + sliceop + cdef + radef +
1 shift 7 + 1 shift 5 + 2,
long<:rdc:>, data1 + data2 + sliceop + cdef + radef +
5 shift 7 + 1 shift 5 + 2,
long<:rd0:>, data1 + data2 + sliceop + cdef + radef + implc +
5 shift 7 + 1 shift 5 + 0 shift 3 + 2,
long<:rd1:>, data1 + data2 + sliceop + cdef + radef + implc +
5 shift 7 + 1 shift 5 + 1 shift 3 + 2,
long<:rd2:>, data1 + data2 + sliceop + cdef + radef + implc +
5 shift 7 + 1 shift 5 + 2 shift 3 + 2,
long<:rd3:>, data1 + data2 + sliceop + cdef + radef + implc +
5 shift 7 + 1 shift 5 + 3 shift 3 + 2,
long<:rm:>, data1 + cdef + radef +
7 shift 7 + 0 shift 5 + 2,
long<:rmx:>, data1 + cdef + radef +
3 shift 7 + 0 shift 5 + 2,
long<:rmw:>, data1 + cdef + radef + 1 shift 7 + 0 shift 5 + 2,
long<:rmc:>, data1 + cdef + radef + 5 shift 7 + 0 shift 5 + 2,
long<:rm0:>, data1 + cdef + radef + implc +
5 shift 7 + 0 shift 5 + 0 shift 3 + 2,
long<:rm1:>, data1 + cdef + radef + implc +
5 shift 7 + 0 shift 5 + 1 shift 3 + 2,
long<:rm2:>, data1 + cdef + radef + implc +
5 shift 7 + 0 shift 5 + 2 shift 3 + 2,
long<:rm3:>, data1 + cdef + radef + implc +
5 shift 7 + 0 shift 5 + 3 shift 3 + 2,
long<:ro:>, data1 + cdef + radef + 7 shift 7 + 2 shift 5 + 2,
long<:rox:>, data1 + cdef + radef + 3 shift 7 + 2 shift 5 + 2,
long<:row:>, data1 + cdef + radef + 1 shift 7 + 2 shift 5 + 2,
long<:roc:>, data1 + cdef + radef + 5 shift 7 + 2 shift 5 + 2,
long<:ro0:>, data1 + cdef + radef + implc +
5 shift 7 + 2 shift 5 + 0 shift 3 + 2,
long<:ro1:>, data1 + cdef + radef + implc +
5 shift 7 + 2 shift 5 + 1 shift 3 + 2,
long<:ro2:>, data1 + cdef + radef + implc +
5 shift 7 + 2 shift 5 + 2 shift 3 + 2,
long<:ro3:>, data1 + cdef + radef + implc +
5 shift 7 + 2 shift 5 + 3 shift 3 + 2,
long<:rz:>, data1 + cdef + radef + 7 shift 7 + 3 shift 5 + 2,
long<:rzx:>, data1 + cdef + radef + 3 shift 7 + 3 shift 5 + 2,
long<:rzw:>, data1 + cdef + radef + 1 shift 7 + 3 shift 5 + 2,
long<:rzc:>, data1 + cdef + radef + 5 shift 7 + 3 shift 5 + 2,
long<:rz0:>, data1 + cdef + radef + implc +
5 shift 7 + 3 shift 5 + 0 shift 3 + 2,
long<:rz1:>, data1 + cdef + radef + implc +
5 shift 7 + 3 shift 5 + 1 shift 3 + 2,
long<:rz2:>, data1 + cdef + radef + implc +
5 shift 7 + 3 shift 5 + 2 shift 3 + 2,
long<:rz3:>, data1 + cdef + radef + implc +
5 shift 7 + 3 shift 5 + 3 shift 3 + 2,
long<:ba:>, data1 + 3,
long<:bf:>, data1 + bfdef + 0 shift 7 + 1,
long<:bfm:>, data1 + bfdef + 1 shift 7 + 1,
long<:bd:>, data1 + data2 + sliceop + 4,
long<:cd:>, data1 + data2 + sliceop + 6,
long<:led:>, data1 + 5,
long<:ccr:>, data2 + sliceop + 7,
long<:int:>, data2 + sliceop + 0,
long<:const:>, data2 + sliceop + 3,
long<:ir:>, s(1,45) + ir,
long<:rc:>, s(1,46) + rc,
long<:h:>, s(1,26) + dofunc,
long<:w:>, s(1,26) + s(1,40) + dofunc,
long<:b:>, s(1,26) + s(1,41) + dofunc,
long<:s:>, s(1,42) + dofunc,
long<:r:>, s(1,26) + s(1,48) + dofunc,
long<:i:>, s(1,26) + s(1,39) + dofunc,
long<:u:>, s(1,44) + dofunc,
long<:jz:>, s(0,3) + jump,
long<:cjs:>, s(1,3) + jump + cond_allowed,
long<:jmap:>, s(2,3) + jump + map,
long<:cjp:>, s(3,3) + jump + cond_allowed,
long<:push:>, s(4,3) + jump + cond_allowed,
long<:jsrp:>, s(5,3) + jump + cond_allowed,
long<:cjv:>, s(6,3) + jump + vect,
long<:jrp:>, s(7,3) + jump + cond_allowed,
long<:rfct:>, s(8,3) + jump + cond_allowed,
long<:rpct:>, s(9,3) + jump + cond_allowed,
long<:crtn:>, s(10,3) + jump + cond_allowed,
long<:cjpp:>, s(11,3) + jump + cond_allowed,
long<:ldct:>, s(12,3) + jump,
long<:loop:>, s(13,3) + jump + cond_allowed,
long<:cont:>, s(14,3) + jump,
long<:twb:>, s(15,3) + jump + cond_allowed,
long<:b0:>, s(0,7) + s(1,47) + cond,
long<:i10:>, s(1,7) + s(1,47) + cond,
long<:st2:>, s(2,7) + s(1,47) + cond,
long<:st3:>, s(3,7) + s(1,47) + cond,
long<:st4:>, s(4,7) + s(1,47) + cond,
long<:st5:>, s(5,7) + s(1,47) + cond,
long<:c7:>, s(6,7) + s(1,47) + cond,
long<:st7:>, s(7,7) + s(1,47) + cond,
long<:zro:>, s(8,7) + s(1,47) + cond,
long<:ovf:>, s(9,7) + s(1,47) + cond,
long<:pty:>, s(10,7) + s(1,47) + cond,
long<:acy:>, s(11,7) + s(1,47) + cond,
long<:b15:>, s(12,7) + s(1,47) + cond,
long<:cry:>, s(13,7) + s(1,47) + cond,
long<:cr:>, s(14,7) + s(1,47) + cond,
long<:b1:>, s(15,7) + s(1,47) + cond,
long<:not:>, s(1,38) + invert,
long<::>);
end tab;
integer procedure search1(pointer);
value pointer;
integer pointer;
begin
integer i;
long word1, word2, l1;
k:=max_symb;
word1:=ext(pointer,0);
word2:=ext(pointer,1);
i:=(((((word1 mod k) shift 24) +
(word2 shift (-24))) mod k) shift 24 + word2) mod k;
while symb(i, 0) <> 0 do
begin
if symb(i, 0) = word1 then
begin
if symb(i, 1) = word2 then
begin
l1:=symb(i, 3);
bitword1:=logor(bitword1,
logand(l1, -s1(1,7)) + logand(l1, s1(1,7)-1)shift(-1));
if l1 extract 1 = 1 then bitword2:= extend 1 shift 47;
a(pointer):=symb(i, 2) + (if word1 = long<:k:> then kk else 0);
goto found;
end;
end;
i:=(i + 1) mod k;
end;
entr_no:=entr_no + 1;
if entr_no > max_symb - 1 then
begin
write(out, <:symbol overflow:>,entr_no,max_symb);
goto slut;
end;
symb(i, 0):=word1;
symb(i, 1):=word2;
a(pointer):=symb(i, 2):=if pass=1 then name else name + undef;
found:
if a(pointer) = name and pass = 2 then
a(pointer):=name + undef;
search1:=i;
end search1;
procedure copy(from, to);
value from, to;
integer from, to;
begin
integer i;
for i:=from step 1 until to do write(out, false add line(i), 1);
end copy;
integer procedure outf1(i, pos);
value i, pos;
integer i, pos;
begin
outf1:=if i=0 then write(out, false add 32, pos) else
outf(ext(i, 0), if pos>6 then 6 else pos) +
outf(ext(i, 1), pos-6);
end outf1;
integer procedure outf(word, pos);
value word, pos;
integer pos;
long word;
begin
integer i;
i:=write(out, string word shift(-8) shift 8, string word shift 40);
outf:=i+write(out, false add 32, pos-i);
end outf;
procedure print_head;
begin
own boolean notfirst;
own real date, time;
real r;
integer j;
integer field fi;
if -, notfirst then
begin
notfirst:=true;
systime(1, 0.0, r);
date:=systime(4, r, time);
end;
line_no:=2;
page_no:=page_no+1;
write(out, <:!<12><10>!rc35mass:>, false add 32, 5);
j:=0;
for fi:=2 step 2 until 8 do
j:=j+write(out, string(extend headname.fi)shift 24);
write(out, false add 32, 15-j,
<<zd dd dd>, date, <: :>, time, false add 32, 10,
<:page:>, <<-ddd>, page_no, <:<10>!<10>:>);
end print head;
procedure prep_line(n);
value n;
integer n;
begin
line_no:=line_no + n;
if line_no > 45 then
begin
print_head;
line_no:=line_no + n;
end;
end prep line;
procedure prep_line1(n);
value n;
integer n;
begin
line_no:=line_no + n;
if line_no > 45 then
begin
print_head;
line_no:=line_no + n + 5;
write(out,<:!:>,
<:lsb: 3 7 11 15 18 21 22 25 26 28 31 34 37 38 39 40 41 42 43 44:>,
<: 45 46 47 48 59 promno: 4 5 4 3 2 0 0 1<10>!:>,
<:addr cnd a b fnc op eh wrg bs bd -i w -b -s -u:>,
<: -rld -r 0 0 7 3 1 1 6 6<10>!:>,
<: nxt sld cin cld not -uc :>,
<:-ir -ce nmar 3 5 4 2 2 0 1<10>!:>,
<: :>,
<: 6 4 3 9 6 2 1<10>!<10>:>);
end;
end prep line1;
procedure prep_line2(n);
value n;
integer n;
begin
line_no:=line_no + n;
if line_no > 45 then
begin
print_head;
line_no:=line_no + n + 2;
write(out,
<:!addr _ _ _0 _ _1 _ _2 _ _3 _ _ 4 _ _5 _ _6 _ _7 _ _ 8 _ _9 _ _a _ _b _ _ c _ _d _ _e _ _f<10>!<10>:>);
end;
end prep_line2;
procedure format;
begin
integer i, j;
if -,compress then
begin
prep_line(1);
outline_no(true, true);
write(out, <: :>, string trihex(bitword2 shift (-47+11)extract 11), <:!:>);
j:=0;
end else j:=1000;
j:=j + write(out, false add 32, 3,
if bitword1 shift (-47+45) extract 1 = 0 then <:ir:=:> else <::>,
if bitword1 shift (-47+46) extract 1 = 0 then <:rc:=:> else <::>,
if bitword1 shift (-47+28) extract 2 = 3 and
bitword1 shift (-47+43) extract 1 = 0 then <:c:=:> else <::>) +
outf1(fbdest, 0) +
write(out, if fbdest=0 then <::> else <::=:>) +
outf1(fbsource, 0);
j:=j+write(out, false add 32, 13-j, if fbsource=0 then <::> else <:,:>);
j:=j+write(out, false add 32, 14-j);
j:=j+outf1(fsldest, 0) +
write(out, case bitword1 shift(-47+18) extract 3 + 1 of
(<::=:>,<::>,<::=:>,<::=:>,<::<62>>:>,
<::=>:>,<::<<60>:>,<::=<60>:>));
j:=j+write(out, false add 32, 18-j) +
write(out,
if bitword1 shift (-47+43) extract 1 = 0 then (
case bitword1 shift (-47+28) extract 2 + 1 of (
<:c>:>,<:c<60>:>,<:c::>,<::>)) else <::>) +
outf1(fslop1, 0) +
write(out, if if fslop=0 then true else ext(fslop, 0) shift(-24)extract 8=0 then <::> else <: :>) +
outf1(fslop, 0) +
write(out, if if fslop=0 then true else ext(fslop, 0) shift(-24)extract 8=0 then <::> else <: :>) +
outf1(fslop2, 0);
j:=j+write(out, false add 32, 28-j, <:,:>);
if bitword1 shift (-47+26) extract 1 = 0 then
j:=j + write(out, <:h :>);
if bitword1 shift(-47+34)extract 3<>2 and
bitword1 shift(-47+37)extract 3<>2 and
bitword1 shift(-47+40)extract 1=1 then
j:=j+write(out, <:w :>);
if bitword1 shift(-47+41)extract 1=0 then
j:=j+write(out, <:b :>);
if bitword2 shift(-47+0)extract 1=0 then
j:=j+write(out, <:r :>);
if bitword1 shift(-47+39)extract 1=0 then
j:=j+write(out, <:i :>);
if bitword1 shift(-47+44) extract 1=0 then
j:=j+write(out, <:u :>);
if bitword1 shift(-47+42)extract 1=0 then
j:=j+write(out, <:s:>);
j:=j+write(out, false add 32, 36-j, <:,:>);
j:=j + write(out,
case bitword1 shift(-47+3) extract 4 + 1 of (
<:jz :>,<:cjs :>,<:jmap :>,<:cjp :>,
<:push :>,<:jsrp :>,<:cjv :>,<:jrp :>,
<:rfct :>,<:rpct :>,<:crtn :>,<:cjpp :>,
<:ldct :>,<:loop :>,<::>,<:twb :>),
(if bitword1 shift (-47+38) extract 1 = 1 then
<:not :> else <::>)) +
outf1(fcond, 0) + write(out, if fcond<>0 then <: :> else <::>);
p:=expr_pointer;
while -,f(line_end) do
begin
j:=j+outf1(p, 0);
advance(1);
end;
write(out, false add 32, if compress then 1030-j else 58-j);
i:=charpos(p);
if line(i)<>59 <* ; *> then write(out, <:;:>);
copy(i, linelength);
end format;
procedure disass;
begin
boolean const;
long t1, top1, top2, t2;
integer i;
long procedure cheat;
begin
cheat:=0;
const:=true;
end cheat;
long procedure bus(dest);
value dest; boolean dest;
begin
long t;
integer i;
t:=long (case bitword1 shift (
if dest then -47+37 else -47+34) extract 3 +
(if dest then 1 else 9) of (
<::>,<:bf:>,<:rd:>,<:ba:>,
<:bd:>,<:led:>,<:cd:>,<:ra:>,
<:int:>, <:swp:>, <:rd:>, string( ( if symb_name<>0 then symb_name else
outhex(bitword2 shift(-47+11) extract 11) ) + cheat),
<:bd:>,<::>,<:cd:>,<:ccr:>));
if t = long<:rd:> then
begin
t:=long(case bitword1 shift (-47+31) extract 3 + 1 of (
<:zdw:>, <:rdw:>, <:zdx:>, <:rdx:>,
<:zdc:>, <:rdc:>, <:zd:>, <:rd:>));
if dest then
t:=t - long<: d:>+long(
case bitword1 shift (-47+28) extract 2 + 1 of (
<: m:>,<: d:>,<: o:>,<: z:>));
if t shift (-24) extract 8 =
long <:c:> shift (-40) then
t:=t - long <:c:> shift (-16) +
extend 48 add (bitword2 shift (-47+11) extract 2) shift 24;
end rd;
if t= long <:bf:> and
bitword1 shift (-47+31) extract 1 = 1 then
t:=long<:bfm:>;
bus:=t;
end bus;
long procedure slice(n);
value n; integer n;
begin
slice:=long (case n+1 of(
<:w0:>,<:w1:>,<:w2:>,<:w3:>,<:w4:>,<:w5:>,<:w6:>,<:w7:>,
<:w8:>,<:w9:>,<:w10:>,<:w11:>,<:w12:>,<:w13:>,<:w14:>,<:w15:>));
end slice;
for i:=1 step 1 until 9 do ext(i, 1):=0;
const:=false;
ext(1, 0):=bus(true);
fbdest:=if ext(1,0)=0 then 0 else 1;
t1:=ext(2, 0):=bus(false);
fbsource:=if ext(2, 0)<>0 then 2 else 0;
if ext(2, 0) = 0 <* alu *> and
bitword1 shift (-47+18) extract 3 = 2 then
begin
ext(2, 0):=slice( bitword1 shift (-47+11) extract 4);
fbsource:=2;
end;
fsldest:= 3; i:= bitword1 shift (-47+18) extract 3;
ext(3,0):= long(if i=0 then <:q:> else
if i=1 then <::> else
string slice(bitword1 shift (-47+15) extract 4));
i:=bitword1 shift (-47+25) extract 3; <* alu source *>
top2:=long(
if i = 7 then <::> else
if i = 6 or i = 0 or i = 2 then <:q:> else
if i >= 4 then string slice(
bitword1 shift (-47+11) extract 4) else
string slice(
bitword1 shift (-47+15) extract 4));
top1:=if i >= 5 then t1 else
if i >= 2 then extend 0 else
slice(bitword1 shift (-47+11) extract 4);
if bitword1 shift(-47+45)extract 1<>0 <* ir:= *> and
bitword1 shift(-47+46)extract 1<>0 <* rc:= *> and
(bitword1 shift(-47+43)extract 1<>0 or
bitword1 shift(-47+28)extract 2<>3) <* c:= *> and
i>=5 and fbdest=0 then fbsource:=0;
i:=bitword1 shift (-47+21) extract 3; <* alu function *>
if i = 6 or i = 1 then
begin t2:=top1; top1:=top2; top2:=t2
end;
if bitword1 shift(-47+34)extract 3=2 or
bitword1 shift(-47+37)extract 3=2 then
bitword1:=logand(bitword1, -s1(1,40)-1); <* remove w if rd *>
t2:=long(case i + 1 of (
if bitword1 shift (-47+22) extract 1 = 0 then ( if top1=0 or top2=0 then <::> else <:+:> ) else <:++:>,
if bitword1 shift (-47+22) extract 1 = 0 then <:--:> else <:-:>,
if bitword1 shift (-47+22) extract 1 = 0 then <:--:> else <:-:>,
<:ior:>,
<:and:>,<:clr:>,<:xor:>,<:equ:>));
if t2 = long <:and:> and
(top1 = 0 or top2 = 0) then
t2:=top1:=top2:=0;
ext(4, 0):=top1;
fslop1:=if top1 = 0 then 0 else 4;
ext(5, 0):=t2;
fslop:=if t2 = 0 then 0 else 5;
ext(6, 0):=top2;
fslop2:=if top2 = 0 then 0 else 6;
i:=bitword1 shift (-47+3) extract 4;
fcond:=0;
if bitword1 shift (-47+47) extract 1 = 0 then
begin comment condition;
fcond:=7;
ext(7,0):=long (case
bitword1 shift (-47+7) extract 4 + 1 of (
<:b0:>,<:i10:>,<:st2:>,<:st3:>,<:st4:>,<:st5:>,
<:c7:>,<:st7:>,<:zro:>,<:ovf:>,<:pty:>,<:acy:>,
<:b15:>,<:cry:>,<:cr:>,<:b1:>))
end else
if i = 2 <* jmap *> or
i = 6 <* cjv *> then
begin
fcond:=7;
ext(7, 0):=outhex(
bitword1 shift (-47+7) extract 4);
end;
expr_pointer:=8;
ext(8, 0):=if symb_name<>0 then symb_name else outhex(
bitword2 shift (-47+11) extract 11);
if const or bitword2 shift(-47+11)extract 11=0 then expr_pointer:=9;
a(8):=0; a(9):=line_end;
charpos(9):=9; line(9):=10;
line_length:=9;
end disass;
procedure disassknehproc;
begin comment disassemble kneh-type micro programs;
integer i,j,k,p,p1;
boolean procedure readhex(pos, val);
value pos;
integer pos, val;
begin
integer j, k, m;
m:=0;
for j:=pos step 1 until pos+3 do
begin
k:=line(j);
if k>=48 and k<=57 then k:=k-48 else
if k>=97 and k<=97+15-10 then k:=k+10-97 else
begin
readhex:=false;
goto ud;
end;
m:=m shift 4 + k;
end;
readhex:=true;
val:=m;
ud:
end readhex;
om:
p:=p1:=i:=0;
j:=0;
while j<>10 and j<>25 do
begin
readchar(zin,j);
i:=i+1;
line(i):=j;
if j=12 <* ff *> then
begin
line(i):=long<:.:> shift(-40);
i:=i+1;
line(i):=long<:p:> shift(-40);
end;
if p1=0 and line(i)=59 then p1:=i;
if p=0 and line(i)=59 then p:=i <* ; *> else
if p=0 and j<>32 then p:=-1;
end;
if j=25 then goto prbslut;
if -,readhex(5, kk) then
no_instr:
begin
if p<=0 then copy(1,i) else
begin
write(out,<:;:>);
copy(p,i);
end;
goto om;
end;
if kk>=2048 then
begin <* addr *>
if -,readhex(20, j) then goto no_instr;
if -,readhex(25, k) then goto no_instr;
for k:=38 step 1 until 42 do line(k):=
( case k-37 of (<:.:>, <:a:>, <:d:>, <:d:>, <:r:>) )shift(-40)extract 8;
copy(30, i);
goto om;
end;
if -, readhex(10, k) then goto no_instr;
bitword1:=extend k shift 32;
if -,readhex(15, k) then goto no_instr;
bitword1:=bitword1 + extend k shift 16;
if -,readhex(20, k) then goto no_instr;
bitword1:=bitword1 + k extract 12 shift(-2);
bitword2:=extend ( k extract 2 shift(-1) ) shift 47;
if -,readhex(25, k) then goto no_instr;
bitword1:=bitword1 + extend( k shift(-10) ) shift 10;
binmem(kk, 0):=bitword1 - bitword1 extract 16 +
bitword1 extract 2 shift 14 + bitword1 shift(-2) extract 14;
binmem(kk, 1):=bitword2:=bitword2 + extend( k extract 10 ) shift 36;
if line(30)>=64 then
begin <* label *>
for j:=30 step 1 until 35 do
if line(j)>=48 and line(j)<>58 then write(out, false add line(j), 1) else
j:=41;
write(out, <::<10>:>);
end label ;
symb_name:=0;
j:=0;
for k:=1 step 1 until i do
if line(k)=long<:,:> shift(-40) then
begin comment comma ;
j:=j+1;
if j=11 then
begin comment the address coloumn found;
k:=k+1;
while line(k)=32 do k:=k+1;
if line(k)>64 then
begin comment name ;
for j:=40 step -8 until 0 do
begin
if line(k)>=48 then
symb_name:=symb_name + extend line(k) shift j else
j:=0;
k:=k+1;
end for j ;
end name ;
k:=i;
end j=11 ;
end comma;
disass;
if p1<>0 then
begin <*copy comment*>
charpos(9):=p1;
linelength:=i;
end;
if bitword1 shift (-47+21) extract 3 = 7 and
bitword1 shift (-47+34) extract 3 = 0 then
begin
write(out,<:nop:>);
if p1<=0 then write(out,<:<10>:>) else copy(p1,i);
end else format;
goto om;
end disasspromtape;
procedure format1(n);
value n;
integer n;
begin
integer i, j;
<* n meaning
1 .loc / .loc expression
2 .k= expression
3 .list on/off
4 .print on/off
5 .instruction / .instruction expression
6 .regname= expression
7 constname= expression
8 <empty line>
9 .m
10 .p
11 constname:
12 .mapk expression
13 .addr expression / .addr expression , repetition *>
if pass=1 then goto next1;
if -,f(line_end) and n<>9 then error1(<:new line missing:>, 1);
if -,listing and (n<>9 or -,mess) then goto ud;
if -,compress then
begin
prep_line(1);
if bossline then write(out, <:!:>, <<ddddd>, bossline_no, <:! :>);
j:=-4;
end else j:=1000;
if n=9 <* .m *> then
begin comment copy the line stricly as it has been written;
copy(char_pos(1), linelength);
goto ud;
end;
p:=1;
if n=11 or n=7 or n=6 then j:=j+write(out, false add 32, 6-j);
while -,f(line_end) do
begin
j:=j+outf1(p, 0);
if p=1 and n=7 or p=2 and n=6 then
j:=j+write(out, false add 32, 16-j) <* spaces before = *> else
if p>1 then j:=j+write(out, <: :>);
advance(1);
end;
if instr>=0 and n=5 <* .instruction *> and -,compress then
j:=j + write(out, <:! :>, string trihex(instr),
<: :>, string trihex(map_table(instr)),
<: :>, string trihex(map_table(instr+256)), <:!:>);
if instr=-1 and n=5 <* .instruction *> and -,compress then
j:=j + write(out, <:! default :>, string trihex(map_table(1024)),
<: :>, string trihex(map_table(1025)), <:!:>);
if n=13 <* .addr *> and -,compress then
j:=j + write(out, false add 32, 25-j, <:! :>, string trihex(instr),
<: :>, string trihex(map_table(instr)), <: :>,
string trihex(reps), <:!:>);
i:=char_pos(p);
write(out, false add 32,
if if i<line_length then line(i+1)=59 <* ; *> else false then
9-j else if compress then 1030-j else 64-j);
if line(i)<>59 <* ; *> then write(out, <:;:>);
copy(i, linelength);
if n=10 then line_no:=1000;
ud:
goto next;
end format1;
procedure print(bitword1, bitword2);
value bitword1, bitword2;
long bitword1, bitword2;
if printing then
begin
integer i, j;
prep_line(1);
outline_no(true, true);
write(out, <: :>);
for i:=3 step 4 until 63 do
begin
if i mod 16=3 then write(out, <: :>);
j:=(if i>47 then bitword2 else bitword1)shift(-47+i mod 48)extract 4;
write(out, false add( if j>9 then j+97-10 else j+48), 1);
end;
if bitword1=no_burn and bitword2=no_burn then goto ud;
write(out, <: :>,
case bitword1 shift(-47+21)extract 3 + 1 of(
<:add:>, <:bus:>, <:sub:>, <:ior:>,
<:and:>, <:clr:>, <:xor:>, <:equ:>),
<<d>, bitword1 shift(-47+22)extract 1, <: :>,
case bitword1 shift(-47+25)extract 3 + 1 of(
<:aq :>, <:ab :>, <:oq :>, <:ob :>,
<:oa :>, <:da :>, <:dq :>, <:d0 :>),
case bitword1 shift(-47+18) extract 3 + 1 of(
<:fq :>, <: :>, <:ar :>, <:fr :>,
<:rq :>, <:rn :>, <:lq :>, <:ln :>),
case bitword1 shift(-47+28)extract 2 + 1 of(
<:rm/c> :>, <:rd/c< :>, <:ro/c= :>, <:rz/c:=:>),
<< dd>, bitword1 shift(-47+11)extract 4,
bitword1 shift(-47+15)extract 4, <: :>,
case bitword1 shift(-47+34)extract 3 + 1 of(
<:int :>, <:swp :>, <:rd :>, <:c :>,
<:bd :>, <:alu :>, <:cd :>, <:ccr :>),
case bitword1 shift(-47+37)extract 3 + 1 of(
<: :>, <:bf :>, <:rd :>, <:ba :>,
<:bd :>, <:led :>, <:cd :>, <:ra :>),
case bitword1 shift(-47+31)extract 3 + 1 of(
<:w :>, <:bw :>, <:x :>, <:bx :>,
<:w0 :>, <:b0 :>, <:rg :>, <:rd :>),
case bitword1 shift(-47+3)extract 4 + 1 of(
<:jz :>, <:cjs :>, <:jmap:>, <:cjp :>,
<:push:>, <:jsrp:>, <:cjv :>, <:jrp :>,
<:rfct:>, <:rpct:>, <:crtn:>, <:cjpp:>,
<:ldct:>, <:loop:>, <: :>, <:twb :>),
if bitword1 shift(-47+38)extract 1=1 then <: not :> else <: :>,
false add ( if bitword1 shift(-47+7)extract 4 > 9 then 97-10
else 48) add (bitword1 shift(-47+7)extract 4), 1, <:/:>,
case bitword1 shift(-47+7) extract 4 + 1 of(
<:b0 :>, <:i10 :>, <:st2 :>, <:st3 :>,
<:st4 :>, <:st5 :>, <:c7 :>, <:st7 :>,
<:zro :>, <:ovf :>, <:pty :>, <:acy :>,
<:b15 :>, <:cry :>, <:cr :>, <:b1 :>));
for i:=3 step 4 until 11 do
begin
j:=bitword2 shift(-47+i)extract (if i=3 then 3 else 4);
write(out, false add(if j>9 then j+97-10 else j+48), 1);
end;
write(out, <: :>);
j:=0;
if bitword1 shift(-47+26)extract 1=0 then j:=j+write(out, <:h :>);
for i:=39 step 1 until 48 do
if(if i>47 then bitword2 else bitword1)shift(-47+i mod 48)
extract 1=(if i=40 or i>=50 then 1 else 0) then
j:=j+write(out, case i-38 of(
<:supp :>, <:wait :>, <:byte :>, <:stat :>, <:updc :>,
<:sb :>, <:ir :>, <:rc :>, <:ccen :>, <:read :>));
ud:
write(out, <:<10>:>);
end print;
integer procedure read_expr;
begin
integer sum, i, result;
result:=-1;
sum:=0;
om:
i:=1;
if f(sign) and n(name+binary) then
begin
if f(minus) then i:=-1;
advance(1);
end;
if f(binary+name) then
begin
sum:=sum+a(p)extract 11 * i;
if result=-1 then result:=0;
if -,f(data2) then
begin
result:=-2;
if pass=2 then
error3(p, if f(r) then <: is a register name:> else
<: is undefined:>);
end;
advance(1);
if f(sign) and n(binary+name) then goto om;
end;
read_expr:= if result<0 then result else sum extract 11;
<* result = -1 : no expression
result = -2 : undefined expression *>
end read expr;
procedure swopop;
begin
long i;
swopcount:=1-swopcount;
i:=op1; op1:=op2; op2:=i;
end swopop;
boolean procedure f(t);
long t;
begin
p1:=p;
f:=logand(a(p1), t)<>0;
end f;
boolean procedure n(t);
long t;
begin
p1:=p1+1;
n:=logand(a(p1), t)<>0;
end n;
procedure advance(n);
integer n;
begin
p:=p+n;
end advance;
procedure setconst(length, n);
value length, n;
integer length, n;
begin
if (n-bitword2 shift(-47+11))extract(
if length<constfieldlength then length else constfieldlength)<>0 then
error(<:constant conflicts:>);
s(n, 59);
if constfieldlength<length then constfieldlength:=length;
end setconst;
procedure set_bus(a, pos);
value a, pos;
long a;
integer pos; <* source/dest bitposition *>
begin
integer i;
if logand(a, binary)<>0 then
begin
setconst(11, a extract 11);
a:=data2+sliceop+3; <* micro word to bus *>
end;
if pos<>0 then
begin
i:=bitword1 shift(-47+pos)extract 3;
if pos=37 and -,expl_bdest or pos=34 and -,expl_bsource then
s(a extract 3, pos) else
if i<>a extract 3 then error(<:bus used twice:>);
end;
if logand(a, implc)<>0 then setconst(2, a shift(-3)extract 2);
if logand(a, cdef)<>0 then
begin
i:=a shift(-5)extract 2;
if bcdef then
begin
if i<>bitword1 shift(-47+28)extract 2 then
error(<:carry field trouble:>);
end;
bcdef:=true;
s(i, 28);
end cdef;
if logand(radef+bfdef, a)<>0 then
begin
i:=a shift(-7)extract 3;
if (i-bitword1 shift(-47+31))extract(
if logand(radef, a)=0 and ra_def_length<>0 then 1 else
ra_def_length) <> 0 then
error(<:wreg contr field trouble:>);
if ra_def_length<>3 then ra_def_length:=if logand(radef, a)
<>0 then 3 else 1;
s(i, 31);
end;
end set bus;
procedure set_bus_source(a);
value a;
long a;
begin
a:=logand(a, -1-cdef); <* dont define the carry field *>
setbus(a, 34);
expl_bsource:=true;
end set bus source;
procedure set_bus_dest(a);
value a;
long a;
begin
setbus(a, 37);
expl_bdest:=true;
end set bus dest;
procedure outline_no(input, outaddr);
value input, outaddr;
boolean input, outaddr;
begin
if bossline then
begin
if input then write(out, <:!:>, <<ddddd>, bossline_no, <:! :>) else
write(out, false add 32, 8);
end;
if outaddr then write(out, <:! :>, string trihex(kk)) else
write(out, false add 32, 6);
end outline_no;
procedure error1(text, pos);
value pos;
integer pos;
string text;
begin
if pass=1 then goto next1;
prep_line(2);
errors:=errors+1;
outline_no(false, true);
write(out, <: **** :>, text, <:<10>:>);
outline_no(true, false);
copy(1,pos-1);
write(out, <:**:>);
copy(pos, linelength);
goto next;
end error1;
procedure error(text);
string text;
begin
integer i;
if pass=1 then
begin
kk:=kk+1;
goto next1;
end;
prep_line(2);
errors:=errors+1;
outline_no(false, true);
write(out, <: **** :>, text, <:<10>:>);
outline_no(true, false);
copy(1, charpos(p)-1);
write(out, <:**:>);
copy(charpos(p), linelength);
outword(no_burn, no_burn);
goto next;
end error;
procedure error3(i, s);
value i;
integer i;
string s;
begin
prep_line(1);
errors:=errors+1;
outline_no(false, true);
write(out, <: **** :>);
outf1(i, 0);
write(out, if i<>0 then <: :> else <::>, s, <:<10>:>);
end error3;
procedure error4(s);
string s;
if warning then
begin
prep_line(1);
outline_no(false, true);
write(out, <: ** :>, s, <:<10>:>);
warnings:=warnings+1;
end error4;
procedure error5(n, s);
value n;
integer n;
string s;
if n<>0 then
begin
prep_line(1);
write(out, <:! :>, <<d>, n, <: :>, s, <:<10>:>);
end error5;
procedure readline;
begin
integer i, j;
boolean skip, comm;
om:
bossline_no:=nextbossline;
nextbossline:=nextbossline+10;
skip:=comm:=false;
for i:=1 step 1 until 200 do
begin
linelength:=i;
readchar(zin, j);
if j>=64 and j<96 then j:=j+32;
line(i):=j;
if j=25 <* em *> then
begin
if i=1 then
begin
if -,opennextsource(zin, sourceno) then
goto if pass=1 then end_pass1 else fin;
goto om;
end else
repeatchar(zin);
end;
if j=12 <* ff *> then
begin
nextbossline:=(nextbossline+990)//1000*1000+10;
i:=i-1;
end else
if comm then else
if j=33 <* ! *> or j=42 <* * *> then
begin
skip:=-,skip;
i:=i-1;
end else
if skip then i:=i-1 else
if j=59 <* ; *> then comm:=true;
if j=10 or j=25 <* em *> then goto ud;
end for i;
while j<>10 and j<>25 do
begin
readchar(zin, j);
if j=12 then nextbossline:=(nextbossline+990)/1000*1000+10;
end;
if j=25 then repeatchar(zin);
linelength:=linelength-10;
error1(<:line too long:>, 1);
ud:
if skip and line_length<=1 then goto om;
line(line_length):=10;
end read line;
procedure laes_snask;
begin
integer i, j, k;
if ext(p, 0)=long <:.:> then
begin comment directive or slice register definition;
advance(1);
if ext(p, 0)=long <:mapk:> then
begin <* . mapk = expression *>
advance(1);
j:=read_expr;
if j=-1 then error1(<:expression missing:>, 1);
if j>=0 then map_k := j extract 10;
format1(12);
end else
if ext(p, 0)=long <:addr:> then
begin <* . addr expression
. addr expression , repetition *>
advance(1);
j:=read_expr;
if j=-1 then error1(<:expression missing:>, 1);
reps:=1;
if f(comma) then
begin
advance(1);
reps:=read_expr;
if reps=-1 then error1(<:expression missing:>, 1);
end;
instr:=map_k;
if pass=2 and reps>-1 and j>-1 then
begin
for i:=reps step -1 until 1 do
begin
if map_table(map_k)>=0 then error3(0, <:instruction redefined:>);
map_table(map_k):=j;
map_k := (map_k + 1) extract 10;
end;
end;
if reps<0 then reps:=0;
format1(13);
end else
if ext(p, 0)=long <:instr:> add 117 and ext(p, 1)=long <:ction:> then
begin comment .instruction ;
advance(1);
instr:=j:=read_expr;
if f(comma) then advance(1);
i:=read_expr;
if f(comma) then advance(1);
k:=read_expr;
if pass=2 and j>=-1 and i>=-1 and k>=-1 then
begin
if j>255 then error1(<:instruction expression too high:>, 1);
if j=-1 then j:=1024; <* default instruction *>
if map_table(j)>=0 then
error3(0, <:instruction redefined:>);
map_table(j):=if i=-1 then kk else i;
map_table(if j=1024 then 1025 else j+256) :=
if k=-1 then kk else k;
end;
format1(5);
end else
if ext(p, 0)=long<:k:> and ext(p+1, 0)=long<:=:> then
begin comment . k = expression ;
advance(2);
j:=read_expr;
if j=-1 then error1(<:expression missing:>, 1);
if j=-2 then error3(0, <:undefined .k=expression:>)
else kk:=j;
format1(2);
end else
if ext(p, 0)=long<:loc:> then
begin comment .loc;
advance(1);
j:=read_expr;
if j>=-1 then
begin comment .loc;
if j=-1 then j:=0;
kk:=(kk+(-j-1) extract 2)//4*4 + j extract 2;
format1(1);
end else
error3(0, <:undefined .loc expression:>);
end else
if ext(p, 0)=long <:list:> then
begin comment .list on/off;
advance(1);
if ext(p, 0)=long <:on:> then listing:=true else
if ext(p, 0)=long <:off:> then listing:=false else
error1(<:wrong list parameter<10>:>, 1);
advance(1);
format1(3);
end else
if ext(p, 0)=long<:print:> then
begin comment .print on/off;
advance(1);
if ext(p, 0)=long <:on:> then printing:=true else
if ext(p, 0)=long <:off:> then printing:=false else
error1(<:wrong print parameter<10>:>, 1);
advance(1);
format1(4);
end else
if f(name) and ext(p+1, 0)=long <:=:> then
begin comment . regname=;
i:=search1(p);
advance(2);
j:=read_expr;
if j>0 then j:=j extract 4;
if j=-1 then error1(<:expression missing:>, 1);
if pass=2 then
begin
if logand(undef, symb(i, 2))<>0 then
begin comment undef in pass2;
symb(i, 2):=name+r+sliceop+
(if j=-2 then 0 else j);
end else
if logand(data2, symb(i, 2))<>0 then
error3(0, <:constant redefined as a register:>) else
if j>=0 and j<>symb(i, 2) extract 11 then
error3(0, <:illegal redefinition:>);
end else
if logand(undef+r+data2, symb(i, 2))=0 then
begin
symb(i, 2):=if j>=0 then name+r+sliceop+j else name+undef;
end;
format1(6);
end else
if ext(p, 0)=long<:m:> then
begin comment .m;
format1(9);
end else
if ext(p, 0)=long<:p:> then
begin comment .p;
advance(1);
format1(10);
end else
error1(<:illegal directive:>, 1);
end directive or slice register definition else
if f(name) and (ext(p+1, 0)=long <:::> or ext(p+1, 0)=long <:=:>) then
begin comment constname=/:;
i:=search1(p);
advance(2);
j:=if ext(p-1, 0)=long <:::> then kk else
read_expr;
if j=-1 then error1(<:expression missing:>, 1);
if pass=2 then
begin
if logand(undef, symb(i, 2))<>0 then
begin comment undef in pass2;
symb(i, 2):=name+data2+sliceop+binary+(if j=-2 then 0 else j);
end else
if logand(r, symb(i, 2))<>0 then
error3(0, <:register redefined as a constant:>) else
if j>=0 and j<>symb(i, 2)extract 11 then
error3(0, <:illegal redefinition:>);
end else
if logand(undef+r+data2, symb(i, 2))=0 then
begin
symb(i, 2):= if j<0 then name + undef else
name+data2+sliceop+binary+j;
end;
format1(if ext(2, 0)=long<:::> then 11 else 7);
end constname=/: else
if f(line_end) then
begin
format1(8);
end;
end laes snask;
<* alu sources *>
aq:=0;
ab:=1;
oq:=2;
ob:=3;
oa:=4;
da:=5;
dq:=6;
d0:=7;
<* alu destinations *>
ar:=2;
fq:=0;
fn:=1;
bd:=4;
<* definitions of type bits *>
data1:=s1(1,0);
data2:=s1(1,1);
sliceop:=s1(1,2);
implc:=s1(1,3);
cdef:=s1(1,4);
radef:=s1(1,5);
bfdef:=s1(1,6);
name:=s1(1,7);
binary:=s1(1,8);
r:=s1(1,9);
q:=s1(1,10);
ass:=s1(1,11);
aluass:=s1(1,12);
carshift:=s1(1,13);
clr:=s1(1,14);
comma:=s1(1,15);
car:=s1(1,16);
cond:=s1(1,17);
op:=s1(1,18);
dofunc:=s1(1,19);
jump:=s1(1,20);
cond_allowed:=s1(1,21);
invert:=s1(1,22);
line_end:=s1(1,23);
vect:=s1(1,24);
map:=s1(1,25);
sign:=s1(1,26);
undef:=s1(1,27);
ir:=s1(1,28);
rc:=s1(1,29);
minus:=s1(1,30);
carry:=s1(1,31);
entr_no:=0;
max_symb:=1999;
for j:=0 step 1 until 3 do
for i:=max_symb step (-1) until 0 do
symb(i, j):=0;
i:=1;
word:=tab(i);
ext(1, 1):=0;
while word <> 0 do
begin
ext(1, 0):=word;
j:=search1(1);
bitword2:=bitword1:=0;
symb(j, 2):=tab(i + 1);
symb(j, 3):=logand(bitword1, -s1(1,7)) +
logand(bitword1, s1(1,7)-1) shift 1 +
bitword2 shift(-47);
i:=i + 2;
word:=tab(i);
end;
printing:=listing:=false;
errors:=warnings:=0;
fpnames:=13;
examine_params(true);
no_burn := if default1 then -1 else 0;
if -,opennextsource(zin, sourceno) then
begin
write(out, <:no input:>);
goto slut1;
end;
symb_name:=0;
page_no:=0;
line_no:=1000;
pass:=1;
kk:=0;
if disasskneh then
begin
for i:=0 step 1 until 1023+4 do map_table(i):=-1;
for i:=0 step 1 until 2047 do binmem(i, 0):=binmem(i, 1):=no_burn;
disassknehproc; comment jumps directly to slut when finished;
end;
next1:
p:=1;
readline;
find_items;
laes_snask;
kk:=kk+1;
goto next1;
end_pass1:
examine_params(true);
opennextsource(zin, sourceno);
for i:=0 step 1 until 1023+4 do map_table(i):=-1;
for i:=0 step 1 until 2047 do binmem(i, 0):=binmem(i, 1):=no_burn;
pass:=2;
kk:=0;
map_k:=0;
next:
bitword1:=bitword2:=0;
p:=1;
readline;
finditems;
laes_snask;
irdef:=rcdef:=expl_bdest:=expl_bsource:=bcdef:=expr_expected:=false;
op1:=op2:=alufunc:=areg:=breg:=0;
p:=1;
swopcount:=expr_pointer:=fbsource:=fslop1:=fslop2:=const_field_length:=
fsldest:=fbdest:=fcond:=fslop:=ra_def_length:=0;
om1:
if f(carry) and n(ass) then
begin comment carry:=bus;
expr_expected:=true;
if bcdef then error(<:double c:=:>);
bcdef:=true;
s(3, 28); s(1, 43);
advance(2);
goto om1;
end;
if f(ir) and n(ass) then
begin
if irdef then error(<:double ir:=:>);
irdef:=true;
expr_expected:=true;
s(1, 45);
advance(2);
goto om1;
end ir;
if f(rc) and n(ass) then
begin
if rcdef then error(<:double rc:=:>);
rcdef:=true;
expr_expected:=true;
s(1, 46);
advance(2);
goto om1;
end rc;
if f(data1 + undef) and n(ass) then
begin
if f(undef) then error(<:undefined:>);
expr_expected:=true;
setbusdest(a(p));
fbdest:=p;
advance(2);
goto om1;
end data1:=;
if f(data2+undef) and n(comma + line_end) then
begin
if f(undef) then error(<:undefined:>);
expr_expected:=false;
setbussource(a(p));
fbsource:=p;
advance(1);
goto read_alu_dest;
end;
if expr_expected then setbussource(data2+5); <* set alu output *>
if f(r + undef) and n(comma) and n(r + undef) and n(ass) then
begin <* r , r := *>
if f(undef) then error(<:undefined:>);
s(ar, 18);
breg:=a(p+2);
fbsource:=p;
areg:=a(p);
advance(2);
goto skip_aludest;
end;
read_alu_dest:
while f(comma) do advance(1);
if f(q) and n(ass) then
begin <* q := *>
s(fq, 18);
goto skip_aludest;
end;
if f(r + undef) and n(aluass) then
begin <* r :=/:=</:<</:=>/:>> *>
if f(undef) then error(<:undefined:>);
s(a(p+1)extract 3, 18); <* set aludest *>
breg:=a(p);
skip_aludest:
expr_expected:=true;
fsldest:=p;
advance(2);
end else
s(fn, 18); <* set aludest fn default *>
if f(carry) and n(car) then
begin
setbus(a(p+1), 0); <* set carry *>
s(1, 43); <* update carry *>
if logand(carshift, a(p+1)) <> 0 then
begin
if bitword1 shift(-47+17)extract 2<>2 + a(p+1)shift(-5)extract 2 then
error(<:illegal carry shifting:>);
end;
advance(2);
end;
if f(sliceop + undef) then
begin comment first operand;
if f(undef) then error(<:undefined:>);
fslop1:=p;
op1:=a(p);
advance(1);
end;
if f(op) then
begin
fslop:=p;
alufunc:=a(p);
s(alufunc extract 4, 22);
advance(1);
end;
if f(sliceop + undef) then
begin comment second operand;
if f(undef) then error(<:undefined:>);
fslop2:=p;
op2:=a(p);
advance(1);
end;
if alufunc=0 then
begin
if op2<>0 then error(<:+operand:>);
if logand(binary, op1)<>0 and op1 extract 11=0 or op1=0 then
begin comment expr=0;
alufunc:=op;
s(4, 21); <* set and *>
s(oa, 25);
goto expr_ok;
end;
if logand(data2, op1)<>0 and bitword1 shift(-47+34)extract 3=5 <* alu *> then
begin
expl_bsource:=false;
bitword1:=bitword1-s1(5, 34);
end;
alufunc:=op;
s(0, 21); <* set + *>
end;
if logand(binary, op1)<>0 and op1 extract 11=0 then op1:=0;
if logand(binary, op2)<>0 and op2 extract 11=0 then op2:=0;
if op2=0 then swopop;
if logand(data2, op2)<>0 then swopop else
if logand(q, op1)<>0 then swopop;
if op1=0 then
begin
if op2=0 then
begin
s(d0, 25);
setbussource(data2+binary+sliceop+0);
swopcount:=0;
goto expr_ok;
end;
if logand(q, op2)<>0 then
begin
s(oq, 25);
goto expr_ok;
end;
if areg=op2 or areg=0 then
begin
areg:=op2;
s(oa, 25);
goto expr_ok;
end else
if breg<>0 and breg<>op2 then
error(<:wrong a, b combination:>);
breg:=op2;
s(ob, 25);
goto expr_ok;
end op1=0;
if logand(data2, op1)<>0 then
begin
setbussource(op1);
if op2=0 then s(d0, 25) else
if logand(op2, q)<>0 then s(dq, 25) else
if logand(r, op2)<>0 then
begin
if areg<>0 and areg<>op2 then
error(<:data must not be combined with b:>);
s(da, 25);
areg:=op2;
end else error(<:data allowed only once:>);
goto expr_ok;
end;
if logand(q, op2)<>0 then
begin
if areg<>0 and areg<>op1 then
error(<:q must not be combined with b:>);
areg:=op1;
s(aq, 25);
goto expr_ok;
end;
if logand(q, op1)<>0 then error(<:q allowed only once:>);
comment a op b;
if logand(clr, alufunc)<>0 and swopcount=0 then swopop;
s(ab, 25);
if areg<>0 and areg<>op1 then swopop else
if breg<>0 and breg<>op2 then swopop;
if areg=0 then areg:=op1 else
if areg<>op1 then error(<:a, b conflicts:>);
if breg=0 then breg:=op2 else
if breg<>op2 then error(<:a, b conflicts:>);
goto expr_ok;
expr_ok:
if areg<>0 then s(areg extract 4, 11);
if breg<>0 then s(breg extract 4, 15);
if swopcount=1 then
begin
if logand(minus, alufunc)<>0 then bitword1:=bitword1 - s1(1, 21);
<* modify sub and sb1 to bus and bs1 *>
end else
if logand(clr, alufunc)<>0 then error(<:clr not commuting:>);
if -,expl_bsource then setbussource(data2 + 5); <* alu is default *>
while f(comma) do advance(1);
comment test do;
while f(dofunc) do advance(1);
while f(comma) do advance(1);
comment jump and cond;
if f(jump) then
begin
if f(vect+map) then
begin
advance(1);
if f(invert) then advance(1);
if -, f(binary) then error(<:missing constant after vect or map:>);
fcond:=p;
i:=a(p)extract 11;
advance(1);
if i>15 then error(<:constant too big after vect or map:>);
s(i, 7); <* set condition field *>
if constfield_length<>0 then
error3(0, <:the constant field is disabled by map and vect:>);
goto ud;
end;
advance(1);
if f(invert) and logand(a(p-1), cond_allowed)<>0 and n(cond) then
begin
advance(1);
end not;
if f(cond) then
begin
fcond:=p;
advance(1);
end;
end jump else
s(14, 3); <* set default continue *>
ud:
while f(comma) do advance(1);
expr_pointer:=p;
i:=read_expr;
if -,f(line_end) then error(<:syntax:>);
if i>=0 then
begin
if bitword1 shift(-47+3)extract 4=6 then
begin comment vect;
if i extract 2<>0 then
begin
error4(<:address not divisible by 4:>);
i:=i shift(-2)shift 2;
end;
i:=i+bitword2 shift(-47+11)extract 2;
end vect;
setconst(11, i);
end;
if bitword2 shift(-47+0)extract 1=1 <* read *> and
bitword1 shift(-47+37)extract 3<>bd <* bd:= *> then
error3(0, <:read requires bd:= :>);
if bitword1 shift(-47+40)extract 1=1 <* wait *> and
bitword1 shift(-47+37)extract 3<>bd <* bd:= *> and
bitword1 shift(-47+34)extract 3<>bd <* :=bd *> then
error3(0, <:wait requires bd:>);
if bitword2 shift(-47+0)extract 1=1 <* read *> and
(bitword1 shift(-47+3)extract 4=2 <* map *> or
bitword1 shift(-47+3)extract 4=6 <*vect *> or
bitword1 shift(-47+46)extract 1=1 <* rc:= *> ) then
error3(0, <:read is disabled by map, vect, or rc:=:>);
if bitword1 shift(-47+46)extract 1=1 <* rc:= *> and
(bitword1 shift(-47+34)extract 3=3 <* const *> or
const_field_length<>0 ) then
error3(0, <:the constant and the address field is disabled by rc:=:>);
if -,fastregs then
begin
if bitword2 shift(-47+0)extract 1=1 <* read *> and
bitword1 shift(-47+40)extract 1=1 <* wait *> then
error3(0, <:read and wait may not coexist:>);
i:=0;
if bitword1 shift(-47+37)extract 3=2 then i:=i+1;
if bitword1 shift(-47+34)extract 3=2 then i:=i+1;
if bitword1 shift(-47+40)extract 1=1 then i:=i+1;
if i>0 then s(1,40); <* set w in case rd *>
if i>1 then error3(0, <:rd, wait trouble:>);
end;
bitword1:=logor(bitword1, s1(1,26) + s1(1, 39) + s1(127, 47)) -
logand(bitword1, s1(1, 26) + s1(1, 39) + s1(127, 47));
bitword2:= ( logor(bitword2, s1(1, 0))shift(-1) -
logand(bitword2, s1(1, 0))shift(-1) ) shift 1;
if disassemble then disass;
if listing then format;
outword(bitword1, bitword2);
goto next;
fin:
<* replace unassigned entries by default ones *>
for i:=1024 step 1 until 1024+3 do
if map_table(i)<0 then map_table(i):=0;
for i:=0 step 1 until 1023 do
if map_table(i)<0 then map_table(i):=map_table(i//256+1024);
if jump_table then
begin
head_name(1):=long<:jump:>;
head_name(2):=long<:table:>;
line_no:=1000;
kk:=2048-256;
for i:=0 step 1 until 255 do
begin
j:=map_table(i);
if j<0 then j:=map_table(1024);
j:=j extract 11;
outword(s1(3, 3) + s1(fn, 18) + s1(4, 21) + s1(oa, 25) + s1(5,34) +
s1(1, 39) + s1(127, 47), s1(1, 0) + s1(j, 11));
end;
end jump_table;
if genoutput then
begin comment generate prom tapes;
opennextsource(bin, 0);
for i:=3 step 4 until 59 do
begin
write(bin, false, 100, false add 255, 1);
for j:=0 step 1 until 2047 do
write(bin, false add(
binmem(j, i//48)shift(-47+i mod 48)extract 4 +64), 1);
end;
write(bin, false, 100, <:<25>:>);
end genoutput;
fpfile(1):=long<:map:>;
fpfile(2):=long<::>;
if opennextsource(bin, -1)then
begin comment map.<mapfilename>;
for i:=0 step 1 until 3 do
begin
write(bin, false, 100, false add 255, 1);
for j:=0 step 1 until 511 do write(bin, false add(
map_table(j + i extract 1 * 512)shift(-i //2*8)
extract 8), 1);
end;
write(bin, false, 100);
end map;
prbslut:
if printbin then
begin
boolean skipping;
head_name(1):=long<:print:>;
head_name(2):=long<:bin:>;
line_no:=1000;
skipping:=true;
for kk:=0 step 1 until 2047 do
begin
for j:=0 step 1 until 1 do
if binmem(kk, j)<>no_burn then goto ud;
if skipping then goto om;
skipping:=true;
prep_line1(1);
write(out, <:!<10>:>);
goto om;
ud:
skipping:=false;
prep_line1(1);
write(out, <:! :>, string trihex(kk));
j:=-1;
bitword1:=binmem(kk, 0);
bitword1:=bitword1 - bitword1 extract 16 +
bitword1 extract 14 shift 2 +
bitword1 shift(-14) extract 2;
for i:=3, 7, 11, 15, 18, 21, 22, 25, 26, 28, 31, 34, 37,
38 step 1 until 48 do
begin
k:=if i=48 then binmem(kk, 1) shift(-47+0) else
bitword1 shift(-47+i) extract(i-j);
j:=i;
write(out, <: :>, false add (if k>9 then k+97-10 else k+48),
1);
end for i;
write(out, <: :>,
string trihex( binmem(kk, 1) shift(-47+11) extract 11),
false add 32, 8);
for j:=15 step 16 until 47 do
write(out, <: :>, string outhex(binmem(kk, 0)
shift(-47+j) extract 16 + 1 shift 16)shift 8);
write(out, <: :>,
string trihex(binmem(kk, 1) shift (-47+11) extract 12), <:<10>:>);
om:
end for kk;
head_name(2):=long<:map:>;
for kk:=0 step 1 until 1023 do
begin
if kk mod 16=0 then
begin
if kk mod 512=0 then line_no:=1000;
prep_line2(1);
write(out, <:! :>, string trihex(kk), <: :>);
end;
if kk mod 4=0 then write(out,<:_:>);
write(out, <: :>, string outhex(map_table(kk) + 1 shift 16)
shift 8);
if kk mod 16=15 then write(out, <:<10>:>);
end for kk;
end printbin;
lineno:=1000;
headname(1):=headname(2):=long<::>;
error5(errors, <:errors:>);
error5(warnings, <:warnings:>);
error5(blocksread, <:blocksread:>);
slut:
close(bin, true);
slut1:
trap_mode:=1 shift 10;
end;
(source=set 1
bin=set 1
source=edit
scope login source
bin=rc35mass disassemble.yes list.yes source bossline.yes,
printbin.yes
finis)
i@
.c4=0b
.reg=0c
.w4=4
.cx=0a
.w0=0
.pu=0e
ra:=reg+c4
.instruction , 2, 3
.k=100
.instruction 5, 6, 7
w4:=cx--
.instruction 8
w0:=77,
bus:=77
cjp 77
rd:=w0:=77
w0:=w0,cjp 77
q:=w0 xor pu
@,f
;;the preceding line contained a form_feed
.instruction 0a
w1:=ccc
.loc
w1:=<0
.loc 0a1
.instruction 0b
fff=ggg+2
ggg:
.instruction 0a
jmp fff
;;dobbelt kommentar
jmp ggg
;;dobbelt kommentar med 7spacer foran
.m message
.m message med 7 spacer
ddd:
w1:=ddd
@,f
ccc=2a
w1:=0
.loc
ddd:
eee:
jmp ddd
jmp eee
.w0=02
.w1=01
fff=ggg+1
ggg:
jmp ggg
jmp fff
kkk=w0+1
rd1,vect 0,14
rd1,vect 0,15
rd1,jmp 14
rd1,jmp 15
w1:<<0
w1:=0
w1:=<c=0
w1:=<c<0
w1:<<0
w1:<<c<0
w1:>>0
w1:=>0
jmp constant
,,,;empty instruction
ra:=0a,,,;data:=const
w0:=w0+w1,,,;r:=r+r
ra:=w1:=w0+w1,,,;data:=r:=r+r
ra:=w0+w1,,,;data:=r+r
w0:=w1+w0,,,;r:=r+r
ra:= 0ab,,,;
ra:= 0ab,,,;
ra:= w0,,,;
ra:=rd/w0:=w0 and w1,,,;
w0:=0a,,,;
w0:=0a+0,,,;
c:=ra:=w0:=w0--w1, h wait, jmp not b0, addr;
ra:=w0/w1:=c:w0+w1,,,;
w1:=< c< w1,,,;
;test bus syntax
c:=w0,,,;
c:=w0,,,
ba:=w0,,,
c:=ba:=w0,,,
c:=ba:=bd,,,
;dette er en kommentar
bd,,,
ba:=w0/w1:=w1+w0,,,
ba:=ccr,,,
bd:=ccr,,,
ba:=0a,,,
ba:=const,,,0ab
ba:=0ab/w0:=w0+0ab,,,
0ab,,,
bus:=0ab,,,
w0:=w0+w1,,,
bus:=w0:=w0+w1,,,
w0/w1:=w0+w1,,,
bus:=w0/w1:=w0+w1,,,
;test kombinationer med c
w0:=c:w1,,,
w0:=w1,,,
c:=w0:=w1,,,
q:=c:w1,,,
q:=w1,,,
c:=q:=w1,,,
c:w1,,,
w1,,,
c:=w1,,,
w0:=<c:w1,,,
w0:=<c<w1,,,
w0:=w1,,,
c:=w0:=<w1,,,
w0:<<c:w1,,,
w0:<<c<w1,,,
w0:<<w1,,,
c:=w0:<<w1,,,
w0:=>c:w1,,,
w0:=>c>w1,,,
w0:=>w1,,,
c:=w0:=>w1,,,
w0:>>c:w1,,,
w0:>>c>w1,,,
w0:>>w1,,,
c:=w0:>>w1,,,
;test alu functions
w0+w1,,,
w0++w1,,,
w0-w1,,,
w0--w1,,,
w0 and w1,,,
w0 ior w1,,,
w0 clr w1,,,
w0 xor w1,,,
w0 equ w1,,,
;test data til alu
w1:=0a+w0,,,
w1:=0a+q,,,
w1:=0a+0,,,
w1:=ccr+w0,,,
w1:=ccr+q,,,
w1:=ccr+0,,,
w1:=bd+w0,,,
w1:=bd+q,,,
w1:=bd+0,,,
;test alu dest and source
;aq
w0/w1:=w0-q,,,
w0/w1:=q-w0,,,
w1:=w0-q,,,
w1:=q-w0,,,
w0-q,,,
q-w0,,,
;ab
w0/w1:=w0-w1,,,
w0/w1:=w1-w0,,,
w1:=w0-w1,,,
w1:=w1-w0,,,
w0-w1,,,
;oq
w0/w1:=0-q,,,
w0/w1:=q-0,,,
w1:=0-q,,,
w1:=q-0,,,
0-q,,,
q-0,,,
;ob
w0/w1:=0-w1,,,
w0/w1:=w1-0,,,
w1:=0-w1,,,
w1:=w1-0,,,
0-w1,,,
w1-0,,,
;oa
w0/w1:=0-w0,,,
w0/w1:=w0-0,,,
w1:=0-w0,,,
w1:=w0-0,,,
;do
w0/w1:=0-0a,,,
w0/w1:=0a-0,,,
w0/w1:=0-0a,,,
w1:=0a-0,,,
w1:=0-0a,,,
0a-0,,,
0-0a,,,
;da
w0/w1:=0a-w0,,,
w0/w1:=w0-0a,,,
w1:=0a-w0,,,
w1:=w0-0a,,,
0a-w0,,,
w0-0a,,,
;dq
w0/w1:=0a-q,,,
w0/w1:=q-0a,,,
w1:=0a-q,,,
w1:=q-0a,,,
0a-q,,,
q-0a,,,
ccr-q,,,
bd-q,,,
;special alu functions
w1:=0,,,
w1:=w0,,,
w1:=q,,,
w1:=0a,,,
w1:=0-0,,,
w1:=-0,,,
w1:=-w0,,,
w1:=-q,,,
w1:=-0a,,,
+0,,,
++0,,,
--0,,,
.print off
@,f
▶EOF◀