|
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: 17664 (0x4500)
Types: TextFile
Names: »changek3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »changek3tx «
b. g1, f4,
w.
s. c20, d5, e25
w.
d.
p.<:fpnames:>
l.
w.
k=h55
; entry changekit
0, 0
jl. c14. ; goto start
c0 : 0 ; saved fp start
c1 : 0 ; devno (device number)
c2 : 0 ; name add of "oldkitname"
c3 : 2.100 ; mask off result 2 and 3
c4 : 0,r.5 ; space for workname
c5 : 3<12 ; message: operation input
0 ; first address of transfer
0 ; last address of transfer
0 ; segment number
c6 : 0,r.8 ; answer: status,bytes transferred,char trans
c7 : 0 ; counter on status from input chaintable
c9 : -1 ; segment counter
c12: 0 ; name conflict false
c13: <:<10>the following names appeared :>
<:in main catalog<10>as well as in :>
<:aux-catalog. they are not inserted<10><0>:>
c11: 1<18 ; end of document bit
c15: 0 ; name address of program name
c14 : rs. w1 c0. ; start: begin c0:=fp start
; check fp command
al w0 x3+2 ; save name address
rs. w0 c15. ; of changekit
se w2 x3 ; if leftside then
jl. e0. ; outerror (leftside)
bl w0 x3+1 ; if program_item <>
se w0 10 ; name then
jl. e7. ; outerror (prog_name)
ba w3 x3+1 ; if separator1 <>
bl w0 x3 ; space then
se w0 4 ; outerror (no_space)
jl. e7. ;
bl w0 x3+1 ; if param1 <>
se w0 4 ; integer then
jl. e7. ; outerror (no_integer)
rl w2 x3+2 ; c1:=w2:=param1
rs. w2 c1. ; comment device number
ba w3 x3+1 ; if separator2 <>
bl w0 x3 ; space then
se w0 4 ; outerror (no_space)
jl. e7. ;
bl w0 x3+1 ; if param2 <>
se w0 10 ; name then
jl. e7. ; outerror (param2)
al w3 x3+2 ; c2:=w3:=address of
rs. w3 c2. ; oldkitname
al w3 x3+8 ; if separator3 = <sp>,<=>,<.>
bl w0 x3 ; then
sl w0 4 ;
jl. e7. ; outerror (param)
al w3 x3-8 ; w3=address of oldkitname
; end check of fp command. w3 contains the address
; of oldkitname. w2 contains the device number
; remove entries belonging to old kit from main catalog
b. a0
w.
al w1 -1 ; w1:=-1
a0 : ba. w1 1 ; rep:w1:=w1+1
jd 1<11+88 ; monitor remove bs (w1,w3)
sn w0 0 ; if all_name_key entries
jl. a0. ; removed then goto rep
sn w0 7 ; if w0=7 then
jl. e1. ; outerror (w0)
la. w0 c3. ; if w0=4 or w0=5
se w0 0 ; then
jl. e2. ; outerror (w0)
e.
; end remove entries from main catalog. w3 contains name
; address of oldkitname. w0=0, w1:= highest segno
; of oldcat + 1. w2:=device number
; input chaintable from newly mounted kit on device devno
; include the device in the backing store system and
; create an area process corresponding to the new aux-catalog
b. a2
w.
al w1 x2 ; w1:=w2
al. w3 c4. ; w3:=workname_address
jd 1<11+54 ; monitor create ph pr (w1,w3)
sn w0 2 ; if result = 2 then
jl. e4. ; outerror (proc not user)
sn w0 4 ; if result=4 then
jl. e5. ; outerror (device no unknown)
sn w0 5 ; if result = 5 then
jl. e6. ; outerror (doc not bs)
se w0 0 ; if w0<>0 then
jl. e9. ; outerror (w0)
jd 1<11+4 ; if kind of periph proc <> 6
rl w1 (0) ; or kind of peripheral proc <> 62
sn w1 84 ; m8000: bs subproc kind
jl. +10 ;
se w1 6 ; then
sn w1 62 ;
sh w1 0 ;
jl. e6. ; outerror (doc not bs)
jd 1<11+6 ; monitor initialize p (w3)
se w0 0 ; if process_not_initialized then
jl. e10. ; outerror (w0)
al. w0 d0. ; first_add_of_transfer:= d0
am 2000 ;
al. w1 d1. ; last_add_of_transfer:= d1
ds. w1 c5.+4 ;
a1 : al. w1 c5. ; repeat: w1:=message_address
jd 1<11+16 ; monitor send mess (w1,w3)
al. w1 c6. ; w1:=answer address
jd 1<11+18 ; monitor wait answer (w1,w2)
am (x1) ; if status <> 0 then
se w3 x3 ;
jl. a2. ; goto error step
se w0 1 ; if dummy answer then
jl. a0. ; goto check
am (x1+2) ; if bytes transferred = 0
sn w3 x3 ; then
jl. a1. ; goto repeat
rl. w1 c1. ; w1:= device no
al. w3 d0. ; w3:= chaintableaddress
jd 1<11+84 ; monitor create bs (w1,w3)
se w0 0 ; if bs not created then
jl. e11. ; outerror (w0)
al w3 x3 +6 ; w3:=name address of catalog
jd 1<11+52 ; monitor create area pc (w3)
se w0 0 ; if area process not created
jl. e12. ; then outerror (w0)
jl. c8. ; goto insert entries
a0 : se w0 5 ; check: if dummy answer <> result 5
jl. e14. ; then outerror (w0)
rl. w0 c7. ; c7:=c7+1
ba. w0 1 ;
rs. w0 c7. ;
sh w0 2 ; if c7<=2 then
jl. a1. ; goto repeat
; else begin
al w0 5 ; add 1<5 to status word
sh w0 0 ; and skip next instruction
a2:al w0 0 ; error step: w0=0
jl. e14. ; outerror(w0)
e. ; end
; insert entries from aux catalog.the catalog is input
; segment by segment. for each segment the monitor
; procedure insert entries are called once per used entry
; when status end_of_document is recieved the program
; returns to fp. w3 contains the name address.
b. a7, b1
w.
c8 : am 2000 ; insert entries:
al. w0 d2. ; c5+2:=first address of transfer:=d2
am 2000 ;
al. w1 d3. ; c5+4:=last address of transfer:=d3
ds. w1 c5.+4 ;
a0 : al. w3 d0. ; next segment: w3=name address of
al w3 x3+6 ; new catalog
rl. w0 c9. ;
ba. w0 1 ; segment count:=segment count +1
rs. w0 c9. ;
rs. w0 c5.+6 ; c5+6:=segment count
a1 : al. w1 c5. ; repeat: w1:= message address
jd 1<11+16 ; monitor send mess (w1,w3)
al. w1 c6. ; w1:=answer address
jd 1<11+18 ; monitor wait answer (w1,w2)
se w0 1 ; if dummy answer then
jl. e15. ; outerror (w0)
am (x1) ; if status<>0
se w3 x3 ; then
jl. a2. ; goto checkend
am (x1+2) ; if bytes transferred=0
sn w3 x3 ; then
jl. a1. ; goto repeat
rl w0 x1+2 ; if bytes transferred<>512
se w0 512 ; then
jl. e15. ; outerror (w0)
am 2000 ;
al. w1 d2. ; w1:=add of first entry
al. w3 d0. ; w3:=chaintableaddress
a3 : rl w0 x1 ; next entry: if entry_available
sn w0 -1 ; then
jl. a4. ; goto update pointer
jd 1<11+86 ; monitor insert entry (w1,w3)
sn w0 3 ; if name_conflict then
jl. a5. ; goto namecon
se w0 0 ; if w0<>0 then
jl. e8. ; outerror (w0)
; no_of_entries - 1
a4 : al w1 x1+34 ; update pointer: w1:=w1+34
am 2000 ;
se. w1 d3. ; if -,(whole_segm_done)
jl. a3. ; then goto next entry
jl. a0. ; goto next segment
a5 : ds. w1 b0. ; namecon: save w0, w1
ds. w3 b1. ; save: w2, w3
rl. w0 c12. ; if first name conflict
se w0 0 ; then
jl. a6. ; begin
al. w0 c13. ; write(out,<:<heading text>:>)
jl. w3 h31.-2 ;
al w0 1 ; name_conflict:=true
rs. w0 c12. ;
; end
a6 : al w2 10 ;
jl. w3 h26.-2 ; write(out,<:<10>:>)
al w0 6 ;
wa. w0 b0. ;
jl. w3 h31.-2 ; write(out,<:<entry name>:>)
dl. w1 b0. ; restore w0, w1
dl. w3 b1. ; restore w2, w3
jl. a4. ; goto entry inserted
0
b0 : 0
0
b1 : 0
a2 : rl w0 x1 ; checkend:
so. w0 (c11.) ; if status<> end of document then
jl. e15. ; outerror (w0)
al. w3 d0. ; w3:=name address of
al w3 x3+6 ; bicat area process
jd 1<11+64 ; monitor remov3 process (w3)
se w0 0 ; if process not removed then
jl. e13. ; outerror (w0)
al w2 0 ; ok.yes, warning.no
jl. h7. ; goto fp_end_program
e. ; end insert entries
; outerror routine
b. b20,a14
w.
b20:<:<10>***<0>:>
b0 :<:<32>call<10><0>:>
b1 :<:<32>main catalog inconsistent<10><0>:>
b2 :<:<32>kit in use<10><0>:>
b3 :<:<32>oldkitname unknown<10><0>:>
b4 :<:<32>process is not included as user<10><0>:>
b5 :<:<32>device number unknown<10><0>:>
b6 :<:<32>document is not a bs document<10><0>:>
b7 :<:<32>param<32><0>:>
b8 :<:<32>insert entry:<32><0>:>
b9 :<:<32>create periph proc, result:<0>:>
b10:<:<32>initialize proc, result:<0>:>
b11:<:<32>create backing storage, result:<0>:>
b12:<:<32>create area process, result:<0>:>
b13:<:<32>remove area process, result:<0>:>
b14:<:<0>:> ; periph proc
b15:<:<0>:> ; area process
b16: 0
a0 : 0 ; save w0
a1 : 0 ; save w1
a2 : 0 ; save w2
a3 : 0 ; save w3
e0 : am b0-b1
e1 : am b1-b2
e2 : am b2-b3
e3 : am b3-b4
e4 : am b4-b5
e5 : am b5-b6
e6 : am b6-b7
e7 : am b7-b8
e8 : am b8-b9
e9 : am b9-b10
e10: am b10-b11
e11: am b11-b12
e12: am b12-b13
e13: am b13-b14
e14: am b14-b15
e15: am b15-b16
al. w2 b16. ; w2:=error_text_address
ds. w1 a1. ; save w0, w1
ds. w3 a3. ; save w2, w3
al. w0 b20. ;
jl. w3 h31.-2 ; write(0ut,<:<10>***:>)
rl. w0 c15. ;
jl. w3 h31.-2 ; write(out,<:changekit:>)
rl. w0 a2. ;
jl. w3 h31.-2 ; write(out,<:<errortext>:>)
rl. w0 a2. ; w0:=error_text_address
sh. w0 b6. ; if w0<=b6 then
jl. a4. ; goto error_group1
sh. w0 b7. ; if w0=b7 then
jl. a5. ; goto error_group2
sh. w0 b8. ; if w0=b8 then
jl. a6. ; goto error_group3
sh. w0 b13. ; if b9<=w0<=b13 then
jl. a7. ; goto error_group4
dl. w1 a1. ; error_group5: get result,status
sl w0 6 ; if result>=6 then
al w0 4 ; result=4 comment if result from
; send mess wait answer was 1 then
; number of bytes transferred are
; stored in w0 and if this is not 512
; we jump to this error_group
al w2 1 ;
ls w2 (0) ; logical status := 1 shift result
sn w2 1<1 ;
lo w2 x1 ; +maybe status
rl. w3 a2. ; w3:=error_text_address
al. w1 d0. ;
al w1 x1+6 ; w1:=name address of area process
sh. w3 b14. ; if proc = periph proc then
al. w1 c4. ; w1*= name add of periph proc
am. (c0.) ;
jl +h7 ; goto fp_end_program
a4 : al w2 1 ; error_group1: fp_end:
am. (c0.) ; ok.no warning.yes
jl +h7 ; goto fp_end_program
a5 : rl. w3 a3. ; error_group2: write_out_separator
bl w1 x3 ; w1*=separator kind
sh w1 -4 ; if separator kind=end comm stack then
jl. a9. ; goto end comm stack
rl. w2 x1+a8. ; write(out,case w1 of ( ) ( nl sp = .))
rl w0 4 ; w0=w2
am. (c0.) ;
jl w3 +h26-2 ;
sn w0 -2 ; if separator = nl then
jl. a4. ; goto fp end
rl. w3 a3. ; write out parameter
bl w1 x3+1 ; w1=param length
sh w1 0 ; if no parameter then
jl. a4. ; goto fp_end
sh w1 2 ; if next separator follows then
jl. a12. ; goto write next separator
sh w1 4 ; if param=integer then
jl. a13. ; goto write integer
al w0 x3+2 ; w0:=name address
am. (c0.) ;
jl w3 h31-2 ; write(out,<name>)
a9 : al w2 10 ; end_comm_stack:
am. (c0.) ; write(out,<:end command stack:>)
jl w3 h26-2 ;
jl. a4. ; goto fp_end
a12: bl w1 x3+2 ; write next separator: w1:=separator kind
sh w1 -4 ; if sep kind= end comm stack then
jl. a9. ; goto end comm stack
rl. w2 x1+a8. ; write (out,case w2 of ( ) nl sp = .
am. (c0.) ;
jl w3 h26-2 ;
jl. a4. ; goto fp_end
a13: rl w0 x3+2 ; write_integer: w0:=integer
am. (c0.) ;
jl w3 h32-2 ;
32<12+3 ;
jl. a9. ; goto fp_end
10 ; newline
a8 : 40 ; begin paranthese
10 ; newline
32 ; space
61 ; equality sign
46 ; point
a6 : al w0 6 ; error_group3:
wa. w0 a1. ; w0:=entry_name_address
am. (c0.) ;
jl w3 h31-2 ; write(out,entry name)
al. w0 a14. ; write(out, result)
am. (c0.) ;
jl w3 h31-2 ;
a7 : rl. w0 a0. ; error_group4:
am. (c0.) ; write(out,<<ddd>,w0)
jl w3 h32-2 ;
32<12+3 ;
jl. a9. ; goto fp_end
a14:<: result: <0>:>
e. ; end outerror routine
; bufferarea
d0 : 0 ; first address of bufferarea
; for chaintable
d1 = d0+2560-2-2000 ; last address of bufferarea
; for chaintable
d2 = d1+2 ; first address of bufferarea
; for catalog segment
d3 = d2+510 ; last address of bufferarea
; for catalog segment
i.
m. rc 12.08.76 fp utility changekit
f1 = d3+2000-1536 ; length
f2 = 4 ; entry
g0:g1:(:f1+511:)>9 ; segment
0,r.4 ; name
s2 ; date
0,0 ; file, block
2<12+f2 ; contents key, entry
f1 ; length
d.
p.<:insertproc:>
l.
e.
e.
e.
▶EOF◀