|
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: 20736 (0x5100)
Types: TextFile
Names: »terrorsnoop «
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦2ba378e4a⟧
└─⟦this⟧ »terrorsnoop «
;
berrorsnoop=set 2 disc
(berrorsnoop=slang; list.no xref.no
berrorsnoop)
; 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; 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,b36,e5,i35 ; 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)
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
b7: 0 ; size of log area
b8: 0 ; message buffer address
b9: 0,r.8 ; answer
b10:0,0,0,0 ; name of console
0 ; used by send message
b11:5<12 ; console message
0 ; first address
b12:0 ; last address
b13:0 ; console proc descr. addr.
b29:1<20 ; data overrun(event status - disc)
b35:1<21 ; timeout(event status - transmit)
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
; 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. ; begin
w.i1: ; out segment:
rs. w3 i0. ; save link;
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);
bz. w1 b9. ;
sn w0 1 ; if result <> 1
se w1 0 ; or status <> 0 then
jl. i17. ; goto type stop;
wa. w0 b6. ;
rs. w0 b6. ; segment no:= segment no + 1;
jl. (i0.) ; 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.i6: al w3 x3+1 ; check message1:
i2: sn w2 0 ; check message2: if buf = 0 then
jl. i16. ; 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 i0. ; 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 i0. ; 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.i8: 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. i5. ; goto type3;
i9: al. w1 b26. ; type5: first addr:= addr(<:proc:>);
al. w2 b19. ; last addr:= addr(nl);
jl. i5. ; goto type3;
i7: am b20-b14 ; type4: text:= addr(outerror)
i3: am b14-b15 ; type1: or <:start:>
i4: al. w1 b15. ; type2: or <:stop:>;
al w2 x1+2 ;
i5: ds. w2 b12. ; type3: save first and last address;
rs. w3 i0. ; save link;
j1: al w0 0 ; repeat:
rl. w1 b13. ; proc:= console descr. addr.;
rs w0 x1+12 ; reserver(proc):= 0;
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. (i0.) ; goto saved link;
e. ; end of type;
i0: 0 ; saved link(common for i1.,i2.,i3.,i4., and i.)
; central code:
;
w.i10: ; wait for start:
al w2 0 ; event:= 0;
jd 1<11+24 ; wait event(event;result,next);
jl. w3 i6. ; check message1(buf,link;switch);
jl. i10. ; if rejected then goto wait for start;
sl w0 0 ; if switch < 0
sl w0 11 ; or switch >= 11 then
jl. i21. ; goto start;
se w0 0 ; if switch <> 0 then
am i7-i9 ; type4(outerror,link)
jl. w3 i9. ; else type5(proc,link);
jl. i10. ; goto wait for start;
i21:al. w3 b3. ; start:
jd 1<11+8 ; reserve process(name;result);
se w0 0 ; if result <> 0 then
jl. i17. ; 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 i1. ; out segment(link);
i11: ; type start:
jl. w3 i3. ; type1(<:start:>,link);
i12: ; 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. i23. ; goto clear;
i22:jl. w3 i8. ; check: checkout(link);
i23: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;
i15: ; wait event0:
al w2 0 ; event:= 0;
i16:jd 1<11+24 ; wait event: wait event(event;result,buf);
se w0 1 ; if result <> 1 then
jl. i18. ; goto exam message;
rl w0 x2+4 ; result:= receiver(buf);
jd 1<11+26 ; get event(buf);
se w0 1 ; if result <> 1 then
jl. i17. ; goto type stop;
rl. w1 b2.-2 ; addr:= first addr(error log mess);
bz w0 x1+0 ; kind:= byte(addr);
sl w0 84 ; if kind < 84
sl w0 86 ; or kind >= 86 then
jl. i28. ; goto disc;
bz w3 x1+1 ; localkind:= byte(addr+1);
se w3 8 ; if localkind <> 8 then
jl. i26. ; goto magtape;
bz w3 x1+18 ; status:= byte(addr+18);
;***terminal: (2 lines)
sn w3 1<9 ; if status = timer then
jl. i23. ; goto clear;
jl. i29. ; goto update;
i26: ; magtape:
;***magtape: (1 line)
se w3 18 ; if localkind <> 18 then
jl. i25. ; goto cardreader;
i27:rl w3 x1+2 ; name:
sn. w3 (b22.) ; if word(addr+2) = <:wrk:> then
jl. i23. ; goto clear;
jl. i29. ; goto update;
i25: ; cardreader:
;***cardreader: (1 line)
se w3 16 ; if localkind <> 16 then
jl. i14. ; goto reader;
rl w3 x1+18 ;
sh w3 -1 ; if status(record) <= -1 then
jl. i23. ; goto clear;
jl. i29. ; goto update;
i14: ; reader:
;***reader: (1 line)
se w3 10 ; if localkind <> 10 then
jl. i29. ; goto update;
bz w3 x1+18 ;
sn w3 1<9 ; if status = timer then
jl. i23. ; goto clear;
jl. i29. ; goto update;
i28: ; disc:
;***disc: (1 line)
se w0 62 ; if kind <> 62 then
jl. i24. ; goto tra;
rl w3 x1+24 ;
la. w3 b29. ;
se w3 0 ; if event status(record) <> 0 then
jl. i23. ; 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. i29. ; goto update;
jl. i23. ; goto clear;
i24: ; tra:
;***fpa: (1 line)
se w0 88 ; if kind <> 88 then
jl. i29. ; 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. i23. ; goto clear;
i29: ; 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;
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;
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. i22. ; goto check;
jl. w3 i8. ; checkout(link);
jl. w3 i1. ; out segment(link;segment no);
sh. w0 (b7.) ; if segment no <= size of log area then
jl. i12. ; goto init;
i17: ; type stop:
al. w3 b3. ;
jd 1<11+10 ; release process(name);
jl. w3 i4. ; type2(<:stop:>,link);
jl. i10. ; goto wait for start;
i18: ; exam message:
jl. w3 i2. ; check message2(buf,link;switch);
jl. i15. ; if rejected then goto wait event0;
se w0 0 ; if switch <> 0 then
jl. i30. ; goto check10;
rl. w2 b8. ; buf:= saved buf address;
jd 1<11+82 ; regret message(buf);
jl. w3 i9. ; type5(proc,link);
jl. i23. ; goto clear;
i30:se w0 10 ; check10: if switch <> 10 then
jl. i19. ; goto stop;
jl. w3 i7. ; type4(outerror,link);
jl. i15. ; goto wait event0;
i19:rl. w2 b8. ; stop: buf:= saved buf address;
jd 1<11+82 ; regret message(buf);
jl. w3 i1. ; out segment(link);
jl. i17. ; goto type stop;
;
; end of central code;
i20: 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.
;
w.g5: rs. w3 b36. ; entry point:
al w1 a1 ; proc:=
wa w1 74 ; + first device in name table);
rl w1 x1+0 ;
rs. w1 b13. ; output-terminal descr. addr.:= proc;
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. e0. ; goto error0;
al. w3 b3. ;
al. w1 g5.-20 ;
jd 1<11+42 ; lookup entry(tail,name;tail);
rl w1 x1+0 ;
al w1 x1-1 ;
rs. w1 b7. ; size of log area:= size(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. e1. ; goto error1;
rl. w1 b36.
rl w1 x1+24 ; top address:= top address(own process);
al. w2 i20. ; 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. e2. ; 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 i1. ; out segment(link);
jl. i11. ; goto type start;
b36: 0
b30:<:no errorlog <10>:>
b31:<:no rclogarea <10>:>
b32:<:proc size too small<10>:>
e0: am b30-b31 ; error0: text:= (b30:b31)
e1: am b31-b32 ; error1: or (b31:b32)
e2: al. w1 b32. ; error2: or (b32:e0)
al w2 x1+12 ;
jl. w3 i5. ; type3(text,link);
jl -1 ; running after error;
; 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 berrorsnoop
▶EOF◀