|
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: 33024 (0x8100)
Types: TextFile
Names: »mode5tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »mode5tx «
; fgs 1989.03.13 fp utility, job adm 1, page 1
; the programs are translated like
; (mode=slang text entry.no
; mode head char finis end)
;
; file processor: basic job administration 1
; mode, head, finis, end programs
; leif svalgaard july 1969
; modified for multi processor monitor :
; F. G. Strøbech march 1985
\f
; fgs 1989.03.13 fp utility, job adm 1, page 2
b.g1, f7 w.
d.
p.<:fpnames:>
l.
s. k=h55, e48, j1 ; begin
w. ;
j0: j1 ; length
0 ; not used
e0:
f1: jl. w2 e1. ; entry 4:
<:*mode :> ; mode
f2: jl. w2 e2. ; entry 10:
<:*head :> ; head
f3: jl. w2 e3. ; entry 16:
<:finis :> ; finis
f4: jl. w2 e5. ; entry 22:
<:*end <127>:> ; end
f7: jl. w2 e2. ; entry char: goto head
<:*char :>
e9: <:<10>**:> ; second time start text
e10: <:<127>**:> ,0 ; first time error text
e11: 0 ; with room for program name
e32: <:param:> ; param message
e12: <:call:> ; call message
e13: rs. w3 e17. ; procedure init param:
dl w0 x2+2 ; param pointer:= w3;
ds. w0 e11. ; set program name in
rl. w3 e17. ; error message;
jl x1 ; return;
e14: 0 ; return addr in list param
e15: 0 ; e15+1 ; booleans: ok, call error
e16: 0 ; saved param pointer
e17: 0 ; current param pointer
\f
; fgs 1989.03.13 fp utility, job adm 1, page 3
; procedure list param.
; prints on current output a param error message followed by
; the current composite parameter, and returns with next param.
e18: al. w0 e10. ; list param:
jl. w3 h31.-2 ; outtext (cur out,<:***...param:>);
al w0 1 ; ok:= false;
hs. w0 e15. ;
rl. w2 e16. ; param pointer:= saved param pointer;
rs. w2 e17. ;
bl w0 x2+0 ;
se w0 4 ; next:
e19: am 14 ; outchar (cur out,
al w2 32 ; if separator=dot then
jl. w3 h26.-2 ; 46 else 32);
rl. w2 e17. ;
bz w1 x2+1 ; if kind.param >= 10 then
al. w3 e20. ; outtext (cur out,param text)
al w0 x2+2 ; else
sl w1 10 ; outinteger (cur out,<<d>,param);
jl. w0 h31.-2 ;
rl w0 x2+2 ;
jl. w3 h32.-2 ,1 ; insert nl in front of ***;
e20: rl. w3 e9. ; get param;
rs. w3 e10. ; if sep=end then goto param end;
jl. w3 e25. ; if sep=dot then goto next;
e33: jl. e24. ; mod ;
jl. e19. ; goto return in e14;
jl. (e14.) ;
jl. e46. ; if end sep then head goes to e46;
\f
; fgs 1989.03.13 fp utility, job adm 1, page 4
; param end.
e24: al. w3 e22. ; param end:
e23: bz. w2 e15.+1 ; call error entry:
dl. w1 e12.+2 ; param text is replaced by call
ds. w1 e12.-2 ; error text in message;
al. w0 e10. ; if call error then
se w2 0 ; outtext (cur out,<:***...call:>);
jl. w0 h31.-2 ; then maybe return (:if e23 entry:);
e22: rl. w0 e10.+2 ; exit:
rl. w2 e15. ; if not ok
se w2 0 ; then
jl. w3 h39. ; outend(cur out,nl);
se. w0 (e0.+2) ; if mode called
jl. e31. ; then begin
al w2 1<6+1<5 ; w2:=warning and ok
la. w2 h51. ; from modebits shift -5;
ls w2 -5 ;
al w0 1 ; negate ok;
lx w2 0 ;
rs. w2 h51.-2 ;c20; save w2 in fp c20;
jl. h63. ; call and enter fp end program;
; comment: in this way the test of pause and error bits in
; fp end program is bypassed (dirty trick) end;
e31: rl. w2 e15. ; w2:=if no errors then 0
se w2 0 ; else 1;
al w2 1 ;
jl. h7. ; goto end program;
\f
; fgs 1989.03.13 fp utility, job adm 1, page 5
; procedure get param;
; w0 separator
; w1 kind
; w2 param pointer
; w3 link next sep ;call+2: end,+4:dot,+6:space
e21: 0 ; return ; return point depends on current sep
e25: rl. w2 e17. ; get param:
ba w2 x2+1 ; param pointer:= param pointer+size.param;
rs. w2 e17. ; w0:=separator.param;
bl w0 x2+0 ; w1:=kind.param;
bz w1 x2+1 ; w2:=param pointer;
se w0 4 ; if sep=space then save the param pointer
jl. 6 ; for the sake of the listing of errors;
rs. w2 e16. ; determine action:
al w3 x3+4 ; if separator= space then
sl w0 4+1 ; return:=return+4 else
al w3 x3+2 ; if separator=dot then
rs. w3 e21. ; return:=return+2;
am x2 ; take next sep:
bl w3 x1 ; w3:=separator.next param;
jl. (e21.) ; return;
; procedure search name(list); w1=list pointer.
e26: rs. w3 e21. ; search name: save return point;
dl w0 x2+4 ; for all items in the name list
sn w0 (x1+2) ; do
se w3 (x1+0) ; if name.param = name.item
jl. e27. ; then return with found name;
dl w0 x2+8 ; comment: x1+8 points to an output
sn w0 (x1+6) ; value of the search;
se w3 (x1+4) ;
jl. e27. ;
jl. (e21.) ;
e27: al w1 x1+10 ; if not found then
rl w0 x1 ; list param;
se w0 0 ;
jl. e26.+2 ; comment: the name list is terminated
jl. e18. ; by a zero word;
; name list format: <4 words name> <1 word output value>
\f
; fgs 1989.03.13 fp utility, job adm 1, page 6
; procedure test call error;
; w0 destroyed
; w1 link link
; w2 unchanged
; w3 param pointer param pointer
e29: bl w0 x3+0 ; test call error:
sn w0 6 ; if current separator = equal
e30: hs. w0 e15.+1 ; then call error:= true;
jl x1 ; return;
\f
; fgs 1989.03.13 fp utility, job adm 1, page 7
; the fp program mode:
; mode <s> <bits>.<on> <area>
b. b24 ; begin
w. ; mode:
e1: jl. w1 e13. ; init param;
jl. w1 e29. ; test call error;
al. w1 b8. ; return from list param:=
rs. w1 e14. ; test kind;
b1: jl. w3 e25. ; next param pair:
jl. e24. ; if sep= end then goto param end;
jl. e18. ; if sep= dot then goto list param;
b8: se w1 10 ; test kind:
jl. b2. ; if kind=integer then goto shift;
sn w3 8 ; name found: if next sep=dot
jl. b3. ; then goto search option;
rl w0 x2+2
sn. w0 (b23.) ; if param=what
jl. b24. ; then list modebits;
jl. e18. ; then list param;
b2: rl w1 x2+2 ; shift:
sl w1 0 ; if param < 0
sl w1 24 ; or param > 23
jl. e18. ; then goto list param;
se w3 8 ; if next sep<>dot
jl. e18. ; then list param
ac w1 x1-23 ;
al w0 1 ; bits:= 1 shift (23-param);
ls w0 x1 ; goto check on;
jl. b4. ;
b3: al. w1 b20. ; search option:
rl w0 x2+2 ;
sn. w0 (b23.) ; if param=what
jl. b24. ; then goto list modebits;
jl. w3 e26. ; search name (option table,param,bits);
rl w0 x1+8 ; if not found then list param;
b4: rs. w0 b10. ; bits:= option bits;
jl. w3 e25. ; check on: get param;
jl. e18. ; if sep<>dot
se w1 10 ; or kind<>name
jl. e18. ; then goto list param;
al. w1 b21. ; search name (on table,param,jump);
jl. w3 e26. ; if not found then list param;
rl. w3 b10. ; goto jump;
jl x1+8 ;
b5: lo. w3 h51. ; set bits: fp mode bits:= bits or
jl. b7. ; fp mode bits;
b6: ac w3 x3+1 ; goto next param pair;
la. w3 h51. ; clear bits: fp mode bits:= inverse (bits)
b7: rs. w3 h51. ; and fp mode bits;
jl. b1. ; goto next param pair;
\f
; fgs 1989.03.13 fp utility, job adm 1, page 8
; option table for mode
b20: <:list:> , 0, 0, 1<0
<:pause:> , 0, 0, 1<3
<:error:> , 0, 0, 1<4
<:ok:> , 0, 0, 0, 1<5
<:warning:> , 0, 1<6
; <:if:> , 0, 0, 0, 1<7
<:listing:> , 0, 1<8
<:initmess:> , 0, 1<9
<:bswait:> , 0, 0, 1<10
<:all:> , 0, 0, 0, 2.111111111111111101111111
0 ; terminate option table
; on table for mode
b21: <:yes:> , 0, 0, 0, jl.b5.
<:no:> , 0, 0, 0, jl.b6.
0 ; terminate on table
b10: 0 ; bits
b23: <:wha:>
b24:
; list modebits;
b. a4 w.
al. w3 a3. ; save textaddr;
rs. w3 a1. ;
rl. w2 h51. ; modebits;
al. w0 a2. ; outtext(<:modebit:>);
jl. w3 h31.-2 ;
jl. 4 ;
a0: ls w2 1 ; loop: modebits:=modebits shift 1;
sn w2 0 ; if modebits empty then
jl. a4. ; goto exit;
rl. w3 a1. ;
al w3 x3+8 ; textaddr:=textaddr+8;
rs. w3 a1. ;
sl w2 0 ; if not this modebit then
jl. a0. ; goto loop;
al w0 x3 ;
jl. w3 h31. ; outtext(modebitname);
jl. a0. ; goto loop;
\f
; fgs 1989.03.13 fp utility, job adm 1, page 9
a1: 0 ;
a2: <:modebit:> ;
a3=k-8
<: 0:>,0,0,0
<: 1:>,0,0,0
<: 2:>,0,0,0
<: 3:>,0,0,0
<: 4:>,0,0,0
<: 5:>,0,0,0
<: 6:>,0,0,0
<: 7:>,0,0,0
<: 8:>,0,0,0
<: 9:>,0,0,0
<: 10:>,0,0,0
<: 11:>,0,0,0
0,0,0,0
<: bswait:>,0
<: initmess:>,0
<: listing:>,0
0,0,0,0
<: warning:>,0
<: ok:>,0,0,0
<: error:>,0,0
<: pause:>,0,0
0,0,0,0
0,0,0,0
<: list:>,0,0
a4: jl. w3 h39. ; exit: outend(nl);
rs. w1 e15. ;
jl. e22. ; goto program exit;
e.
e. ; end mode
\f
; fgs 1989.03.13 fp utility, job adm 1, page 10
; the fp program head:
; <file>=head <s> <form feeds> or: head <s> <form feeds>
b. b51 ; begin
w.e2: jl. w1 e13. ; head: init param;
al w1 6 ; modify return after errors
hs. w1 e33.+1 ; to the printing sequence;
al. w1 h21. ; file:= current output;
rs. w1 b3. ; if sep=equal then
bl w0 x3+0 ; file:= file in call
se w0 6 ; else goto scan parameters;
jl. b18. ;
al w2 x3-8 ; left hand side in call:
al. w1 b1. ; initialize a zone to
al. w3 b2. ; hold the file;
rs w3 x1+h0+4 ; set used share in zone;
rs w3 x1+h0+6 ; set first share in zone;
rs w3 x1+h0+8 ; set last share in zone;
al. w0 e48. ; set first shared.share;
rs w0 x3+2 ;
al w0 1<2+0 ; if new area then one segment on disk;
jl. w3 h28. ; connect output (file,zone,result);
hs. w0 e15.+1 ; call error:= result<>0;
sn w0 0 ; if call error then
rs. w1 b3. ; file:= current output;
sn w0 0
jl. w3 e47. ; prepare entry for textoutput
jl. b18. ; goto scan parameters;
b3: 0 ; zone descr addr for file
b12: 0 ; init zero ; form feeds
b1=k-h0 , 0, r.h5/2 ; zone descriptor
b2: 0, r.h6/2 ; share descriptor
b5: 0 ; sec ; all values are init to zero
b6: 0 ; month ;
b7: 0 ; date ;
b8: 0 ; min ;
b9: 0 ; hour ;
b10: 0 ; year ;
\f
; fgs 1989.03.13 fp utility, job adm 1, page 11
b18: rl. w0 e11. ; scan parameters:
sn. w0 (f2.+4) ; if program=head then
jl. b13. ; goto head
al. w1 b47. ;
rs. w1 e14. ; set return after list param
b11: jl. w3 e25. ; next char param:
b47: jl. b25. ; if end param then goto exit
jl. b40. ; if sep=dot then goto dotparam
sn w1 10 ;
jl. w1 b48. ; if param=text then goto textparam;
rl w3 x2+2 ;
hs. w3 b41. ; value:=param
bl w3 x2+4 ;
sn w3 8 ; if nextsep=dot then
jl. b11. ; goto next char param
al w3 1 ;
rs. w3 b12. ; repeat:=1;
jl. b15. ; goto print
b40: sn w1 10 ; dotparam:
jl. e18. ; if param=dot text then goto list param
rl w3 x2+2 ;
al w1 133 ; max:=133
bl. w2 b41. ;
sn w2 12 ; if value=ff then
al w1 6 ; max:=6
sn w2 10 ; if value=nl then
al w1 64 ; max:=64
sl w3 x1 ; if repeat>max then
al w3 x1 ; repeat:=max
rs. w3 b12. ;
jl. b15. ; goto print
\f
; fgs 1989.03.13 fp utility, job adm 1, page 12
b48:
b. t4 w.
rl w0 x2+2 ; w0:=text;
al w3 0 ; value:=
sn. w0 (t1.) ; if text=nl then
al w3 10 ; 10 else
sn. w0 (t2.) ; if text=ff then
al w3 12 ; 12 else
sn. w0 (t3.) ; if text=em then
al w3 25 ; 25 else
sn. w0 (t4.) ; if text=sp then
al w3 32 ; 32
sn w3 0 ; else alarm;
jl. e18. ;
hs. w3 b41. ; save value;
bl w3 x2+10 ; w3:=nextsep
jl x1+6 ;
t1: <:nl:>
t2: <:ff:>
t3: <:em:>
t4: <:sp:>
e.
b13: rl. w1 b3. ; head: outfile
bz w0 x1+h1+1 ; if kind=14 (printer)
al w2 15 ; then
sn w0 14 ; outchar(file,
jl. w3 h26. ; shift-in-char)
al. w1 b4. ;
rs. w1 e14. ; set return of list param
b0: jl. w3 e25. ; next head param:
b4: jl. b15. ; if end param then goto print
jl. e18. ; if dot then goto list param
rl w3 x2+2 ;
sn w1 10 ; if param=integer then
jl. b49. ; begin
sl w3 6 ; if param>6 then
al w3 6 ; param:=6
rs. w3 b12. ; repeat:=param
jl. b0. ; goto next head param
\f
; fgs 1989.03.13 fp utility, job adm 1, page 13
; end;
b49: se. w3 (b50.) ;
jl. b14. ;
al w3 0 ; if param=old then
rs. w3 b35. ; iso:=false;
jl. b0. ; goto next head param;
b14: al w2 1 ;
sn. w3 (b38.) ; if param=<:cpu:> then
rs. w2 b36. ; cpu.=true
sn. w3 (b37.) ; if param=<:iso:> then
rs. w2 b35. ; iso:=true
se. w3 (b37.) ; if param=<:cpu:> or
sn. w3 (b38.) ; param=<:iso:> then
jl. b0. ; goto next head param
jl. e18. ; else goto list param
b15: rl. w0 b12. ; print:
rl. w1 b3. ; w1:=output descr.
rl. w3 e15. ; if param error then
se w3 0 ; outchar (cur out,nl);
jl. w3 b26. ;
b16: sh w0 0 ;
jl. b17. ; for form feeds:= form feeds-1
bs. w0 1 ; while form feeds>=0 do
b41=k+1
al w2 12 ;or char; outchar(file,char);;
jl. w3 h26. ;
jl. b16. ;
b17: rl. w0 e11. ;
se. w0 (f2.+4) ; if program<>head then
jl. b11. ; goto next char param
am -2000 ; print process name:
am. (h16.+2000) ;
al w0 +2 ; w0 := addr own process.name;
rl. w1 b3. ; outtext (file,name of own process);
jl. w3 h31. ;
jd 1<11+36 ; get and convert clock:
ld w3 -65 ; get clock (clock);
wd. w1 b31. ;
wd. w0 b30. ; fourmin:= clock//2 400 000;
wd. w3 b29. ; clock:= clock mod 2400000;
rx. w0 b8. ; min:= clock//600 000;
wd. w1 b32. ; clock:= clock mod 600 000;
rx w3 0 ; sec:=clock//10 000;
al w2 0 ; days:=fourmin//360;
wd. w3 b33. ; fourmin:=fourmin mod 360;
as w2 2 ; hour:=fourmin//15;
wa. w2 b8. ; fourmin:=fourmin mod 15;
ds. w1 b6. ; min:= 4*fourmin + min;
ds. w3 b9. ;
ld w0 -65 ; julian calendar:
wd. w1 b28. ; year:=days//1461*4+1968;
as w1 2 ; days:=days mod 1461;
al w1 x1+1968 ;
se w0 59 ; if days = 59 then
jl. b19. ; begin comment: leap year;
al w2 2 ; month:= 2;
al w3 29 ; date:= 29;
jl. b21. ; end else goto b19
\f
; fgs 1989.03.13 fp utility, job adm 1, page 14
b27: 365 ; constants: days in 1 year
b28: 1461 ; days in 4 years
b29: 10000 ; clock unit 0.1 msec
b30: 600000 ; 60*10000
b31: 2400000 ; 60*10000*4
b32: 360 ; 24*15
b33: 15 ;15
b35: 1 ; iso:=true
b36: 0 ; cpu:=false
b37: <:iso:> ;
b46: <: :> ;
b38: <:cpu: :> ;
b39: <: sec.:> ;
10000<9 ;
b43: 4096+14-47 ; 10000*2**(-47) as floating
1<22 ;
b44: 0 ; 0.5 as floating
1600<12 ;
b45: 7 ; 100 as floating
b50: <:old:>
\f
; fgs 1989.03.13 fp utility, job adm 1, page 15
b34=k-1 ; month table:
h. -1, 30, 58 ; number of days minus one
89, 119, 150 ; elapsed since jan 1st
180, 211, 242 ; for each month.
272, 303, 333 ;
w.
b19: sl w0 59+1 ; begin
bs. w0 1 ; if days>59 then
wd. w0 b27. ; days:= days-1;
wa w1 0 ; year:= year + days//365;
al w2 13 ; days:=days mod 365; month:=13;
b20: al w2 x2-1 ; last month:
bl. w0 x2+b34. ; month:= month-1;
sh w3 (0) ; if days <= month table (month)
jl. b20. ; then goto last month;
ws w3 0 ;
b21: rs. w1 b10. ; date:= days - month table (month);
ds. w3 b7. ; end;
rl. w1 b3. ; print time:
rl. w0 b7. ; file:= (b3); saved file
jl. w3 b22. ; outsp
jl. w3 b22. ; outsp
al w3 0 ;
se. w3 (b35.) ; if iso then year
rl. w0 b10. ;
jl. w2 b24. ; outinteger (<<zd>,date or year);
jl. w3 b23. ; outdot;
rl. w0 b6. ;
jl. w2 b24. ; outinteger (<<zd>, month);
jl. w3 b23. ; outdot;
rl. w0 b10. ;
al w3 0 ;
se. w3 (b35.) ; if iso then date
rl. w0 b7. ;
jl. w2 b24. ; outinteger(<<zd>,year or date);
jl. w3 b22. ; outspace;
jl. w3 b22. ; outspace;
rl. w0 b9. ;
jl. w2 b24. ; outinteger(<<zd>,hour);
jl. w3 b23. ; outdot;
rl. w0 b8. ;
jl. w2 b24. ; outinteger(<<zd>,min);
\f
; fgs 1989.03.13 fp utility, job adm 1, page 16
al w0 0 ;
sn. w0 (b36.) ; if cpu then
jl. b42. ; begin
jl. w3 b23. ; outdot
rl. w0 b5. ;
jl. w2 b24. ; outinteger(<<zd>,ms)
al. w0 b46. ;
jl. w3 h31. ; outtext( cpu: )
am -2000 ;
am. (h16.+2000) ;
dl w3 56 ; w2w3:=run time own process
al w0 0 ;
rl w1 104 ; w0w1:=time slice
aa w1 6 ; +time slice
nd w1 3 ; float
fd. w1 b43. ; w0w1:=time in sec
ds. w1 b8. ;
fs. w1 b44. ; -0.5
cf w1 0 ; convert to integer
rs. w1 b5. ; save seconds
ci w1 0 ; convert back
ds. w1 b10. ;
dl. w1 b8. ;
fs. w1 b10. ; decimals
fm. w1 b45. ;
cf w1 0 ; convert to integer
se w1 100 ;
jl. b51. ; if decimals=100 then
rl. w1 b5. ; begin
al w1 x1+1 ; seconds:=seconds+1;
rs. w1 b5. ; decimals:=0;
al w1 0 ; end;
b51: rs. w1 b6. ; save decimals
rl. w1 b3. ;
rl. w0 b5. ;
jl. w3 h32. ; outinteger(<<d>,seconds)
1 ;
jl. w3 b23. ; outdot
rl. w0 b6. ;
jl. w2 b24. ; outinteger(<<zd>,decimals)
al. w0 b39. ;
jl. w3 h31. ; outtext( sec.)
b42: jl. w3 b26. ;
b25: rl. w1 b3. ;
se. w1 b1. ; if not left hand side
jl. e24. ; in call then goto param end;
am -2048 ;
jl. w3 h95.+2048 ; close up as should be
jl. w3 h79. ; terminate zone (left hand file);
jl. e24. ; goto param end;
\f
; fgs 1989.03.13 fp utility, job adm 1, page 17
b26: am -22 ; outcr : char:='nl';
b22: am -14 ; outspace: char:=' ';
b23: al w2 46 ; outdot: char:='.';
jl. h26. ; outchar (i); return;
b24: jl. w3 h32. ; outinteger (<zd>,integer);
48<12+2 ; layout for z;
jl x2 ; return;
e46=b15 ; print entry point
e. ; end head;
e48=k ; start of head output zone;
\f
; fgs 1989.03.13 fp utility, job adm 1, page 18
; the fp program finis (output.(yes/no)) (text)
b. b24 ; begin
w. ;
b3: <:c:>,0,0,0 ;
b4: <:v:>,0,0,0 ;
b5: <:no:> ;
b6: <:yes:> ;
b7: <:out:> ;
b8: <:put:> ;
b9: 1<0 ;
b10: 128<12 + 0 ; MCL message:
0 ; localid
12<12 + 15 ; no of characters
0, r.5 ; text (1:5)
b11: <:menu<0>:> ;
b12:<: ok no<0>:>;
<: ok <0>:>;
<:warning, ok no<0>:>;
<:warning, ok <0>:>;
b13: 3 ; mask for extract 2
b14: 10 ; constant
\f
; fgs 1989.03.13 fp utility, job adm 1, page 19
; finis:
e3: jl. w1 e13. ; init param;
jl. w1 e29. ; test call error;
al. w1 b23. ; return from list: after param;
rs. w1 e14. ;
al w1 4 ; modify return
hs. w1 e33.+1 ; after error;
am -2000 ;
rl. w3 h51.+2000 ; text addr := addr ( case (warning.ok) of (
ls w3 -5 ;
la. w3 b13. ; <: ok no:>,
wm. w3 b14. ; <: ok :>,
al. w2 b12. ; <:warning, ok no:>,
wa w2 6 ; <:warning, ok :>) );
dl w0 x2+2 ; move
ds. w0 b10.+8 ; text
dl w0 x2+6 ; from
ds. w0 b10.+12 ; constant text area
rl w0 x2+8 ; to
rs. w0 b10.+14 ; message.text area;
\f
; fgs 1989.03.13 fp utility, job adm 1, page 20
; finis:
b20: jl. w3 e25. ; nextparam:
; w0=sep,w1=kind,w2=pointer,w3=nextsep
jl. b23. ; return if end
jl. b21. ; return if dot
sh w1 9 ; return if space
jl. e18. ; if param<>text then alarm;
se w3 8 ; if nextsep<>dot
jl. b19. ; then gettext;
rl w0 x2+2 ; if param<>output
se. w0 (b7.) ; then
jl. b21. ; goto not output;
rl w0 x2+4 ;
se. w0 (b8.) ;
jl. e18. ;
rl. w3 h45.+6 ; mess+6
rl w0 x2+12 ; if
sn. w0 (b5.) ; <:no:>
lo. w3 b9. ; then mess+6:=mess+6 or 1<0;
rs. w3 h45.+6 ;
sn. w0 (b5.) ; if <:no:>
jl. b22. ; then goto update;
se. w0 (b6.) ; if not <:yes:>
jl. e18. ; then alarm;
ac. w3 (b9.) ; if
al w3 x3-1 ; <:yes:>
la. w3 h45.+6 ; then
rs. w3 h45.+6 ; remove bit;
b22: rl. w3 e17. ; get param pointer;
ba w3 x3+1 ; update;
rs. w3 e17. ;
jl. b20. ; goto next param;
b19: al w0 0 ; get text:
rs. w0 b10.+14 ; zero message.text area.last word;
dl w0 x2+4 ;
ds. w0 b10.+8 ; move
dl w0 x2+8 ; text
ds. w0 b10.+12 ; from
rl w0 x2+10 ; param
se w1 10 ; to
rs. w0 b10.+14 ; message area;
jl. b20. ; goto next param;
\f
; fgs 1989.03.13 fp utility, job adm 1, page 21
b21: jl. e18. ; not output: alarm;
b23: am -2000 ;
am. (h16.+2000) ; after param:
dl w1 +78 ;
al. w3 b2. ; w3 := addr name (zero);
jd 1<11+72 ; set catbase (std base);
am -2000 ;
rl. w3 h15.+2000 ;
al w3 x3+2 ;
jd 1<11+4 ; w0 := proc descr addr (prim out);
sn w0 0 ; if w0 <> 0 then
jl. b24. ; 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. b24. ; skip;
rl w2 x3+10 ;
rl w3 0 ; restore w3;
dl w1 x2+4 ;
sn. w0 (b11.) ; if prim out.parent.name <> <:menu:> then
se. w1 (b11.+2) ;
jl. b24. ; skip;
al. w1 b10. ;
jd 1<11+16 ; send message (prim out, message);
al. w1 h43. ;
jd 1<11+18 ; wait answer (answer area lowest level);
b24: ; end;
\f
; fgs 1989.03.13 fp utility, job adm 1, page 22
al w2 0 ; close up (cur out,null);
am -2048 ;
; jl. h7.+2048 ; ****************************************
jl. w3 h95.-2+2048;
al w0 0 ;
jl. w3 h79.-2 ; terminate zone (cur out,file mark);
al. w3 b3. ;
jd 1<11+48 ; remove c
al. w3 b4. ;
jd 1<11+48 ; remove v
jl. w3 h14. ; send finis message
jl. -2 ; if not removed then send it again;
\f
; fgs 1989.03.13 fp utility, job adm 1, page 23
; the fp program end
e5: jl. w1 e13. ; end: init param;
jl. w1 e29. ; test call error;
al. w1 e18. ; return from list: more list;
rs. w1 e14. ;
jl. w3 h30.-4 ; unstack current input (cur chain);
al w3 x1+h1+2 ;
bz w1 x3-1 ;
se w1 4 ; if kind(in) = bs
jl. b1. ; then begin
al. w1 b2. ; send message (sense);
jd 1<11+16 ;
jd 1<11+18 ; wait answer
; (in order to get name table
; address under the name)
b1: jl. w3 e25. ; end; next param:
jl. e24. ; get param;
jl. e18. ; goto if sep = end then param end
jl. e18. ; else list param;
b2: 0,r.8 ; message and answer (sense area proc)
e. ; end finis and end;
\f
; fgs 1989.03.13 fp utility, job adm 1, page 24
e45: 1<22 ; bit to disting. asterisk
e47: bl w0 x1+h1+1 ;
sn w0 4 ; if -,bs and
jl. 6 ; -,mt
se w0 18 ; then
jl x3 ; return;
am -2048 ;
al. w1 h54.+2048 ;
rl. w2 e17. ;
al w2 x2-8 ;
; procedure prepare entry for textoutput
; w0 not used
; w1 lookup area
; w2 name addr, entry must be present
; w3 return addr
b. a2 w.
ds. w1 a1. ; save w0.w1
ds. w3 a2. ; save w2.w3
al w3 x2 ; w3:=name addr
jd 1<11+42 ; lookup
bz w2 x1+16 ;
sh w2 32 ; if contents=4 or
sn w2 4 ; contents>=32
jl. 4 ; then
jl. a0. ; file:=block:=0;
rs w0 x1+12 ;
rs w0 x1+14 ;
a0: rs w0 x1+16 ; contents.entry:=0;
rs w0 x1+18 ; loadlength:=0;
dl w1 110 ;
ld w1 5 ; shortclock;
rl. w1 a1. ;
rs w0 x1+10 ;
jd 1<11+44 ; changeentry;
dl. w1 a1. ; restore w0,w1
dl. w3 a2. ; restore w2,w3
jl x3 ; return
0 ; saved w0
a1: 0 ; saved w1
0 ; saved w2
a2: 0 ; saved w3
e.
\f
; fgs 1989.03.13 fp utility, job adm 1, page 25
j1=k-j0
; entry mode
g0: (:j1+511:)>9 ; segm
0, r.4 ; name
s2 ; date
0,0 ; file, block
2<12+f1-h55 ; contents, entry
j1 ; length
; entry head
1<23+4 ; bs
0,r.4 ;
s2 ; date
0,0 ; file, block
2<12+f2-h55 ; contents, entry
j1 ; length
; entry char
1<23+4 ; bs
0, r.4 ;
s2 ; date
0,0 ; file, block
2<12+f7-h55 ; contry
j1 ; length
; entry finis
1<23+4 ; bs
0,r.4 ;
s2 ; date
0,0 ; file, block
2<12+f3-h55 ; contents, entry
j1 ; length
; entry end
g1: 1<23+4 ; bs
0,r.4 ;
s2 ; date
0,0 ; file , block
2<12+f4-h55 ; content, entry
j1 ; lenght
m.rc, fp job adm 1, 1989.03.13
d.
p.<:insertproc:>
l.
i. ; maybe names
e. ; end job adm 1;
e. ; end fp names
▶EOF◀