|
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: 52224 (0xcc00)
Types: TextFile
Names: »fptext1«, »kkfptxt1«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦84635a524⟧ »kkmon4filer«
└─⟦this⟧
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦f781f2336⟧ »kkmon0filer«
└─⟦this⟧
\f
; rc 19.02.73 file processor, permanent, page ...1...
b. h99, c31, j131 ; begin global block
m.file processor 76.02.02 system 3
; slang structure:
;
; b. h99, c31, j131 ; global block
;
; s. k=0, h99, c31 ; permanent fp, resident io
; e. ; drum segments 0,1,2
;
; s. k=h13, e48 ; simple check
; e. ; segment 3
;
; s. k=h13, e48 ; connect input
; e. ; segment 4
;
; s. k=h13, e48 ; connect output
; e. ; segment 5, 6
;
; s. k=h13, e48 ; stack medium
; e. ; segment 7
;
; s. k=h13, e48 ; unstack medium
; e. ; segment 8
;
; s. k=h13, e48 ; magtape check
; e. ; segment 9
;
; s. k=h13, e48 ; terminate zone
; e. ; segment 10
;
; transient parts:
;
; s. k=h55, e48 ; initialize fp
; e. ; segment 11
;
; s. k=h55, e48 ; command assembly
; e. ; segment 12,13
;
; s. k=h55, e48 ; load program
; e. ; segment 14
;
; s. k=h55, e48 ; end program action
; e. ; segment 15
;
; s. k=h55, e48 ; device errors
; e. ; segment 16
;
; e. ; end global block
;
\f
; rc 76.02.02 file processor, permanent, page ...2...
; resident file processor
s. k=0, h99, c43 ; begin permanent
w. ; and resident parts:
; when created and started by the parent process the file
; processor is entered at the second word with:
;
; w0 = description address (prim input)
; w1 = irrelevant
; w2 = description address (prim output)
; w3 = own process description address
; ex = 0
; ic = second word of own process
h12: 1536 ; fp base: on drum size of first bin segment
; during execution first address of process;
h10: ds. w1 h17. ; ia: saved w0; upstart:
ds. w3 h16. ; saved w1; save registers;
rl w1 66 ; saved w2;
dl w3 x1+70 ; saved w3; user interval:=
ds. w3 h58. ; saved ex; initial catbase;
jl. h60. ; saved ic; goto init fp;
12 ; saved cause;
h76=16 ; number of bytes i reg dump area
jl. 2, r.(:h10+h76-k+2:)>1;
jl. c40. ; goto break;
c39: rl. w0 h10.+12 ; write cause:
jl. w3 c36. ;
32<12 + 1 ; writeinteger(out,cause);
rl. w0 h10.+10 ;
jl. w3 c36. ; writeinteger(out,instr. count);
1<23+32<12+1 ;
h65: jl. w3 h39. ; end fp: outend(out, nl);
jl. w3 h95. ; close up;
jl. h67. ; parent message(<:break:>);
am 0
; at start: repeat the message to the parent;
c33: ds. w3 c11. ; restore io segment: save(w2,return);
jl. h70. ; call and enter io segment;
c27=h10+8 ; used by stack; saved bad
c30=h10+4 ; device name
\f
; rc 17.08.72 file processor, permanent, page ...3...
; fp stderror:
h68: al w2 x3 ; fp stderror:
al w1 x1+c25 ; w2 := status; w1 := name addr;
; fp end program:
h7: jl. w3 c33. ; fp end program:
ds. w2 c20. ; restore io segment;
sz w2 -4 ; save end conditions;
jl. 4 ; if not device error then
jl. c34. ; goto test modebits;
dl w0 x1+2 ; save document name:
ds. w0 c30. ;
dl w0 x1+6 ;
ds. w0 c27. ; move name of bad device to perm. fp;
c34: dl. w3 h51. ; test modebits:
sz w3 1<4 ; if -,ok and error
sn w2 0 ; or pause
sz w3 1<3 ; then
jl. h65. ; goto end fp;
jl. h63. ; call and enter end program segment;
; load and enter program
h18: ; w1=zone ; load and enter:
jl. w3 h22. ; inblock (prog zone);
al. w1 h12. ; w1:= fp base address;
dl. w3 c12. ; w2,w3:=current pointers;
am. (c13.) ; goto transient base +
jl. h55. ; relative entry.prog zone;
; fp variables in permanent part:
h83: 0 ; users bits in check
h9: 0 ; last of commands
h8: 0 ; current command pointer
c12: 0 ; w1 end prog; or: cur parameter
c20: 0 ; w2 end prog; or:
h51: 0 ; fp mode bits (ok initialized to false);
h50: 0, r.4 ; current name chain
h15: 0 ; process descr addr prim output
h16: 0 ; own process descr addr
0 ; h17-2 ; process descr addr prim input
h17: 0 ; parent descr addr
c8: 0 ; tries.
\f
; rc 76.02.02 file processor, permanent, page ...3a...
b. a3,b2
w.
; dummy notes
h96: 0 ; count of fp syntax errors;
;close up - as it should be:
am c41 ; zone:=curr in;
al. w1 c43. ; zone:=curr out;
h95: bz w2 x1+c42 ; char:=
se w2 4 ; if kind = bs
sn w2 18 ; or kind = mt
am 25 ; then em
al w2 0 ; else null;
jl. h34. ; goto close up
; fp break
c40: jl. w3 c33. ; break: restore io-segment;
rl. w1 h10.+10 ; test breakpoint: w1 := break address + 2;
sh w1 100 ; if address <= 100
jl. b2. ; goto write break (break 10);
bl w0 x1-2 ; w0 := instruction part;
rl. w2 h10.+12 ; if cause = 0 then
sn w2 0 ; begin
bl w2 x1-1 ; w2 := address part;
sh w2 -1 ; if address part >= 0 or
h. se w0, ks ; instruction <> ks then
w. jl. b2. ; goto write break; end;
al. w0 a0. ; outtext(<:<10>*breakpoint<0>:>);
am -2 ;
jl. w3 h31. ;
al w0 x2 ; outinteger ( address part);
jl. w3 h32. ;
1<23 ; layout;
\f
; rc 76.02.02 file processor, permanent, page ...3b...
al w2 -2 ; for w2 := 0 step 2 until 10 do
b0: al. w0 a2. ; begin
jl. w3 h31. ; writecr;
al w2 x2+2 ;
sl w2 12 ;
jl. b1. ;
al. w0 x2+a3. ; outtext( case w2 of
jl. w3 h31. ; (<:w0:>, <:w1:>, <:w2:>,
rl. w0 x2+h10. ; <:w3:>, <:ex:>, <:ic:>));
jl. w3 h32. ; outinteger ( register contents);
1<23+32<12+10 ;
ac. w0 h12. ; w0:= process relative
wa. w0 x2+h10. ; register contents;
jl. w3 h32. ; outinteger ( w0);
1<23+32<12+10 ;
jl. b0. ; end;
b1: rs. w2 h10.+12 ; cause := 12;
dl. w1 h10.+2 ; restore registers;
dl. w3 h10.+6 ;
xl. h10.+9 ;
jl. (h10.+10) ; return;
b2: al. w0 c32. ; write break:
jl. w3 c35. ; outtext(<:<10>***break:>);
jl. c39. ; goto write cause;
a0: <:<10>*breakpoint<0>:>
a2: <:<10>:> ;
a3: <:w0:>, <:w1:>, <:w2:>
<:w3:>, <:ex:>, <:ic:>
0 ; saved initial
h58: 0 ; catbase
0,r.2
; space used by notes - now partly used by breakpoint routine
e.
\f
; rc 76.02.02 file processor, permanent, page ...4...
; current program, zone descriptor
h19: ; part 0:
h0: 0 ; h0+0 base process area
0 ; h0+2 last byte process area
h80 ; h0+4 used share
h80 ; h0+6 first share
h80 ; h0+8 last share
; part 1:
h1: 1<23+4 ; h1+0 1<11+mode, kind
0, r.4 ; h1+2 document name
0 ; h1+10 name table address
0 ; h1+12 file count
0 ; h1+14 block count
0 ; h1+16 segment count
; part 2:
h2: 0 ; h2+0 give up mask
h92: h68 ; h2+2 give up action
0 ; h2+4 not used
0 ; h2+6 used by terminate zone
h19=k ; part 3:
h3: 0 ; h3+0 base of present program block
0 ; h3+2 last byte of program block
0 ; h3+4 length of program block
c13: 0 ; h3+6 relative entry to program block
; part 4:
h4: 0 ; h4+0 used by terminate zone
0 ; h4+2 used by terminate zone
0 ; h4+4 used by terminate zone
h5=k-h0 ; zone descriptor length
h0=h0-h3 , h1=h1-h3 ; redefine relatives so that
h2=h2-h3 , h4=h4-h3 ; part 3 starts at the zone descr addr.
h3=0 , c25=h1+2 ;
; current program, share descriptor (always single buffered)
h80: 0 ; s+0 state (buf addr)
0 ; s+2 first shared
0 ; s+4 last shared
3<12+0 ; s+6 message
0, r.7 ;
0 ; s+22 bytes transferred
h6=k-h80 ; share descr length
\f
; rc 1.7.69 file processor, permanent, page ...5...
; current input, zone descriptor
h20: ; part 0:
0 ; h0+0 base buffer area
0 ; h0+2 last byte of buffer
81 ; h0+4 used share
81 ; h0+6 first share
81 ; h0+8 last share
; part 1:
1<23+8 ; h1+0 1<11+mode, kind
<:console:> ,0 ; h1+2 document name
0 ; h1+10 name table address
0 ; h1+12 file count
0 ; h1+14 block count
0 ; h1+16 segment count
; part 2:
1 ; h2+0 give up mask+ i-bit
h93: h68 ; h2+2 give up action
1<16 ; h2+4 partial word
0 ; h2+6 free parameter
h20=k ; part 3:
0 ; h3+0 record base
0 ; h3+2 last record byte
0 ; h3+4 record length
0, r.4 ; free parameters
; current output, zone descriptor
h21: ; part 0:
0 ; h0+0 base buffer area
0 ; h0+2 last byte of buffer
82 ; h0+4 used share
82 ; h0+6 first share
82 ; h0+8 last share
; part 1:
1<23+8 ; h1+0 1<11+mode, kind
c31: <:console:> ,0 ; h1+2 document name
0 ; h1+10 name table address
0 ; h1+12 file count
0 ; h1+14 block count
0 ; h1+16 segment count
; part 2:
0 ; h2+0 give up mask
h94: h68 ; h2+2 give up action
1<0 ; h2+4 partial word
0 ; h2+6 free parameter
h21=k ; part 3:
0 ; h3+0 record base
0 ; h3+2 last record byte
0 ; h3+4 record length
0, r.4 ; free parameters
; the share descriptors for current input and for current output
; may be placed anywhere. at present they are placed in the re-
; sident part of fp.
\f
; rc 25.05.72 file processor, permanent, page ...6...
; working cells for fp routines:
c0: 0 ; w0 ; save w0 block io
c1: 0 ; w1 ; zone block io
c5: 0 ; w2 ; share block io
c6: 0 ; w3 ; link block io
h84= c6 ;
c2: 0 ; w2 ; share block io
c3: 0 ; w3 ; return block io
c4: 0 ; w0 ; swap fpsegmentation
c7: 0 ; w1 ; swap - -
c9: 0 ; w2 ; swap - -
c11: 0 ; w3 ; swap - -
c14: 0 ; digit string start:
c21: 0 ; w0 ; save w0 resident
c16: 0 ; w1 ; save w1 resident
c23: 0 ; w2 ; save w2 resident
c17: 0 ; w3 ; save w3 resident
c29: 0 , c29=c29+1 ; digitstring end (max 12 pos)
c19: 0 ; w2 ; save w2 outtext/integer/check all
c18: 0 ; w3 ; save w3 - - -
c15: 0 ; w2 ; link innermost level
;used by connect in (reader):
h37: <:clock:>,0,0,0 ; process name, name table address
0, 1 ; message to clock (delay 1 second)
h66: ; answer area for block io:
c10: 0 ; status word
c22: 0 ; number of bytes transferred
c24: 0 ; number of characters transferred
c26: 0 ; file number
c28: 0 ; block number
0, r.3 ; rest of answer
h54: 1<23+0 ; file descriptor: mode,kind
<:documentname:> ; document name (8 bytes);
0 ; name table address
0 ; file
0 ; block
0<12-0 ; content, entry
0 ; length
h99= (:h12+512-k:)/2 ; remaining words on segment
c. -1-h99 m.length error on fp segment 0
m.remove the free parameters in prog zone
z. ;
c. h99-1 ; if remaining bytes > 0
w. 0, r.h99 ; then fill up to 512 bytes
z. ;
c41=h20-h21 ; cf page 3a
c42=h1+1
c43=h21
m.fp permanent 76.02.02
\f
; base of swap segments:
h13=k ; swap base
w. 512 ; not used ; entry at second word
dl. w1 c7. ; restore (w0,w1);
dl. w3 c11. ; restore (w2,w3);
jl x3 ; return;
\f
; rc 16.6.70 file processor, block io, page ...1...
; procedures inblock, outblock, and wait and free.
; registers in call at return
; w0 unchanged
; w1 zone descriptor zone descriptor
; inblock: outblock:
; w2 unchanged
; wait and free:
; w2 share descriptor share descriptor
; w3 link link
b. e48 ; begin
w. e0=k ; io block driver:
; inblock
al. w1 h20. ; (-2): zone:=cur in;
h22: ds. w1 c1. ; inblock: save (w0,zone);
ds. w3 c3. ; save (w2,link);
rl w2 x1+h0+4 ; share:=used share.zone;
e12: al w0 3 ; rep block in: operation:=input;
jl. w3 e10. ; start transport (zone,share);
jl. e6. ; if pending then goto wait in;
jl. e12. ; free: goto rep block in;
; outblock
al. w1 h21. ; (-2): zone:=cur out;
h23: ds. w1 c1. ; outblock: save (w0,zone);
ds. w3 c3. ; save (w2,link);
rl w2 x1+h0+4 ; share:=used share.zone;
e13: al w0 5 ; rep block out: operation:=output;
jl. w3 e10. ; start transport (zone,share);
; if pending then
am e3 ; wait out: return:=rep block out
e7: am e2 ; wait exit: or return:=exit
e6: al. w3 e4. ; wait in: or return:=adjust last;
al w0 0 ; tries:= 0;
rs. w0 c8. ; counts parity errors;
jl. w0 e11. ; wait transport (zone,share,return);
e4: bs. w0 1 ; adjust last:
rs w0 x1+h3+2 ; last byte:= top transferred-1;
e5: dl. w1 c1. ; exit: restore (w0,zone);
dl. w3 c3. ; restore (w2,link);
jl x3 ; goto link;
e3=e13-e5 ; define wait out
e2= e5-e4 ; define wait exit
; wait and free
am h20-h21 ; (-4): zone:=cur in or
al. w1 h21. ; (-2): zone:=cur out;
h48: ds. w1 c1. ; wait and free: save (w0,zone);
ds. w3 c3. ; save (share,link);
; h48 + 4 is entered by terminate zone, to prevent against
; saving registers.
jl. e7. ; goto wait exit;
; states of shares
; = 0 free share
; = 1 transport completed and checked
; > 1 pending transport
; < 0 running child process
\f
; rc 19.05.72 file processor, block io, page ...2...
; start transport
e10: ds. w3 c6. ; start transport:
am (x2+0) ; save (share,link);
se w2 x2+0 ; if share not free then
jl x3 ; no transport: goto link;
hs w0 x2+6 ;
rl w0 x2+2 ; op.message:=operation;
rs w0 x2+8 ; first addr.message:=first shared;
rl w0 x1+h1+16 ;
rs w0 x2+12 ; only significant for backing store:
rl w3 x2+10 ; begin
ws w3 x2+8 ; segment no.:=segment count;
al w3 x3+2 ; segment count:=segment count +
ls w3 -9 ; (last addr-first addr+2)/512;
wa w3 0 ; end;
rs w3 x1+h1+16 ;
al w3 x1+h1+2 ; w3:=name address;
al w1 x2+6 ; w1:=message address;
jd 1<11+16 ; send message(w3,w1,buf);
sn w2 0 ; if buf claim exceeded then
jd 1<11+18 ; provoke interrupt cause 6;
rs w2 x1-6 ; share state:=buf;
al w1 x3-h1-2 ; restore(zone,share,link);
dl. w3 c6. ;
al w2 x2+h6 ; share:=share+share descr length;
sh w2 (x1+h0+8) ; if share>last share then
jl x3+2 ; share:=first share;
rl w2 x1+h0+6 ; transport started:
jl x3+2 ; goto link+2;
; wait transport
e11: ds. w3 c6. ; wait transport
h87: rs w2 x1+h0+4 ; save(share,link);
dl w0 x2+4 ; used share:=share;
al w3 x3-1 ; record base:=first shared-1;
ba. w0 1 ; last byte:=last shared+1;
ds w0 x1+h3+2 ;
al w2 0 ; share state:=free;
rx. w2 (c5.) ; if share was pending
sl w2 2 ; then goto wait for it;
jl. e18. ;
h36: dl. w2 c5. ; return from check: reg irrel.
rl w0 x2+22 ; w1:=zone; w2:=share;
jl. (c6.) ; w0:=top trsf; goto saved link;
e18: al. w1 c10. ; wait for it:
jd 1<11+18 ; w2=buf addr, c10 answer area.
al w3 1 ; wait answer (buf,answer,result);
ls w3 (0) ; status:= 1 shift result;
al w0 0 ; if normal answer (result=1) then
dl. w2 c5. ; status:=status or status word.answer
se w3 1<1 ; else
ds. w0 c22. ; bytes transferred:=0;
lo. w3 c10. ;
\f
; rc 19.05.72 file processor, block io, page ...3...
bz w0 x2+6 ; generate common bits:
sz w0 1 ; w0:= if operation=io
am 6 ; then first addr in message
rl w0 x2+2 ; else first shared;
wa. w0 c22. ; top transferred :=
rs w0 x2+22 ; w0 + bytes transferred;
sh w0 (x2+10) ; if top transferred <= last address
bz w0 x2+6 ; then w0:=operation else w0:=nonsense;
bz w2 x1+h1+1 ; w2:=process kind;
am. (c22.) ; if (bytes transferred=0
sn w1 x1 ; and kind = bs)
se w2 4 ; or
sn w0 5 ; w0 = output then
al w3 x3+1<8 ; add stop bit;
bz. w2 x2+e21. ; index:=device table(proc kind);
se w2 0 ; if index <> 0 then
jl. e20. ; goto determine action;
dl. w1 c24. ; magnetic tape status bits:
ld w2 -23 ;
se w0 0 ; if bytes transferred > 0 then
wd w2 0 ; begin
se w1 0 ; if number of characters * 2
al w3 x3+1<7 ; modulo bytes transferred <> 0
rl. w2 c1. ; then status:=status+word defect bit;
se w0 0 ; incr:=1;
al w1 1 ; end
al w0 0 ; else incr:=0;
aa w1 x2+h1+14 ;
rs w1 x2+h1+14 ; block count:= block count + incr;
sn. w0 (c26.) ; if file count <> file.answer
se. w1 (c28.) ; or block count <> block.answer
al w3 x3+1<6 ; then status:=status+position bit;
ld w2 24 ; index:=0 again;
e20: sz w3 2.111100 ; determine action:
la. w3 e20. ; remove superfluous status bits;
rs. w3 c10. ; answer(0):=final status word;
la w3 x1+h2+0 ; users bits:=status and give up mask;
rs. w3 h83. ; remaining:=status - users bits;
lx. w3 c10. ; if remaining and hard (index)
sz. w3 (x2+e24.) ; is not zero then goto give up;
jl. e26. ; if remaining and special (index)
sz. w3 (x2+e25.) ; is not zero then goto spec action;
jl. e27. ;
h86=k
e19: rl. w3 h83. ; normal action:
sn w3 0 ; if users bits=0
jl. h36. ; then goto return from check;
am -1 ; give up bit:=false;
h88=k ;
e26: al w3 +1 ; give up: give up bit:=true;
lo. w3 c10. ; w3:=status or give up bit;
la. w3 e28. ; leave only official bits;
dl. w2 c5. ; w1,w2:=zone,share;
al. w0 c10. ; w0:=answer address;
jl (x1+h2+2) ; goto give up action.zone;
e27: bz w2 x1+h1+1 ; spec action:
bz. w2 x2+e22. ; c9:= special action number;
ds. w3 c11. ; depending on process kind.
se w2 10 ; if spec action <> 10 then
jl. h71. ; call and enter simple check else
jl. h77. ; call and enter magtape check;
\f
; rc 26.05.72 file processor, block io, page ...4...
; device table containing mask index and special action no.
h. ; bytes
e21=k , e22=k+1 ;
20 , 6 ; ip ; special actions:
20 , 0 ; clock ; 0: give up
8 , 2 ; bs ; 2: area process action
4 , 0 ; drum ; 4: end of medium
12 , 6 ; tw ; 6: timer error
16 , 4 ; tr ; 8: char output
20 , 8 ; tp ; 10: mag tape errors
20 , 8 ; lp
16 , 4 ; cr
0 , 10 ; mt
20 , 8 ; pl
; mask table specifying hard and special errors depending
; on the index selected via the process kind
w.
e24: 8.1107 7031 ; 0: mt
e25: 8.2620 0744 ;
8.7677 7375 ; 4: hard error
8.0100 0400 ; special action
8.7277 7331 ; 8: backing storage
8.0500 0444 ;
8.2757 7375 ; 12: typewriters
8.1000 0400 ;
8.1614 7775 ; 16: readers
8.0100 0000 ;
8.3677 7375 ; 20: char oriented output media
8.1100 0400 ;
e28: 8.7777 4777 ; official bits.
; treatment of status bits for different indices.
; bit error hard special
; 0 4 8 12 16 20 0 4 8 12 16 20
; 0 local * *
; 1 parity * * * * *
; 2 timer * * * * * * *
; 3 overrun * * * * * *
; 4 block l. * * * * * *
; 5 end doc. * * * * * *
; 6 load p. * * * *
; 7 tape mark * * * *
; 8 ring * * * * *
; 9 mode err. * * * * * *
; 10 read err. * * * * *
; 11 card rej. * * * * *
;
; 12 sum err. * * * * * *
; 13 * * * * * *
; 14 * * * * * *
; 15 stop * * * * * *
; 16 defect * * * * * *
; 17 position * * * * * *
; 18 non-exist * * * * * *
; 19 disconn. * * * * * *
; 20 unintell. * * * * * *
; 21 rejected * * * * * *
; 22 normal
; 23 give up * * * * * *
e. ; end block io;
\f
\f
; rc 5.6.70 file processor, character io, page ...1...
; input/output on character level
; procedures inchar, outchar, outend, close up.
; registers in call at return
; w0 unchanged
; w1 zone descriptor zone descriptor
; w2 out: character in: character
; w3 link link
; after output the contents of register w2 is undefined.
b. e48 ; begin
w. ; character io:
; inchar:
al. w1 h20. ; (-2): zone:= current input zone;
h25: rx w3 x1+h2+4 ; inchar:
al w2 0 ; w2:= front char.partial word;
ld w3 8 ; partial word:= partial word shift 8;
sn w3 0 ; if partial word=0 then
jl. e1. ; no more: goto inword;
rx w3 x1+h2+4 ; return;
jl x3 ;
e1: rl w3 x1+h3 ; inword:
al w3 x3+2 ; record base := record base + 2;
rs w3 x1+h3 ; test empty:
e2: sl w3 (x1+h3+2) ; if record base >= last byte then
jl. e6. ; goto next block;
rl w3 x3+2 ; partial word :=
al w2 0 ; record(record base+2);
ld w3 8 ; char := partial word (bit 0 - 7);
al w3 x3+1 ; partial word := partial word
rx w3 x1+h2+4 ; shift 8 + empty bit;
jl x3 ; return;
e6: jl. w3 h22. ; next block:
rl w3 x1+h3 ; inblock;
jl. e2. ; goto test empty;
; outchar:
al. w1 h21. ; (-2): zone:= current output zone;
h26: rx w3 x1+h2+4 ; outchar:
sz. w3 (e3.) ; if last in partial word
jl. e4. ; then goto outword;
ls w3 8 ; partial word:= character
lo w3 4 ; + partial word shift 8;
rx w3 x1+h2+4 ; return;
jl x3 ;
e4: ls w3 8 ; outword: partial word:=
lo w2 6 ; partial word shift 8 + character;
rl w3 x1+h3 ;
al w3 x3+2 ;
rs w3 x1+h3 ; record base := record base + 2;
rs w2 x3 ; record(record base) := partial word;
al w2 1 ;
rx w2 x1+h2+4 ; partial word := 1<0; (empty)
rx w2 6 ; restore return;
sl w2 (x1+h3+2) ; if record base >= last byte then
jl. h23. ; goto outblock;
jl x3 ; return;
\f
; rc 26.03.73 file processor, character io, page ...2...
e3: 1<16 ; mask for last in partial;
; special entries:
; in all cases a jump to the word just before the official entry
; will select one of the current zones as the zone parameter in
; w1. the procedure outend is often used in connection with
; the null and with the nl character; therefore special entries
; (-6 and -4) are provided for those. current output zone is
; always selected when using the special entries -6 and -4.
; outend:
h59: am -10 ; (-6): char:= null
h39: al w2 +10 ; (-4): char:= nl
al. w1 h21. ; (-2): zone:= current output zone;
h33: rs. w2 c2. ; outend:
bz w2 x1+h1+1 ; if kind <> console
se w2 8 ; or kind <> punch
sn w2 12 ; or kind <> printer
jl. e8. ; or kind <> internal process
se w2 14 ; then goto outchar;
sn w2 0 ;
jl. e8. ; goto adjust partial;
rl. w2 c2. ;
jl. w0 h26. ;
; close up:
c37: al w2 10 ; (-4): char:=nl;
c38: al. w1 h21. ; (-2): zone:= current output zone;
h34: rs. w2 c2. ; close up:
e8: rx w3 x1+h2+4 ; adjust partial word:
ld w3 8 ; partial word:= character +
lo. w3 c2. ; partial word shift 8;
so w2 2.1 ; left justify (partial word);
ld w3 8 ;
so w2 2.1 ;
ld w3 8 ;
e9: al w2 1 ; adjust message:
wa w2 x1+h3+0 ; rec base:= rec base+1;
rs w3 x2+0 ; word (rec base):= partial word;
bz w3 x1+h1+1 ; last addr.used share:=
se w3 4 ; if kind=bs
sn w3 18 ; or kind=mt
am (x1+h0+4) ; then last.shared
rl w2 4 ; else
rl w3 x1+h0+4 ; record base;
rs w2 x3+10 ;
rl w2 x3+4 ; w2:=last shared;
jl. w3 h23. ;
am (x1+h0+4) ;
rs w2 10 ; last addr.old used share :=
al w3 1 ; last shared;
rx w3 x1+h2+4 ; partial word := 1<0; (empty)
jl x3 ; return;
\f
; rc 15.6.70 file processor, character io, page ...3...
; procedures outtext, outinteger;
; registers in call at return
; w0 text addr or value destroyed
; w1 zone descriptor zone descriptor
; w2 unchanged
; w3 link link
; outtext
c35: al. w1 h21. ; (-2): zone:= current output;
h31: ds. w3 c18. ; outtext: save registers;
e11: rl w3 (0) ; get text word:
ba. w0 1 ; partial word := word(text addr);
ba. w0 1 ;
rs. w3 c14. ; text addr:= text addr+2;
jl. w3 e12. ; next char;
jl. w3 e12. ; next char;
al. w3 e11. ; next char;
e12: al w2 0 ; goto get text word;
rx. w3 c14. ; next char:
ld w3 8 ; w2:= front char of partial;
rx. w3 c14. ; partial:= partial shift 8;
sz w2 255 ; if not text end
jl. w0 h26. ; then goto outchar;
dl. w3 c18. ; restore registers;
jl x3 ; return;
; outinteger
; converts a 24 bits integer to a textstring which is output
; to the zone given in the call. the conversion is controlled
; by a layout given in the word following the call (skipped
; at return).
; layout format:
; sign<23 + fill<12 + positions
; if the sign is 1 then the value is considered a signed
; integer otherwise it is treated as having no sign.
; the fill character replaces leading zeroes.
; positions determines the number of characters output (except
; for alarm printing). the maximum value of positions is 12.
c36: al. w1 h21. ; (-2): zone:= current output;
h32: ds. w1 c1. ; outinteger:
ds. w3 c18. ; save registers;
rl w3 x3 ; unpack layout:
hs. w3 e13. ; positions := second byte(layout);
as w3 -12 ;
hs. w3 e22. ; sign := layout < 0;
la. w3 e21. ;
hs. w3 e14. ; fill := bits(1,11,first byte(layout));
la w3 0 ; if layout < 0
sh w3 -1 ; and number < 0 then
ac w0 (0) ; number := -number;
al w1 -1 ; i := -1;
e15: al w3 0 ; convert:
wd. w0 e20. ; digit := number mod 10;
al w3 x3+48 ; number := number//10;
jl. w2 e16. ; put in string(digit+iso digit base);
se w0 0 ; if number <> 0 then
jl. e15. ; goto convert;
\f
; rc 26.03.73 file processor, character io, page ...4...
al. w2 e23. ; set return(end number);
e22 = k + 1 ; sign ;
sl w0 0 ; if layout <= 0 then
jl. e17. ; goto test print sign;
e13 = k + 1 ; positions ; end number:
e23: sh w0 x1+12 ; while -1 < positions do
jl. e18. ; fill up string(fill character);
al. w0 x1+c19. ;
rl. w1 c1. ; restore(w1: zone descr addr);
e19: ba. w0 1 ; move string to zone:
bz w2 (0) ; for i := i+1 while
jl. w3 h26. ; i < string top do
se. w0 c29. ; outchar(zone, string(i));
jl. e19. ;
dl. w3 c18. ; restore registers;
jl x3+2 ; return with skip of layout;
; w0 = 0 at entry here:
e17: al w3 45 ; test print sign:
sh. w0 (c1.-2) ; char := <:-:>;
; if saved number >= 0 then
e14 = k + 1 ; fill char ; fill up string:
e18: al w3 32 ; char := fill;
e16: hs. w3 x1+c19. ; put in string:
al w1 x1-1 ; string(i) := char; i := i-1;
jl x2 ; return;
e20: 10 ; constant: 10
e21: -1-1<11 ; mask for unpack layout
m.fp io system 26.03.73
e. ; end character input/output;
\f
\f
; rc 1977.09.14 file processor, resident, page ...1...
; fp segmentation and fp messages
h40: <:fp:>, 0, r.4; fix; name of fp area process
h44: <:s:> , 0, r.4;init; name of parent process
h42: 3<12+0 ; input message: operation
h47: 0, 0 ; first, last address
h41: 0 ; segment number
h49: 5<12+0 ; output message: operation
0, 0 ; first, last address
h45: 2<12+1<9+0<5+1; finis message:
<:finis:>, 0 ; to parent
h46: 2<13+0<5+1 ; break (pause) message
<:break:>, 0 ; to parent
c32: <:<10>***break<32><0>:> ; jfr. permanent, page ...2...
h85: 0, r.4 ; dummy name , m(8:14)
h43: 0, r.8 ; answer area lowest level
h64: am 1 ; hard error:
h63: am 1 ; end program:
h62: am 2 ; load:
h61: am 1 ; commands:
h60: am 1 ; init:
h78: am 1 ; terminate:
h77: am 1 ; magtape check:
h75: am 1 ; unstack:
h74: am 2 ; stack:
h73: am 1 ; connect output:
h72: am 1 ; connect input:
h71: am 2 ; simple check:
h70: al w3 1 ; io segment:
h99= (:h70-h60+6:)/2 ; swap:= segment number < 12;
ds. w1 c7. ; save (w0,w1);
sl w3 h99 ; base:= if swap then base swap
am h56; =h55-h13 ; else base transient;
al. w1 h13.+0 ; first address.mess:= base;
al w2 x1+510 ; last address.mess:= first addr+510;
rs. w3 h41. ; set segment number (entry point);
ds. w2 h42.+4 ;
h69: al. w1 h42. ; send for segment:
al. w3 h40. ; message (<:fp:>, mess, result);
jl. w2 h11. ; if result<>1 then
se w0 1 ; create area process (<:fp:>,result);
jd 1<11+52 ; if result <> 1 or
sn w0 1 ; result=1 and bytes transf=0
sl w0 (x1+2) ; then goto send for segment;
jl. h69. ;
am. (h47.) ; enter at second word
jl +2 ; at called segment;
\f
; rc 29.5.70 file processor, resident, page 2
; procedure parent message(message, name);
; registers call return
; w0 not used unchanged
; w1 addr of message unchanged
; w2 addr of doc name unchanged
; w3 link unchanged
; the procedure sends the following message to the parent:
; m(0 :6 ) : message
; m(8 :14) : doc name
b. g24
w.
g0: 0, r.8 ; message to parent
h35: ds. w1 g1. ; parent message:
ds. w3 g2. ; save(w0,w1,w2,w3);
dl w0 x1+2 ;
ds. w0 g0.+2 ; move message to m(0:4)
dl w0 x1+6 ;
ds. w0 g0.+6 ;
dl w0 x2+2 ;
ds. w0 g0.+10 ; move name to m(0:14)
dl w0 x2+6 ;
ds. w0 g0.+14 ;
al. w1 g0. ;
al. w3 h44. ;
jl. w2 h11. ; message(parent,message,result);
dl. w1 g1. ;
dl. w3 g2. ; restore(w0,w1,w2,w3);
jl x3 ; return;
0 ; saved w0
g1: 0 ; saved w1
0 ; saved w2
g2: 0 ; saved w3
h67:
g4: am h46-h45 ; pause: mess := break;
h14: al. w1 h45. ; finis: mess := finis;
al. w2 h85. ; w2 := dummy;
jl. h35. ; goto parent message;
h11: rs. w2 c15. ; message: save link;
g7: jd 1<11+16 ; send the message (proc,mess);
se w2 0 ; if buf<> 0 then goto wait for it;
jl. g5. ; no buffer:
g6: jd 1<11+24 ; wait event (buf);
se w0 1 ; if not answer then
jl. g6. ; goto no buffer;
jd 1<11+26 ; get event(buf);
jl. g7. ; goto message;
g5: al. w1 h43. ; wait for it:
jd 1<11+18 ; wait answer (buf,answer,result);
jl. (c15.) ; return;
e. ; end;
\f
; rc 15.4.71 file processor, resident, page ...3...
h38: 0, r.4 ; dummy entry:
; procedure check all (zone);
; registers in call at return
; w0 destroyed
; w1 zone descriptor zone descriptor
; w2 used share descriptor
; w3 link destroyed
b. g24 ; begin
w. am 5 ; (-2): op:= output or
h89: al w0 0 ; check all: op:= any operation;
hs. w0 g0. ; share:= used share.zone;
rl w2 x1+h0+4 ; save (share);
ds. w3 c18. ; save (link);
g1: bz w0 x2+6 ; check share:
rl w3 x2 ; if share is pending
sl w3 2 ; with message
g0=k+1, so w0 ; if operation.share=op
jl. g2. ; then begin
jl. w3 h24. ; wait and ready;
g2: al w2 x2+h6 ; share:= share+share descr length;
sh w2 (x1+h0+8) ; if share>last share
jl. 4 ; then share:=first share;
rl w2 x1+h0+6 ; if share<>saved used share
se. w2 (c18.-2) ; then goto check share;
jl. g1. ; return;
jl. (c18.) ;
e. ; end check all;
; procedures stack, unstack (zone,chain);
; registers in call at return
; w0 unchanged
; w1 zone descriptor zone descriptor
; w2 chain address chain address
; w3 link link
; stack
al. w2 h50. ; (-4): chain:= current chain;
al. w1 h20. ; (-2): zone:= current input;
h29: ds. w1 c16. ; stack medium:
ds. w3 c17. ; save registers;
rl w2 x1+h0+4 ; save (used share.zone);
rs. w2 c18.-2 ; save (record base.zone);
dl w3 x1+h3+2 ; save (last byte.zone);
ds. w3 c27. ; comment: must be restored later;
jl. w3 h89. ; check all (zone, any operation);
jl. h74. ; call and enter stack segment;
; unstack
al. w2 h50. ; (-4): chain:= current chain;
al. w1 h20. ; (-2): zone:= current input;
h30: ds. w3 c11. ; unstack medium: save registers;
jl. h75. ; call and enter unstack segment;
\f
; rc 5.6.1970 file processor, resident, page ...3a...
; procedure wait and ready(zone,share);
; registers in call at return
; w0 not used unchanged
; w1 zone descr addr unchanged
; w2 share descr addr unchanged
; w3 link link
b. b1 ; begin block: wait and ready
w. ;
0; saved w3
b0: 0; saved w0
0; saved record base
b1: 0; saved last byte
am h20-h21 ; (-4) zone := current input else
al. w1 h21. ; (-2) zone := current output;
h24: ds. w0 b0. ; wait and ready:
dl w0 x1+h3+2 ; save(w0,w3);
ds. w0 b1. ; save(record base,last byte);
jl. w3 h48. ; wait and free;
al w0 1 ;
rs w0 x2 ; share state := 1; (ready)
dl. w0 b1. ;
ds w0 x1+h3+2 ; restore(record base,last byte);
dl. w0 b0. ; restore(w0,w3);
jl x3 ; return;
e. ; end block wait and ready
\f
; rc 11.04.72 file processor, resident, page ...4...
; procedures connect input, connect output (zone, file);
; registers in call at return
; w0 result
; w1 zone descriptor zone descriptor
; w2 file descriptor file descriptor
; w3 link link
; connect input
al. w1 h20. ; (-2): zone:= current input;
h27: ds. w3 c11. ; connect input:
jl. h72. ; call and enter conn. input segm;
; connect output
al. w1 h21. ; (-2): zone:= current output;
h28: ds. w3 c11. ; connect output:
jl. h73. ; call and enter conn. output segm;
; procedure terminate zone (zone);
; registers in call at return
; w0 tape mark unchanged
; w1 zone descriptor zone descriptor
; w2 unchanged
; w3 link link
am h20-h21 ; (-4): zone:= current input
al. w1 h21.+0 ; (-2): zone:= current output;
h79: ds. w1 c16. ; terminate zone:
ds. w3 c17. ; save registers;
jl. h78. ; call and enter terminate zone segm;
; current zones: share descriptors.
h90=1 ; number of shares in:
h81: 0, r.h90*h6/2 ; current input share descriptors
h91=1 ; number of shares in:
h82: 0, r.h91*h6/2 ; current output share descriptors
; the number of shares in the program zone is allways 1
; end of resident file processor
h55= h12+3*512 ; base of programs and of fp transient.
h56= h55-h13 ; base difference: transient - swap.
b. g1 ; begin
g1= (:h12+3*512-k:)/2 ; fill up to 1536 bytes
c. -g1 m.length error on fp segment 2
z. ; zero fill:
w. 0, r.g1 ;
e. ; end fill up;
\f
; rc 76.02.02 file processor, resident, page ...5...
; transmit h-names to global block
j0 = h0 ; zone descriptor: buffer area
j1 = h1 ; - - process
j2 = h2 ; - - status
j3 = h3 ; - - record
j4 = h4 ; - - free
j5 = h5 ; - - length
j6 = h6 ; share descriptor length
j7 = h7 ; end program: w1=name addr, w2=ok
j8 = h8 ; current command pointer
j9 = h9 ; last of commands
j10=h10 ; interrupt address: break=h10+h76
j11=h11 ; message sender: w1=mess,w2=link,w3=name
j12=h12 ; file processor base: at present first word
j13=h13 ; swap segment base: at present h12+512
j14=h14 ; send finis message: w2=link, h14-2: pause mess
j15=h15 ; primary output description address
j16=h16 ; own process description address
j17=h17 ; parent process description address
j18=h18 ; load and enter block from program zone w1=zone
j19=h19 ; current program zone descriptor
j20=h20 ; current input zone descriptor
j21=h21 ; current output zone descriptor
j22=h22 ; inblock: w1=zone,w3=link
j23=h23 ; outblock: w1=zone,w3=link
j24=h24 ; wait and ready: w1=zone, as h89
j25=h25 ; inchar: w1=zone,w2=char,w3=link
j26=h26 ; outchar: w1=zone,w2=char,w3=link
j27=h27 ; connect input: w1=zone,w2=file,w3=link,w0=result
j28=h28 ; connect output: w1=zone,w2=file,w3=link,w0=result
j29=h29 ; stack: w1=zone,w2=chain,w3=link
j30=h30 ; unstack: w1=zone,w2=chain,w3=link
j31=h31 ; outtext: w1=zone,w0=text,w3=link
j32=h32 ; outinteger: w1=zone,w0=value,w3=link
j33=h33 ; outend: w1=zone,w2=char,w3=link
j34=h34 ; close up: w1=zone,w2=char,w3=link
j35=h35 ; parent message: w0,w1=text,w3=link
j36=h36 ; return to check: registers irrelevant
j37=h37 ; clock message , used by connect in
j38=h38 ; dummy entry
j39=h39 ; outend a new line on cur output: w3=link
j40=h40 ; name address of fp area process
j41=h41 ; segment number (in mess h42)
j42=h42 ; input message (4 words) used by fp swap machinery
j43=h43 ; answer area (8 words)
j44=h44 ; name address of fp parent process
j45=h45 ; finis message (1 word )
j46=h46 ; pause message (1 word )
j47=h47 ; first address (in mess h42)
j48=h48 ; wait and free: w1=zone,w2=share,w3=link
j49=h49 ; output message(3 words)
\f
; rc 76.02.02 file processor, resident, page ...6...
; transmitting h-names to global block:
j50=h50 ; current name chain address
j51=h51 ; fp mode bits
j54=h54 ; working tail for file connection
j55=h55 ; base of called programs: at present h12+1536
j56=h56 ; used internally by fp (transient base - swap base)
j57=-1-1<20; fp-version = system 3
j58=h58 ; initial catbase
j59=h59 ; outend a null char on cur output, w3=link
j60=h60 ; init fp
j61=h61 ; read commands
j62=h62 ; load program
j63=h63 ; end program
j64=h64 ; hard errors on devices
j65=h65 ; special break program entry (fp internal use)
j66=h66 ; answer area for io package
j67=h67 ; parent message (***break ): w3=link
j68=h68 ; fp stderror entry: w1=zone,w3=status
j69=h69 ; fp internal use: send for fp-segment
j70=h70 ; io segment
j71=h71 ; simple check
j72=h72 ; connect input
j73=h73 ; connect output
j74=h74 ; stack
j75=h75 ; unstack
j76=h76 ; size of regdump area after interupt
j77=h77 ; magtape check
j78=h78 ; terminate zone
j79=h79 ; terminate zone: w1=zone,w3=link
j80=h80 ; current program: share descriptor
j81=h81 ; current input: first share descriptor
j82=h82 ; current output: first share descriptor
j83=h83 ; users bits
j84=h84 ; io link
j85=h85 ; empty text in parent message
j86=h86 ; block io: normal action, regs irr
j87=h87 ; block io: wait transport, w1=zone,w2=share
j88=h88 ; block io: give up action, regs irr
j89=h89 ; check all: w1=zone,w3=link, h89-2: output
j90=h90 ; number of shares in current input
j91=h91 ; number of shares in current output
j92=h92 ; give up action in current program zone
j93=h93 ; - - - - - - - in current input zone
j94=h94 ; - - - - - - - in current output zone
j95=h95 ; close up - as it should be
j96=h96 ; count of fp syntax errors
j97= 97 ; init catalog selection
j98= 98 ; maybe testoutput
j99=h99 ; common temporary assignments
\f
; rc 12.6.70 file processor, resident, page ...7...
; c-hames are transmitted to global block tru j-names:
; j <100+index> = c <index>
j100= c0 ; w0 block io
j101= c1 ; w1 block io
j102= c2 ; w2 block io
j103= c3 ; w3 block io
j104= c4 ; w0 swap
j105= c5 ; w2 start/wait
j106= c6 ; w3 start/wait
j107= c7 ; w1 swap
j108= c8 ; tries, saved device name
j109= c9 ; w2 swap
j110=c10 ; answer area block io
j111=c11 ; return address swap
j112=c12 ; current parameter
j113=c13 ; relative program entry point
j114=c14 ; digitstring start
j115=c15 ; return address inner most level
j116=c16 ; w1 resident
j117=c17 ; w3 resident
j118=c18 ; link outtext/outinteger
j119=c19 ; w2 outtext/outinteger
j120=c20 ; w2 end program
j121=c21 ; w0 resident
j122=c22 ; number of bytes transferred
j123=c23 ; w2 resident
j124=c24 ; number of characters transferred
j125=c25 ; fp internal use
j126=c26 ; file count
j127=c27 ; used by stack
j128=c28 ; block count
j129=c29 ; digitstring end
j130=c30 ; used by stack
j131=c31 ; device name current output
m.fp resident 76.02.02
i. ; maybe names
e. ; end perament and resident fp
h99=0 ; end translation:= false;
c.h99-1 m.only resident fp was translated
e.,z. ;
\f
; rc 76.02.02 file processor, resident, page ...8...
; reassign h-names in global block
h0= j0-j12, h1= j1-j12, h2= j2-j12, h3= j3-j12,
h4= j4-j12, h5= j5-j12, h6= j6-j12, h7= j7-j12,
h8= j8-j12, h9= j9-j12, h10= j10-j12, h11= j11-j12,
h12= j12-j12, h13= j13-j12, h14= j14-j12, h15= j15-j12,
h16= j16-j12, h17= j17-j12, h18= j18-j12, h19= j19-j12,
h20= j20-j12, h21= j21-j12, h22= j22-j12, h23= j23-j12,
h24= j24-j12, h25= j25-j12, h26= j26-j12, h27= j27-j12,
h28= j28-j12, h29= j29-j12, h30= j30-j12, h31= j31-j12,
h32= j32-j12, h33= j33-j12, h34= j34-j12, h35= j35-j12,
h36= j36-j12, h37= j37-j12, h38= j38-j12, h39= j39-j12,
h40= j40-j12, h41= j41-j12, h42= j42-j12, h43= j43-j12,
h44= j44-j12, h45= j45-j12, h46= j46-j12, h47= j47-j12,
h48= j48-j12, h49= j49-j12, h50= j50-j12, h51= j51-j12,
h54= j54-j12, h55= j55-j12,
h56= j56-j12, h57= j57 , h58= j58-j12, h59= j59-j12,
h60= j60-j12, h61= j61-j12, h62= j62-j12, h63= j63-j12,
h64= j64-j12, h65= j65-j12, h66= j66-j12, h67= j67-j12,
h68= j68-j12, h69= j69-j12, h70= j70-j12, h71= j71-j12,
h72= j72-j12, h73= j73-j12, h74= j74-j12, h75= j75-j12,
h76= j76 , h77= j77-j12, h78= j78-j12, h79= j79-j12,
h80= j80-j12, h81= j81-j12, h82= j82-j12, h83= j83-j12,
h84= j84-j12, h85= j85-j12, h86= j86-j12, h87= j87-j12,
h88= j88-j12, h89= j89-j12, h90= j90-j12, h91= j91-j12,
h92= j92-j12, h93= j93-j12, h94= j94-j12, h95= j95-j12,
h96= j96-j12, h97= j97-j12, h98= j98-j12, h99= j99-j12,
; reassign c-names in global block
c0=j100-j12, c1=j101-j12, c2=j102-j12, c3=j103-j12,
c4=j104-j12, c5=j105-j12, c6=j106-j12, c7=j107-j12,
c8=j108-j12, c9=j109-j12, c10=j110-j12, c11=j111-j12,
c12=j112-j12, c13=j113-j12, c14=j114-j12, c15=j115-j12,
c16=j116-j12, c17=j117-j12, c18=j118-j12, c19=j119-j12,
c20=j120-j12, c21=j121-j12, c22=j122-j12, c23=j123-j12,
c24=j124-j12, c25=j125-j12, c26=j126-j12, c27=j127-j12,
c28=j128-j12, c29=j129-j12, c30=j130-j12, c31=j131-j12,
\f
▶EOF◀