|
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: 23808 (0x5d00)
Types: TextFile
Names: »twatchdog «
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦2ba378e4a⟧
└─⟦this⟧ »twatchdog «
(watchdog=slang list.no xref.no
watchdog)
; ehp 1981.03.02
;
; version 1981.03.02
; version 1981.06.24
;
; 90 08 13 08.32 kak error records from LAN and IOC devices included
; the program receives error-records from !errorlog! and
; writes these on !rclogarea!.
; the !rclogarea! must have been created before start of program.
;
;
; the internal process, in which the program is running, is
; started with the following s-commands:
;
; new errorsnoop size 1100 buf 2 area 1 mode 0
; base -8388607 8388605 prog watchdog perm disc 0 0 run
;
;
; error messages:
; <:no errorlog<10>:>
; the external process, !errorlog!, is not included
; in the monitor. this process is needed to get the
; error-records.
; <:no rclogarea<10>:>
; <:no buffercore<10>:>
;
; all texts (also error-messages) are sent to the output-terminal defined
; by a1. default: device 2 (main-console).
;
; when the internal process is created correctly, the program
; will write on the output-terminal:
; <:start<10>:>
; the program will now receive error-records from
; !errorlog! and update these in !rclogarea!.
; a message with the second word equal to the text <:sto:>
; will cause the program to update the the last error-records
; at bs-area and finis with an <em> character on this.
; the !rclogarea! is released, when the text <:stop<10>:>
; is written on the output-terminal.
; the program can be started again by a new message
; with the second word equal to the text <:sta:>.
;
; in case of error during output to the bs-area, or when the
; bs-area is full, the program write on the output-terminal the
; text <:stop<10>:>.
;
;
\f
b.g5 ; begin
w. ;
d.
p.<:fpnames:>
l.
g2: ;
s.a5,b40,e8,f40,q99 ; begin
w. ;
a0 = 510 ; size of error log buffer
;***output-terminal:
a1 = 2<1 ; device no of output-terminal shift 1
a2 = 74 ; size of max record
a3 = 34 ; size of std record
a4 = 32 ; addr(time in record)
q6 = 6 ; ioc disc
q8 = 8 ; csp terminal
q18=18 ; idatape
q20=20 ; ida main
q26=26 ; dlc main
q28=28 ; generel sekvential device (DLC)
q62=62 ; disc
b0: <:errorlog:>,0 ; name of error log process
0 ; used by send message
b1: 19<12 ; error log message
0 ; first address
b2: 0 ; last address
b25:0 ; proc descr addr
b3: <:rclogarea:>,0 ; name of log area
0 ; used by send message
b4: 5<12 ; log area message
0 ; first address
b5: 0 ; last address
b6: 0 ; segment no
b8: 0 ; message buffer address
b9: 0,r.8 ; answer
b10:0,0,0,0 ; name of console
0 ; used by send message
0,r.5 ; name of parent terminal
b11:5<12 ; console message
0 ; first address
b12:0 ; last address
b29:1<20 ; data overrun(event status - disc)
b35:1<21 ; timeout(event status - transmit)
b38:0,r.10 ; tail
b14:<:start<10>:> ;
b15:<:stop<10>:> ;
b16:<:on<0>:> ;
b17:<:off:> ;
b26:<:proc :> ;
b18:0,r.4 ; procname
b19:<:<10><0><0>:> ; nl
b20:0 ; outerror
b21:0 ; switch
b22:<:wrk:> ;
b23:<:addr 0:> ;
b24:0 ; no of records
b36:0,r.5 ; parent name
; procedure out segment(link):
; comments: outputs the error log buffer on the log area;
; in case of unacceptable result or status, it returns to
; !type stop!.
; call: return:
; w0 next segment no
; w1 destroyed
; w2 destroyed
; w3 link destroyed
;
b.i5,j6 w. ; begin
i0: 0 ; increase count;
i1: 16<12+1,<:rclogarea bs claim rq:>,0
i2: 2<12+1<5+0,<:rclogarea error:>,0,0
e0: ; out segment:
rs. w3 b37. ; save link;
al w0 0 ;
rs. w0 i0. ; increase count:=0;
j0: al. w3 b3. ;
al. w1 b4. ;
jd 1<11+16 ; send message(message,name;buf);
al. w1 b9. ;
jd 1<11+18 ; wait answer(buf;result,answer);
se w0 1 ; if result <> 1 then
jl. j5. ; goto type stop;
bz. w1 b9. ;
sn w1 0 ; if status < 0 then
jl. j6. ; begin
j1: rl. w2 b9.+2 ;
so w1 (224) ; if end of file or
se w2 512 ; halfwords transferred<512 then
sz ; goto increase
jl. j5. ; else goto stop
rx. w1 i0. ; increase:
se w1 0 ; in -,first time then
jl. j5. ; goto stop else
al. w1 b38. ; tail addr
jd 1<11+42 ; lookup_entry(<:rclogarea:>,tail);
rl w2 x1 ;
al w2 x2+1 ; increase
rs w2 x1+0 ; size of file
jd 1<11+44 ; change_entry(<:rclogarea:>,tail);
sn w0 0 ; if size increased then
jl. j0. ; goto output
sn w0 6 ; if claim exceeded then
am i1-i2 ; parent mess: bs wait
j5: al. w1 i2. ; stop
rs. w0 i2.+14 ; insert result
al w0 0 ;
rs. w0 i0. ; clear increase count
al. w3 b36. ; parent name
jd 1<11+16 ; send_message(parent,message);
al. w1 b9. ; answer address
jd 1<11+18 ;
jl. j0. ; if answer <*from bs wait*> then goto output
j6: al w0 1 ;
wa. w0 b6. ;
rs. w0 b6. ; segment no:= segment no + 1;
jl. (b37.) ; goto saved link;
e. ; end of out segment;
; procedure check message(buf,link;switch):
; comments: if word(message+10) contains the text <:sta:>,<:sto:>,<:on<0>:>
; or <:off:>, an answer is sent with result 1 and return is taken to link + 2;
; the same is done, if word(message+10) contains the text <:pro:> and
; word(message+18) is zero or equal to a device process description address;
; if not, an answer is sent with result 2 and return is taken to
; link;
; if buffer claim exceeded, return is taken to wait event.
; call: return:
; w0 switch (if return to link+2)
; w1 destroyed
; w2 buf destroyed
; w3 link destroyed
;
b.j10 ; begin
w.e1: al w3 x3+1 ; check message1:
e2: sn w2 0 ; check message2: if buf = 0 then
jl. f7. ; goto wait event;
rs. w2 b21. ; switch:= buf;
rl. w0 b24. ;
rs. w0 b9. ; word(answer):= no of records;
rl w0 x2+10 ; text:= word(buf+10);
sn. w0 (b26.) ; if text = <:pro:> then
jl. j5. ; goto check proc;
se. w0 (b16.) ; if text = <:on:>
sn. w0 (b17.) ; or text = <:off:> then
jl. j3. ; goto set;
sz w3 2.1 ; result:=
am b14-b15 ; if text = (if link(23) <> 0 then <:sta:>
sn. w0 (b15.) ; else <:sto:>) then
j1: am 1-2 ; res1: 1
j2: al w0 2 ; res2: else 2;
jd 1<11+26 ; get event(buf);
al. w1 b9. ;
jd 1<11+22 ; send answer(result,answer,buf);
se w0 1 ; if result <> 1 then
jl x3+0 ; goto link;
rl. w0 b21. ; get switch;
jl x3+2 ; goto link +2;
j3: rs. w0 b20. ; set: outerror:= text;
al w0 10 ;
rs. w0 b21. ; switch:= 10;
jl. j1. ; goto res1;
j5: ; check proc:
rl w0 x2+18 ; addr:= proc descr addr(mess+18);
sn w0 0 ; if addr = 0 then
jl. j7. ; goto found;
rl w1 74 ; nameaddr:= first device in name table;
al w1 x1-2 ; nameaddr:= nameaddr - 2;
j6: al w1 x1+2 ; next: nameaddr:= nameaddr + 2;
sl w1 (76) ; if nameaddr >= first area in name table then
jl. j2. ; goto res2;
se w0 (x1+0) ; if addr <> word(nameaddr) then
jl. j6. ; goto next;
j7: rs. w0 b25. ; found: proc descr addr:= addr;
rs. w3 b37. ; save link;
rl w3 0 ;
sn w3 0 ; if addr = 0 then
al. w3 b23.-2 ; addr:= addr(text(<:addr 0:>) - 2);
dl w1 x3+4 ;
ds. w1 b18.+2 ;
dl w1 x3+8 ; move proc name or text
ds. w1 b18.+6 ; to procname;
al w3 0 ;
rs. w3 b21. ; switch:= 0;
rl. w3 b37. ; unsave link;
jl. j1. ; goto link;
e. ; end of check message;
; procedure type(text,link):
; comments: writes a text on the output-terminal.
; call: return:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed
;
b.j5 ; begin
w.e3: rl. w0 b20. ; checkout:
am. (b2.-2) ;
rl w1 28 ;
se. w1 (b25.) ; if cur proc(record) = proc descr addr
se. w0 (b16.) ; or outerror <> <:on:> then
jl x3+0 ; goto link;
al. w1 b18. ; first addr:= addr(procname);
al. w2 b19. ; last addr:= addr(nl);
jl. e8. ; goto type3;
e4: al. w1 b26. ; type5: first addr:= addr(<:proc:>);
al. w2 b19. ; last addr:= addr(nl);
jl. e8. ; goto type3;
e5: am b20-b14 ; type4: text:= addr(outerror)
e6: am b14-b15 ; type1: or <:start:>
e7: al. w1 b15. ; type2: or <:stop:>;
al w2 x1+2 ;
e8: ds. w2 b12. ; type3: save first and last address;
rs. w3 b37. ; save link;
al. w3 b10. ;
al. w1 b11. ;
jd 1<11+16 ; send message(message,name;buf);
al. w1 b9. ;
jd 1<11+18 ; wait answer(buf;result,answer);
bz. w1 b9. ;
sn w0 1 ; if result <> 1
se w1 0 ; or status <> 0 then
jl. j1. ; goto repeat;
jl. (b37.) ; goto saved link;
j1: al. w1 b11. ; error at primary output terminal:try parent terminal
al. w3 b10.+10 ;
jd 1<11+16 ; send message(message,name;buf);
al. w1 b9. ;
jd 1<11+18 ; wait answer(buf;result,answer);
jl. (b37.) ; goto saved link;
e. ; end of type;
b37: 0 ; saved link(common for e0.,e1.,...,e8.)
; central code:
;
w.
f0: ; wait for start:
al w2 0 ; event:= 0;
jd 1<11+24 ; wait event(event;result,next);
jl. w3 e1. ; check message1(buf,link;switch);
jl. f0. ; if rejected then goto wait for start;
sl w0 0 ; if switch < 0
sl w0 11 ; or switch >= 11 then
jl. f1. ; goto start;
se w0 0 ; if switch <> 0 then
am e5-e4 ; type4(outerror,link)
jl. w3 e4. ; else type5(proc,link);
jl. f0. ; goto wait for start;
f1: al. w3 b3. ; start:
jd 1<11+8 ; reserve process(name;result);
se w0 0 ; if result <> 0 then
jl. f20. ; goto type stop;
rs. w0 b6. ; segment no:= 0;
rs. w0 b24. ; no of records:= 0;
rl. w2 b5.-2 ; get first address;
dl w1 110 ;
ds w1 x2+a4 ; move(time, error log + addr(time));
jl. w3 e0. ; out segment(link);
f2: ; type start:
jl. w3 e6. ; type1(<:start:>,link);
f3: ; init:
rl. w2 b5.-2 ; get first addr;
al w3 x2+a2 ; last addr:= first addr + size of max record;
ds. w3 b2. ; save first and last addr in error log mess;
jl. f5. ; goto clear;
f4: jl. w3 e3. ; check: checkout(link);
f5: rl. w2 b2.-2 ; clear:
al w0 25 ;
rs w0 x2+0 ; word(first addr):= 25;
al. w3 b0. ;
al. w1 b1. ;
jd 1<11+16 ; send message(message,name;buf);
rs. w2 b8. ; save buf address;
f6: ; wait event0:
al w2 0 ; event:= 0;
f7: jd 1<11+24 ; wait event: wait event(event;result,buf);
se w0 1 ; if result <> 1 then
jl. f21. ; goto exam message;
rl w0 x2+10 ;
rs. w0 b9.+2 ; save no of hw
rl w0 x2+4 ; result:= receiver(buf);
jd 1<11+26 ; get event(buf);
se w0 1 ; if result <> 1 then
jl. f20. ; goto type stop;
rl. w1 b2.-2 ; addr:= first addr(error log mess);
bz w0 x1+0 ; kind:= byte(addr);
bz w3 x1+1 ; localkind:= byte(addr+1);
sl w0 6 ; if 6<= kind <=28 then <* LAN/IOC device *>
sl w0 29 ;
jl. f9. ; begin
rl w3 0 ; local_kind:=kind;
sn w3 q18 ; if idatape then
jl. f12. ; goto idatape
se w3 q8 ; if -,terminal then
jl. f19. ; goto update
bz w3 x1+34 ;
jl. f10. ; goto test terminal status
; end else
f9: sl w0 84 ; if kind < 84
sl w0 86 ; or kind >= 86 then
jl. f16. ; goto disc;
se w3 8 ; if localkind <> 8 then
jl. f11. ; goto magtape;
bz w3 x1+18 ; status:= byte(addr+18);
;***terminal: (2 lines)
f10: sn w3 1<9 ; if status = timer then
jl. f5. ; goto clear;
jl. f19. ; goto update;
f11: ; magtape:
;***magtape: (1 line)
se w3 18 ; if localkind <> 18 then
jl. f13. ; goto cardreader;
f12: rl w3 x1+2 ; name:
sn. w3 (b22.) ; if word(addr+2) = <:wrk:> then
jl. f5. ; goto clear;
jl. f19. ; goto update;
f13: ; cardreader:
;***cardreader: (1 line)
se w3 16 ; if localkind <> 16 then
jl. f15. ; goto reader;
rl w3 x1+18 ;
sh w3 -1 ; if status(record) <= -1 then
jl. f5. ; goto clear;
jl. f19. ; goto update;
f15: ; reader:
;***reader: (1 line)
se w3 10 ; if localkind <> 10 then
jl. f19. ; goto update;
bz w3 x1+18 ;
sn w3 1<9 ; if status = timer then
jl. f5. ; goto clear;
jl. f19. ; goto update;
f16: ; disc:
;***disc: (1 line)
se w0 62 ; if kind <> 62 then
jl. f18. ; goto tra;
rl w3 x1+24 ;
la. w3 b29. ;
se w3 0 ; if event status(record) <> 0 then
jl. f5. ; goto clear;
rl w3 x1+2 ;
bz w2 x1+10 ;
sn. w3 (b22.) ; if word(addr+2) <> <:wrk:>
se w2 0 ; or oper(addr+10) <> 0 then
jl. f19. ; goto update;
jl. f5. ; goto clear;
f18: ; tra:
;***fpa: (1 line)
se w0 88 ; if kind <> 88 then
jl. f19. ; goto update;
rl w3 x1+18 ;
rl w2 x1+24 ; event:= event status(first sense)
ws. w2 b35. ; - timeout;
se w3 0 ; if channel(first sense) = 0
sn w2 0 ; or event = 0 then
jl. f5. ; goto clear;
f19: ; update:
dl w3 x1+4 ;
ds. w3 b18.+2 ;
dl w3 x1+8 ; move record name
ds. w3 b18.+6 ; to proc name;
al w2 1 ;
wa. w2 b24. ; no of records:=
rs. w2 b24. ; no of records + 1;
c. -1
al w2 x1+a3 ; first addr:= addr + size of std record;
se w0 86 ; if kind = 86 or kind = 88 then
sn w0 88 ; first addr:= first addr - size of std
al w2 x2-a3+a2 ; record + size of max record;
al w3 x2+a2 ; last addr:= first addr + size of max record;
z.
al w2 x1 ;
wa. w2 b9.+2 ; first addr:=old first addr+number of halfwords received
al w3 x2+a2 ; last addr:=first addr + max buff size
ds. w3 b2. ; save first and last addr;
al w3 x3-2 ;
sh. w3 (b5.) ; if last addr <= last addr(log area mess) then
jl. f4. ; goto check;
jl. w3 e3. ; checkout(link);
jl. w3 e0. ; out segment(link;segment no);
jl. f3. ; goto init;
f20: ; type stop:
al. w3 b3. ;
jd 1<11+10 ; release process(name);
jl. w3 e7. ; type2(<:stop:>,link);
jl. f0. ; goto wait for start;
f21: ; exam message:
jl. w3 e2. ; check message2(buf,link;switch);
jl. f6. ; if rejected then goto wait event0;
se w0 0 ; if switch <> 0 then
jl. f22. ; goto check10;
rl. w2 b8. ; buf:= saved buf address;
jd 1<11+82 ; regret message(buf);
jl. w3 e4. ; type5(proc,link);
jl. f5. ; goto clear;
f22:se w0 10 ; check10: if switch <> 10 then
jl. f23. ; goto stop;
jl. w3 e5. ; type4(outerror,link);
jl. f6. ; goto wait event0;
f23:rl. w2 b8. ; stop: buf:= saved buf address;
jd 1<11+82 ; regret message(buf);
jl. w3 e0. ; out segment(link);
jl. f20. ; goto type stop;
;
; end of central code;
b40: 0,r.50 ; first word(buffer);
; init code:
;
; comments: the following code
; 1) initialize the name of the terminal by means of
; !device no of output-terminal!,
; 2) initializes the !errorlog!,
; 3) creates and reserves an area process for the !rclogarea!,
; and output the time in segment 0,
; 4) and examines whether there is room for the log
; buffer or not.
; in case of an unacceptable result during this job, an error
; message is send to the output-terminal
; and the program will be running after error.
;
b. i12 w.
g5: ds. w1 i4. ; entry point:
ds. w3 i6. ; save w0,w1=pda.parent,w2=pda.console,w3=pda.own
dl w0 x2+4 ; move
ds. w0 b10.+12 ; parent console name to
dl w0 x2+8 ; to buffer
ds. w0 b10.+16 ;
dl w0 x1+4 ; move parent name to proc
ds. w0 b36.+2 ;
dl w0 x1+8 ;
ds. w0 b36.+6 ;
al w1 a1 ; proc:=
wa w1 74 ; + first device in name table);
rl w1 x1 ;
dl w3 x1+4 ;
ds. w3 b10.+2 ;
dl w3 x1+8 ;
ds. w3 b10.+6 ; name of output-terminal:= name(proc);
al. w3 b0. ;
jd 1<11+4 ; process description(name;result);
sn w0 0 ; if result = 0 then
jl. i10. ; goto error0;
al. w3 b3. ;
al. w1 b38. ;
jd 1<11+42 ; lookup entry(tail,name;tail);
jd 1<11+52 ; create area process(name);
jd 1<11+8 ; reserve process(name;result);
se w0 0 ; if result <> 0 then
jl. i11. ; goto error1;
rl. w1 i6. ;
rl w1 x1+24 ; top address:= top address(own process);
al. w2 b40. ; first address:= addr(first address(buffer));
al w3 x2+a0 ; last address:= first address + size of error log buffer;
sl w3 x1+0 ; if last address >= top address then
jl. i12. ; goto error2;
ds. w3 b2. ; save first and last address in error log
ds. w3 b5. ; message and log area message;
dl w1 110 ;
ds w1 x2+a4 ; move(time, error log + addr(time));
jl. w3 e0. ; out segment(link);
jl. f2. ; goto type start;
i0: 2<12+0,<:no errorlog:>,0,0,0
i1: 2<12+0,<:no rclogarea:>,0,0,0
i2: 2<12+0,<:proc size too small:>,0
i3: 0 ; saved w0
i4: 0 ; w1: pda of parent
i5: 0 ; w2: pda of parent console
i6: 0 ; w3: pda of errorsnoop process
i10:am i0-i1 ; error0
i11:am i1-i2 ; error1
i12:al. w1 i2. ; error2
al. w3 b36. ;
jd 1<11+16 ; send finis message to parent
jl. 0 ; and wait
e.
; end of init code;
e. ; end of central codesegment;
; information for insertproc:
;
g3: ;
g0: g1: ; first and last tail
(:g3-g2+511:) > 9 ; no of segments
0,0,0,0 ; name
0 ; date
0 ;
0 ;
3<12+g5-g2 ; contents, entry
g3-g2 ; length
d.
p.<:insertproc:>
scope user watchdog
▶EOF◀