|
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: 16128 (0x3f00)
Types: TextFile
Names: »bossold«, »tbossold«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦0b92c64d5⟧ »ctb«
└─⟦this⟧
; rc 18.5.72 bossold, ...1...
;
;
; versionid: 79 02 21, 13
; usage:
;
; preparing system generation:
; bossold=set mto <tape name> 0 1
; i bossold
; after this, the following operations may be carried out.
;
; correcting the system or changing the options:
; load correction tapes
;
; generating the binary version (corutine files):
; i bossbin
; if boss is started up now, the new text files are cancelled
; as they are temporary. however, the new corutine files are kept.
;
; correcting a single corutine file:
; load correction tape
; i <name of text file corrected>
;
; generating an updated text tape:
; bossnew=set mto <new tape name> 0 1
; i bossupdate
;
; generating a primitive user catalog and accountjob:
; i taccount
;
; generating the program for updating the user catalog:
; i tcatupdate
;
; generating the program for printing of the testoutput
; i testout
;
\f
; rc 1.5.72 bossold, ...2...
o qq1
; generate bossbin and bossupdate
bossbin=edit
i/
head 1
i central
i tterm1
i tterm2
i tjobstart
i tjob
i tmount
i tread
i tprinter
i tprocs
i tbanker
i tcatupdate
i testout
head 1
end
/,f
\f
; rc 75.06.24 bossold, ...3...
bossupdate=edit
i/
head 1
lookup bossnew
if ok.no
(message bossnew not set
end)
lookup bossold options jobdescr central tterm1 tterm2 tjobstart,
tjob tmount tread tprinter tprocs tbanker taccount tcatupdate,
tuserout testout textxref tsaveconv tgetconv tusercat
head 1
bossnew=move message.yes,
bossold options jobdescr central tterm1 tterm2,
tjobstart tjob tmount tread tprinter tprocs tbanker,
taccount tcatupdate tuserout testout,
textxref tsaveconv tgetconv tusercat
if ok.no
end
head 1
tt=set 250
f=entry bossnew bossnew bossnew bossnew
(repeat 21
tt=move message.yes f
if ok.no
finis
nextfile f)
clear temp tt
/,f
\f
; rc 76 09 22 bossold ...3a...
;generate bosstrans
bosstrans=edit
i/
head 1
i central
i tterm1
i tterm2
i tjobstart
i tjob
i tmount
i tread
i tprinter
i tprocs
i tbanker
head 1
end
/,f
\f
; rc 1.5.72 bossold, ...4...
; generate bossload
bossload=edit
i /
o qq1
lookup bossold
if ok.no
(o c
message bossold not set
end)
slang qq
if ok.no
(o c
message bossfiles not loaded
end)
lookup f
if ok.yes
(scope temp f
clear temp f)
lookup bossnew
if ok.no
bossnew=set 200 disc
lookup bossnew
if ok.no
(o c
message too few ressources on disc
end)
bossnew=changeentry 0 bossnew
if ok.no
(o c
message bossnew not drum or disc
end)
f=entry bossold bossold bossold bossold
scope temp bossold
clear temp bossold
bossold=entry bossnew bossnew
bossold=move message.yes f
nextfile f
clear temp options
options=entry bossnew bossnew
options=move message.yes f
scope user options
nextfile f
clear temp jobdescr
jobdescr=entry bossnew bossnew
jobdescr=move message.yes f
scope user bossold jobdescr
nextfile f
clear temp central tterm1 tterm2 tjobstart tjob tmount,
tread tprinter tprocs tbanker taccount,
tcatupdate tuserout testout textxref tsaveconv tgetconv tusercat
central=entry bossnew bossnew
central=move message.yes f
nextfile f
tterm1=entry bossnew bossnew
tterm1=move message.yes f
nextfile f
tterm2=entry bossnew bossnew
tterm2=move message.yes f
nextfile f
tjobstart=entry bossnew bossnew
tjobstart=move message.yes f
nextfile f
tjob=entry bossnew bossnew
tjob=move message.yes f
nextfile f
tmount=entry bossnew bossnew
tmount=move message.yes f
nextfile f
tread=entry bossnew bossnew
tread=move message.yes f
nextfile f
tprinter=entry bossnew bossnew
tprinter=move message.yes f
\f
; rc 75.06.24 bossold, ...5...
nextfile f
tprocs=entry bossnew bossnew
tprocs=move message.yes f
nextfile f
tbanker=entry bossnew bossnew
tbanker=move message.yes f
nextfile f
taccount=entry bossnew bossnew
taccount=move message.yes f
nextfile f
tcatupdate=entry bossnew bossnew
tcatupdate=move message.yes f
nextfile f
tuserout=entry bossnew bossnew
tuserout=move message.yes f
nextfile f
testout=entry bossnew bossnew
testout=move message.yes f
nextfile f
textxref=entry bossnew bossnew
textxref=move message.yes f
nextfile f
tsaveconv=entry bossnew bossnew
tsaveconv=move message.yes f
nextfile f
tgetconv=entry bossnew bossnew
tgetconv=move message.yes f
nextfile f
tusercat=entry bossnew bossnew
tusercat=move message.yes f
scope user central tterm1 tterm2 tjobstart tjob tmount tread,
tprinter tprocs tbanker taccount tcatupdate tuserout testout,
textxref tsaveconv tgetconv tusercat
o c
end
)
/,f
\f
; rc bossold ...5a...
bosscompfd=edit
i$
o qq
ccs=set 10 1
ccs=slang
; rc 76.07.01 textcompr
b.
d.
p.<:fpnames:>
l.
;this program compresses a slang text i.e. removes all
;blind characters (spaces and non-graphics) except in text
;strings and messages. all vt and ff is converted to nl.
;input is copied directly, until b. or s. is found
;in the beginning of a line.
; call: result=textcompr infile
s. j5, i5, g5, f5, e5, d5, c10, b5, a10
w.
k=h55
0
b2: 0 ;
ds. w3 b2. ; entry: save fpparam
sn w3 x2 ; if no left side then
jl. a1. ; alarm(call)
al. w1 h19. ; connect output:
jl. w3 h79. ; (leftside is connected to
al. w3 b1. ; current program zone)
rs. w3 h80.+2
al w3 x3-1
rs w3 x1+h0
al w3 x3+512
rs w3 x1+h0+2
al w2 x2+2
al w0 1<1+1
jl. w3 h28.
se w0 0
jl. a2.
rl. w3 b2. ;
bl w1 x3+10
sh w1 3
jl. a3. ; if no param then alarm
bl w1 x3+11 ;
se w1 10 ; if param<>text
jl. a3. ; then alarm(param)
jl. w3 h29.-4 ; stack cur in
rl. w3 b2. ;
al w2 x3+12 ; connect input
jl. w3 h27.-2 ;
se w0 0
jl. a2.
al w0 0 ; find a nice b. or s. :
jl. a5. ;
a4: al. w1 h19. ; new:
jl. w3 h26. ; outchar(char);
a5: jl. w3 h25.-2 ; inchar(char);
sn w2 25 ; if char=25
jl. a9. ; then goto em;
bl. w3 x2+g0. ; class:=table(char);
sn w3 c10 ; if class=blind (c10=c1 in table)
jl. a4. ; then goto new;
se w3 c4 ; if class=newline then
jl. a6. ; begin
al w0 0 ; state:=empty line;
al w2 10 ; char:=10;
jl. a4. ; goto new;
a6: sn w0 2 ; end;
jl. a4. ; if state=copy linerest then goto new;
se w0 0 ; if state=empty line then
jl. a8. ; begin check normal character:
se w2 83 ; if char<>big s
sn w2 115 ; and char<>small s
jl. a7. ;
se w2 66 ; and char<>big b
sn w2 98 ; and char<>small b then
jl. a7. ; begin
al w0 2 ; state:=copy linerest; goto new;
jl. a4. ; end else
a7: al w0 1 ; begin state:=point expected; goto new;
jl. a4. ; end end else point is expected:
a8: al w0 2 ; if char<>point then
se w2 46 ; begin state:=copy linerest; goto new; end
jl. a4. ; else
; compression may start:
;
c0: rs. w2 f3. ; outnext:
al. w1 h19.
jl. w3 h26. ; outchar(char);
c1: jl. w3 h25.-2 ; next: inchar(char)
d0: bl. w3 x2+g0. ; take action: action:= table(char);
al w0 1 ;
j0: jl. x3 ; goto action;
d1: al w0 1 ; normal1:
c2=k-j0
sn. w0 (f0.) ; normal:
jl. c1. ; goto if comment then next else outnext;
jl. c0. ;
c3=k-j0
se. w0 (f1.) ; space:
sn. w0 (f2.) ; goto if string or message
jl. c0. ; then outnext else next;
jl. c1. ;
c4=k-j0
al w2 10 ; nl: vt: ff:
al w0 0 ; char:= nl;
se. w0 (f2.) ; if message then message:= false else
rs. w0 f2. ;
se. w0 (f0.) ; if comment then comment:= false;
rs. w0 f0. ;
al w3 10 ;
sn. w0 (f1.) ; if string or
se. w3 (f3.) ; char<>10 then
jl. c0. ; goto outnext else
jl. c1. ; goto next;
c5=k-j0
a9: jl. w3 h30.-4 ; em: unstack curr in;
al. w1 h19. ;
rl w0 x1+h3 ;
ws w0 x1+h0 ;
hs. w0 c10. ; recbase-basebuf
jl. w3 h95. ; close(output zone);
jl. w3 h79. ;
al w2 x1
al w3 x1+h1+2
al. w1 h54. ; lookup area
jd 1<11+42 ; lookup entry
rl w3 x2+h1+16 ; tail(0):=segm.count
rs w3 x1 ;
al w3 x3-1 ; (segm-1)
ls w3 9 ; *512
c10=k+1
al w3 x3+80 ; +(recbase-basebuf
al w3 x3+2 ; +2)
rs w3 x1+18 ; => loadlength
dl w0 110 ;
ld w0 5 ;
rs w3 x1+10 ; shortclock
al w3 x2+h1+2 ; restore w3
bz w2 x2+h1+1 ; output kind
sn w2 4 ; if kind=bs then
jd 1<11+44 ; changeentry
al w2 0 ; ok:=true;
jl. h7. ; goto fp end program;
c6=k-j0
sn. w0 (f0.) ; semicolon:
jl. c1. ; if comment then goto next;
se. w0 (f1.) ;
sn. w0 (f2.) ; if string or message
jl. c0. ; then goto outnext;
rs. w0 f0. ; comment:= true;
jl. c1. ; goto next;
\f
; rc 21.05.74 page 2
c7=k-j0
am 1 ; m: m: mess:= true; goto inn;
c8=k-j0
al w3 0 ; less than: mess:= false;
hs. w3 b0. ; inn:
sn. w0 (f0.) ; if comment then goto next;
jl. c1. ;
se. w0 (f1.) ;
sn. w0 (f2.) ; if string or message then goto outnext;
jl. c0. ;
al. w1 h19.
jl. w3 h26. ; outchar(char);
jl. w3 h25.-2 ; inchar(char);
b0=k+1;mess, true=1,false=0
se w3 x3 ; if mess then goto message;
jl. a0. ;
se w2 58 ; if char<>colon then goto take action;
jl. d0. ;
rs. w0 f1. ; string:= true;
jl. c0. ; goto outnext;
a0: se w2 46 ; message:
jl. d0. ; if char<>point then goto take action;
rl. w3 f3. ;
sh w3 63 ; if oldchar<>letter then
rs. w0 f2. ; message:= true;
jl. c0. ; goto outnext;
c9=k-j0
al w0 0 ; colon:
sn. w0 (f1.) ;
jl. d1. ; if not string then goto normal1;
al. w1 h19.
jl. w3 h26. ; outchar(char);
jl. w3 h25.-2 ; inchar(char);
se w2 62 ; if char<>greater than then
jl. d0. ; then goto take action;
rs. w0 f1. ; string:= false;
jl. c0. ; goto outnext;
e1: <:***textcompr call<10><0>:>
e2: <:***textcompr connect error<10><0>:>
e3: <:***textcompr param<10><0>:>
a1: am e1-e2
a2: am e2-e3
a3: al. w0 e3.
jl. w3 h31.-2
al w2 1
jl. h7.
;booleans, true=1, false=0
f0: 0 ; comment
f1: 0 ; string
f2: 0 ; message
f3: 0 ; oldchar
h.
c0=c0-j0, c1=c1-j0, c10=c1
g0:
;0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
c1,c1,c1,c1,c1,c1,c1,c1,c1,c1,c4,c4,c4,c1,c1,c1; 0-15
c1,c1,c1,c1,c1,c1,c1,c1,c1,c5,c1,c1,c1,c1,c1,c1;16-31
c3,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2;32-47
c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c9,c6,c8,c2,c2,c2;48-63
c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c7,c2,c2;64-79
c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2;80-95
c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c7,c2,c2;96-111
c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c1;112-127
w.
b1: 0, r.256 ; buffer for program zone
e.
e.
e. ; end of slangcompr
if ok.no
(o c
message trouble textcomp program
end)
o c
message start textcomp
tt=set 50 1
tt=ccs central
if ok.no
(message trouble compress central
end)
rename tt.central
if ok.no
(message trouble rename central
end)
tt=set 50 1
tt=ccs tterm1
if ok.no
(message trouble compress tterm1
end)
rename tt.tterm1
if ok.no
(message trouble rename tterm1
end)
tt=set 50 1
tt=ccs tterm2
if ok.no
(message trouble compress tterm2
end)
rename tt.tterm2
if ok.no
(message trouble rename tterm2
end)
tt=set 50 1
tt=ccs tjobstart
if ok.no
(message trouble compress tjobstart
end)
rename tt.tjobstart
if ok.no
(message trouble rename tjobstart
end)
tt=set 50 1
tt=ccs tjob
if ok.no
(message trouble compress tjob
end)
rename tt.tjob
if ok.no
(message trouble rename tjob
end)
tt=set 50 1
tt=ccs tmount
if ok.no
(message trouble compress tmount
end)
rename tt.tmount
if ok.no
(message trouble rename tmount
end)
tt=set 50 1
tt=ccs tread
if ok.no
(message trouble compress tread
end)
rename tt.tread
if ok.no
(message trouble rename tread
end)
tt=set 50 1
tt=ccs tprinter
if ok.no
(message trouble compress tprinter
end)
rename tt.tprinter
if ok.no
(message trouble rename tprinter
end)
tt=set 50 1
tt=ccs tprocs
if ok.no
(message trouble compress tprocs
end)
rename tt.tprocs
if ok.no
(message trouble rename tprocs
end)
tt=set 50 1
tt=ccs tbanker
if ok.no
(message trouble compress tbanker
end)
rename tt.tbanker
if ok.no
(message trouble rename tbanker
end)
message end textcomp
fdsave coboss.1 newkit.main newscope.temp ,
bossold options jobdescr ,
central tterm1 tterm2 tjobstart tjob tmount tread tprinter tprocs tbanker
fdsave alboss.1 newkit.main newscope.temp ,
taccount tcatupdate tuserout testout textxref tsaveconv tgetconv tusercat
$,f
; check bossold description
qq=edit
i/
b. a10 w.
a0: 0
a1: 0, r.10 ; tail
a2: <:bossold:>,0;
a3: rs. w3 a0. ; save slang return
al. w1 a1. ;
al. w3 a2. ;
jd 1<11+42 ; lookup bossold
bz. w1 a1.+1;
al w2 0
sl. w2 (a1.); if modekind > 0
se w1 18 ; or not magtape then
al w2 1 ; not ok else
al w0 0 ; ok;
jl. (a0.); slang return
jl. a3.
j. e.
/,f
slang qq
if ok.no
(o c
message file descriptors left unchanged
end)
o c
\f
; rc 19.5.72 bossold, ...6...
; generate text file descriptors
f=entry bossold bossold bossold bossold
nextfile f f f; skip options and jobdescr
central=entry f f f f
nextfile f
tterm1=entry f f f f
nextfile f
tterm2=entry f f f f
nextfile f
tjobstart=entry f f f f
nextfile f
tjob=entry f f f f
nextfile f
tmount=entry f f f f
nextfile f
tread=entry f f f f
nextfile f
tprinter=entry f f f f
nextfile f
tprocs=entry f f f f
nextfile f
tbanker=entry f f f f
nextfile f
taccount=entry f f f f
nextfile f
tcatupdate=entry f f f f
nextfile f
tuserout=entry f f f f
nextfile f
testout=entry f f f f
nextfile f
textxref=entry f f f f
nextfile f
tsaveconv=entry f f f f
nextfile f
tgetconv=entry f f f f
nextfile f
tusercat = entry f f f f
; generate options and jobdescr
(end
f=entry bossold bossold bossold bossold
nextfile f
options = set 40 disc
options=move f
nextfile f
jobdescr = set 40 disc
jobdescr=move f
)
\f
▶EOF◀