|
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: 21504 (0x5400)
Types: TextFile
Names: »i4tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »i4tx «
; the programs are translated like
; (i=slang text entry.no
i o if)
b.g1, f4 w.
\f
\f
; rc 16.04.72 fp utility, job adm 2, page 1
; file processor: basic job administration 2
; i, o, if, init, help programs.
; leif svalgaard, july 1969
d.
p.<:fpnames:>
l.
s. k=h55, e50, j1 ; begin
w. ;
j0: j1 ; length
0 ; not used
e0:
f1: jl. w2 e1. ; entry 4:
<:*i :>, e48 ; i
f2: jl. w2 e2. ; entry 10:
<:*o :>, e48 ; o
f3: jl. w2 e3. ; entry 16:
<:*if:>, e47 ; if
jl. w2 e4. ; entry 22:
<:*init :> ; init
jl. w2 e5. ; entry 28:
<:*help :> ; help
e9: <:<10>**:> ; second time error text start
e10: <:<127>**:> , 0 ; first time error text start
e11: 0 ; with room for program name
e31: <:param:> ; param error message
e12: <:call:> ; call error message
e13: rs. w3 e17. ; procedure init param: w1=link
dl w0 x2+2 ; param pointer:= w3;
ds. w0 e11. ; set program name in
rl. w3 e17. ; error message.
jl x1 ; return;
e6: jl. e22 ; instruction : goto break
e7: <:c:> , 0, 0, 0 ; name of primary output
e8: 0 ; addr ; return address in param end
e14: 0 ; addr ; return address in list param
e15: 0 ; e15+1 ; booleans ok,call error
e16: 0 ; pointer ; saved param pointer
e17: 0 ; pointer ; current param pointer
e44: 0 ; work ; free cell
e45: 0 ; work ; free cell
e46: 0 ; work ; free cell
e49: 0 ; addr ; return address in connect prim out
e47= 32<16+127<8+127 ; space,delete,delete
e48= 127<16+127<8+127 ; 3 deletes
; 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;
; param end:
rs. w3 e8. ; param end:
e24: bz. w2 e15.+1 ; param text is replaced by
dl. w1 e12.+2 ; call error text in message;
ds. w1 e12.-2 ; if call error then
al. w0 e10. ; outtext (cur out, <:***...call:>);
se w2 0 ; return via (e8);
jl. w3 h31.-2 ;
jl. (e8.) ;
\f
; rc 28.07.71 fp utility, job adm 2, page 2
; 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, >:***...para,:>);
al w0 1 ; ok:= false;
hs. w0 e15. ;
rl. w2 e16. ;
rs. w2 e17. ; param pointer:= saved param pointer;
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
sn w1 10 ; outinteger (cur out, <<d>, param);
jl. w0 h31.-2 ;
rl w0 x2+2 ; insert nl in front of ***;
jl. w3 h32.-2, 1 ;
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;
jl. e24. ;
jl. e19. ; return via (e14);
jl. (e14.) ;
; procedure get param.
; w0 separator
; w1 kind
; w2 param pointer
; w3 link next sep; call+2:end;+4:dot;+6:space
e21: 0 ; return addr ; point depends on current separator
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 ; comment: used by list param;
rs. w2 e16. ; determine return:
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 via (e21);
; procedure clear bits.
; link in w2
e36: al w3 -1-1<5-1<6 ; clear bits:
la. w3 h51. ; fp mode bit (ok):= false;
rs. w3 h51. ; fp mode bit (dump):= false;
jl x2 ; return;
\f
; rc 76.02.02 fp utility, job adm 2, page ...2a...
; procedure connect primary output.
; link in w3
e37: rs. w3 e49. ; save link;
al. w2 e7. ; connect primary out:
e22 = h10+h76-e37 ; relative address of the fp break-routine
rl. w0 e6. ; set return to break, to prevent more
rs. w0 e37. ; than one connect to console;
al w0 0 ; if ...c... not available then
; no creation of area;
jl. w3 h28.-2 ; connect output (cur out, c-note);
se w0 0 ; if not ok
jl. h60. ; then initialize fp;
jl. (e49.) ; return;
\f
; rc 1.7.69 fp utility, job adm 2, page 3
; procedure search name (list); w1=list pointer, w3=link
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 will point to
sn w0 (x1+6) ; an output 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 ; comment: the name list is ter-
jl. e26.+2 ; minated by a zero word;
jl. e18. ;
; name list format: <4 words name> <1 word output value> ... 0
; the fp program if:
; if <s> <bits>.<on>
b. b24 ; begin
w. ; if:
e3: jl. w1 e13. ; init param;
jl. w1 e29. ; test call error;
al. w1 b0. ; return param end:= test skip;
al. w2 b8. ; return list param:= test kind;
ds. w2 e14. ;
b1: jl. w3 e25. ; next param pair:
jl. e24. ; get param; if sep=end then goto
jl. e18. ; param end; if sep=dot then list param;
b8: se w1 10 ; test kind:
jl. b2. ; if kind=integer then goto shift;
al. w1 b20. ; search option:
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 condition:
jl. e18. ; get param;
se w1 10 ; if sep><dot
jl. e18. ; or kind<>name
al. w1 b21. ; then list param;
jl. w3 e26. ; search name (on table,param,jump);
rl. w3 b10. ; if not found then goto list param;
jl x1+8 ; goto jump;
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 ; bits:= 1 shift (23-param);
al w0 1 ; goto check on condition;
ls w0 x1 ;
jl. b4. ;
b10: 0 ; bits
\f
; rc 01.11.72 fp utility, job adm 2, page 4
; option table for if
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
<:all:> , 0, 0, 0, 2.111111111111111101111111
0 ; terminate option table
; on table for if
b21: <:yes:> , 0, 0, 0, jl.b5.
<:no:> , 0, 0, 0, jl.b6.
0 ; terminate on table
b5: lo. w3 e45. ; yesbit:
ac w0 x3+1 ; yes:=yes or bits;
la. w0 e46. ; no:= no and inverse(yes);
ds. w0 e46. ; goto next param pair;
jl. b1. ;
b6: lo. w3 e46. ; nobit:
ac w0 x3+1 ; no:= no or bits;
la. w0 e45. ; yes:= yes and inverse (no);
rx w3 0 ; goto next param pair;
jl. b5.+6 ;
b0: rl. w3 h51. ; test skip:
sz. w3 (e46.) ; if fp mode bits do not
jl. b7. ; correspond to selected bits
so. w3 (e45.) ; then goto skip command;
jl. b7. ;
b9: rl. w0 e15. ; finis:
al w2 10 ; if ok,call <> 0
se w0 0 ; then outchar (cur out,nl);
jl. w3 h26.-2 ;
al w2 1<6+1<5 ; w2:=saved warning and ok bits
la. w2 h51. ; shift -5; comment: the program if
ls w2 -5 ; does not change theese bits;
al w0 1 ;
lx w2 0 ;
e39: jl. h7. ; goto end program;
b7: rl. w2 h8. ; skip command:
ba w2 x2+1 ; cur comm:= cur comm + item size;
bl w0 x2+0 ; separator:= first byte.item;
rs. w2 h8. ;
sn w0 -4 ; if sep= -4 (end stack) then
jl. b11. ; goto set if bit;
se w0 2 ; if sep<> nl then
jl. b7.+2 ; goto skip current;
\f
; rc 15.4.71 fp utility, job adm 2, page 4a
al w0 0 ; skip next: w0<>0 means command skipped
al w1 0 ; w1 is parenthes counter;
b12: rs. w2 h8. ; store parameter pointer;
bl w3 x2+1 ; w3 := size(item);
sl w3 4 ; if size(item) >= 4
al w0 1 ; then w0 := 1;
ba w2 x2+1 ; w2:=address of next item;
bl w3 x2+0 ; w3:=seperator;
sn w3 -4 ; if seperator=end stack then
jl. b13. ; goto end skip;
sn w3 0 ; if seperator = (
al w0 1 ; then w0 := 1;
se w3 2 ; if seperator=nl
jl. b14. ; and
sl w1 1 ; par.count <= 0
jl. b14. ; and
se w0 0 ; command skipped, then
jl. b9. ; goto finis
b14: se w3 -2 ; if seperator = )
jl. b15. ; then
se w1 0 ; if par.count <> 0
am -1 ; then
al w1 x1+0 ; par.count := par.count - 1
b15: sn w3 0 ; if sep. = (
al w1 x1+1 ; then par.count:=par.count+1;
bl w3 x2+1 ; w3:=lenght of item
sl w3 4 ; if lenght(item) >= 4
al w0 1 ; then w0 := 1;
jl. b12. ; continue skipping;
b13: se w0 0 ; end skip: if command skipped
jl. b9. ; then goto finis else
b11: al w0 1<7 ; set if bit:
lo. w0 h51. ; fp mode bit (7):= 1;
rs. w0 h51. ; goto finis;
jl. b9. ;
e. ; end if;
\f
; rc 16.4.72 fp utility, job adm 2 page 5
; the fp programs i & o:
; i <s> <file> , o <s> <file>
b. b24 ; begin
w. ;
e1: am -4 ; i: text:= ***i or
e2: al. w0 b24. ; o: text:= ***o;
rs. w0 e46. ;
jl. w1 e13. ; init param;
jl. w1 e29. ; test call error;
al. w1 b18. ; return param end:= fresh fp;
al. w2 b8. ; return list param:= test kind;
ds. w2 e14. ;
al. w3 b11. ; set addr for jump
rs. w3 e0.-2 ; to fresh fp;
b1: jl. w3 e25. ; next param: get param;
jl. b18. ; if sep=end then goto fresh fp;
jl. e18. ; if sep=dot then goto list param;
b8: sn w1 10 ; test kind: if kind<>name
sl w3 3 ; or next sep<>end
jl. e18. ; then goto list param;
rs. w2 e44. ; save param pointer;
rl. w0 e46. ;
sn. w0 b24. ; goto case addr(text) of
jl. b2. ; (i,o);
; i program:
b3: jl. w3 h29.-4 ; i: stack (cur in,cur chain);
am. (e44.) ; file:= param pointer+2;
al w2 2 ; connect input (cur in,file);
jl. w3 h27.-2 ; if result=ok (0)
al. w3 b4. ; then set name table address
sn w0 0 ; with return to
jl. e50. ; set i-bit;
b5: al. w3 b11. ; connect error:
rs. w3 e0.-2 ; set return(fresh fp);
rx. w0 e46. ; b5+2: save return;
jl. w3 h31.-2 ; outtext (cur out,text);
al w0 x2+2 ;
jl. w3 h31.-2 ; outtext (cur out,document name);
al w1 10 ;
wm. w1 e46. ; outtext (cur out,resulttext);
al. w0 x1+e40. ;
jl. w3 h31.-2 ; outend (cur out,nl);
b18: jl. w3 h39. ;
jl. (e0.-2) ; return;
b19: 0,r.4 ; name
\f
; fgs 1988.09.08 fp utility, job adm 2, page 6.
b23: <:***i :> ; program names
b24: <:***o :> ; connection result texts:
b22: <: no resources:> ; 1: claim
<: disconnected :> ; 2: error
<: name unknown:> ; 3: exist 3 exist
<: kind illegal:> ; 4: kind mode=0
<: reserved:> ,0,0 ; 5: 1 reserv
<: name format:>,0 ; 6: name
e40=b22-10 ; catalog. initialize. other.
b4: al w0 1 ; set i-bit:
lo w0 x1+h2+0 ; i-bit.cur input:= 1;
rs w0 x1+h2+0 ; comment: cleared by stack zone;
b15: jl. w3 e24.-2 ; end action: param end;
rl. w0 e15. ;
se w0 0 ; if ok<>0 then
b20: jl. w3 h39. ; outend (cur out,nl);
se w0 0 ;
am 1 ; w2:= ok condition;
e41: al w2 0 ; goto end program;
jl. e39. ;
b11: al w2 25 ; fresh fp:
jl. w3 h34.-2 ; close up (current out,em);
al w0 0 ;
jl. w3 h79.-2 ; terminate zone (cur out,file mark);
jl. w2 e36. ; clear bits;
b12: jl. w3 h30.-4 ; for name:= cur chain while name<>0
rl w0 x2 ; do unstack (cur input,cur chain);
se w0 0 ;
jl. b12. ; call and enter init fp;
jl. h60. ;
b2: al. w1 h21. ; o:
bz w3 x1+h1+1 ;
se w3 4 ; char := if kind(curr out) = 4
sn w3 18 ; or kind(curr out) = 18 then
am 25 ; end-medium
al w2 0 ; else null;
jl. w3 h34.-2 ; close up (cur out,char);
al w0 0 ;
jl. w3 h79.-2 ; terminate zone (cur out,file mark);
bz w2 x1+h1+1 ; the outputfile must be reduced to the
al w3 x1+h1+2 ; absolute minimum, in case of backing storage:
al. w1 h54. ;
jd 1<11+42 ; lookup entry(outfilename, tailaddr);
rl w0 x3+14 ; tail(0) := segment count (output zone);
rs w0 x1 ;
sn w2 4 ; if kind(output zone) = <bs> then
jd 1<11+44 ; change entry(outfile name, tail);
al w0 1<2+0 ; connect the new file: (permkey zero, one segment)
am. (e44.) ;
al w2 +2 ; file:= param pointer+2;
rl w1 x2 ; if name = <:c:>
sn. w1 (e7.) ; then
al w0 0 ; then no creation of area;
jl. w3 h28.-2 ; connect output (cur out, file);
\f
; rc 76.05.20 fp utility, job adm 2, page ...6a...
b9: al. w3 b6. ; if result = ok
sn w0 0 ; then set name table address with
jl. e50. ; return to change;
rs. w0 e45. ;
rl. w2 e44. ;
dl w1 x2+4 ; save document name;
ds. w1 b19.+2 ;
dl w1 x2+8 ;
ds. w1 b19.+6 ;
jl. w3 e37. ; connect console;
al. w2 b19.-2 ; doc name pointer;
rl. w0 e45. ; connect error;
jl. w3 b5.+2 ; fp result := 1;
jl. e41.-2 ; goto fp end program;
b6: rs w0 x2+16 ; change:
rs w0 x2+18 ; content:=entry:=length:= 0;
rl. w3 e44. ;
al w3 x3+2 ; if file was a note
al. w1 h54. ; then goto end action;
se w1 x2 ;
jl. b7. ; lookup (file);
al w2 x3 ; w2:=name addr
jl. w3 b13. ; prepare entry for textoutput
b7: jl. b15. ; goto end action
b13:
al. w1 h21. ;
bl w0 x1+h1+1 ; if -,bs and
sn w0 4 ; -,mt
jl. 6 ; then
se w0 18 ; return;
jl x3 ;
al. w1 h54. ; w1:=lookup area;
; 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.
e. ; end i&o;
;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
e50: 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 x1h1+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.
\f
; rc 1.7.69 fp utility, job adm 2, page 7
; init
e4: jl. h60. ; goto init fp;
; help
e5: al. w0 e38. ; outtext( help info);
jl. w3 h31.-2 ; goto end program;
jl. e41. ;
e38: <:<10>******help information
intended for basic system information for the present installation.
sorry, that was all for the moment.
:>
j1=k-j0
; entry i
g0: (:j1+511:)>9 ; segm
0, r.4
s2 ; date
0,0 ; file, block
2<12+f1-h55 ; contents, entry
j1 ; length
; entry o
1<23+4 ; bs
0,r.4
s2 ; date
0,0 ; file, block
2<12+f2-h55 ; contents, entry
j1 ; elngth
; entry if
g1: 1<23+4 ; bs
0,r.4
s2 ; date
0,0 ; file , block
2<12+f3-h55 ; content, entry
j1 ; lenght
m.fp job adm 2, 1988.09.08
d.
p.<:insertproc:>
l.
i. ; maybe names
e. ; end job adm 2
e. ; end fp names
\f
▶EOF◀