|
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: 65280 (0xff00)
Types: TextFile
Names: »tgenass«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦976cf9702⟧ »tassemb«
└─⟦this⟧
;nhp time.300
slet std.genass
beskyt std.genass.85
genass=hcalg message.no
begin comment tda,tabel directed assembler;
integer machine,wordlength,nooindex,noobase,coresize,nooformats,
textword,charrep,charsinword,charlength,
realword,expoex,exposh,fracex,fracsh,
resultlength,addressword,indirect,noteadr,
i,j,p,sourceno,noosource,nooblocks,
noocodes,nooperm,baseindex,maxaddrno,indexk,
list,mpasssize,noosym,test,condtassem,symlimit,blknr,sna,aa,sca;
boolean boo,type,symbols,blocks,note,pack,current;
integer array t(1:17);
array sourcenames(1:20),a,mpass,result,stackname(1:2);
zone zio(128,1,stderror);
integer procedure max(a,b); value a,b; integer a,b;
max:=if a>b then a else b;
boolean procedure nextsource;
begin comment if more sourceareas exist the next is initialized
and nextsource is true
else nextsource is false;
integer i;
array a(1:2);
nextsource:=noosource>sourceno;
if noosource>sourceno then
begin
sourceno:=sourceno+1;
a(1):=sourcenames(sourceno*2-1);
a(2):=sourcenames(sourceno*2);
i:=1;
if list=0 then write(out,<:<10>:>,string a(increase(i)),<:<10>:>);
if connectcuri(a)<>0 then alarm(<:source:>)
end
end nextsource;
comment the commandlist is scanned,
a call of the program has the form:
result=genass dataarea (parameters sources);
type:=pack:=true;
condtassem:=test:=0;
list:=1;
noosym:=221;
sourceno:=0;
mpasssize:=30;
blocks:=symbols:=false;
comment initialize resultdocument;
if readparam(result)<0 then readparam(a) else generaten(result);
note:= false;
for i:= 1 step 1 until 6 do
if result(1)=real(case i of(<:c:>,<:r:>,<:s:>,<:t:>,<:u:>,<:v:>))
then
begin
note:= true;
noteadr:= firstnote+(i-1)*22;
if wordload(noteadr+4)=0 then
begin
generaten(result);
cleararray(t);
t(1):= 100;
createentry(result,t);
wordstore(noteadr+2,1 shift 23 add 4);
doublestore(noteadr+6,long result(1));
doublestore(noteadr+10,long result(2))
end else
begin
nameload(noteadr+4,result);
if lookuptail(result,t)=0 and t(1)<0 then
begin
for i:= 1 step 1 until 10 do
wordstore(noteadr+2*i,t(i))
end
end;
i:= 7
end;
i:= headandtail(result,t);
if i=0 and t(8)<0 then
begin
result(1):= real<::>add t(9)shift 24 add t(10);
result(2):= real<::>add t(11)shift 24 add t(12);
i:= headandtail(result,t)
end;
if i=0 and t(1)extract 12=0 then
begin
if removeentry(result)<>0 then alarm(<:object:>);
i:= 3
end;
t(1):= t(8);
if i=3 then
begin
cleararray(t);
t(1):= 100;
i:= createentry(result,t)
end;
if i<>0 then alarm(<:object:>);
resultlength:= t(1);
comment skip programname (genass) and dataarea;
readparam(a);
comment read sourcedocuments and optional parameters;
next:
for i:=readparam(a) while i>0 do
begin
if i<>2 then alarm(<:syntax:>);
comment space name is read;
for i:=1 step 1 until 9 do
if a(1)=real(case i of(
<:list:>,<:type:>,<:block:>,<:sym:>,<:pack:>,
<:tab:>,<:aux:>,<:test:>,<:names:>)) then goto param;
comment sourcedocument read;
sourceno:=sourceno+1;
if sourceno>10 then alarm(<:sources:>);
sourcenames(sourceno*2-1):=a(1);
sourcenames(sourceno*2):=a(2);
goto next;
comment an optional parameter is read;
param:
j:=readparam(a);
if a(1)=real<:yes:> then boo:=true else
if a(1)=real <:no:> then boo:=false else
if j=4 then alarm(<:parameter:>);
if i<6 and j=4 then
begin
case i of
begin
list:=if boo then 0 else 1;
type:=boo;
blocks:=boo;
symbols:=boo;
pack:= boo
end
end else
if i>5 and j=3 then
begin
case i-5 of
begin
noosym:= max(a(1),noosym);
mpasssize:= max(a(1),mpasssize);
test:= a(1)
end
end
else
if i=9 and j=4 then symbols:= boo else alarm(<:syntax:>);
end;
current:= sourceno=0;
comment a passarea is created and ioz is connected to it;
generaten(mpass);
cleararray(t);
t(1):=mpasssize;
i:=1;
if test<>0 then write(out,<:<10>pass area: :>,
string mpass(increase(i)),<:<10>:>);
createentry(mpass,t);
i:= 1;
open(zio,4,string mpass(increase(i)),0);
comment read in variabels defining the assembler;
read(in,machine,
wordlength,nooindex,noobase,coresize,nooformats,
textword,charrep,charsinword,charlength,
realword,expoex,exposh,fracex,fracsh,
addressword,indirect,
noocodes,nooperm,baseindex,maxaddrno);
begin comment define tabels to be used in both passes;
boolean array symtype(0:noosym),
formattab,opf(0:nooformats-1),
adrmodif(0:(nooformats)*(noobase+nooindex+4));
integer array opcode(0:noocodes),
symname, symval(0:noosym);
symlimit:=noobase+nooindex+nooperm+1;
if noosym<=symlimit then alarm(<:symboltabelsize:>);
begin comment tabels and variabels to be used in pass 1;
boolean array modif1tab(0:nooformats-1),
internal(1:128),
tab1(1:130),
tab2(1:192);
integer array opcodename(0:noocodes),
b(1:max(1,noobase));
boolean nextchar,lineno,normal,found,outpass1,nl,sp;
integer iso,isoclass,char,class,
charclass,charstate,action,texterror,
base,noochar,num,textbyte,
nextaction,state,output,error,index,mode,newmode,
maxmode,modifparts,op,arg,sign,f,daction,
nooadr,k,addk,indexsym,c,z,condtassem,
val,i,code,symno,j,state2;
real realnumber;
long sym,nextsym,longchar;
integer procedure searchtab(T,no,name);
value no,name; integer array T;
integer no,name;
begin integer k;
comment the tabel T is searched for the name name.
The tabel T must be declared T(0:no).
The index index gets the value of which
T(index)=name or T(index)=0. The result is
T(index);
k:=(name shift (-12) + name extract 12) mod no;
for index:=k+1 step 1 until no,
0 step 1 until k do
if T(index)=name or T(index)=0 then goto Found;
alarm(<:***genass symbol overflow.:>);
Found:
searchtab:=T(index);
end searchtab;
procedure readreal;
begin comment reads in a real number;
repeatchar(in); read(in,realnumber);
if list=0 then write(out,<<d.dddddddd>,realnumber);
repeatchar(in)
end readreal;
integer procedure charvalue;
begin comment gives the internal value of a char;
if charrep=1 then
begin comment ascii 8-bit;
charvalue:=if iso>96 then iso+96 else iso+128
end else
if charrep=2 then
begin comment ascii 6-bit;
charvalue:=if iso>96 then iso-96 else
if iso=96 or iso=64 then 0 else iso
end else
begin comment iso 8-bit;
charvalue:=iso
end
end charvalue;
comment read in data to assemblerdependenttabels used in pass1
and initialize others tabels;
begin comment define worktabels;
integer array wformattab,wopf,wmodif1tab(0:nooformats-1),
wadrmodif(0:nooformats*(noobase+nooindex+4)),
indextab(1:max(1,nooindex)),
basetab(1:max(1,noobase)),
permtab(1:max(1,nooperm*2));
procedure insymtab(name);
value name; integer name;
begin comment this procedure inserts the name in the
symboltabels returning the index of the
tabelentry;
searchtab(symname,noosym,name);
symname(index):=name;
end insymtab;
read(in,opcodename,opcode);
if nooindex>0 then read(in,indextab);
if noobase>0 then read(in,basetab);
if nooperm>0 then read(in,permtab);
read(in,wformattab,wopf,wmodif1tab,wadrmodif);
for i:=0 step 1 until nooformats-1 do
begin
formattab(i):=false add wformattab(i);
opf(i):=false add wopf(i);
modif1tab(i):=false add wmodif1tab(i)
end;
for i:=0 step 1 until (nooformats)*(noobase+nooindex+4) do
adrmodif(i):=false add wadrmodif(i);
comment initialize conversion tabel;
for i:=1 step 1 until 31 do
internal(i):=false add 11 shift 8;
for i:=33,35,36,37,38,39,63,91,92,93,94,95,96,124,125,126 do
internal(i):=false add 12 shift 8;
for i:=48 step 1 until 57 do
internal(i):=false add 1 shift 8 add (i-48);
for i:=65 step 1 until 90 do
internal(i):=false add 3 shift 8 add (i-55);
for i:=97 step 1 until 122 do
internal(i):=false add 3 shift 8 add (i-87);
internal(12):=
internal(10):=false add 6 shift 4 add 9 shift 4 add 0;
internal(25):=false add 13 shift 8;
internal(9):=
internal(32):=false add 5 shift 8;
internal(34):=false add 10 shift 8;
internal(40):=false add 4 shift 4 add 6 shift 4 add 1;
internal(41):=false add 5 shift 8 add 1;
internal(42):=false add 4 shift 4 add 5 shift 4 add 3;
internal(43):=false add 4 shift 4 add 4 shift 4 add 1;
internal(44):=false add 4 shift 4 add 9 shift 4 add 1;
internal(45):=false add 4 shift 4 add 4 shift 4 add 2;
internal(46):=false add 2 shift 4 add 6 shift 4 add 0;
internal(47):=false add 4 shift 4 add 5 shift 4 add 4;
internal(58):=false add 7 shift 4 add 12 shift 4 add 0;
internal(59):=false add 10 shift 8 add 1;
internal(60):=false add 8 shift 4 add 5 shift 4 add 5;
internal(61):=false add 4 shift 4 add 6 shift 4 add 3;
internal(62):=false add 9 shift 4 add 5 shift 4 add 6;
internal(64):=
internal(123):=false add 4 shift 4 add 6 shift 4 add 2;
comment initialize state/action tabel for getchar;
for i:=1 step 1 until 130 do
tab1(i):=false add (case i of
(1,0,3,0,0,0,0,4,0,9,0,0,0,
1,2,0,0,0,0,0,0,0,0,0,0,0,
2,0,2,0,0,0,0,0,0,0,0,0,0,
3,0,3,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,5,0,0,0,0,0,0,
5,5,5,5,5,0,7,6,8,5,8,5,0,
6,8,8,8,6,0,8,8,5,8,8,8,0,
8,8,8,8,8,0,8,8,0,8,8,8,0,
8,8,8,8,8,0,8,8,8,8,8,8,0,
9,9,9,9,9,0,9,9,9,9,9,9,0))
shift 6 add (case i of
(1,8,5,8,9,8,8,9,8,22,21,21,24,
3,2,4,4,4,4,4,4,4,4,4,4,4,
3,4,3,4,4,4,4,4,4,4,4,4,4,
6,4,6,4,4,4,7,4,4,4,4,4,4,
10,10,10,10,10,10,11,10,10,10,10,10,10,
12,12,12,12,12,19,16,13,18,12,20,12,18,
14,18,18,18,09,19,18,18,15,18,20,20,18,
20,20,20,20,20,19,20,20,17,20,20,20,20,
9,9,9,9,9,23,9,9,9,9,9,9,24,
9,9,9,9,9,25,9,9,9,9,9,9,24));
comment initialize state/action tabel for getsym;
for i:=1 step 1 until 192 do
tab2(i):=false add (case i of
(0,1,6,6,11,6,0,10,0,10,0,11,
5,4,4,4,5,1,5,5,4,5,0,5,
4,4,4,4,4,1,4,4,4,4,0,4,
4,4,4,1,4,4,4,4,4,4,0,4,
5,4,4,4,4,5,5,5,4,5,0,5,
5,5,5,5,5,5,5,5,4,5,0,5,
11,6,6,6,6,11,11,11,0,11,0,11,
11,11,11,6,6,12,11,11,0,11,0,11,
11,11,11,11,11,10,11,11,0,11,0,11,
11,11,11,11,11,12,11,11,0,11,0,11,
11,11,11,11,11,11,11,11,0,11,0,11,
11,11,11,11,11,11,11,11,0,11,0,11,
11,13,13,14,11,11,11,11,0,11,0,11,
11,11,11,14,14,11,11,11,0,11,0,11,
11,13,13,11,11,11,11,11,0,11,0,11,
15,15,15,15,15,15,15,15,15,15,0,15))
shift 6 add (case i of
(1,2,11,12,21,22,24,24,21,24,40,35,
36,3,4,5,36,6,36,36,14,36,40,36,
36,36,36,7,7,8,36,36,16,36,40,36,
36,36,36,9,36,36,36,36,17,36,40,36,
38,10,11,12,12,38,38,38,15,38,40,38,
21,21,21,21,21,21,21,21,15,21,40,21,
38,10,11,12,12,38,38,38,23,38,40,38,
39,39,39,13,13,25,39,39,41,39,40,39,
39,39,39,39,39,26,39,39,31,39,40,39,
39,39,39,39,39,26,39,39,31,39,40,39,
27,27,27,27,27,27,27,27,27,27,40,27,
21,21,21,21,21,21,21,21,33,21,40,21,
38,28,29,30,38,38,38,38,32,38,40,38,
38,38,38,30,30,38,38,38,27,38,40,38,
38,28,29,38,38,38,38,38,32,38,40,38,
21,34,21,21,21,21,21,21,21,21,40,21));
comment insert indexregisternames,baseregisternames and
permanent names in the symboltabels;
for i:=0 step 1 until noosym do
begin
symname(i):=symval(i):=0;
symtype(i):=false add 0
end;
if nooindex>0 then
for i:= 1 step 1 until nooindex do
begin
insymtab(indextab(i));
symval(index):=i; symtype(index):=false add 9
end;
if noobase>0 then
for i:=1 step 1 until noobase do
begin
insymtab(basetab(i));
symval(index):=i; symtype(index):=false add 8
end;
if nooperm>0 then
for i:=1 step 1 until nooperm do
begin
insymtab(permtab(i*2-1));
symval(index):=permtab(i*2); symtype(index):=false add 6
end;
insymtab(21); indexk:=index;
symval(indexk):=k:=0; symtype(indexk):=false add 7
end pass1 definitions;
comment initialize variabels;
for i:=1 step 1 until max(1,noobase) do b(i):=0;
c:=13; z:=36;
lineno:=normal:=true; nextchar:=outpass1:=false;
symno:= blknr:= 1;
charstate:=daction:=arg:=addk:=state:=0;
condtassem:=nextaction:=output:=error:=nooblocks:=0;
nl:=false add 10; sp:=false add 32;
comment start output and connect in to the first source;
outrec(zio,128);
noosource:=sourceno; sourceno:=0;
if current then
begin
sca:= wordload(wordload(66)+22)+100;
comment h50, stack chain for current input;
sna:= firstaddr(stackname)-1;
aa:= firstaddr(a)-1;
movebytes(sca,sna,8);
stackcuri;
movebytes(sca,aa,8); movebytes(sna,sca,8); movebytes(aa,sna,8);
unstackcuri
end else
begin
stackcuri;
if -,nextsource then alarm(<:source:>)
end;
comment a charecter is read in from sourcearea or primary input,
a charecter is known through four variabels,
class giving the internal class-value,
char giving the internal charecter-value,
iso giving the iso-value,
isoclass giving the isoclass-value;
getchar:
if nextchar then
begin comment the next chae is already read in;
nextchar:=false
end
else begin comment read the next char in and copy it
to current output;
isoclass:=readchar(in,iso);
if iso>125 then iso:=88;
if list=0 then
begin
if internal(iso) shift (-8) extract 4 = 11 then iso:=88;
if lineno then
begin
write(out,<<-ddddd>,k,sp,3); lineno:=false
end;
lineno:=iso=10;
if iso<>25 then outchar(out,iso)
end
end;
i:=internal(iso) extract 12;
charclass:=i shift (-8) extract 4; char:= i extract 8;
comment the char is interpreted through a final state tabel,
in the tabel chars are converted to symbols:
numbers (reals and integers) are calculated,
names are converted to internal representation,
texts are packed as result code,
comments,space and ) are skipped.
getchar receives the following class- and char-values:
class= char=
1 cipher 0123456789
2 point 4.6,4.0
3 letter 10,...,38
4 delimiter 4.class,4.symval (see below)
5 space ) 0 for sp, 1 for )
6 new line 4.9,4.0
7 colon 4.12,4.0
8 < 4.5,4.5
9 > 4.5,4.6
10 semicolon quote 0 1 for quote semicolon
11 illegal 0
12 intext 0
13 end of medium 0
class values of delimiters:
4,4,5,5,5,5,9,6,6,6 for +-*/<>,(cmatt =
symbol values:
1,2,3,4,5,6,0,1,2,3 for the same cheracters.
getcher returns the follewing class- and symbol-values:
class= sym=
1 label 4 first letters in name
2 name 4 first letters in name
3 integer value
4 sign 1 2 for + -
5 operator 3 4 5 6 for * / < >
6 delimiter 0 1 2 3 for . ( cmatt =
7 text code
8 textend 0 1(error)
9 separator 0 1 for nl ,
10 realnumber value
11 end of medium 0
12 illegal 0
;
i:=charstate*13+charclass;
j:=tab1(i) extract 12;
charstate:=j shift (-6) extract 6; action:=j extract 6;
if test extract 1>0 then
write(out,false add iso,1,<:(:>,charstate,<:,:>,action,
<:):>);
case action of
begin
begin comment 1: start calc of integer;
base:=10; sym:=char; class:=3
end 1;
begin comment 2: base sym integer;
base:=sym; sym:=0
end 2;
comment 3: add one chipher;
if char>=base then
begin comment end of number;
charstate:=0;
nextchar:=true; goto getsym
end else sym:=sym*base+char;
begin comment 4: symbol is finished,output;
nextchar:=true; goto getsym
end 4;
begin comment 5: first char in name;
sym:=char+1; noochar:=1; class:=2
end 5;
begin comment 6: a char in a name;
if noochar<4 then
begin
sym:=sym*40+char+1; noochar:=noochar+1
end
end 6;
begin comment 7: colon,name is a label output;
class:=1; goto getsym
end 7;
begin comment 8: operator,delimiter or separator,output;
class:=char shift (-4) extract 4; sym:=char extract 4;
goto getsym
end 8;
comment 9: empty action;;
begin comment 10: shift operator,output;
class:=5; sym:=5; nextchar:=true; goto getsym
end 10;
comment 11: prepare text;
textbyte:=texterror:=0;
begin comment 12: add one char to the text;
textbyte:=textbyte+1;
char:=charvalue;
addtext:
if textbyte=1 then sym:=0;
longchar:=char;
sym:=sym + ( longchar shift (48-charlength*textbyte));
if textbyte=charsinword then
begin comment a word is generated;
textbyte:=0; class:=7; goto getsym
end
end 12;
comment 13: prepare numerical char; num:=0;
comment 14: numerical char calculation;
num:=num*10+char;
begin comment 15: test numerical char;
textbyte:=textbyte+1;
if num<512 then
begin
char:=num;
goto addtext
end
else begin
char:=0; texterror:=1
end
end 15;
fintext:
begin comment 16: text is finished,output last word;
if textbyte<>0 then
begin
class:=7; textbyte:=0; goto getsym
end
end 16;
textend:
begin comment 17: text is finished,output textend symbol;
class:=8; sym:=texterror; goto getsym
end 17;
begin comment 18: error in text,
output last word,skip the rest;
nextchar:=true; texterror:=1;
textbyte:=textbyte+1; goto fintext;
end 18;
begin comment 19: error in text,finish;
texterror:=1; nextchar:=true; goto textend
end 19;
begin comment 20: error in text,skip;
texterror:=1; textbyte:=textbyte+1; goto fintext
end 20;
begin comment 21: illegal symbol,output;
sym:=iso; class:=12; goto getsym
end 21;
begin comment 22: read realnumber;
if char=0 then
begin comment real number start;
isoclass:=readchar(in,iso);
if isoclass<6 then
begin comment legal syntax;
readreal;
class:=10; sym:=long realnumber;
end
else begin comment illegal syntax;
class:=10; sym:=long 1.6'616; nextchar:=true;
if list=0 then write(out,false add iso,1)
end;
charstate:=0;
goto getsym
end
end 22;
begin comment 23: text is finished,output textend symbol,
nextchar is read (nl);
class:=8; nextchar:=true; sym:=texterror; goto getsym
end 23;
begin comment 24: end charecter,if more sources continue
else output;
if -,nextsource then
begin
class:=11; goto getsym
end
end 24;
begin comment 25: end of comment,output sep;
class:=9; sym:=0; goto getsym
end 25;
end charecter action;
goto getchar;
comment the symbols are interpreted through a
final state tabel forming sentences,
the interpreted symbols are output to pass 2.
a symbol read in can invoke that one or more actions
are performed before the next symbol is read in.
if another action shall be performed before the next
symbol is read the variabel nextaction is given the
number of the action and variabel nextsym is
given the value of the symbol to be used in the
action.
symbols output to pass 2 are describeb through
the following class and symbol values:
class= sym=
1 opcode index
2 modif/format 32.modif,16.format
3 name index
4 integer value
5 operator 123456 for +-*/<>
6 text code
7 textend 0 or 1 (error)
8 directive 6.newstate,42.value
9 error errornumber
10 separator 0
11 real value
12 end of medium 0
;
getsym:
if nextaction>0 then
begin comment an extra action shal be performed;
action:=nextaction; sym:=nextsym; nextaction:=0;
if test shift (-2) extract 1>0 then
write(out,<:((:>,action,<:)):>)
end
else begin comment a new symbol is interpreted;
val:=state*12+class;
action:=tab2(val) extract 6;
state:=tab2(val) shift(-6) extract 6;
if test shift (-1) extract 1>0 then
write(out,<:(:>,class,<:*:>,sym,<:):>);
if test = 2 then write(out,nl,1)
end;
if test shift(-2) extract 1>0 then
write(out,<:((:>,state,<:,:>,action,<:)):>);
case action of
begin
begin comment 1: label met,search symtab and insert;
val:=1;
searchsymtab:;
comment search the symboltabel with the name given in sym,
found tells if the name was found,
index gives the index of the last entry examined,
depending on the value of val an action is
performed on the result;
j:=searchtab(symname,noosym,sym);
found:=j=sym;
i:=symtype(index) extract 12;
case val of
begin
begin comment 1: label,insert name and value;
if i<2 or i=4 or i=5 then
begin comment legal name;
symval(index):=k;
symtype(index):=false add(if i<2then 4 else 5);
if -,found then symlimit:=symlimit+1;
symname(index):=sym
end
else begin comment reserved name;
output:=1; class:=9; sym:=9;
end
end 1;
begin comment 2: name start of assignment directive
or datedirective;
if i<9 then
begin comment legal name;
daction:=(if i=7 then 2 else if i=8 then 4 else
if (i=0 or i=2) then 3 else -1);
state:=7; state2:=9;
if -,found then
begin
symtype(index):=false add 1;
symname(index):=sym; symlimit:=symlimit+1
end;
indexsym:=index
end
else begin comment illegal name,skip to sep:;
state:=11
end
end 2;
begin comment 3: name in operand or addr modif part;
if i<8 then
begin comment name in operand,
output modif part and name;
nextaction:=20;
if -,found then
begin
symtype(index):=false add 1;
symname(index):=sym; symlimit:=symlimit+1
end;
goto modifaction;comment 4;
end
else begin comment address modif sym,change state;
state:=i-6
end
end 3;
begin comment 4: name in directive operand;
if i<2 or i=9 then
begin comment undefined symbol,
illegal operation is simulated;
op:=4; sym:=0
end
else begin
if i=8 then sym:=b(symval(index))
else sym:=symval(index)
end;
goto perform; comment 29;
end 4;
begin comment 5: name in operand;
if i<>9 then
begin comment legal name;
if -,found then
begin
symname(index):=sym; symlimit:=symlimit+1;
symtype(index):=false add 1
end;
output:=1; class:=3; sym:=index
end
else begin comment indexreg,error;
output:=1; class:=9; sym:=6;
end
end 5;
end case val of;
end 1;
begin comment 2: name met,
search the opcodetabel with the name,
index gives the index of the last
entry examined;
j:=searchtab(opcodename,noocodes,sym);
if j=sym then
begin comment then name is found;
code:=opcode(index);
f:=code extract 6;
if f<32 then
begin comment output code,initialize operands;
output:=class:=1; sym:=index;
i:=formattab(f) extract 12;
modifparts:= i extract 4;
if modifparts=0 then state:=4;
nooadr:= i shift (-4) extract 4;
addk:= i shift (-8) extract 4;
mode:=0
end
else begin comment directive ,initialize action
and operand;
daction:=f-31;
addk:=code shift (-6) extract 6;
state:= code shift (-12) extract 6;
state2:= code shift (-18) extract 6;
arg:=0; op:=1
end
end
else begin comment not found,
search symbol tabel,
expect assignment directive
or datadirective;
val:=2; goto searchsymtab; comment 1;
end
end 2;
begin comment 3: name in operand or modif part,
if index- or basereg the computa-
tion of the modif part is continued
else the modif part and the name
is output;
val:=3; goto searchsymtab; comment 1;
end 3;
begin comment 4: integer in operand,
output modif part and integer;
nextaction:=11; nextsym:=sym;
modifaction:;
comment an action depending on the formatnumber and the
modificationval1e is performed on the two;
case modif1tab(f) extract 12 of
begin
comment 1: empty action;;
extended:
begin comment 2:texas 980,extended addresseng;
if mode>7 then
begin
mode:=mode-8;
if mode=7 or mode=0 or mode=2 then
begin
f:=12;
if mode<7 then mode:=mode+4 else mode:=0;
addk:=2
end
else begin comment illegal modif value;
mode:=0; error:=10;
end
end
end 2;
begin comment 3: texas 980,extendedaddressing,
double word;
if mode=15 then
begin comment operand in next two words;
mode:=0; f:=14; addk:=3
end
else begin comment indirect address in next word;
goto extended
end
end 3;
end modif action;
modifparts:=modifparts-1;
output:=1; class:=2;
sym:= mode shift 16 add f;
if error<>0 then
begin
nextaction:=37; nextsym:=error; error:=0
end
end 4;
begin comment 5: sign start of operand,
output modif part and sign;
nextaction:=12; nextsym:=sym;
goto modifaction; comment 4;
end 5;
computemode:
begin comment 6: modification symbol,
the symbol values are:
0 1 2 3 for rel ind ext imm addr,
>3 and < 4+noobase for baserel
>3+noobase for index;
newmode:=adrmodif(f*(4+noobase+nooindex)+sym)extract 12;
if integerand(newmode,mode)=0 then
mode:=mode add newmode
else begin comment illegal modif value,skip;
mode:=0; state:=4; error:=10;
goto modifaction; comment 4;
end
end 6;
begin comment 7: operator after baseregister,
output modif part,
basereg and operator;
nextaction:=13; nextsym:=sym;
goto modifaction; comment 4;
end 7;
begin comment 8: point after baseregister,
compute modification;
if sym=0 then
begin comment point;
sym:= 3+symval(index); goto computemode; comment 6;
end
else begin comment modif syntax error;
mode:=0; state:=4; error:=10;
goto modifaction; comment 4;
end
end 8;
begin comment 9: sign after indexregister,
compute modification;
sym:= 3+symval(index)+noobase;
goto computemode; comment 6;
end 9;
begin comment 10: name in operand,
search symbol tab,output;
val:=5;
goto searchsymtab; comment 1;
end 10;
begin comment 11: integer in operand,
output;
output:=1; class:=4;
if daction=0 or daction=3 then daction:=22
end 11;
begin comment 12: operator in operand,
output;
output:=1; class:=5
end 12;
begin comment 13: output name and operator;
daction:=22;
nextaction:=12; nextsym:=sym;
goto outputname; comment 20;
end 13;
begin comment 14: no operand,
output modif part and separator;
nextaction:=15; nextsym:=sym;
if modifparts>0 then
goto modifaction; comment 4;
end 14;
begin comment 15: output separator;
if sym=0 and nooadr>1 then
begin comment operand(s) missing,error;
error:=11;
nooadr:=0
end;
if nooadr>0 then nooadr:=nooadr-1;
if modifparts>1 then state:=1;
if nooadr=0 then
begin comment operation is finished;
state:=0;
k:=symval(indexk):=k+addk; addk:=0
end;
output:=1;
if error>0 then
begin
class:=9; sym:=error; error:=0
end else class:=10
end 15;
begin comment 16: baseregister is operand,
output modif part,name and sep;
nextaction:=18; nextsym:=sym;
goto modifaction; comment 4;
end 16;
begin comment 17: indexregister is operand,error,
output modif part,error and sep;
nextaction:=19; nextsym:=sym;
mode:=0;
goto modifaction; comment 4;
end 17;
begin comment 18: output name and sep;
nextaction:=15; nextsym:=sym;
goto outputname; comment 20;
end 18;
begin comment 19: output ***modif and sep;
nextaction:=15; nextsym:=sym;
output:=1; class:=9; sym:=10;
modifparts:=modifparts-1
end 19;
outputname:
begin comment 20: output name;
output:=1; class:=3; sym:=index
end 20;
comment 21: skip;;
comment 22: datadirective start,indirect address;
if sym=1 then
begin
output:=1; class:=23 shift 6 add 6 shift 6 add 8;
sym:=0; daction:=23
end
else state:=11;
begin comment 23: output separator after pass2-directiv);
output:=1; class:=10;
k:=symval(indexk):=
k+(if daction=22 or daction=23
then addressword else addk); addk:=daction:=0
end 23;
begin comment 24: datadirective,
text,textend or real;
output:=daction:=1;
addk:=addk+(if class=7 then textword else
if class=10 then realword else 0);
class:=if class<10 then class-1 else 11
end 24;
comment 25: in directive,expect = ;
if sym<>3 then
begin comment not = ;
state:=11; error:=8; addk:=0
end
else if daction<0 then
begin comment predefined name,error;
state:=11; error:=6
end else
begin
if symtype(indexsym) extract 12=1 then
symtype(indexsym):=false add 2;
op:=1; arg:=0
end;
begin comment 26: in directive,expect . ;
if sym<>0 then
begin comment not . ;
state:=11; error:=8; addk:=0
end
else if daction>20 then
begin comment pass2-directive;
state:=6; op:=1; arg:=0;
if daction<>22 and daction<>23 then
begin comment not address constant;
output:=1; sym:=0;
class:=daction shift 6 add state2 shift 6 add 8
end
end else
if daction=13 then
begin comment message (m);
for isoclass:=readchar(in,iso) while iso<>10 do
write(out,false add iso,1);
write(out,nl,1);
state:=0
end
end 26;
begin comment 27: directive finished,
perform directive action and
output result,
each directive is described throug':
type (daction)
argument (arg) and error;
case daction of
begin comment pass-1 directives (1,20);
begin comment 1: datadirective,textend;
output:=1; class:=10; sym:=0
end 1;
comment 2: initialize load address;
if (arg<0 or coresize<=arg) and error=0
then error:=2
else begin
k:=symval(indexk):=arg; sym:=arg;
nooblocks:=nooblocks+1
end;
comment 3: initialize symbol;
if (arg<-8388607 or arg>8388607) and error=0
then error:=2
else begin
symval(indexsym):=arg;
sym:=0 + (extend indexsym) shift 24 add arg
end;
comment 4: initialize baseregister;
if (arg<0 or arg>=coresize) and error=0
then error:=2
else begin
b(symval(indexsym)):=arg;
sym:=0 + (extend indexsym) shift 24 add arg
end;
begin comment 5: repeat (r);
if (arg<1 or arg>=coresize-k) and error=0
then error:=12
else begin
sym:=arg-1; addk:=arg-1
end
end 5;
comment 6: conditional assembly (c);
if arg<0 then
begin
condtassem:=condtassem+1; state:=15
end;
begin comment 7: conditional assembly (z);
if condtassem>0 then
condtassem:=condtassem-1
else error:=13;
if condtassem>0 then state:=15
end 7;
comment 8: list (l);
if arg<0 then list:=list+1 ;
comment 9: list (u);
if list>0 then list:=list-1
else error:=14;
comment 10: normal input (n);
if -,normal then
begin
unstackcuri; normal:=true
end;
comment 11: typewriter input (t);
if normal and type then
begin
stackcuri; connectcuri(<:v:>); normal:=false;
write(out,<:<10>type :>);
outend(32)
end;
begin comment 12: datadirective,realnumber;
output:=1; class:=10; sym:=0
end 12;
comment 13: message ,see action 26;;
comment 14-20 unused;;;;;;;;
comment pass-2-directives(21-35);
comment 21: bytedirective (texas 980);;
comment 22: datadirective,address;;
comment 23: datadirective,indirect address;;
comment 24: double word constant;;
comment 25-35 unused;
end directive action;
comment output directive and separator;
if error>0 then
begin
sym:=error; output:=1; class:=9; error:=0
end
else if daction>1 and daction<6 or daction>12 then
begin
output:=1;
class:=daction shift 6 add state2 shift 6 add 8;
nextaction:=23
end;
comment update load address;
k:=symval(indexk):=k+addk;
addk:=daction:=0;
end 27;
begin comment 28: directive operand,name;
val:=4;
goto searchsymtab; comment 1;
end 28;
perform:
begin comment 29: directive operand,integer;
if op=4 and sym=0 then
begin comment division with zero;
error:=6; state:=11
end
else
arg:= case op of
(arg+sym,arg-sym,arg*sym,arg//sym,
arg shift sym,arg shift (-sym))
end 29;
comment 30: operator in directive expression;
op:=sym;
begin comment 31: directive syntax error;
output:=1; class:=9; sym:=8; addk:=daction:=0
end 31;
begin comment 32: operand syntax error;
output:=1; class:=9; sym:=4; addk:=daction:=0
end 32;
begin comment 33: end of skip,output error;
if error=0 then error:=7;
output:=1;
class:=9; sym:=error; error:=0;
k:=symval(indexk):=k+addk;
addk:=daction:=0
end 33;
begin comment 34: name during no assembly,
test for c or z;
daction:= if sym=c then 6
else if sym=z then 7
else 0;
state:= if sym=c then 9
else if sym=z then 8
else state;
addk:=0
end 34;
comment 35: illegal symbol;
error:=7;
begin comment 36: modif syntax error,
output modif part;
error:=10; mode:=0;
goto modifaction; comment 4;
end 36;
begin comment 37: output error;
output:=1; class:=9
end 37;
comment 38: operand syntaxerror;
error:=4;
begin comment 39: directive syntaxerror;
error:=8; addk:=0
end 39;
begin comment 40: end of sources;
outpass1:=true; output:=1; class:=10; sym:=0;
nextaction:=42
end 40;
begin comment 41: output name and sep;
daction:=22;
output:=1; class:=3; sym:=index;
nextaction:=23
end 41;
begin comment 42: output end of sources;
output:=1; class:=12
end 42;
end of pass 1 actions;
comment one or none symbols are output,
a symbol is described by class and sym;
if symno>128 then
begin
if blknr=mpasssize then
begin
integer i,j;
array mp(1:2);
generaten(mp);
cleararray(t);
mpasssize:= 2*mpasssize;
t(1):= mpasssize;
i:= 1;
if test<>0 then write(out,<:<10>pass area: :>,
string mp(increase(i)),<:<10>:>);
createentry(mp,t);
stackcuri;
close(zio,true);
connectcuri(mpass);
setposition(in,0,0);
i:= 1;
open(zio,4,string mp(increase(i)),0);
for i:= 1 step 1 until blknr do
begin
inrec(in,128);
outrec(zio,128);
for j:= 1 step 1 until 128 do zio(j):= in(j)
end;
unstackcuri;
if test=0 then removeentry(mpass);
for i:= 1,2 do mpass(i):= mp(i)
end;
blknr:=blknr+1;
outrec(zio,128);
symno:=1
end;
if output=1 and test shift(-3) extract 1>0 then
write(out,<:((:>,class,<:*:>,sym,<:)):>,nl,1);
if output=1 then
begin
zio(symno):= class;
zio(symno+1):= real sym;
symno:=symno+2;
output:=0; sym:=0
end;
comment more actions to be performed before the next
symbol is received;
if nextaction>0 then goto getsym;
comment pass-1 finished;
if outpass1 then goto pass2;
comment get next symbol;
goto getchar;
end pass 1;
pass2:;
comment output dangling data from pass1;
setposition(zio,0,0);
if current then
begin
if wordload(sca)=0 then stackcuri;
movebytes(sca,aa,8); movebytes(sna,sca,8); movebytes(aa,sna,8);
unstackcuri;
movebytes(sna,sca,8)
end else
unstackcuri;
begin comment define tabels and variabels to be used in pass2;
boolean array modif2tab(0:baseindex),
maskaddr,base(0:nooformats-1),
amf,adf(0:nooformats-1,0:maxaddrno),
tab3(1:120);
integer array arg,mode(1:maxaddrno),
b(1:max(1,noobase)),
maskvalue(0:nooformats-1),
r(1:4), o(1:48//wordlength+1);
real array block(1:128);
boolean illegopd,found,outpass2,sp,nl;
integer class,state,action,f,noowords,nooadr,noa,
modifparts,maxmode,code,wordsinbytes,
h,k,addk,op,error,lastword,
index,daction,start,val,i,byte,no;
long sym,word,wreal,wadr;
procedure errormessage;
begin comment the procedure writes out an errormessage
and sets the errorvariabel to zero;
write(out,nl,1,sp,3,<<-dddd>,<:***:>,k,sp,3,case error of
(<:text:>,<:operand size:>,<:double declaration:>,
<:operand:>,<:system:>,<:undefined:>,
<:garbage:>,<:directive:>,<:label:>,
<:modification:>,<:operands missing:>,
<:repeat:>,<:conditional:>,<:list:>,
<:load address:>,<:real:>));
error:=0
end errormessage;
comment read in data to assembler dependent tabels
used in pass2
and initialize other tabels used in pass2;
begin comment define workarrays;
integer array wmodif2tab(0:baseindex),
wmaskaddr,wbase(0:nooformats-1),
wamf,wadf(0:nooformats-1,0:maxaddrno);
read(in,wmodif2tab,wbase,wamf,wadf,
wmaskaddr,maskvalue);
for i:=0 step 1 until nooformats-1 do
begin
base(i):=false add wbase(i);
maskaddr(i):=false add wmaskaddr(i);
for j:=0 step 1 until maxaddrno do
begin
amf(i,j):=false add wamf(i,j);
adf(i,j):=false add wadf(i,j)
end
end;
for i:=0 step 1 until baseindex do
modif2tab(i):=false add wmodif2tab(i)
end initialization of assem dep tabels;
comment initialize state/action tabel;
for i:=1 step 1 until 120 do
tab3(i):=false add (case i of
(1,5,7,7,8,0,9,9,0,0,9,0,
5,2,5,5,5,5,5,5,5,0,5,0,
5,5,3,3,4,5,5,5,2,0,5,0,
5,5,5,5,4,5,5,5,3,0,5,0,
5,5,3,3,5,5,5,5,4,0,5,0,
5,5,5,5,5,5,5,5,0,0,5,0,
5,5,7,7,8,5,5,5,0,0,5,0,
5,5,5,5,8,5,5,5,0,0,5,0,
5,5,7,7,5,5,5,5,0,0,5,0,
5,5,5,5,5,5,5,5,0,0,5,0)
extract 6)
shift 6 add (case i of
(1,24,11,12,13,15,16,18,21,10,17,26,
24,2,24,24,24,24,24,24,24,24,24,26,
24,24,3,4,5,24,24,24,8,14,24,26,
24,24,9,9,6,24,24,24,8,7,24,26,
24,24,3,4,9,24,24,24,8,7,24,26,
10,10,10,10,10,10,10,10,21,20,10,26,
23,23,3,4,5,23,23,23,22,23,23,26,
23,23,23,23,6,23,23,23,22,19,23,26,
23,23,3,4,23,23,23,23,22,23,23,26,
19,19,19,19,19,19,19,19,22,19,19,26)
extract 6);
comment initialize variabels;
h:=k:=start:=symval(indexk):=0;
state:=error:=lastword:=0;
no:= 1; byte:= 0;
nooblocks:=1;
outpass2:=illegopd:=false;
sp:=false add 32;
nl:=false add 10;
wordsinbytes:=wordlength//12;
if wordsinbytes*12<>wordlength then
wordsinbytes:=wordsinbytes+1;
if wordsinbytes=3 then wordsinbytes:=4;
for i:=1 step 1 until noobase do b(i):=0;
comment connect in to result;
stackcuri;
if connectcuri(result)<>0 then alarm(<:object:>);
comment reserve the first 128 variables for blockinformation;
blknr:= 2;
setposition(in,0,1);
outrec(in,128);
comment a symbol is read in,
it is described by class- and char-value
(see getsym);
nextsym:
inrec(zio,2);
class:= zio(1);
sym:= long zio(2);
val:=state*12+(class extract 6);
i:=tab3(val) extract 12;
action:= i extract 6; state:= i shift (-6) extract 6;
if test shift (-4) extract 1>0 then
write(out,nl,1,<:((:>,class,<:/:>,
sym,<:)),(:>,state,<:,:>,action,<:):>);
case action of
begin
begin comment 1: start of operation,
initialize;
i:=opcode(sym);
f:= i extract 6;
code:= i shift (-6) extract 18;
for i:=1 step 1 until maxaddrno do mode(i):=arg(i):=0;
initoperation:
i:=formattab(f) extract 12;
modifparts:=i extract 4;
nooadr:=i shift (-4) extract 4;
noowords:=i shift (-8) extract 4;
addk:=noowords;
maxmode:=2**(amf(f,1) extract 6);
wadr:=0; noa:=0; op:=1;
comment update load address;
h:=k+addk;
if modifparts=0 then state:=2
end 1;
begin comment 2: modif part and format number;
modifparts:=modifparts-1;
mode(noa+1):=sym shift (-16) extract 24;
i:=sym extract 16;
if i<>f then
begin comment change format;
f:=i;
goto initoperation; comment 1;
end;
end 2;
begin comment 3: name in operand;
i:=symtype(sym) extract 12;
val:=if i<>8 then symval(sym) else b(symval(sym));
if i<3 then op:=7;
if i=5 and error=0 then error:=3;
compute:
if op=4 and val=0 then op:=7;
illegopd:=op=7;
wadr:=case op of
(wadr+val,wadr-val,wadr*val,wadr//val,
wadr shift val,wadr shift(-val),0)
end 3;
begin comment 4: integer in operand;
val:=sym extract 24; goto compute; comment 3;
end 4;
comment 5: sign start of operand;
op:=if sym>2 then 7 else sym;
comment 6: operator in operand;
op:=sym;
addresscalc:
begin comment 7: operand finished,
test the operand and if the
operation is finished output
the code;
case modif2tab(base(f) extract 12+maxmode*noa
+mode(noa+1)) extract 12
of
begin
begin comment 1: relative to h,8 bit,2-compl;
wadr:=wadr-h;
l1: if wadr>127 or wadr<-128 then goto fielderror
end 1;
begin comment 2: relative to basereg 1,8 bit,nonneg;
wadr:=wadr-b(1);
l2: if wadr>255 or wadr<0 then goto fielderror
end 2;
comment 3: absolut,8 bit,2-compl; goto l1;
comment 4: absolut,8 bit,nonneg; goto l2;
comment 5: empty;;
comment 6: absolut,5 bit,nonneg;
if wadr<0 or wadr>31 then goto fielderror;
comment 7: absolut,3 bit,nonneg;
if wadr<0 or wadr>7 then goto fielderror;
comment 8: absolut,4 bit,limited;
if wadr<0 or wadr>8 then goto fielderror;
comment 9: absolut,4 bit,nonneg;
if wadr<0 or wadr>15 then goto fielderror;
comment 10: absolut,memory address;
if wadr<0 or wadr>=coresize then goto fielderror;
comment 11: absolut,16 bit,nonneg;
if wadr<0 or wadr>65535 then goto fielderror;
comment 12: illegal address;
goto fielderror;
begin comment 13: absolut,3-bit,shifted 3;
if wadr<0 or wadr>7 then goto fielderror;
wadr:=wadr shift 3
end 13;
begin comment 14: absolut,3-bit,shifted -1,4;
if wadr<0 or wadr>7 then goto fielderror;
if wadr mod 2=1 then goto fielderror;
wadr:=(wadr shift (-1)) shift 4
end 14;
begin comment 15: absolut,1,2,shifted -1,4;
if wadr<>0 and wadr<>2 then goto fielderror;
wadr:=(wadr shift (-1)) shift 4
end 15;
begin comment 16: absolut,3-bit,shifted 1;
if wadr<0 or wadr>7 then goto fielderror;
wadr:=wadr shift 1
end 16;
begin comment 17: absolut,5-bit,shifted 1;
if wadr<8 or wadr>31 then goto fielderror;
wadr:= wadr shift 1
end 17;
begin comment 18: address for adr-macro (intel8008);
if wadr<0 or wadr>=coresize then goto fielderror;
i:=wadr;
wadr:= extend (i shift (-8) extract 8) shift 8
add 54 shift 8 add (i extract 8)
end 18;
begin comment 19: absolut,memory address for intel;
if wadr<0 or wadr>=coresize then goto fielderror;
i:=wadr;
wadr:=extend(i extract 8) shift 8
add (i shift(-8) extract 8)
end 19;
fielderror:
begin
if error=0 then error:=2; wadr:=0
end;
end addresscalculation;
noa:=noa+1;
arg(noa):=wadr;
wadr:=0; op:=1;
if illegopd and error=0 then error:=6;
illegopd:=false;
if noa<>nooadr then
begin comment calculate next operand;
state:=if modifparts=0 then 2 else 1;
goto nextsym
end
else begin comment the operation is finished,
code is output;
i:=maskaddr(f) extract 12;
comment an operand to be masked in is tested;
if i<>0 then
begin
if integerand(arg(i),maskvalue(f))<>0 then
begin
if error=0 then error:=2; arg(i):=0
end
end;
prepcodeword:
if test shift(-5) extract 1>0 then
write(out,nl,1,<:*:>,<<-ddddd>,f,code,mode(1),mode(2),
arg(1),arg(2),<:*:>,nl,1);
j:=opf(f) extract 12;
word:=0 + ((
extend code shift(48-(j extract 6))
shift(-48+(j extract 6)))
shift (j shift (-6) extract 6));
i:=0;
for i:=i+1 while i<=noa do
begin
j:= amf(f,i) extract 12;
word:=word + ((
extend mode(i) shift(48-(j extract 6))
shift(-48+(j extract 6)))
shift (j shift (-6) extract 6));
j:=adf(f,i) extract 12;
word:=word + ((
extend arg(i) shift(48-(j extract 6))
shift(-48+(j extract 6)))
shift (j shift (-6) extract 6));
end;
prepcode:;
comment prepare output of code;
for i:=1 step 1 until noowords do
o(i):=word shift (wordlength*i-48) extract wordlength;
outputcode:
for i:=1 step 1 until noowords do
begin
if byte=4 then
begin
if no>0 then
in(no):=case wordsinbytes of(
real <::> add r(1) shift 12 add r(2) shift 12
add r(3) shift 12 add r(4),
real <::> add r(2) shift 24 add r(4),
11,
r(4));
byte:=wordsinbytes; no:=no+1;
if no>128 then
begin
blknr:=blknr+1;
if blknr>resultlength then alarm(<:program too big:>);
outrec(in,128); no:=1
end;
end
else byte:=byte+wordsinbytes;
r(byte):=lastword:=o(i);
if test shift (-6) extract 1>0 then
write(out,<:*:>,sp,4,k,<:::>,sp,3,r(byte),nl,1);
end;
comment update load address;
if error<0 then error:=0;
if error>0 then errormessage;
if state<>0 then error:=5;
k:=symval(indexk):=h;
end
end 7;
begin comment 8: pass1 error in operand;
if error=0 then error:=sym;
comment not modification;
if sym<>10 then
begin
noa:=nooadr; state:=0;
goto prepcodeword; comment 7;
end;
end 8;
begin comment 9: no operand;
if nooadr>0 then
begin
wadr:=0; if error=0 then error:=4;
goto addresscalc; comment 7;
end
else goto prepcodeword; comment 7;
end 9;
comment 10: skip;;
begin comment 11 name start of address constant;
daction:=22; wadr:=0; op:=1;
i:=symtype(sym) extract 12;
val:=if i<>8 then symval(sym) else b(symval(sym));
if i<3 and error=0 then error:=6;
if i=5 and error=0 then error:=3;
goto compute; comment 3;
end 11;
begin comment 12: integer start of address constant;
daction:=22; wadr:=0; op:=1;
val:=sym;
goto compute; comment 3;
end 12;
begin comment 13: sign start of address constant;
daction:=22; wadr:=0;
op:=if sym>2 then 7 else sym
end 13;
begin comment 14: no operand;
if nooadr>0 then
begin comment operand missing;
if error=0 then error:=11; wadr:=0;
goto addresscalc; comment 7;
end else goto prepcodeword; comment 7;
end 14;
begin comment 15: datadirective text;
noowords:=textword; word:=sym;
h:=k+noowords;
goto prepcode; comment 7;
end 15;
begin comment 16: datadirective,textend;
daction:=1; error:=sym
end 16;
begin comment 17: datadirective,real number;
daction:=12; wreal:=sym
end 17;
begin comment 18: directive,
initialize state and action;
state:=class shift (-6) extract 6;
daction:=class shift (-12) extract 6;
wadr:=sym extract 24; op:=1;
index:=sym shift (-24) extract 24
end 18;
directiveaction:
begin comment 19: directive is finished,
perform action;
case daction of
begin comment pass 1 directives(1-20);
comment 1: datadirective,textend;;
begin comment 2: initialize load address;
if nooblocks>127 then
alarm(<:too many blocks:>);
nooblocks:=nooblocks+1;
block(nooblocks):= real <::> add start shift 24 add (h-1);
h:=k:=start:=symval(indexk):=wadr
end 2;
begin comment 3: initialize symbol;
symval(index):=wadr;
symtype(index):=false add 3
end 3;
begin comment 4: initialize baseregister;
b(symval(index)):=wadr; symtype(index):=false add 8
end 4;
begin comment 5: repeat;
for i:=1 step 1 until wadr do
begin
if byte=4 then
begin
if no>0 then
in(no):=case wordsinbytes of(
real <::> add r(1) shift 12 add r(2) shift 12
add r(3) shift 12 add r(4),
real <::> add r(2) shift 24 add r(4),
12,
r(4));
byte:=wordsinbytes; no:=no+1;
if no>128 then
begin
blknr:=blknr+1;
if blknr>resultlength then alarm(<:program too big:>);
outrec(in,128); no:=1
end
end
else byte:=byte+wordsinbytes;
r(byte):=lastword;
if test shift(-6) extract 1>0 then
write(out,<:*:>,sp,4,h+i-1,<:::>,sp,3,r(byte),nl,1)
end;
h:=symval(indexk):=k:=wadr+k
end 5;
comment 6,7,8,9,10,11: ;;;;;;;
begin comment 12: datadirective realnumber;
noowords:=realword;
h:=k+realword;
if wreal=long 1.6'616 then
begin
wreal:=0; error:=16
end;
word:=0 + (extend(wreal extract expoex) shift exposh)
+ (wreal shift (-48+fracex) shift fracsh);
goto prepcode; comment 7;
end 12;
comment 13-20 unused;;;;;;;;;
comment 21-23 pass 2 directives;
begin comment 21: byte-directive(texas 980);
noowords:=2;
h:=k+2;
o(1):=wadr shift(-15) extract 2;
o(2):=wadr extract 15;
if wadr<0 or wadr>=coresize*2 then
begin
if error=0 then error:=2; o(1):=o(2):=0
end;
goto outputcode; comment 7;
end 21;
begin comment 22: datadirective,address;
word:=0;
address:
noowords:=addressword;
word:=(word+wadr) shift (48-noowords*wordlength);
h:=k+noowords;
goto prepcode; comment 7;
end 22;
begin comment 23: datadirective,indirect address;
word:=indirect;
goto address; comment 22;
end 23;
begin comment 24: double word constant,dwc (intel 8080);
noowords:=2; h:=k+2;
if wadr<0 or wadr>65535 then
begin
if error=0 then error:=2; wadr:=0
end;
o(1):=wadr extract 8;
o(2):=wadr shift (-8) extract 8;
goto outputcode; comment 7;
end 24;
end directive action;
if error<0 then error:=0
end 19;
begin comment 20: separator after error;
if error=0 then
begin
h:=h-1;
error:=7; errormessage;
h:=h+1
end else error:=0
end 20;
begin comment 21: write error;
if error=0 then error:=sym; errormessage
end 21;
begin comment 22: error in directive;
if error=0 then error:=sym; errormessage;
error:=-1; wadr:=0; goto directiveaction; comment 19;
end 22;
begin comment 23: error in directive operand;
error:=4; wadr:=0;
goto directiveaction; comment 19;
end 23;
begin comment 24: system error;
error:=5;
errormessage
end 24;
comment 25: not used;;
comment 26: end of program;
outpass2:=true;
end of pass2 action;
if -,outpass2 then goto nextsym;
comment assembly is finished;
close(zio,true);
in(no):= case wordsinbytes of(
real <::> add r(1) shift 12 add r(2)
shift 12 add r(3) shift 12 add r(4),
real <::> add r(2) shift 24 add r(4),
13,
r(4));
setposition(in,0,0);
comment output the blockinformation in the first 128 realwords
in the resultarea;
outrec(in,128);
block(1):=nooblocks;
nooblocks:=nooblocks+1;
block(nooblocks):= real <::> add start shift 24 add (h-1);
for i:=1 step 1 until 128 do
in(i):=block(i);
setposition(in,0,1);
cleararray(t);
i:= (blknr-1)*512+no*4;
if wordlength=8 and pack then i:= (i-510)//3*2+512;
t(1):= (i+511)//512;
t(9):= (10+machine)shift 12;
t(10):= i;
if note then
begin
wordstore(noteadr+18,t(9));
wordstore(noteadr+20,t(10))
end;
comment information about blocks and symbols are output;
if blocks then
begin
write(out,<:<12>Load information::>,nl,1);
for i:=2 step 1 until block(1)+1 do
write(out,nl,1,block(i) shift (-24) extract 24,sp,3,
block(i) extract 24)
end;
if symbols then
begin
integer dist,i,k0,k,kmd;
integer nk,nkmd,svk;
boolean stk;
dist:= -1;
for dist:= dist shift(-1) while dist>0 do
if dist<noosym then
begin
for k0:= dist step 1 until noosym do
begin
nk:= symname(k0);
svk:= symval(k0);
stk:= symtype(k0);
k:= k0;
p: kmd:= k-dist;
if kmd>=0 then
begin
nkmd:= symname(kmd);
if nkmd>nk then
begin
symname(k):= nkmd;
symval(k):= symval(kmd);
symtype(k):= symtype(kmd);
k:= kmd;
goto p
end
end;
symname(k):= nk;
symval(k):= svk;
symtype(k):= stk
end
end;
write(out,<:<12>; Symbols used::>,nl,1);
for i:=1 step 1 until noosym do
begin
if symtype(i) extract 12<>0 then
begin
if symtype(i) extract 12=8 then
symval(i):=b(symval(i));
r(1):=r(2):=r(3):=r(4):=32;
h:=symname(i);
f:=5;
for f:=f-1 while f>0 and h<>0 do
begin
k:=h mod 40;
r(f):=if k<=10 then k+47 else k+86;
h:=h//40
end;
write(out,nl,1,false add r(1),1,false add r(2),1,
false add r(3),1,false add r(4),1,
<: = :>,<<-ddddddd>,symval(i),<: ; :>,
symtype(i) extract 12);
if test<>0 then write(out,<<ddddddd>,i)
end
end
end;
if pack and wordlength=8 then
begin
i:= 1;
open(zio,4,string result(increase(i)),0);
setposition(zio,0,1);
for k:=blknr step -1 until 2 do
for j:=1 step 1 until 128 do
begin
inrec(in,1);
for i:=-36 step 12 until 0 do
write(zio,false add (in(1) shift i extract 8),1);
end j;
close(zio,true);
setposition(in,0,0);
end wordlength=8;
changeentry(result,t)
end pass2
end both passes;
if test=0 then removeentry(mpass);
end
▶EOF◀