|
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: 180480 (0x2c100)
Types: TextFile
Names: »retuti4 «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »retuti4 «
job fgs 1 274001 temp disc 1000 100 time 20 0 stat 2
mode list.yes
; editering af fp utility texter
;
; magtapes :
;
;
; mt543053 : - 1.01, vers 2
; mt543331 : - 2.00, vers 2
; mt543285 : - 3.00, vers 2
; mt543020 : - 5.00, vers 2
;
; magtape :
;
; mt295276 : release 3.00, vers 2
;
; slettes og bliver kopi af :
;
; mt543020 : release 5.00, vers 2
;
head 1
message ret fp utility texter
message rettelse fra mt543285 til mt543020 1989.08.01
;
n=set nrz mt543020
g=set mto mt543285
opmess ring on mt543020
mount n
opmess no ring mt543285
mount g
message subpackage ident fil 1
nextfile n g
n=copy list.yes 7
tape identification
contents : source code
package number : sw8010/2
package name : system utility
release : 5.00, 1989.08.01
subpackage name : utility
release : 5.00, 1989.08.01
\f
message translate job fil 2
nextfile n g
n=edit
m e
i#
; job til oversættelse af fp og utilities
char ff
term =set tw terminal d.0
utilities=edit
i/
xp,
utility,
account,
assign,
backfile,
base,
binin,
binout,
bossjob,
cat,
catsort,
change,
changeentry,
char,
claim,
claimtest,
clear,
clearmt,
compresslib,
convert,
copy,
corelock,
coreopen,
correct,
,crb,
,crc,
,crd,
delete,
edit,
enable,
end,
entry,
finis,
fpnames,
head,
,headpunch,
i,
if,
incload,
incsave,
init,
job,
kit,
label,
load,
load13,
lookup,
,lp,
message,
mode,
mount,
mountspec,
move,
newjob,
nextfile,
o,
online,
opcomm,
opmess,
permanent,
,pl,
print,
,ptre,
,ptrf,
,ptro,
,ptrn,
,ptrz,
procsurvey,
release,
rename,
repeat,
replace,
rewind,
ring,
rubout,
save,
save13,
scope,
search,
set,
setmt,
skip,
suspend,
term,
timer,
,tpe,
,tpf,
,tpn,
,tpo,
,tpt,
translated,
,tre,
,trf,
,trn,
,tro,
,trz
unload
/,f
utiareas=edit
i/
xp,
account,
backfile,
base,
binin,
binout,
catsort,
claim,
claimtest,
compresslib,
copy,
correct,
edit,
,headpunch,
i,
job,
label,
load,
load13,
lookup,
message,
mode,
move,
online,
print,
procsurvey,
rewind,
rubout,
save,
save13,
translated,
set,
/
f
compressuti=edit
i/
utility=set 1 3
utility=compress,
fpnames,
account,
backfile,
base,
binin,
binout,
claim,
compresslib,
copy,
correct,
edit,
,headpunch,
i,
job,
label,
lookup,
message,
mode,
move,
online,
print,
procsurvey,
rewind,
rubout,
translated,
set
/
f
scopeuti=edit utilities
i/
scope user,
/
f
lookuputi=edit utilities
i/
head 1
lookup,
/,f
clearuti=edit utilities
i/
clear user,
/, f
binoututi=edit utilities
l./xp/,d,
i/
init=changeentry init fp init init init init init
sys2=binout headfp.ne.b xp.ne.s.12,
/,
l./utility/,r/y/y.p/,
l b, l-1, r/set/set,
endfp.ne.b
/,f
headfp=slang
s.w.
<:newcat:>
<:create:>
<:fp:>,0,0,0
21
0, r.4
s2 ; shortclock
0
0
3<12+2
3584
<:perman:>
<:fp:>,0,0,0
3
<:load:>
<:fp:>,0,0,0
12
e.
endfp=slang
s.w.
<:end:>
e.
c=message oversæt slang del af utility
sorry=algol
begin
trapmode := 1 shift 10;
write (out,
"nl", 2, <:***********************************************:>,
"nl", 1, <:* *:>,
"nl", 1, <:* *:>,
"nl", 1, <:* *:>,
"nl", 1, <:* *:>,
"nl", 1, <:* *:>,
"nl", 1, <:* S O R R Y *:>,
"nl", 1, <:* *:>,
"nl", 1, <:* *:>,
"nl", 1, <:* *:>,
"nl", 1, <:* *:>,
"nl", 1, <:* *:>,
"nl", 1, <:***********************************************:>);
endaction := -1;
end;
c=copy uti1 message.no ; dato
fpnames=copy uti3 ; new fpnames
insertproc=copy uti4
slangcompr=slang uti.5
if ok.no
sorry
fpnames=slangcompr fpnames
if ok.no
sorry
insertproc=slangcompr insertproc
if ok.no
sorry
;i trfp5tx
(xp=slang uti.6
xp init)
if ok.no
sorry
;i trmode5tx
(mode=slang uti.9
mode head char finis end)
if ok.no
sorry
;i tri4tx
(i=slang uti.10
i o if)
if ok.no
sorry
;i tropmess4tx
(account = slang uti.11
account replace newjob mount opmess ring ,
suspend release enable change timer convert,
mountspec kit corelock coreopen bossjob opcomm)
if ok.no
sorry
(online=slang uti.12
online repeat)
if ok.no
sorry
;i tredit4tx
(edit=slang uti.13 uti.14 uti.15 uti.16
edit)
if ok.no
sorry
;i trbinin4tx
(binin=slang uti.17
binin)
if ok.no
sorry
;i trbinout4tx
(binout=slang uti.18
binout)
if ok.no
sorry
;i trprint4tx
(print=slang uti.19
print)
if ok.no
sorry
;i trmess4tx
(message=slang uti.20
message)
if ok.no
sorry
;i trmove5tx
(move=slang uti.21
move)
if ok.no
sorry
;i trset5tx
(set=slang uti.22
set setmt clearmt entry changeentry assign rename permanent nextfile)
if ok.no
sorry
;i trlookup4tx
(lookup=slang uti.23
lookup search clear delete scope)
if ok.no
sorry
(backfile=slang uti.24
backfile)
if ok.no
sorry
;i trcopy4tx
(copy=slang uti.25
copy skip)
if ok.no
sorry
;i trbase4tx
(base=slang uti.26
base)
if ok.no
sorry
;i trjob4tx
(job=slang uti.27
job)
if ok.no
sorry
;i trclaim4tx
(claim=slang uti.28
claim)
if ok.no
sorry
(rubout=slang uti.29
rubout)
if ok.no
sorry
(correct=slang uti.30
correct)
if ok.no
sorry
;i trcompr4tx
(compress=slang uti.31
compress)
if ok.no
sorry
;i trcomprl4tx
compresslib=slang uti.32
if ok.no
sorry
;i trtransl4tx
(translated=slang uti.33
translated)
if ok.no
sorry
;i trprocsu5tx
(procsurvey=slang uti.34
procsurvey)
if ok.no
sorry
;i trlabel4tx
(label=slang uti.35
label)
if ok.no
sorry
;i trrewind4tx
(rewind=slang uti.36
rewind unload)
if ok.no
sorry
c=message slut over sættelse af slang del af utility
char ff
c=message oversæt algol del af utility
;i trsave134tx
(allocbuf=slang uti.37
allocbuf)
if ok.no
sorry
save13=algol connect.no survey.yes uti.38
if warning.yes
sorry
;i trload134tx
load13=algol connect.no survey.yes uti.39
if warning.yes
sorry
;i trcats4tx
catsort=algol connect.no survey.yes uti.40
if ok.no
sorry
catsort=changeentry catsort catsort catsort 64.120 catsort catsort catsort
cat =assign catsort
;i trcltst4tx
claimtest=algol connect.no survey.yes uti.41
if warning.yes
sorry
;i trsave4tx
(copyarea=slang uti.42
copyarea)
if ok.no
sorry
save=algol connect.no message.no uti.43
if warning.yes
sorry
save =changeentry save save save 3 save save save
incsave=assign save
;i trload4tx
load=algol connect.no message.no survey.yes uti.44
if warning.yes
sorry
load =changeentry load load load 0 load load load
incload=assign load
c=message slut over sættelse af algol del af utility
char 12
i compressuti
i scopeuti
i lookuputi
release uti
c=message slut oversætjob
char ff
end
#
f
message fpnames fil 3
nextfile n g
n=edit g; new fpnames
; h53 = 18
l./h53/, r/16/18/
f
message insertproc fil 4
nextfile n g
n=edit g
f
message slangcompr fil 5
nextfile n g
n=edit g
; connect output : segm < 2 + key
l./h28./, l-1, r/1<1+1/1<2+0/
f
message fp text fil 6
nextfile n g
fp4tx=edit g
; rettelser til release 4.0
;
; iso 95 = _ rettes tilbage til blind fra illegal
;
; alle store bogstaver gøres legale
;
; extend area i simple check sender parent message hvis claims exceeded
; med wait bit undtagen hvis fp mode bswait (1<10) er false
;
; connect output, docname = 0, 1, 2, 3 => permkey
;
; h53=18 i stedet for h53=16
;
; fyldtegn for positivt fortegn i integer i list command i load ændres
; til 0 i stedet for 127
;
; i connect input/connect output trunceres process kind før indsættelse i zone
;
; connect output : segm = 0 => der skal ikke creeres en fil hvis ingen er
;
; connect output, magtape, after setmode ignoreres svaret (ingen enable)
;
; block io, magtape wait transfer : position fra devicet overføres til zonen
;
; magtape check, reposition indtil 5 gange i tilfælde af position error
; og erase and retry op til 15 gange
l./page ...1/, r/86.08.22/89.01.25/
l./c43/, r/c43/c50/
l./m.file processor/, r/86.10.10/89.01.25/
l./m.fp text 1/, r/86.12.12/89.01.25/
l./page ...2/, r/86.08.27/88.04.24/
l./w2 =/, r/= /= /, p1
l./page ...3b/, r/82.12.09/88.05.19/
l./h52:/, r/3<12/4<12/
l1, i/
h53 = 18 ; no of halfwords in available area in front of zone buffers
/, p-1
l./page ...4/, r/82.12.09/88.05.19/
l./h53=/, d
l./page ...6/,
l./m.fp permanent/, r/85.03.26/89.01.25/
l./block io, page ...2/, r/rc 19.05.72 /fgs 1989.01.25/
l./e18:/, i/
e23: 1<7 ; word defect bit
/, p1
l./block io, page ...3/, r/86.12.12/89.01.25/
l./dl. w1 c24./, d./ld w2 24/, i#
dl. w1 c24. ; magnetic tape status bits:
ld w2 -23 ; if bytes transferred > 0 then
se w0 0 ; begin
wd w2 0 ; if number of characters * 2
se w1 0 ; modulo bytes transferred <> 0
lo. w3 e23. ; then status:=status or word defect bit;
rl. w2 c1. ; end;
sz. w3 (c44.) ; if status.tape mark sensed = 1 then
jl. e30. ; goto skip;
wa w0 6 ; if hwds xferred <> 0 or status <> 0 then
sn w0 0 ; begin <*update pos in zone by pos in answer*>
jl. e30. ; zone.file, block :=
dl. w1 c28. ; answ.file, block;
ds w1 x2+h1+14 ; end;
e30: ld w2 24 ; index := 0 again;
#
l./character io, page ...2/, r/26.03.73/88.04.24/
l./h33:/,
l1, r!console!terminal/console and!
l1, r/or / /, r/punch/punch and/
l1, r/or / /, r/printer/printer and/
l1, r/or / /
l./page ...4/,
l./m.fp io system/, r/86.12.12/89.01.27/
l./resident, page ...1/, r/86.12.12/89.01.25/
;l./h40:/, r/fp/fp5/
l./h85:/, d, r/ /h85:/, i/
/
l./; am 0/, d, i/
/
l./resident, page ...4/, r/rc 11.04.72 /fgs 1989.01.26/
l./h82:/, l2, i/
c44: 1<16 ; tape mark sensed
/, p1
l./simple check, page ...1/, r/84.09.04/88.04.24/
l./e17:/, l1, i#
; working locations:
; fnc area:
e42: 44<12+2.0000011<5+1; fnc<12+pattern<5+wait
<:bs :> ; <:bs :>
0, r.4 ; docname of area process
0 ; segments
0 ; 0 entries
e47: 0 ; area process descr.
e48: 0, r.10 ; tail
\f
; fgs 1988.04.24 fileprocessor simple check, page ...2...
#, p-12
l./simple check, page ...1a/, d./e47:/, i#
\f
; fgs 1988.04.24 fileprocessor simple check, page ...3...
e32: jd 1<11+8 ; reserve: reserve process;
se w0 0 ; if not reserved
jl. e1. ; then goto give up;
jl. e10. ; goto repeat;
e31: bl w0 x2+6 ; rejected:
sn w0 5 ; if operation = output
jl. e32. ; then goto reserve;
bz w0 x1+h1+1 ; w0 := zone.kind;
sn w0 6 ; if kind = disc process then
jl. e32. ; goto reserve;
jl. e1. ; goto give up;
e46: al w3 x1+h1+2 ; extend:
jd 1<11+4 ; process description;
rs. w0 e47. ;
am (0) ;
rl w0 18 ; old size := no of segments (area process);
rl w3 x2+10 ;
ws w3 x2+8 ; new size :=
al w3 x3+2 ; segment(share) +
ls w3 -9 ; (last transfer-first transfer+2)//512;
wa w3 x2+12 ;
sl w0 x3 ; if old size >= newsize then
jl. e10. ; goto repeat;
al w0 x3 ;
al w3 0 ;
am. (e47.) ; device:=area(10);
rl w2 10 ; slice length:=device(26);
sn w2 0 ; if deviceref=0 then
jl. e33. ; jump
wd w0 x2+26 ; new size :=
se w3 0 ; (new size // slice length
ba. w0 1 ; + if remainder = 0 then 0 else 1)
wm w0 x2+26 ; * slice length;
e33: rl w2 0 ; w2 := new size;
\f
; fgs 1988.04.24 fileprocessor simple check, page ...4...
e14: al w3 x1+h1+2 ;
al. w1 e48. ;
jd 1<11+42 ; lookup entry(area);
rs w2 x1 ; size := new size;
jd 1<11+44 ; change entry;
se w0 6 ; if claims exceeded then
jl. e35. ; begin <*extend area*>
rl. w0 e42.+12 ;
se w0 0 ; if fnc area.segm <> 0 then
jl. e29. ; goto give up;
rl. w1 h51. ;
sz w1 1<10 ; if mode.bswait = false then
jl. e34. ; begin
rl. w0 e42. ; fnc area.fnc :=
ls w0 -1 ; fnc area.fnc -
ls w0 1 ; wait bit;
rs. w0 e42. ; end;
e34: rl. w1 e47. ; claim :=
rl. w0 e48. ; new size -
ws w0 x1+18 ; old size ;
rs. w0 e42.+12 ; fnc area.segm := claim;
dl w0 x1+22 ; move
ds. w0 e42.+6 ; area process.docname
dl w0 x1+26 ; to
ds. w0 e42.+10 ; fnc area.docname;
al. w1 e42. ; w1 := addr first half fnc area;
al w2 x1+8 ; w2 := addr second half fnc area;
jl. w3 h35. ; parent message special (w1=fnc area);
dl. w2 c5. ; w1 := zone;
rl. w2 e48. ; w2 := new size;
jl. e14. ; goto change entry;
; end else
e35: sn w0 0 ; if result <> 0 then
jl. e26. ; begin
e29: al w0 0 ; fnc area.segm := 0;
rs. w0 e42.+12 ; goto give up;
jl. e1. ; end else
;
e26: rs. w0 e42.+12 ; begin
dl. w2 c5. ; fnc area.segm := 0;
dl. w0 c11. ; restore registers ;
jl. e10. ; goto repeat;
; end;
#, p-12
l./page ...2/, r/28.05.72/88.04.24/, r/...2/...5/
l./e26:/, r/e26:/ /, p1
l./m.fp simple check/, r/84.09.04/88.05.04/
l./connect in, page ...4/, r/84.09.05/88.08.09/
l./ds w0 x1+h1+2/, i/
sz w3 1 ; <*if kind odd then
al w3 x3-1 ; truncate kind*>
/, p-2
l./connect in, page ...5/, r/rc 08.08.73 /fgs 1988.08.09/
l./e36:/, r/e36: /;e36:/
l./a27:/, r/a27: /a27:/
l./connect in, page ...6/, r/rc 1976.02.02 /fgs 1988.08.09/
l./c. -g1/, r/-g1/-1-g1/
l./w. 0, r. g1/, d, i/
c. -1+g1
w. 0, r.g1 ; fill segment
z.
/, p-2
l./m.fp connect input/, r/86.12.12/88.08.09/
l./connect output, page ...1/, r/82.11.29/88.05.01/
l./c4:/, r/<1/<2/, r/<drum or disc>/permkey/
l./preferably on drum (if w0/, d1, i/
; connect output will create an area on the disc with the most
; resources of the particular permkey.
/, p-2
l./negaive/, r/negaive/negative/
l./greatest temporary/, d1, i/
; device with the greatest claims of the particular permkey) decreased
; by the absolute value of segments.
/, p-2
l./page ...2/, r/82.11./88.05.01/
l2, r/b9, e49 /b20, e49/
l./page ...3/, r/rc/fgs/, r/78.09.27/88.05.01/
l./convension/, r/convension/convention/
l./page ...4/, r/82.11.82/88.09.07/
l./sz w3 1/, d5, i/
al w1 3 ; lookup area (0) := 0;
la w1 6 ; lookup area (1) := w0.permkey;
ds. w1 h54.+2 ;
al w0 x1 ; key := permkey;
as w3 -2 ; wanted := w0.segments > 2;
sn w3 0 ; if wanted = 0 then
jl. b9. ; goto unknown;
/, p-5
l./as w3 -1/, r/ -1/ -2 /
l1, d1
l./page ...5/, r/83.07.28/88.09.07/
l./jl. w2 a4./, d, i#
rx w0 6 ; swop (claim, wanted);
jl. w2 a4. ; convert to slices (claim);
rx w0 6 ; swop (claim, wanted);
jl. w2 a4. ; convert to slices (wanted);
#, p1
l./a13:/, d./jl. h70.+2/, i/
a13: rs. w2 c9. ; descriptor found:
rl. w3 h41. ; save file descriptor in c9;
al w3 x3+1 ; segment (fp) := segment (fp) + 1;
jl. h70.+4 ; call segment 2 (connect output);
/, p-5
; *********
;l./a13:/, r/rl w0 x2/ /
;l./bz w1 1/, d./al w0 x1/,
;r/; w0 := kind > 1;/; call connect2:/
;***********
l./page ...7/, d./page ...7b/, i#
\f
; fgs 1988.05.01 fileprocessor connect output, page ...7...
; segment 1
; procedure get claims (key, filedescriptor);
;
; call: return:
;
; w0 key claim
; w1 link link
; w2 - unchanged
; w3 - unchanged
;
; filedescriptor.docname entry.docname or docname of disc
; 0, ..., 3 with claims
;
; The procedure finds the disc with the largest claims for the
; given key and returns the claims in w0 and the docname of the
; disc in filedescriptor.docname.
; If docname given in filedescriptor.docname is 0, all discs are
; searched for the one with the greatest claims of that particular
; permkey. The search goes on backwards from last disc to first disc
; or drum.
; If, however, the docname given is a document name for a disc
; included in the bs system, the procedure returns the claims
; for the given key for that disc.
;
a8: ds. w3 h10.+4 ; get claims: (fp exception routine dump area used)
rs. w1 h10.+0 ; save (w2, w3); save return;
zl w2 64 ;
sl w2 9 ; if monitor release > 8 then
am 1 ; key := key * 4 else
ls w0 1 ; key := key * 2 ;
hs. w0 b2. ;
al w0 -2 ;
sh w2 8 ; if monitor <= 8 then
hs. w0 b12. ; decr := -2;
rl w0 92 ; w0 := first drum;
rl w1 96 ; last device :=
al w1 x1-2 ; top discs - 2;
rs. w0 b1. ; first device := first drum;
\f
; fgs 1988.05.01 fileprocessor connect output, page ...7a...
; segment 1
rl. w2 h54.+2 ; w2 := first word of docname;
sh w2 3 ; if docname (1) <> (0, 1, 2, 3) then
jl. a12. ; begin <*docname specified*>
al. w3 h54.+2 ;
jd 1<11 + 4 ; w0 := proc descr addr (docname);
sn w0 0 ; if process exists then
jl. a12. ; begin
am (0) ; w0 :=
rl w0 24 ; chaintable addr (docname);
a25: rl w2 x1 ; loop: w2 := device.chaintable address;
sn w2 (0) ; if device.chaintable address <>
jl. a39. ; doc .chaintable address then
; begin
al w1 x1-2 ; device := device -2;
jl. a25. ; goto loop;
; end;
a39: rs. w1 b1. ; first device := last device := device found;
; end process exists;
; end docname specified;
a12: al w0 0 ;
rs. w0 h10.+8 ; max slices := 0;
a9: rl w2 x1 ; next device:
rl. w3 h16. ; w2 := device.chaintable address;
wa w3 x2-36 ; w3 := device.key zero claims;
rs. w3 h10.+12 ; save device.key zero claims;
al w0 2047 ; min slices :=
jl. w2 a3. ; convert to segments (
rs. w0 h10.+10 ; + infinity);
b2 = k + 1 ; key * (if mon rel < 9 then 2 else 4);
al w3 x3+0 ; w3 := device.slice claims.key
\f
; fgs 1988.05.01 fileprocessor connect output, page ...7b...
; segment 1
a10: zl w0 64 ; next key:
sl w0 9 ; if monitor release <= 8 then
jl. a36. ; begin <*halfwords*>
rl w0 6 ; device key :=
ws. w0 h10.+12 ; (device.key claims -
ls w0 -1 ; device.key0 claims) > 1;
zl w2 x3 ; w2 := entry claims;
sh w0 1 ; if device key <= 2 then
al w2 1 ; w2 := 1;
zl w0 x3+1 ; w0 := slice claims;
jl. a37. ; end else
a36: rl w0 6 ; begin
ws. w0 h10.+12 ; device key :=
ls w0 -2 ; (device key claims - device.key0 claims) > 2;
rl w2 x3 ; w2 := entry claims;
sh w0 1 ; if device key <= 2 then
al w2 1 ; w2 := 1;
rl w0 x3+2 ; w0 := slice claims;
a37: ; end;
sh w2 0 ; if entry claim = 0 then
al w0 0 ; slice claim := 0;
jl. w2 a3. ; convert to segments (slice claim);
sh. w0 (h10.+10) ; if slice claim <= min slices then
rs. w0 h10.+10 ; min slices := slice claim;
b12=k+1 ; decr:
a29: al w3 x3-4 ; decrease sliceclaim key address by decr;
sl. w3 (h10.+12) ;
jl. a10. ;
; if claim key addr >= claim key 0 address then
; goto next key;
rl w2 x1 ; device := chaintable;
rl. w0 h10.+10 ;
sl. w0 (h10.+8) ; if min slices >= max slices then
jl. a11. ;
jl. a38. ; begin
a11: rs. w0 h10.+8 ; max slices := min slices;
rs. w2 h10.+14 ; best device := device;
rl w0 x2-8 ; slice length := slice length (device);
rs. w0 h10.+6 ; end;
a38: al w1 x1-2 ; device := device - 2;
sl. w1 (b1.) ; if device <> first device then
jl. a9. ; goto next device;
\f
; fgs 1988.05.01 fileprocessor connect output, page ...7c...
; segment 1
rl. w2 h10.+14 ; get best device;
dl w0 x2-16 ; move
ds. w0 h54.+4 ; chaintable.docname
dl w0 x2-12 ; to
ds. w0 h54.+8 ; filedescriptor.docname;
rl. w0 h10.+8 ; w0 := max slices in segments;
dl. w3 h10.+4 ; restore (w2, w3);
jl. (h10.) ; return;
\f
; fgs 1988.05.01 fileprocessor connect output, page ...7d...
; segment 1
; procedure convert to segments (slices);
;
; call : return :
;
; w0 : slices slices * slicelength
; w1 : name table entry unchanged
; w2 : link address chaintable
; w3 : device.slice claims.key unchanged
b. b3 ; begin block
w.
a3: rs. w2 b2. ; save return;
rl w2 x1 ; w2 := chain table entry;
rs. w3 b3. ; save w3;
wm w0 x2-8 ; slices := slices * slicelength;
rl. w3 b3. ; restore w3;
jl. (b2.) ; return;
b2: 0 ; saved return
b3: 0 ; saved w3;
i.
e. ; end block
\f
; fgs 1988.05.01 fileprocessor connect output, page ...7e...
#
l./page ...7c/, r/82.12.03/88.05.01/, r/7c/7f/
l./m.fp connect out 1/, r/85.03.07/89.02.02/
l./page ...8/, r/82.11.29/88.09.07/
l./e0:/, i/
; c4 : irrelevant
; c7 : zone addr or 0
; c9 : file descr addr
; c11: link
/, p-4
l./rl. w1 c4./, d, i/
rl w0 x2 ; w2 := addr file descr; w0 := file descr.kind;
zl w1 1 ; kind := file descr.kind >
ls w1 -1 ; 1;
sl w1 e16 ; if kind > max kind then
jl. a27. ; goto convention error;
rs. w1 c4. ; save kind;
/, p-7
l./page ...9/, r/86.12.12/89.02.02/
l./a19:/, l-1, d./<:enable/
l./page ...10/, r/86.12.12/89.02.02/
l./; mount ring:/, d./jl. a22./, d
l./connect output, page ...11/, r/82.11.29/88.09.07/
l./ds w0 x1+h1+2/, i/
sz w3 1 ; <*if kind odd then
al w3 x3-1 ; truncate kind*>
/, p-2
l./page ...12/, r/82.11.29/88.05.01/
l./m.fp connect out/, r/86.12.12/89.02.02/
l./magtape check, page ...1/, r/84.09.04/88.12.09/
l./e2:/, r/+1<6/ /
l./e35:/, l1, i/
e31: <:<25><0><0>:> ;
/, p-1
l./magtape check, page ...1a/, r/rc 23.05.72/fgs 1989.01.25/
l./e22:/, l./jl. e17./, r/e17./e23./, r/give up/parity/
l./e20:/,
l./sz w0 1<6/, i/
sn w3 8 ; if operation = move then
jl. e15. ; goto check position;
/, p-2
l./jl. e23./, r/e23./e29./, r/parity/prepare reposition;/, p-1
l./e15:/, d./dl. w0 c11./, i#
e15: al w2 x3 ; check position:
dl. w0 c28. ;
se w2 8 ; if operation <> move then
ds w0 x1+h1+14 ; zone.file, block := answer.file, block;
sn w3 (x1+h1+12) ; if answer.file count <> zone.filecount
se w0 (x1+h1+14) ; or answer.block count <> zone.blockcount then
jl. e33. ; goto add position error bit;
rl. w2 c5. ; w2 := share;
#
l./sn w3 3 ; if operation <> input/, r/sn/se/
l./so. w0 (e4.)/, d
l./al w0 25/, d1, i/
; zone.first address := <:<25><0><0>:>;
rl. w0 e31. ; top transferred := first addr + 2;
/, p-1
l./e33:/, l./jl. e23./, r/e23./e29./, r/parity/prepare reposition/, p-1
l./magtape check, page ...2/, r/84.09.04/89.01.31/
l./sz. w0 (e2.)/, r/ , overrun or position/or overrun/, i/
se w3 0 ; if operation = sense
sl w3 8 ; or operation = move , out tapemark or setmode then
jl. e29. ; goto prepare reposition;
/, l1, p-4
;l./e0:/, r/no transport:/no transport: <*stopped or position error empty trans;fer*>/, i/
; rl. w1 c22. ;
; sz w0 1<6 ; if position error and
; sh w1 0 ; halfs xferred > 0 then
; jl. e0. ;
; jl. e17. ; goto give_up;
;/, l1, p-6
l./e21:/, d1, i/
e21: sz w3 2.111 ; mount tape:
jl. e30. ; if sense or move then
jl. e16. ; goto return;
e30: ; <*the position is completed at next transfer*>
/, p-4
l./magtape check, page ...3/, r/84.09.04/88.12.09/
l./e27:/, i/
e29: al w1 0 ; prepare reposition:
rs. w1 e35. ; reposition count := 0;
/, l1, p-2
l./magtape check, page ...4/, r/86.12.12/89.01.31/
l./sl w3 5/, r/sl w3 5/sl w3 15/, r/=5/=15/
l./jl. e27./, r/e27./e29./, r/repos/prepare repos/
l./jl. e27./, r/e27./e29./, r/repos/prepare repos/
l./magtape check, page ...5/,
l./m.fp magtape check/, r/86.12.12/89.01.31/
l./init,page ...1/, r/86.12.12/88.05.04/
l./e48, b12/, r/b12/b20/
l./init, page ...4/, r/86.12.12/88.05.02/
l./e4:/, r/1<1/1<2/
l1, r/device := drum;/permkey := 0;/
l./am. (b8.)/, d2, i/
am. (b8.) ;
se w1 x1 ; if first init then
jl. e19. ; begin
; al. w3 b13. ;
; jd 1<11+4 ; addr of process (<:s:>);
; rl. w1 h17. ;
; sn w0 x1 ; if addr of parent process = addr of <:s:> then
; am 1<10 ; add bswait to fp mode bits;
al w2 1<9 ; mode.initmess :=
lo. w2 h51. ; yes;
rs. w2 h51. ;
jl. e16. ; end else
e19: ; begin <*not first*>
/, p-9
l./comment do not check/, r/com/ com/
l./curr out./, r/cur/ cur/
l./if mode 14.no/, r/if/ if/
l1, r/begin/ begin mode initmess.yes/
l./e17:/, r/end/ end/
l2, r/close/ close/
l1, r/prep/ prep/
l1, r/; skipped:/; end not first;/
l1, r/comm/ comm/, p-4
l./b12:/, l1, i/
b13: <:s:>, 0, r.3 ; name of ancestor <:s:>
/, p-2
l./m.fp init /, r/86.12.12/89.01.12/
l./commands, page ***15***/, r/86.08.22/88.04.24/
l./; 65:/, g5/+10/+ 2/, r/0<5+ 2/0<5+10/, p-5
l./; 95:/, r/0<5+10/ 0/, r/<95>/ _ /
l./page ***16***/, r/86.09.01/88.04.24/
l./i10:/, r/m. /
m./, r/top of command reading/fp comm. reading/, r/86.09.03/88.04.24/
l./, load, page 3/, r/rc 86.10.10 /fgs 1988.07.21/
l./1<23+ 127<12 + 1/, r/127/ 0/
l./page 3a/, l./m.fp/, r/86.10.10/88.07.21/
l./end program, page ...4/, r/86.09.01/88.05.02/
l./1<1+1/, r/1<1+1/1<2 /
l./m.fp end program and/, r/86.12.12/88.05.02/, r/and device status/ /
f
n=edit fp4tx
; rettelser til release 5.0
;
; block io, common bits : if less than wanted was input and kind = disk
; or less than wanted was output then add stopped
;
; block io : bit 1<23, intervention, special bit for character output
; simple check : bit 1<23, intervention, special action is as for
; paper low : parent message attend with wait bit
;
; simple check : parent message change ændres til attend
;
; init : efter connect (out, primout) og connect (in, primin) sættes
; name table address, så evt. area process ikke fjernes af
; fp end program igen
;
; commands : script indføres
;
; commands : ved 'em' på prim out tømmes curr out og der sendes finis til
; parenten, ved 'em' på stakket curr out afstakkes blot
;
; in fp load program any program with text contents is just connected as
; current input and fp jumps to command reading
;
; a new slang segment, finis, is brought in to send an MCL message before
; a finis parent message in case primary output process is a pseudo pro-
; cess and its main process has the name <:menu:>
;
; end program : device status card reject or disk error ændres til
; disk error or not connected
l./page ...1/, r/89.01.25/89.06.27/
l./m.file processor/, r/89.01.25/89.06.27/
l./m.fp text 1/, r/89.01.25/89.06.28/
l./s. k=h55, e48 ; command assembly/, l1, r/13, 14/13, 14, 15/
l3, r/15/16, 17/
l./end program and device status/, i/
; s. k=h55, e48 ; finis message to parent
; e. ; segment 18
;
/, l2, r/16, 17/19, 20/, p-3
l./permanent, page ...3b/, r/88.05.19/89.06.27/
l./h52:/, r/4/5/
l./page ...6/,
l./m.fp permanent/, r/89.01.25/89.06.28/
l./block io, page ...2/, r/89.01.25/89.03.20/
l./e23:/, l1, i/
e29: 1<8 ; stopped bit
/, p-1
l./block io, page ...3/, r/89.01.25/89.03.20/
l./am. (c22.)/, d./al w3 x3+1<8/, i/
sn w0 3 ; if less than wanted was input and
se w2 4 ; kind = disk
sn w0 5 ; or less than wanted was output then
lo. w3 e29. ; status := status or stopped bit;
/, p-4
l./block io, page ...4/, r/82.12.12/89.03.20/
l./e28:/, l-1, r/8.0/8.4/
l6, r#*#* /#, p1
l./page ...4/,
l./m.fp io system/, r/89.01.27/89.03.20/
l./resident, page ...1/, r/89.01.25/89.06.27/
l./h64:/, r/am 0/am -1/, r/hard error =/fp finis:/
l1, r/am 1/am 3/
l1, r/am 2/am 3/
l./h99=/, l./am 512/, r/512 /1024/
l1, r/1022/1534/
l./resident, page ...4/, r/89.01.26/89.06.29/
l./c44:/, l1, i/
c45: -1 ; script (initially : not in script)
/, p-1
l./h56=/, l./c. -g1/, r/-g1 /-g1-1/
l2, d, i/
w. c. g1-1 0, r.g1 z. ;
/, p-1
l./resident, page ...6/, r/82.12.09/89.06.27/
l./h64/, r/hard errors on devices/finis program/
l./resident, page ...7/, l./m.fp resident/, r/86.12.12/89.06.27/
l./simple check, page ...1/, r/88.04.24/89.03.20/
l./e17:/, l1, i#
e18: 1<23 + 1<18 ; test intervention and end doc
#, p-1
l./simple check, page ...2/, r/88.04.24/89.03.20/
l./so. w0 (e17.)/, d1, i/
sz. w0 (e17.) ; if not end doc then
jl. e9. ; begin <*not end doc and stopped*>
bz w0 x1+h1+1 ;
bz w3 x2+6 ;
sn w0 4 ; if kind = area and
se w3 3 ; operation = input then
jl. e23. ; goto return else
jl. e7. ; goto repeat the rest;
e9: ; end;
/, p-9
l./e19:/, l./rl. w0 c11./, d1, i/
rl w3 x2+2 ;
al w3 x3+1 ;
sh w3 (x2+22) ; if share.top transferred > share.first shared then
/, l1, p-4
l./page ...5/, r/88.04.24/89.03.20/
l./e25:/, l1, r/change/attend/
l./e5:/, l./so. w0 (e17.)/, d1, i/
sz. w0 (e18.) ; if intervention or end doc then
jl. e24. ; goto attend message else
jl. e27. ; goto test stop ;
/, l1, r/ al/e24: al/, r/ if end document then/ attend message:/, p-4
l./m.length error on fp segment 3/, r/ on fp segment 3/, simple check/
l./m.fp simple check/, r/88.05.04/89.03.20/
l./stack, page ...5/,
l./m.length error on fp segment 6/, r/ on fp segment 6/, stack/
l./unstack, page ...5/,
l./m.length error on fp segment 7/, r/ on fp segment 7/, unstack/
l./magtape check, page ...5/,
l./m.length error on fp segment 9/, r/ on fp segment 9/, magtape check/
l./init, page ...1/, r/88.05.04/89.06.28/
l./; segment 10/, r/segment 10/segment 11/
l./init, page ...3a/, r/86.12.12/89.06.23/, r/3a/4/
l1, l./init, page ...4/, r/88.05.02/89.06.23/, r/...4/...5/
l./jl. w3 h28.-2/, l3, i/
jl. w2 e20. ; send and wait sense (out);
/, p-1
l5, i/
jl. w2 e20. ; send and wait sense (in);
/, p-1
l./rs. w3 h9./, l1, i/
al w3 -1 ; set
rs. w3 c45. ; not in script;
/, p-2
l./; the following code is skipped/, i/
\f
; fgs 1989.06.23 file processor, init, page ...5...
/
l./e5:/, i/
\f
; fgs 1989.06.23 file processor, init, page ...6...
/
l./jl. w3 h14./, d./b13:/, i/
jl. h64. ; goto fp finis;
e20: ; send and wait sense (zone);
rs. w2 b14. ; save return;
al w3 x1+h1+2 ; w3 := zone.docname;
al. w1 b4. ; w1 := message area (sense);
jd 1<11+16 ; send message;
al. w1 h66. ; w1 := addr answer area block io;
jd 1<11+18 ; wait answer;
jl. (b14.) ; return;
\f
; fgs 1989.06.23 file processor, init, page ...7...
b0: 1<23 ;
b1: 0 ; file descriptor;
0 ;
b5: 0 ; first half of name;
0 ;
b6: 0 ; second half of name;
0, r.5 ; rest of tail;
b2: <:c:>,0,0,0 ;
b3: <:v:>,0,0,0 ;
b4: 0, r.4 ; zero used in set catbase and send and wait sense
b7: <:***fp reinitialized<10><0>:>
b8: 0 ; first (boolean)
b9: 8<13+0<5 ; parent message
<:***fp init troubles :>
b10: <: version<0>:> ;
b11: <: release<0>:> ;
b12:; <: started with <0>:>
b13: <:s:>, 0, r.3 ; name of ancestor <:s:>
b14: 0 ; saved return in send and wait sense
/, p1
l./m.length error on fp segment 11/, r/ on fp segment 11/, fp init/
l./m.fp init /, r/89.01.12/89.07.04/
l./commands, page ***01/, r/86.08.06/89.07.04/
l./b. a2/, r/a2/a9/, r/b0/b9/
l./a0:/, l./al. w3 a0./, d3, i/
se w2 25 ; if char = 'em' then
jl. a1. ; begin
rl. w1 h50. ;
se w1 0 ; if current input stack chain empty then
jl. a2. ; begin
jl. w3 h95.-2 ; close out text (curr out);
jl. h64. ; goto finis to parent;
a2: al w1 -1 ; end;
se. w1 (c45.) ; if not in script then
jl. a3. ;
al. w3 a0. ; goto unstack current input; return to rep;
jl. h30.-4 ;
a3: wa. w1 g19. ; bracket count :=
rs. w1 g19. ; bracket count - 1;
se w1 0 ; if bracket count <> 0 then
jl. f0. ; goto syntax error; <*where in will be unstacked*>
jl. w3 h30.-4 ; unstack current input;
rl. w3 g3. ; get char addr;
al w0 7 ; state := 7; <*cheat, w0 is not supposed to change*>
al w2 10 ; char := 'nl'; <*cheat again, char in buffer unch.*>
a1: ; end;
/, p1
l./commands, page ***06/, r/86.08.27/98.06.28/
l./b. a9/, r/a9, b2 /a99, b2/
l./commands, page ***07/, r/86.09.03/98.07.04/
l./jl. h14./, r/h14/h64/, l-1, r/finis/goto fp finis/, p1
l./i3:/, l2, i/
jl. w3 h39. ;
al w0 -1 ; if in script then
sn. w0 (c45.) ; begin
jl. i0. ; set not in script;
rs. w0 c45. ; warning.yes, ok.no ;
al w2 3 ; goto fp end program;
jl. h7. ; end else
; goto initiate command reading;
/, p-2
l./commands, page ***08/, r/86.08.08/98.07.04/
l./al w3 1/, d2, i/
al w3 1 ;
rs. w3 g14. ; state := 1;
sn. w0 (c45.) ; bracket count := if in script then 1
al w0 1 ; else 0;
ds. w0 g19. ; sign := 1;
/, p-5
l./rl. w2 h9./, l1, i/
al w0 0 ;
se. w0 (c45.) ; if in script then
jl. a11. ; begin
rl. w2 h8. ; cur command := fp.cur command;
a12: ea w2 x2+1 ; cur command := cur command + cur command.length;
zl w1 x2 ; sep := cur.command.sep;
sl w1 4 ; if sep > 'nl' then
jl. a12. ; goto rep;
al w2 x2+2 ; <*because commands are moved to x2-4*>
a11: ; end;
/, p1
l./dl. w1 i13.; move endlist/, d1, i/
dl. w1 i13. ;
al w3 0 ; if not in script then
se. w3 (c45.) ; move endlist;
ds w1 x2 ;
; end part of fp;
/, p1
l./page ***09/, r/86.08.11/89.07.04/
l./jl. h62./, l-1, i/
al w0 -1 ; set
rs. w0 c45. ; not in script;
/, p-2
l./commands, page ***11/, r/86.08.15/98.06.28/
l./f5:/, l./sh w1 -1/, d, i/
sh. w1 (c45.) ; if bracket count <= script then
/, p1
l./commands, page ***16/, r/88.04.24/98.06.28/
l./i10:/, i#
w.
b. g1 ; fill segment
g1 = (:h55+1536-k:)/2
c. -g1 m. length error fp commands
z.
; w. 0, r.g1
e.
#
l./m.fp comm. reading 88.04/, r/88.04.24/89.07.04/
l./load, page 1/, r/rc 12.07.79 /fgs 1989.06.28/
l3, r/512 /1024/
l./load, page 1a/, r/rc 12.07.79 /fgs 1989.06.28/, r/1a/...2.../
l./load, page 1b/, r/rc 12.07.79 /fgs 1989.06.28/, r/1b/...3.../
l./e2:/, d3, i/
e2: ; if contents = 0
sl w3 2 ; or contents = 1 then
jl. e18. ; begin
e17: al w0 x2+2 ; file name pointer := param pointer + 2;
jl. w3 h29.-4 ; stack current input;
rl w2 0 ;
jl. w3 h27.-2 ; connect curr input ( file name);
sn w0 0 ; if result <> 0 then
jl. e19. ; begin
jl. w3 h30.-4 ; unstack current input (cur chain);
jl. w3 e48. ; set name table addr in curr in;
jl. e44. ; goto connect trouble;
e19: jl. w3 e48. ; end;
rs. w0 c45. ; set name table addr in curr in;
rl. w3 h51. ; script := 0;
sz w3 1<0 ; if fp mode list.yes then
jl. w3 e26. ; list curr command;
jl. h61. ; goto commands;
e18: ; end else
se w3 2 ; if not (contents = 2
sn w3 8 ; or contents = 8) then
jl. e20. ;
jl. e47. ; goto call trouble;
e20: ;
/, p1
l./load, page 2/, r/rc 86.09.03 /fgs 1989.06.28/, r/page 2/page ...4.../
l./load, page 3/, r/88.07.21 /fgs 1989.06.28/, r/page 3/page ...5.../
l./load, page 3a/, r/rc 86.10.10 /fgs 1989.06.28/, r/3a/...6.../
l./e44:/, i/
;procedure set name table address in zone:
;w1 = zone w3 = link
b. a3 w.
a1: 0,r.10 ; message and answer
0 ; saved w2
a2: 0 ; link
0 ; saved w0
a3: 0 ; saved w1
e48: ds. w3 a2. ; save w2,w3;
bz w3 x1+h1+1 ; if kind <> bs
se w3 4 ; then
jl. (a2.) ; return;
ds. w1 a3. ;
al w3 x1+h1+2 ;
al. w1 a1. ; send message (sense area proc);
jd 1<11+16 ;
jd 1<11+18 ; wait answer;
dl. w1 a3. ; restore w0,w1;
dl. w3 a2. ; restore w2,w3;
jl x3 ; return;
e.
/, p1
l./e13=/, l./(:h55+512/, r#512-k:)/2 #1024-k:)/2#
l./m.length error on fp segment 13/, r/on fp segment 13/load/
l./m.fp program load 88.07.21/, r/88.07.21/89.06.28/
l./end program, page ...1/, i#
\f
; fgs 1989.06.27 file processor, finis, page 1
; the fp segment finis
s. k=h55, a20, e48, f7
w. ;
512
e0: jl. e1. ; entry:
a2: 0 ,0,0,0 ; zero name
a3: <:c:>,0,0,0 ;
a4: <:v:>,0,0,0 ;
a10: 128<12 + 0 ; MCL message:
0 ; localid
12<12 + 15 ; no of characters
0, r.5 ; text (1:5)
a11: <:menu<0>:> ;
a12:<: ok no<0>:>;
<: ok <0>:>;
<:warning, ok no<0>:>;
<:warning, ok <0>:>;
a13: 3 ; mask for extract 2
a14: 10 ; constant
\f
; fgs 1989.06.27 file processor, finis, page 2
e1: ; finis:
rl. w3 h51. ; text addr := addr ( case (warning.ok) of (
ls w3 -5 ;
la. w3 a13. ; <: ok no:>,
wm. w3 a14. ; <: ok :>,
al. w2 a12. ; <:warning, ok no:>,
wa w2 6 ; <:warning, ok :>) );
dl w0 x2+2 ; move
ds. w0 a10.+8 ; text
dl w0 x2+6 ; from
ds. w0 a10.+12 ; constant text area
rl w0 x2+8 ; to
rs. w0 a10.+14 ; message.text area;
\f
; fgs 1989.06.27 file processor, finis, page 3
am. (h16.) ; after param:
dl w1 +78 ;
al. w3 a2. ; w3 := addr name (zero);
jd 1<11+72 ; set catbase (std base);
rl. w3 h15. ;
al w3 x3+2 ;
jd 1<11+4 ; w0 := proc descr addr (prim out);
sn w0 0 ; if w0 <> 0 then
jl. e2. ; begin
rx w3 0 ; save w3; w3 := addr prim out proc;
rl w1 x3 ;
se w1 64 ; if prim out.kind <> 64 <*pseudo*> then
jl. e2. ; skip;
rl w2 x3+10 ;
rl w3 0 ; restore w3;
dl w1 x2+4 ;
sn. w0 (a11.) ; if prim out.parent.name <> <:menu:> then
se. w1 (a11.+2) ;
jl. e2. ; skip;
al. w1 a10. ;
jd 1<11+16 ; send message (prim out, message);
al. w1 h43. ;
jd 1<11+18 ; wait answer (answer area lowest level);
e2: ; end;
\f
; fgs 1989.06.27 file processor, finis, page 4
al w2 0 ; close up (cur out,null);
jl. w3 h95.-2 ;
al w0 0 ;
jl. w3 h79.-2 ; terminate zone (cur out,file mark);
al. w3 a3. ;
jd 1<11+48 ; remove c
al. w3 a4. ;
jd 1<11+48 ; remove v
jl. w3 h14. ; send finis message
jl. -2 ; if not removed then send it again;
b. g1 ; fill segment
g1 = (:h55+512-k:)/2
c. -g1 m. length error fp finis
z.
w. 0, r.g1
e.
e. ; end finis
m.fp finis 89.06.27
#
l./end program, page 3/, r/rc 86.09.01 /fgs 1989.06.27/
l./jl. w3 h14./, r/w3 h14/ h64/
l./end program, page ...8/, r/rc 86.08.28/ fgs 89.03.20/
l./e21:/, r/card rejected or disk error/disk error or not connected/
l./end program, page ...9/,
l./e41 =/, d1, i#
w.
b. g1 ; fill segment
g1 = (:h55+1024-k:)/2
c. -g1 m. length error fp end program
z.
w. 0, r.g1
e.
#
l./m.fp end program/, r/88.05.02/89.03.20/
l./insertproc page ...1/, r/86.12.12/89.06.27/
l./g0: 18/, r/18 / 21/
f
message fp text 2 fil 7 empty
nextfile n g
;n=head
message fp text 3 fil 8 empty
nextfile n g
;n=head
message job adm 1 text fil 9
nextfile n g
n=edit mode5tx ; job adm 1, mode head char finis end
f
message job adm 2 fil 10
nextfile n g
n=edit g ; job adm 2, i o if
; connect output, w0 := segm < 2 + permkey
; mode bits initmess and bswait added to the program if
;
l./page 4/, d./terminate option table/, i#
\f
; fgs 1989.01.11 fp utility, job adm 2, page 4
; option table for if
b20: <:list:> , 0, 0, 1<0
<:pause:> , 0, 0, 1<3
<:error:> , 0, 0, 1<4
<:ok:> , 0, 0, 0, 1<5
<:warning:> , 0, 1<6
; <:if:> , 0, 0, 0, 1<7
<:listing:> , 0, 1<8
<:initmess:> , 0, 1<9
<:bswait:> , 0, 0, 1<10
<:all:> , 0, 0, 0, 2.111111111111111101111111
0 ; terminate option table
#, p1
l./page 6/, r/rc 08.08.73 /fgs 1988.09.08/
l./al w0 1<1+1/, r/1<1+1/1<2+0/, r/pref. on disk/permkey zero/
l./al. w3 b9./, d
l./m.fp job adm 2/, r/76.05.20/89.01.11/
f
message job adm 3 fil 11
nextfile n g
n=edit g ; job adm 3, account replace newjob mount opmess
; ring suspend release enable change timer
; convert mountspec kit corelock
; coreopen bossjob opcomm
; opmess, opcomm : fp parametre af længde > 10 (ny fp syntax)
;
l./page 10/, r/rc 24.04.72 / fgs 1988.09.15/
l./j4:/, l./se w3 10/, r/se/sh/, r/10/9 /
l./...15/,
l./m.rc fp/, r/86.12.22/88.09.15/
f
message online repeat fil 12
nextfile n g
n=edit g
f
message edit text 1 fil 13
nextfile n g
n=edit g ; edit text 1
f
message edit text 2 fil 14
nextfile n g
n=edit g ; edit text 2
; connect output, correction area : segm < 2 + 0
l./tape 2, page 6/, r/84.10.29/88.09.08/
l./al w0 1<1+0/, r/1<1/1<2/, r/pref. on disk/temporary/
l./page 21/, l./m.rc/, r/84.10.29/88.09.08/
f
message edit text 3 fil 15
nextfile n g
n=edit g ; edit text 3
f
message edit text 4 fil 16
nextfile n g
n=edit g ; edit text 4
;
; connect output, object area : segm < 2 + 0
l./tape 4, page 22/, r/rc 14.09.72 /fgs 1988.09.08/
l./al w0 1<1+1/, r/1<1+1/1<2 /, r/pref. on disk/temporary/
l./page 24/, l./m.rc/, r/85.02.28/88.09.08/
f
message binin text fil 17
nextfile n g
n=edit g ; binin
;
; ny parameter disc.<disc> or disc.(0/1/2/3)
;
l./page ...1/, r/rc 1977.02.04/fgs 1988.05.03/
l./a32, b26/, r/a32, b26/a40, b40/
l./page 8/, r/rc 29.07.1971/fgs 1988.05.03/
l./1<1+1/, r/1<1+1/1<2 /, r/ on disc/, temporary/
l./page 10/, r/rc 19.02.1973/fgs 1988.06.02/
l./d13:/, d1, i/
d13: al. w2 b17. ; w2 := addr docname;
rl w0 x2 ; w0 := docname.first word;
rl w1 x1 ; w1 := permkey;
sl w0 4 ; if docname.first word > 3 then
am 40 ; permanent entry into auxcat else
jd 1<11+50 ; permanent entry;
/, p-6
l./page ...11/, r/rc 1977.02.04/fgs 1988.05.03/
l./a20:/, d./a11:/, i#
a20: ba w2 x3-1 ; ok: current command := current command +
rx. w2 g3. ; size part(command table(index-1));
am 6 ;
se. w3 g4. ; if create then
jl. a11. ; begin
ds. w3 b5. ; save w2, w3;
rl w3 x2+12 ;
sh w3 -1 ; if tail.size >= 0 and
jl. a38. ; if discname (1) >= 0 then
al. w3 b17. ; begin
dl w1 x3+2 ; move
sh w0 -1 ; discname
jl. a38. ; from
ds w1 x2+16 ; b17
dl w1 x3+6 ; to
ds w1 x2+20 ; current command.tail.docname;
a38: dl. w3 b5. ; end;
rl. w1 i9. ;
sn w1 0 ; if list.yes then
jl. a11. ; begin
ds. w3 b5. ;
al w2 10 ;
jl. w3 h26.-2 ; writenl;
dl. w3 b5. ;
al w0 x2+4 ; write(out,<:entryname:>);
jl. w3 h31.-2 ; end;
dl. w3 b5. ; end;
#
l1, r/ bz./a11: bz./
l./b1:/, i#
\f
; fgs 1988.05.03 fp utility, binin, page 11a
#
l./d18:/, i#
\f
; fgs 1989.01.11 fp utility, binin, page 12a
#
l./b10:/, l1, i/
b17: <:dis:> ; -1 ; default for discname (1) : -1 means no default
<:c<0>:>; 0 ; - (2)
<:<0>:> ; 0 ; - (3)
<:<0>:> ; 0 ; - (4)
b24: <:list:> ;
b25: <:no:> ;
b26: <:yes:> ;
b27: <:disc:> ;
b28: <:disk:> ;
/, p-4
l./page ...13/, r/rc 1977.02.04/fgs 1989.01.11/
l./d2:/, d./b26:/, i#
d2: rl. w2 f4. ; scan parameter list:
ba w2 x2+1 ; next param;
rs. w2 f4. ;
al w0 0 ;
hs. w0 i0. ; check := false;
hs. w0 i7. ; s := false;
rl w0 x2 ; if param <> (space,name) then
se. w0 (b11.) ; goto not name;
jl. a32. ;
dl w1 x2+4 ;
sn. w0 (b24.) ; if name = <:lis:>
se. w1 (b24.+2) ;
jl. a39. ;
jl. a33. ;
a39: sn. w0 (b27.) ; or name = <:disc:>
se. w1 (b27.+2) ;
jl. a40. ;
jl. a34. ;
a40: sn. w0 (b28.) ; or name = <:disk:> then
se. w1 (b28.+2) ;
jl. a18. ; case name of
jl. a34. ; begin
a33: rl w0 x2+10 ; begin <*list*>
se. w0 (b12.) ; if next param <> pointname then
jl. a18. ; goto next tape;
rl w0 x2+12 ;
sn. w0 (b25.) ; if next param = <:no:> then
jl. a31. ; goto listno ;
se. w0 (b26.) ; if next param <> <:yes:> then
jl. a18. ; goto next tape;
am 1 ; listyes:
a31: al w0 0 ; listno :
rs. w0 i9. ; list := list.(yes/no);
jl. a37. ; end <*list*>;
\f
; fgs 1989.01.11 fp utility, binin, page ...13a...
a34: rl w0 x2+10 ; begin <*disc*>
se. w0 (b12.) ; if next param <> pointname and
sn. w0 (b20.) ; next param <> pointint then
jl. a35. ; goto next tape;
jl. a18. ;
a35: se. w0 (b20.) ; if next param = pointint then
jl. a36. ; begin
rl w0 x2+12 ; int := next param;
sl w0 0 ; if int < 0
sl w0 4 ; or int > 3 then
jl. a18. ; goto next tape;
rs. w0 b17. ; discname (1) := int;
jl. a37. ; end else
a36: dl w1 x2+14 ; begin <*next param = pointname*>
ds. w1 b17.+2 ; discname :=
dl w1 x2+18 ; next param;
ds. w1 b17.+6 ; end;
; end <*disc*>;
a37: rl. w2 f4. ; end case;
al w2 x2+10 ;
rs. w2 f4. ; prepare for next param;
jl. d2. ; goto scan param list;
#
l./a32:/, i#
\f
; fgs 1989.01.11 fp utility, binin, page ...13b...
#
l./a15:/, i#
\f
; fgs 1988.05.03 fp utility, binin, page ...14a...
#
l./a17:/, i#
\f
; fgs 1988.05.03 fp utility, binin, page ...15a...
#
l./m.rc/, r/77.02.04/89.01.11/
f
message binout text fil 18
nextfile n g
n=edit g ; binout text
;
; connect output : segm < 2 + key
l./page ...18/, r/rc 1976.05.21/fgs 1988.09.08/
l./jl w3 h28/, l-2, r/1<1+1/1<2+0/, r/ pref. on disc/, temporary/
l./m. rc/, r/76.05.21/88.09.08/
f
message print text fil 19
nextfile n g
n=edit g ; print text
;
; new : format hex
; 4.1.2 : print from relocated processes
; 4.1.3 : print from bs areas exceeding 32768 segments
; : print from addresses beyound 4194304 up to 8388606
; 4.1.3 : print accesses each segment from 0 up until the first one to print
; 4.1.4 : print does not connect via bs entries
;
l./1985.03.26/, r/85.03.26/88.11.21/
l./i24/, r/i24/i30/
l./jl. e2./, d
l./f8:/, i/
f31: 0 ; block base
f32: 0 ; hwd base
/
l./f8:/, r/1<22 /1<23-1/
l./f11:/, r/1<22 /1<23-1/
l./f12:/, i/
0 ;
/, l1, r/total/total (double)/, p-1
l./print, page 2/, r/rc 8.7.1970 /fgs 1988.07.17/
l./rl. w0 f12./, r/rl/dl/
l./a5:/, d1, i/
a5: al w0 x3 ; ok:
al w3 0 ;
aa. w0 f12. ; no := first + total;
/, p-2
l./rl. w0 f12./, r/f12./f1. /
l1, r/wa/aa/, r/f1. /f12./
l1, r/rs/ds/
l./page ...3/, r/rc 1977.09.14/fgs 1988.07.12/
l./a2:/, l./bz. w0 i4./,
r/i4. /i14./, r/blocked/bs area/, i#
rl. w0 f17. ;
sn w0 0 ; if input descr.name (1) <> 0 then
jl. a54. ; begin
am. (f13.) ;
dl w0 +4 ;
sn. w3 (f17. ) ; if name in area descr in parameter <>
se. w0 (f17.+2) ;
jl. a53. ;
am. (f13.) ;
dl w0 +8 ;
sn. w3 (f17.+4) ; name in input descriptor then
se. w0 (f17.+6) ;
jl. a53. ;
jl. a54. ; begin
a53:
jl. w3 c3. ; writecr;
al w2 40 ;
jl. w3 c9. ; write (<:(:>);
al. w0 f17. ;
jl. w3 c5. ; writetext (input descr name);
al w2 41 ;
jl. w3 c9. ; write (<:):>);
a54: ; end;
\f
; fgs 1988.07.12 fp utility, print, page ...3a...
#
l./a3:/, l-1, d, i/
32<12 +1 ;
zl. w0 i1. ;
se w0 6 ; if segmented then
jl. a3. ; begin
jl. w3 c3. ; writesp;
al w2 40 ;
jl. w3 c9. ; writechar (<:(:>);
rl. w0 f21. ;
bs. w0 1 ; w0 := segm count - 1;
jl. w3 c4. ; writeinteger (<<d>, w0);
32<12 +1 ;
al w2 46 ;
jl. w3 c9. ; writechar (<:.:>);
zl. w0 i0. ; w0 := rel;
jl. w3 c4. ; writeinteger (<<d>, w0);
32<12 +1 ; writechar (<:):>);
al w2 41 ; end;
jl. w3 c9. ; end;
/, p2
l./a7:/, l./32<12 +6/, r/6/8/, r/dddddd/dddddddd/
l./i20=/, l-1, d./jl. w3 c9./, i#
rl. w0 f6. ; w0 := address;
\f
; fgs 1988.07.12 fp utility, print, page ...3b...
i20=k+1 ;
; jl. 2 ; (if octal)
jl. i22. ; skip;
jl. w3 c31. ; writeoctal (addr);
al w2 46 ;
jl. w3 c9. ; writechar (point);
rl. w0 f6. ; w0 := address;
i22=k+1 ;
; jl. 2 ; (if hex)
jl. i3. ; skip;
jl. w3 c33. ; writehex (addr);
al w2 46 ;
jl. w3 c9. ; writechar (point);
#, p-14
l./page 4/, r/rc 14.8.1969 /fgs 1988.07.12/
l./jl. a10./, r/a10./a52./
l./a10:/, i/
i26 = k + 1; hex ; print octal:
a52: sn w3 x3 ; if octal then
jl. a51. ; begin
rl. w0 f10. ; w0 := current word;
jl. w3 c31. ; write_octal (word);
i25 = k + 1; hex ; print hexadecimal:
a51: sn w3 x3 ; if hex then
jl. a10. ; begin
rl. w0 f10. ; w0 := current word;
jl. w3 c33. ; write_hex (word);
/, p-10
l./page ...5/, r/rc 1977.10.12 /fgs 1988.07.12/
l./se w1 0/, d./jl. a14./
l./sz w2 3<2/, d, i/
sz w2 3<2 ; if x-field <> 0 and
sn w1 0 ; displacement <> 0 then
jl. a55. ;
/, p-3
l./sh w1 -1/, r/ /a55: /
l./b2 =/, l2, i/
sz w2 3<2 ; if x-field <> 0 and
se w0 0 ; displacement = 0 then
jl. a56. ; begin
al. w0 g14. ; writetext (<:____:>);
jl. w3 c5. ; goto print right bracket;
jl. a14. ; end;
/
l./sh w0 -1/, r/ /a56: /
l./jl. w3 c4./, r/<<d>/<<dddd>/
l1, r/+1/+4/
l./rs. w0 f29./, r/f29./ f29./
l1, r/c4./c4. /
l./1<23+32<12+1/, r/+1/+9/, r/<<-d>/<<-dddddddd>/
l1, r/f29./f29. /
l2, r/2/2 /
l1, r/a6./i23./, r/increase number/hex/
l1, r/;/ ;/
l./jl. a6./, d,
i/
i23=k+1 ;
; jl. 2 ; (if hex)
jl. a6. ; goto increase number;
jl. w3 c33. ; writehex (final addr);
jl. a6. ; goto increase number;
/, p-5
l./page ...5a/, r/rc 1977.10.13 /fgs 1988.07.12/
l./al w1 9/, i/
al. w0 g12. ;
jl. w3 c5. ; outtext (out, <:8.:>);
/, p-3
l./al w1 9/, r/9 /-3/, r/9/-3/
l./i3:/, l2, i#
;procedure write_hex (value);
;
; call : return : saved in:
;
; w0 : value unch b0
; w1 : - unch b1
; w2 : - unch b2
; w3 : link unch b3
;
b. a10, b10 ;
w. ;
c33: ds. w1 b1. ; entry:
ds. w3 b3. ; save registers;
jl. w3 c3. ; outchar (out, sp);
al. w0 g13. ;
jl. w3 c5. ; outtext (<:16.:>);
al w0 -24 ; shifts := -24;
a0: rl. w2 b0. ; for shifts := shifts + 4
wa. w0 b4. ; while shifts <= 0 do
sl w0 1 ; begin
jl. a1. ; char :=
ls w2 (0) ; value shift shifts
la. w2 b6. ; 4;
zl. w2 x2+b5. ; hex :=
jl. w3 c9. ; hextable (char);
jl. a0. ; end;
a1: dl. w1 b1. ; restore registers;
dl. w3 b3. ;
jl x3 ; return;
b0: 0 ; saved w0
b1: 0 ; - w1
b2: 0 ; - w2
b3: 0 ; - w3
b4: 4 ; constant
b6: 2.1111 ; mask
h. ; hextable (0:15):
b5: 48, 49, 50, 51 ; 0, 1, 2, 3
52, 53, 54, 55 ; 4, 5, 6, 7
56, 57, 65, 66 ; 8, 9, A, B
67, 68, 69, 70 ; C, D, E, F
w. ;
i.
e. ; end block
#
l./page ...6/, r/85.03.26/88.07.12/
l./g9:/, l1, i/
g12: <:8.:> ;
g13: <:16.<0>:> ;
g14:<:<32><32><32><32>:>;
/, l1, p-3
l./c0:/, l./wa. w1 f9./, d1, i/
rl w0 x1-2 ; current word := word (current core relative - 2);
/, p-1
l./page 8/, r/rc 31.1.1974 /fgs 1988.07.14/
l./b4:/, r/numbering/limit violation/
l./b7:/, r/core/memory/
l./c25:/, l1, d./hs. w0 i0./, i/
ld w1 -9 ; current core relative := w0;
ls w1 -15 ; rel :=
hs. w1 i0. ; (w3, w0) extract 9;
ld w1 9 ;
ld w0 -9 ; segment :=
ba. w0 1 ; (w3, w0) shift (-9) +
rs. w0 f0. ; 1;
/, p-7
l./page ...8a/, r/rc 1976.03.11 /fgs 1988.07.22/
l./f30:/, r/14/h76/, r/16/h76+2/
l./page ...9/, r/rc 1977.09.14 /fgs 1988.07.12/
l./c.h57<3/, d./z./
l./page 10/, r/rc 7.7.1970 /fgs 1988.07.17/
l./al w0 0/, d./ds. w1 f3./, i/
al w0 0 ; from word := 0;
rl. w1 f11. ; to word := infinite ;
ds. w1 f3. ;
rl. w0 f31. ; from block := block base;
ds. w1 f5. ; to block := infinite ;
rs. w0 f7. ; block := block base;
al w3 0 ;
ld w0 9 ; total := double
wa. w0 f32. ; (block base < 9 +
ds. w0 f12. ; hwd base );
/, p-10
l./page ...11/, r/rc 1970.07.15 /fgs 1988.07.14/
l./al w1 0/, d./rs. w1 f5./, i/
rl. w1 f31. ; save pointer (field specification);
rs. w1 f4. ; from block := block base;
rs. w1 f5. ; to block := block base;
rs. w1 f7. ; block := block base;
rl w2 0 ; save w0;
al w0 0 ;
ld w1 9 ; total := double
wa. w1 f32. ; (block base < 9 +
ds. w1 f12. ; hwd base );
al w0 x2 ; restore w0;
rl. w2 g9. ; restore w2;
al w1 0 ;
/, p-11
l./a27:/, l./sn w1 4/, d1, i/
se w1 4 ; if w1 = 4 then
jl. a68. ; begin
rl. w0 x1+f2. ; from block :=
wa. w0 f31. ; from block +
rs. w0 x1+f2. ; block base;
rs. w0 f7. ; block :=
al w3 0 ; from block;
ld w0 9 ; total := block <
ds. w0 f12. ; 9;
rl. w0 x1+f2.+2 ; to block :=
wa. w0 f31. ; to block +
rs. w0 x1+f2.+2 ; block base;
jl. a28. ; goto execute;
a68: ; end;
/, p-7
l./page 11a/, r/rc 7.7.1970 /fgs 1988.07.17/
l./jl. w2 c25./, l-1, d1, i/
dl. w0 f12. ; begin
wa. w0 f2. ; (w3, w0) :=
jl. w2 c25. ; total + from word;
/, p1
l1, l./jl. w2 c25./, l-1, d, i/
dl. w0 f12. ; (w3, w0) :=
wa. w0 f3. ; total + to word;
/, p1
l1, l./jl. w2 c25./, l-1, d, i/
dl. w0 f12. ; (w3, w0) :=
wa. w0 b34. ; total + center address;
/, p1
l./a64:/, d
l./page 11b/, r/rc 16.7.1970 /fgs 1988.07.14/
l./a28:/, d, i/
a64: rl. w2 d0. ;
al w0 0 ;
rl. w1 f31. ;
rs. w1 f7. ; block := block base;
ld w1 9 ; total := double
wa. w1 f32. ; (block base < 9 +
ds. w1 f12. ; hwd base );
a28: al w3 x2 ; execute:
/, p-5
l./rs. w0 f7./, d1
l./page ...12/, r/rc 1977.10.13 /fgs 1988.07.21/
l./b19:/, d./b40:/, i#
b19: 32<12 + 1 ;
b20: 32<12 + 2 ;
12<12 +23 ;
b21: 1<23+32<12+ 6 ;
b22: 1<23+32<12+ 9 ;
b23: 3 ;
b25: 32<12+ 5 ;
b36: 32<12+ 4 ;
b37: 8<12+15 ;
b38: 16<12+23 ;
b39: 48<12+ 1 ;
b40: 3<12+ 3 ;
#
l./page ...12a/, r/rc 1977.10.13 /fgs 1988.07.12/
l./c30:/, l./rl. w1 b39./, d15, r/a31./a20./, i/
hs. w0 i26. ; octal := true; <*in write word*>
/
l./c18:/, i/
; hex:
c32: se w3 4 ; if next delim <> sp then
jl. a22. ; goto param error;
jl. w3 c14. ; clear format list;
al w0 2 ;
hs. w0 i22. ; hex := true; <*in write address*>
hs. w0 i23. ; hex := true; <*in write final addr*>;
hs. w0 i25. ; hex := true; <*in write word*>
jl. a20. ; goto scan parameterlist1;
/, p-10
l./page ...14/, r/rc 1977.09.26 /fgs 1988.07.12/
l./g10:/, d./g11:/, i#
g10: <:integer:> , 0 , c16-d7 ; format table:
<:word:>, 0 , 0 , c16-d7 ;
<:char:>, 0 , 0 , c28-d7 ;
<:half:>, 0 , 0 , c17-d7 ;
<:abshalf:> , 0 , c29-d7 ;
<:octal:>,0 , 0 , c30-d7 ;
<:hex:>,0,0 , 0 , c32-d7 ;
<:byte:>, 0 , 0 , c17-d7 ;
<:code:>, 0 , 0 , c19-d7 ;
<:text:>, 0 , 0 , c20-d7 ;
<:bits:>, 0 , 0 , c21-d7 ;
<:words:>,0 , 0 , c23-d7 ;
g11: <:all:>,0,0 , 0 , c18-d7 ;
#, p-13
l./page ...15/, d b, i#
\f
; fgs 1988.07.12 fp utility, print, page ...15...
b28: <:s:> ;
b29: <:,xi:> ; replaces <:,ri:> in instr table in mpu
b35: <:connect out<0>:>;
e2: am -2000 ; initialize print:
rs. w1 f15.+2000 ;
am -2000 ;
rs. w2 f24.+2000 ; save top command;
am -2000 ;
rs. w3 f16.+2000 ; save fp base; save command pointer;
rl. w0 b29. ;
gg w3 2*17 ;
sl w3 60 ; if cpu ident >= 60 then
rs. w0 i24. ; replace <:,ri:> with <:,xi:> in instr.table;
al. w3 d5. ;
al w0 x3+510 ; first core := first free core;
am -2000 ;
ds. w0 f20.+2000 ; last core := first core + 510;
al w3 x3+512 ; comment: bs segment buffer;
am -2000 ;
rs. w3 f14.+2000 ; base bit group table := last core + 2;
am -2000 ;
rs. w3 f25.+2000 ; bit group point := last core + 2;
sh w3 x2-4 ; if last core + 2 >= top command then
jl. a36. ; begin
al. w1 b7. ; message(<:core size:>);
jl. w3 c12. ; goto exit fp
jl. d8. ; end;
a36: dl w0 x1+h10+h76+2;
rx. w3 f30.-2 ; exchange two first words of
rx. w0 f30. ; fp break with entries at print;
al. w0 e4. ;
ds w0 x1+h10+h76+2;
al w0 x1+h21 ;
am -2000 ;
rs. w0 f28.+2000 ; secondary out := current out;
am -2000 ;
rl. w2 f16.+2000 ; w2 := command pointer(point);
\f
; fgs 1988.07.12 fp utility, print, page ...16...
bz w1 x2 ;
se w1 6 ; if delimiter = <=> then
jl. a37. ; begin
am -2000 ;
am. (f15.+2000);
jl w3 h29-4 ; stack current input;
am -2000 ;
rl. w2 f16.+2000 ;
al w2 x2-8 ;
am -2000 ;
rl. w3 f15.+2000 ;
al w1 x3+h20 ; zone := current in;
al w0 1<2+0 ; comment: one segm. , temporary;
jl w3 x3+h28 ; connect out(zone); (=secondary output);
sn w0 0 ; if result <> 0 then
jl. d10. ; begin
al. w1 b35. ;
jl. w3 c12. ; message(<:connect out:>);
jl. d3. ; goto exit fp;
d10: am -2000 ;
rs. w1 f28.+2000 ; secondary out zone := current in;
bl w0 x1+h1+1 ;
sn w0 4 ; if -,bs and
jl. 6 ; -,mt
se w0 18 ; then
jl. a44. ; skip;
am -2000;
rl. w2 f16.+2000;
al w2 x2-8 ; w2:=name addr
am -2000 ;
am. (f15.+2000);
al w1 h54 ; w1:=lookup area
jl. w3 a65. ; prepare output
\f
; fgs 1988.07.12 fp utility, print, page ...17...
a44: am -2000 ;
rl. w2 f16.+2000 ;
a37: al w0 0 ; again:
am -2000 ;
hs. w0 i1.+2000 ;
am -2000 ;
rs. w0 f9.+2000 ;
jl. w3 c8. ; next param;
bl w1 x2 ;
sl w1 4 ; if param = <end list> then
jl. a43. ; begin
al. w1 b3. ; message(<:area:>);
jl. w3 c12. ; goto exit fp
jl. d3. ; end;
a43: am -2000 ;
rs. w2 f13.+2000 ; save pointer(area description);
bz w1 x2+1 ;
se w1 4 ; if param = integer then
jl. a66. ;
am -2000 ;
rs. w0 f27.+2000 ; current core relative := param;
am -2000 ;
rs. w0 f32.+2000 ; hwd base := param;
a66: sn. w3 (b11.) ; if next param = (point, integer) then
jl. a41. ; goto numbering;
sn. w3 (b14.) ; if next param = (point,name) then
jl. a40. ; goto segmented;
a38: bl w1 6 ; test space:
sn w1 4 ; if delimiter = space then
jl. a42. ; goto area or process name;
\f
; fgs 1988.07.12 fp utility, print, page ...18...
a39: al. w1 b5. ; syntax error:
jl. w3 c12. ; message(<:param:>);
am -2000 ;
rl. w2 f13.+2000 ; w2 := addr(area description);
jl. w3 c1. ; list parameter;
jl. a37. ; goto again;
a40: jl. w3 c8. ; segmented: next param;
se. w0 (b28.) ; if param <> <:s:> then
jl. a39. ; goto syntax error;
al w0 6 ;
am -2000 ;
hs. w0 i1.+2000 ; content := 6;
se. w3 (b11.) ; if next param <> (point,integer) then
jl. a38. ; goto test space;
a41: jl. w3 c8. ; numbering:
am -2000 ;
rs. w0 f9.+2000 ; first number := next param;
al w1 1 ;
hs. w1 i27. ; first number read in memory area :=
hs. w1 i28. ; first number read in bs area := true;
jl. a38. ; goto test space;
a42: am -2000 ; area or process name:
rs. w2 f16.+2000 ;
am -2000 ;
rl. w3 f13.+2000 ;
al w3 x3 +2 ;
jd 1<11+4 ; process description;
sn w0 0 ; if process does not exist then
jl. d11. ; goto area;
rl w2 (0) ;
se w2 0 ; if process kind <> internal then
jl. d11. ; goto area;
\f
; fgs 1988.07.12 fp utility, print, page ...19...
rl w2 0 ; proc := process descr addr;
rl w0 x2+22 ; first addr :=
wa w0 x2+98 ; proc.first logical + proc.base;
am -2000 ;
rs. w0 f27.+2000 ; current core relative := first address;
am -2000 ;
rs. w0 f32.+2000 ; hwd base := first address;
rl w1 x2+24 ; last addr :=
wa w1 x2+98 ; proc.top logical addr +
al w1 x1-2 ; proc.base - 2;
am -2000 ;
rs. w1 f8.+2000 ;
am 1 ; internal process := true;
a50: al w1 0 ; ready:
am -2000 ;
rl. w0 f32.+2000 ; w0 := current core relative; <* = first address*>
am -2000 ;
rx. w0 f9. +2000 ;
i27 = k + 1; first number read:
sn w3 x3 ; if first number read then
jl. a70. ; first number := if internal process then
se w1 0 ; first number + proc.first logical addr else
wa w0 x2+22 ; first number ;
am -2000 ; else
rx. w0 f9.+2000 ; first number :=
a70: rl w1 x2+24 ; current core relative;
al w0 0 ;
hs. w0 i17. ; blocked := false;
am -2000 ;
rl. w2 f16.+2000 ; restore command pointer;
jl. a48. ; restore command pointer; goto all1;
\f
; fgs 1988.07.12 fp utility, print, page ...20...
d11: am -2000 ; area:
am. (f13.+2000); w1 := tail := first free core;
al w3 2 ; w3 := addr(area name);
dl w1 x3+2 ;
am -2000;
ds. w1 f17.+2+2000; move name from
dl w1 x3+6 ; parameter stack
am -2000; to
ds. w1 f17.+6+2000; input description;
al. w1 d5. ;
jd 1<11+42 ; lookup entry;
sn w0 0 ; if result <> 0 then
jl. a46. ; begin
sn w0 6 ; if name format illegal then
jl. a50. ; abs core addr: goto ready;
a45: al. w1 b6. ; unknown: mess name(<:unknown);
al w2 1 ;
am -2000 ;
rs. w2 f23.+2000 ; fpresult:=1;
jl. w3 c13. ; goto exit fp
jl. d3. ; end;
\f
; fgs 1988.07.12 fp utility, print, page ...21...
a46: am -2000 ; descriptor found:
zl. w0 i1.+2000 ;
sn w0 6 ; if content <> 6 <*segmented*> then
jl. a58. ;
zl w0 x1+16 ; content :=
am -2000 ;
hs. w0 i1.+2000 ; entry tail (16);
a58: rl w2 x1+14 ; blockno := entry tail (14);
zl w0 x1+16 ;
sh w0 31 ; if content >= 32 then
jl. a67. ; begin
rl w2 0 ; blockno :=
al w2 x2-32 ; content - 32;
a67: rl w0 x1 ; end;
sl w0 0 ; if tail(0) >= 0 then
jl. a47. ; goto prepare area process;
al w3 x1+2 ; w3 := addr(document name);
dl w1 x3+2 ;
am -2000;
ds. w1 f17.+2+2000; move name from
dl w1 x3+6 ; entry tail
am -2000; to
ds. w1 f17.+6+2000; input description;
al. w1 d13. ; w1 := first free core + 10;
jd 1<11+42 ; lookup entry;
se w0 0 ; if result <> 0 then
jl. a45. ; goto unknown;
am -2000 ;
rs. w2 f31.+2000 ; blockbase := blockno;
rl w0 x1 ;
sh w0 -1 ; if entry tail.size < 0 then
jl. a46. ; goto descriptor found;
\f
; fgs 1988.07.12 fp utility, print, page ...22...
a47: am -2000 ; prepare area process:
al. w3 f17.+2000 ; prepare area process:
jd 1<11+52 ; create area process;
se w0 0 ; if result <> 0 then;
jl. d4. ; goto area alarm;
am -2000 ;
rl. w1 f11.+2000 ;
am -2000 ;
rs. w1 f5. +2000 ; to block := infinite ;
am -2000 ;
rl. w1 f31.+2000 ;
am -2000 ;
rs. w1 f4. +2000 ; from block := block base;
am -2000 ;
rs. w1 f7. +2000 ; block := blockbase;
ld w1 9 ; total := double
am -2000 ;
wa. w1 f32.+2000 ; (block base < 9 +
am -2000 ;
ds. w1 f12.+2000 ; hwd base );
am -2000 ;
bz. w0 i1. +2000 ;
i28 = k + 1; first number read:
sn w3 x3 ; if first number read
se w0 7 ; or content <> 7 then
jl. d12. ; goto start print;
al w0 0 ;
hs. w0 i17. ; blocked := false;
am -2000 ;
dl. w0 f12.+2000 ; (w3, w0) := total;
jl. w2 c25. ; setposition;
jl. w3 c26. ;
am -2000 ;
rl. w0 f10.+2000 ; get word;
am -2000 ;
rs. w0 f9. +2000 ; first number := current word;
d12: am -2000 ; start print:
rl. w2 f16.+2000 ; restore command pointer;
al w0 1 ;
hs. w0 i14. ; bs area := true;
jl. a48. ; goto all1;
\f
; fgs 1988.07.12 fp utility, print, page ...23...
; procedure prepare entry for textoutput
; w0 not used
; w1 lookup area
; w2 name addr, entry must be present
; w3 return addr
b. a2 w.
a65: ds. w1 a1. ; save w0.w1
ds. w3 a2. ; save w2.w3
al w3 x2 ; w3:=name addr
jd 1<11+42 ; lookup
bz w2 x1+16 ;
sh w2 32 ; if contents=4 or
sn w2 4 ; contents>=32
jl. 4 ; then
jl. a0. ; file:=block:=0;
rs w0 x1+12 ;
rs w0 x1+14 ;
a0: rs w0 x1+16 ; contents.entry:=0;
rs w0 x1+18 ; loadlength:=0;
dl w1 110 ;
ld w1 5 ; shortclock;
rl. w1 a1. ;
rs w0 x1+10 ;
jd 1<11+44 ; changeentry;
dl. w1 a1. ; restore w0,w1
dl. w3 a2. ; restore w2,w3
jl x3 ; return
0 ; saved w0
a1: 0 ; saved w1
0 ; saved w2
a2: 0 ; saved w3
e.
\f
; fgs 1988.07.12 fp utility, print, page ...24...
d1 = k - d0 , d5 = k, d6 = k + 512, d13 = k + 10
0 ; zero, to terminate program segment
m0 = k - h55 ; load length
m1 = e2 - h55 ; entry point
i. ; id list
e. ; end segment: print
m.rc 1988.11.21 fp utility, print
\f
; fgs 1988.07.12 fp utility, print, page ...25...
g0:g1: (:m0+511:)>9 ; segm
0,r.4
s2 ; date
0,0 ; file, block
2<12+m1 ; contents, entry
m0 ; length
d.
p.<:insertproc:>
#
f
message message text fil 20
nextfile n g
n=edit g ; message text
;
; connect output : segm < 2 + key
l./page ...1/, r/rc 1976.05.21 /fgs 1988.09.08/
l./jl. w3 h28./, l-1, r/1<1+1/1<2+0/, r/one/one temporary/, r/ on disc//
l./m.rc/, r/86.08.15/88.09.08/
f
message move text fil 21
nextfile n g
n=edit move5tx ; move text
f
message cat adm 1 text fil 22
nextfile n g
set4tx=edit g ; cat adm 1 text, set setmt clearmt entry changeentry
; assign rename permanent nextfile
;
; nye modekind abbrev.
; general text parameter allowed in set, changeentry, assign and entry
;
l./cat adm 1/, r/rc 07.04.72/fgs 1988.19.13/
l./cfversion/, r/cfversion //
l./s. a200/, r/a200/a300/
l./...08/, r/rc 76.05.31/ fgs 1988.12.20/
l./a23:/, g1/name/ shortest name/
l./a25:/, i/
a223:4<12+ 9 ; space, nearly name
a123:4<12+(:7*8+10:); space, longest name
a124:8<12+(:7*8+10:); point, longest name
a28: 4<12+4 ; space, integer
/, p-2
l./...10/, r/84.06.18/8.05.06/
l./<:mto:>/, d./<:mthl:>/, i#
<:mto:>,0 , 1<23+ 0<12+18 ; mt, high density, odd parity
<:mte:>,0 , 1<23+ 2<12+18 ; even
<:nrz:>,0 , 1<23+ 4<12+18 ; low , odd
<:nrze:> , 1<23+ 6<12+18 ; even
<:mtlh:> , 1<23+ 0<12+18 ; low speed, high , odd
<:mtll:> , 1<23+ 4<12+18 ; low
<:mthh:> , 1<23+128<12+18 ; high speed, high
<:mthl:> , 1<23+132<12+18 ; low
<:mt62:> , 1<23+ 0<12+18 ; 6250 bpi
<:mt16:> , 1<23+ 4<12+18 ; 1600
<:mt32:> , 1<23+ 8<12+18 ; 3200
<:mt08:> , 1<23+12<12+18 ; 800
#, p1
l./...12/, r/rc 22.05.72 / fgs 1988.12.20/
l./sh. w3 (a23.)/, r/a23.) /a123.)/, p-1
l./se. w0 (a23.)/, d2, i/
sn. w0 (a28.) ; if param <> space, integer
se. w3 (a29.) ; or next param <> point, integer then
jl. b13. ; goto paramerror;
/, p-3
l./...13/, r/rc 78.03.18 / fgs 1988.11.30/
l./b. c9/, r/c9/c11/
l./se. w0 (a23.)/, d, i/
sh. w0 (a123.) ; if param > 4 < 12 + longest name
sh. w0 (a223.) ; or param < 4 < 12 + shortest name
/, l1, p-3
l./se. w0 (a23.)/, d, i/
sh. w0 (a123.) ; if param > 4 < 12 + longest name
sh. w0 (a223.) ; or param < 4 < 12 + shortest name
/, l1, p-3
l./ds. w1 a90./, i/
ls w1 -8 ; zero last char
ls w1 8 ; of last word in name;
/, p-2
l./sn. w0 (a23.)/, d2, i/
sh. w0 (a123.) ; if param > 4 < 12 + longest name
sh. w0 (a223.) ; or param < 4 < 12 + shortest name
jl. c10. ; goto not name else
jl. c0. ; goto test if date;
c10: sh. w0 (a25.) ; if nextsep = endsep then
/, p-5
l./sn. w0 (a23.)/, d2, i/
sh. w0 (a123.) ; if param > 4 < 12 + longest name
sh. w0 (a223.) ; or param < 4 < 12 + shortest name
jl. c11. ; goto not name else
jl. b13. ; goto paramerror;
c11: rl. w3 c7. ; if nextsep = endsep then
/, p-5
l./c5:/, l./sl w1 2/, g/2/4/
l./...17/, r/fgs 1981.08.05/ fgs 1988.10.13/
l./c16:/, r/c16:/ /
l./se. w0 (a23.)/, d, i/
sh. w0 (a123.) ; if param > 4 < 12 + longest name
sh. w0 (a223.) ; or param < 4 < 12 + shortest name then
/, l1, p-3
l./se. w0 (a23.)/, d, i/
sh. w0 (a123.) ; if param > 4 < 12 + longest name
sh. w0 (a223.) ; or param < 4 < 12 + shortest name
/, l1, p-3
l./se. w0 (a23.)/, d, i/
sh. w0 (a123.) ; if param > 4 < 12 + longest name
sh. w0 (a223.) ; or param < 4 < 12 + shortest name
/, l1, p-3
l./...18/, r/82.12.17/88.11.30/
l./se. w0 (a23.)/, l-1, d4, i/
se w3 0 ; if count <> 0 then
jl. c16. ; examine separator;
sh. w0 (a123.) ; if param > 4 < 12 + longest name
sh. w0 (a223.) ; or param < 4 < 12 + shortest name
jl. c16. ; goto eamine separator;
jl. w1 c21. ; test if date;
c16: ba w2 x2+1 ; examine separator:
/, l1, p-8
l./c9:/, l./sl w1 2/, g/2/4/
l./c15:/, l./se w1 10/, r/se w1 10/sh w1 9 /
l./cat adm 1, tails/, l./m./, r/84.06.18/88.12.20/
l./m. set/, r/ set/ set/
f
n=edit set4tx
; alarmen <:entry in use:> ved result 5 fra create entry ændres til
; <:entry in use or catbase illegal:> når catbase >= stdbase
l./...04/, r/82.12.17/89.07.06/
l./b46: am i46 ; /,
r#<: entry in use#<: entry in use/catalog base illegal#
l./...09/, r/82.12.17/89.07.07/
l./a46:/, r#<: entry in use#<: entry in use/catalog base illegal#
l./...13/, r/88.11.30/89.07.07/
l./c8:/, d./c6:/, i#
c8: al. w3 a91. ; rest of tail:
rs. w3 c7. ; pointer:=name table addr;
rl. w2 a2. ;
ba w2 x2+1 ;
rl w0 x2 ; if nextparam=name
sh. w0 (a123.) ; if param > 4 < 12 + longest name
sh. w0 (a223.) ; or param < 4 < 12 + shortest name
jl. c10. ; goto not name else
jl. c0. ; goto test if date;
c10: sh. w0 (a25.) ; if nextsep = endsep then
jl. c9. ; goto set shortclock;
c6: jl. w3 b27. ; next tail: next comp. param;
#, p1
l./c5:/, d./jl. b80./, i#
c5: sl w1 0 ; integer doc.name:
sl w1 4 ; if doc.name < 0 or >= 4
jl. b13. ; then goto paramerror;
rs. w1 a88. ; store parameter;
jl. c8. ; goto rest of tail;
c9: dl w1 110 ; set shortclock:
ld w1 5 ;
rs. w0 a91. ; save shortclock
jl. b80. ; goto set entry;
#, p1
l./a135: 0/, d b, i#
a135: 0 ;
a137: 1<23+4; bs-code
a138: 1<23 ; sign bit
\f
;fgs 1989.07.06 cat adm 1, tails
i.
m.rc 1989.07.06 fp utility, sys 3, cat adm 1
m. set , setmt , clearmt , entry , changeentry,
m. assign, rename, permanent, nextfile
e.
w.
g0: (:g2+511:)>9 ; entry set
0,r.4 ; name
s2 ; date
0,r.2 ;
2<12+g7-g3 ; cont, entry
g2 ; load length
1<23+4 ; entry setmt
0, r.4 ; name
s2 ; date
0, 0 ;
2<12+g14-g3 ; cont, entry
g2 ; load length
1<23+4 ; entry clearmt
0, r.4 ; name
s2 ; date
0,0 ;
2<12+g15-g3 ; cont, entry
g2 ; load length
1<23+4 ; entry entry
0,r.4 ; name
s2 ; date
0,r.2 ;
2<12+g8-g3 ; cont, entry
g2 ; load length
1<23+4 ; entry changeentry
0, r.4 ; name
s2 ; date
0, r.2 ;
2<12+g6-g3 ; cont, entry
g2 ; load length
1<23+4 ; entry assign
0, r.4 ; name
s2 ; date
0,0 ;
2<12+g5-g3 ; cont, entry
g2 ; load length
1<23+4 ; entry rename
0,r.4 ; name
s2 ; date
0,r.2 ;
2<12+g9-g3 ; cont, entry
g2 ; load length
1<23+4 ; entry permanent
0,r.4 ; name
s2 ; date
0,0 ;
2<12+g10-g3 ; cont, entry
g2 ; load length
g1: 1<23+4 ; entry nextfile
0,r.4 ; name
s2 ; date
0,r.2 ;
2<12+g11-g3 ; cont, entry
g2 ; load length
\f
d.
p.<:insertproc:>
l.
e.
#
f
message cat adm 2 text fil 23
nextfile n g
n=edit g ; cat adm 2 text, lookup search clear scope
;
; nye modekind abbrev.
; filters as search parameters
; nyt program delete
; base interval parameter til search og delete
; connect output : segm < 2 + key
;
l./cat adm 2/, r/adm 2/adm 2 ...0.../
l./lookup, search/, r/scope/delete, scope/
l./lookup search/, r/scope/delete scope/
l./...06/, r/rc 1976.05.25 / fgs 1988.08.04/
l./b9:/,
l./ds w1 x3+2/, d, i/
am. a50. ;
ds w1 +2 ; and save it in work name;
/, p1
l./ds w1 x3+6/, d, i/
am. a50. ;
ds w1 +6 ; and save it in work name;
/, p1
l./jl. b50./, i/
al. w0 a50. ; w0 := addr (work name);
/, p1
l./al w0 1<1+1/, r/1<1+1/1<2+0/
l./...08/, r/rc 76.05.25 / fgs 1988.08.02/
l./b15:/, l1, i/
sh w1 -2 ; if scope illegal, in max then
al w1 -2 ; scope := illegal, in std;
/, p-2
l./...10/, i#
\f
; fgs 1988.08.02 fp utility, system 3, cat adm 2 ...9a...
;procedure remove entry.
;
;removes the entry addressed by w2
;and returns to link + 2 if removed, to link if not removed
;at return the link b16 is different from zero.
;
;w0 destroyed
;w1 unchanged
;w2 addr of entry unchanged
;w3 link destroyed
;
b. j20 w.
j0: 0 ; saved w0
b66: ds. w3 b16. ; entry: save link, entry;
al w3 x2+6 ; w3 := entry.name;
jd 1<11+48 ; remove entry;
sn w0 0 ; if removed then
jl. j6. ; goto link + 2;
rs. w0 j0. ; save w0;
jl. w3 b26. ; outtext(<:***<prog> <scope>:>,
rl. w0 j0. ; restore w0;
se w0 2 ; if catalog error, document not ready then
jl. j1. ; begin
jl. w3 b43. ; outtext (<:bs device not ready<10>:>);
jl. j5. ; end else to link;
j1: jl. w3 b33. ; outtext (<: :>);
dl. w3 b16. ; restore entry;
al w0 x2+6 ; name := entry.name;
jl. w3 b30. ; outtext (name);
rl. w0 j0. ; restore w0;
se w0 3 ; if not found then
jl. j2. ; begin
jl. w3 b37. ; outtext (<: unknown<10>:>);
jl. j5. ; end else
j2: se w0 4 ; if entry protected then
jl. j3. ; begin
jl. w3 b47. ; outtext (<: entry protected<10>:>);
jl. j5. ; end else
j3: se w0 5 ; if used by another then
jl. j4. ; begin
jl. w3 b46. ; outtext(<: entry in use<10>:>);
jl. j5. ; end else
j4: jl. w3 b45. ; outtext (<: catalog error<10>:>);
j5: jl. (b16.) ; goto link;
j6: am. (b16.) ; return to link + 2:
jl +2 ;
e.
#
l./...11/, r/rc 16.02.72 / fgs 1988.08.02/
l./-2/, r/-2/-4/, l1, i/
; -2: illegal scope, interval contained in std, equals interval in scope
/, p1
l./b. j13/, r/j13/j14/
l./...12/, r/rc 11.02.72 / fgs 1988.08.02/
l./j4:/, i/
/
l./j13:/, l-1, d, i/
al w1 x1+1 ; else
sn. w0 (a12.) ; if int.low <> int in scope.low and
se. w1 (a13.) ; int.up <> int in scope.up then
jl. j11. ; goto inside max else
jl. j14. ; goto inside std, equals int in scope;
/, p1
l./j11:/, r/-2/-4/, i/
j14: am 2 ; inside std, equals int in scope
/, p1
l./...16/, r/82.11.24/88.07.10/
l./a102:/, l1, i/
a104: 0 ; addr of parameter after <scope>).<device>) in search
a105: 0 ; addr of catalog entry in filter algorithm in search
/, p-2
l./a29:/, l1, i/
a30: 4<12+ 4 ; space,integer
a50: 0, r.8 ; work name used in output entry
/, p-1
l./...18/, i#
; dh 1987.05.06 fp system, system 3, cat adm 2 ...17a...
b. a20, b3, c1, d5 w.
;This algorithm enables search to filter the output of catalog entries
;found according to a given scope specification. The filter works on
;the entry name and the document name of an entry.
;
;Syntax (augments):
;------------------
;( )1 ( )*
;(<out file> = ) search <scope spec> (<filter>)
;( )0 ( )0
;
; ( )*
;<filter> ::= <substring>(.<substring>)
; ( )0
;
; ( <generalized name> )
;<substring> ::= ( <name> )
; (<apostrophized name>)
;
;Function:
;---------
; The main catalog is scanned, and a subset of it is listed with an
;output format as for lookup. If an outfile is specified, the list of
;catalog entries is printed on that file, otherwise current output is
;used. Messages from search are always printed on current output.
; If no filters are given, all entries from the main catalog accor-
;ding to the scope spec (see Scope specification) are listed, other-
;wise, the set of catalog entries is further delimited by means of
;filters (see Filter specification below).
;
;Filter specification:
;---------------------
; A filter consists of one or more substrings concatenated by period.
;If a list of filters exists, an entry selected for listing will only
;be listed if either its name or its document name contain all the sub-
;strings of at least one of the filters. The order of the substrings
;in a filter is irrellevant.
; Thus, in a possible list of filters, you may consider space as "or"
;and period as "and", where the precedence of "and" and "or" is as in
;Algol.
\f
; dh 87.05.07 fp system, system 3, cat adm 2 ...17b...
;requirements:
; w0 w1 w2 w3 a104 a105
;
;entry: irr. irr. irr. return item after catalog
; scope spec entry
;
;exit: all registers and variables unchanged.
;
; the procedure returns to return+0 in case of failure
; and to return+2 in case of success.
;
b27: ds. w3 b3. ; save registers
rs. w2 a105. ; save addr entry;
rl. w3 a104. ;
el w2 x3 ; if item after scope spec = end command
sh w2 2 ; then goto letitpass1;
jl. a11. ;
ds. w1 b2. ;
rl. w2 a105. ; save addr entry;
al w2 x2+6 ; name in entry := entry name;
c1: al w3 x3+2 ; repeat <* entry- and document-name *>
ds. w3 d1. ; text part(item) := first item addr + 2;
al w3 10 ; x := 10;
; string := name in entry;
a0: rs. w3 d2. ;
al w1 x3 ; repeat
jl. w3 c0. ; namelength := x;
rl. w3 d2. ; l := takechar(x, string);
al w3 x3-1 ; x := namelength - 1;
sn w1 0 ; until l <> 0;
jl. a0. ;
a1: ; repeat <* all possibillities of filter *>
\f
; dh 87.05.05 fp system, system 3, cat adm 2 ...17c...
;a1: ; repeat <* items in a filter *>
rl. w0 d2. ; j := namelength; <* charcount in an entry *>
a2: rs. w0 d3. ; repeat <* stepping backward through the
; name in the entry *>
al w3 0 ;
jl. a4. ; for i := 0,
a3: rl. w3 d4. ; <*i controls pos in an item *>
al w3 x3+1 ; i+1 while l = k do
se. w1 (d5.) ; begin
jl. a5. ;
a4: rs. w3 d4. ;
am. (d3.) ; k := takechar
al w1 x3 ; (j+i, name in entry);
rl. w2 d0. ;
jl. w3 c0. ;
rs. w1 d5. ;
rl. w1 d4. ; l := takechar
rl. w2 d1. ; (i, item);
jl. w3 c0. ;
sn w1 0 ; if l = 0
jl. a6. ; then goto found;
jl. a3. ; end while loop;
a5: rl. w0 d3. ;
es. w0 1 ; j := j - 1;
sl w0 0 ; until j < 0 <* end backward stepping *>;
jl. a2. ; comment when the loop is exhausted, l<>0;
a6: ;found:
ba w2 x2-1 ; nopass := l <> 0; <* variable kept in w1 *>
rs. w2 d1. ; item := next item;
el w0 x2-2 ; sep := item separator;
se w0 8 ; until sep (item) <> '.'
jl. a7. ;
el w0 x2-1 ; or length (item) = 4 <*integer*>
sh w0 4 ;
jl. a12. ; or nopass <* end items in a filter *>;
al w0 8 ;
sn w1 0 ; comment hereafter either all substrings in a
jl. a1. ; filter have suceeded, or a filter failed;
\f
; dh 87.05.07 fp system, system 3, cat adm 2 ...17d...
a7: sn w1 0 ; if -,nopass <* i.e. a filter suceeded *>
jl. a10. ; then goto letitpass;
a8: se w0 8 ; comment a filter failed, therfore: ;
jl. a9. ; while sep = '.' do
a12: ba w2 x2-1 ; begin
el w0 x2-2 ; item := next item; sep := item separator;
jl. a8. ; end;
a9: rs. w2 d1. ; comment we may now examine the next filter;
sl w0 4 ; until sep = end command;
jl. a1. ; comment all filters have failed on this name;
rl. w2 a105. ; name in entry := document name;
al w2 x2+16 ; item := item after scope spec;
rl. w3 a104. ;
se. w2 (d0.) ; until document name tested once before;
jl. c1. ; comment the names have been tested with all fltrs;
dl. w1 b2. ;failure:
dl. w3 b3. ; restore registers;
jl x3 ; return failure;
a10: dl. w1 b2. ;letitpass:
a11: dl. w3 b3. ;letitpass1: restore registers;
jl x3+2 ; return success;
\f
; dh 87.05.05 fp system, system 3, cat adm 2 ...17e...
c0: ;subprocedure takechar(pos, string);
; call: w0: -; w1: pos; w2: string; w3: return
al w0 0 ; exit: w0: -; w1: char; w2: unch; w3: unch
wd. w1 b0. ; addr := pos // 3;
am x1 ; subpos := pos mod 3;
am x1 ;
rl w1 x2 ; substring := word(2*addr + string);
ls w0 3 ;
am (0) ; char := substring shift(subpos*8 -16)
ls w1 -16 ; extract 7;
la. w1 b1. ;
jl x3 ; return;
b0: 3 ; constant 3 <* chars per word *>
b1: 8.177 ; constant: last 7 bits;
0, b2: 0, 0, b3: 0 ; room for registers;
d0: 0 ; addr of name in an entry;
d1: 0 ; addr of text part of an item;
d2: 0 ; namelength, i.e. length of name part in an entry
d3: 0 ; var: j <* stepping through name in an entry *>
d4: 0 ; var: i <* stepping through an item *>
d5: 0 ; var: k <* char from an entry *>
e. ; end block
#
l./...18/, l./a62:/, l1, i/
i0: jl. b0. ; stepping stone:
i2: jl. b2. ; -
i3: jl. b3. ; -
i4: jl. b4. ; -
/, p-4
l./...19/, r/84.06.18/88.05.06/
l./<:mtlh:>/, d./<:mthl:>/, i#
<:mt62:> , 1<23+ 0<12+18; mt, low speed, 6250 bpi , odd parity
<:mte:>,0 , 1<23+ 2<12+18; , - - , high density, even -
<:mt16:> , 1<23+ 4<12+18; , - - , 1600 bpi , odd -
<:nrze:> , 1<23+ 6<12+18; , - - , low density, even -
<:mt32:> , 1<23+ 8<12+18; , - - , 3200 bpi , odd -
<:mt08:> , 1<23+ 12<12+18; , - - , 800 bpi , - -
<:mthh:> , 1<23+128<12+18; , high - , high density, odd -
<:mthl:> , 1<23+132<12+18; , - - , low - , - -
#, p1
l./...22/, r/rc 78.04.11 / fgs 1988.07.08/
l./c3:/, l./jl. w3 b15./, i/
jl. w3 b27. ; test filters;
jl. c4. ; if failure then goto step entry;
/, p-2
l./b64:/, i#
\f
; fgs 1988.12.19 fp utility, system 3, cat adm 2 ...23...
;the program delete
b. c6 w.
g7: jl. w1 b0. ; start: initialize program;
jl. w3 b8. ; if left side then connect;
rs. w1 a16. ; save output zone address;
jl. w3 b22. ; read scope parameter;
sn w3 8 ; if scope = system then
jl. b14. ; goto scope error;
sl w3 10 ; if scope=own
jl. c5. ; then goto change criteria;
c1: jl. w3 b17. ; prepare cat. scan;
jl. w3 b19. ; start cat. scan;
c2: jl. w3 b23. ; check entry: find entry scope;
c3: se. w1 (a14.) ; if entry(scope) <> actual
jl. c4. ; then goto step entry;
jl. w3 b24. ; test bs device spec.;
jl. w3 b27. ; test filters;
jl. c4. ; if failure then goto step entry;
jl. w3 b15. ; ok: output entry;
dl w1 x2+4 ; interval := entry.interval;
al. w3 a15. ; w3 := addr <::>; <*own process*>
jd 1<11+72 ; set catbase;
jl. w3 b66. ; remove entry;
jl. c0. ; if not removed then goto reset catbase;
c0: jl. w3 i3. ; reset catbase;
c4: jl. w3 b21. ; step entry: next entry;
jl. c2. ; more in buf: goto check entry;
jl. w3 b20. ; buf empty: input cat. segments;
jl. c2. ; more in cat: goto check entry;
rl. w0 b16. ; end search:
se w0 0 ; if some output
jl. b2. ; then goto end program;
jl. w3 b26. ; error text:
jl. w3 b40. ; outtext(***<prog.name> <scope>
jl. b2. ; no entries found); goto end prog;
c5: rl. w0 c6. ; change criteria:
rs. w0 c3. ; change crit. to: if entry
jl. c1. ; not visible ;
c6: sl w1 8 ; new instruction
e. ; end program delete
\f
; fgs 1988.07.08 fp utility, system 3, cat adm 2 ...24...
#
l1,
l./...22a/, r/22a/25/
l./...22b/, r/22b/26/
l./...22c/, r/22c/27/
l./...23/ , r/23/28/
l./a95=g4/, l1, i/
jl. b11. ; stepping stone for b11:
b11 = k - 2 ;
jl. b14. ; stepping stone for b14:
b14 = k - 2 ;
jl. b26. ; stepping stone for b26:
b26 = k - 2 ;
/, p-3
l./...24/, r/rc 28.02.72 / fgs 1988.07.10/, r/24/29/
l./;a12-a13/,
l-1, r/temp/basepair temp/
l1, r/stand/base stand/
l1, r/0/-2 0/
l./b. j12/, r/j12/j20/
l./b22:/, l2, r/b2./i2./
l2, i/
al w3 x2+10 ;
rs. w3 a104. ; save addr param after <scope>;
/, p-2
l./jl. b14./, r/b14./j13./, r/scope error/maybe interval/
l./ls w3 -2/, i/
\f
; fgs 1988.07.08 fp utility, system 3, cat adm 2 ...30...
/
l./j5:/, d, i/
j5: rl. w0 (a104.) ; look for bs device spec:
/, p1
l./...25/, r/rc 10.02.72 / fgs 1988.07.10/, r/25/31/
l./sl. w0 (a29.)/, i/
al w3 x2+10 ;
rs. w3 a104. ; save addr param after <scope>.<device>;
/, p-2
l./...26/, r/rc 15.02.72 / fgs 1988.07.10/, r/26/32/
l./jl. b2./, r/b2./i2./
l./e. ;end procedure read scope parameter/, i/
j13: se. w0 (a30.) ; if del, kind <> space, integer then
jl. b14. ; goto scope error;
rl w1 x2+2 ; int in scope.low := lower :=
rs. w1 a12. ; param;
jl. w3 b11. ; next param;
jl. i2. ; if end list then end program;
se. w0 (a29.) ; if del, kind <> point, integer then
jl. b14. ; goto scope error;
rl w1 x2+2 ; int in scope.up := upper :=
rs. w1 a13. ; param;
al w3 x2+4 ;
rs. w3 a104. ; save addr param after <interval>;
rl. w0 a12. ;
al w1 x1+1 ;
sl w0 x1 ; if lower > upper then
jl. b14. ; goto scope error;
sh. w0 (a6.) ; if lower > std.lower
sh. w1 (a7.) ; or upper < std.upper then
jl. j14. ; goto check contained in std;
jl. b14. ; else
; goto scope error;
j14: al w1 x1-2 ; check contained in std:
sl. w0 (a6.) ; if lower < std.lower
sl. w1 (a7.) ; or upper > std.upper then
jl. b14. ; goto scope error;
al w3 -2 ;
rs. w3 a14. ; save value;
jl. j5. ; goto look for bs dev. spec;
/
l./;call error:/, i/
\f
; fgs 1988.07.08 fp utility, system 3, cat adm 2 ...33...
/
l./jl. b2./, r/b2./i2./
l./jl. b2./, r/b2./i2./
l./ ...27/, r/rc 78.04.10 / fgs 1988.07.10/, r/27/34/
l./jl. w1 b0/, r/b0./i0./
l./jl. b2./, r/b2./i2./
l./jl. w3 b4./, r/b4./i4./
l./c3:/, d./jl. c0./, i/
c3: jl. w3 b66. ; remove entry;
jl. c0. ; if not removed then goto set catbase;
jl. c1. ; if removed then goto next clear ;
/, p-3
l./...28/, r/82.11.24/88.07.10/, r/28/35/
l./jl. w3 b3./, r/b3/i3/
l./jl. w3 b4./, r/b4./i4./
l./...29/, r/29/36/
l./sl w3 8/, r/if/or/, i/
sl w3 0 ; if scope < 0
/, p1
l./c5:/, d, i/
c5: am -2000 ; next scope:
jl. w3 b11.+2000 ; next param;
/, p-3
l./...30/, r/30/37/
l./...31/, r/87.03.13/88.07.10/, r/31/38/
l./jl. w3 b3./, r/b3./i3./
l./jl. w3 b3./, r/b3./i3./
l./am -2048/, d
r/b3./i3./, r/+2048/ /
l./...32/, r/rc 79.08.30 / fgs 1988.07.10/, r/32/39/
l./am -2048/, d
r/b3./i3./, r/+2048/ /
l./cat adm 2 tails/, l./rc 19/, r/87.03.13/88.12.19/, r/m.rc/m. rc/
l./m. look/, r/m. look/m. look/, r/clear/clear,delete/
l./g0:/, l-1, d./<:insertproc/, i/
w.
g0: (:g2+511:) > 9 ; no of segments
0,r.4 ;
s2 ; month year
0,r.2 ;
2<12+g4-g3 ; entry lookup
g2 ;
1<23+4 ; kind = bs
0,r.4 ;
s2 ; month year
0,r.2 ;
2<12+g5-g3 ; entry search
g2 ;
1<23+4 ; kind = bs
0,r.4 ;
s2 ; month year
0,r.2 ;
2<12+g6-g3 ; entry clear
g2 ;
1<23+4 ; kind = bs
0,r.4 ;
s2 ; month year
0,r.2 ;
2<12+g7-g3 ; entry delete
g2 ;
g1: 1<23+4 ; kind = bs
0,r.4 ;
s2 ; month year
0,r.2 ;
2<12+g10-g3 ; entry scope
g2 ;
d.
p.<:insertproc:>
/
f
message backfile text fil 24
nextfile n g
n=edit g ; backfile text
f
message copy skip text fil 25
nextfile n g
n=edit g
;
; connect output : seg < 2 + key
;
l./; init copy/, l./jl.w3 h28./, l-1, r/1<1+1/1<2+0/
l./m.rc/, r/78.04.17/88.09.08/
f
message base text fil 26
nextfile n g
n=edit base4tx ; base
f
message job text fil 27
nextfile n g
n=edit g
; connect output : segm < 2 + key
;
l./page 1/, r/rc 26.10.70/fgs 1988.09.08/
l./jl. w3 h28./, l-1, r/1<1+1/1<2+0/
l./m.rc/, r/07.02.74/88.09.08/
f
message claim text fil 28
nextfile n g
n=edit g
;
; connect output : segm < 2 + key
; claim <proc> ...
;
l./claim ...1/, r/85.03.13/89.01.10/
l./s. a26/, r/a26, b38/a99, b99/, r/d2/d9/
l./; variables/, i/
\f
; fgs 1989.01.10 claim ...1a...
/
l./b0:/, i/
b40: 0 ; process description address
b41: 0, r.4; process name
b49: 0 ; saved item adress
b50: 0 ;
b51: 0 ; save item head, address of head after <:all:>
/, l1, p-2
l./b21:/, r/entr/entr./
l./b22:/, r/segm/segm./
l./b24:/, r/***/<10>***/, r/<0>/param <0>/
l./b28:/, r/<10>/ /, r/area/area :/
l./b29:/, r/ buf/ buf :/
l./b30:/, r/ size/ size :/
l./b35:/, r/<:: :>/<: : <0>:>/
l./b38:/, r/ first core/ first :/, l1, i/
b39: <:<10>name : <0>:>
b42: <:area<0>:>
b43: <:buf<0>:>
b44: <:size<0>:>
b45: <:first<0>:>
b46: <:<32><32><32>:>
b47: <:<32><32><0>:>
b48: <:all:>
b52: 4<12 + 10
/, p-1
l./claim ...2/, d./a5:/, d./jl. a2./, i#
\f
; fgs 1989.01.10 claim ...2...
; program start:
; if a leftside is specified in the program call,
; the current input zone is stacked and used for
; secondary output.
a0: al w0 x3 ; save w3;
rs. w1 b8. ; save fpstart;
al. w1 h19. ;
jl. w3 h79. ; terminate prog zone
al w3 (0) ;
am. (h16.) ;
zl w1 27 ; save own process.area
rs. w1 b17. ; before connect
rl w0 x3 ; start: w0 := item head of program name;
el w2 0 ; w2 := separator;
se w2 6 ; if separator = equal then
jl. a1. ; begin
jl. w3 h29.-4 ; stack current input;
rl. w2 h8. ; w2 := outfile name;
al w2 x2+2 ;
al w0 1<2+0 ; comment: connect 1 segm. temporary
jl. w3 h28. ; connect output(w0, w1, w2);
se w0 0 ; if connect trouble then
jl. a7. ; error (<:connect output:>);
am h20-h21; outputzone := current input;
a1: al. w2 h21. ; end
rs. w2 b0. ; else outputzone := current output;
rl. w1 h16. ; process descr addr :=
rs. w1 b40. ; own process description addr;
dl w0 x1+4 ; move
lo. w3 b46. ; name of process
lo. w0 b46. ; or
ds w0. b41.+2 ; spaces
dl w0 x1+8 ; to
lo. w3 b46. ;
lo. w0 b47. ;
ds. w0 b41.+6 ; process name;
jl. w3 d1. ; next param;
am ; comment: skip <end param> action;
rs. w1 b49. ; saved item address := item address;
\f
; fgs 1989.01.10 claim ...3...
; comment: at this point the register contents are:
; w0 == item head
; w1 == item address
; w2 == irrellevant
; w3 == irrellevant
a2: ds. w1 b9. ; next parameter: save w0w1;
al w2 13 ;
rs. w2 b1. ; keymask := all scopes;
al w2 -1 ;
rs. w2 b2. ; devicename := all devices;
el w2 0 ;
sh w2 3 ; if separator = <end param> then
jl. a27. ; goto not internal proc;
zl w2 1 ;
se w2 10 ; if item kind <> <name> then
jl. a5. ; goto paramerror
el w2 0 ;
se w2 4 ; if separator = 'sp' then
jl. a27. ; begin <*maybe internal process*>
ea w1 x1+1 ; get next separator;
el w2 x1 ;
dl. w1 b9. ; restore w0w1;
sl w2 5 ; if next separator <> 'sp' and <> end param then
jl. a27. ; goto not internal process;
jl. w3 d4. ; get next internal process;
jl. a50. ; if no success then goto check item name;
rs. w1 b49. ; saved item address := item address;
rs. w3 b40. ; process descr addr := w0;
dl w1 x3+4 ; move
lo. w0 b46. ; process name
lo. w1 b46. ; or
ds. w1 b41.+2 ; spaces
dl w1 x3+8 ; to
lo. w0 b46. ;
lo. w1 b47. ;
ds. w1 b41.+6 ; process name;
jl. w3 d1. ; next param;
am 0 ; ignore end param list;
ds. w1 b9. ; save new w0w1;
al w3 1 ; new process :=
hs. w3 b6. ; true;
jl. a27. ; end <*maybe internal process*>;
; goto internal process;
a50: rl. w1 b49. ; check if item = <:all:>:
rl w0 x1+2 ;
se. w0 (b48.) ; if item.firat word = <:all:> then
jl. a27. ; begin
dl. w1 b51. ; get saved item head. address of head after <:all:>;
jl. a2. ; goto next parameter;
\f
; fgs 1989.01.10 claim ...3a...
a27: al w3 1 ; not internal process:
b6=k+1; new process
se w3 1 ; if not new process then
jl. a3. ; goto on with param;
rl. w1 b0. ;
al. w0 b39. ;
jl. w3 h31. ; writetext (<:<10>process name : :>);
al. w0 b41. ;
jl. w3 h31. ; writetext (process name);
al. w0 b28. ;
jl. w3 h31. ; writetext(<:area:>);
rl. w2 b40. ; area := if own process then
zl w0 x2+27 ; own process.area
sn. w2 (h16.) ; else
rl. w0 b17. ; process.area;
jl. w3 h32. ; writeinteger(area);
32<12+4 ;
al. w0 b29. ;
jl. w3 h31. ; writetext(<:buf.>);
am. (b40.) ;
zl w0 26 ;
jl. w3 h32. ; writeinteger(buf);
32<12+4 ;
al. w0 b30. ;
jl. w3 h31. ; writetext(<:size:>);
rl. w3 b40. ;
rl w0 x3+24 ;
ws w0 x3+22 ;
jl. w3 h32. ; writeinteger(size);
32<12+8 ;
al. w0 b38. ;
jl. w3 h31. ; writetext(<:first address:>);
am. (b40.) ;
rl w0 22 ;
jl. w3 h32. ; writeinteger(first address);
32<12+8 ;
al w2 0 ; new process :=
hs. w2 b6. ; false;
dl. w1 b9. ; restore w0w1;
el w2 0 ;
sh w2 3 ; if separator = <end param> then
jl. a8. ; goto search;
\f
; fgs 1989.01.10 claim ...3b...
a3: dl. w1 b9. ; on with param: restore w0w1;
a33: el w2 0 ; more param:
sh w2 3 ; if separator = <end param> then
jl. a6. ; goto terminate program;
zl w2 1 ;
se w2 10 ; if item kind <> <name> then
jl. a5. ; goto paramerror
ea w1 x1+1 ; get next item;
el w2 x1 ;
dl. w1 b9. ; restore (item);
sn w2 8 ; if next separator = '.' then
jl. a34. ; goto treat param;
el w2 0 ;
se w2 4 ; if separator <> 'sp' then
jl. a34. ; goto treat param;
jl. w3 d4. ; check internal process;
jl. a34. ; if no success then goto treat param;
jl. a8. ; if success then goto start search;
a34: rl. w3 b1. ; treat param:
rl w2 x1+2 ; w3:=
sn. w2 (b26.+2); if param=<:key:>
al w3 -1 ; then -1 else
sn. w2 (b31.+2); if param=<:temp:>
al w3 1 ; then 1 else
sn. w2 (b32.+2); if param=<:login:>
al w3 4 ; then 4 else
sn. w2 (b33.+2); if param=<:perm:>
al w3 8 ; then 8 else keymask;
sn. w3 (b1.) ; if w3 = keymask then
jl. a18. ; goto move docname;
rs. w3 b1. ; keymask := w3;
jl. a4. ; goto next param;
a18: dl w3 x1+4 ; move parametername to devicename;
ds. w3 b3. ;
dl w3 x1+8 ;
ds. w3 b5. ;
a4: jl. w3 d1. ; next param:
jl. a8. ; if param = <end param> then goto start search;
el w2 0 ; if separator <> <point> then
se w2 8 ; goto start search;
jl. a8. ;
ds. w1 b9. ; store (item);
jl. a33. ; goto more param;
a5: jl. w3 d2. ; paramerror: out error param;
jl. w3 d1. ; next param;
am ; comment: skip end param action;
al w2 1 ; succes := false;
hs. w2 b7. ;
jl. a2. ; goto next parameter;
#
l./...3a/, r/3a/3c/
l./a6:/, d3
r/ rl./a6: rl./
l./se. w1 h20./, i/
al w2 10 ;
jl. w3 h26. ; outchar ('nl');
/, p-2
l./rl. w3 h8./, g/./ /, i/
am. (b8.) ;
/, p1
l./jd 1<11+42/, l1, i/
al w2 x1 ; save w1;
dl w1 110 ;
ld w1 5 ; w0 := shortclock;
al w1 x2 ; restore w1;
rs w0 x1+10 ; tail.shortclock := w0;
/, p-5
l./jl. h7./, g/./ /, i/
am. (b8.) ;
/, p1
l./rl. w3 h8./, g/./ /, i/
am. (b8.) ;
/, p1
l./...4/, r/82.11.24/89.01.10/
l./al w1 1/, d1
l./...4a/, r/85.03.15/89.01.10/
l./h16/, l-1, d1, i/
wa. w1 b40. ; proc descr addr ;
/, p-1
l./...5/, r/85.03.13/89.01.10/
l./h16/, l-1, d1, i/
wa. w1 b40. ; proc descr addr ;
/, p-1
l./...6/, r/rc 19.06.1971 /fgs 1989.01.10/
l./a12:/, i/
/
l./dl. w1 b9./, d, i/
rl. w1 b0. ;
al w2 10 ;
jl. w3 h26. ; outchar ('nl');
rl. w1 b49. ;
rl w0 x1+2 ;
se. w0 (b48.) ; if saved item.word1 = <:all:> then
jl. a36. ; begin <*reset item address to point to <:all:>*>
jl. w3 d3. ; reset item address;
ds. w1 b51. ; save latest parameter address;
rl. w0 b52. ; w0 := 4 < 12 + 10;
rl. w1 b49. ; w1 := save item address;
ds. w1 b9. ; save (item);
; end;
a36: dl. w1 b9. ; restore (item);
/, p-4
l./a13:/, d3, i/
a13: rl. w2 b2. ; end of devices:
se w2 -1 ; if empty paramname then
jl. a35. ; begin
rl. w1 b0. ; w1 := outputzone;
al w2 10 ;
jl. w3 h26. ; outchar ('nl');
rl. w1 b49. ;
rl w0 x1+2 ;
se. w0 (b48.) ; if saved item.word1 = <:all:> then
jl. a37. ; begin <*reset item address to point to <:all:>*>
jl. w3 d3. ; reset item address;
ds. w1 b51. ; save latest parameter address;
rl. w0 b52. ; w0 := 4 < 12 + 10;
rl. w1 b49. ; w1 := save item address;
ds. w1 b9. ; save (item);
; end;
a37: dl. w1 b9. ; restore (item);
jl. a2. ; goto next param;
a35: ; end;
/, p-4
l./al w2 1/, d, i/
dl. w1 b2.+2 ; device not found:
sn. w0 (b42.) ;
se. w1 (b42.+2); if name is <:area:> then
jl. a28. ;
jl. a32. ; goto ok;
a28: sn. w0 (b43.) ;
se. w1 (b43.+2); if name is <:buf:> then
jl. a29. ;
jl. a32. ; goto ok;
a29: sn. w0 (b44.) ;
se. w1 (b44.+2); if name is <:size:> then
jl. a30. ;
jl. a32. ; goto ok;
a30: sn. w0 (b45.) ;
se. w1 (b45.+2); if name is <:first:> then
jl. a31. ;
jl. a32. ; goto ok;
a31: al w2 1 ; failure:
/, p-2
l./dl. w1 b9./, d, i/
a32: rl. w1 b49. ;
rl w0 x1+2 ;
se. w0 (b48.) ; if saved item.word1 = <:all:> then
jl. a38. ; begin <*reset item address to point to <:all:>*>
jl. w3 d3. ; reset item address;
ds. w1 b51. ; save latest parameter address;
rl. w0 b52. ; w0 := 4 < 12 + 10;
rl. w1 b49. ; w1 := save item address;
ds. w1 b9. ; save (item);
; end;
a38: dl. w1 b9. ; restore (item);
/
l./d2 = k+2/, l1, i/
d3 = k+4 ; entry to procedure reset param pointer
/, p-2
l./...7/, r/rc 19.06.1971 /fgs 1989.01.10/
l./a9 , b7/, r/a9 /a10/
l./a0:/, i/
; procedure reset param pointer;
; the procedure resets the param pointer in b2 by the value of
; w1 at call and returns the old value of item head and address in w0, w1.
;
; w0 == old value of item head
; w1 == old value of item address
; w2 == unchanged
; w3 == unchanged
;
; return is made to w3.
a10: rx. w1 b2. ; swop address of item head;
rl w0 x1 ;
jl x3 ; return;
/, p-3
l./...8/, r/rc 19.06.1971 /fgs 1989.01.10/
l./b4:/, r/***/<10>***/
l./d0 = k ; length of program/, i#
\f
; fgs 1989.01.10 claim ...9...
; the following pages contain the code for fetching the
; next internal process description address which matches the name
; pointed to by x1+2
; if the name pointed to by x1+2 is <:all:>, the procedure gets the
; next used internal procedure description address and leaves the
; variable 'next internal in nametable' to point at the next procedure
; description.
;
; at entry and return the contents of w0, w1, w2 and w3 are :
;
; w0 : - unchanged
; w1 : name address -2 unchanged
; w2 : - unchanged
; w3 : link proc descr address
;
; return to :
; no success : link
; success : link +2
b. a9 , b9 ; begin block get next internal
w.
d4: ds. w1 b1. ; save registers
ds. w3 b3. ;
rl w2 x1+2 ;
sn. w2 (b48.) ; if name.param.word1 = <:all:> then
al w1 0 ; single process := false;
hs. w1 b6. ; else
hs. w1 b7. ; single process := true;
hs. w1 b8. ;
se w1 0 ; if not single process then
jl. a0. ; begin <*set the next index*>
rl. w2 b4. ; index :=
sn w2 0 ; if next in nametable = 0 then
a0: rl w2 78 ; first in nametable else
; else
; next in nametable;
; end else
; index := first in nametable;
a1: rl w3 x2 ; next process:
dl w0 x3+4 ;
sl. w3 (b5.) ; if name.index.first word.first char <> 0 and
b6=k+1;
se w3 x3+0 ; name.param.first word = <:all:> then
jl. a2. ;
jl. a3. ; goto success;
a2: sn w3 (x1+2) ; if name.index.first word <>
se w0 (x1+4) ; name.param.first word then
jl. a4. ; goto miss;
rl w3 x2 ;
dl w0 x3+8 ;
sn w3 (x1+6) ; if name.index.secnd word <>
se w0 (x1+8) ; name.param.secnd word then
jl. a4. ; goto miss;
a3: dl. w1 b1. ; success:
rl w3 x2 ; proc descr addr := nametable.index;
al w2 x2+2 ;
b7=k+1;
sn w3 x3+0 ; if name.param.first word = <:all:> then
rs. w2 b4. ; next in nametable := index + 2;
rl. w2 b2. ; restore registers;
am. (b3.) ; return to
jl +2 ; link + 2;
a4: ; miss:
al w2 x2+2 ; index := index + 2;
se w2 (80) ; if index <> last in nametable then
jl. a1. ; goto next proc;
al w2 0 ; no success:
b8=k+1;
sn w3 x3+0 ; if not single process then
rs. w2 b4. ; next in nametable := 0;
dl. w1 b1. ;
dl. w3 b3. ; restore registers;
jl x3 ; goto link;
b0: 0 ; saved w0
b1: 0 ; - w1
b2: 0 ; - w2
b3: 0 ; - w3
b4: 0 ; next in nametable
b5: 1<16 ;
d.
e. ; end block get next internal
l.
\f
; fgs 1989.01.10 claim ...10...
#
l./m. rc/, r/85.03.13/89.01.10/
f
message rubout text fil 29
nextfile n g
n=edit g
f
message correct text fil 30
nextfile n g
n=edit g
f
message compress text fil 31
nextfile n g
n=edit g
;
; connect output : segm < 2 + key
;
l./; connect output zone.../, l./jl. w3 h28./, l-3, r/1<1+1/1<2+0/
l./m. rc/, r/85.03.13/88.09.08/
f
message compresslib text fil 32
nextfile n g
n=edit g
;
; close up text output on any alarm
; endless loop in case of parameter error
; check entry permkey as well as entry bases
; end of doc in input => transport error in input
; rejected input from catalog => repeat
; check startsegment of any already compressed entry against size
l./page 2/, r/86.07.04/88.10.12/
l./b13:/, l1, i/
b14: 0 ; - - - permkey;
/, p-1
l./page ...5/, r/86.07.03/88.10.12/
l./a0:/, d3, i/
a0: zl w2 x3+1 ; begin
sn w2 0 ; if preceeding length (param) = 0 then
jl. a1. ; goto finis;
hs w0 x3 ; preceeding separator (param) := 4; <*<s>*>
/, p-3
l./a1: rx. w1 d1./, l./comment i + 6/, d./jl. a0./, i/
ls w1 1 ; <*i + k + 4 is rel addr of last word of ext list*>
wa. w1 d1. ; <*i. e. rel addr of the word containing <date> *>
al w0 x1 ;
a0: wa w0 6 ; for i := i + k
sh w0 502-7 ; while i + k + 4 > 502 - 2 do
jl. (d0.) ; begin
; <*if there is only one word left on the seg-*>
; <*ment then it is used for continuation word*>
jl. w3 c3. ; input extra segment; k := rel start ext list;
al w3 x3-502 ; k := k - 502;
jl. a0. ; end;
/, p-11
l./page 6/, r/86.07.04/88.10.12/
l./c3:/, l./rl. w2 d0./, i/
rl. w3 b1.+22 ; if input zone.share.top transferred -
ws. w3 b1.+8 ; input zone.share.first address <= 2
sh w3 2 ; then
jl. f0. ; goto transport error input zone;
/, p-4
l./c7:/, l./ds. w0 b12./, l1, i/
al w0 7 ; ;
la w0 x1 ; save entry permkey;
rs. w0 b14. ;
/, p-3
l./bz w0 x1+30/, i/
al w0 7 ;
la w0 x1 ; if entry permkey <> saved permkey then
se. w0 (b14.) ; result := 2
jl. a3. ; else
/, p-4
l./page 7/, r/86.07.04/88.10.12/
l./a3=k-a0/, r/interval/scope/
l./page 8/, r/rc 06.03.73 /fgs 1988.10.12/
l./jl. c6./, i/
am -2000 ;
jl. w3 h95.+2000 ; close up text output (curr out);
/, p-1
l./jl. c5./, i/
am -2000 ;
jl. w3 h95.+2000 ; close up text output (curr out);
/, p-1
l./page 9/, r/rc 01.03.73 /fgs 88.10.12/
l./a3:/, l./jl. c0./, i/
am -2000 ;
jl. w3 h95.+2000 ; close up text output (curr out);
/, p-1
l./page 10/, r/rc 03.04.74 /fgs 1988.10.12/
l./d6:/, r/-1<2/-1<3/, r/tus/tus (all except rejected, normal, hard)/
l./page 11/, r/86.07.04/88.10.12/
l./check entry base/, r/base/base, permkey/
l./page 12/, r/86.07.04/88.10.12/
l./a4:/, l2, i/
al w2 0 ;
se w0 1 ; if dummy answer then
rs w2 x1 ; status := 0;
/, p-3
l./a6:/, l./dl. w1 b0.+h1+4/, i/
al w0 7 ;
la w0 x2 ; if entry permkey <> saved entry permkey then
se. w0 (b14.) ; goto next entry;
jl. a7. ;
/, p-4
l./rs. w1 b0.+h1+16/, i/
am. (b4.+14) ; if first segment >
sl w1 1 ; outputfile.size then
jl. a7. ; goto next_entry; <*entry doesnt belong*>
zl w0 x2+31 ; input entry.rel start external list :=
hs. w0 b4.+31 ; entry.rel start external list;
/, p-5
l./page 13/, r/rc 24.03.83 /fgs 88.10.12/
l./m.compr/, r/86.07.04/88.10.12/
f
message translated text fil 33
nextfile n g
n=edit translat4tx
f
message procsurvey text fil 34
nextfile n g
n=edit procsurv4tx
;
; start ext list = 500 => break 0
;
l./page ...1/, r/88.09.20/89.08.18/
l./first of buffer-1/, r/10/h0/
l./page ...4/, r/88.09.20/89.08.18/
l./d10:/, l./rl. w3 c15./, l-1, r/+/;/
l./rl. w3 c15./, i/
rl. w0 c2. ;
sn w0 500 ; if startext = 500 then
jl. d17. ; goto change segment;
/, p-3
l./rl. w3 c15./, r/;/; addr := addr +/
l./page ...5/, r/88.09.20/89.08.18/
l./rl. w1 h54./, r/ /d17: /
l./d15:/, r/;/; else/
l./d16:/, l-2, r/;/; +/
l./d16:/, d, i/
d16: al w1 x1+6 ; 6 +
wa. w1 c2. ; startext;
am +2000 ;
al. w1 x1+c27. ;
rs. w1 c3. ;
/
l./page ...9/, r/88.09.20/89.08.18/
l./d22:/, r/d22:/ /
l./page ...18/,
l./m./, r/88.09.20/89.08.18/
f
message label text fil 35
nextfile n g
n=edit g
;
; nye modekind abbr.
l./page ...6/, r/84.06.18/88.05.05/
l./c20:/, l./c15:/, i/
<:mt62:> , 1<23+ 0<12+18; mt, 6250 bpi , odd
<:mt16:> , 1<23+ 4<12+18; 1600
<:mt32:> , 1<23+ 8<12+18; 3200
<:mt08:> , 1<23+ 12<12+18; 800
/, p-5
l./m.1984/, r/1984.06.18/rc 1988.05.05/
f
message rewind unload text fil 36
nextfile n g
n=edit rewind4tx
f
message allocbuf til brug for save text fil 37
nextfile n ;g = text fil 36
n=edit g
f
;fpproc i g text fil 37 bruges ikke mere
nextfile g
;
message save13 text fil 38
nextfile n g
n=edit g
;
; parameter array til system med lower bound = 0
; connect output : segm < 2 + 0
l./page ... 36/, l./message stack current output/, l-1, r/81.12.07/88.09.08/
l./result := 2;/, r/2/1 shift 2/, r/1<1/1<2/, r/preferably on drum/temporary/
l./message prepare cat scan page 2/, l-1, r/82.12.28/89.01.17/
l./integer field/, l1, i/
integer array field iaf;
/, p-1
l./result :=/, i/
iaf := -2;
/, p1
l./system (5 )/, r/proc_descr)/proc_descr.iaf)/
l./message skip entry page 1;/, l-1, r/83.02.09/88.09.02/
l./<:covered by a better entry/,
r/covered by a better entry/area process inaccessible/
l./errorbits := 2/, d, i/
if result extract 12 < 4 then
errorbits := 2; <*warning.yes, ok.yes*>
/, p-2
f
message load13 text fil 39
nextfile n g
n=edit g
f
message catsort text fil 40
nextfile n g
n=edit g
; aux cat : 2 linier pr entry, den anden skal tælles med ved udskrift
; nye modekinds : mt62, mt32, mt16, mt08
; connect output : segm < 2 + key
;
l./procedure stack_current_output (file_name);/,
l./result := 2;/, r/2/1 shift 2/, r/1<1/1<2 + 0/, r/preferably disc/temporary/
l./procedure outmodekind;/, d./end outmodekind;/, i#
procedure outmodekind;
begin integer i, monrelease;
integer array dummyia (1:12);
<*get monitor release*>
system (5) move core :(64, dummyia);
monrelease := dummyia (1); <*rel shift 12 + subrel*>
for i:=1 step 1 until 25 do
begin
if segm = (case i of (
<*ip*> 1 shift 23 + 0 shift 12 + 0,
<*bs*> 1 shift 23 + 0 shift 12 + 4,
<*tw*> 1 shift 23 + 0 shift 12 + 8,
<*tro*> 1 shift 23 + 0 shift 12 + 10,
<*tre*> 1 shift 23 + 2 shift 12 + 10,
<*trn*> 1 shift 23 + 4 shift 12 + 10,
<*trf*> 1 shift 23 + 6 shift 12 + 10,
<*tpo*> 1 shift 23 + 0 shift 12 + 12,
<*tpe*> 1 shift 23 + 2 shift 12 + 12,
<*tpn*> 1 shift 23 + 4 shift 12 + 12,
<*tpf*> 1 shift 23 + 6 shift 12 + 12,
<*tpt*> 1 shift 23 + 8 shift 12 + 12,
<*lp*> 1 shift 23 + 0 shift 12 + 14,
<*crb*> 1 shift 23 + 0 shift 12 + 16,
<*crd*> 1 shift 23 + 8 shift 12 + 16,
<*crc*> 1 shift 23 + 10 shift 12 + 16,
<*mto*> 1 shift 23 + 0 shift 12 + 18, <*mt62, mtlh*>
<*mte*> 1 shift 23 + 2 shift 12 + 18,
<*nrz*> 1 shift 23 + 4 shift 12 + 18, <*mt16, mtll*>
<*nrze*> 1 shift 23 + 6 shift 12 + 18,
<* *> 1 shift 23 + 8 shift 12 + 18, <*mt32*>
<* *> 1 shift 23 + 12 shift 12 + 18, <*mt08*>
<*mthh*> 1 shift 23 +128 shift 12 + 18,
<*mthl*> 1 shift 23 +132 shift 12 + 18,
<*pl*> 1 shift 23 + 0 shift 12 + 20 ))
then goto found
end;
found:
if i=26 then
begin
write(out,<<dddd>,segm shift (-12),<:.:>,
<<d>,segm extract 12,sp,
if segm extract 12<10 then 2 else 1);
end else
begin
if monrelease < 80 shift 12 + 0 then
write (out, true, 8, case i of (
<: ip:>,
<: bs:>,
<: tw:>,
<: tro:>,
<: tre:>,
<: trn:>,
<: trf:>,
<: tpo:>,
<: tpe:>,
<: tpn:>,
<: tpf:>,
<: tpt:>,
<: lp:>,
<: crb:>,
<: crd:>,
<: crc:>,
<:mtlh:>,
<: mte:>,
<:mtll:>,
<:nrze:>,
<:mt32:>,
<:mt08:>,
<:mthh:>,
<:mthl:>,
<: pl:> ))
else
write(out, true, 8, case i of (
<: ip:>,
<: bs:>,
<: tw:>,
<: tro:>,
<: tre:>,
<: trn:>,
<: trf:>,
<: tpo:>,
<: tpe:>,
<: tpn:>,
<: tpf:>,
<: tpt:>,
<: lp:>,
<: crb:>,
<: crd:>,
<: crc:>,
<:mt62:>,
<: mte:>,
<:mt16:>,
<:nrze:>,
<:mt32:>,
<:mt08:>,
<:mthh:>,
<:mthl:>,
<: pl:> ));
end;
end outmodekind;
#
l./sorted:/, l./if cat >= 0 and segm >= 0 then/, l2, i/
line := line - 1;
/, p1
f
message claimtest text fil 41
nextfile n g
n=edit g
f
message copyarea til brug for save vers 2 text fil 42
nextfile n g
n=edit g
f
message save version 2 text fil 43
nextfile n g
n=edit g
;
; remove process udskydes til senere i save entries
; check af write access counter og area size genindføres nu da ida er enkbufret
; "covered by a better entry" => "area process inaccessible"
; "area size changed during save" laves om fra alarm til warning
; parameter array til system med lower bound = 0
; high speed bit til og fra i save entries
; connect output : segm < 2 + 0
l./page ... 36/, l./message stack current output/, l-1, r/81.12.07/88.09.08/
l./result := 2;/, r/2/1 shift 2/, r/1<1/1<2/, r/preferably on drum/temporary/
l./page ...38/, l./message connect output/, l-1, r/84.04.25/88.09.08/
l./1 shift 1/, r/1 shift 1/1 shift 2/, r/pref drum/temporary/
;********************************************
l./message decl. second level/, l./page 2;/, l-1, r/85.02.08/88.02.04/
l./dummy,/, i/
speedlimit ,
monrelease ,
/, p1
;********************************************
l./message mount param page 1;/, l-1, r/81.12.04/88.08.21/
l./<********/, d, d./<*******/, i/
<***************************************************************>
<* *>
<* The procedure returns the kind of the item given. *>
<* *>
<* Call : mount_param (seplength, item); *>
<* *>
<* mount_param (return value, integer). The kind of the *>
<* item : *>
<* 0 seplength<> <s> or ., item not below *>
<* 1 seplength = <s> or ., item = mountspec *>
<* 2 -"- , -"- release *>
<* 3 -"- , -"- mt62, mtlh, mto *>
<* 4 -"- , -"- mte *>
<* 5 -"- , -"- mt16, mtll, nrz *>
<* 6 -"- , -"- nrze *>
<* 7 -"- , -"- mt32 *>
<* 8 -"- , -"- mt08 *>
<* 9 -"- , -"- mthh *>
<* 10 -"- , -"- mthl *>
<* seplength (call value, integer). Separator < 12 + *>
<* length as for system (4, ...). *>
<* item (call value, array). An item in *>
<* item (1:2) as for system (4, ...). *>
<* *>
<***************************************************************>
/
l./message mount param page 2;/, l-1, r/84.05.30/88.08.21/
l./for i := 1 step 1/, d./i := 8/, i/
for i := 1 step 1 until
(if seplength <> space_txt and
seplength <> point_txt then 0 else 10) do
if item (1) = real ( case i of (
<:mount:> add 's',
<:relea:> add 's',
<:mt62:> ,
<::> ,
<:mt16:> ,
<::> ,
<:mt32:> ,
<:mt08:> ,
<::> ,
<::> ) ) and
item (2) = real ( case i of (
<:pec:> ,
<:e:> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ) )
or item (1) = real ( case i of (
<::> ,
<::> ,
<:mtlh:> ,
<::> ,
<:mtll:> ,
<::> ,
<::> ,
<::> ,
<:mthh:> ,
<:mthl:> ) ) and
item (2) = real ( case i of (
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ) )
or item (1) = real ( case i of (
<::> ,
<::> ,
<:mto:> ,
<:mte:> ,
<:nrz:> ,
<:nrze:> ,
<::> ,
<::> ,
<::> ,
<::> ) ) and
item (2) = real ( case i of (
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ) ) then
begin j := i; i := 10; end;
/
l./message prepare cat scan page 2/, l-1, r/85.07.09/88.02.01/
l./integer field/, l1, i/
integer array field iaf;
/, p-1
l./result :=/, i/
iaf := -2;
/, p1
l./system (5 )/, r/proc_descr)/proc_descr.iaf)/
l./message save entries page 8;/, l-1, r/85.07.09/88.02.01/
l./close (zhelp/, d1, i/
close (zhelp, false); <*process will be removed later*>
/, p1
l./message save entries page 12/, l-1, r/85.07.02/88.11.03/
l.#if (entry_kind (j) // segm) > 4#, d6, i#
for copy_count := 1 step 1 until copies do
if modekind (copy_count) shift 4 < 0 then
begin <*high speed bit specified*>
getzone6 (za (copy_count), zdescr);
zdescr (1):=
if entry_kind (j) <
speedlimit /
(if modekind (copy_count) shift 9 < 0 then 4 else 1) then
logand (modekind (copy_count),
-(1 shift 19 + 1)) extract 23 <*clear*>
else
logor (modekind (copy_count),
1 shift 19 ) extract 23;<*set *>
if test then
write (out,
"nl", 1, <:high speed bit zone (:>, copycount,<:) = :>,
zdescr (1) shift (-19) extract 1,
"nl",1,<:size = :>, entry_kind (j),
"nl", 1, <:speedlimit/dens = :>, speedlimit/
(if modekind (copycount) shift 9 < 0 then 4 else 1));
setzone6 (za (copy_count), zdescr);
end;
#, p1
l./<. write acces counter again/, r/<*/ /, g 18/<./<*/, g -18/.>/*>/
l-19,
l./<*write acces counter again*>/, d2, i/
<* write access counter again*>
system (5) move core :( entry_nta (j) , proc);
system (5) move core :( proc (1) - 4, proc);
if test then
write (out,
"nl", 1, <:entry_nta (j) = :>, entry_nta (j) ,
"nl", 1, <:proc (17) = :>, proc (17) ,
"nl", 1, <:write acc = :>, entry_wr_acc (j));
/
l./true, 9/, g/, 9,/, 10,/
l./*** alarm : area size changed during save/, r/alarm/warning/
l./true, 9/, g/, 9,/, 10,/
l2, r/trap (-1)/errorbits := 2/, r/;/; <*warning.yes, ok.yes*>/
l2, r/*>/ /
l./begin <*remove highspeed bit in modekind*>/, l-1, d./if ida_copy/, d./end;/
i#
getzone6 (za (copy_count), zd);
zd (1) := logand (modekind (copy_count),
-(1 shift 19 + 1)) extract 23 <*clear high speed*>;
if ida_copy then
begin <*update position in tape zone*>
getposition (zida ,
fileno (copy_count),
blockno (copy_count));
zd (7) := fileno (copy_count);
zd (8) := blockno (copy_count);
end;
setzone6 (za (copy_count), zd);
#, p1
l./end <*next entry*>/, l./if entry_kind (j) > 0/, r/>/>=/, p1
l./monitor (64/, d, i/
area_proc := monitor (4) proc :(zhelp, 0, proc <*dummy*>);
if area_proc <> outproc and
area_proc <> catproc then
monitor (64) remove process :(zhelp, 0, zdescr);
/, p-4
l./message list entry page 2;/, l-1, r/81.12.30/88.08.11/
l./write (z, "sp", 3, true, 7, case modekind/, d./<:mte:>/, i/
if monrelease < 80 shift 12 + 0 then
write (z, "sp", 3, true, 7, case modekind of (
<: ip:>, <: bs:>, <: tw:>, <: tro:>, <: tre:>, <: trn:>,
<: trf:>, <: trz:>, <: tpo:>, <: tpe:>, <: tpn:>, <: tpf:>,
<: tpt:>, <: lp:>, <: crb:>, <: crd:>, <: crc:>, <:mtlh:>,
<: mte:>, <:mtll:>, <:nrze:>, <:mt32:>, <:mt08:>, <:mthh:>,
<:mthl:>, <: pl:> ))
else
write (z, "sp", 3, true, 7, case modekind of (
<: ip:>, <: bs:>, <: tw:>, <: tro:>, <: tre:>, <: trn:>,
<: trf:>, <: trz:>, <: tpo:>, <: tpe:>, <: tpn:>, <: tpf:>,
<: tpt:>, <: lp:>, <: crb:>, <: crd:>, <: crc:>, <:mt62:>,
<: mte:>, <:mt16:>, <:nrze:>, <:mt32:>, <:mt08:>, <:mthh:>,
<:mthl:>, <: pl:> ));
/
l./message skip entry page 1;/, l-1, r/85.07.08/88.09.02/
l./<:covered by a better entry/,
r/covered by a better entry/area process inaccessible/
l./errorbits := 2/, d, i/
if result extract 12 < 4 then
errorbits := 2; <*warning.yes, ok.yes*>
/, p-2
l./message modekind case page 1;/, l-1, r/81.12.30/88.08.11/
l./until 24/, r/24/26/
l./<*mto, mtlh*>/, d./<*mthl*>/, i/
1 shift 23 + 0 shift 12 + 18, <* mt62, mto, mtlh*>
1 shift 23 + 2 shift 12 + 18, <* mte*>
1 shift 23 + 4 shift 12 + 18, <* mt16, nrz, mtll*>
1 shift 23 + 6 shift 12 + 18, <* nrze*>
1 shift 23 + 8 shift 12 + 18, <* mt32*>
1 shift 23 + 12 shift 12 + 18, <* mt08*>
1 shift 23 +128 shift 12 + 18, <* mthh*>
1 shift 23 +132 shift 12 + 18, <* mthl*>
/, p-8
l./i := 24/, r/24/26/
l./message program/, l./page 2;/, l-1, r/85.01.16/88.08.11/
l./<*obtain area and buffer claim*>/, i/
<*get monitor release*>
system (5) move core :(64, dummyia);
monrelease := dummyia (1); <*rel shift 12 + subrel*>
/, p-3
l./message program/, l./page 3;/, l-1, r/84.05.30/88.02.04/
;*********************************************
l./tape_param_ok :=/, l1, i/
<*
write (out, "nl", 1, <:speed limit : :>, "<", 1);
*>
<*stopzone (out, false);*>
<*read (in, speedlimit);
write (out, "nl", 1, <:speed limit : :>, speedlimit, "nl", 1);
*>
<*stopzone (out, false);*>
speedlimit := 100;
/
;**********************************************
l./message program page 4/, l-1, r/81.12.15/88.09.16/
l./1 shift 23 + 18/, d./1 shift 23+132/, i/
modekind (copycount) := 1 shift 23 + 18; <*mto, mtlh, mt62*>
modekind (copycount) := 1 shift 23 + 2 shift 12 + 18; <*mte*>
modekind (copycount) := 1 shift 23 + 4 shift 12 + 18; <*nrz, mtll, mt16*>
modekind (copycount) := 1 shift 23 + 6 shift 12 + 18; <*nrze*>
modekind (copycount) := 1 shift 23 + 8 shift 12 + 18; <*nr32*>
modekind (copycount) := 1 shift 23 +12 shift 12 + 18; <*mt08*>
modekind (copycount) := 1 shift 23+128 shift 12 + 18; <*mthh*>
modekind (copycount) := 1 shift 23+132 shift 12 + 18; <*mthl*>
/
l./message declare zones page 1;/, l-1, r/85.01.16/88.08.11/
l./ida_copy :=/, i/
ida_copy := monrelease < 80 shift 12 + 0; <*monitor release 80*>
/, l1, r/ida_copy :=/idacopy :=
idacopy and/,
p-2
f
message load vers 2 text fil 44
nextfile n g
n=edit g
;
; ignore parity error in magtape
; prepare for sizes different than the ones wanted
; connect output : segm < 2 + key
l./page ... 36/, l./message stack current output/, l-1, r/81.12.07/88.09.08/
l./result := 2;/, r/2/1 shift 2/, r/1<1/1<2/, r/preferably on drum/temporary/
l./page ...38/, l./message connect output/, l-1, r/84.04.25/88.09.08/
l./size shift 1/, r/shift 1/shift 2/, r/pref drum/temporary/
l./message decl. second level page 1;/, l-1, r/84.10.31/88.11.17/
l./boolean/, l./inc_dump/, i/
reading_savecat ,
/, p-1
l./boolean array/, l./expell_zone/, i/
parity ,
/, p1
;********************************************
l./dummy,/, i/
speedlimit ,
monrelease ,
/, p1
;********************************************
l./message connect wrk or exist page 2;/, l-1, r/84.09.19/88.11.25/
l./headtail.base (1) = entry.base (1)/, d1, i/
if headtail .base (1) = entry .base (1) and
headtail .base (2) = entry .base (2) and <*bases*>
headtail (1) extract 3 = entry (1) extract 3 and <*permkey*>
(headtail .size >= 0 and <*areas*>
entry .size >= 0
or headtail .size < 0 and <*descr*>
entry .size < 0) then
/, l1, p-8
l./tofrom/, i/
if entry.size >= 0 then
/, l1, r/tofrom/ tofrom/, p-1
l./message rename wrk /, l-1, r/84.07.10/88.02.04/
l./integer array field base/, r/;/, tail;/
l./size := 16/, i/
tail := 14; <* - - tail*>
/, p1
l./page 2/, l-1, r/84.11.09/88.02.04/
l./if result > 0 and result <> 3 then/, i#
if result = 0 then
begin <*reopen zone z*>
close (z, true);
open (z, 0, entry_name, 0);
end;
if (result = 0 <*renamed *>
or result = 3) and <*name overlap*>
entry.size >= 0 then
begin <*check whether or not to cut area*>
integer result1;
result1 := monitor (76) head and tail :(z, 1, headtail);
if test then
begin
integer array zdescr (1:20);
integer array field zname;
zname := 2;
getzone6 (z, zdescr);
write (out,
"nl", 1, <:lookup head and tail : :>, zdescr.zname,
"nl", 1, <:result : :>, result1 );
end;
if result1 = 0 and
entry.size <> headtail.size then
begin <*cut area*>
result1 := monitor (44) change entry :(z, 1, entry.tail);
if test then
begin
integer array zdescr (1:20);
integer array field zname;
zname := 2;
getzone6 (z, zdescr);
write (out,
"nl", 1, <:change entry : :>, zdescr.zname,
"nl", 1, <:entry.size : :>, entry.size ,
"nl", 1, <:result : :>, result1);
end;
if result1 > 0 then
begin <*could not be changed*>
reset_catbase;
monitor_alarm (out, 44, entry.name, result1);
end;
end <*cut area*>;
end <*check whether ...*>;
\f
<* sw8010/2, load entry procedures page ... xx...
1988.02.04*>
message rename wrk page 1a;
#, p1
l./begin <*name equivalence*>/, i/
if entry.size <> headtail.size then
write (out,
"nl", 1, "*", 3, "sp", 1, true, 12, headtail.name, <:not renamed:>)
else
/, p1
l./message monitor alarm/,
l./page 2;/,l-1, r/85.02.06/88.02.04/
l./errorbits := 3;/, r/3/2/, r/ok.no/ok.yes/
l./procedure terminate_alarm (z/, d./end terminate_alarm;/, i#
procedure terminate_alarm (z, text, name, val, text1, val1);
value val, val1 ;
zone z ;
string text, text1 ;
long array name ;
integer val, val1 ;
<***********************************************************>
<* *>
<* The procedure terminates with an invisible runtime alarm*>
<* after having written an alarm message on the zone z. *>
<* *>
<* Call: terminate_alarm (z, text, name, val, text1, val1);*>
<* *>
<* z (call and return value, zone). The document, the *>
<* buffering and the position of the document where *>
<* to write the alarm message. *>
<* text (call value, string). *>
<* text1 *>
<* name (call value, long array). *>
<* val (call value, integer). All values which are writ- *>
<* val1 ten on the zone z. *>
<* *>
<***********************************************************>
begin
write_alarm (z, text);
write (z, "nl", 1, "sp", 4,
true, 12, name, <: :>, val, text1, val1);
trapmode := 1 shift 13; <*ignore output of trap alarm*>
trap (1); <*alarm*>
end terminate_alarm;
\f
<* sw8010/2, load entry procedures page ... xx...
1988.01.28*>
message continue warning page 1;
procedure continue_warning (z, text, name, val, text1, val1);
value val, val1 ;
zone z ;
string text, text1 ;
long array name ;
integer val, val1 ;
<***********************************************************>
<* *>
<* The procedure continues after having written an warning *>
<* message on the zone z. The fp mode bits are set *>
<* warning.yes ok.yes *>
<* *>
<* Call: continuewarning (z, text, name, val, text1, val1);*>
<* *>
<* z (call and return value, zone). The document, the *>
<* buffering and the position of the document where *>
<* to write the alarm message. *>
<* text (call value, string). *>
<* text1 *>
<* name (call value, long array). *>
<* val (call value, integer). All values which are writ- *>
<* val1 ten on the zone z. *>
<* *>
<***********************************************************>
begin
write_alarm (z, text);
write (z, "nl", 1, "sp", 4,
true, 12, name, <: :>, val, text1, val1);
errorbits := 2; <*warning.yes, ok.yes*>
end continue_warning;
#, l1, p-5
l./message mount param page 1;/, l-1, r/81.12.04/88.08.21/
l./<********/, d, d./<*******/, i/
<***************************************************************>
<* *>
<* The procedure returns the kind of the item given. *>
<* *>
<* Call : mount_param (seplength, item); *>
<* *>
<* mount_param (return value, integer). The kind of the *>
<* item : *>
<* 0 seplength<> <s> or ., item not below *>
<* 1 seplength = <s> or ., item = mountspec *>
<* 2 -"- , -"- release *>
<* 3 -"- , -"- mt62, mtlh, mto *>
<* 4 -"- , -"- mte *>
<* 5 -"- , -"- mt16, mtll, nrz *>
<* 6 -"- , -"- nrze *>
<* 7 -"- , -"- mt32 *>
<* 8 -"- , -"- mt08 *>
<* 9 -"- , -"- mthh *>
<* 10 -"- , -"- mthl *>
<* seplength (call value, integer). Separator < 12 + *>
<* length as for system (4, ...). *>
<* item (call value, array). An item in *>
<* item (1:2) as for system (4, ...). *>
<* *>
<***************************************************************>
/
l./message mount param page 2;/, l-1, r/84.05.20/88.08.21/
l./for i := 1 step 1/, d./i := 8/, i/
for i := 1 step 1 until
(if seplength <> space_txt and
seplength <> point_txt then 0 else 10) do
if item (1) = real ( case i of (
<:mount:> add 's',
<:relea:> add 's',
<:mt62:> ,
<::> ,
<:mt16:> ,
<::> ,
<:mt32:> ,
<:mt08:> ,
<::> ,
<::> ) ) and
item (2) = real ( case i of (
<:pec:> ,
<:e:> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ) )
or item (1) = real ( case i of (
<::> ,
<::> ,
<:mtlh:> ,
<::> ,
<:mtll:> ,
<::> ,
<::> ,
<::> ,
<:mthh:> ,
<:mthl:> ) ) and
item (2) = real ( case i of (
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ) )
or item (1) = real ( case i of (
<::> ,
<::> ,
<:mto:> ,
<:mte:> ,
<:nrz:> ,
<:nrze:> ,
<::> ,
<::> ,
<::> ,
<::> ) ) and
item (2) = real ( case i of (
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ) ) then
begin j := i; i := 10; end;
/
l./message in savecat head page 2;/, l-1, r/84.10.04/87.04.29/
l./terminate_alarm/,
l2, r/);/, <: in save catalog : :>, local_maxnoofvol);/
l./procedure load_entries ( za/, l./message load entries page 5;/,
l-1, r/86.10.10/78.04.29/
l./terminate_alarm (out/, r/terminate_alarm/continue_warning/
l./<:incorrect no of segments of part/,
r/incorrect no of segments of/incomplete/
l1, r/segments/partcatsize/, r/);/, <: transferred : :>, abs (segments));/
l./page 6;/, l1, l./page 6;/, l-1, r/84.11.15/87.04.29/
l./setposition (za (1)/, d, i/
blockno (copycount) := blockno (copycount) + 1;
/, l1, p-2
l./if zpart.size > 0/, r/and/ and/
l1, r/and/ and/
l1, r/and/ and/
l1, r/segments/abs (segments)/
l1, i/
begin <*warning and correct zpart.size*>
/
l1, r/terminate_alarm/continue_warning/
l1, r/segments/abs (segments)/, r/<:not/
<:warning : not/, r/else/
else/
l1, r/<:/ <:warning : /,
l1, r/segments/zpart.size/, r/);/, <: transferred : :>, abs (segments));/
l1, i/
zpart.size := abs (segments);
end <*warning and correct ...*>;
/
l./if entry_found and/, r/and/ and/
l1, r/and/ and/
l1, r/then/ and/
l1, i/
(segments >= 0
or connect ) then
/
l./total_segm__count :=/, r/segments/abs (segments)/, l-1, r/1;/ 1;/, p1
l./if load and/, r/and/ and/
l1, r/then/ and/
l1, i/
(segments >= 0
or connect ) then
/
l./slice_count (discno)/, i/
segments := abs (segments);
/
l./message list entry page 2;/, l-1, r/81.12.30/88.08.11/
l./write (z, "sp", 3, true, 7, case modekind/, d./<:mte:>/, i/
if monrelease < 80 shift 12 + 0 then
write (z, "sp", 3, true, 7, case modekind of (
<: ip:>, <: bs:>, <: tw:>, <: tro:>, <: tre:>, <: trn:>,
<: trf:>, <: trz:>, <: tpo:>, <: tpe:>, <: tpn:>, <: tpf:>,
<: tpt:>, <: lp:>, <: crb:>, <: crd:>, <: crc:>, <:mtlh:>,
<: mte:>, <:mtll:>, <:nrze:>, <:mt32:>, <:mt08:>, <:mthh:>,
<:mthl:>, <: pl:> ))
else
write (z, "sp", 3, true, 7, case modekind of (
<: ip:>, <: bs:>, <: tw:>, <: tro:>, <: tre:>, <: trn:>,
<: trf:>, <: trz:>, <: tpo:>, <: tpe:>, <: tpn:>, <: tpf:>,
<: tpt:>, <: lp:>, <: crb:>, <: crd:>, <: crc:>, <:mt62:>,
<: mte:>, <:mt16:>, <:nrze:>, <:mt32:>, <:mt08:>, <:mthh:>,
<:mthl:>, <: pl:> ));
/
l./message modekind case page 1;/, l-1, r/81.12.30/88.08.11/
l./until 24/, r/24/26/
l./<*mto, mtlh*>/, d./<*mthl*>/, i/
1 shift 23 + 0 shift 12 + 18, <* mt62, mto, mtlh*>
1 shift 23 + 2 shift 12 + 18, <* mte*>
1 shift 23 + 4 shift 12 + 18, <* mt16, nrz, mtll*>
1 shift 23 + 6 shift 12 + 18, <* nrze*>
1 shift 23 + 8 shift 12 + 18, <* mt32*>
1 shift 23 + 12 shift 12 + 18, <* mt08*>
1 shift 23 +128 shift 12 + 18, <* mthh*>
1 shift 23 +132 shift 12 + 18, <* mthl*>
/, p-8
l./i := 24/, r/24/26/
l./message open tape/, l-1, r/84.09.26/88.02.11/
l./open (z, modekind/, r/modekind extract 18, doc/
logand (modekind, -(1 shift 19 + 1)) extract 23, <*clear speed bit*>
doc/, p-1
l./procedure transfer (za/,
l./message transfer page 3;/, l-1, r/84.11.12/88.02.03/
l./boolean tapemark/, r/;/, rem_parity;/
l1, r/user (1:2)/user (1:16)/
l./tapemark :=/, l1, i/
rem_parity:= false ;
/, p-1
l.#if (segments // segm) > 4#, d5, i#
if modekind (i) shift 4 < 0 then
begin <*high speed bit specified*>
getzone6 (za (1), zdescr);
zdescr (1) :=
if segments <
speedlimit / (if modekind (i) shift 9 < 0 then 4 else 1) then
logand (modekind (i), -(1 shift 19 + 1)) extract 23 <*clear*>
else
logor (modekind (i), 1 shift 19 ) extract 23;<*set *>
if test then
write (out,
"nl", 1, <:speed bit = :>, zdescr (1) shift (-19) extract 1);
setzone6 (za (1), zdescr);
end;
#, p1
l./"sp", 2, <:n.t. addr/, i/
"sp", 2, <:area name = :>, procname,
"sp", 2, <:pos in area :>, file (area), block (area),
/, p1
l./if hwds > 2 then/, i/
if parity (1) then
begin <*parity error input tape zone*>
parity (1) := false;
rem_parity := true ;
if sumsegs < segments - segments mod segm then
segs := segm
else
begin
segs := segments mod segm; <*last block*>
if segs * 512 < hwds then
hwds := segs * 512;
end;
write (out,
"nl", 1, "sp", 4, <:loading to:>,
"nl", 1, "sp", 4, true, 12, procname,
<: last :>, segs * 512 - hwds, <: halfwords of segments :>,
sumsegs, <: - :>, sumsegs + segs - 1,
if expell then <: would be:> else <: are:>, <: zeroed:>,
"nl", 1);
end;
/, p1
l./if segs <> segm then segments := sumsegs + segs;/, d, i/
if segs <> segm
or hwds = aux_sync_length then
begin <*data blocks expired too early*>
if hwds = aux_sync_length then
begin <*sync block read as last data block*>
segs := 0; <*regret record*>
hwds := 0; <*makes the coming changerecio regret record*>
changerecio (za, hwds); <*regret record*>
getposition (za (1), file (i ), block (i )); <*log pos before sync*>
setposition (za (1), file (i ), block (i )); <*phys pos = logical*>
getposition (za (2), file (area), block (area));
setposition (za (2), file (area), block (area));
end;
segments := sumsegs + segs; <*to terminate loop*>
end <*data blocks expired too early*>;
/, p1
l./changerecio/, r/ch/if hwds > 0 then
ch/
l./page 4;/, l-1, r/84.11.08/88.11.17/
l./transfer (za, i/, l-1, i/
reading_savecat := true;
/, p-1
l./transfer (za, i/, l2, i/
reading_savecat := false;
/, p-1
l./if j <> savecatsize/, r/j/abs (j)/
l2, r/incorrect no of segments of/incomplete/
l1, r/);/, <: transferred : :>, abs (j));/
l./page 5;/, l-1,r/1894.11.12/1988.11.17/
l./<*stop zones, maybe tap/, i/
getzone6 (za (1), zdescr);
if aux_sync_length > 0 and
zdescr (16) > 0 and
not reading_savecat then <*record length*>
begin
<*sync blocks present and present record not one, *>
<*check that next share has input a sync block and*>
<*- if not : read on until sync block *>
<*- if : leave *>
integer array sdescr1, sdescr2, sdescr3 (1:12);
integer used_share, next_share, reclength;
getzone6 (za (1), zdescr);
used_share := zdescr (17); <*save used share*>
next_share := used_share + 1; <*save next share*>
if next_share > zdescr (18) then
next_share := 1;
zdescr (17) := next_share;
getshare6 (za (1), sdescr1, used_share);
getshare6 (za (1), sdescr2, next_share);
<* if test then
begin
write (out, "nl", 1, <:zone and shares before check next share ::>,
"nl", 1, <:used share = :>, used_share,
"sp", 1, <:next share = :>, next_share);
writezone (za (1), 1);
writeshare (za (1), used_share);
writeshare (za (1), next_share);
end;
*>
setzone6 (za (1), zdescr); <*used share updated*>
check (za (1) ); <*check it*>
getshare6 (za (1), sdescr3, next_share); <*get checked share*>
sdescr2 (1) := sdescr3 (1) := 1; <*share.state := ready*>
setshare6 (za (1), sdescr3, next_share); <*reset the share*>
<* if test then
begin
write (out, "nl", 1, <:zone and shares after check next share ::>);
writezone (za (1), 1);
writeshare (za (1), used_share);
writeshare (za (1), next_share);
end;
*>
reclength :=
sdescr3 (12) - sdescr3 (5) ;
<*sh.top xferred - sh.first addr*>
zdescr (17) := used_share;
setzone6 (za (1), zdescr); <*reset zone*>
setshare6 (za (1), sdescr1, used_share); <*and shares*>
<* if test then
begin
integer i;
write (out,
"nl", 1, <:zone and shares before set share next share ::>,
"nl", 1, <:reclength = :>, reclength,
"nl", 1, <:zdescr(16)= :>, zdescr(16));
writezone (za (1), 1);
writeshare (za (1), used_share);
writeshare (za (1), next_share);
write (out, "nl", 1, <:sdescr2 = :>);
for i := 1 step 1 until 12 do
write (out, "nl", 1, "sp", 10, << dddddd>, sdescr2 (i));
end;
*>
setshare6 (za (1), sdescr2, next_share);
if reclength > aux_sync_length then
begin <*too many data blocks, read on until sync block*>
getposition (za (1), file (i ), block (i )); <*log pos before last block*>
getposition (za (2), file (area), block (area));
closeinout (za); <*terminate zones, reinit zone array*>
block (i) := block (i) + 1; <*log pos after last block*>
setposition (za (1), file (i ), block (i )); <*phys = log pos*>
setposition (za (2), file (area), block (area));
<* if test then
write (out,
"nl", 1, <:position before transfer : :>,
file (i), block (i),
"nl", 1, <:- in area : :>,
file (area), block (area));
*>
segs :=
transfer (za, i, copies, file, block, 8388607, endtape, expell);
<*transfer until sync block, but expell disc zone*>
sumsegs := sumsegs + segs;
setposition (za (1), file (i), block (i)); <*save pos in zone*>
<* if test then
write (out,
"nl", 1, <:position after transfer : :>,
file (i), block (i),
"nl", 1, <:- in area : :>,
file (area), block (area));
*>
end <*too many full length blocks*>;
end <*aux_sync_length > 0*>;
/, p1
l./<*stop zones, maybe/, i#
\f
<* sw8010/2, load tape handling procedures page ... xx...
1988.02.02*>
message transfer page 6;
#
l./if test then/, i/
getzone6 (za (2), zdescr);
name_table_addr := zdescr (6);
if zdescr (13) >= 32 then <*z.state < 32 == closeinout was here before*>
closeinout (za); <*reallocate buffer area*>
/
l./getzone6 (za (2)/, d2
l./"nl", 1, <:proc bases/, r/));/),
"nl", 1, <:segments = :>, user (12));/, p-1
l./getzone_6 (za (1)/, d2
l./transfer :=/, r/sumsegs/
if rem_parity then
- sumsegs
else
sumsegs/, p-4
l./message next volume page 3;/, l-1, r/85.02.11/87.04.29/
l./terminate_alarm (/, l2, r/);/, <: block number : :>, block (index));/
l./terminate_alarm (/, l2, r/);/, <: block number : :>, block (index));/
l./procedure end_of_document (ztape,/,
l./page 2;/, l-1, r/84.10.04/87.04.24/
;**************************************
;l./if status/, i/
; write (out,
; "nl", 1, "*" , 3, <:blockprocedure end of doc : :>,
; "nl", 1, "sp", 3, <:status = :>, status);
;
;/, p1
;***************************************
l./if status extract 1 = 1/, r/then/ and/, r/extract/ extract/
l1, i/
(status shift (-22) extract 1 = 0 <*not parity*>
or status shift (-13) extract 1 = 1) then <*read error*>
/, l1, r/;/; <*hard error, not parity or read error*>/, p-2
;l./if status shift (-18)/,
;**********************************
;i/
;
; write (out,
; "nl", 1, "sp", 3, <:index = :>, index ,
; "nl", 1, "sp", 3, <:oper. = :>, operation);
;
;/, p-5
;**********************************
l./if status shift (-18)/,
r/if status/if status shift (-22) extract 1 = 1 then
begin <*parity error*>
if operation <> 3 then
give_up (ztape, status, hwds); <*not input*>
getposition (ztape, i, j);
write_alarm (out,
<:warning : persistent parity error in input from tape:>);
errorbits := 2; <*warning.yes, ok.yes*>
write (out,
"nl", 1, "sp", 4, true, 12, zdescr.docname,
<: file, block no :>, i, <:, :>, j);
parity (index) := true;
if hwds < 4 then
hwds := 4; <*not filemark*>
end <*parity error*> else
if status/,
p-12
l./begin <*mode error*>/, l./for i := 1 step 1/, r/6/8/
l2, r/128/8, 12, 128/
l1, r/6/8/
l1, r/6/8/
l2, r/128/8, 12, 128/
l./if nextmode = startmode/, d1, i#
getstate (ztape, i);
if nextmode = startmode <*all modes h been tried*>
or i shift (-5) extract 1 = 1 <*after inoutrec/chrecio*> then
give_up (ztape, status, hwds);
#, p-5
l./<:*mode error on/, l2, r#mtlh#mt62/mtlh#, r#mtll#mt16/mtll#, r#<:mthh:>,#
<:mt32:>, <:mt08:>, <:mthh:>, #
l./message program page 2;/, l-1, r/85.01.16/88.08.11/
l./<*obtain area and buffer claim*>/, i/
<*get monitor release*>
system (5) move core :(64, dummyia);
monrelease := dummyia (1); <*rel shift 12 + subrel*>
/, p-3
l./message program page 3;/, l-1, r/85.02.06/87.04.24/
l./end_of_doc/, i/
parity (i) :=
/,p1
;*********************************************
l./tape_param_ok :=/, l1, i/
<*write (out, "nl", 1, <:speed limit : :>, "<", 1);
*>
<*stopzone (out, false);*>
<*read (in, speedlimit);
write (out, "nl", 1, <:speed limit : :>, speedlimit, "nl", 1);
*>
<*stopzone (out, false);*>
speedlimit := 100;
/
;**********************************************
l./message program page 4;/, l-1, r/81.12.15/88.08.21/
l./mode_kind (copy_count) := 1 shift 23/, d./1 shift 23+132/, i/
modekind (copycount) := 1 shift 23 + 18; <*mt62, mtlh, mto*>
modekind (copycount) := 1 shift 23 + 2 shift 12 + 18; <*mte*>
modekind (copycount) := 1 shift 23 + 4 shift 12 + 18; <*mt16, mtll, nrz*>
modekind (copycount) := 1 shift 23 + 6 shift 12 + 18; <*nrze*>
modekind (copycount) := 1 shift 23+ 8 shift 12 + 18; <*mt32*>
modekind (copycount) := 1 shift 23+ 12 shift 12 + 18; <*mt08*>
modekind (copycount) := 1 shift 23+128 shift 12 + 18; <*mthh*>
modekind (copycount) := 1 shift 23+132 shift 12 + 18; <*mthl*>
/
l./message prepare tapes page 1;/, l-1, r/85.02.06/87.04.29/
l./terminate_alarm/,
l2, r/);/, <: block no :>, blockno (copy_count));/
l./message prepare save-loadcat page 2;/, l-1, r/85.01.16/88.11.17/
l./transfer (ztape/, l-1, i/
reading_savecat := true;
/, p-1
l./if segments <> savecatsize/, i/
reading_savecat := false;
/, p-1
l./terminate_alarm/, l1, d, i/
<:incomplete save catalog transferred from tape:>,
/
l1, d
l./savecatsize);/, r/);/, <: transferred : :>, abs (segments));/
f
lookup n g
message slut editering af utility texter
end
finis
▶EOF◀