|
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: 12937 (0x3289)
Description: Bits:30009221 tre - sæt ny dumpprogram i 't' med 'tre'
Types: 8-hole paper tape, TextFileEvenParity
; THIS FILE M U S T BE EXECUTED FROM BACKING STORAGE lhø -9-1974
(t=set 17
if ok.yes
t=copy 25.1
if ok.yes
message dump system ligger nu på t
if ok.no
(end
end
end
message sorry sorry sorry
clean 0)
end)
mode list.no
o lp
if ok.no
(end
end
end
o c
clean 0)
head 1
copy 59.1
FORBERED BRUGERDUMP :
;
t=set 40 ; to see if there is room for workfiles
if ok.yes
u=set 42
if ok.no
(head 1
skip 59.1
copy 59.1
end
end
end
o c
clean 0)
skip 59.2
;
*** dump SÆT ARB. AREAL MISLYKKET , prøv igen
;
t=set 25 ; final size
if 0.no
r=set mto docdump ; note the possibilities
mode 0.no
t=copy message.no 59.1 ; prepare error
*** dump : oversættelse af fp-generator mislykket , give up
;
(u=algol
if ok.no
(i t
copy 25.1
end
end
end
end
o c
clean 0)
)
begin
integer array ia(1:10),ia2,ia1(1:20) ;
boolean error ;
integer i,j,k,m,n,entries,areas,segments,item,tegn ;
real hr,hr2 ;
real array field rf ;
real array ra(1:3) ;
zone waz(128,1,stderror), hz(128,1,stderror) ;
rf:= 2 ; open(waz,4,<::>,0) ; ia(1):= 7 ; for i:= 2 step 1 until 10 do ia(i):= 0 ;
i:=monitor(40,waz,0,ia) ; comment waz holder en intern navneliste ;
if i<> 0 then
begin
createerror:
write(out,<:<10><10> ***dump SÆT ARB. AREAL RESULTAT :>,i,<: , prøv igen:>) ;
SORRY:
system(9,0,<:<10>sorry :>) ;
end ;
open(hz,0,<::>,0) ; ia(1):= 11 ;
i:=monitor(40,hz,0,ia) ; comment arbejdszone , arealet indeholder senere
fil med genindlæsnings- fp-fil ;
if i<> 0 then goto createerror ;
getzone(hz,ia1) ; getzone(hz,ia2) ; j:= 1 ; close(hz,false) ;
comment begynd at skrive fp-fil for egl. dump på 'out' ;
write(out,<:<10>head 1<10>copy 59.1<10><10>EGL. DUMP BEGYNDER : output er<10>;:>
,<:<10>lookup r<10>copy 59.1<10><10>;:>
,<:<10>r=copy message.no :>,string ia1.rf(increase(j))
,<:<10>if ok.no<10>(skip 59.1<10>copy 59.1<10>end<10>end<10>end<10>o c<10>clean 0)<10>skip 59.2:>
,<:<10>;<10><10>***dump output fejl i genindlæsnings fil<10><10>;:>) ;
j:= 1 ;
write(out,<:<10><10>clear :>,string ia1.rf(increase(j))
,<:<10><10>nextfile r ;!<10><10><10><10>r=binout , alle 'entries' i dump liste:>) ;
comment indlæs navneliste , gem den i waz-s areal , og dan samtidig en binout kommando
der dumper BESKRIVELSERNE af områderne . ;
k:= 44 ; error:= false ; item:= 999 ; areas:=entries:=segments:=m:= 0 ;
læs:
if k = 25 or k = 10 then goto del2 ;
if k <> 44 then
begin
FEJL:
if m = 0 then
begin
write(out,<:,<10>,<10>, *** dump liste syntax , tegn ::>,false add k,1
,<:: <60>:>,k) ;
hr:= real <:<62> efter ::> ;
j:=m:= 1 ; goto PF ;
end ;
end ;
for i:= readchar(in,k) while i > 6 do
if k = 25 then goto del2 else
if k <> 12 and k <> 10 and k <> 32 then goto FEJL ;
ra(2):=ra(3):= real<::> ; m:= 0 ; repeatchar(in) ;
readstring(in,ra,1) ; repeatchar(in) ; n:= readchar(in,k) ;
if n < 7 then
begin
for n:= readchar(in,j) while n < 7 do ; repeatchar(in) ;
end ;
hr:= ra(1) ; hr2:= ra(2) ; ra(3):= ra(3) shift(-8)shift 8 ;
if hr = real<::> or hr2 extract 8 <> 0 then
begin
FEJL1:
hr:= real <:,<10>,<10>, ***dump navne format ::> ;
goto PF ;
end ;
if hr shift(-24) = real <:wrk:> shift(-24) or hr = real <:r:> or hr = real <:s:> or
hr = real <:t:> or hr = real <:u:> or hr = real <:v:> or hr = real <:c:> then
begin
hr:= real <:,<10>,<10>, ***dump worknames og noter ikke tilladt ::> ;
goto PF ;
end ;
j:= 1 ;
ia2.rf(1):= hr ; ia2.rf(2):= hr2 ; setzone(hz,ia2) ; comment pseudo-open ;
j:= monitor(42,hz,0,ia) ;
if j=2 then
begin
hr:= real <:<10><10> ***dump CATALOG I/O ERROR:> ;
goto PF ;
end else
if j=6 then goto FEJL1 ;
if j= 3 then
begin
hr:= real <:,<10>,<10>, ***dump katalogindgang eksisterer ikke ::> ;
if false then
PF: error:= true ;
i:= 1 ;
write(out,string hr,string ra(increase(i)),<::<10>,:>) ;
item:= 999 ;
goto if j = 2 then SORRY else læs ;
end ;
comment pad navn til 11 tegn med spac ;
tegn:= hr extract 8 ;
if tegn = 0 then
begin
hr2:= real <:_ _ _:> ; tegn:= 32 ; i:= 0 ;
for i:= i - 8 while hr shift i extract 8 = 0 do ;
hr:= real ( long hr + long <:_ _ _:> shift(-48 - i) ) ;
end
else
begin
i:= - 48 ;
for i:= i + 8 while hr2 shift i extract 8 <> 0 do ;
hr2:= real ( long hr2 + long <:_ _ _:> shift(-48 - i)shift 8 ) ;
end ;
i:= ia(1) ; entries:= entries + 1 ;
write(out,if item < 4 then <:_ :> else <:,<10>:>,string hr shift(-8)shift 8,false add tegn,1
,string hr2,<:.np:>) ;
item:= if item < 4 then item + 1 else 0 ;
if i > 0 then
begin
outrec(waz,2) ; waz(1):= hr ; waz(2):=hr2 ;
areas:= areas + 1 ; segments:= segments + i ;
end ;
goto læs ;
del2: ; comment terminate reading phase ;
write(out,if error then <:<10><10>;*** dump ADVARSEL : fejl i dump liste:> else <::>
,<:<10><10>; dumpede entries = :>,<<ddddd>,entries
,<:<10><10>; dumpede arealer = :>,areas
,<:<10><10>; dumpede segmenter = :>,segments
,<:<10><10>; båndlængde krævet ca.= :>,((256*3/800+.6/4)/12*1.01) * (segments + areas) + 10
,<: (fod ved 800 bpi.):>
,<:<10>;!<10>if ok.no<10>(skip 59.1<10>copy 59.1<10>end<10>end<10>end<10>o c<10>clean 0)<10>skip 59.2:>
,<:<10>;<10><10>*** dump output fejl in binout af katalogindgange<10><10>;:>) ;
outrec(waz,2) ; waz(1):= real<::> ;
setposition(waz,0,0) ; comment set end-marker and terminate internal namelist ;
comment create call of move program ;
write(out,<:<10><10>nextfile r<10>r=copy message.no 1<10>;!<10><10><10><10>u r , moving of areas :>) ;
comment r is formally input descriptor , but is used to describe output , to cheat fp ;
item:= 999 ;
for j:=inrec(waz,2) while waz(1)<> real<::> do
begin
j:= 1 ;
write(out,if item < 4 then <:_ _ _:> else <:,<10>:>,string waz(increase(j))) ;
item:= if item < 4 then item + 1 else 0 ;
end ;
write(out,<:<10>;!<10>if ok.no<10>(skip 59.1<10>copy 59.1<10>end<10>end<10>end<10>o c<10>clean 0)<10>skip 59.2:>
,<:<10>;<10><10>*** dump output fejl i kopiering af arealer<10><10>;:>
,<:<10><10>copy 59.1<10><10>:>
,if error then <:*** dump ADVARSEL : dump liste havde fejl<10>:> else <::>
,if error then <:_ _ _ _ de dumpede arealer er måske ikke de ønskede <33><10><10>:> else <::>
,<:DUMP KORREKT AFSLUTTET.<10><10>;:>
,<:<10><10>head<10>head 3<10>o c<10>(end<10>clear r u t)<10><10>:>) ;
comment fp-file generated , now generate fp -file to read in the dump ;
setposition(waz,0,0) ; close(hz,false) ; j:= 1 ;
open(hz,4,string ia1.rf(increase(j)),0) ;
write(hz ,<:<10><10>o lp<10><10>head 1<10><10>copy 59.1<10><10><10>:>
,<:GENINDLÆSNING FORBEREDES :<10><10><10>;<10><10>:>
,<:t=set 10 ; for at sikre arbejdsarealer<10>if ok.yes<10>u=set 18<10>:>
,<:if ok.no<10>(skip 59.1<10> copy 59.1<10> end<10> end<10> end<10> o c<10>:>
,<: clean 0)<10><10>skip 59.2<10><10>;<10><10>:>
,<:*** genindlæs SÆT ARBEJDSAREAL MISLYKKET , prøv igen<10><10><10>;<10><10>:>
,<:t=set 1 ; endelig lgd.<10><10>t=copy message.no 59.1<10><10><10>:>
,<:*** genindlæs : oversættelse af kopierings program mislykket , opgiv<10><10>:>
,<:;<10><10>(u=algol<10> if ok.no<10> (i t<10> copy 25.1<10> end<10>:>
,<: end<10> end<10> end<10> o c<10> clean 0)<10> )<10><10> <10><10>:>
,<:begin<10>zone zi(128*4*2,2,stderror),zu(128*2,2,stderror) ;<10>:>
,<:integer array ia(1:20) ;<10>real array field raf ;<10>:>
,<:integer i,sys,parno,blgd ;<10><10>:>
,<:getzone(in,ia) ; raf:= 2 ; i:= 1 ; open(zi,18,string ia.raf(increase(i)),0) ;<10>:>
,<:setposition(zi,ia(7),0) ; parno:= 2 ;<10><10>:>
,<:for sys:= system(4,parno,ia.raf) while sys <60><62> 0 do<10>:>
,<: begin comment for parameter (område) ;<10><10>:>
,<: i:= 1 ; close(zu,true) ; parno:= parno + 1 ;<10>:>
,<: open(zu,4,string ia.raf(increase(i)),0) ;<10><10>:>
,<: for blgd:= inrec(zi,0) while blgd <62> 0 do<10>:>
,<: begin comment for blok i fil ;<10><10>:>
,<: if blgd <62> 128 then blgd:= 128 ; inrec(zi,blgd) ; <10>:>
,<: if blgd <> 128 then stderror(zi,3,blgd shift 2) ; <10>:>
,<: outrec(zu,blgd) ; tofrom(zu,zi,blgd shift 2) ;<10><10>:>
,<: outrec(zu,0) ; comment skyd blok af straks ;<10><10>:>
,<: end move fil ;<10><10> end filer ;<10><10>:>
,<:close(zi,true) ; close(zu,true) ;<10>:>
,<:end ; :<62> end ; end ; end ; end<10><10>; gem fejltekster <10><10>:>
,<:t=copy message.no 59.1<10><10><10>:>
,<:*** genindlæs input fejl i binin af katalogindgange<10><10><10><10><10>!<10>:>
,<:<10><10>*** genindindlæs input fejl i kopiering af arealer<10><10><10>!<10>:>
,<:<10><10>GENINDLÆSNING KORREKT AFSLUTTET.<10><10>!<10>;<10><10>:>
,<:; udførelsesfasen begynder , da andre filer end den , dette læses fra,<10>:>
,<:; benyttes , er resten e n sammensat kommando<10><10>head<10><10>:>
,<:copy 59.1<10><10><10>EGL. GENINDLÆSNING BEGYNDER :<10><10><10>;<10><10>:>
,<:(end<10> mode 0.no<10> nextfile s<10> binin s<10> if ok.no<10> (i t<10>:>
,<: copy 33.1<10> mode 0.yes)<10> nextfile s<10> if 0.no<10>:>
,<: u s , move program<10>:>
) ;
item:= 999 ;
for j:=inrec(waz,2) while waz(1)<> real <::> do
begin
j:= 1 ;
write(hz,if item < 4 then <:_ _ _:> else <:,<10>:>,string waz(increase(j))) ;
item:= if item < 4 then item + 1 else 0 ;
end ;
write(hz,<:<10><10> if ok.no<10> (i t<10> skip 33.1<10> copy 33.1<10> mode 0.yes):>
,<:<10> if 0.no<10> (i t<10> skip 33.2<10> copy 33.1<10> end<10> head:>
,<:<10> head 3<10> o c<10> end<10> s=set<10> clear t u):>
,<:<10> if 0.yes<10> (end<10> end<10> end<10> end<10> o c<10> clean 0):>
,<:<10> )<10><25>:>) ;
close(hz,true) ; close(waz,true) ; monitor (48,waz,0,ia) ;
comment internal namelist area cleared , the fp-file clears all other areas used ;
write(out,<:<25>:>) ; comment først her p.g.a. algol alarmer ;
end ; :> end ; end ; end ; end ;
; generering af fp-fil
head
(o t
u s ; run generating program
if ok.yes
(o lp
clear u)
if ok.no
(o lp
i t
copy 25.1 ; for diagnosis : print what was generated
end
skip 59.1
copy 59.1
end
end
end
o c
mode 0.no
clean 0)
)
skip 59.2
;
*** dump : fp-fil kunne ikke genereres , giv op
;
; generer move program
s=set 1
s=copy message.no 59.1
*** dump : oversættelse af kopieringsprogram mislykket , giv op
;
head
(u=algol
if ok.no
(end
end
end
i s
copy 25.1
end
o c
clean 0)
)
begin
zone zi(128*4,1,stderror),zu(128*4*2,2,stderror) ;
integer array ia(1:20) ;
real array field raf ;
integer i,sys,parno,blgd,filno ;
getzone(in,ia) ; raf:= 2 ; i:= 1 ; open(zu,18,string ia.raf(increase(i)),0) ;
filno:= ia(7) ; parno:= 2 ;
for sys:= system(4,parno,ia.raf) while sys <> 0 do
begin comment for parameter (område) ;
i:= 1 ; close(zi,true) ; parno:= parno + 1 ;
open(zi,4,string ia.raf(increase(i)),0) ; inrec(zi,0) ; comment start indlæsning ;
setposition(zu,filno,0) ; filno:= filno + 1 ;
for blgd:= inrec(zi,0) while blgd > 0 do
begin comment for blok i fil ;
inrec(zi,blgd) ; outrec(zu,blgd) ;
tofrom(zu,zi,blgd shift 2) ;
i:= outrec(zu,0) ; comment skyd blok af straks ;
end move fil ;
if i <> (128*4) then outrec(zu,i+1) ; changerec(zu,0) ; comment pres ;
end filer ;
for i:= 1 step 1 until 5 do
begin
setposition(zu,filno,0) ; filno:= filno + 1 ; outrec(zu,0) ;
end ;
close(zi,true) ; close(zu,true) ;
end ; :> end ; end ; end ; end
clear s
head
; write the fp file
(i t
skip 33.1
copy 33.1
skip 33.1
copy 33.1
end)
; execute the fp-file ie. the dump proper
(end
i t
)
opiering af arealer<10><10><10>!<10>:>
▶EOF◀