|
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: 54528 (0xd500)
Types: TextFile
Names: »retuti3job «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »retuti3job «
job fgs 1 274001 temp disc 1000 100 time 20 0 stat 2
mode list.yes
; editering af fp utility texter
;
; magtapes :
;
; mt543026 : - 11.01 *** frigjort ved release 3.00, vers 2 ***
;
; mt543020 : - 13.00
; mt543053 : - 1.01, vers 2
; mt543331 : - 2.00, vers 2
; mt543285 : - 3.00, vers 2
;
; magtape :
;
; mt295276 : release 2.00, vers 2
;
; slettes og bliver kopi af :
;
; mt543285 : release 3.00, vers 2
;
head 1
message ret fp utility texter
message rettelse fra mt543331 til mt543285 1987.05.01
;
n=set nrz mt543285
g=set mto mt543331
opmess ring on mt543285
mount n
opmess no ring mt543331
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 : 3.00, 1987.05.01
subpackage name : utility
release : 3.00, 1987.05.01
\f
message translate job fil 2
nextfile n g
n=edit
m e
i#
; job til oversættelse og binout af fp og utilities
char ff
c=message start oversætjob
term =set tw terminal d.0
tro =set tro reader d.0
tre =set tre reader d.0
trn =set trn reader d.0
trf =set trf reader d.0
trz =set trz reader d.0
tpo =set tpo punch d.0
tpe =set tpe punch d.0
tpn =set tpn punch d.0
tpf =set tpf punch d.0
tpt =set tpt punch d.0
lp =set lp printer d.0
crb =set crb cardreader d.0
crd =set crd cardreader d.0
crc =set crc cardreader d.0
pl =set pl plotter d.0
ptre=set tre reader d.0
ptrf=set trf reader d.0
ptro=set tro reader d.0
ptrn=set trn reader d.0
ptrz=set trz reader d.0
utilities=edit
i/
xp,
utility,
account,
assign,
backfile,
binin,
binout,
bossjob,
catsort,
cat,
change,
changeentry,
char,
claim,
claimtest,
clear,
clearmt,
compresslib,
convert,
copy,
corelock,
coreopen,
correct,
crb,
crc,
crd,
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,
ring,
rubout,
save,
save13,
scope,
search,
set,
setmt,
skip,
suspend,
term,
timer,
tpe,
tpf,
tpn,
tpo,
tpt,
translated,
tre,
trf,
trn,
tro,
trz
/,f
utiareas=edit utilities
l./utility/,d,
l./assign/,d,
l./bossjob/,d,
l./cat,/, d
l./change/,d2,
l./clear/,d1,
l./convert/,d,
l./corelock/,d1,
l./crb/,d2,
l./enable/,d4,
l./head/,d,
l./if/,d,
l./incload/, d
l./incsave/, d
l./init/, d
l./kit/,d,
l./lp/,d,
l./mount/,d1,
l./newjob/,d2,
l./opcomm/,d3,
l./ptre/,d4,
l./release/,d4,
l./scope/,d3,
l./skip/,d8,
l./tre/,d b,i/
set,
/,
f
compressuti=edit utiareas
i/
utility=set 1
utility=compress,
fpnames,
/,
l./xp/,d,
l./catsort/,d,
l./claimtest/,d,
l./load/,d,
l./load13/, d
l./save/,d,
l./save13/, d
l./set,/,r/,//,
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-4,l./trz/,r/trz/trz,
endfp.ne.b
/,f
headfp=slang
s.w.
<:newcat:>
<:create:>
<:fp:>,0,0,0
18
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
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
insertproc=slangcompr insertproc
(xp=slang uti.6
xp init)
if ok.no
sorry
(mode=slang uti.9
mode head char finis end)
if ok.no
sorry
(i=slang uti.10
i o if)
if ok.no
sorry
(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
(edit=slang uti.13 uti.14 uti.15 uti.16
edit)
if ok.no
sorry
(binin=slang uti.17
binin)
if ok.no
sorry
(binout=slang uti.18
binout)
if ok.no
sorry
(print=slang uti.19
print)
if ok.no
sorry
(message=slang uti.20
message)
if ok.no
sorry
(move=slang uti.21
move)
if ok.no
sorry
(set=slang uti.22
set setmt clearmt entry changeentry assign,
rename permanent nextfile)
if ok.no
sorry
(lookup=slang uti.23
lookup search clear scope)
if ok.no
sorry
(backfile=slang uti.24
backfile)
if ok.no
sorry
(copy=slang uti.25
copy skip)
if ok.no
sorry
(headpunch=slang uti.26
headpunch)
if ok.no
sorry
(job=slang uti.27
job)
if ok.no
sorry
(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
compress=slang uti.31
if ok.no
sorry
compresslib=slang uti.32
if ok.no
sorry
(translated=slang uti.33
translated)
if ok.no
sorry
(procsurvey=slang uti.34
procsurvey)
if ok.no
sorry
(label=slang uti.35
label)
if ok.no
sorry
(allocbuf=slang uti.36
allocbuf)
if ok.no
sorry
; *** bruges ikke mere ***
;(fpproc=slang fpnames uti.37 insertproc
; fpproc)
;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
save13=algol survey.yes connect.no uti.38
if warning.yes
sorry
load13= algol survey.yes connect.no uti.39
if warning.yes
sorry
catsort= algol survey.yes connect.no uti.40
if warning.yes
sorry
catsort=changeentry catsort catsort catsort 64.120 catsort catsort catsort
cat =assign catsort
claimtest=algol survey.yes connect.no uti.41
if warning.yes
sorry
(copyarea=slang uti.42
copyarea)
if ok.no
sorry
save= algol survey.yes connect.no uti.43
if warning.yes
sorry
save= changeentry save save save 3 save save save
incsave=assign save
load= algol survey.yes connect.no 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 fpnames ; new fpnames
f
message insertproc fil 4
nextfile n g
n=edit g
f
message slangcompr fil 5
nextfile n g
n=edit g
f
message fp text fil 6
nextfile n g
g1=assign g
g2=assign g
nextfile g1 g2 g2
fptx=edit g g1 g2 tnyfpsyntax ; fp text
l./...1/, r/19.02.73/86.08.22/, l./b.h99/, r/h99,/ /, r/31/43/, i!
b. h99 w. ; special block for fpnames
!, l./m.file processor/, r/76.02.02/86.10.10/,
l./m.fptext1/, r/85.03.07/86.08.27/,
l./;b.h99,/, r/,c31,j131/ /, r/ck/ck with fpnames
; b. c43, j131 ; block with c- and j-names/,
l./;s.k=0/, r/,h99,c31/ /,
l./endprogramaction/, r/action/and device status/,
l1, r/15/15, 16/,
l2, r/s.k=h55,e48/b. g1 /,
r/device errors/block for old fpnames/,
l1, r/segment16/and insertproc/,
l2, r/e./e. ; end c- and j-names
; e./,
l./...2/, r/85.03.07/86.08.27/, l./s.k=0/, r/,h99,c43/ /,
l./h65:/, l./h67./, r/jl. /jl. w3/,
l1, d, i!
jl. h60. ; if the answer should arrive
; then goto init;
!,
l./...3a/, r/76.02.02/86.08.27/,
l./h96:/, r/countoffpsyntaxerrors/prim inout errors/,
l./...3b/, l./h52:/, r/2<12/3<12/,
l./resident,page...1/, r/81.08.06/86.08.27/,
l./h85:/, l./am 0/, r/ am/; am/, r/one/none/,
l./h64:/, r/1/0/, r/r:/r =/,
l./h70:/, l./x1+510/, i!
sl w3 h99 ; last address.mess :=
am 512 ; first addr + (if swap
!, l1, r/last address.mess:=firstaddr+510/ then 510 else 1022)/,
l./h69:/, l./jl+2/, l1, d,
l./...7/, r/12.6.70 /86.08.28/,
l./j127=/, r/stack/stack and end program/,
l./j130=/, r/stack/end program/,
l./resident85/, r/5.03.26/6.08.28/,
l b, s 2,
l b, s 3, l./m.fptext3/, r/85.03.07/86.10.10/,
l./init,page...1/, r/5.03.07/6.09.03/,
l./s.k=h55/, r/,b12 /, b12/,
l./e0:/, r/ init://,
r!e0:!e0: am. (h96.) ; fp init: skip next;
al w0 0 ; utility init: prim inout errors := 0;
rs. w0 h96. ;
!,
l./page...4/, r/5.03.07/6.09.03/,
l./rs.w3h9./, l1, d 1,
l./al.w0b7./, i!
al. w3 h50. ; if stack chain is used
rl. w0 h50. ; then
se w0 0 ; remove entry(stack chain);
jd 1<11 + 48 ; comment do not check the result;
al w0 0 ; stack chain := 0;
rs. w0 h50. ;
al w0 -1-1<7 ;
la. w0 h51. ; if bit := 0;
rs. w0 h51. ;
!,
l./jl.h7./, r/;/; comment to fetch unused areas etc;/,
l./jl.h61./, r/command segment/end program/, r/h61./h7. /, i!
al w2 1 ; comment to fetch unused areas etc,
; in case of stop load start;
!, l1,
l./m.fpinit85/, r/5.03.07/6.09.03/,
l./endinit;/, r/t;/t;æ10ææ12æ/,
l./commands,page1/,
s 4, l./i20=/, r/1 /-1/,
l./***02/, r/06/22/, l./-4/, r/4/5/, r/16/32/,
l./mod16/, r/16/32/,
l./b0:/, r/1 /11/, r/4/5/,
l./***03/, r/8.08/8.22/, l./f10:/, r/=3/= 3; tastenext/,
l./rl.w1g8./, d./rs.w1g8./,
l./a0:/, l1, r/f0/i7/, r/syntaxerror/test cancel/,
l./64-8/, g 1/+2/-2/,
l./***06/, r/18/27/, l./i4:/, r/i4:/ /, l1, r/ j/i4: j/,
l1, r/;/;entry stack: outtext(out, <:***fp stack:>);/,
l./***07/, r/8.11/9.03/,
l./al.w0g24./, i!
al w0 -1-1<7 ;
la. w0 h51. ; if bit := 0;
rs. w0 h51. ;
!,
l./i3:/, r/text/text, outend(nl)/, l1, d, r/h33/h39/,
l./i0:/, l./-64/, g/64/70/,
l./***10/, r/11/27/,
l./g11:/, g/<10>//, r/: /:/, i!
g10: <:***fp stack: <0>:>
!,
l./g18../, r/c/g/,
l./g24:/, r/<0/ <0/,
l./g26:/, r/ */<10>*/,
l./g27:/, r/<0/ <0/,
l./***15/, r/8.08/8.22/,
l./val<4+class/, g26/<4/<5/,
l./***16/, r/08.18/09.01/, l./sl.w2(g7./, r/l/h/, r/>=/</, i!
rs. w2 g6. ;
!,
l./jl.i4./, d1, r!return! then return;
al. w0 g10. ; else goto stack alarm;
jl. i4. ;!,
l./reading86.08.18/, r/08.18/09.03/,
l b, s 3, d./m.fpcommands73.03.26/, d,
l./load,page2/, r/12.07.79/86.09.03/,
l./e27:/, l./alw1x1+1/, r/then //, i!
rl. w3 e33. ; then
ls w3 -2 ;
sl w3 3 ;
am x3-1 ;
!, l1,
l./snw232/, d, l-1, r/ out/ count := 0; out/,
l./e28./, r/1/1+length shift(-3)/,
l./load,page3/, r/12.07.79/86.10.10/,l./e28:/, l-1, r/=10/<>4/,
l./dl.w2/, r/ outtext(curout,paramname)//,
l1, d1, r/ s/e14: s/, i!
al w0 x2+2 ;
sh w1 10 ; begin
jl. e14. ; if general text then
al w2 34 ; write(out, <:":>,
jl. w3 h26.-2 ; param, <:":>);
jl. w3 h31. ; else
al w2 34 ;
jl. w3 h26. ; outtext(out, param name)
jl. e29. ; end else
!,
l./snw110/, r/10/4 /, r/n/e/,
l1, d, i!
jl. e15. ;
!,
l./e29:/, l-1, r/0/1/, r/32/127/, r/1 /1/,
l1, i!
jl. e29. ;
e15: rl w3 x2+2 ;
al w2 39 ;
sh. w3 (e16.) ;
jl. w3 h26.-2 ;
jl. w3 h31.-2 ;
!,
l./e37:/, r/;/ ;/, r/> />*/,
l./e41:/, l1, i!
e16: <:@<0><0>:> ; constant showing whether a name
; begins with a letter or a digit;
æ10ææ12æ
; rc 86.10.10 file processor, load, page 3a
!,
l./m.fpprogramload/, r/79.07.12/86.10.10/,
l./endprogram,page...1/, r/2.12.09/6.08.28/,
l./s.k=/, r/a8,e8/a10, e48/,
l-1, r/thebreakactionis entered/fp is reeinitialized/,
l./e8:/, l-1, r/512/1024/, l./h68./, i!
dl. w3 c30. ; move troubled name
ds. w3 e35. ; to these segments:
dl. w3 c27. ;
ds. w3 e36. ;!,
l./page2/, r/16.04.72/86.08.28/,
l./a1:/, r/a1:/ /, i!
a1=k-a0!, l./a7./, r/a7./ e39./,
l./a2:/, r/a2: /e33:/, i!
a2=k-a0!, l./a2./, r/a2. /e33./,
l./a3:/, r/a3:/ /, i!
a3=k-a0
!,
l./,page3/, r/19.02.73/86.09.01/, l./a4:/, r/a4:/a4=k-a0
/,
l./d5:/, l./jl.d9./, r/d9. /e32./,
l./d9:/, r/ giveup://, r!d9: !a10=k-a0
e32: rl. w1 h96. ;give up:
al w1 x1+1 ; prim inout errors :=
rs. w1 h96. ; prim inout errors + 1;
sh w1 10 ; if prim inout errors <= 10
jl. h60. ; then goto initialize fp;
!,
l./d10:/, l1, r/swithc/: c or v/,
l./page...4/, r/2.12.09/6.09.01/,
l./jl.d9./, r/d9. /e32./,
l./jl.d9./, r/d9. /e32./,
l./;flgforat/, d./jl.d9./,
l./e./, i!
e.
a9=k-a0 ; goto (if stack empty) then commands else load;
b. b1 w. ;
dl. w3 h8. ; if first command address < stacktop - 10
sl w3 x2-10 ; then
jl. h61. ; begin
b0: ea w3 x3+1 ; for command := next in stack
el w1 x3 ; while kind > 2 do
sl w1 3 ; <* nothing *>;
jl. b0. ;
b1: el w1 x3+1 ; while
sl w1 10 ; length (command) < 10 do
jl. h62. ; begin
ea w3 x3+1 ; command := next in stack;
sl w3 x2-8 ; if command address >= stacktop - 8
jl. h61. ; then goto load;
jl. b1. ; end;
; end; goto commands
!,
l./...5/, r/5.03.07/6.08.28/,
l./a5:/, r/a5:/a5=k-a0
/,
l./...6/, r/2.12.09/6.08.28/,
l./a6:/, r/a6:/ /, i!
a6=k-a0!, l./a7:/, r/a7: /a7=k-a0
e39:/,
l./;enterdevice/, d./s.k=h55/,
d./512;/, i!
æ10ææ12æ
; rc 86.09.01 file processor, end program, page ...7...
!,
l./al.w0e7./, r/e7. /e47./, r/ a/a8=k-a0
al. w0 e32. ;write device status alarm:
rs. w0 h21.+h2+2 ; giveup action(out) :=
a/, r/devicestatus:/ reinitialize fp;/,
l./h10.+2/, r/h10.+2/e34. /,
l./e6:/, r/6: /46:/, r/c20./e7. /,
l./e5./, r/e5. /e45./, l./e6./, r/e6. /e46./,
l./h10.+2/, i!
rl. w0 h21.+h0+0 ; while base buffer area <> record base do
e37: sn. w0 (h21.+h3+0) ; begin
jl. e38. ; char := 127;
al w2 127 ; outchar current;
jl. w3 h26.-2 ; end;
jl. e37. ; comment either outend or this algorithm will
; force the block out thus preventing
e38: al w0 x1-h21+h68 ; endless looping on reselect out;
rs w0 x1+h2+2 ; giveup action(out) := fp std error;!,
l./h10.+2/, r/h10.+2/e34. /,
l./e9:/, r/e2. /e42./, l1, r/c20./e7. /,
l./e4./, r/e4. /e44./, l./e8./, r/e8. /e4. /,
l./e3./, r/e3. /e43./,
l./h10.+2/, r/h10.+2/e34. /,
l./e8:/, d./e33:/, d./jl.h62./, i!
jl. e4. ; goto next action
!, l./e3:/, r/3: /43:/, l./e4:/, r/4: /44:/,
l./e7:/, r/7:/47:/,
l./page...2/, r/77.09.22 /86.08.28/,
r/device status, page...2/end program, page ...8/,
l./e2:/, r/2: /42:/,
l./e5:/, r/5: /45:/,
l./w./, r!w.!w.
e34: 0, e35: 0, 0, e36: 0 ; room for troubled device name
!,
l./e1=/, i!
æ12æ
; dh 86.08.28 file processor, end program, page ...9...æ10ææ10æ
; table of sequences of actions
h.
; no device errors:
f1: a1, a2, a5, a9
;hard error on current out
f2: a7, a4, a2, a5, a8, a9
; hard error on stacked cur in zone
f3: a1, a6, a5, a8, a2, a9
; hard error on cur in zone:
f4: a3, a4, a6, a5, a8, a10
; hard error on other zone:
f5: a1, a2, a5, a8, a9
w.
; the actions are:
;a1: outend and free curr out
;a2: unstack curr in zone to i-bit
;a3: terminate curr out
;a4: connect primary out, if problems then reeinitialize fp
;a5: remove area processes and message buffers
;a6: free current in zone
;a7: free current out zone
;a8: write device status alarm, if problems then reinitialize fp
;a9: goto (if empty stack) then commands else load
;a10: reeinitialize fp
;comment if fp is reinitialized more than 10 times then
; the job will be terminated. this should take care
; of removed primary in and out.
!,
l./e1=/, r/e1/e41/, r/512/1024/, l1, r/e1 /e41/,
l./m.fpdev/, r/fp/fp end program and/, r/77.09.22/86.09.01/,
l./insertproc page...1/, r/82.12.09/86.09.03/,
l./i.;list/, r/i. /e. i./,
r/;/ ;/, r/fp na/new fp na/,
l./b.g1/, r!w.!w. d. p.<:fpnames:>, w. l.; use old fpnames
b. w. ; a local block to cheat the i. in insertproc!,
l./g1:/, r/g1:/ /, l./3584/, r/3584/4096/,
l./p./, i!
æ10æg1: 1<23 + 4 ; secondary entry: init
0, r.4 ; room for docname
s2 ; date
0, 11 ; file, block
2<12 + 4 ; content, entry
512 ; code length
!,
l./p./, r/p./d. p./, r/:>/:>, l./,
l./e./, i!
e. ; end block with g-names
!,
f
n=edit fptx
; gem prim in , prim out processes i stakken
; reinit og mode 14.yes => fp version og release message
; raise stopped bit for kind 6 as for kind 4
; magtape check, erase kun for output
; magtape check, connect in, connect out, <:enable:> isf <:ring:>
l./m.fp text 1/, r/08.27/12.12/
l./transient parts:/, l./segment 11/, r/11/11, 12/
l3, r/12,13/13, 14/
l3, r/14/15/
l3, r/15, 16/16, 17/
l./block io, page ...3.../, r/rc/fgs/, r/19.05.72/86.12.12/
l./am. (c22.)/, i/
sn w2 6 ; if kind = disc then
al w2 4 ; kind := area;
/, p1
l./page ...4/, r/12.09/12.12/
l./; device table/, d./; end block io;/, i#
; device table containing mask index and special action no.
h. ; bytes
e21=k , e22=k+1 ;
16 , 6 ; ip ; special actions:
16 , 0 ; clock ; 0: give up
4 , 2 ; area ; 2: area process action
4 , 2 ; disc ; 4: end of medium
8 , 6 ; tw ; 6: timer error
12 , 4 ; tr ; 8: char output
16 , 8 ; tp ; 10: mag tape errors
16 , 8 ; lp
12 , 4 ; cr
0 , 10 ; mt
16 , 8 ; pl
; mask table specifying hard and special errors depending
; on the index selected via the process kind
w.
e24: 8.1107 7031 ; 0: magtape (mt)
e25: 8.2620 0744 ;
8.7277 7331 ; 4: area/disc process (size)
8.0500 0444 ;
8.2757 7375 ; 8: typewriters (tw)
8.1000 0400 ;
8.1614 7775 ; 12: readers (tr, cr)
8.0100 0000 ;
8.3677 7375 ; 16: char oriented output (ip, clock, tp, lp, pl)
8.0100 0400 ;
e28: 8.7777 4777 ; official bits.
; treatment of status bits for different indices.
; bit error hard:* spec:/
; 0 4 8 12 16
;
; 0 local *
; 1 parity / * * *
; 2 timer * * / * *
;
; 3 overrun / / * * *
; 4 block l. / * * * *
; 5 end doc. * / * / /
;
; 6 load p. * * *
; 7 tape mark / * *
; 8 ring * * * *
;
; 9 mode err. * * * * *
; 10 read err. * * * *
; 11 card rej. * * * *
;
;
; 12 sum err. * * * * *
; 13 * * * * *
; 14 * * * * *
;
; 15 stop / / / * /
; 16 defect / * * * *
; 17 position / * * * *
;
; 18 non-exist / / * * *
; 19 disconn. * * * * *
; 20 unintell. * * * * *
;
; 21 rejected / / * * *
; 22 normal
; 23 give up * * * * *
;
; 0 4 8 12 16
e. ; end block io;
#, p1
l./m.fp io system/, r/82.12.09/86.12.12/
l./file processor, resident, page ...1/, r/08.27/12.12/, r/rc/fgs/
l./h61:/, r/1 /2 /
l./m.fp resident/, r/08.28/12.12/
l./m.fp text 2/, r/85.03.07/86.12.12/
l./connect in, page ...2.../, r/84.09.04/86.12.12/
l./<:mount :>/, r/<:mount :>, 0 /<:mount <0>:>/
l./m.fp connect input/, r/84.09.04/86.12.12/
l./connect output, page ...9.../, r/82.11.29/86.12.12/
l./<:ring/, r/<:ring:>, 0 /<:enable <0>:>/
l./<:mount/, r/<:mount:>, 0 /<:mount <0>:>/
l./page ...10/, r/84.09.04/86.12.12/
l./<:ring:>/, r/ring/enable/
l./m.fp connect out 2/, r/84.09.04/86.12.12/
l./magtape check, page ...4.../, r/84.09.04/86.12.12/
l./e42=/, l./or input/, r/ input/ -, output/
l2, r/sn w0 3/se w0 5/
l./magtape check, page ...5.../, r/84.09.04/86.12.12/
l./<:ring :>/, r/<:ring :>, 0 /<:enable <0>:>/
l./<:mount :>/, r/<:mount :>, 0/<:mount <0>:>/
l./m.fp magtape check/, r/84.09.06/86.12.12/
l./m.fp text 3/, r/10.10/12.12/
l./page ...1/, r/09.03/12.12/
l./512 ; length/, r/ 512/1024/
l./page ...3/, r/82.12.09/86.12.12/
l./al w2 x2-1/, r/-1 /-21/, r/-1;/-21;/
l./page ...4/, r/09.03/12.12/, i/
æ12æ
; fgs 1986.12.12 file processor init, page ...3a...
rl. w2 h17.-2 ; prim proc := addr prim input proc;
; repeat:
e8: rl w0 x2 ; kind := prim proc.kind;
am. (h16.) ; addr (prim proc descr) :=
rl w1 +24 ; top own process -
e9=k+1 ; rel:
al w1 x1-20 ; rel;
rs w0 x1 ; stack.prim proc descr (0) :=
dl w0 x2+4 ; kind + 1<23;
ds w0 x1+4 ; stack.prim proc descr (2:8) :=
dl w0 x2+8 ; prim proc.name;
ds w0 x1+8 ;
el. w2 e9. ;
se w2 -20 ; if prim proc <> addr prim output proc then
jl. e18. ; begin
rs. w1 h17.-2 ; addr prim input proc := proc.top addr - 20;
al w0 -10 ; rel := -10;
hs. w0 e9. ; prim proc := addr prim output proc;
rl. w2 h15. ; goto repeat;
jl. e8. ; end;
e18: rs. w1 h15. ; addr prim output proc := proc.top addr - 10;
/, p1
l./e4:/, l./al w0 1 /, d4, i/
al w0 0 ; curr in.give up mask := curr out.give up mask :=
al. w1 h68. ; 1; <*i-bit*>
ds. w1 h92. ; curr prog.give up mask :=
al w0 1 ; 0;
ds. w1 h93. ; curr in.give up act. := curr out.give up act. :=
ds. w1 h94. ; curr prog.give up act. := fp std error;
/, p1
l./jd 1<11 + 48/, l./al w0 -1-1<7/, i/
rs. w0 h94.-2 ; curr out.give up mask := 0; <*i-bit*>
/, p1
l./;e16:/, l-3, d2, i/
rl. w0 h51. ;
so w0 1<9 ; if mode 14.no then <*mode reinitmess.no*>
jl. e17. ; begin
/, p1
l./;e16:/, r/because sos supposes an input first/at reinit when mode.14 = 0;/,
r/e16://
l./am. (h16.)/, r/ /;/
l1, r/ /;/
l1, r/ /;/
l1, r/ /;/
l1, r/ /;/
l./<:, vers/, r/<:,/<:/
l./<:, rel/, r/<:,/<:/
l./32<12+1/, r/32/48/, r/+1/+2/
l./e16:/, l-2, d1, i/
e17: ; end <*mode 14.no*>;
al w2 10 ;
jl. w3 h34.-2 ; close up (out, 'nl');
am 2 ; prepare call and enter end program; <*warn.yes, ok.no*>
/, p1
l1, r/al/ al/, r/comment/comment warn.no, ok.no/
l1, r/;/ ;/
l1, r/jl/ jl/
l1, i/
/, p1
l./b10:/, r/,//
l1, r/,//
l./b12:/, r/ /;/
l./g1=/, g/512/1024/, r/2 /2/
l./m.fp init 86/, r/09.03/12.12/
l./end program, page ...1/, r/08.28/12.12/
l./e8:/, l./ds. w3 h21.+h2+2/, r/ds/rs/, r/g.up.mask(out):=0;//
l./end program, page 2/, r/rc/fgs/, r/08.28/12.12/
l./a1=k-a0/, l1, i/
al w0 0 ; i-bit := curr out.give up mask;
rx. w0 h21.+h2 ; curr out.give up mask := 0 ;
sn w0 1 ; if i-bit = 1 then
jl. e4. ; goto next action; <*skip outend curr out*>
/, p1
l./m.fp end program and device status/, r/09.01/12.12/
l./insertproc page ...1.../, r/09.03/12.12/
l./g0:/, r/17/18/
l./g1:/, l./512; code length/, r/512 /1024/
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 g ; job adm 1, mode head char finis end
; ny fp modebit : initmess
l./page ...4.../, r/rc 77.02.09/fgs 1986.12.12/
l./<:all:>/, i/
<:initmess:> , 0, 1<9
/, p-1
l./a0:/, l./al w3 x3+6/, g/6/8/
l./a3=k-6/, r/-6/-8/, l1, g13/0,0/0,0,0/, p-14
l./<: listing:>/, l-1, d, i/
<: initmess:>,0
/, p-1
l1, r/:>/:>,0/
l1, r/0,0/0,0,0/
l1, r/:>/:>,0/
l1, r/,0,0/,0,0,0/
l1, g1/,0/,0,0/, p-1
l1, g1/,0,0/,0,0,0/, p-1
l1, r/,0/,0,0/
l./m.rc, fp/, r/85.03.11/86.12.12/
f
message job adm 2 fil 10
nextfile n g
n=edit g ; job adm 2, i o if
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
; nyt program : enable == ring (<:enable:>)
l./page ...1/, r/85.03.13/86.12.22/
l./release - change/, r/release/release - enable/
l./slang text/, l2, r/release/release enable/
l./page ...2/, r/rc 76.06.17/fgs 1986.12.22/
l./a13:/, l-1, i/
;enable
a12: d1, d3,d19,d21, d9,d10
/, p1
l./page 13a/, r/rc 30.03.73/ fgs 1986.12.22/
l./a7-a0, b7:/, r/mount/mount /, r/.5/.4/
l2, r/ring/ring /, r/.5/.4/
l1, r/suspend/suspend /
l1, r/release/release /
l1, i/
a12-a0,b12: 9<13+0<5+1, <:enable :>,0,r.4
/, p-1
l1, r/change/change /, r/.5/.4/
l./page 14/, r/85.03.13/86.12.22/, r/14/...14.../
l./i13:/, r/b11/b12/
l./i11:/, i/
i12: am b12-b11 ; entry enable:
/, p1
l./page ...14a/, r/rc 76.06.17 / fgs 1986.12.22/
l./rl. w2 c2./, i/
am -2000 ;
/
l1, r/c2. /c2.+2000/
l./sn. w0 (c3./, i/
am -2000 ;
/
l1, r/c3.) /c3.+2000)/
l./page ...15/, r/rc 31.07.74/ fgs 1986.12.22/
l./; change/, i/
1<23+4,0,r.4,s2 ,0,r.2 ; enable
2<12+i12-i0,g2
/, p-4
l./m.rc/, r/85.03.13/86.12.22/
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
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
f
message binin text fil 17
nextfile n g
n=edit g ; binin
f
message binout text fil 18
nextfile n g
n=edit g ; binout text
f
message print text fil 19
nextfile n g
n=edit g ; print text
f
message message text fil 20
nextfile n g
n=edit g ; message text
l./,page2/, r/12.04.73/86.08.15/,
l./a1:/, l./sew010/, r/se/sn/, r/10/4 /,
l./a2:/, l./32<12+1/, r/32<12+1 /1<23+127<12 +1/,
l./f1=b4/, l./m.rc1976/, r/1976.05.21/86.08.15/,
f
message move text fil 21
nextfile n g
n=edit g ; move text
f
message cat adm 1 text fil 22
nextfile n g
n=edit g ; cat adm 1 text, set setmt clearmt entry changeentry
; assign rename permanent nextfile
f
message cat adm 2 text fil 23
nextfile n g
n=edit g ; cat adm 2 text, lookup search clear scope
; reset permkey if permanent entry fails (13557)
l./...31/, r/81.08.06/87.03.13/
l./c25:/, l./; permanent fault:/, l1, i/
rs. w0 c2. ; undo permanent:
rl. w1 a119. ; save result;
ls w1 21 ; key :=
ls w1 -21 ; old permkey;
jd 1<11+50 ; permanent entry (key);
rl. w0 c2. ; restore result;
/, p1
l./m.rc/, r/85.03.13/87.03.13/
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
f
message headpunch text fil 26
nextfile n g
n=edit g
; integer exception siden 831213
; ny fp kommando syntax (lige som message)
l./page 2/, r/okh 6.9.1973/fgs 1987.03.13/
l./wd. w1 a0./, r/min/four_min/, r/00)/00*4)/
l1, i/
; <*four to avoid integer exception*>
/
l./wd. w1 a1./, r/min/four_min/
l./jl. w2 f50./, r/f50. /f50./, i/
ls w0 2 ; w0 := minutes;
/, l1, p-2
l1, i/
ls w3 -8 ; >8
wa. w3 a180. ; add <:.:>;
/
l./al w3 x3+32/, d, i/
ls w3 -8 ; hours :=
wa. w3 a10. ; decimal (hours) add <: :>;
/
l./c25:/, r/d51./d52./, l./ld w3 8/, d1, i/
al w3 x3+46 ; w2w3 := ' 19' add year add '.';
/
l./ds. w3 d53./, r/d53./d51./
l./rl. w0 d51./, r/d51./d52./
l./rs.w3 d51./, r/d51./d52./, r/rs./rs. /
l./al w3 x3+46/, r/46/32/, r/./ /
l1, r/d50./d53./
l./page 5/, r/ta 26.09.73 /fgs 1987.03.13/
l./c42:/, l./se w0 10/, r/se/sn/, r/10/4 /
l./page 7/, r#ta/okh 23.01.74#fgs 1987.03.13#
l./a0:/, r/600000/600000*4/
l1, r#60#60/4#
l./a9:/, r/49/32<16+49/, r/57 /57/, r/<0>/ /
l./a10:/, r/ <0>/ <0>/
l./m.rc/, r/76.05.21/87.03.13/
f
message job text fil 27
nextfile n g
n=edit g
f
message claim text fil 28
nextfile n g
n=edit g
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
f
message compresslib text fil 32
nextfile n g
n=edit ncomplibtx
; beregning af laengde af externliste for fortran subroutiner med
; commons og zone commons i stedet for no of halfs to transfer
; to own core
; opgiv krav om at entry base = catalog base = std base, i stedet
; skal source ebtry base = object entry base og object base skal
; harmonere med processens baser
; source entries genskabes på den disc hvor de oprindeligt lå før
; de blev removed for genskabelse
; alarm hvis create entry, permanent into aux cat og set entry
; base ikke lykkes
l./page 1/, r/rc 01.03.73 /fgs 1986.07.04/
l./page 2/, r/rc 06.03.73 /fgs 1986.07.04/
l./b9:/, r/result/result
b11: 0 ; saved object entry base (1);
b12: 0 ; - - - - (2);
b13: 0 , r.4 ; - - doc name (1:4);
/, p-3
l./jl. w2 c7./, r/);/); <*w0 never zero*>/
l./page 4/, r/rc 27.03.73 /fgs 1986.07.04/
l./a2:/, l./jl. w2 c7./, i/
al w0 1 ; ensure w0 <> 0;
/, p-1
l./dl. w0 b2.+h1+4/, i/
dl w0 x1+4 ; move document name
ds. w0 b13.+2 ; from tail
dl w0 x1+8 ; to saved object docname
ds. w0 b13.+6 ; for use by permanent into auxcat;
/, p-4
l./al w1 2.111/, i/
se w0 0 ; if result <> 0 then
jl. a5. ; goto alarm;
al. w2 b13. ; w2 := addr old document name;
/, p-4
l./1<11+50/, r/50/90/, r/y;/y into auxcat;/
l1, i/
se w0 0 ; if result <> 0 then
jl. a4. ; goto alarm;
dl. w1 b12. ;
jd 1<11+74 ; set entry base (saved base);
se w0 0 ; if result <> 0 then
jl. a3. ; goto alarm;
/, p-6
l./jl. a2./, l1, i/
a3: am 1 ; alarm set entry base:
a4: am 1 ; alarm permanent into auxcat
a5: al w1 10 ; alarm create entry:
jl. f5. ; goto alarm;
/, p-4
l./page ...5.../, r/rc 76.10.27 /fgs 1986.07.03/
l./c5:/, i/
b. a1 w. ; begin block finis program;
/, p1
l./hs w0 x3/, r/ /a0: /, r/param)/param) := <s>;/
l./ba w3 x3+1/, r/ba/ea/, r/:= <s>;//, i/
am (x3+1) ;
sn w3 x3 ; if separator = 0 then
jl. a1. ; goto finis;
/, p1
l./jl. -6/, r/-6 /a0./
l./rl. w2 b9./, r/ /a1: /
l./jl. h7./, l1, i/
e. ; end block finis program;
/, p-1
l./b. a5/, r/d3/d10 /
l./c4:/, l./am x2/, l1,l./am x2/, d2, i/
am x2 ;
rl w1 x3 ; nb := word (k + j);
rl. w0 b4.+26 ; w0 := kind and spec (1);
sl w0 0 ; if fortran subroutine then
jl. a1. ; begin
rs. w1 d3. ; save nc, nz;
zl w1 2 ; nb :=
wm. w1 d5. ; nc * 12;
rx. w1 d3. ; nb :=
zl w1 3 ; nz *
wm. w1 d6. ; 18 +
wa. w1 d3. ; nb;
a1: rx. w1 d1. ; end <*fortran subroutine*>;
/, l1, r/d3./d4./, p-14
l./d0:/, d2, i/
b10:
d0: 0 ; saved return;
d1: 0 ; ne
d2: 0 ; ng
d3: 0 ; work for nc, nz
d4: 6 ; constant 6
d5: 12 ; - 12
d6: 18 ; - 18
/, p-8
l./page 6/, r/rc 09.08.73 /fgs 1986.07.04/
l./; procedure check entry./, l2, i/
; ; w0 = 0 => check and save object entry base
/, p1
l./b. a5/, r/a5 w./a5, d1 w./
l./c7:/, r/c7:/ /, i/
c7: rs. w2 b8. ; entry: save return;
rl w2 0 ; w2 := w0;
/, p-2
l./(66)/, d, i/
se w2 0 ; if object entry then
jl. a5. ; begin
dl w1 x1+4 ;
al w3 0 ; w3 := own process;
rs. w3 d1. ;
al. w3 d1. ;
jd 1<11+72 ; set catalog base (entry base);
se w0 0 ; if catbase not set then
jl. a3. ; result := 2
al. w1 b4. ; else
dl w0 x1+4 ; begin
ds. w0 b12. ; save entry base;
am -2000 ;
am. (h16.+2000) ; set catbase (std base);
dl w1 +78 ;
al. w3 d1. ; w3 := own process;
jd 1<11+72 ; end;
a5: al. w1 b4. ; end;
/, p1
l./dl w0 +70/, r/dl w0 +70 /dl. w0 b12./
l./the catalog base/, r/catalog/saved/, p1
l./a4:/, l1, d, i/
jl. (b8.) ; return;
d1: 0 ; work;
/, p-1
l./page 7/, r/rc 06.03.73 /fgs 1986.07.04/
l./f10:/, l./h8./, d, i/
am -2000 ;
rl. w3 h8.+2000 ;
/, p-2
l./b. a11/, r/a11/a20/
l./a11 ;/, l1, i/
a12 ; 10, create entry
a13 ; 11, permanent into auxcat
a14 ; 12, setentry base
/, p-3
l./a10:/, i/
a12=k-a0, <: create entry<10><0>:>
a13=k-a0, <: permanent into auxcat<10><0>:>
a14=k-a0, <: set entry base<10><0>:>
/, p-3
l./page 11/, r/rc 03.24.83 /fgs 1986.07.04/
l./jl. w2 c7./, i/
al w0 0 ; check entry base and save it;
/, p-1
l./a0:/, l-1, d./jl. f8./
l./page 12/, r/rc 03.24.83 /fgs 1986.07.04/
l./a2:/, r/a2:/ /
l./a6:/, l1, r/sh/sn/
l./am (66)/, d1, i/
dl. w1 b12. ;
/, p-1
l./<> catbase/, r/catbase/saved entry base/
l./hs w1 b4./, r/hs /hs./
l./m.compresslib/, r/83.03.24/86.07.04/
f
message translated text fil 33
nextfile n g
n=edit g
f
message procsurvey text fil 34
nextfile n g
n=edit g
f
message label text fil 35
nextfile n g
n=edit g
; to gange connect output (set mode, setpos (0, 0)) a.h.t.
; programstyret mode
l./page ...4.../, r/ta 1977.08.17/fgs 1986.12.12/
l./jl. w3 h28./, r/;/; <*setmode; setposition (z, 0, 0);*>/
l1, i/
jl. w3 h28. ; connect again ; <*setmode; setposition (z, 0, 0);*>
/, p-2
f
message allocbuf til brug for save text fil 36
nextfile n g
n=edit g
f
message fpproc til brug for save text fil 37
; bruges ikke mere
nextfile n g
n=edit g
f
message save text fil 38
nextfile n g
n=edit g
f
message load text fil 39
nextfile n g
n=edit g
; blocklength > 9 segm
l./segm:=zlabel(8) shift (-24) extract 8;/, d1, i/
segm := 0;
for i := -24 step 8 until -8 do
begin
integer digit;
digit := zlabel (8) shift i extract 8;
digit :=
if digit > 48 and
digit < 58 then
digit - 48
else
0;
if digit > 0 then
segm := segm * 10 + digit;
end;
/, l1, p-5
f
message catsort text fil 40
nextfile n g
n=edit g
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
savetx1=edit g
; closeinout er rettet så der sluttes af med reopen, d.v.s. at
; zone state i zoner med kind = 18 bliver = 8 (eller inoutbit + 8)
; hvilket er unpositioned : der må en position operation med check
; til før en ny openinout
l./page ... 3.../
l./message transfer page 4;/, l-1, r/84.11.09/86.10.12/
l./end <*change to nexttape*> else/, l1, d, i/
begin <*after closeinout the zone states are 'unpositioned'*>
setposition (za (i), file (i), block (i));
l_expell (i) := true; <*set expell condition*>
end;
for i := 1 step 1 until copies do
stopzone (za (i), false); <*no mark*>
/, l1, p-7
l./page 5;/, l-1, r/84.11.08/86.10.12/
l./closeinout (/, l1, i/
<*after closeinout the zonestates are 'unpositioned'*>
for i := 1 step 1 until copies do
setposition (za (i), file (i), block (i));
for i := 1 step 1 until copies do
stopzone (za (i), false); <*no mark*>
/, p1
f
savetx2=edit savetx1
v n
g b*sw8010/1*sw8010/2*
l t
l./save pageheads/,d10,d./*>/
l./maybe device status page 1;/
l./long array field docname/,l1,i#
own boolean called_before;
#
l./if cause = -11/,r/then/and -, called_before then/
l./begin/,l1,i#
called_before := true;
#
l./<:device st/,r/<:/<:***/
l./until 23/,r/23/21/
l./decl. second level page 1;/
l./test ,/,l1,i#
reserve , <*unused *>
#
l./decl. second level page 2;/
l./syncblocklength/,l1,i#
aux_synclength ,
#
l./special param page 2;/
l./then 0 else 10/,r/10/11/
l./:conne:/,r/:conne:/:reser:/,r/'c'/'v'/
i#
<:conne:> add 'c',
#
l./:t:/,r/:t:/:e:/
i#
<:t:>,
#
l./i := 10/,r/10/11/
l./store entries page 2;/
l./integer /,l./;/,r/;/, loop_count;/
l./store entries page 4;/
l./1 shift 23 + 4/,i#
loop_count := 1;
#
l./while kind/,r/do/and loop_count < 10 do/
l./end <*while*>/,i#
loop_count := loop_count + 1;
if loop_count = 10 then result := 1;
#
l./save entries page 2;/
l./ catproc;/,r/;/, next_area;/
l./(1:entries_part/,r/;/, areas (1 : (entries_part + 1) * 17);/
l./integer array field/,l1,i#
real array field current_entry;
#
l./save entries page 5;/
l./partcat_size := (entr/,d,i#
partcat_size := (entries_part + 14) // 15;
#
l./save entries page 9;/
l./end <*move savecat/,i#
<*save catalog entry for later use - page 12 - *>
current_entry := (entries_ready - 1) * 34;
tofrom (areas.current_entry, zcat, 34);
#
l./save entries page 11;/
l./<*outrec6, stop/,l1,i#
check(za (copy_count));
#
l./save entries page 12;/
l./mark := /,d,i#
mark := false;
if (entry_kind (j) // segm) > 4
and copies = 1 then
begin <*change to highspeed if specified*>
getzone_6 (za (1), zdescr);
zdescr (1) := modekind (1) extract 23;
setzone_6 (za (1), zdescr);
end;
#
l./<*area processes are removed/,d
l./close (za (copies + 1), false)/,i#
for copy_count := 1 step 1 until copies do
begin
<*make one sync block*>
integer array zd (1 : 20);
integer bl;
if copies = 1 then
begin <*remove highspeed bit in modekind*>
getzone_6 (za (1), zd);
zd (1) := modekind (1) extract 18;
setzone_6 (za (1), zd);
end;
if ida_copy then
begin <*update position in tape zone*>
getposition (zida, fileno (1), blockno (1));
getzone_6 (za (1), zd);
zd (7) := fileno (1);
zd (8) := blockno (1);
setzone_6 (za (1), zd);
end;
bl := outrec_6 (za (copy_count), 0);
outrec_6 (za (copy_count), aux_synclength);
za (copy_count, 1) := real <::>;
current_entry := 4;
<*zeroize zync block*>
tofrom (za (copy_count).current_entry, za (copy_count), aux_synclength - 4);
for next_area := j + 1 step 1 until entries_ready do
begin <*find descriptor of next area to be transferred*>
if entry_kind (next_area) > 0 then
begin <*area found - copy descriptor to sync block*>
current_entry := (next_area - 1) * 34;
tofrom (za (copy_count), areas.current_entry, 34);
next_area := entries_ready;
end;
end;
outrec_6 (za (copy_count), bl);
changerec_6 (za (copy_count), 0);
stopzone (za (copy_count), false);
getposition (za (copy_count), fileno (copy_count), blockno (copy_count));
if ida_copy then
begin <*update position in ida zone*>
getzone_6 (zida, zd);
zd (7) := fileno (1);
zd (8) := blockno (1);
setzone_6 (zida, zd);
end;
end; <*make sync blocks *>
#
l./if ida_copy then/,i#
<*
#
l./if ida_copy/
g 4/*/./
l./until entries/,i#
*>
getzone (zhelp, zdescr);
for j := 2 step 1 until entries_ready do
begin
if entry_kind (j) > 0 then
begin <*remove process*>
name := (j-1)*34 + 6;
base := (j-1)*34 + 2;
set_catbase (areas.base);
tofrom (zdescr.docname, areas.name, 8);
setzone_6 (zhelp, zdescr);
monitor (64)remove_process:(zhelp, 0, zdescr);
end;
end;
reset_catbase;
#
l./end <*partial catalog/,i#
for copy_count := 1 step 1 until copies do
begin <*terminate with filemark*>
outrec_6 (za (copy_count), 0);
setposition (za (copy_count), fileno (copy_count) + 1, 0);
getposition (za (copy_count), fileno (copy_count), blockno (copy_count));
end;
#
l./list entry page 3;/
l./<*latest changed*>/,
l./write (/,r/write/if changed <> 0 then write/
l./skip entry page 1;/
l./begin/,l1,i#
long array field name;
name := 6;
#
l./write/,d,i#
write (z, "nl", 1, <:***:>, true, 12, entry.name, <:skipped : :>,
#
l./list counters page 1/
l./if disc_specified/,d
l./(entry/,r/ (/ if (/
l./open tape page 1;/
l./:mount :/,r/t :/t :/
l./open (z, /,r/1 shift 18/1 shift 21 + 1 shift 18/
l./:ring :/,r/:ring :/:enable :/
l./:high/,r/h :/h :/,r/w :/w :/
l./get file nos page 2;/
l./open_tape/,r/modekind (i)/modekind (i) extract 18/
l./get file nos page 3;/
l./fileno_found (i) :=/,r/:=/:= hw (i) = 2;/
l1,d./:cont.:/
l./out labelrec page 4;/
l./sync_blocklength/,l1,i#
ifld := ifld + 2; ztape.ifld := aux_synclength;
#
l./transfer page 5;/
l./if name_table_addr > 0 then/,d./end <*prepare/
l./close/,r/name_table_addr > 0/false/
l./next volume page 3;/
l./long array/,l1,i#
integer i;
#
l./close (za (ind/,i#
if output then
begin
setposition (za (index), file (index), 0);
for i := 1 , 2 do
begin
outrec6 (za (index), 0);
setposition (za (index), file (index) + i, 0);
end;
end;
#
l./open_tape/,r/modekind (index)/modekind (index) extract 18/
l./program page 2;/
l./if entries_in_partcat < 1/,i#
if entries_in_partcat > 50 then entries_in_partcat := 50;
#
l./release_id := /,r/2/3/
l./sync_block/,l1,i#
aux_synclength := 320;
#
l./program page 9;/
l./; <*connect*>/,l1,i#
; <*reserve*>
#
l./declare zones page 1;/
l./no_of_ida_shares :=/,r/:=/:= 1;/,l1,d2
l./take over page 4;/
l./close (ztape (2), true);/,r/true/false/
l./end of document page 1;/
l./getzone__6/,i#
if status shift (-18) extract 1 = 1 then
begin <* end of document *>
#
l./getzone__6/,r/g/ g/
l1,l./getshare_6/,r/g/ g/
l1,l./index/,r/i/ i/
l1,l./operation/,r/o/ o/
l1,l./end_of_doc/,r/e/ e/
l1,i#
end <* end of document *>;
#
l./prepare tapes and ida page 1;/
l./open_tape/,l1,r/modekind (copy_count)/modekind (copy_count) extract 18/
l./end third block page 1;/
l./for copy_count/,d./setposition/,d
l./out_endmess/,i#
for copy_count := 1 step 1 until no_of_copies do
#
l./end <*next file*>;/,d
i#
fpproc (33)out end:( 0, out, 'nul');
for copy_count := 1 step 1 until no_of_copies do
begin <* terminate with filemark *>
#
l./begin <*empty label record*>/,l-1
d./<*if parent is s output/
l./*empty label/,r/empty label record/terminate with filemark/
l./end third block page 2;/
l./<*out tapemark*>/
l./outrec6 (/,d3
l./setposition/,i#
setposition (ztape (copy_count),
fileno (copy_count),
blockno (copy_count));
outrec6 (ztape (copy_count), 0);
#
l./program page 16;/
l1,i#
getzone_6 (out, zdescr);
if zdescr (1) extract 12 = 4 then
begin
#
l./<*write/,r/</ </
l./list/,r/l/ l/
l1,r/list/ list/
l1,i#
end;
#
f
n=edit savetx2
f
message load version 2 text fil 44
nextfile n g
loadtx1=edit g
; closeinout er rettet så der sluttes af med reopen, d.v.s. at
; zone state i zoner med kind = 18 bliver = 8 (eller inoutbit + 8)
; hvilket er unpositioned : der må en position operation med check
; til før en ny openinout
l./page ... 3.../
l./message load entries page 5;/, l-1, r/85.02.19/86.10.10/
l./stopzone (za (1), false);/, l./setposition (za (1)/, d1
l1, i/
setposition (za (1), fileno (copy_count), blockno (copy_count));
setposition (za (2), 0 , 0 );
/,p-3
f
loadtx2=edit loadtx1
v n
g b*sw8010/1, save*sw8010/2, load*
l t
l./message pageheads/,d./*>/
l./connect output page 1;/
; line 1303
g 7/giveup/size, giveup/,l-7
l./zone/,r/;/ ;/
l./long/,r/;/ ;/
l./result := 1 shift 1;/,r/1 shift/size shift/,r/one/at least one/
l./maybe device status page 1;/
; line 1432
l./long array field docname/,l1,i#
own boolean called_before;
#
l./if cause = -11/,r/then/and -, called_before then/
l./begin/,l1,i#
called_before := true;
#
l./<:device status/,r/<:dev/<:***dev/
l./until 23/,r/23/21/
l./decl. second level page 1/
; line 1489
l./test ,/,i#
reserve , <*not used*>
#
l./decl. second level page 2;/
l./dummy ,/,i#
aux_synclength ,
#
l./connect wrk or exist page 4;/
; line 1839
l./entry.size >= 0/,r/>=/>/
l./special param page 2;/
; line 2276
l./step 1 until/,r/0 else 10/0 else 11/
l./<:conne:>/,r/:conne:/:reser:/,r/add 'c'/add 'v'/
i#
<:conne:> add 'c',
#
l./<:t:>/,r/:t:/:e:/,i#
<:t:>,
#
l./j := i;/,r/10/11/
l./load entries page 3;/
; line 3481
l./vol := ca/,i#
trap (remove_wrk_entry);
#
l./open (zcat,/,i#
partcat_size := (entries_part + 14) // 15;
#
l./:= connect_output (/,r/0)/partcat_size, 0)/
l./<*prepare partial catalog*>/
l./partcat_size :=/,d
l./load entries page 5;/
; line 3555
l./<:not all segments/,r/not all/incorrect no of/
l./load entries page 6;/
; line 3635
l./setposi/,i#
if aux_synclength > 0 and -, skipped_area_entry then
setposition (za (1), fileno (copycount), blockno (copycount) + 1) else
#
l./load and/,d
l./terminate_alarm/
l./<:not/,r/</if zpart.size > segments then </,r/>,/> else/
l1,i#
<:too many segments of area transferred from tape:>,
#
l./end load_entries;/,i#
if false then
remove_wrk_entry:
begin
<*fjern entry hvis docname i za(2) er forskellig fra
name i zpart.entry d.v.s. docname i zone er et wrk-navn *>
integer array zd (1 : 20);
long array field docname;
maybe_device_status (out);
docname := 2;
getzone (zpart, zd);
if zd (13) = 5 <*after inrec*> then
begin
getzone_6 (za (2), zd);
for j := 1 step 1 until 2 do
if zpart.entry.name (j) <> zd.docname (j) then
begin
set_catbase (zpart.entry.base);
monitor (48)remove_entry:(za (2), 1, zd);
j := 2;
reset_catbase;
end;
end;
trap (1);
end; <*remove_wrk_entry*>
#
l./list entry page 3;/
; line 3945
l./<*latest changed*>/
l./write (/,r/write/if changed <> 0 then write/
l./skip entry page 1;/
; line 3968
l./list_entry (z/,i#
long array field name;
name := 6;
#
l./write/,d,i#
write (z, "nl", 1, <:*** :>, true, 12, entry.name, <: skipped : :>,
#
l./open tape page 1;/
; line 4170
l./open (z/,r/1 shift 18/1 shift 18 + 1 shift 21/,r/extract 23/extract 18/
l./get file no page 4;/
; line 4343
l./:= get_labelrec/,l./sync_blockl/,i#
aux_synclength,
#
l./:= get_labelrec/,l./sync_blockl/,i#
aux_synclength,
#
l./file_no_found :=/,r/-, label_found/label_found extract 12 = 2/
l./get file no page 5;/
; line 4553
l./<*version or con/,l1,i#
if label_found then
begin
#
l1,r/vol/ vol/,l1,r/fil/ fil/,l1,r/blo/ blo/,l1,i#
end;
#
l./get labelrec page 1;/
l./sync_blength/,i#
aux_sync ,
#
l./integer/
l./sync_blength/,i#
aux_sync ,
#
l./get labelrec page 3;/
; line 4479
l./if hwds <> 100/,l1,d,i#
begin
if hwds = 2 then get_labelrec := false add 2
else get_labelrec := false;
end
#
l./sync_blength :=/,l1,i#
ifld := ifld + 2; aux_sync := z.ifld;
if release < 3 shift 12 then aux_sync := 0;
#
l./transfer page 3;/
;line 4718
l./getzone6/,i#
if (segments // segm) > 4 then
begin <*if specified set high speed*>
getzone_6 (za (1), zdescr);
zdescr (1) := modekind (i) extract 23;
setzone_6 (za (1), zdescr);
end;
#
l./<*not end of docu/,l1,d./end <*too many*>/,i#
if sumsegs + segs < segments then
begin <*transfer not terminated check correct blocksize*>
if segs <> segm then segments := sumsegs + segs;
end;
#
l./transfer page 4;/
; line 4764
l./<:not all seg/,r/not all/incorrect no of/
l./transfer page 5;/
l./closeinout/,d
l./if name_table_addr > 0/,i#
closeinout (za); <*reallocate buffer area*>
#
l./reset_catbase;/,l1,i#
getzone_6 (za (1), zdescr); <*reset high speed bit*>
zdescr (1) := modekind (i) extract 18;
setzone_6 (za (1), zdescr);
#
l./next volume page 3;/
; line 4947
l./n_syncblocklength/,r/n_sync/n_auxsynclength, n_sync/
l./get_labelrec (z/,l./n_sync_block/,r/ n_sync/ n_auxsynclength , n_sync/
l./<:syncblock/,i#
"nl", 1, <:aux sync , nauxsyncleng = :>, aux_synclength,
naux_synclength,
#
l./end of document page 2;/
; line 5027
l./end <*end of docum/,l1,i#
if status shift (-21) extract 1 = 1 then
begin <*timer*>
if operation = 3 and
hwds = 0 <*nothing transferred*> then
hwds := 2 <*end of recorded media - on adp streamer tape*>
else giveup (ztape, status, hwds);
end <*timer*> else
#
l./program page 8;/
l./connect :=/,d
l./end <*special block/,i#
connect := entry (14) extract 1 = 1;
#
l./program page 10;/
; line 5391
l./end case action/,i#
<*reserve*>
; <*ignore reserve param*>
#
l./program page 23;/
; line 5862
l./long <:main/,r/or disc/or (disc/
l./long <:all/,r/or disc/or disc/,r/<:all:>/<:all:> and i <= no_of_discs)/
l./until discname (entry/,r/ and/;/,l1,d
l./prepare tapes page 1;/
l./get_labelrec (z/
l./version_id/,r/ //,r/sync/aux_synclength , sync/
l./<:sync bl/,i#
"nl", 1, <:aux synclength = :>, aux_synclength,
#
l./declare zones page 1;/
l./no_of_shares :=/,d,i#
no_of_shares := 2; <*basta*>
#
l./prepare save-loadcat page 2;/
; line 6104
l./connect_output/,r/0))/savecatsize, 0))/
l./<:not all/,r/<:/if segments < savecatsize then <:/,r/,/ else/,l1,i#
<:too many segments of save catalog transferred from tape:>,
#
l./connect_output (z/,r/0)/savecatsize, 0)/
l./program page 27;/
; line 6225
l./if tapeparam/,i#
getzone_6 (out, zdescr);
#
l./if tapeparam/,r/then/and zdescr (1) extract 12 = 4 then/
f
n=edit loadtx2
f
lookup n g
message slut editering af utility texter
finis
▶EOF◀