|
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: »retfp4tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »retfp4tx «
mode list.yes
fp5tx=edit fp4tx
; rettelser til release 5.0
;
; block io, common bits : if less than wanted was input and kind = disk
; or less than wanted was output then add stopped
;
; block io : bit 1<23, intervention, special bit for character output
; simple check : bit 1<23, intervention, special action is as for
; paper low : parent message attend with wait bit
;
; simple check : parent message change ændres til attend
;
; init : efter connect (out, primout) og connect (in, primin) sættes
; name table address, så evt. area process ikke fjernes af
; fp end program igen
;
; commands : script indføres
;
; commands : ved 'em' på prim out tømmes curr out og der sendes finis til
; parenten, ved 'em' på stakket curr out afstakkes blot
;
; in fp load program any program with text contents is just connected as
; current input and fp jumps to command reading
;
; a new slang segment, finis, is brought in to send an MCL message before
; a finis parent message in case primary output process is a pseudo pro-
; cess and its main process has the name <:menu:>
;
; end program : device status card reject or disk error ændres til
; disk error or not connected
l./page ...1/, r/89.01.25/89.06.27/
l./m.file processor/, r/89.01.25/89.06.27/
l./m.fp text 1/, r/89.01.25/89.06.28/
l./s. k=h55, e48 ; command assembly/, l1, r/13, 14/13, 14, 15/
l3, r/15/16, 17/
l./end program and device status/, i/
; s. k=h55, e48 ; finis message to parent
; e. ; segment 18
;
/, l2, r/16, 17/19, 20/, p-3
l./permanent, page ...3b/, r/88.05.19/89.06.27/
l./h52:/, r/4/5/
l./page ...6/,
l./m.fp permanent/, r/89.01.25/89.06.28/
l./block io, page ...2/, r/89.01.25/89.03.20/
l./e23:/, l1, i/
e29: 1<8 ; stopped bit
/, p-1
l./block io, page ...3/, r/89.01.25/89.03.20/
l./am. (c22.)/, d./al w3 x3+1<8/, i/
sn w0 3 ; if less than wanted was input and
se w2 4 ; kind = disk
sn w0 5 ; or less than wanted was output then
lo. w3 e29. ; status := status or stopped bit;
/, p-4
l./block io, page ...4/, r/82.12.12/89.03.20/
l./e28:/, l-1, r/8.0/8.4/
l6, r#*#* /#, p1
l./page ...4/,
l./m.fp io system/, r/89.01.27/89.03.20/
l./resident, page ...1/, r/89.01.25/89.06.27/
l./h64:/, r/am 0/am -1/, r/hard error =/fp finis:/
l1, r/am 1/am 3/
l1, r/am 2/am 3/
l./h99=/, l./am 512/, r/512 /1024/
l1, r/1022/1534/
l./resident, page ...4/, r/89.01.26/89.06.29/
l./c44:/, l1, i/
c45: -1 ; script (initially : not in script)
/, p-1
l./h56=/, l./c. -g1/, r/-g1 /-g1-1/
l2, d, i/
w. c. g1-1 0, r.g1 z. ;
/, p-1
l./resident, page ...6/, r/82.12.09/89.06.27/
l./h64/, r/hard errors on devices/finis program/
l./resident, page ...7/, l./m.fp resident/, r/86.12.12/89.06.27/
l./simple check, page ...1/, r/88.04.24/89.03.20/
l./e17:/, l1, i#
e18: 1<23 + 1<18 ; test intervention and end doc
#, p-1
l./simple check, page ...2/, r/88.04.24/89.03.20/
l./so. w0 (e17.)/, d1, i/
sz. w0 (e17.) ; if not end doc then
jl. e9. ; begin <*not end doc and stopped*>
bz w0 x1+h1+1 ;
bz w3 x2+6 ;
sn w0 4 ; if kind = area and
se w3 3 ; operation = input then
jl. e23. ; goto return else
jl. e7. ; goto repeat the rest;
e9: ; end;
/, p-9
l./e19:/, l./rl. w0 c11./, d1, i/
rl w3 x2+2 ;
al w3 x3+1 ;
sh w3 (x2+22) ; if share.top transferred > share.first shared then
/, l1, p-4
l./page ...5/, r/88.04.24/89.03.20/
l./e25:/, l1, r/change/attend/
l./e5:/, l./so. w0 (e17.)/, d1, i/
sz. w0 (e18.) ; if intervention or end doc then
jl. e24. ; goto attend message else
jl. e27. ; goto test stop ;
/, l1, r/ al/e24: al/, r/ if end document then/ attend message:/, p-4
l./m.length error on fp segment 3/, r/ on fp segment 3/, simple check/
l./m.fp simple check/, r/88.05.04/89.03.20/
l./stack, page ...5/,
l./m.length error on fp segment 6/, r/ on fp segment 6/, stack/
l./unstack, page ...5/,
l./m.length error on fp segment 7/, r/ on fp segment 7/, unstack/
l./magtape check, page ...5/,
l./m.length error on fp segment 9/, r/ on fp segment 9/, magtape check/
l./init, page ...1/, r/88.05.04/89.06.28/
l./; segment 10/, r/segment 10/segment 11/
l./init, page ...3a/, r/86.12.12/89.06.23/, r/3a/4/
l1, l./init, page ...4/, r/88.05.02/89.06.23/, r/...4/...5/
l./jl. w3 h28.-2/, l3, i/
jl. w2 e20. ; send and wait sense (out);
/, p-1
l5, i/
jl. w2 e20. ; send and wait sense (in);
/, p-1
l./rs. w3 h9./, l1, i/
al w3 -1 ; set
rs. w3 c45. ; not in script;
/, p-2
l./; the following code is skipped/, i/
\f
; fgs 1989.06.23 file processor, init, page ...5...
/
l./e5:/, i/
\f
; fgs 1989.06.23 file processor, init, page ...6...
/
l./jl. w3 h14./, d./b13:/, i/
jl. h64. ; goto fp finis;
e20: ; send and wait sense (zone);
rs. w2 b14. ; save return;
al w3 x1+h1+2 ; w3 := zone.docname;
al. w1 b4. ; w1 := message area (sense);
jd 1<11+16 ; send message;
al. w1 h66. ; w1 := addr answer area block io;
jd 1<11+18 ; wait answer;
jl. (b14.) ; return;
\f
; fgs 1989.06.23 file processor, init, page ...7...
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, r.4 ; zero used in set catbase and send and wait sense
b7: <:***fp reinitialized<10><0>:>
b8: 0 ; first (boolean)
b9: 8<13+0<5 ; parent message
<:***fp init troubles :>
b10: <: version<0>:> ;
b11: <: release<0>:> ;
b12:; <: started with <0>:>
b13: <:s:>, 0, r.3 ; name of ancestor <:s:>
b14: 0 ; saved return in send and wait sense
/, p1
l./m.length error on fp segment 11/, r/ on fp segment 11/, fp init/
l./m.fp init /, r/89.01.12/89.07.04/
l./commands, page ***01/, r/86.08.06/89.07.04/
l./b. a2/, r/a2/a9/, r/b0/b9/
l./a0:/, l./al. w3 a0./, d3, i/
se w2 25 ; if char = 'em' then
jl. a1. ; begin
rl. w1 h50. ;
se w1 0 ; if current input stack chain empty then
jl. a2. ; begin
jl. w3 h95.-2 ; close out text (curr out);
jl. h64. ; goto finis to parent;
a2: al w1 -1 ; end;
se. w1 (c45.) ; if not in script then
jl. a3. ;
al. w3 a0. ; goto unstack current input; return to rep;
jl. h30.-4 ;
a3: wa. w1 g19. ; bracket count :=
rs. w1 g19. ; bracket count - 1;
se w1 0 ; if bracket count <> 0 then
jl. f0. ; goto syntax error; <*where in will be unstacked*>
jl. w3 h30.-4 ; unstack current input;
rl. w3 g3. ; get char addr;
al w0 7 ; state := 7; <*cheat, w0 is not supposed to change*>
al w2 10 ; char := 'nl'; <*cheat again, char in buffer unch.*>
a1: ; end;
/, p1
l./commands, page ***06/, r/86.08.27/98.06.28/
l./b. a9/, r/a9, b2 /a99, b2/
l./commands, page ***07/, r/86.09.03/98.07.04/
l./jl. h14./, r/h14/h64/, l-1, r/finis/goto fp finis/, p1
l./i3:/, l2, i/
jl. w3 h39. ;
al w0 -1 ; if in script then
sn. w0 (c45.) ; begin
jl. i0. ; set not in script;
rs. w0 c45. ; warning.yes, ok.no ;
al w2 3 ; goto fp end program;
jl. h7. ; end else
; goto initiate command reading;
/, p-2
l./commands, page ***08/, r/86.08.08/98.07.04/
l./al w3 1/, d2, i/
al w3 1 ;
rs. w3 g14. ; state := 1;
sn. w0 (c45.) ; bracket count := if in script then 1
al w0 1 ; else 0;
ds. w0 g19. ; sign := 1;
/, p-5
l./rl. w2 h9./, l1, i/
al w0 0 ;
se. w0 (c45.) ; if in script then
jl. a11. ; begin
rl. w2 h8. ; cur command := fp.cur command;
a12: ea w2 x2+1 ; cur command := cur command + cur command.length;
zl w1 x2 ; sep := cur.command.sep;
sl w1 4 ; if sep > 'nl' then
jl. a12. ; goto rep;
al w2 x2+2 ; <*because commands are moved to x2-4*>
a11: ; end;
/, p1
l./dl. w1 i13.; move endlist/, d1, i/
dl. w1 i13. ;
al w3 0 ; if not in script then
se. w3 (c45.) ; move endlist;
ds w1 x2 ;
; end part of fp;
/, p1
l./page ***09/, r/86.08.11/89.07.04/
l./jl. h62./, l-1, i/
al w0 -1 ; set
rs. w0 c45. ; not in script;
/, p-2
l./commands, page ***11/, r/86.08.15/98.06.28/
l./f5:/, l./sh w1 -1/, d, i/
sh. w1 (c45.) ; if bracket count <= script then
/, p1
l./commands, page ***16/, r/88.04.24/98.06.28/
l./i10:/, i#
w.
b. g1 ; fill segment
g1 = (:h55+1536-k:)/2
c. -g1 m. length error fp commands
z.
; w. 0, r.g1
e.
#
l./m.fp comm. reading 88.04/, r/88.04.24/89.07.04/
l./load, page 1/, r/rc 12.07.79 /fgs 1989.06.28/
l3, r/512 /1024/
l./load, page 1a/, r/rc 12.07.79 /fgs 1989.06.28/, r/1a/...2.../
l./load, page 1b/, r/rc 12.07.79 /fgs 1989.06.28/, r/1b/...3.../
l./e2:/, d3, i/
e2: ; if contents = 0
sl w3 2 ; or contents = 1 then
jl. e18. ; begin
e17: al w0 x2+2 ; file name pointer := param pointer + 2;
jl. w3 h29.-4 ; stack current input;
rl w2 0 ;
jl. w3 h27.-2 ; connect curr input ( file name);
sn w0 0 ; if result <> 0 then
jl. e19. ; begin
jl. w3 h30.-4 ; unstack current input (cur chain);
jl. w3 e48. ; set name table addr in curr in;
jl. e44. ; goto connect trouble;
e19: jl. w3 e48. ; end;
rs. w0 c45. ; set name table addr in curr in;
rl. w3 h51. ; script := 0;
sz w3 1<0 ; if fp mode list.yes then
jl. w3 e26. ; list curr command;
jl. h61. ; goto commands;
e18: ; end else
se w3 2 ; if not (contents = 2
sn w3 8 ; or contents = 8) then
jl. e20. ;
jl. e47. ; goto call trouble;
e20: ;
/, p1
l./load, page 2/, r/rc 86.09.03 /fgs 1989.06.28/, r/page 2/page ...4.../
l./load, page 3/, r/88.07.21 /fgs 1989.06.28/, r/page 3/page ...5.../
l./load, page 3a/, r/rc 86.10.10 /fgs 1989.06.28/, r/3a/...6.../
l./e44:/, i/
;procedure set name table address in zone:
;w1 = zone w3 = link
b. a3 w.
a1: 0,r.10 ; message and answer
0 ; saved w2
a2: 0 ; link
0 ; saved w0
a3: 0 ; saved w1
e48: ds. w3 a2. ; save w2,w3;
bz w3 x1+h1+1 ; if kind <> bs
se w3 4 ; then
jl. (a2.) ; return;
ds. w1 a3. ;
al w3 x1+h1+2 ;
al. w1 a1. ; send message (sense area proc);
jd 1<11+16 ;
jd 1<11+18 ; wait answer;
dl. w1 a3. ; restore w0,w1;
dl. w3 a2. ; restore w2,w3;
jl x3 ; return;
e.
/, p1
l./e13=/, l./(:h55+512/, r#512-k:)/2 #1024-k:)/2#
l./m.length error on fp segment 13/, r/on fp segment 13/load/
l./m.fp program load 88.07.21/, r/88.07.21/89.06.28/
l./end program, page ...1/, i#
\f
; fgs 1989.06.27 file processor, finis, page 1
; the fp segment finis
s. k=h55, a20, e48, f7
w. ;
512
e0: jl. e1. ; entry:
a2: 0 ,0,0,0 ; zero name
a3: <:c:>,0,0,0 ;
a4: <:v:>,0,0,0 ;
a10: 128<12 + 0 ; MCL message:
0 ; localid
12<12 + 15 ; no of characters
0, r.5 ; text (1:5)
a11: <:menu<0>:> ;
a12:<: ok no<0>:>;
<: ok <0>:>;
<:warning, ok no<0>:>;
<:warning, ok <0>:>;
a13: 3 ; mask for extract 2
a14: 10 ; constant
\f
; fgs 1989.06.27 file processor, finis, page 2
e1: ; finis:
rl. w3 h51. ; text addr := addr ( case (warning.ok) of (
ls w3 -5 ;
la. w3 a13. ; <: ok no:>,
wm. w3 a14. ; <: ok :>,
al. w2 a12. ; <:warning, ok no:>,
wa w2 6 ; <:warning, ok :>) );
dl w0 x2+2 ; move
ds. w0 a10.+8 ; text
dl w0 x2+6 ; from
ds. w0 a10.+12 ; constant text area
rl w0 x2+8 ; to
rs. w0 a10.+14 ; message.text area;
\f
; fgs 1989.06.27 file processor, finis, page 3
am. (h16.) ; after param:
dl w1 +78 ;
al. w3 a2. ; w3 := addr name (zero);
jd 1<11+72 ; set catbase (std base);
rl. w3 h15. ;
al w3 x3+2 ;
jd 1<11+4 ; w0 := proc descr addr (prim out);
sn w0 0 ; if w0 <> 0 then
jl. e2. ; begin
rx w3 0 ; save w3; w3 := addr prim out proc;
rl w1 x3 ;
se w1 64 ; if prim out.kind <> 64 <*pseudo*> then
jl. e2. ; skip;
rl w2 x3+10 ;
rl w3 0 ; restore w3;
dl w1 x2+4 ;
sn. w0 (a11.) ; if prim out.parent.name <> <:menu:> then
se. w1 (a11.+2) ;
jl. e2. ; skip;
al. w1 a10. ;
jd 1<11+16 ; send message (prim out, message);
al. w1 h43. ;
jd 1<11+18 ; wait answer (answer area lowest level);
e2: ; end;
\f
; fgs 1989.06.27 file processor, finis, page 4
al w2 0 ; close up (cur out,null);
jl. w3 h95.-2 ;
al w0 0 ;
jl. w3 h79.-2 ; terminate zone (cur out,file mark);
al. w3 a3. ;
jd 1<11+48 ; remove c
al. w3 a4. ;
jd 1<11+48 ; remove v
jl. w3 h14. ; send finis message
jl. -2 ; if not removed then send it again;
b. g1 ; fill segment
g1 = (:h55+512-k:)/2
c. -g1 m. length error fp finis
z.
w. 0, r.g1
e.
e. ; end finis
m.fp finis 89.06.27
#
l./end program, page 3/, r/rc 86.09.01 /fgs 1989.06.27/
l./jl. w3 h14./, r/w3 h14/ h64/
l./end program, page ...8/, r/rc 86.08.28/ fgs 89.03.20/
l./e21:/, r/card rejected or disk error/disk error or not connected/
l./end program, page ...9/,
l./e41 =/, d1, i#
w.
b. g1 ; fill segment
g1 = (:h55+1024-k:)/2
c. -g1 m. length error fp end program
z.
w. 0, r.g1
e.
#
l./m.fp end program/, r/88.05.02/89.03.20/
l./insertproc page ...1/, r/86.12.12/89.06.27/
l./g0: 18/, r/18 / 21/
f
end
▶EOF◀