|
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: 8448 (0x2100)
Types: TextFile
Names: »symslang3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »symslang3tx «
begin comment SYMBOLICLang preprocessor jh, LL, AW : 23.9.69
SLANG programs containing names (identifiers) starting with 2 letters
are transformed into SLANG a-names. Only the first 8 characters are
distinguished and ordinary SLANG names are preserved by no tran -
forming names in which the second character is a digit. Comments
following semicolon are removed.
Input from current input:
the number of the first allowed a-name,
the number of symbolic names (expected maximum)
name of file from which the symbolic program are read
mod, kind, and name of medium on which the ordinary program is wanted
e.g. 26 50 meaning begin with a26, reserve 150 names
tre even parity paper tape reader
object even parity magnetic tape mt123456 file 7
(if object = set mto mt123456 0 7)
Transput:
The symbolic SLANG program is read from the given input file and
the ordinary SLANG program is output on the wanted output file.
Output on current output:
A list of the connection between SLANG a-names and the corresponding
symbolic names provided the program is called with names.yes;
integer no, size ;
read(in, no, size) ;
size := 1.25 * size ;
begin comment inner block ;
integer class, tegn, string1, string2, start, state, count, i, j, k ;
boolean names;
real pack ;
integer array name1, name2, sno(0:size) , buf(1:9) , tail(1:20) ,
statetable, action(1:5,1:6) ;
real array ra(1:2) ;
zone sym, slang(256, 2, stderror) ;
procedure openzone (z);
zone z ;
begin
integer array tail (1:10);
long array name (1:2 );
long array field docname ;
integer field size, file ;
docname := size := 2; file := 14;
if readstring (in, name, 1) < 0 then
begin
name (2) := name (2) shift (-8) shift 8;
write (out,<:<10>***symslang, filename too long : :>, name);
goto finis;
end;
open (z, 0, name, 0); close (z, true);
if monitor (42, z, 0, tail) <> 0 then
begin
write (out, <:<10>***symslang, entry does not exist : :>, name);
goto finis;
end;
if tail.size >= 0 then
open (z, 4, name, 0)
else
begin <*file descriptor*>
open (z, tail.size, tail.docname, 0);
setposition (z, tail.file, 0);
end;
end procedure openzone;
names := false; i := 1;
for tegn := system (4, increase (i), ra) while tegn > 4 shift 12 do
begin
if tegn= 4 <*sp*> shift 12 add 10 <*text*> and
ra (1) = real <:names:> then
begin
tegn := system (4, increase (i), ra);
if tegn = 8 <*.*> shift 12 add 10 <*text*> and
ra (1) = real <:yes:> then
names := true;
end;
end;
comment open zones ;
openzone (sym );
openzone (slang);
write (out, <:<10>symbolic slang preassembler :>, <<dd dd dd>, 83 08 25);
getzone6 (out, tail);
if tail (1) extract 12 <> 4 <*bs*> and
tail (1) extract 12 <> 18 <*mt*> then
setposition (out, 0, 0);
comment statetable and action table:
class
state 1.letter 2.digit 3. : 4.semico 5. < 6.other
------------------------------------------------------------------------------
1.before name 2 init 1 1 copy 4 1 copy 4 1 outs 6 3 init 1 1 copy 4
2.one letter 4 more 2 1 outc 5 1 outc 5 1 outs 6 3 outc 5 1 outc 5
3.after < 2 outb 3 1 outc 5 1 text 8 1 outs 6 1 outc 5 1 outc 5
4.two letters 5 more 2 5 more 2 1 outc 5 1 outs 6 1 outc 5 1 outc 5
5.in name 5 more 2 5 more 2 1 test 7 1 test 7 1 test 7 1 test 7
;
for i := 1 step 1 until 5 do
for j := 1 step 1 until 6 do
begin
k := (i - 1) * 6 + j ;
statetable(i,j) := case k of (
2,1,1,1,3,1,
4,1,1,1,3,1,
2,1,1,1,1,1,
5,5,1,1,1,1,
5,5,1,1,1,1) ;
action(i,j) := case k of (
1,4,4,6,1,4,
2,5,5,6,5,5,
3,5,8,6,5,5,
2,2,5,6,5,5,
2,2,7,7,7,7) ;
end state and action table ;
state := 1 ;
count := 0 ;
comment initiate nametable ;
for i := 1 step 1 until size do name1(i) := name2(i) := sno(i) := 0 ;
character:
class := case readchar(sym,tegn) of (
6,
2,
6,
6,
6,
1,
if 58 <= tegn and tegn <=60 then tegn-55 else 6,
6) ;
case action (state,class) of
begin
INIT: begin comment 1.INIT ;
count := 1 ;
buf(1) := tegn ;
buf(9) := real<: :> ;
end INIT ;
begin comment 2.MORE
MORE; if count >= 8
then begin count := 9 ; buf(9) := 42 end star
else begin count := count + 1 ; buf(count) := tegn end
end MORE ;
begin comment 3.OUT , INIT ;
for i := 1 step 1 until count do write(slang,false add buf(i),1) ;
goto INIT
end ;
COPY: begin comment 4.COPY ;
write(slang,false add tegn, 1) ; count := 0
end COPY ;
begin comment 5. OUT,COPY ;
for i := 1 step 1 until count do write(slang,false add buf(i),1) ;
if count=1 and tegn=46 <* point *> and buf(1)=109 <* m *> then
goto SKIP; <* message-line *>
goto COPY
end OUT COPY ;
begin comment 6.SKIP ;
for i := 1 step 1 until count do write(slang,false add buf(i),1) ;
SKIP: for i := i, i while readchar(sym,tegn) <> 8 do
outchar(slang, tegn);
if tegn = 25 then goto exit ;
goto COPY
end OUT ,SKIP,COPY ;
begin comment 7.TEST (SKIP) COPY ;
pack := 0.0 shift (-12) ; comment 48 zero bits ;
for i := if count > 7 then 8 else count step -1 until 1 do
begin
k := buf(i) ;
k := if k > 96 then k - 39 else
if k > 64 then k - 7 else k ;
k := k - 47 ;
pack := pack shift 6 add k
end packing ;
string1 := pack extract 24 ;
string2 := pack shift (-24) extract 24 ;
start := abs string1 mod size ;
for i := start step 1 until size , 1 step 1 until start do
if name1(i) = 0 then goto NEW else
if name1(i) = string1 then
begin if name2(i) = string2 then goto SLANG end ;
write(out , <: name table full :>) ;
goto exit ;
NEW: name1(i) := string1 ;
name2(i) := string2 ;
sno (i) := no ;
no := no + 1 ;
if names then
begin
write (out, <:
a:>, <<ddd>, sno(i), <: :>) ;
for j := 1 step 1 until count do
write(out, false add buf(j), 1) ;
end;
SLANG: i := write(slang, <:a:>, <<zdd>, sno(i)) ;
for i := count - i step -1 until 1 do
outchar(slang, 32);
goto if tegn = 59 then SKIP else COPY
end TEST ,(SKIP), COPY ;
begin comment 8. TEXT ; boolean colon ;
write(slang, <:<60><58>:>) ; comment write <: ;
colon := false ;
TEXT: readchar(sym, tegn) ; if tegn = 25 then goto exit ;
write(slang, false add tegn, 1) ;
if -, colon then
NOEND: begin
colon := tegn = 58 ;
goto TEXT
end ;
if tegn <> 62 then goto NOEND
end TEXT ;
end actions ;
state := statetable(state, class) ;
if tegn <> 25 then goto character ;
exit:
write(slang, <:<25>:>) ; comment END MEDIUM ;
close(sym, true) ;
close(slang, true) ;
getzone6(slang, tail);
if tail(1) = 4 then
begin comment change entry for backing storage areas;
system(5, 108) get clock :(ra);
tail(1) := tail(9); <* size := segment count *>
for i := 2 step 1 until 10 do tail(i) := 0;
tail(6) := ra(1) shift (-19) extract 24; <* shortclock *>
monitor(44) change entry :(slang, 0, tail);
end;
write (out, <:<10>end symbolic slang preassembler:>);
finis:
end inner block
end\f
▶EOF◀