|
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: 6144 (0x1800)
Types: TextFile
Names: »retmont3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »retmont3tx «
mode list.yes
montest4tx=edit montest3tx
; connect output : segm < 2 + key
;
l./procedure dump;/, l./typeerror (s_text/, i/
begin
/, p1
l./init_pointers/, i/
dump_area := false; <*initpointers as for core*>
end;
/, p-2
l./procedure info;/,
l./internal all/, l1, i/
used
free
/, p-2
l./buf all/, l1, i/
used
free
/, p-2
l./external all/, l1, i/
used
free
kind.<kind>
/, p-3
l./area all/, l1, i/
used
free
kind.<kind>
/, p-3
l./ result := 2; <*1 < 1 : 1 segment, preferably drum*>/,
r/2/1 shift 2/, r/1 < 1/1 < 2/, r/preferably drum/temporary/, p1
l./procedure read_params(/,
l./<* specif/, d./8 - undefined/, i/
<* specif : 1 - user.<name>
2 - reserver.<name>
3 - name.<name>
4 - all
5 - devno.<integer>
6 - devno.<integer>.all
7 - main.<name>
8 - used
9 - free
10 - kind.<kind>
11 - undefined specification *>
/
l./specif:=8/, r/8/11/
l./if param(1) = real<:user/, i/
if param(1) = real<:used:> then specif := 8 else
if param(1) = real<:free:> then specif := 9 else
/, p-1
l1,l./specif:=8/, r/8/11/
l./specif:=8/, r/8/11/
l./else specif:=8/, r/8/11/
l./end read_params;/, l-2, i/
if param (1) = real <:kind:> then
begin
if nextparam (p_number) then
begin
devno := round param (1);
name (1) := param (1);
specif := 10;
end else
typeerror (anything, <:parameter error ::>, dummy);
end else
/, l1, p-3
l./procedure external;/, l./specif:= 4/, r/4/8/, r/all/used/
l1,l./specif < 8/, r/8/11/
l./<* main.<name> *>/, l2, i/
<* used *>
if contents.eprocname (1) shift (-40) extract 8 <> 0 then
type_external;
<* free *>
if contents.eprocname (1) shift (-40) extract 8 = 0 then
type_external;
<* kind.<kind> *>
if contents.eprocname (0) extract 24 = devno then
type_external;
/, p-3
l./<:not found : user.:>/, d2, i/
<:not found : user.:> , <:not found : reserver.:>,
<:not found : name.:> , <:not found : all:> ,
<:not found : devno.:>, <:not found : devno.:> ,
<:not found : main.:> , <:not found : used:> ,
<:not found : free:> , <:not found : kind.:>) , name);
/
l./procedure area_process;/,
l./addr, moves/, r/addr/addr, kind/
l./specif:= 4/, r/4/8/, r/all/used/
l./read_params(/, r/i);/kind);/
l./specif < 8/, r/8/11/
l./<* main *>/, l2, i/
<* used *>
if contents.eprocname (1) shift (-40) extract 8 <> 0 then
type_areaprocess;
<* free *>
if contents.eprocname (1) shift (-40) extract 8 = 0 then
type_areaprocess;
<* kind.<kind> *>
if contents.eprocname (0) extract 24 = kind then
type_areaprocess;
/, p-6
l./type_error (s_text,/, r/s_text/if specif <> 10 then s_text else s_number/
l./<:not found : user.:>/, d1, i/
<:not found : user.:> , <:not found : reserver.:>,
<:not found : name.:> , <:not found : all:> ,
<::> , <::> ,
<:not found : main.:> , <:not found : used:> ,
<:not found : free:> , <:not found : kind.:>) , name);
/
l./procedure buf;/, l./check := 6;/, r/6/8/
l./if param(1) = real<:sende:>/, i/
if param(1) = real<:used:> then check := 6 else
if param(1) = real<:free:> then check := 7 else
/, p-2
l./ok := false; <*param error*>/, i/
ok := true; <*used*>
ok := true; <*free*>
/, p-2
l./ok:= start_addr + addr >= buf_addr ;/, l1, i/
ok := contents.base (4) <> 0
or contents.base (5) <> 0;
ok := contents.base (4) = 0 and
contents.base (5) = 0 ;
/, p-5
l./type_error (s_text , <:not found/, d5, i/
type_error (s_text , <:not found : all:> , dummy );
type_error (s_text , <:not found : sender.:> , sender_name );
type_error (s_text , <:not found : receiver.:>, receiver_name);
type_error (s_text , <:not found : receiver.:>, receiver_name);
type_error (s_number, <:not found : addr.:> , param );
type_error (s_number, <:not found : addr.:> , param );
type_error (s_number, <:not found : used:> , param );
type_error (s_number, <:not found : free:> , param );
/
l./procedure internal;/, l./<:interrupt m/, r/interrupt m/(unused) /
l./boolean found,/, r/;/, type_used, type_free;/
l./type_all := true;/, r/true/type_free := false/, r/;/; type_used := true;/
l./if param (1) = real <:name/, i/
if param (1) = real <:used:> then
begin
type_all := type_free := false;
type_used := ok := true;
end else
if param (1) = real <:free:> then
begin
type_all := type_used := false;
type_free := ok := true;
end else
/, l1, p-2
l./type_all := false;/, r/false/type_used := type_free := false/
l./<* search internal proc descr *>/,
l./if type_all then type_descr/, d2, i/
if type_all then
typedescr
else
if type_used and contents.raf (1) shift (-40) extract 8 <> 0 then
typedescr
else
if type_free and contents.raf (1) shift (-40) extract 8 = 0 then
typedescr
else
if name (1) = contents.raf (1) and
name (2) = contents.raf (2) then
typedescr;
/, l1, p-12
f
end
▶EOF◀