|
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: 62208 (0xf300)
Types: TextFile
Names: »kkfptxt33«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦80d78256e⟧ »kkmon4filer«
└─⟦this⟧
m. fp text 3
\f
; fp text 3
; rc 19.02.73 file processor, init, page 1
; initialize the file processor
s. k=h55, e48,b12 ; begin
w. 512 ; length ; segment 10:
e0: al. w0 h12. ; init: word(first of process) :=
rs. w0 h12. ; first of process;
am (66) ; parent:
rl w1 50 ; h17:=parent address;
rs. w1 h17. ; search the nametable
rl w2 78 ; to find the nametable address
al w2 x2+2 ; of the parent (to be used at
se w1 (x2-2) ; parent-messages);
jl. -4 ;
rx. w2 h44.+8 ;
rs. w2 b8. ; first:=(old addr=0);
al. w3 h10. ;
al w0 0 ;
jd 1<11+0 ; set interrupt (0,fp break);
am (66) ; get parent name:
rl w2 50 ; w2:=parent;
dl w1 x2+4 ;
ds. w1 h44.+2 ; move parent name
dl w1 x2+8 ; to resident fp;
ds. w1 h44.+6 ;
rl w1 66 ; set catbase:
dl w1 x1+78 ; set catbase(standard);
al. w3 b4. ;
jd 1<11+72 ;
; initialize current out:
rl. w2 h15. ; create c:
rl w0 x2 ; kind := kind of prim out;
sl w0 20 ; if kind > 18 then
al w0 8 ; kind := tw;
wa. w0 b0. ;
al. w1 b1. ; tail(0) := 1<23 + kind;
rs w0 x1 ;
dl w0 x2+4 ;
ds w0 x1+4 ; tail(2:8) :=
dl w0 x2+8 ; process name(prim out);
ds w0 x1+8 ;
al. w3 b2. ;
e11: jd 1<11+40 ; create entry(<:c:>);
se w0 3 ; if not allready exists
jl. e12. ; then goto check created;
\f
; rc 06.10.72 file processor, init, page 2
al. w1 h54. ; c exists allready:
jd 1<11+42 ; lookup entry(c);
se w0 0 ; if not found
jl. e5. ; then goto failure;
dl. w3 b5. ; compare proc.names:
sn w2 (x1+2) ; if first part of name
se w3 (x1+4) ; does not fit
jl. e10. ; then goto remove c;
dl. w3 b6. ;
sn w2 (x1+6) ; if second part of name
se w3 (x1+8) ; does not fit
jl. e10. ; then goto remove c;
jl. e6. ; goto initialize curr in;
e10: al. w3 b2. ; remove c:
jd 1<11+48 ; remove entry(c);
al. w1 b1. ;
jl. e11. ; goto create c;
; check created:
e12: se w0 0 ; if not created then
jl. e5. ; goto failure;
; initialize current in:
e6: rl. w2 h17.-2 ; create v:
rl w0 x2 ; kind := kind of prim in;
sl w0 20 ; if kind > 18 then
al w0 8 ; kind := tw;
wa. w0 b0. ;
al. w1 b1. ; tail(0) := 1<23 + kind;
rs w0 x1 ;
dl w0 x2+4 ;
ds w0 x1+4 ; tail(2:8) :=
dl w0 x2+8 ; process name (prim in);
ds w0 x1+8 ;
al. w3 b3. ;
e13: jd 1<11+40 ; create entry(<:v:>);
se w0 3 ; if not allready exists
jl. e14. ; then goto check created;
al. w1 h54. ; v exists allready:
jd 1<11+42 ; lookup entry(v);
se w0 0 ; if not found
jl. e5. ; then goto failure;
dl. w3 b5. ; compare proc.names:
sn w2 (x1+2) ; if first part of name
se w3 (x1+4) ; does not fit
jl. e15. ; then goto remove v;
dl. w3 b6. ;
sn w2 (x1+6) ; if second part of name
se w3 (x1+8) ; does not fit
jl. e15. ; then goto remove v;
jl. e7. ; goto init zones;
e15: al. w3 b3. ; remove v:
jd 1<11+48 ; remove entry(v);
al. w1 b1. ;
jl. e13. ; goto create v;
; check created:
e14: se w0 0 ; if not created then
jl. e5. ; goto failure;
\f
; rc 06.10.72 filiprocessor init, page 3
; initialize current zones and shares (max double buffered)
e7: rl. w3 h16. ; init current zones:
dl w2 x3+24 ;
al w1 x1-1 ; base.prog:= first addr.proc -1;
al w2 x2-1 ; last.prog:= top addr.proc -1;
ds. w2 h19.+h0+2 ;
al w1 x2-h91*512 ; base.out:= last.prog -h91*512;
ds. w2 h21.+h0+2 ; last.out:= last.prog;
al w3 x1+1 ; base.in:= base.out -h90*512;
rs. w3 h82.+2 ; last.in:= base.out;
e1: al w3 x3+512 ;
c. h91-2 ; comment: the init code will
rs. w3 h82.+2+h6 ; handle single and double
z. al w0 x1-h90*512 ; buffered io zones;
ds. w1 h20.+h0+2 ;
ba. w0 1 ; first shared.first share.out:=
rs. w0 h81.+2 ; base.out +1;
c. h90-2 ;
ba. w0 e1.+1 ; first shared.last share.out:=
rs. w0 h81.+2+h6 ; base.out +1 + (h91-1)*512;
z. al. w0 h80. ; first shared.first share.in:=
rs. w0 h19.+h0+4 ; base.in +1;
rs. w0 h19.+h0+6 ; first shared.last share.in:=
rs. w0 h19.+h0+8 ; base.in +1 + (h90-1)*512;
al. w1 h81. ;
e2= (:h90-1:)*h6 ; set first,last share in prog;
al w2 x1+e2 ;
ds. w2 h20.+h0+8 ; set first,last share in out;
al. w1 h82. ;
e3= (:h91-1:)*h6 ; set first,last share in in;
al w2 x1+e3 ;
ds. w2 h21.+h0+8 ;
\f
; rc 05.06.73 file processor, init, page 4
e4: al w0 1<1 ; connect in and out:
al. w2 b2. ; no of segs := 1; device := drum;
jl. w3 h28.-2 ; connect out (c , out zone);
se w0 0 ; if result <> 0 then
jl. e5. ; goto failure;
al. w2 b3. ; connect in (v , in zone);
jl. w3 h27.-2 ; if result <> 0 then
se w0 0 ; goto failure;
jl. e5. ;
al w0 1 ;
al. w1 h68. ; set i-bit to zero in cur input;
ds. w1 h93. ; clear give up masks in all zones;
al w0 0 ; set fp stdaction as
ds. w1 h92. ; give up action in all cur. zones;
rl. w3 h20.+h0+0 ; init command pointers:
al w3 x3-1 ; current command pointer:=
rs. w3 h8. ; last of commands:=
rs. w3 h9. ; base.in -1;
al w0 0 ; current name chain(0):= 0;
rs. w0 h50. ;
am. (b8.) ; if not first
sn w1 x1 ; then
jl. e16. ; begin
al. w0 b7. ; outtext(<:***fp reinitialized:>);
jl. w3 h31.-2 ;
al w2 3 ; goto end program;
jl. h7. ;
jl. w3 h33. ; end;
e16: jl. h61. ; call and enter command segment;
e5: al. w1 b9. ; failure:
al. w3 h44. ; parent message
jd 1<11+16 ; (<:***fp init troubles:>);
jd 1<11+18 ;
jl. w3 h14. ; goto finis;
jl. e4. ; at start: goto connect in and out;
b0: 1<23 ;
b1: 0 ; file descriptor;
0 ;
b5: 0 ; first half of name;
0 ;
b6: 0 ; second half of name;
0, r.5 ; rest of tail;
b2: <:c:>,0,0,0 ;
b3: <:v:>,0,0,0 ;
b4: 0 ; zero used in set catbase
b7: <:***fp reinitialized<10><0>:>
b8: 0 ; first (boolean)
b9: 8<13+0<5 ; parent message
<:***fp init troubles :>
b. g1 ; begin
g1= (:h55+512-k:)/2 ; fill up segment to 512 bytes:
c. -g1 m.length error on fp segment 11
z.w. 0, r.g1 ; zero fill
e. ; end fill up;
c. h90-3 m.fp init, buf error: in
z. ;
c. h91-3 m.fp init, buf error:out
z. ;
m.fp init 05.06.73
i. ; maybe names
e. ; end init;
\f
\f
; rc 21.04.72 file processor, commands, page 1
; command assembly:
s. w.
b. k=h55, e48, j24 ; begin
w. 1024 ; length ; segment 11:
rl. w3 h41. ; save segment number of
hs. w3 j2. ; command reading segment;
al. w2 h55.+516 ; initialize char save area:
rs. w2 h55.+512 ; start:= slut:=
rs. w2 h55.+514 ; first of cycl buf;
e0: al. w2 h55.+534 ; state:=composite count:= 0;
rs. w2 e8. ; delimpointer:= first free;
dl. w0 e4. ; value pointer:=delim pointer+2;
ds w0 x2+0 ; delim word:= start command;
rl. w0 e3. ; comment: the stack begins with
rs. w0 (h9.) ; the bytes: 4,2, 2,2;
al w3 x2+2 ; last of commands:= end mark;
rs. w2 e10. ; init saved delimpointer;
jl. e25. ; goto input char;
e3: -4<12+0 ; end command mark
2<12+2 ; start command mark
e4: 2<12+2 ; nl-mark
e7: 0 ; value pointer
e8: 0 ; delim pointer
e5: 0, e6=e5+1 ; state, composite count
e10: 0 ; saved delim pointer
e9: 0, ; saved state, saved comp. count
e11: <:***fp cancel<0>:>; cancel text
e13: 0 ; common return
; procedure next char;
; reads the next non-blind character from current input.
; end of medium and non-text characters cause unstacking
; of input (possibly with an error message) and reading
; continues from the old current input.
; registers call return
; w0 destroyed
; w1 character class
; w2 character value
; w3 link link
e20: rs. w3 e13. ; begin
jl. w3 h25.-2 ; next char:
se w2 0 ; if char = 0
sn w2 127 ; or char = 127 then
jl. j1. ; bypass char saving;
rl. w3 h55.+512 ; save char in cycl buf:
hs w2 x3 ; buf(pointer):=char;
al w3 x3+1 ; pointer:=pointer+1;
sh. w3 h55.+529 ; if pointer>last of buf
jl. e12. ; then begin
rs. w3 h55.+514 ; start:=irrelevant;
al. w3 h55.+516 ; pointer:=first of buf;
e12: rs. w3 h55.+512 ; end;
\f
; rc 17.08.72 file processor, commands, page 1a
j1:
bz. w1 x2+e47. ; char:=inchar(cur in);
sl w2 128 ; class:=table(char,3);
jl. e45. ; if char>127 then goto off;
la. w1 e28. ; if class=12 then begin
al. w3 e20.+2 ; eom: unstack(cur in,cur chain);
sn w1 12 ; goto next char; end;
jl. w0 h30.-4 ; if class=9 then
sn w1 9 ; blind char:
jl. e20.+2 ; goto next char;
sn w1 14 ; if class=14 then
jl. e19. ; goto cancel;
jl. (e13.) ; end next char;
; input character:
e25: rs. w3 e7. ; input char: save value pointer;
e26: jl. w3 e20. ; get char: char,class:=next char;
dl. w0 e5. ; if savestack then begin
e17=k+1, sn w1 x1 ; save (delim pointer,
ds. w0 e9. ; state, composite count);
hs. w2 e17. ; savestack:=false; end;
se w1 10 ; if class=skip space
sn w1 11 ; or class=skip line
jl. e21. ; then goto skip;
sl w1 8 ; if class>7 then
jl. e22. ; goto syntax;
\f
; rc 1.7.69 file processor, commands, page 2
e23: ba. w1 e5. ; get action and state:
bz. w0 x1+e47. ; lookup in state table:
ld w1 -8 ; index:=8*state+class;
ls w0 3 ; action:=table(index,2);
hs. w0 e5. ; state:=table(index,1);
ls w1 -20 ; w0=action addr
bl. w0 x1+e48. ; w1=action number (0 to 15)
rl. w3 e7. ; w2=character value
am (0) ; w3=value pointer
e24: jl. e24. ; enter action (w0);
e21: hs. w1 e14. ; skip: save class;
jl. w3 e20. ; new: char,class:=next char;
e28: sn w1 15 ;used ; if alarm then
jl. e22. ; goto syntax;
se w1 7 ; if not new line then
jl. e21.+2 ; goto new;
al w0 0 ; savestack:=true;
hs. w0 e17. ; causes saving at next char;
am -4 ; class:=saved class-4;
e14=k+1 ; saved class ; comment: transforms
al w1 10 ; <,> to <sp>, and <;> to <nl>;
jl. e23. ; goto get action and state;
; the action numbers are chosen so that the separator value
; can be computed from the action: sep:=(action number)//2*2-6.
e30=e26 ; empty: goto get char;
e31: ld w1 -65 ; init name:
ds w1 x3+2 ; words(value pointer) to:
ds w1 x3+6 ; (value pointer+6):=0;
al w1 10 ; increase:=10;
hs w1 x3-1 ; count:=121;
al w1 121 ; goto test count;
jl. j0. ;
e35: al w1 121 ; pack name:
al w1 x1-11 ; count:=count-11;
j0: hs. w1 e35.+1 ; test count:
sh w1 0 ; if count <= 0 then
jl. e22. ; goto syntax;
sz w1 16 ; word(value pointer):=
ls w2 8 ; word(value pointer) +
sz w1 28 ; character value shift
ls w2 8 ; (count mod 33/11*8);
lo w2 x3+0 ; if count mod 33=0
rs w2 x3+0 ; then value pointer:=
sz w1 28 ; value pointer+2;
jl. e25. ; goto input char;
al w3 x3+2 ;
jl. e25. ;
e33: al w0 0 ; init integer:
al w1 4 ; word(value pointer):=0;
rs w0 x3+0 ; increase:=4;
hs w1 x3-1 ;
\f
; rc 21.04.72 file processor, commands, page 3
e37: al w2 x2-48 ; pack integer:
al w1 10 ; char:=char-iso digit base;
wm w1 x3+0 ; word (value pointer):=
wa w1 4 ; 10*word (value pointer) + char;
se w0 0 ; if too big then goto syntax;
jl. e22. ; goto input char;
rs w1 x3+0 ;
jl. e25. ;
e36: am +2 ; increase: change:= +1; or:
e34: al w0 -1 ; decrease: change:= -1;
ba. w0 e6. ; composite count:=
hs. w0 e6. ; composite count+change;
sh w0 -1 ; if composite count<0
jl. e22. ; then goto syntax;
jl. e44. ; goto set delimeter;
e40: am e31-e33 ; space name: place to go:= init name;
e41: am e33-e25 ; space int: place to go:= init integer;
e39: e42: ;
e44: al. w3 e25.+0 ; set delimeter:
e46: rs. w3 e13. ; set equal: set dot:
ls w1 -1 ; place to go:= input char; if not mod.
al w0 x1-3 ; separator value:=
ls w0 13 ; (action number)//2*2-6;
rl. w1 e8. ; delim pointer:=
ba w1 x1+1 ; delim pointer+increase;
rs. w1 e8. ; value pointer:=delim pointer+2;
al w3 x1+2 ; delim word:=separator shift 12 + 2;
hl. w0 -1 ; if room enough then
rs w0 x1+0 ; goto place to go;
sh. w3 (h8.) ; stack overflow:
jl. (e13.) ; goto stack overflow;
jl. e18. ;
e32: dl. w0 e5. ; save stack:
ds. w0 e9. ; save current status of the stack;
jl. e26. ; goto get char;
e38: dl. w0 e5. ; test end:
ba w3 x3+1 ; update delim pointer;
ds. w0 e9. ; save stack status;
sz w0 2047 ; place to go:= if composite count <> 0
jl. e44. ; then input char else
jl. w3 e46. ; end of commands; goto set delimeter;
e29: rl. w2 h8. ; end of commands:
al w3 x3-2 ; for addr:=value pointer-2
rl w0 x3+0 ; step -2 until first free do begin
al w2 x2-2 ; cur comm:=cur comm-2;
rs w0 x2+0 ; word(cur comm):=word(addr);
se. w3 h55.+532 ; end;
jl. e29.+2 ;
al w1 -1-1<7 ; oldmode:= fp mode bits;
la. w1 h51. ; fp mode bits:= fp mode bits remove if;
rx. w1 h51. ; comment: clear if bit;
sz w1 1<7 ; if oldmode (if bit) = 1 then
jl. h61. ; call and enter read commands;
rs. w2 h8. ; goto program load segment;
jl. h62. ;
\f
; rc 08.04.72 file processor, commands, page 4
; error handling:
e22: ; syntax:
e43: ; new line error
e45: am 1 ; error
e18: al w0 0 ; stack overflow
j2=k+1
al w3 1 ; goto command reading
al w3 x3+1 ; error segment;
jl. h70.+2 ;
e19: al. w0 e11. ; cancel: text:=cancel;
jl. w3 h31.-2 ; outtext (cur out,
jl. w3 h39. ; <:***fp <text>:>);
dl. w3 e9. ; outend(new line);
rs. w3 e5. ; restore state: comp.count:=
al w1 x2+2 ; state:= delim pointer:= saved values;
ds. w2 e8. ; value pointer:=delim pointer+2;
al w0 0 ; increase.delimp:= 0;
hs w0 x2+1 ;
al w1 7 ; simulate input of a
al w2 10 ; new line character
jl. e26.+2 ; goto got char; (+2);
; survey of classes, states, and actions
; value char state action
; 0 letter before command empty action.
; 1 digit in file name init name
; 2 left ( after = save stack
; 3 right ) in program name init integer
; 4 equal = after <s> decrease
; 5 dot . in param name pack name
; 6 spaces in param integer increase
; 7 new lines after dot pack integer
; 8 illegal after command test end
; 9 blind file name <s>
; 10 skip <,> parameter <s> space name
; 11 skip <;> after right ) space integer
; 12 end medium set equal
; 13 new line error
; 14 cancel set dot
; 15 alarm error error
; class values greater than 7 are handled at microsyntactical
; level, thus eliminating the need for a 256 bytes state table.
; most actions are composite and follows each other in rather
; complicated manners.
; init name => init, pack name
; init integer => init, pack integer
; increase => count, set separator
; space name => separator, init, pack name
; space integer => separator, init, pack integer
\f
; rc 05.04.72 file processor, commands, page 5
; state 0: before command
e47: ; start of tables
h. 1<8+ 1<4+ 9 ; l. file, init name nul
15<8+15<4+ 9 ; d. error, error soh
0<8+ 6<4+ 9 ; ( b.comm, increase stx
11<8+ 4<4+ 9 ; ) after ), decrease etx
15<8+15<4+ 9 ; = error, error eot
15<8+15<4+ 9 ; . error, error enq
0<8+ 0<4+ 9 ; <s> b.comm, empty ack
0<8+ 2<4+ 9 ; <nl> b.comm, save stack bel
; state 1: in file name
h. 1<8+ 5<4+15 ; l. file, pack name bs
1<8+ 5<4+ 6 ; d. file, pack name ht
15<8+15<4+ 7 ; ( error, error nl
8<8+ 4<4+ 7 ; ) a.comm, decrease vt
2<8+12<4+ 7 ; = equal, set equal ff
15<8+15<4+ 9 ; . error, error cr
9<8+ 0<4+15 ; <s> after sp1, empty so
0<8+ 8<4+ 9 ; <nl> b.comm, test end si
; state 2: after =
h. 3<8+ 1<4+ 9 ; l. program, init name dle
15<8+15<4+ 9 ; d. error, error dc1
15<8+15<4+ 9 ; ( error, error dc2
15<8+15<4+ 9 ; ) error, error dc3
15<8+15<4+ 9 ; = error, error dc4
15<8+15<4+ 9 ; . error, error nak
2<8+ 0<4+ 9 ; <s> after =, empty syn
15<8+13<4+ 9 ; <nl> error, nl error etb
; state 3: in program name
h. 3<8+ 5<4+14 ; l. program, pack name can
3<8+ 5<4+12 ; d. program, pack name eom
15<8+15<4+15 ; ( error, error sub
8<8+ 4<4+15 ; ) a.comm, decrease esc
15<8+15<4+ 9 ; = error, error fs
15<8+15<4+ 9 ; . error, error gs
4<8+ 0<4+ 9 ; <s> after sp, empty rs
0<8+ 8<4+ 9 ; <nl> b.comm, test end us
; state 4: after sp
h. 5<8+10<4+ 6 ; l. param name,sp name sp
6<8+11<4+ 8 ; d. param int, sp integer !
15<8+15<4+ 8 ; ( error, error quo
8<8+ 4<4+ 8 ; ) a.comm, decrease ste
15<8+15<4+ 8 ; = error, error dol
15<8+15<4+ 8 ; . after dot, set dot
4<8+ 0<4+ 8 ; <s> after sp, empty &
0<8+ 8<4+ 8 ; <nl> b.comm, test end '
; state 5: in param name
h. 5<8+ 5<4+ 2 ; l. param name,pack name (
5<8+ 5<4+ 3 ; d. param name,pack name )
15<8+15<4+11 ; ( error, error *
8<8+ 4<4+ 8 ; ) a.comm, decrease +
15<8+15<4+10 ; = error, error ,
7<8+14<4+ 8 ; . after dot, set dot -
10<8+ 0<4+ 5 ; <s> after sp2, empty .
0<8+ 8<4+ 5 ; <nl> b.comm, test end /
\f
; rc 1.7.69 file processor, commands, page 6
; state 6: in param integer
h. 15<8+15<4+ 1 ; l. error, error 0
6<8+ 7<4+ 1 ; d. param int, pack integer 1
15<8+15<4+ 1 ; ( error, error 2
8<8+ 4<4+ 1 ; ) a.comm, decrease 3
15<8+15<4+ 1 ; = error, error 4
7<8+14<4+ 1 ; . after dot, set dot 5
10<8+ 0<4+ 1 ; <s> after sp2, empty 6
0<8+ 8<4+ 1 ; <nl> b.comm, test end 7
; state 7: after dot
h. 5<8+ 1<4+ 1 ; l. param name,init name 8
6<8+ 3<4+ 1 ; d. param int, init integer 9
15<8+15<4+ 8 ; ( error, error :
15<8+15<4+11 ; ) error, error ;
15<8+15<4+ 8 ; = error, error <
15<8+15<4+ 4 ; . error, error =
7<8+ 0<4+ 8 ; <s> after dot, empty >
15<8+13<4+14 ; <nl> error, nl error
; state 8: after command
h. 15<8+15<4+ 8 ; l. error, error cat
15<8+15<4+ 8 ; d. error, error a
15<8+15<4+ 8 ; ( error, error b
8<8+ 4<4+ 8 ; ) a.comm, decrease c
15<8+15<4+ 8 ; = error, error d
15<8+15<4+ 8 ; . error, error e
8<8+ 0<4+ 8 ; <s> a.comm, empty f
0<8+ 8<4+ 8 ; <nl> b.comm, test end g
; aux state 9: after space (following file name)
h. 5<8+10<4+ 8 ; l. param name,sp name h
6<8+11<4+ 8 ; d. param int, sp integer i
15<8+15<4+ 8 ; ( error, error j
8<8+ 4<4+ 8 ; ) a.comm, decrease k
2<8+12<4+ 8 ; = after =, set equal l
15<8+15<4+ 8 ; . error, error m
9<8+ 0<4+ 8 ; <s> after sp1, empty n
0<8+ 8<4+ 8 ; <nl> b.comm, test end o
; aux state 10: after space (following parameter)
h. 5<8+10<4+ 8 ; l. param name,sp name p
6<8+11<4+ 8 ; d. param int, sp integer q
15<8+15<4+ 8 ; ( error, error r
8<8+ 4<4+ 8 ; ) a.comm, decrease s
15<8+15<4+ 8 ; = error, error t
7<8+14<4+ 8 ; . after dot, set dot u
10<8+ 0<4+ 8 ; <s> after sp2, empty v
0<8+ 8<4+ 8 ; <nl> b.comm, test end w
; aux state 11: after right )
h. 15<8+15<4+ 8 ; l. error, error x
15<8+15<4+ 8 ; d. error, error y
15<8+15<4+ 8 ; ( error, error z
11<8+ 4<4+ 8 ; ) after ), decrease æ
15<8+15<4+ 8 ; = error, error ø
15<8+15<4+ 8 ; . error, error å
11<8+ 0<4+ 8 ; <s> after ), empty cir
0<8+ 8<4+ 9 ; <nl> b.comm, test end _
\f
; rc 05.04.72 file processor, commands, page 7
; aux state 12: not used
h. 8 ; acc
0 ; a
0 ; b
0 ; c
0 ; d
0 ; e
0 ; f
0 ; g
; aux state 13: not used
h. 0 ; h
0 ; i
0 ; j
0 ; k
0 ; l
0 ; m
0 ; n
0 ; o
; aux state 14: not used
h. 0 ; p
0 ; q
0 ; r
0 ; s
0 ; t
0 ; u
0 ; v
0 ; w
; aux state 15: syntax error
h. 0 ; x
0 ; y
0 ; z
0 ; æ
0 ; ø
0 ; å
8 ; ovl
9 ; del
; action table, containing addresses relative to e24
e48: e30-e24 ; * empty
e31-e24 ; * init name
e32-e24 ; * save stack
e33-e24 ; * init integer
e34-e24 ; -2 decrease
e35-e24 ; * pack name
e36-e24 ; 0 increase
e37-e24 ; * pack integer
e38-e24 ; 2 test end
e39-e24 ; *
e40-e24 ; 4 space name
e41-e24 ; * space integer
e42-e24 ; 6 set equal
e43-e24 ; * new line error
e44-e24 ; 8 set dot
e45-e24 ; * error
b. g1 ; begin
w.g1=(:h55+512-k:)/2 ; fill segment to 512 bytes;
c. -g1 m.length error on commands part 1
z.w. 0, r.g1 e. ; zero fill; end fill up;
i.e. ;
\f
; rc 01.03.73 file processor, commands, page 8
;this second part of the command reading contains the error
;handling (syntax and stack overflow). it is entered from the
;command reading via the generel swopping machinery with the last
;few characters read from current in in the cyclic buffer
;just after the segment. the content of c4 (w0 at exit from command
;reading) determines whether the error is syntax or stack.
;the error handling first reselects primary output as current
;output. then the first part of the error text consisting of
;a heading (*** etc..) and the characters in the cycl buf is
;output. next the current input file is unstacked down to pri-
;mary input. during unstacking the document names of the input
;files are output. when unstacking is finished the current input
;and output files are terminated and the initialization of fp is
;entered (in order to abandon the command stack etc..)
b. k=h55, e48, w. ; begin second part of commands
0 ; dummy word, not used;
rl. w0 c4. ; start:
rs. w0 e0. ; save cause (syntax or stack);
jl. e1. ; goto reselect curr out;
e20: <:c:>,0,0,0 ; name of primary output
e21: 1<23 ; area for create(c)
e22: 0,r.9 ;
e23: <:***fp stack<32><0>:> ; error texts:
e24: <:***fp syntax<32><0>:> ;
e25: <:<10> *selected from<32><0>:> ;
e26: <:primary input<0>:> ;
e0: 0 ; cause
e27: <:<10> *read from<32><0>:>
e30: <:<10>***fp job termination<10><0>:>
e1: al. w1 h21. ; reselect curr out:
bz w3 x1+h1+1 ; char:=
se w3 4 ; if kind(curr out) = bs
sn w3 18 ; or kind(curr out) = mt
am 25 ; then em
al w2 0 ; else null;
jl. w3 h34. ; close up(curr out,char);
jl. w3 h79. ; terminate curr out;
rl. w2 h15. ; find c:
rl w0 x2 ;
sl w0 20 ; try create c: kind:=kind(prim out);
al w0 8 ; if kind > 18 then kind :=tw;
al. w1 e21. ; tail(0) := 1<23+kind;
hs w0 x1+1 ;
dl w0 x2+4 ;
ds w0 x1+4 ;
dl w0 x2+8 ;
ds w0 x1+8 ; tail(2:8):=name(prim out);
al. w3 e20. ; create entry (c);
e11: jd 1<11+40 ;
se w0 3 ; if not allready exists
jl. e8. ; then goto check created
al. w1 h54. ; c exists allready:
jd 1<11+42 ; lookup entry(c);
se w0 0 ; if not found
jl. h67. ; then break;
\f
; rc 21.04.72 file processor, commands, page 9
dl. w3 e21.+4 ; compare proc names:
sn w2 (x1+2) ; if name(found c)
se w3 (x1+4) ; < >
jl. e12. ; name(primt out proc)
dl. w3 e21.+8 ; then goto remove c;
sn w2 (x1+6) ;
se w3 (x1+8) ;
jl. e12. ;
jl. e2. ; goto connect c;
e12: al. w3 e20. ; remove c:
jd 1<11+48 ; remove entry(c);
se w0 0 ; if not ok
jl. h67. ; then break
al. w1 e21. ;
jl. e11. ; goto create c;
e8: se w0 0 ; check created: if not created
jl. h67. ; then break;
e2: al. w2 e20. ; connect(curr out,c);
al w0 1<1+1 ;
jl. w3 h28.-2 ;
se w0 0 ; if not ok
jl. h67. ; then break;
am. (e0.) ; error text heading:
se w3 x3 ; text:=if cause <> 0
am e24-e23 ; then <:***fp syntax:>
al. w0 e23. ; else <:***fp stack:>
jl. w3 h31.-2 ; outtext(curr out,text);
rl. w0 h55.+514 ; write last input chars:
se. w0 h55.+516 ; pointer:=if start relevant
rl. w0 h55.+512 ; then start else char pointer;
e3: bz w2 (0) ; next char: w2:=char value;
sn w2 32 ; if char = space
jl. e4. ; then write char;
sh w2 39 ; if 40 <= value <= 62
jl. e7. ; or 97 <= value <= 125
sh w2 62 ; then goto write char
jl. e4. ; else goto write value;
sh w2 125 ;
sh w2 96 ;
jl. e7. ;
e4: jl. w3 h26.-2 ; write char: outchar(curr out,char);
e5: am (0) ; increase pointer: pointer :=
al w0 1 ; pointer+1;
sl. w0 h55.+530 ; if pointer > last of buf
al. w0 h55.+516 ; then pointer := first of buf;
sn. w0 (h55.+512) ; if pointer = slut
jl. e28. ; then goto unstack in else
jl. e3. ; goto next char;
e6: 0 ; saved pointer;
e7: rs. w0 e6. ; write value: save pointer;
al w2 60 ;
jl. w3 h26.-2 ; outchar(<);
bl. w0 (e6.) ;
jl. w3 h32.-2 ; outinteger(value);
1<23+0<12+1 ;
al w2 62 ;
jl. w3 h26.-2 ; outchar(>);
rl. w0 e6. ; restore pointer;
jl. e5. ; goto increase pointer;
\f
; rc 01.03.73 file processor, commands, page 10
; unstack in:
e28: am e27-e25 ; first time: text:=<:read from:>;
e9: al. w0 e25. ; output doc.name:
jl. w3 h31.-2 ; outtext(curr out,<:*selected from :>);
am. (h50.) ;
sn w3 x3 ; if curr in name chain = 0
jl. e10. ; then goto chain end;
al. w0 h20.+h1+2 ;
jl. w3 h31.-2 ; outtext(curr out,doc.name(in));
jl. w3 h30.-4 ; unstack curr in;
jl. e9. ; goto output doc name;
e10: al. w0 e26. ; chain end:
jl. w3 h31.-2 ; outtext(curr out,<:primary input:>);
al w2 1 ; syntax count:
wa. w2 h96. ; count:=count+1;
rs. w2 h96. ;
sl w2 10 ; if count >= 10 then
jl. e29. ; goto termination;
jl. w3 h39. ; outend(nl);
jl. w3 h95. ; close up;
jl. w3 h79.-2 ; terminate curr in and curr out;
jl. w3 h79.-4 ;
jl. h60. ; goto init fp;
e29: al. w0 e30. ; terminate:
jl. w3 h31.-2 ; output error text;
jl. w3 h39. ; close up curr out;
jl. w3 h95. ;
jl. w3 h79.-2 ; terminate curr in
jl. w3 h79.-4 ; and curr out;
jl. h14. ; goto finis;
b. g1 w. ; fill segment to 512 bytes
g1=(:h55+512-k:)/2
c. -g1 m.length error on commands part 2
z. w. 0,r.g1 e. ; fill up
i.e. ; end commands part 2
m.fp commands 26.03.73
i.e. ; end commands;
\f
\f
; rc 12.07.79 file processor, load, page 1
; interpretation of commands; program loading
s. k=h55, e48 ; begin
w. 512 ; length ; segment 12:
al w0 1 ; give up mask.cur in:= 1;
al. w1 h68. ; give up mask.prog.cur out:= 0;
ds. w1 h93. ;
al w0 0 ; give up action.in.out.prog:=fp stderror;
ds. w1 h92. ;
ds. w1 h94. ;
e0: rl. w2 h8. ; upspace to next command:
ba w2 x2+1 ; cur comm:= param pointer:=
bl w0 x2+0 ; cur comm + item size;
rs. w2 h8. ; separator:= first byte.item;
rs. w2 e8. ; if separator= -4
sn w0 -4 ; then goto read commands;
jl. h61. ; if separator <> 2 (nl)
sz w0 -3 ; or <> 0 then goto
jl. e0.+2 ; upspace to next command;
e1: am. (e8.) ; find program name:
bz w2 +1 ; updated param pointer:=
wa. w2 e8. ; param pointer + size.param;
bl w3 x2+0 ; e8:= updated pointer;
rs. w2 h8. ; h8:= pointer;
rx. w2 e8. ; if end of commands in stack
sn w3 -4 ; then goto read commands;
jl. h61. ; w0:= separator.param;
bl w0 x2+0 ; w1:= kind.param;
bz w1 x2+1 ; w3:= next sep.param;
se w1 10 ; if kind.param <> 10 (i e name)
jl. e1. ; then goto find program name;
ds. w1 e33. ; save params for first name;
rs. w2 h8. ; h8:= current param pointer;
sn w3 6 ; if next sep = <equal>
al w2 x2+10 ; then upspace to next param;
rs. w2 c12. ; w3 at entry:=current param;
rs. w2 e12. ; addr of prog name param
\f
; rc 12.07.79 file processor, load, page 1a
al. w1 e4. ; test content of entry:
al w3 x2+2 ; lookup entry(program name, own filedescr.);
jd 1<11+42 ;
se w0 0 ; if unknown then
jl. e44. ; goto connect trouble;
bz. w3 e5. ; load content;
se w3 15 ; if content<>15 then
jl. e2. ; goto test content and load;
bz. w3 e6. ; load through sysldr:
sl w3 1000 ; if loaderno>999 then
jl. e47. ; goto call trouble;
al w1 -8 ; convert loaderno to text:
e11: al w1 x1+8 ; repeat
al w2 0 ; counter:=counter+8;
wd. w3 e10. ; w2:=loaderno mod 10;
al w2 x2+48 ; loaderno:=loaderno//10;
ls w2 x1 ; w2:=w2+48;
wa w0 4 ; w2:=w2 shift counter;
se w1 16 ; w0:=w0 add x2;
jl. e11. ; until counter=0;
rs. w0 e13. ; e13:=loaderno as text;
al. w2 e12. ; base for loader name
rs. w2 e12. ; used by connect trouble and size trouble
al. w1 e4. ; test content of loader entry:
al w3 x2+2 ;
jd 1<11+42 ; lookup_entry(loader name, own file descr);
se w0 0 ; if unknown then
jl. e44. ; goto connect trouble;
bz. w3 e5. ; load content;
\f
; rc 12.07.79 file processor, load, page 1b
; test content and load:
e2: se w3 2 ; if content<>2 and
sn w3 8 ; content <> 8
jl. 4 ; then
jl. e47. ; goto call trouble;
al w2 x2+2 ; file name pointer:= param pointer+2;
al. w1 h19. ; connect input (file name pointer,
jl. w3 h27. ; program zone,result);
se w0 0 ; if result <> 0 then
jl. e44. ; goto connect trouble;
bz. w0 e6. ; test size:
rl. w1 e7. ; if entry>=length
rs. w0 h19.+h3+6 ; or length<=0
sh w0 x1-1 ; then goto size trouble;
sh w1 0 ;
jl. e46. ; entry.pzone:= entry;
rl. w3 e4. ;
bz. w0 e9. ; if mode.kind >= 0
sl w3 0 ;
jl. 6 ; or
se w0 4 ; kind = 4
jl. e3. ;
al w1 x1+511 ; then
ls w1 -9 ; length:= (length+511)//512*512;
ls w1 +9 ;
\f
; rc 12.07.79 file processor, load, page 2
e3: rs. w1 h19.+h3+4 ; test room:
ac. w3 h55.+0 ; top length:= cur command pointer
wa. w3 h8. ; - base of transient;
sl w1 x3 ; if length>=top length
jl. e46. ; then goto size trouble;
al w1 x1-1 ; increment:= (length-1)//2*2;
ls w1 -1 ; adjust share:
ls w1 +1 ; first shared:= first address:=
al. w0 h55. ; base of transient;
al. w1 x1+h55. ; last addr:= first addr+increment;
ds. w1 h80.+10 ; last shared:= cur command pointer-2;
rl. w1 h8. ; set dump range:
al w1 x1-2 ; base.prog:= first addr.proc-1;
ds. w1 h80.+4 ; last.prog:= top addr.proc-1;
rl. w3 h16. ;
dl w2 x3+24 ; if list mode
al w1 x1-1 ; then list cur command;
al w2 x2-1 ;
ds. w2 h19.+h0+2 ; floating precision:= long;
rl. w3 h51. ;
sz w3 1<0 ; zone:= program zone;
jl. w3 e26. ; goto load and enter;
al. w1 h19. ;
xl. 0 ;
jl. h18. ;
e8: 0 ; ; current parameter pointer
e10: 10 ; ; constant 10
e31: 0 ; ; count
e32: 1 ; ; sep
e33: 1 ; ; kind
e34: 0 ; ; saved param pointer
e35: 0 ; w2 ; saved w2
e36: 0 ; w3 ; saved w3
e26: ds. w3 e36. ; list cur command:
dl. w1 e33. ; save (w2,w3);
rl. w2 h8. ; restore params for first name;
al w3 0 ; count:= 0;
rs. w3 e31. ;
e27: ds. w2 e34. ; print param:
sh w0 3 ;
al w2 42 ; char:= case separator of
sn w0 4 ; (<4: asterisk,
al w2 32 ; 4: space ,
sn w0 6 ; 6: equal ,
al w2 61 ; 8: dot );
sn w0 8 ;
al w2 46 ; if char=space
rl. w1 e31. ; and count>10
al w1 x1+1 ; then begin
rs. w1 e31. ; outtext (cur out,<:,<10> :>);
sn w2 32 ; count:= 0;
sh w1 10 ; end;
jl. e28. ; count:= count+1;
\f
; rc 12.07.79 file processor, load, page 3
al w1 0 ;
rs. w1 e31. ; outchar (cur out, char);
al. w0 e37. ;
jl. w3 h31.-2 ; if kind.param=10
e28: jl. w3 h26.-2 ; then
dl. w2 e34. ; outtext (cur out,param name)
al. w3 e29. ; else
al w0 x2+2 ; outinteger (cur out,
sn w1 10 ; <<d>,param integer);
jl. h31.-2 ;
rl w0 x2+2 ;
jl. w3 h32.-2 ;
0<23 + 32<12 + 1 ;
e29: dl. w2 e34. ; take next param:
wa w2 2 ; param pointer:= pointer+size;
bl w0 x2+0 ; separator:= new separator;
bz w1 x2+1 ; kind:= new kind;
sl w0 4 ; if separator > 3 then
jl. e27. ; goto print param;
jl. w3 h39. ;
dl. w3 e36. ; outend (cur out,new line);
jl x3 ; return;
e37: <:,<10> :> ; end list;
e38: <:***fp name<32><0>:> ; not found in catalog
e39: <:***fp connect<32><0>:> ; io trouble during connection
e40: <:***fp size<32><0>:> ; program to big
e41: <:***fp call<32><0>:> ; call convention error
e44: sn w0 3 ; connect trouble:
am e38-e39 ; text:= if result <> 3 then <name>
am e39-e40 ; else <connect>
e46: am e40-e41 ; size trouble: or <size>
e47: al. w0 e41. ; call trouble: or <call>;
jl. w3 h31.-2 ; outtext (cur out, text);
rl. w3 e12. ; outtext(curr out,prog.name);
al w0 x3+2 ;
jl. w3 h31.-2 ;
jl. w3 h39. ; outend (cur out, new line);
al w2 3 ; warning:=true; ok:= false;
jl. h7. ; goto end program;
e4: 0 ; own filedescriptor: mode.kind
e9=e4+1 ; mode
0,r.7
e5: 0 ; content
e6=e5+1 ; entry
e7: 0 ; length
e12: 0 ; base of loader name or prog name param
<:sysldr:> ; space for loader name
0,r.2 ; space for number part of loader name
e13=e12+6 ; address of number part of loader name
b. g1 ; begin
g1= (:h55+512-k:)/2 ; fill up segment to 512 bytes;
c. -g1 m.length error on fp segment 13
z.w. 0, r.g1 ; zero fill
e. ; end fill up;
m.fp program load 12.07.79
i. ; maybe names
e. ; end load;
\f
; rc 09.03.73 file processor, end program, page 1
;this segment is entered when a utility program terminates by
;entering end program entry h7. the function is to stop the
;current out zone, to set the ok bit and to remove su-
;perfluos area processes and messages buffers.
;the segment calls either the load program segment, the device
;status segment or the break action.
;if load program is entered the current in zone will before be
;unstacked to the first i-bit.
;if device status is entered the current zone is unstacked to
;the i-bit unless there is hard error on the stacked curr in
;zone.
;in case of hard error on current out or on a curr in zone
;with i-bit the current out zone is connected to primary out.
;if this is impossible the break action is entered.
s. k=h55, a8, e7, f7
w.
512
al w0 0 ; entry:
al. w3 h10. ; set interrupt;
jd 1<11+0 ;
al. w3 h68. ; restore give up action in:
al w2 0 ;
rs. w3 h19.+h2+2 ; program zone;
rs. w3 h20.+h2+2 ; curr in zone;
ds. w3 h21.+h2+2 ; curr out zone; g.up.mask(out):=0;
dl. w2 c20. ; set mode bits:
rs. w2 e7. ; save status word;
al w0 -1-1<6-1<5 ; w0:=mode bits -
la. w0 h51. ; (ok and warning);
al w3 2.11 ;
la w3 4 ;
bz. w3 x3+e6. ; w3:=table(w2.exit);
sz w2 -4 ; if device errors then
al w3 1<6 ; w3:=warn yes and ok no;
lo w0 6 ; mode bits := w0 or w3;
rs. w0 h51. ;
sz w2 -4 ; determine action:
jl. e1. ; if no device errors
al. w3 f1. ; get action and
jl. e5. ; goto start on actions;
e1: se. w1 c31. ; if hard error on curr out
jl. e2. ; then get actions
al. w3 f2. ;
jl. e5. ; and goto start on actions;
e7: 0 ; saved status word
;mode bit table:
h. ; warning: ok:
e6: 0<6+1<5 ; no yes
0<6+0<5 ; no no
1<6+1<5 ; yes yes
1<6+0<5 ; yes no
w.
\f
; rc 16.04.72 file processor, end program, page 2
e2: se. w1 h20.+h1+2 ; if hard error curr in zone
jl. e3. ; then
rl. w0 h20.+h2+0 ;
al. w3 f3. ; get action(i-bit)
sz w0 2.1 ;
al. w3 f4. ;
jl. e5. ; and goto start on actions;
e3: al. w3 f5. ; other zone error:
jl. e5. ; get actions and goto actions;
e0: 0 ; action table pointer;
;central call of next action:
e4: rl. w3 e0. ; next action entry:
al w3 x3+1 ; pointer:=pointer+1;
e5: rs. w3 e0. ; start actions entry: save pointer;
bl w3 x3 ; action:=table(pointer);
a0: jl. x3+a0. ; goto action;
;outend and wait current out:
a1: jl. w3 h59. ; outend(curr out,nl);
jl. w3 h89. ; check all(curr out);
jl. a7. ; goto free the share;
;unstack curr in to i-bit:
a2: rl. w0 h20.+h2+0 ; start: if bit 0 in give up
sz w0 2.1 ; is <> 0 then
jl. e4. ; goto next action else
jl. w3 h30.-4 ; unstack curr in and
jl. a2. ; goto start;
;close up and terminate curr out
a3: al. w1 h21. ; char:=
bz w3 x1+h1+1 ; if kind(curr out) = bs
se w3 4 ; or kind(curr out) = mt
sn w3 18 ; then em
am 15 ; else nl;
al w2 10 ;
jl. w3 h34. ; terminate curr out;
jl. w3 h79. ; terminate zone;
jl. e4. ; goto next action;
\f
; rc 19.02.73 file processor, end program, page 3
;connect current out to primary out:
b. d10 w.
d1: 0 ; area for lookup entry:
0 ;
d2: 0 ; name first doubleword
0 ;
d3: 0 ; name second doubleword
0,r.5 ; rest of tail;
d4: <:c:>,0,0,0 ; name of primary output;
d0: 1<23
a4: rl. w2 h15. ; start: create c:
rl w0 x2 ; kind:=kind(prim out process);
sl w0 20 ; if kind > 18
al w0 8 ; then kind = tw;
wa. w0 d0. ;
al. w1 d1. ;
rs w0 x1 ; tail(0):=1<23+kind;
dl w0 x2+4 ;
ds w0 x1+4 ; tail(2:8) := name(prim out);
dl w0 x2+8 ;
ds w0 x1+8 ;
al. w3 d4. ;
d5: jd 1<11+40 ; create entry(c);
se w0 3 ; if not allready exists
jl. d7. ; then goto check created;
al. w1 h54. ; c exists allready:
jd 1<11+42 ; lookup entry(c);
se w0 0 ; if not found
jl. d9. ; then goto give up;
dl. w3 d2. ; compare proc names:
sn w2 (x1+2) ;
se w3 (x1+4) ; if name cat entry (c)
jl. d6. ; < > name (prim out process)
dl. w3 d3. ; then goto remove c;
sn w2 (x1+6) ;
se w3 (x1+8) ;
jl. d6. ; else goto connect;
jl. d8. ;
d6: al. w3 d4. ; remove c:
jd 1<11+48 ; remove entry(c);
al. w1 d1. ;
jl. d5. ; goto create (c);
d9: al. w1 d10. ; give up:
al. w3 h44. ;
jd 1<11+16 ; parent message:
jd 1<11+18 ; (<:***fp troubles with c:>);
jl. w3 h14. ; goto finis;
d10: 8<13+0<5
<:***fp troubles with c:>
\f
; rc 76.05.25 file processor, end program, page ...4...
d7: se w0 0 ; check created: if not created
jl. d9. ; then give up;
d8: al w0 1<1+1 ; connect c:
al. w2 d4. ;
jl. w3 h28.-2 ;
se w0 0 ; if not ok
jl. d9. ; then give up
; flg for at undgaa at cykle, naar forbindelse til primært
; output er afbrudt
al w3 x1+h1+2 ;
al. w1 d4.+2 ; w1:=sense
jd 1<11+16 ; send message
al. w1 d1. ;
jd 1<11+18 ; wait answer
se w0 1 ; if not ok then
jl. d9. ; goto give up
jl. e4. ; else goto next action;
e.
;remove area processes and message buffers:
b. d12 w.
d9: -1,r.8 ; dummy message to fp;
d10: 0 ; buf address;
d11: 0 ; rel. addr of bittable in areaproc
d12: 24 ;
a5:
rl w1 80 ; last internal
ws w1 78 ;
ls w1 -1 ; w1:=number of internals
al w1 x1+23 ;
al w0 0 ;
wd. w1 d12. ; w1:=size of bittable for userbits
ls w1 1 ;
ac w1 x1+4 ;
rs. w1 d11. ; d11:=rel. addr of bittable i areaproc
rl w1 76 ; start: remove area processes:
d1: rl w2 x1+0 ; for w2 through area in name table do
rl w3 66 ; w3:=cur;
ba w2 x3+12 ; w2:=w2+rel addr.curr
am. (d11.) ;
bz w0 x2 ; w0:=userbits.cur
bs w2 x3+12 ; reset w2
sz w0 (x3+12) ; if cur is user of area proc then
jl. d3. ; then goto maybe remove proc;
d2: al w1 x1+2 ;
se w1 (78) ;
jl. d1. ;
jl. d4. ; goto remove buffers;
d3: se. w1 (h20.+h1+10); maybe remove process:
sn. w1 (h21.+h1+10); if name tab addr(proc) <>
jl. d2. ; name tab(in) and name tab(out)
dl w0 x2+4 ; then begin
ds. w0 h43.+2 ; if proc name <> <:fp:>
sn. w3 (h40.) ; then
jl. d2. ; copy name into own core area
dl w0 x2+8 ;
ds. w0 h43.+6 ;
al. w3 h43. ; and remove process;
jd 1<11+64 ; end
jl. d2. ; return;
d4: al. w1 d9. ; remove buffers:
al. w3 h40. ; send dummy message to fp;
jd 1<11+16 ;
rs. w2 d10. ; save buffer address;
d5: al w2 0 ; first event: event:=first;
d6: jd 1<11+24 ; wait: wait event;
sn w2 0 ; if claims exceeded
jl. d7. ; then goto get clock buf;
\f
; rc 19.02.73 file processor, end program, page 5
sn w0 0 ; if event=message
jl. d6. ; then goto wait;
sn. w2 (h81.) ; if buf = sh.state(in) then
jl. d6. ; goto wait next;
jd 1<11+26 ; get event;
se. w2 (d10.) ; if buf <> clock buf
jl. d5. ; then goto first event;
jl. e4. ; goto next action;
d7: rl. w2 d10. ; get clock buf:
al. w1 d9. ;
jd 1<11+18 ; wait answer(clock buf);
jl. e4. ; goto next action;
e.
;free curr in - free cur out:
a6: am h20-h21 ; zone:=curr in
a7: al. w1 h21. ; zone:=curr out;
al w0 0 ;
rl w2 x1+h0+6 ;
rs w0 x2 ; share state := free;
rl w3 x2+4 ; last address :=
rs w3 x2+10 ; last shared;
jl. e4. ; goto next action;
;enter device status:
a8: rl. w1 e7. ; restore status word;
rs. w1 c20. ;
jl. h64. ; goto device status;
\f
; rc 19.02.73 file processor, end program, page 6
;table of sequences of actions:
;(each sequence consists of an even number of bytes)
h.
;no device errors:
f1: a1-a0,a2-a0,a5-a0,h62-a0
;hard error on current out:
f2: a7-a0,a4-a0,a2-a0,a5-a0,a8-a0,0
;hard error on stacked curr in zone:
f3: a1-a0,a6-a0,a5-a0,a8-a0
;hard error on curr in zone:
f4: a3-a0,a4-a0,a6-a0,a5-a0,a8-a0,0
;hard error on other zone:
f5: a1-a0,a2-a0,a5-a0,a8-a0
w.
;the actions are:
;
;a1 outend and free curr out
;a2 unstack curr in zone to i-bit
;a3 terminate cur out
;a4 connect primary output
;a5 remove area processes and message buffers
;a6 free curr in zone
;a7 free curr out zone
;h62 call and enter load program segment
;a8 call and enter device status segment
b. g1 ; fill up to 512 bytes:
g1=(:h55+512-k:)/2
c. -g1 m.length error on end program segment
z.w. 0,r.g1
e.
m.fp end program 07.03.73
i.e.
\f
; rc 12.04.72 file processor, device status, page 1
s. k=h55, e48 ; begin segment: device status;
w. ;
512 ; length of segment
al. w0 e7. ; device status:
jl. w3 h31.-2 ; writetext(out,<:***device status:>);
al. w0 h10.+2 ;
jl. w3 h31.-2 ; writetext(out,doc name);
al w2 0 ;
e6: rl. w1 c20. ; for bit := 0 step 1 until 21 do
ls w1 x2 ; begin
al. w0 e10. ;
ba. w0 x2+e5. ;
sh w1 -1 ; text := device status text(bit);
jl. w3 h31.-2 ; if bit = 1 then
al w2 x2+1 ; writetext(out,text);
se w2 22 ;
jl. e6. ; end;
jl. w3 h39. ; outend(nl);
al. w3 h10.+2 ; examine hardware error:
jd 1<11+4 ; process description(document name);
sn w0 0 ; if non exist then
jl. e9. ; goto get mask;
rl w1 (0) ; w1 := kind(doc name);
se w1 4 ; if kind = 4 (bs)
sn w1 8 ; or kind = 8 (tw)
jl. +4 ; or
sn w1 14 ; kind = 14 (lp)
am 2 ; add parity to mask;
e9: rl. w1 e2. ; get mask;
rl. w0 c20. ; move status to message;
la w0 2 ;
rs. w0 e4. ;
sn w0 0 ; if status and mask(kind) <> 0
jl. e8. ; then
al. w1 e3. ;
al. w2 h10.+2 ; parent message(<:status:>, doc name);
jl. w3 h35. ;
e8: dl. w2 c20. ; test if current in error:
rl. w0 h20.+h2+0 ;
sn. w1 h20.+h1+2 ; if error on curr in zone
so w0 2.1 ; and i-bit then
jl. e33. ; begin
al. w3 2 ; unstack curr in
rl. w0 h50. ; until name
se w0 0 ; chain end;
jl. h30.-4 ;
rl. w3 h20.+h0+0 ; reset the
al w3 x3-1 ; fp command stack;
rs. w3 h8. ;
rs. w3 h9. ; call and enter
jl. h61. ; command segment;
e33: al. w3 2 ; end;
rl. w0 h20.+h2+0 ; unstack curr in zone
so w0 2.1 ; until first i-bit;
jl. h30.-4 ; call and enter
jl. h62. ; load program segment;
; hard error message to parent, in case of hardware errors:
e3: 3<13+1<9+0 ; m(0) , pattern word
<:status:> ; m(2:4)
e4: 0 ; m(6) , logical status
e7: <:<10>***device status <0>:>
\f
; rc 77.09.22 file processor, device status, page ...2...
; mask(0:20) , to select hardware errors:
e2: 1<23+ 1<21+1<20+1<13+1<12+1<4 ; without parity bit
1<23+1<22+1<21+1<20+1<13+1<12+1<4 ; with parity bit
; device status text (0:21):
e10: <:<10>intervention<0>:> ;
e11: <:<10>parity error<0>:> ;
e12: <:<10>timer<0>:> ;
e13: <:<10>data overrun<0>:> ;
e14: <:<10>block length error<0>:> ;
e15: <:<10>end of document<0>:> ;
e16: <:<10>load point<0>:> ;
e17: <:<10>tape mark or attention<0>:> ;
e18: <:<10>writing enabled<0>:> ;
e19: <:<10>mode error<0>:> ;
e20: <:<10>read error<0>:> ;
e21: <:<10>card rejected or disk error<0>:> ;
e22: <:<10>checksum error<0>:> ;
e23: <:<10>bit 13<0>:> ;
e24: <:<10>bit 14<0>:> ;
e25: <:<10>stopped<0>:> ;
e26: <:<10>word defect<0>:> ;
e27: <:<10>position error<0>:> ;
e28: <:<10>process does not exist<0>:> ;
e29: <:<10>disconnected<0>:> ;
e30: <:<10>unintelligible<0>:> ;
e31: <:<10>rejected<0>:> ;
h.
e5: e10-e10, e11-e10, e12-e10, e13-e10, e14-e10, e15-e10
e16-e10, e17-e10, e18-e10, e19-e10, e20-e10, e21-e10
e22-e10, e23-e10, e24-e10, e25-e10, e26-e10, e27-e10
e28-e10, e29-e10, e30-e10, e31-e10
w.
e1 = (:h55+512-k:)/2
0, r. e1 ; fill segment with zeroes
m.fp device status 77.09.22
m. fpnames follows:
e. ; end device status segment
i. ; list fp names
b. g1 w.
g0: g1: 17 ; segm
0, r.4 ; docname
s2 ; date
0, 0 ; fil, blok
3<12 + 2 ; contry
3584 ; length
p.<:insertproc:>
e. ; end file processor
▶EOF◀