|
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: »autoload3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »autoload3tx «
autoload=slang
b.
d.p.<:fpnames:>
l.
; autoload
; a utility program for autoload of front end computers.
;
m. autoload 1984.10.05
;
;
; the program can load a front-end connected either via a fpa or via
; a ifp (interface processor adaptor).
; the autoload program will determine the kind of connection
; by inspecting the kind of the main process.
;
;
; the communication takes place either via the transmitter part of a fpa 801
; or, in case of a ifp connection, via a subprocess representing a connection
; to device 0 in the front-end.
; after autoload this program reads commands from the device controller
; simulating a magtape station locally connected to the device controller.
; the load file must be placed on backing storage in consecutive segments.
; the load file consists of a number of records with the format:
; <ident> <data>
; where ident > 0 : size of data block (in characters)
; = 0 : tapemark (datablock empty)
; =-3 : end of tape (datablock empty)
;
; the program is called in this way-
;
; <name of main> =autoload <load area> <start-spec>
;
; <start-spec>==start.yes
; start.no
; <empty>
; where
; <name of main> is the name of the external process that are connected
; to the front end in question,
; <load area> is the name of the file holding the autoload file, and
; <start-spec> is a statement which determines whether the autoload
; should be followed by a start of communication (master
; clear) on the line. the default is 'start.yes'.
; on the ifp connection, the start yes will cause a
; "open gate" to be sent to the front-end.
;
k=h55
s.e10,m10,n10,p10,q10,r10,s40 w.
; counters.
p4=3 ; maxnumber of autoloads
p5=3 ; max number of errors
0, 0
jl. m0. ; start of program: goto start;
b.i20,j10 w.
; reset process.
s0: 4<12+0 ; operation:=reset all subprocesses
; transmit status message.
s1: 5<12+2.11 ; operation:=transmit, mode:=reset, receive
i1: s6. ; first:=first of sense area
i2: s7. ; last:=last of sense area
8 ; charcount:=8
249 ; startchar:=sense block
; transmit status message.
s2: 5<12+2.01 ; operation:=transmit, mode:=receive
i3: s6. ; first:=first of sense area
i4: s7. ; last:=last of sense area
8 ; charcount:=8
249 ; startchar:=sense block
; transmit data block.
s3: 5<12+2.01 ; operation:=transmit, mode:=receive
0 ; first
i5: s24. ; last
0 ; charcount
251 ; strtchar:=data block
; autoload.
s4: 6<12+2.11 ; operation:=autoload, mode:=reset, receive
; dummy
; master clear
s9: 8<12+0 ; operation:=master clear
; dummy
; answer area.
s5: 0 ; status
0 ; bytes transferred (pd.connection after autoload)
0 ; chars transferred
0 ; command character (statuschar)
0, r.4 ; dummy
; sense information area.
s6: 0 ; char0,1:=status(0:15), char2:=size(0:7),
0 ; char3:=size(8:15),char4,5:=filenumber(0:15),
s7: 0 ; char6,7:=blocknumber(0:15)
; name of load device
s8: 0, r.4, 0 ;
s10: 0 ; status
s11: 0 ; size(data)
s12: 0 ; filenumber
s13: 0 ; blocknumber
s14: 0 ; first(record)
s17: 0 ; errorcount
; input message.
s20: 3<12+0 ; operation:=read
i6: s22. ; first:=first of record buffer
i7: s24. ; last:=last of record buffer
0 ; first segment number
; name of load file or bs device.
s21: 0, r.4, 0 ;
; delay message
s25: 0<12 + 2 ; operation := wait;
0, 5000 ; mode := msec; time := 500 msec;
; name of clock
s26: <:clock:>, 0, 0 ; name of clock process;
0 ; name table address ;
; start flag.
s30: 0 ; start flag: =0 no start, <>0 start;
s31= 92 ; kind of ifp mainprocess
s32= 96 ; kind of ifp connection
m0: ; start of program:
se w2 x3-10 ; if no left side in call then
jl. e0. ; goto error0;
dl w1 x2+4 ;
ds. w1 s8.+2 ; name(fpa-main):=left side in call;
dl w1 x2+8 ;
ds. w1 s8.+6 ;
ba w3 x3+1 ;
rl w0 x3 ;
se. w0 (i0.) ; if seperator,lenght(param)<>4,10 then
jl. e0. ; goto error0;
dl w1 x3+4 ;
ds. w1 s21.+2 ; name(load file):=param;
dl w1 x3+8 ;
ds. w1 s21.+6 ;
ba w3 x3+1 ; item:=next item;
rl w0 x3 ; param:=param(item);
se. w0 (i0.) ; if seperator,length(param)=4,10
jl. j0. ; and param=<:start:>
rl w0 x3+2 ;
se. w0 (i10.) ;
jl. j0. ;
ba w3 x3+1 ;
rl w0 x3 ;
; se. w0 (i11.) ; seperator,length(param)<>.,10
; jl. j0. ; and param=<:no:> then
rl w0 x3+2 ; start flag:=0;
sn. w0 (i12.) ;
am 0-1 ; else
j0: al w0 1 ; start flag:=1;
rs. w0 s30. ;
al. w0 i1. ;
wa. w0 i1. ;
rs. w0 i1. ;
al. w0 i2. ;
wa. w0 i2. ;
rs. w0 i2. ;
al. w0 i3. ;
wa. w0 i3. ;
rs. w0 i3. ;
al. w0 i4. ;
wa. w0 i4. ;
rs. w0 i4. ;
al. w0 i5. ;
wa. w0 i5. ;
rs. w0 i5. ;
al. w0 i6. ;
wa. w0 i6. ;
rs. w0 i6. ;
al. w0 i7. ;
wa. w0 i7. ;
rs. w0 i7. ;
al. w3 s21. ;
jd 1<11+52 ; create area process;
se w0 0 ; if result<>0 then
jl. e1. ; goto error1;
al. w3 s8. ;
jd 1<11+8 ; reserve process(name,result);
se w0 0 ; if result<>0 then
jl. e2. ; goto error2;
jl. w3 n2. ; initiate;
jl. r4. ; goto autoload;
i0: 4<12+10 ;
i10: <:sta:> ;
i11: 2<12+10 ; '.'<12+10
i12: <:no:> ;
e.
m2: rl. w0 s5.+6 ; execute:
sn w0 0 ; if command char=0 then
jl. q0. ; goto transmit next block;
sn w0 1 ; if command char=1 then
jl. q1. ; goto retransmit block;
sn w0 2 ; if command char=2 then
jl. q2. ; goto rewind;
sn w0 4 ; if command char=4 then
jl. q3. ; goto upspace block;
sn w0 8 ; if command char=8 then
jl. q4. ; goto upspace file;
sn w0 12 ; if command char=12 then
jl. q5. ; goto end;
sn w0 128 ; if command char=128 then
jl. q6. ; goto sense;
sn w0 255 ; if command char=255 then
jl. q7. ; goto wait;
jl. e6. ; goto error6;
b.j10 w.
; after error, reset and transmit status, receive command.
r1: al w0 0 ; reset,trm status:
rs. w0 s17. ; errorcount:=0;
jl. w3 n3. ; set up status area;
j0: al. w1 s1. ; repeat0: message:=reset,transmit status,receive;
al. w3 s8. ; name:=name(load device);
jl. w2 n1. ; send and wait;
jl. m2. ; ok: goto execute;
al w3 1 ;
wa. w3 s17. ; error: errorcount:=errorcount+1;
rs. w3 s17. ;
sh w3 p5 ; if errorcount=<maxerrorcount then
jl. j0. ; goto repeat0;
jl. e5. ; goto error5;
; transmit status.
r2: jl. w3 n3. ; transmit status: setup status area;
al. w1 s2. ; message:=transmit status;
al. w3 s8. ; name:=name(load device);
jl. w2 n1. ; send and wait;
jl. m2. ; ok: goto execute;
jl. r1. ; error: goto restart;
; transmit data.
r3: rl. w2 s14. ; transmit data:
al w2 x2+2 ; first(data):=first(record)+2;
rs. w2 s3.+2 ; size:=size(data);
rl. w2 s11. ; if size=0 then
sn w2 0 ; size:=1;
al w2 1 ;
rs. w2 s3.+6 ; char count:=size;
al w1 0 ; last(data):= first(data) + (size//3*2) - 2;
al w0 3 ;
al w2 x2+2 ;
wd w2 0 ;
ls w2 1 ;
wa. w2 s3.+2 ;
al w2 x2-2 ;
rs. w2 s3.+4 ;
al. w1 s3. ; message:=transmit block;
al. w3 s8. ; name:=name(load device);
jl. w2 n1. ; send and wait;
jl. m2. ; ok: goto execute;
jl. r1. ; error: goto restart;
; autoload.
r4: al w0 0 ; autoload:
rs. w0 s17. ; errorcount:=0;
al. w1 s0. ; message:=reset;
al. w3 s8. ; name:=name(load dev);
jl. w2 n1. ; send and wait;
jl. j1. ; ok: goto start load;
jl. e3. ; error: goto error3;
j1: al. w1 s4. ; start load: message:=autoload;
al. w3 s8. ; name:=name(load device);
jl. w2 n1. ; send and wait;
jl. j2. ; ok: goto check kind;
al w3 1 ;
wa. w3 s17. ; error:
rs. w3 s17. ; errorcount:=errorcount+1;
sh w3 p5 ; if errorcount=<maxerrorcount then
jl. j1. ; goto repeat;
jl. e4. ; goto error4;
j2: rl. w1 (s8.+8) ; if kind.main= ifpkind then
rl w1 x1 ;
se w1 s31 ; begin
jl. m2. ;
rl. w1 s5.+2 ; move name.connection
dl w0 x1+4 ; to name.load device
ds. w0 s8.+2 ;
dl w0 x1+8 ;
ds. w0 s8.+6 ; end
jl. q0. ; goto transmit next block
e.
; transmit next block.
q0: jl. w3 n0. ; transmit next block: next block;
jl. r3. ; goto transmit block;
; retransmit block.
q1=r3 ; retransmit block: goto transmit block;
; rewind.
q2: jl. w3 n2. ; rewind: transfer command;
jl. r2. ; goto transmit status;
; upspace block.
q3: jl. w3 n0. ; upspace block: next block;
al w3 1<2 ;
sz w0 1<8+1<4 ; if status=end of tape or end of file then
rs. w3 s10. ; status:=position error;
al w3 0 ; size(data):=0;
rs. w3 s11. ;
jl. r2. ; goto transmit status;
; upspace file.
q4: jl. w3 n0. ; upspace file:
sn w0 0 ; while status=0 do
jl. q4. ; next block;
al w3 0 ;
sz w0 1<8 ; if status=end of file then
rs. w3 s10. ; status:=ok;
rs. w3 s11. ; size(data):=0;
jl. r2. ; goto transmit status;
; end.
q5: rs. w0 s33. ; end: save exit code;
sn w0 0 ; if exit code = not ok and no master clear then
jl. q10. ; goto exit;
rl. w1 (s8.+8) ; if kind.rec = connection then
rl w0 x1+0 ; begin
se w0 s32 ;
jl. q9. ;
rl w1 x1+10 ; move name.main
dl w0 x1+4 ;
ds. w0 s8.+2 ; to name.load device
dl w0 x1+8 ;
ds. w0 s8.+6 ; end
q9: al. w1 s9. ; end: message:=master clear;
al. w3 s8. ; name:=name(load device);
rl. w0 s30. ;
sn w0 1 ; if start flag=1 then
jl. w2 n1. ; send and wait;
al. w3 s8. ;
jd 1<11+10 ; release process(name(main));
q10: al w2 0 ; modebits := warning.no, ok.yes;
rl. w3 s33. ;
se w3 12 ; if exit code <> 12 then
al w2 3 ; mode bits := warning.yes, ok.no;
jl. h7. ; goto end program;
s33: 0 ; saved exit code;
; sense.
q6=r2 ; sense: goto transmit status;
; wait.
q7: al. w1 s25. ; wait:
al. w3 s26. ; name := name of clock process;
jl. w2 n1. ; send and wait;
am 0 ;
jl. r1. ; goto receive command;
; error.
q8=r2 ; error: goto transmit status;
; procedure next block.
; this procedure finds the start of the next record.
;
; status: 0 ok
; 1<4 end of tape
; 1<8 end of file
; 1<14 disc error
;
; call: return:
; w0 status
; w1 size(data)
; w2 destroyed
; w3 link destroyed
b.i4,j4 w.
i0: 0 ; saved link
i1: 3 ; constant
i2: 1<14 ; disc error
i3: 1<18 ; end medium
n0: rs. w3 i0. ; next block:
rl. w1 (s14.) ;
sl w1 -3 ; if size(data)<-3
sl w1 768 ; or size(data)>=512 then
jl. e7. ; goto error7;
al w1 x1+2+3 ; first(next record):=
al w0 0 ; (size(data)+3)+2)//3*2+first(record);
wd. w1 i1. ;
ls w1 1 ;
wa. w1 s14. ;
rs. w1 s14. ; first(record):=first(next record);
sh. w1 s23. ; if first(record)>first(buf)+510 then
jl. j0. ; first(record):=first(record)-512;
al w1 x1-512 ; first segmentno:=first segmentno+1;
rs. w1 s14. ;
al w0 1 ;
wa. w0 s20.+6 ;
rs. w0 s20.+6 ;
al. w1 s20. ; message:=input;
al. w3 s21. ; name:=name(load file device);
jl. w2 n1. ; send and wait;
jl. j0. ; ok: goto cont;
rl. w3 s6.+2 ; error:
sn. w1 (i3.) ; if status=end medium
se w3 512 ; and bytes transferred=1 segment then
jl. j4. ; goto cont;
jl. j0. ;
j4: rl. w0 i2. ; status:=discerror;
al w1 0 ; size:=0;
dl. w3 s13. ; fileno:=fileno, blockno:=blockno;
jl. j3. ; goto exit;
j0: rl. w1 (s14.) ; cont:
sh w1 0 ; if ident(record)>0 then
jl. j1. ; size(data):=ident(record);
al w0 0 ; status:=0;
dl. w3 s13. ; filenumber:=filenumber;
al w3 x3+1 ; blocknumber:=blocknumber+1;
jl. j3. ; else
j1: se w1 0 ; if size(record)<>0 then
am 1<4-1<8 ; status:=end of tape
al w0 1<8 ; else status:=end of file;
j2: al w1 0 ; size(data):=0;
al w2 1 ; filenumber:=filenumber+1;
wa. w2 s12. ; blocknumber:=1;
al w3 1 ;
j3: ds. w1 s11. ; exit:
ds. w3 s13. ;
jl. (i0.) ; return;
e.
; procedure send and wait.
; the procedure returns to link in case of result ok (which is
; status=0 and result=1), else to link+2.
; call: return:
; w0 result
; w1 message status
; w2 link destroyed
; w3 name destroyed
b.i0 w.
n1: rs. w2 i0. ; send and wait:
jd 1<11+16 ; send message;
al. w1 s5. ; answer area:=std answer area;
jd 1<11+18 ; wait answer;
rl. w1 s5.+0 ; if result<>1
rl. w2 i0. ;
sn w0 1 ; or status<>0 then
se w1 0 ; return to link+2
jl x2+2 ; else return to link;
jl x2+0 ;
i0: 0 ; saved link
e.
; procedure transfer command.
; call return:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link unchanged
b.w.
n2: ld w1 -100 ; initiate:
ds. w1 s11. ; status, size:=0,0;
al w0 1 ;
rs. w0 s12. ; filenumber:=1;
rs. w0 s13. ; blocknumber:=1;
al w0 -1 ;
rs. w0 s20.+6 ;
al w0 768-3 ; assure that first and second segment are
rs. w0 s22. ; transferred to core first time the
al. w0 s22. ; record buffer are used;
rs. w0 s14. ;
jl x3 ; exit: return;
e.
; procedure setup status area.
; call: return:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed
b.w.
n3: rl. w0 s10. ; setup status area:
rl. w1 s11. ;
se w0 0 ; if status<>ok then
al w1 0 ; size(data):=0;
ls w1 8 ;
ld w1 8 ;
lo. w1 s12. ; sense status area:=
rl. w2 s13. ; status(0:15)<8+size(0:7),
ls w2 8 ; size(8:15)<16+filenumber(0:15),
ds. w1 s6.+2 ; blocknumber(0:15)<8;
rs. w2 s6.+4 ;
jl x3 ; exit: return;
e.
; error messages and termination of program.
;
b.i30,j10 w.
i0: <:call<0>:>
i1: <:load file connect error, result <0>:>
i2: <:reservation of main impossible, <0>:>
i3: <:error at reset,<0>:>
i4: <:error at autoload,<0>:>
i5: <:error at transfer,<0>:>
i6: <:illegal command received, value <0>:>
i7: <:illegal format of load file<0>:>
i10: <:***autoload <0>:>
i11: <: result <0>:>
i12: <: status <0>:>
i20: 0 ; saved w0 (result)
i21: 0 ; saved w1 (status)
i22: 0 ; addr of errortext
i23: 0 ; saved w3
e0: am i0-i1 ; error0:
e1: am i1-i2 ; error1:
e2: am i2-i3 ; error2:
e3: am i3-i4 ; error3:
e4: am i4-i5 ; error4:
e5: am i5-i6 ; error5:
e6: am i6-i7 ; error6:
e7: al. w2 i7. ; error7:
ds. w1 i21. ; save w0, w1;
ds. w3 i23. ; save addr of errortext, w3;
al. w0 i10. ;
jl. w3 h31.-2 ; outtext(curr,<:***autoload:>;
rl. w0 i22. ;
jl. w3 h31.-2 ; outtext(curr, errortext);
rl. w1 i20. ;
sn. w0 i1. ; if error=error0 then
jl. j2. ; goto exit;
se. w0 i2. ; if error=error1
sn. w0 i7. ; or error=error6 then
jl. j1. ; goto writenumber;
dl. w1 i21. ;
sn w0 1 ; if result<>ok then
am i12-i11 ; outtext(curr,<: result :>;
al. w0 i11. ; outinteger(curr,saved w0);
jl. w3 h31.-2 ; else
dl. w1 i21. ; outtext(curr,<: status :>);
sn w0 1 ; outinteger(curr,saved w1);
j1: al w0 x1 ;
jl. w3 h32.-2 ;
1 ;
j2: al w2 10 ;
jl. w3 h26.-2 ; outchar(curr,<nl));
am -2048 ;
jl. w3 h95.+2046 ; close up text output (out);
rl. w0 i22. ; exit code :=
sh. w0 i3. ; if error <= error3 then 0
al w0 0 ; else addr of errortext ;
jl. q5. ; goto end;
e.
s22=k ; start of record buffer
s23=s22+510 ; last of first segment in record buffer
s24=s22+512*2-2 ; last of record buffer
e.
m. autoload 1984.10.05
e.e. ; end of program.
▶EOF◀