|
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: 212736 (0x33f00)
Types: TextFile
Names: »fp4tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »fp4tx «
\f
; rc 89.01.25 file processor, permanent, page ...1...
b. h99 w. ; special block for fpnames
b. c50, j131 ; begin global block
m.file processor 89.01.25 system 3
m.
m.fp text 1 89.01.25
; slang structure:
;
; b. h99 ; global block with fpnames
; b. c43, j131 ; block with c- and j-names
;
; s. k=0 ; 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, 12
;
; s. k=h55, e48 ; command assembly
; e. ; segment 13, 14
;
; s. k=h55, e48 ; load program
; e. ; segment 15
;
; s. k=h55, e48 ; end program and device status
; e. ; segment 16, 17
;
; b. g1 ; block for old fpnames
; e. ; and insertproc
;
; e. ; end c- and j-names
; e. ; end global block
;
\f
; fgs 1988.04.24 file processor, permanent, page ...2...
; resident file processor
s. k=0 ; 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;
dl w3 x3+70 ; saved w2; user interval:=
ds. w3 h58. ; saved w3; initial catbase;
jl. h60. ; saved ex; goto init fp;
am 0 ; saved ic; dummy, one saved;
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. w3 h67. ; parent message(<:break:>);
jl. h60. ; if the answer should arrive
; then goto init;
; 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 86.08.27 file processor, permanent, page ...3a...
b. a3,b2
w.
; dummy notes
h96: 0 ; prim inout 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
; fgs 1988.05.19 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 = user base
2 ; file processor package version
h52: 4<12 + 0 ; file processor package release < 12 + subrelease
h53 = 18 ; no of halfwords in available area in front of zone buffers
; space used by notes - now partly used by breakpoint routine
e.
\f
; fgs 1988.05.19 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 89.01.25
\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
; fgs 1989.01.25 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;
e23: 1<7 ; word defect bit
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
; fgs 89.01.25 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;
sn w2 6 ; if kind = disc then
al w2 4 ; kind := area;
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 ; if bytes transferred > 0 then
se w0 0 ; begin
wd w2 0 ; if number of characters * 2
se w1 0 ; modulo bytes transferred <> 0
lo. w3 e23. ; then status:=status or word defect bit;
rl. w2 c1. ; end;
sz. w3 (c44.) ; if status.tape mark sensed = 1 then
jl. e30. ; goto skip;
wa w0 6 ; if hwds xferred <> 0 or status <> 0 then
sn w0 0 ; begin <*update pos in zone by pos in answer*>
jl. e30. ; zone.file, block :=
dl. w1 c28. ; answ.file, block;
ds w1 x2+h1+14 ; end;
e30: 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
; fgs 1982.12.12 file processor, block io, page ...4...
; device table containing mask index and special action no.
h. ; bytes
e21=k , e22=k+1 ;
16 , 6 ; ip ; special actions:
16 , 0 ; clock ; 0: give up
4 , 2 ; area ; 2: area process action
4 , 2 ; disc ; 4: end of medium
8 , 6 ; tw ; 6: timer error
12 , 4 ; tr ; 8: char output
16 , 8 ; tp ; 10: mag tape errors
16 , 8 ; lp
12 , 4 ; cr
0 , 10 ; mt
16 , 8 ; pl
; mask table specifying hard and special errors depending
; on the index selected via the process kind
w.
e24: 8.1107 7031 ; 0: magtape (mt)
e25: 8.2620 0744 ;
8.7277 7331 ; 4: area/disc process (size)
8.0500 0444 ;
8.2757 7375 ; 8: typewriters (tw)
8.1000 0400 ;
8.1614 7775 ; 12: readers (tr, cr)
8.0100 0000 ;
8.3677 7375 ; 16: char oriented output (ip, clock, tp, lp, pl)
8.0100 0400 ;
e28: 8.7777 4777 ; official bits.
; treatment of status bits for different indices.
; bit error hard:* spec:/
; 0 4 8 12 16
;
; 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 * * * * *
;
; 0 4 8 12 16
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 88.04.24 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 <> terminal/console and
se w2 8 ; kind <> punch and
sn w2 12 ; kind <> printer and
jl. e8. ; 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 89.01.27
e. ; end character input/output;
\f
\f
; fgs 1989.01.25 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+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: sn w0 0 ; check create area process:
jl. h69. ; if result = 0 then goto send for segment;
jl. h14. ; goto finis message;
h43: 0, r.8 ; answer area lowest level
h64: am 0 ; hard error =
h63: am 1 ; end program:
h62: am 2 ; load:
h61: am 2 ; 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;
sl w3 h99 ; last address.mess :=
am 512 ; first addr + (if swap
al w2 x1+510 ; then 510 else 1022);
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 dummy answer then
se w0 1 ; goto clear name table address
jl. h38. ; and create area process (<:fp:>);
sl w0 (x1+2) ; if halfs transferred = 0 then
jl. h69. ; goto send for segment;
am. (h47.) ; enter at second word
jl +2 ; at called segment;
\f
; rc 1981.08.06 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 h40. ; w2 := addr of docname (<:fp:>) ;
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 1981.08.06 file processor, resident, page ...3...
h38: al w0 0 ; clear name table address:
rs. w0 h40.+8 ; clear name table adrdress;
jd 1<11+52 ; create area process (<:fp:>);
jl. h85. ; goto check result create area process;
; 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
; fgs 1989.01.26 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
c44: 1<16 ; tape mark sensed
; 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 1981.08.06 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, overtaken by fp segmentation
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
; fgs 1982.12.09 file processor, resident, page ...6...
; transmitting h-names to global block:
j50=h50 ; current name chain address
j51=h51 ; fp mode bits
j52=h52 ; file processor version, release and subrelease
j53=h53 ; length of available area in front of zone buffer areas
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, overtaken by check create area process
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 86.08.28 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 and end program
j128=c28 ; block count
j129=c29 ; digitstring end
j130=c30 ; used by end program
j131=c31 ; device name current output
m.fp resident 86.12.12
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
; fgs 1982.12.09 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,
h52= j52-j12, h53= j53-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
m.
m.fp text 2 86.12.12
\f
; fp text 2
; fgs 1988.04.24 file processor, simple check, page ...1...
; this segment is called when special status bits are set for
; all input/output except for magnetic tapes.
s. k=h13, e48 ; begin
w. 512 ; length ; segment 3:
e0: dl. w0 c11. ; w3,w0:=special, remaining bits;
dl. w2 c5. ; w1,w2:=zone, share;
jl. x3+2 ; goto case special of
jl. e1. ; (0: give up,
jl. e2. ; 2: areas,
jl. e3. ; 4: readers,
jl. e4. ; 6: typewriters,
jl. e5. ; 8: char output,
jl. e6. ; 10: mag tape);
e13: 25<16 ; <em><0><0>
e15: 1<21 ; test timer
e16: 1<20 ; test overrun
e17: 1<18 ; test end doc
; working locations:
; fnc area:
e42: 44<12+2.0000011<5+1; fnc<12+pattern<5+wait
<:bs :> ; <:bs :>
0, r.4 ; docname of area process
0 ; segments
0 ; 0 entries
e47: 0 ; area process descr.
e48: 0, r.10 ; tail
\f
; fgs 1988.04.24 fileprocessor simple check, page ...2...
e2: al w3 x1+h1+2 ; areas: w3:=name.addr;
sz w0 2.111100 ; if not normal answer
jl. e30. ; then goto dummy answer;
sz. w0 (e16.) ; if overrun
jl. e10. ; then repeat;
so. w0 (e17.) ; test outside: if not end doc (i.e. -, end doc and stopped)
jl. e23. ; then repeat the rest;
bz w0 x1+h1+1 ; end document (maybe stopped):
bz w3 x2+6 ; w0 := zone.kind;
sn w0 4 ; w3 := operation;
se w3 5 ; if proc kind = area process and
jl. e19. ; operation = output then
jl. e46. ; goto extend area;
e19: se w3 3 ; maybe physical end of medium:
jl. e1. ; if not input then give up;
rl. w0 c11. ;
so w0 1<8 ; if -, stopped then
jl. e7. ; goto return;
e20: rl w3 x1+h1+12 ; physical eom:
al w3 x3+1 ; file count:= file count+1;
al w0 0 ; block count:= 0;
ds w0 x1+h1+14 ; zone (first addr):= eom char;
rl. w0 e13. ; top transferred:= first addr+2;
rs w0 (x2+8) ; goto normal action;
rl w1 x2+8 ; comment: the following entries set
al w1 x1+2 ; the return point to the
rs w1 x2+22 ; io-segment;
e7: am h86-h87 ; normal return: set return
e8: am h87-h88 ; wait transport: set return
e1: al. w3 h88. ; give up: set return.
dl. w2 c5. ; w1,w2:=zone,share;
ds. w3 c11. ; w3:=return point;
jl. h70. ; call and enter io-segment;
e30: so w0 1<5 ; dummy answer: if existing
jl. e31. ; then goto rejected;
al w0 0 ; create:
rs w0 x3+8 ; name table addr := 0;
jd 1<11+52 ; create area process;
se w0 0 ; if not created then
jl. e1. ; goto give up;
bl w0 x2+6 ; if operation=input
sn w0 3 ; then
jl. e10. ; goto repeat;
\f
; fgs 1988.04.24 fileprocessor simple check, page ...3...
e32: jd 1<11+8 ; reserve: reserve process;
se w0 0 ; if not reserved
jl. e1. ; then goto give up;
jl. e10. ; goto repeat;
e31: bl w0 x2+6 ; rejected:
sn w0 5 ; if operation = output
jl. e32. ; then goto reserve;
bz w0 x1+h1+1 ; w0 := zone.kind;
sn w0 6 ; if kind = disc process then
jl. e32. ; goto reserve;
jl. e1. ; goto give up;
e46: al w3 x1+h1+2 ; extend:
jd 1<11+4 ; process description;
rs. w0 e47. ;
am (0) ;
rl w0 18 ; old size := no of segments (area process);
rl w3 x2+10 ;
ws w3 x2+8 ; new size :=
al w3 x3+2 ; segment(share) +
ls w3 -9 ; (last transfer-first transfer+2)//512;
wa w3 x2+12 ;
sl w0 x3 ; if old size >= newsize then
jl. e10. ; goto repeat;
al w0 x3 ;
al w3 0 ;
am. (e47.) ; device:=area(10);
rl w2 10 ; slice length:=device(26);
sn w2 0 ; if deviceref=0 then
jl. e33. ; jump
wd w0 x2+26 ; new size :=
se w3 0 ; (new size // slice length
ba. w0 1 ; + if remainder = 0 then 0 else 1)
wm w0 x2+26 ; * slice length;
e33: rl w2 0 ; w2 := new size;
\f
; fgs 1988.04.24 fileprocessor simple check, page ...4...
e14: al w3 x1+h1+2 ;
al. w1 e48. ;
jd 1<11+42 ; lookup entry(area);
rs w2 x1 ; size := new size;
jd 1<11+44 ; change entry;
se w0 6 ; if claims exceeded then
jl. e35. ; begin <*extend area*>
rl. w0 e42.+12 ;
se w0 0 ; if fnc area.segm <> 0 then
jl. e29. ; goto give up;
rl. w1 h51. ;
sz w1 1<10 ; if mode.bswait = false then
jl. e34. ; begin
rl. w0 e42. ; fnc area.fnc :=
ls w0 -1 ; fnc area.fnc -
ls w0 1 ; wait bit;
rs. w0 e42. ; end;
e34: rl. w1 e47. ; claim :=
rl. w0 e48. ; new size -
ws w0 x1+18 ; old size ;
rs. w0 e42.+12 ; fnc area.segm := claim;
dl w0 x1+22 ; move
ds. w0 e42.+6 ; area process.docname
dl w0 x1+26 ; to
ds. w0 e42.+10 ; fnc area.docname;
al. w1 e42. ; w1 := addr first half fnc area;
al w2 x1+8 ; w2 := addr second half fnc area;
jl. w3 h35. ; parent message special (w1=fnc area);
dl. w2 c5. ; w1 := zone;
rl. w2 e48. ; w2 := new size;
jl. e14. ; goto change entry;
; end else
e35: sn w0 0 ; if result <> 0 then
jl. e26. ; begin
e29: al w0 0 ; fnc area.segm := 0;
rs. w0 e42.+12 ; goto give up;
jl. e1. ; end else
;
e26: rs. w0 e42.+12 ; begin
dl. w2 c5. ; fnc area.segm := 0;
dl. w0 c11. ; restore registers ;
jl. e10. ; goto repeat;
; end;
\f
; rc 88.04.24 file processor, simple check, page ...5...
e3: ; readers:
rl. w3 c22. ; if bytes transf <> 0
sn w3 0 ;
jl. e20. ; goto normal action;
jl. e7. ; goto physical eom;
; change paper message to parent:
e25: 13<13+0<5+1 ; m(0) , pattern word, wait;
<:change<32>:> ; m(2:6)
e4: bl w3 x2+6 ; typewriters:
se w3 5 ; if operation = input then
jl. e27. ; goto test stop;
e5: sz. w0 (e15.) ; char output:
jl. e1. ; if timer then goto give up;
so. w0 (e17.) ; test end doc:
jl. e27. ;
al w2 x1+h1+2 ; if end document then
al. w1 e25. ; parent message(<:change :>, doc name);
jl. w3 h35. ;
dl. w0 c11. ;
dl. w2 c5. ;
e27: so w0 1<8 ; test stop:
jl. e7. ; if not stopped then
rl w3 x2+22 ; goto normal action;
rs w3 x2+8 ; first addr:=top transferred;
; repeat
e10: al w3 x1+h1+2 ; block repeat:
al w1 x2+6 ; send message (proc.zone,mess.share);
jd 1<11+16 ; share state:= message buffer address;
rs w2 x1-6 ; goto wait transport;
jl. e8. ;
e23: rl. w0 c10. ; repeat the rest: w0:=total status;
sz. w0 (e17.) ; if end doc in status
jl. e7. ; then return;
rl w0 x2+22 ;
rx w0 x2+8 ; first addr:=top transf
ac w0 (0) ; seg.number:=
wa w0 x2+22 ; seg.numer +
ls w0 -9 ; (top transf - old first)//512
wa w0 x2+12 ;
rs w0 x2+12
jl. e10. ; goto block repeat;
e6=e1 ; mag tape: goto give up;
b. g1 ; begin
g1= (:h13+512-k:)/2 ; fill up segment to 512 bytes
c. -g1 m.length error on fp segment 3
z.w. 0, r.g1 ; zero fill
e. ; end fill up;
m.fp simple check 88.05.04
i. ; maybe names
e. ; end simple check;
\f
; rc 22.08.74 fileprocessor connect in, page ...1...
; connect input
; c4: w0 place result here
; c7: w1 zone descriptor address
; c9: w2 address of file descriptor or of name
; c11: w3 return
s. k=h13, a40, b10, e48, j24 ; begin
w. 512 ; length ; segment 4:
e0: rl. w2 c9. ; c9 = file descr;
dl w0 x2+2 ; if mode < 0 then
sh w3 -1 ; goto descriptor found;
jl. j3. ; name:
al w3 x2+0 ; cat look up:
al w2 x2-2 ; name pointer:= w2+2;
rs. w2 c9. ; comment: to handle not
al. w1 h54. ; found items;
jd 1<11+42 ; lookup (wtail,name words);
se w0 0 ; if result <> 0
jl. e33. ; then goto unknown;
rl w1 x1 ; if mode >= 0
sh w1 -1 ; then
jl. j1. ; move name to wtail;
dl w1 x3+2 ;
ds. w1 h54.+4 ;
dl w1 x3+6 ;
ds. w1 h54.+8 ;
j1: al. w1 h54.+0 ; test mode:
j4: al w2 x1 ; descriptor found:
j3: rl w0 x2+0 ; w2:=file descriptor addr;
sl w0 0 ; if mode >= 0
rl. w0 e47. ; then mode := 1<23+4;
rs. w2 c9. ; save file descr. addr;
rs w0 x2+0 ;
bz w1 1 ; if kind>max kind
ls w1 -1 ; then goto convention error;
sl w1 e16 ;
jl. e34. ;
bl. w0 x1+e13. ; block length:= standard (kind);
hs. w0 e14. ;
al w0 0 ;
rs w0 x2+10 ; name table address :=0;
bz w0 x2+16 ; algol or fortran procedures:
sn w0 4 ; if contents = 4
jl. j8. ; or
sh w0 31 ; contents >= 32
jl. j7. ; then
j8: ld w0 -65 ; file count:=block count:=0;
ds w0 x2+14 ;
j7: rl. w3 c7. ; area claim:
sn w3 0 ; if zone=0 then
jl. j6. ; goto separate proc;
bz w0 x3+h1+1 ; if kind.zone = 4 then
al w3 x3+h1+2 ; remove process (name.zone);
sn w0 4 ; comment: to save the area claim;
jd 1<11+64 ; result irrelevant;
\f
; fgs 1986.12.12 file processor, connect in, page ...2...
j6: am x1 ; separate proc:
jl. x1+e15. ; goto proc (kind);
e15: jl. e25. ; ip: goto check and init;
jl. e34. ; clock: goto convention error;
jl. e25. ; bs: goto check and init;
jl. e25. ; drum: goto check and init;
jl. e25. ; tw: goto check and init;
jl. e1. ; tr: goto readers;
jl. e34. ; tp: goto convention error;
jl. e34. ; lp: goto convention error;
jl. e1. ; cr: goto readers;
jl. e43. ; mt: goto reserve tape;
; standard block length :
h. ; bytes ; kind
e13: 512-2 ; 0: 768 chars
0-2 ; 2: 0 -
512-2 ; 4: 768 -
512-2 ; 6: 768 -
104-2 ; 8: 156 -
36-2 ; 10: 56 -
80-2 ; 12: 120 -
80-2 ; 14: 120 -
80-2 ; 16: 120 -
512-2 ; 18: 768 -
e14: 512-2 ; selected block size
e16=e14-e13 ; max kind
w. ;
e47: 1<23+4 ; mode,kind for bs
e48: 3<12+1<11 ; constant to be added to mode,kind
; mount tape message to parent:
a1: 7<13+0<5+1 ; m(0) , pattern word, wait
<:mount <0>:> ; m(2:6)
a5: al. w1 a1. ; mount tape:
al w2 x3 ; parent message(<:mount :>);
jl. w3 h35. ;
e43:
a4: rl. w2 c9. ; reserve tape:
al w3 x2+2 ; initialize process(proc.file);
jd 1<11+6 ;
se w0 0 ; if not ok
jl. a5. ; then goto mount tape;
\f
; fgs 1984.09.04 file processor, connect in, page ...3...
al w0 2047 ; set mode:
bz w1 x2 ;
la w0 2 ;
al w1 14 ;
hs w1 0 ; operation(message) :=
rs. w0 c10. ; set mode < 12 + mode;
al. w1 c10. ;
jd 1<11+16 ; send message;
jd 1<11+18 ; wait answer;
rl. w2 c9. ; set position:
al w1 6 ;
al w0 8 ;
hs. w0 e48. ; ...change <operation> to <move>...
ls w0 12 ; operation(message) := move < 12;
ds. w1 c10.+2 ; message(2) := 6;
dl w1 x2+14 ; message(4) := file count;
ds. w1 c10.+6 ; message(6) := block count;
al. w1 c10. ; send message;
jd 1<11+16 ;
rs. w2 e37. ; init buf := message buffer address;
jl. e40. ; goto move description;
; check and init:
e25: bz w1 x2+1 ; check and init:
al w3 x2+2 ; w3:=name addr;
al w0 0 ;
sn w1 4 ; if kind = 4 then
jd 1<11+52 ; create area process;
se w0 0 ; if result <> 0 then
jl. a27. ; goto set result;
jd 1<11+6 ; initialize process(w3);
sn w0 0 ; if result=0 (ok) then
jl. e40. ; goto move description;
sn w0 1 ; if result=1 then goto
jl. e35. ; access not allowed;
sn w0 2 ; if result=2 then goto
jl. e31. ; no resources;
jl. e33. ; not present;
\f
; fgs 1988.08.09 file processor, connect in, page ...4...
; until now the zone descriptor was unchanged:
; move the file descriptor to the zone descriptor.
e40: al. w2 e30. ; move description: return := set ok result;
a29: rs. w2 b3. ; save return;
dl. w2 c9. ;
al w0 0 ; if zone descr addr=0
sn w1 0 ; then goto ok result;
jl. e30. ;
dl w0 x2+2 ; move (mode,kind,name,
sz w3 1 ; <*if kind odd then
al w3 x3-1 ; truncate kind*>
ds w0 x1+h1+2 ; name table addr,
dl w0 x2+6 ; file count,
ds w0 x1+h1+6 ; block count) from:
dl w0 x2+10 ; (file descriptor) to:
ds w0 x1+h1+10 ; (zone descriptor);
dl w0 x2+14 ; segment count:=block count;
ds w0 x1+h1+14 ;
rs w0 x1+h1+16 ;
al. w3 h68. ; if give up action<fp std error
sl w3 (x1+h2+2) ; then give up action:=
rs w3 x1+h2+2 ; fp std error addr;
al w0 1 ; partial word:=1<16;
ls w0 16 ;
rs w0 x1+h2+4 ;
ld w0 -65 ; record base:=
ds w0 x1+h3+2 ; last byte:= 0;
rs w0 x1+h3+4 ;
rl w3 x1+h0+6 ; used share:=first share;
rs w3 x1+h0+4 ;
e46: bl w0 x1+h1+0 ; set shares:
wa. w0 e48. ; for share:=first share step
rs w0 x3+6 ; share descr length until last share
rl w0 x3+2 ; do begin
rs w0 x3+8 ; message(0):=(if magtape then move else 3<12)+mode;
rs w0 x3+22 ; top transferred := first shared;
ba. w0 e14. ; message(2):=first shared;
rs w0 x3+4 ; message(4):=last shared:=
rs w0 x3+10 ; first shared+block size-2;
al w0 0 ;
rs w0 x3+0 ; state.share:=0 (free);
al w3 x3+h6 ; end;
sh w3 (x1+h0+8) ;
jl. e46. ;
jl. (b3.) ; goto saved return;
; at return to the io-segment w0 must be set to the result of
; the connection, w1 must be unchanged , and the saved values
; of w2,w3 must also be unchanged.
\f
; fgs 1988.08.09 file processor, connect in, page ...5...
; connection results: if ok then w0=0 else w0<>0.
;e36: am 1 ; 6: name format error
e35: am 1 ; 5: not allowed
e34: am 1 ; 4: convention error
e33: am 1 ; 3: not user,non-exist
e32: am 1 ; 2: malfunctioning
e31: al w0 1 ; 1: no resources
jl. a27. ; goto set result;
e30: rl. w1 c7. ; ok result:
rl. w2 e37. ; w0 := result;
se w1 0 ; if zone <> 0 then
rs w2 (x1+h0+4) ; state(first share) := init buf;
se w2 0 ; if init buf = 0
se w1 0 ; or zone <> 0 then
jl. h70. ; return;
al. w1 c10. ; w1 := answer address;
jd 1<11+18 ; wait answer;
se w0 1 ; w0 := if result = 1 then 0 else 5;
am 5 ;
a28: al w0 0 ; ok exit: w0:=0;
a27: rl. w1 c7. ; set result:restore w1;
jl. h70. ; return;
e37: 0 ; init buf;
b2: 1<18 ; test end of paper
b3: 0 ; saved return
b4 = h37+10 ; clock message (jfr. permanent, page 6)
b5 = h37 ; name of clock (jfr. permanent, page 6)
; wait reader message to parent:
b0: 8<13+0<5+0 ; m(0) , pattern word
<:wait for :> ;
; load reader message to parent:
b1: 12<13+0<5+0 ; m(0) , pattern word
<:load :>, 0 ; m(2:6)
e1: al w3 x2+2 ; readers:
jd 1<11+6 ; initialize process;
sn w0 0 ; if initialized then
jl. a36. ; goto init zone;
sn w0 1 ; if reserved by another then
jl. a2. ; goto wait reader:
sn w0 2 ; if result = 2 then
jl. e31. ; goto no resources
jl. e33. ; else goto not user;
a2: al. w1 b0. ; wait reader:
al w2 x2+2 ;
jl. w3 h35. ; parent message(<:wait for:>, doc name);
a30: jl. w3 a33. ; rep: wait a second; w3 := doc name addr;
jd 1<11+6 ; initialize process;
sn w0 1 ; if reserved by another then
jl. a30. ; goto rep;
a36: jl. w2 a29. ; init zone: move description;
rl. w3 c7. ;
al w3 x3+h1+2 ; w3 := addr(document name);
\f
; fgs 1988.08.09 file processor, connect in, page ...6...
a31: jl. w2 a34. ; clean reader: read a block;
rl w1 x2+4 ; w1:=result;
jd 1<11+26 ; get event;
se w1 1 ; if not normal answer
jl. a37. ; then goto clear share;
so. w0 (b2.) ; if not end of paper then
jl. a31. ; goto clean reader;
jd 1<11+6 ; initialize process;
al. w1 b1. ;
rl. w2 c9. ;
al w2 x2+2 ;
jl. w3 h35. ; parent message(<:load :>,doc name);
rl. w3 c9. ; w3:=
al w3 x3+2 ; name address;
a32: jl. w2 a34. ; rep1: read a block;
rl w1 x2+10 ; w1 := bytes transferred;
se w1 0 ; if bytes transferred <> 0 then
jl. a28. ; goto okexit;
jd 1<11+26 ; get event;
jl. w3 a33. ; wait a second; w3:=name address;
jl. a32. ; goto rep1;
a33: rs. w3 b3. ; wait a second: save return;
al. w1 b4. ;
al. w3 b5. ;
jd 1<11+16 ; send message(clock);
al. w1 b4.+4 ;
jd 1<11+18 ; wait answer;
rl. w3 c9. ;
al w3 x3+2 ; w3 := doc name addr;
jl. (b3.) ; return;
a34: rs. w2 b3. ; read a block: save return;
rl. w1 c7. ;
rl w1 x1+h0+6 ; w1 := first share;
al w1 x1+6 ; w1 := message addr;
jd 1<11+16 ; send message;
rs w2 x1-6 ; share state := buf addr;
al w2 0 ; w2 := start event queue;
a35: rl w0 x2+8 ; rep2: (w0,w1) := (status,bytes transferred);
sn w2 (x1-6) ; if event = share state then
jl. (b3.) ; return;
jd 1<11+24 ; wait event;
jl. a35. ; goto rep2;
a37: rl. w1 c7. ; clear chare:
rl w1 x1+h0+6 ; share state
al w0 0 ; (first share
rs w0 x1 ; (zone)):=0;
jl. e31. ; goto no resources
b. g1
w.
g1 = (:h13+512-k:)/2
c. -1-g1, m. length error, connect in
z.
c. -1+g1
w. 0, r.g1 ; fill segment
z.
e. ; end fill
m.fp connect input 88.08.09
i. ; list names
e. ; end connect in
\f
; fgs 1988.05.01 fileprocessor connect output, page ...1...
; segment 1
; connect output consists of two backing storage segments. the first
; segment is loaded by the call. the second segment is loaded by con-
; nect output itself.
; entry: c4: w0: segments<2 + permkey
; c7: w1: zone descriptor address or 0
; c9: w2: address of filedescriptor or of name
; c11: w3: link
; exit: w0: result
; w1: unchanged
; w2: address of filedescriptor
; w3: undefined
; The contents of w0 are only used, if connect output creates (or changes)
; an area on backing storage:
; If w0 is zero no new bs area is created.
; If w0 is non-zero and if w2 defines a name, which is not found in
; the catalog (by a call of lookup_entry), or if the entry exists and it
; describes a backing storage area, which is protected against writing, then
; connect output will create an area on the disc with the most
; resources of the particular permkey.
; The name of the area is defined by w2. the size of the area is
; given as the second parameter in w0 (segments).
; If this parameter is negative, the size will be max. claim (for the
; device with the greatest claims of the particular permkey) decreased
; by the absolute value of segments.
; If segments is positive, the areasize will be minimum of <segments>
; and max. claim.
; If the entry already exists the areasize is increased if demanded
; according to the rules above.
; If the area exists in advance the areasize is
; never decreased by connect output.
\f
; fgs 1988.05.01 fileprocessor connect output, page ...2...
; segment 1
s. k=h13, a40, b20, e49 ; begin segment: connect output
w. 1024 ; size of connect output
al. w1 h54.-14 ; connect output:
rl. w3 c9. ; w1:=address of look up - area
al w2 x3 ; w2:= addr of file descr or name;
rl w0 x3 ;
sl w0 0 ; if w2 param points at filedescriptor then
jl. a0. ; begin
se. w0 (e47.) ; if modekind <> bs then
jl. a13. ; goto descriptor found;
al w3 x3+2 ;
jd 1<11+76 ; lookup head and tail;
sn w0 0 ; if not found
jl. w3 a35. ; or outside bases then
jl. a33. ; goto create new;
rl. w0 h54. ;
sh w0 -1 ; if size < 0 then
jl. a17. ; goto convention error;
jl. a2. ; end;
; else
\f
; fgs 1988.05.01 fileprocessor connect output, page ...3...
; segment 1
a0: jd 1<11+76 ; begin comment name parameters;
se w0 0 ; lookup head and tail;
jl. a32. ; if not found then
al. w2 h54. ; goto create blank
rl. w0 h54. ;
se. w0 (e47.) ; if modekind <> bs
sl w0 0 ; and modekind < 0 then
jl. 4 ; goto descriptor found;
jl. a13. ;
jl. w3 a35. ; if outside bases then
jl. a32. ; goto create blank;
se. w0 (e47.) ; if modekind = bs then
jl. b3. ; begin
al w2 2 ;
a1: dl. w0 x2+h54. ; move file descriptor
ds. w0 x2+b0. ; to saved file descriptor;
al w2 x2+4 ;
sh w2 19 ;
jl. a1. ;
al. w2 b0. ;
al w3 x2+2 ;
jd 1<11+76 ; lookup head and tail
sn w0 0 ; if not found
jl. w3 a35. ; or outside bases
jl. a33. ; then goto create new;
rl. w0 h54. ;
sh w0 -1 ; if size < 0 then
jl. a17. ; goto convention error;
jl. a2. ; end name indirect
b3: jl. w3 b8. ; else
dl. w1 h54.+18 ; begin
ds w1 x2+18 ; make blank;
dl. w1 h54.+14 ; move file, block, contry, length;
ds w1 x2+14 ;
rl. w0 h54. ; end;
jl. a2. ; goto make larger;
; end name parameter;
\f
; fgs 1988.09.07 fileprocessor connect output, page ...4...
;segment 1
a32: jl. w3 b8. ; create blank: make blank;
a33: rl. w3 c4. ; create new:
rs. w2 c9. ; save w2;
al w2 18 ;
ld w1 -100 ;
b6: ds. w1 x2+h54. ; for i:= 18 step -2 until 4 do
al w2 x2-4 ; lookup area(i):= 0;
se w2 2 ;
jl. b6. ;
al w1 3 ; lookup area (0) := 0;
la w1 6 ; lookup area (1) := w0.permkey;
ds. w1 h54.+2 ;
al w0 x1 ; key := permkey;
as w3 -2 ; wanted := w0.segments > 2;
sn w3 0 ; if wanted = 0 then
jl. b9. ; goto unknown;
jl. b7. ; goto get claims;
a2: rs. w2 c9. ; make larger: ;comment now size>=0;
rl. w3 c4. ; save address of file descr.
as w3 -2 ;
al w0 2.111 ;
la. w0 h54.-14 ; key:= key(entry);
b7: jl. w1 a8. ; get claims (key,entry);
\f
; fgs 1988.09.07 fileprocessor connect output, page ...5...
; segment 1
rx w0 6 ; swop (claim, wanted);
jl. w2 a4. ; convert to slices (claim);
rx w0 6 ; swop (claim, wanted);
jl. w2 a4. ; convert to slices (wanted);
rx. w3 h54. ; swop (wanted, size);
jl. w2 a4. ; convert to slices (size );
rx. w3 h54. ; swop (size, wanted);
sl w3 0 ; if wanted < 0 then
jl. a5. ; wanted := wanted +
wa. w3 h54. ; size +
wa w3 0 ; claims ;
a5: wa. w0 h54. ;
am (0) ;
sl w3 +1 ; if wanted > size + claims then
rl w3 0 ; wanted := size + claims;
sh. w3 (h54.) ; if wanted <= size then
rl. w3 h54. ; wanted := size ;
wm. w3 h10.+6 ; wanted := wanted * slicelength;
rs. w3 h54. ; size := wanted ;
al. w1 h54. ;
rl. w3 c9. ; change entry (lookup area, name in descr);
al w3 x3+2 ;
jd 1<11+44 ;
se w0 0 ; if not changed then
jd 1<11+40 ; create entry (lookup area, name in descr);
se w0 0 ; if not created then
jl. a18. ; goto no resources;
a6: rl. w3 c9. ;
al. w2 h54.+20 ; move file descriptor to
a7: al w3 x3-4 ; lookup area;
al w2 x2-4 ;
dl w1 x3+22 ;
ds w1 x2+2 ;
se. w2 h54. ; w2:= address of lookup area;
jl. a7. ;
a13: rs. w2 c9. ; descriptor found:
rl. w3 h41. ; save file descriptor in c9;
al w3 x3+1 ; segment (fp) := segment (fp) + 1;
jl. h70.+4 ; call segment 2 (connect output);
\f
; fgs 1985.03.07 fileprocessor connect output, page ...6...
; segment 1
b0: 1<23+4
0, r.9 ; saved file descriptor;
0, b1: 0 ; work for outside bases, make blank and get claims
a35: ds. w2 b1. ; boolean procedure outside bases;
am. (h16.) ; returns to x3 if the entry in
dl w2 74 ; h54 is outside max base. else
al w2 x2+1 ; a return to x3+2 is made
sh. w1 (h54.-12) ; (just as skip-instructions do).
sh. w2 (h54.-10) ; the procedure is called with
al w3 x3-2 ; return in w3. w0,w1,w2 are
dl. w2 b1. ; unchanged.
jl x3+2 ;
b8: rs. w3 b1. ; procedure make blank:
al. w2 b0. ; w2:=saved file descriptor
rl. w3 c9. ;
dl w1 x3+2 ; saved file descr(2:8):= name;
ds w1 x2+4 ; comment it is used that the
dl w1 x3+6 ; rest of saved file descr = 0;
ds w1 x2+8 ; w2:= saved file descr;
jl. (b1.) ; return;
\f
; fgs 1988.05.01 fileprocessor connect output, page ...7...
; segment 1
; procedure get claims (key, filedescriptor);
;
; call: return:
;
; w0 key claim
; w1 link link
; w2 - unchanged
; w3 - unchanged
;
; filedescriptor.docname entry.docname or docname of disc
; 0, ..., 3 with claims
;
; The procedure finds the disc with the largest claims for the
; given key and returns the claims in w0 and the docname of the
; disc in filedescriptor.docname.
; If docname given in filedescriptor.docname is 0, all discs are
; searched for the one with the greatest claims of that particular
; permkey. The search goes on backwards from last disc to first disc
; or drum.
; If, however, the docname given is a document name for a disc
; included in the bs system, the procedure returns the claims
; for the given key for that disc.
;
a8: ds. w3 h10.+4 ; get claims: (fp exception routine dump area used)
rs. w1 h10.+0 ; save (w2, w3); save return;
zl w2 64 ;
sl w2 9 ; if monitor release > 8 then
am 1 ; key := key * 4 else
ls w0 1 ; key := key * 2 ;
hs. w0 b2. ;
al w0 -2 ;
sh w2 8 ; if monitor <= 8 then
hs. w0 b12. ; decr := -2;
rl w0 92 ; w0 := first drum;
rl w1 96 ; last device :=
al w1 x1-2 ; top discs - 2;
rs. w0 b1. ; first device := first drum;
\f
; fgs 1988.05.01 fileprocessor connect output, page ...7a...
; segment 1
rl. w2 h54.+2 ; w2 := first word of docname;
sh w2 3 ; if docname (1) <> (0, 1, 2, 3) then
jl. a12. ; begin <*docname specified*>
al. w3 h54.+2 ;
jd 1<11 + 4 ; w0 := proc descr addr (docname);
sn w0 0 ; if process exists then
jl. a12. ; begin
am (0) ; w0 :=
rl w0 24 ; chaintable addr (docname);
a25: rl w2 x1 ; loop: w2 := device.chaintable address;
sn w2 (0) ; if device.chaintable address <>
jl. a39. ; doc .chaintable address then
; begin
al w1 x1-2 ; device := device -2;
jl. a25. ; goto loop;
; end;
a39: rs. w1 b1. ; first device := last device := device found;
; end process exists;
; end docname specified;
a12: al w0 0 ;
rs. w0 h10.+8 ; max slices := 0;
a9: rl w2 x1 ; next device:
rl. w3 h16. ; w2 := device.chaintable address;
wa w3 x2-36 ; w3 := device.key zero claims;
rs. w3 h10.+12 ; save device.key zero claims;
al w0 2047 ; min slices :=
jl. w2 a3. ; convert to segments (
rs. w0 h10.+10 ; + infinity);
b2 = k + 1 ; key * (if mon rel < 9 then 2 else 4);
al w3 x3+0 ; w3 := device.slice claims.key
\f
; fgs 1988.05.01 fileprocessor connect output, page ...7b...
; segment 1
a10: zl w0 64 ; next key:
sl w0 9 ; if monitor release <= 8 then
jl. a36. ; begin <*halfwords*>
rl w0 6 ; device key :=
ws. w0 h10.+12 ; (device.key claims -
ls w0 -1 ; device.key0 claims) > 1;
zl w2 x3 ; w2 := entry claims;
sh w0 1 ; if device key <= 2 then
al w2 1 ; w2 := 1;
zl w0 x3+1 ; w0 := slice claims;
jl. a37. ; end else
a36: rl w0 6 ; begin
ws. w0 h10.+12 ; device key :=
ls w0 -2 ; (device key claims - device.key0 claims) > 2;
rl w2 x3 ; w2 := entry claims;
sh w0 1 ; if device key <= 2 then
al w2 1 ; w2 := 1;
rl w0 x3+2 ; w0 := slice claims;
a37: ; end;
sh w2 0 ; if entry claim = 0 then
al w0 0 ; slice claim := 0;
jl. w2 a3. ; convert to segments (slice claim);
sh. w0 (h10.+10) ; if slice claim <= min slices then
rs. w0 h10.+10 ; min slices := slice claim;
b12=k+1 ; decr:
a29: al w3 x3-4 ; decrease sliceclaim key address by decr;
sl. w3 (h10.+12) ;
jl. a10. ;
; if claim key addr >= claim key 0 address then
; goto next key;
rl w2 x1 ; device := chaintable;
rl. w0 h10.+10 ;
sl. w0 (h10.+8) ; if min slices >= max slices then
jl. a11. ;
jl. a38. ; begin
a11: rs. w0 h10.+8 ; max slices := min slices;
rs. w2 h10.+14 ; best device := device;
rl w0 x2-8 ; slice length := slice length (device);
rs. w0 h10.+6 ; end;
a38: al w1 x1-2 ; device := device - 2;
sl. w1 (b1.) ; if device <> first device then
jl. a9. ; goto next device;
\f
; fgs 1988.05.01 fileprocessor connect output, page ...7c...
; segment 1
rl. w2 h10.+14 ; get best device;
dl w0 x2-16 ; move
ds. w0 h54.+4 ; chaintable.docname
dl w0 x2-12 ; to
ds. w0 h54.+8 ; filedescriptor.docname;
rl. w0 h10.+8 ; w0 := max slices in segments;
dl. w3 h10.+4 ; restore (w2, w3);
jl. (h10.) ; return;
\f
; fgs 1988.05.01 fileprocessor connect output, page ...7d...
; segment 1
; procedure convert to segments (slices);
;
; call : return :
;
; w0 : slices slices * slicelength
; w1 : name table entry unchanged
; w2 : link address chaintable
; w3 : device.slice claims.key unchanged
b. b3 ; begin block
w.
a3: rs. w2 b2. ; save return;
rl w2 x1 ; w2 := chain table entry;
rs. w3 b3. ; save w3;
wm w0 x2-8 ; slices := slices * slicelength;
rl. w3 b3. ; restore w3;
jl. (b2.) ; return;
b2: 0 ; saved return
b3: 0 ; saved w3;
i.
e. ; end block
\f
; fgs 1988.05.01 fileprocessor connect output, page ...7e...
; segment 1
; procedure convert to slices (w3, slicelength);
;
; call : return :
;
; w0 : - unchanged
; w1 : - destroyed
; w2 : link destroyed
; w3 : value (value - sign)//slicelength + sign
; h10.+6 : slicelength slicelength
;
a4: rs. w2 h10.+0 ; entry: save return;
sh w3 0 ; i :=
am +2 ; sign (value);
al w1 -1 ;
sn w3 0 ;
al w1 0 ;
wa w3 2 ; extend sign (w3);
el w2 6 ; value := ((value + i)//
el w2 4 ; slicelength - i) *
wd. w3 h10.+6 ; slicelength ;
ws w3 2 ;
jl. (h10.) ; return;
\f
; fgs 1988.05.01 file processor connect output, page ...7f...
; segment 1
b9: am -1 ; unknown:
a17: am 3 ; convention error:
a18: al w0 1 ; no resources:
rl. w1 c7. ; w1 := saved w1; w0 := result;
jl. h70. ; return;
e47: 1<23 + 4 ; mode, kind for backing storage;
b. g1 ; fill segment
g1 = (:h13+512-k:)/2
c. -1-g1 m. length error connect output 1
z.
c. -1+g1
w. 0, r.g1
z.
e.
m.fp connect out 1 89.02.02
\f
; fgs 1988.09.07 fileprocessor connect output, page ...8...
; segment 2
k = h13 ; start segment 2
w. 0 ; dummy word
; c4 : irrelevant
; c7 : zone addr or 0
; c9 : file descr addr
; c11: link
e0: rl. w2 c9. ; entry segment 2:
rl w0 x2 ; w2 := addr file descr; w0 := file descr.kind;
zl w1 1 ; kind := file descr.kind >
ls w1 -1 ; 1;
sl w1 e16 ; if kind > max kind then
jl. a27. ; goto convention error;
rs. w1 c4. ; save kind;
bl. w0 x1+e13. ;
rs. w0 h10. ; blocklength := standard(kind);
al w0 0 ;
rs w0 x2+10 ; name table address := 0;
bz w0 x2+16 ; algol or fortran procedures:
sn w0 4 ; if contents = 4
jl. a34. ; or
sh w0 31 ; contents >= 32
jl. a14. ; then
a34: ld w0 -65 ; filecount := blockcount := 0;
ds w0 x2+14 ;
a14: rl. w3 c7. ;
sn w3 0 ; if zone = 0 then
jl. a40. ; goto determine action;
bz w0 x3+h1+1 ;
al w3 x3+h1+2 ; if zone.kind = 4 then
sn w0 4 ; remove process(zone.name);
jd 1<11+64 ; comment result not checked;
a40: rl. w3 c4. ; w3 := kind > 1;
zl. w3 x3+e15. ; w3 := action address (kind);
a16: jl. x3+e0. ; switch to action(kind);
e49: 1<15 ; write enable bit
e48: 5<12 + 1<11 ; constant to be added to <mode,kind>
\f
; fgs 1989.02.02 fileprocessor connect output, page ...9...
; segment 2
; mount tape message to parent:
a20: 7<13 + 0<5 + 1 ; m(0) , pattern word , wait
<:mount <0>:> ; m(2:6)
a21: al. w1 a20. ; mount tape:
a22: al w2 x3 ;
jl. w3 h35. ; parent message(<:mount:>);
am (x2) ; test work tape:
se w3 x3 ; if first word(doc name) <> 0
jl. a23. ; then goto reserve tape;
dl. w1 h43.+2 ; move name from parent
ds w1 x2+2 ; answer to the file descriptor;
dl. w1 h43.+6 ; it will be moved to the zone-
ds w1 x2+6 ; descriptor later on;
e43 = k - e0 ; entry mag tape
a23: rl. w2 c9. ; reserve tape:
al w3 x2+2 ;
jd 1<11+6 ; initialize process(document);
se w0 0 ; if not ok
jl. a21. ; then goto mount tape;
\f
; fgs 1989.02.02 fileprocessor connect output, page ...10...
; segment 2
al w0 2047 ; set mode:
bz w1 x2 ;
la w0 2 ;
al w1 14 ;
hs w1 0 ; operation(message) :=
rs. w0 c10. ; set mode < 12 + mode
al. w1 c10. ;
jd 1<11+16 ; send message;
jd 1<11+18 ; wait answer;
rl. w2 c9. ; set position:
al w1 6 ;
al w0 8 ;
hs. w0 e48. ; ...change <operation> to <move>...
ls w0 12 ; message(0) := move < 12;
ds. w1 c10.+2 ; message(2) := 6;
dl w1 x2+14 ; message(4) := filecount;
ds. w1 c10.+6 ; message(6) := blockcount;
al. w1 c10. ;
jd 1<11+16 ; send message;
rs. w2 e37. ; init buf := message buffer address;
jl. e40. ; goto move description;
e25 = k - e0, e26 = e25 ; check and init:
a24: al w3 x2+2 ; check and reserve:
bz w1 x2+1 ; w1 := descriptor.kind;
al w0 0 ;
sn w1 4 ; if proc.kind = 4 then
jd 1<11+52 ; create area process;
se w0 0 ; if result <> 0 then
jl. e30. ; goto set result;
jd 1<11+6 ; initialize process;
sn w0 0 ; if result = ok
jl. a31. ; then goto blank tape;
sn w0 1 ; if result = 1 then
jl. a26. ; goto access not allowed;
sn w0 2 ; if result = 2 then
jl. a30. ; goto no resources;
jl. a28. ; goto not present;
\f
; fgs 1988.09.07 fileprocessor connect output, page ...11...
; segment 2
e40: dl. w2 c9. ; move description:
al w0 0 ;
sn w1 0 ; if zone = 0 then
jl. e30. ; goto ok result;
dl w0 x2+2 ; move ( mode, kind, name,
sz w3 1 ; <*if kind odd then
al w3 x3-1 ; truncate kind*>
ds w0 x1+h1+2 ; name table address = 0,
dl w0 x2+6 ; filecount,
ds w0 x1+h1+6 ; blockcount)
dl w0 x2+10 ; from:
ds w0 x1+h1+10 ; filedescriptor
dl w0 x2+14 ; to:
ds w0 x1+h1+14 ; zone descriptor;
rs w0 x1+h1+16 ; segment count := blockcount;
al w0 1 ;
rs w0 x1+h2+4 ; partial word := 1;
al. w3 h68. ; if give up action < fp std error
sl w3 (x1+h2+2) ; then give up action :=
rs w3 x1+h2+2 ; fp std error;
rl w3 x1+h0+6 ;
rs w3 x1+h0+4 ; used share := first share;
rl w0 x3+2 ;
bs. w0 1 ; record base :=
rs w0 x1+h3+0 ; first share(used share) - 1;
ba. w0 -5 ;
wa. w0 h10. ; last byte :=
rs w0 x1+h3+2 ; record base + 2 + blocklength - 2;
; set shares:
e46: bl w0 x1+h1+0 ; for share := first share step
wa. w0 e48. ; 1 until last share do
rs w0 x3+6 ; begin
rl w0 x3+2 ; message(0) :=(if magtape then move else 5<12)+ mode;
rs w0 x3+8 ; message(2) := first shared;
rs w0 x3+22 ; top transferred := first shared;
wa. w0 h10. ; message(4) := last address of transfer :=
rs w0 x3+4 ; first shared + block length(kind) - 2
rs w0 x3+10 ;
al w0 0 ; message(4);
rs w0 x1+h3+4 ; record length := 0;
rs w0 x3 ; share state := 0;
al w3 x3+h6 ; end;
sh w3 (x1+h0+8) ;
jl. e46. ;
jl. e30. ; goto ok result;
\f
; fgs 1988.05.01 fileprocessor connect output, page ...12...
; segment 2
a26: am 1 ; not allowed:
a27: am 1 ; convention error:
a28: am 1 ; not user, not exist:
am 1 ; malfunction:
e34=a27-e0, e35=a26-e0 ;
a30: al w0 1 ; no resources:
e30: rl. w1 c7. ; ok result:
rl. w2 e37. ; w0 := result;
se w1 0 ; if zone <> 0 then
rs w2 (x1+h0+4) ; state(first share) := init buf;
se w2 0 ;
se w1 0 ; if zone <> 0 or init buf = 0 then
jl. h70. ; return;
al. w1 c10. ;
am. (c9.) ;
al w3 2 ; w3 := addr(name);
jd 1<11+18 ; wait answer;
se w0 1 ; w0 :=
am 5 ; if result = 1 then 0
al w0 0 ; else 5;
rl. w1 c7. ; restore w1;
jl. h70. ; resturn;
a31: se w1 12 ; blank tape:
jl. e40. ; if process kind <> punch then
al w1 5 ; goto move description;
ls w1 12 ;
al w1 x1+2 ;
rs. w1 c10. ; operation(message) := 5 < 12 + even parity;
al. w0 b4. ;
al. w1 b5. ; set first core and last core;
ds. w1 c10.+4 ;
al. w1 c10. ;
jd 1<11+16 ; send message;
jd 1<11+18 ; wait answer;
jl. e40. ; goto move description;
b4: 0, r.40 ; 100 blanks
b5 = k-2 ;
e37: 0 ; init buf;
\f
; fgs 1982.11.29 fileprocessor connect output, page ...12...
; segment 2
h. ; action table
e15: ; action ; kind action
e26 ; ip check and init
e34 ; clock convention error
e25 ; area check and reserve
e25 ; disc check and reserve
e26 ; tw check and init
e34 ; tr convention error
e25 ; tp check and reserve
e25 ; lp check and reserve
e34 ; cr convention error
e43 ; mt reserve tape
e25 ; pl check and reserve
h. ; blocklength table
e13: ; bytes ; kind no of characters
512-2 ; ip 768
0-2 ; clock 0
512-2 ; area 768
512-2 ; disc 768
104-2 ; tw 156
36-2 ; tr 56
80-2 ; tp 120
80-2 ; lp 120
80-2 ; cr 120
512-2 ; mt 768
80-2 ; pl 120
e16 = k - e13
w.
b. g1 ; fill segment
g1 = (:h13+512-k:)/2
c. -g1 m. length error connect output 2
z.
w. 0, r.g1
e.
e. ; end connect output
m.fp connect out 2 89.02.02
\f
; rc 26.10.73 file processor stack/unstack, page 0
; implementation of stack/unstack zone
;
; first stack zone is considered. if a stack chain area already
; exists, it is extended (if necessary) and the zone is stacked after
; the latest stacked zone. if either no stack area exists or the area
; cannot be extended, a new area is created, preferably on drum.
; the stack chain is always updated to give the name of the stack
; area, and the area for zone stacking is administered as follows:
; 1. the entire zone buffer occupies an integral number of segments.
; 2. the following segment contains:
; 2.1. the zone descriptor;
; 2.2. all share descriptors (max 498 bytes);
; 2.3. the old stack chain (8 bytes);
; 2.4. length in segments of former stacking (2 bytes);
; 2.5. +-infinity, or if the stacked zone is connected to an area,
; the base of the connected area process (4 bytes).
; if the zone which is to be stacked is connected to an area
; process, the area process is removed.
;
; both stack and unstack will be made at the std base, ensuring
; that the stack area(s) can always be found. after stack/unstack, the
; cat base is reestablished.
; the area entry of the stack area is used like this:
; tail+0 : size ; >=necessary segments
; +(2:12): name of bsdevice, 0, 0;
; +14 : block ; first seg. of latest stacking
; +16 : 5<12+0 ; content=5
; +18 : length (segm) ; segs. used for latest stacking
; note that the length part is in segments, and that the value of
; size is not used.
;
; zone unstacking will proceed in the reverse way of stacking.
; if the unstacked zone had been connected to an area process, this
; is reestablished with a cat base determined by catbase:= if
; saved_base < maxbase then saved_base else maxbase. the name table
; address in the zone is reestablished by means of send (unintell.)
; message - wait answer.
\f
; fgs 1982.12.09 file processor, stack, page ...1...
; stack medium:
s. k=h13, e48, j24 ; begin
w. 512 ; length ; segment 6:
e0: rl. w2 h16. ; treat break:
dl w0 x2+36 ; save old im and old ia;
ds. w0 e11. ; set interrupt (stack break,0);
al w0 0 ; comment: this is done in order
al. w3 e0.+2 ; to transfer control to the call
jd 1<11+0 ; of remove entry (work area).
jl. j0. ; otherwise the area claim may
10; stack error ; be exceeded and the area forgotten;
jl. 2, r.(:e0+2+h76-k+2:)>1
; goto restore used;
e30: al. w3 e10. ; stack break:
jd 1<11+48 ; remove entry(stack work area);
rl. w3 e11. ; if old ia=0 then
sn w3 0 ; goto fp break;
jl. h10.+h76 ;
dl. w1 e0.+4 ; move registers to old ia area;
ds w1 x3+2 ; comment: if e30 was entered because
dl. w1 e0.+8 ; of errors in stacking the register
ds w1 x3+6 ; values are undefined, however:
dl. w1 e0.+12 ; the cause is set to 10 to indicate
ds w1 x3+10 ; the situation;
rl. w1 e0.+14 ;
rs w1 x3+12 ;
rl. w0 e12. ; set interrupt (old ia, old im);
jd 1<11+0 ; goto old ia+h76;
al w3 x3+h76 ; comment: first is the io-segment
jl. j1. ; restored;
e26: am 1 ; stackerrors: zone descriptor
e27: am 1 ; transport
e28: am 1 ; create error
e29: al w3 0 ; zone size...
rs. w3 e0.+12 ; set breakaddress to errorkey...;
jl. e30. ; goto stack break;
e10: 0, r.5 ; working name, init to zero.
e12: -1 ; old interrupt mask
e11: -1 ; old interrupt address
e9: 0, r.10 ; entry tail for work area
e16: 5<12 ; output message
e15: 0 ; first address
e14: 0 ; last address
e13: 0 ; init to zero ; segment number
-8388608 ;
e17: 8388607 ; saved process bases
e18: 0 ; work size
e19: 0 ; saved length
-8388608 ;
e20: 8388607 ; saved area process bases
\f
; fgs 1985.03.07 file processor, stack, page ...2...
; procedure remove area process (zone, process bases);
;
; call: return:
;
; w0 : - destroyed
; w1 : c16 : zone addr zone addr
; w2 : link link
; w3 : - destroyed
;
; e20: -2 : process bases
;
e7: rs. w2 e0.-2 ; remove area process: save link;
rl w3 x1+h1+10 ;
sl w3 (76) ; if name table address does not belong
sl w3 (78) ; among area and pseudo processes then
jl x2 ; return;
rl w3 x3 ; w3 := proc descr addr;
al w0 4 ;
se w0 (x3) ; if process kind <> 4 then
jl x2 ; return;
dl w1 x3-2 ;
ds. w1 e20. ; area process bases := bases (process);
rl. w3 h16. ;
dl w1 x3+70 ; save cat bases;
ds. w1 e17. ;
dl. w1 e20. ;
rl w2 x3+74 ; bases :=
sl w0 (x3+72) ; if lower proc base >= lower max base and
sl w1 x2+1 ; upper proc base <= upper max base then
dl w1 x3+74 ; proc base else max base;
al. w3 e9. ; w3 := name addr (null name);
jd 1<11+72 ; set cat base (bases);
rl. w1 c16. ; w1 := zone addr;
al w3 x1+h1+2 ; w3 := name addr (area process);
jd 1<11+64 ; remove area process;
al. w3 e9. ;
dl. w1 e17. ;
jd 1<11+72 ; set catbase (old cat base);
rl. w1 c16. ; w1 := zone address;
jl. (e0.-2) ; return;
; procedure transport (mess)
e23: rs. w3 e0.-2 ; transport: save link;
al. w1 e16. ; repeat:
al. w3 e10. ; mess:= output message;
jl. w2 h11. ; name:=stack work area name;
sn w0 1 ; message (mess,name);
sh w0 (x1+0) ; if result <> 1 or
jl. e27. ; statusword.answer <> 0
rl w2 x1+2 ; then goto stack break;
sh w2 0 ; if bytes transferred = 0
jl. e23.+2 ; then goto repeat;
jl. (e0.-2) ; return;
\f
; fgs 1985.03.07 file processor, stack, page ...2a...
j0: rl. w1 c16. ; restore used:
rl. w0 c18.-2 ; used share:=saved used share;
rs w0 x1+h0+4 ; record base:=saved record base;
dl. w0 c27.+0 ; last byte:=saved last byte;
ds w0 x1+h3+2 ;
bz w2 x1+h1+1 ; if kind.zone=area then
sn w2 4 ; goto remove area;
jl. w2 e7. ; zone size:=last byte buf - base buf;
rl w3 x1+h0+2 ; if zone size mod 512 <> 0
ws w3 x1+h0+0 ; then goto stack break;
sz w3 511 ;
jl. e29. ; work size:=zone size/512+1;
ls w3 -9 ; first word.tail:=work size;
al w3 x3+1 ;
rs. w3 e18. ;
rl. w3 h16. ;
dl w1 x3+78 ; std base:=own proc(78);
dl w3 x3+70 ; cat base:=own proc(70);
ds. w3 e17. ; save catbase;
al. w3 e9. ; w3 := name addr (null name);
jd 1<11+72 ; set cat base (std base);
rl. w3 c17.-2 ;
al. w1 e9. ; look up entry
jd 1<11+42 ; (tail area, chain);
bz. w2 e9.+16 ; if not looked up
rl. w0 e9. ; or content <> 5
sn w2 5 ; or size < 0
sh w0 -1 ; then
jl. e6. ; goto new;
rl. w0 e18. ; w0:=length;
rx. w0 e9.+18 ; length:=work size;
rs. w0 e19. ; saved length:=w0;
wa. w0 e9.+14 ;
rs. w0 e13. ; first segment:=block:=
rs. w0 e9.+14 ; block + saved length;
wa. w0 e18. ;
rs. w0 e9. ; size:=block + work size;
jd 1<11+44 ; change entry;
sn w0 6 ; if claims exceeded then
jl. e6. ; goto new;
se w0 0 ; if other errors then
jl. e28. ; goto create error;
dl w1 x3+2 ;
ds. w1 e10.+2 ; move chain to area name;
dl w1 x3+6 ;
ds. w1 e10.+6 ;
jl. e3. ; goto get area process;
\f
; fgs 1982.12.09 file processor, stack, page ...3...
e6: ld w1 -100 ; new:
ds. w1 e9.+4 ;
ds. w1 e9.+8 ; clear entry tail
ds. w1 e9.+12 ;
rs. w1 e9.+14 ;
rs. w1 e13. ; first segm := 0;
rl. w0 e16. ; content := 5;
rl. w1 e18. ; length:=
ds. w1 e9.+18 ; size:=
rs. w1 e19. ; saved length:=
rs. w1 e9. ; work size;
al. w1 e9.
al. w3 e10. ; create entry
jd 1<11+40 ; (tail, entry name);
se w0 0 ; if not created
jl. e28. ; then goto create error;
e3: al. w3 h40. ; get area process:
jd 1<11+64 ; remove process (<:fp:>);
al. w3 e10. ; create area process (work area);
jd 1<11+52 ; reserve process (work area);
jd 1<11+8 ;
rl. w1 c16. ; adjust message:
dl w0 x1+h0+2 ; first addr:= base buf+1;
al w3 x3+1 ; last addr:= last byte buf-1;
bs. w0 1 ; segment no:= 0;
ds. w0 e14. ;
jl. w3 e23. ; dump zone:
rl. w1 c16. ; transport(mess);
al w3 x1+h5+h0 ;
rl w2 x1+h0+0 ; save zone descriptor:
e1: rl w0 x1+h0+0 ; move descriptor to buffer area;
rs w0 x2+1 ;
al w1 x1+2 ; comment: the zone descr and all
al w2 x2+2 ; the share descriptors are moved
se w1 x3-h0-0 ; to the buffer area and output to
jl. e1. ; the last segment of the working area;
\f
; rc 05.02.74 file processor, stack, page ...4...
rl w1 x3-h5+6 ; save shares:
rl w3 x3-h5+8 ; move all share descriptors
e2: rl w0 x1+0 ; to the buffer area;
rs w0 x2+1 ;
al w1 x1+2 ; if not room then
al w2 x2+2 ; then goto stack break;
am. (e15.) ;
sl w2 497 ; comment only 1 segment is
jl. e26. ; used to hold all descriptors;
se w1 x3+h6 ;
jl. e2. ;
rl. w3 c17.-2 ;
dl w1 x3+2 ;
ds w1 x2+3 ; move name (chain) to
dl w1 x3+6 ; first 8 bytes following
ds w1 x2+7 ; the saved shares
rl. w1 e19. ; move old length
rs w1 x2+9 ; and
dl. w1 e20. ; area process bases
ds w1 x2+13 ; to next 6 bytes;
dl. w1 e10.+2 ;
ds w1 x3+2 ; move name of dump area(work)
dl. w1 e10.+6 ; to name(chain)
ds w1 x3+6 ;
\f
; fgs 1982.12.09 file processor stack, page ...5...
rl. w0 e9.+14 ; dump descriptors:
al w3 510 ; last addr:=first addr+510;
wa. w3 e15. ; segment no := block + work size-1;
wa. w0 e18. ;
bs. w0 1 ;
ds. w0 e13. ; transport(mess);
jl. w3 e23. ;
al. w3 e10. ;
jd 1<11+64 ; remove process (work area);
rl. w0 e12. ;
rl. w3 e11. ; set interrupt (old im, old ia);
jd 1<11+0 ;
dl. w1 c16. ; restore io-segment;
al w2 -2 ;
la w2 x1+h2+0 ;
rs w2 x1+h2+0 ; i-bit := 0;
ld w3 -100 ; clear document name and n.t.addr. of zone
rs w3 x1+h1+10 ; which will cause no release
ds w3 x1+h1+4 ; if unstack is called before
ds w3 x1+h1+8 ; connect is ok;
al w3 x1+h1+2 ;
dl. w1 e17. ;
jd 1<11+72 ; set catbase(saved bases);
dl. w3 c17. ;
j1: ds. w3 c11. ; return to user;
dl. w1 c16. ; restore w0,w1
jl. h70. ;
b. g1 ; begin
g1= (:h13+512-k:)/2 ; fill up segment to 512 bytes;
c. -g1 m.length error on fp segment 6
z. ;
w. 0, r.g1 ; zero fill
e. ; end fill up;
m.fp stack zone 85.03.07
i. ; maybe names;
e. ; end stack medium;
\f
; rc 76.02.02 file processor, unstack, page ...1...
; unstack medium:
s. k=h13, e48, j24 ; begin
w. 512 ; length ; segment 7:
e0: rl. w2 h16. ; treat breaks:
dl w0 x2+36 ; save old im and old ia;
ds. w0 e11. ; set interrupt (unstack break,0);
al w0 0 ; comment: this is done in order
al. w3 e0.+2 ; to transfer control to the call
jd 1<11+0 ; of remove entry (work area);
jl. j0. ; otherwise the area will not be removed;
10 ; stack error ; goto stop transports;
jl. 2, r.(:e0+2+h76-k+2:)>1
e30: al. w3 e10. ; unstack break:
jd 1<11+48 ; remove entry (stack work area);
rl. w3 e11. ; if old ia=0 then
sn w3 0 ; goto fp break;
jl. h10.+h76 ;
dl. w1 e0.+4 ; move registers to old ia area;
ds w1 x3+2 ; comment: if e30 was entered because
dl. w1 e0.+8 ; of errors in the unstacking then
ds w1 x3+6 ; the registers are undefined, however:
dl. w1 e0.+12 ; the cause is set to 10 to indicate
ds w1 x3+10 ; the situation;
rl. w1 e0.+14 ;
rs w1 x3+12 ;
rl. w0 e12. ; set interrupt (old ia, old im);
jd 1<11+0 ; goto old ia+14;
al w3 x3+h76 ; comment: restore the io-segment
rs. w3 c11. ; before leaving the unstack segment;
jl. j1. ;
e27: am 1 ; unstack errors: transport
e28: am 1 ; entry not found
e29: al w3 4 ; zone size...
rs. w3 e0.+12 ; set breakaddress to errorkey...;
jl. e30. ; goto unstack break;
e9: 0, r.10 ; look up area
e10: 0, r.5 ; stack work area name
e12: -1 ; old interrupt mask
e11: -1 ; old interrupt address
e16: 3<12+0 ; input message
e15: 0 ; first address
e14: 0 ; last address
e13: 0 ; segment number
0 ;
e18: 0 ; own process bases
e19: 0 ; null (used as such)
0 ;
e20: 0 ; area process bases
e21: -8388608 ; minus infinity
\f
; fgs 1985.03.07 file processor, unstack, page ...2...
; procedure transport (mess);
e23: rs. w3 e0.-2 ; transport: save link;
al. w1 e16. ; repeat:
al. w3 e10. ; mess: input message;
jl. w2 h11. ; name:= stack work area name;
sn w0 1 ; message (mess,name);
sh w0 (x1+0) ; if result <> 1 or
jl. e27. ; status word.answer <> 0
rl w2 x1+2 ; then goto unstack break;
sh w2 0 ; if bytes transferred=0
jl. e23.+2 ; then goto repeat;
jl. (e0.-2) ; return;
; procedure remove area process (zone);
;
; call: return:
;
; w0 : - destroyed
; w1 : c7 : zone addr zone addr
; w2 : link link
; w3 : proc name addr destroyed
;
e7: rs. w2 e0.-2 ; remove area process: save link;
rl w3 x1+h1+10 ; w3 := zone.proc.name table addr;
sl w3 (76) ; if name table address does not belong
sl w3 (78) ; among area and pseudo processes then
jl x2 ; return;
rl w3 x3 ; w3 := proc address;
al w0 4 ;
se w0 (x3) ; if zone.proc.kind <> 4 then
jl x2 ; return;
dl w1 x3-2 ; area process bases :=
ds. w1 e20. ; proc.bases;
rl. w3 h16. ;
dl w1 x3+70 ;
ds. w1 e18. ; save cat base;
dl. w1 e20. ;
rl w2 x3+74 ; bases :=
sl w0 (x3+72) ; if lower proc base >= lower max base and
sl w1 x2+1 ; upper proc base <= upper max base then
dl w1 x3+74 ; proc base else max base;
al. w3 e19. ; w3 := name addr (null name);
jd 1<11+72 ; set cat base (bases);
rl. w1 c7. ;
al w3 x1+h1+2 ; w3 name address (area process);
jd 1<11+64 ; remove area process;
al. w3 e19. ;
dl. w1 e18. ;
jd 1<11+72 ; set cat base (saved cat base);
rl. w1 c7. ; w1 := zone address;
jl. (e0.-2) ; return;
\f
; fgs 1985.03.07 file processor, unstack, page ...2a...
j0: rl. w2 (c9.) ; stop transports:
sn w2 0 ; if first word (name chain) = 0
jl. j5. ; then goto done1;
rl. w1 c7. ;
rl w3 x1+h0+6 ; zone:= zone in unstack param;
e1: rl w2 x3 ; wait transport:
al. w1 h43. ; for share:= first share step
sl w2 (86) ; share descr length until
jd 1<11+18 ; last share do
rl. w1 c7. ; if transport pending then
al w3 x3+h6 ; wait answer (state.share, irr, irr);
sh w3 (x1+h0+8) ; comment: no checking;
jl. e1. ;
bz w2 x1+h1+1 ; release file:
al w3 x1+h1+2 ; release process (process name.zone);
jd 1<11+10 ; if kind.zone=backing store then
sn w2 4 ; remove process (process name.zone);
jl. w2 e7. ;
rl w3 x1+h0+2 ; length:= last byte.zone - base.zone;
ws w3 x1+h0+0 ; if length modulo 512 <> 0
sz w3 511 ; then goto unstack break;
jl. e29. ;
rl. w3 h16. ;
dl w1 x3+78 ; saved proc base:=
dl w3 x3+70 ; base(own process);
ds. w3 e18. ;
al. w3 e19. ;
jd 1<11+72 ; set catbase(standard base);
rl. w3 c9. ;
dl w1 x3+2 ; save name at name chain;
ds. w1 e10.+2 ; comment: to save the name;
dl w1 x3+6 ;
ds. w1 e10.+6 ;
\f
;rc 15.10.73 file processor, unstack, page ...3...
al. w1 e9. ;
jd 1<11+42 ; lookup (name, wtail);
se w0 0 ; if not found then
jl. e28. ; goto unstack break;
al. w3 h40. ; get area process:
jd 1<11+64 ; remove process (<:fp:>);
al. w3 e10. ; create area process (entry name);
jd 1<11+52 ; comment: no checking;
rl. w2 c7. ;
rl. w0 e9.+14 ; segment no.mess:= block + length -1;
wa. w0 e9.+18 ;
bs. w0 1 ; first address.mess:= base.zone +1;
al. w1 e16. ; last address.mess:= first address+510;
rs w0 x1+6 ;
rl w3 x2+h0+0 ; transport (saved zone descriptor);
al w3 x3+1 ;
al w0 x3+510 ; init move:
ds w0 x1+4 ; from:= first address;
jl. w3 e23. ; to:= zone descriptor address;
rl. w2 c7. ;
al w2 x2+h0 ; comment:
al w3 x2+h5 ; the zone descriptor is restored from
rl. w1 e15. ; the stacked zone;
\f
; rc 15.01.74 file processor, unstack, page ...4...
e4: rl w0 x1 ; move zone descr:
rs w0 x2 ; word (to):= word (from);
al w2 x2+2 ; to:= to+2;
al w1 x1+2 ; from:= from+2;
se w2 x3 ; if more then goto move zone descr;
jl. e4. ;
am. (c7.) ; move share descriptors:
dl w3 h0+8 ; to:= first share;
al w3 x3+h6 ; move next:
e5: rl w0 x1 ; word (to):= word (from);
rs w0 x2 ; to:= to+2;
al w2 x2+2 ; from:= from+2;
al w1 x1+2 ; if more then goto move next;
se w2 x3 ;
jl. e5. ;
rl. w2 c9. ;
dl w0 x1+2 ;
ds w0 x2+2 ; move unstacked chain-name
dl w0 x1+6 ; to name(chain);
ds w0 x2+6
rl. w0 e9.+14 ; segm no in mess :=
rs. w0 e13. ; size:=
rs. w0 e9. ; block;
rl w3 x1+8 ;
rs. w3 e9.+18 ; length:=saved length;
ws w0 6 ;
rs. w0 e9.+14 ; block:=block - length;
dl w0 x1+12 ;
ds. w0 e20. ; peripheral proc base:= saved base;
rl. w1 c7. ; prepare restoring of zone buffer:
dl w0 x1+h0+2 ;
al w3 x3+1 ; first address.mess:= base.zone+1;
bs. w0 1 ; last address.mess:= last byte.zone-1;
al. w1 e16. ; segment no.mess:= 0;
ds w0 x1+4 ;
jl. w3 e23. ; transport(mess, zone buffer);
\f
; fgs 1985.03.07 file processor, unstack, page ...5...
j3: al. w3 e10. ; unstack ok:
rl. w0 e9. ;
se w0 0 ; if entry size = 0
jl. 6 ; then
jd 1<11+48 ; remove entry(work area)
jl. j4. ; else
jd 1<11+64 ; remove area process (work area)
al. w1 e9. ; change entry(tail, work area);
jd 1<11+44 ;
j4: se w0 0 ; if impossible
jl. e28. ; then error(not found);
dl. w1 e20. ; if area process bases
sn. w0 (e21.) ; = infinity
jl. j2. ; then goto unstack done;
rl. w2 h16. ; comment always area process: ;
rl w3 x2+74 ;
sl w0 (x2+72) ; if area process bases
sl w1 x3+1 ; outside max base
dl w1 x2+74 ; then base:=maxbase else base:=area proc base;
al. w3 e19. ; w3:= nullname;
jd 1<11+72 ; then set catbase(base);
al w0 0 ;
am. (c7.) ;
al w3 h1+2 ;
rs w0 x3+8 ; nametabaddr.zone := 0;
jd 1<11+52 ; create area process(name.zone);
al. w1 e21. ;
jd 1<11+16 ; send dummy message(area process);
al. w1 e9. ; comment in order to establish n.t.addr ;
jd 1<11+18 ; wait answer(dummy message);
j2: dl. w1 e18. ; unstack done:
al. w3 e19. ;
jd 1<11+72 ; own proc, saved catbase);
j5: rl. w0 e12. ; done1:
rl. w3 e11. ; set interrupt (saved im,ia);
jd 1<11+0 ; load and enter io-segment;
j1: dl. w1 c7. ; with return to the user;
jl. h70. ;
b. g1 ; begin
g1= (:h13+512-k:)/2 ; fill up segment to 512 bytes;
c. -g1 m.length error on fp segment 7
z. ;
w. 0, r.g1 ; zero fill
e. ; end fill up;
m.fp unstack zone 85.03.07
i. ; maybe names
e. ; end unstack medium;
\f
\f
\f
; fgs 1988.12.09 file processor, magtape check, page ...1...
; this segment is called when special status bits are set for
; operations with magnetic tapes.
s. k=h13, e48 ; begin
w. 512 ; length ; segment 8:
dl. w0 c11. ; w0:=remaining bits;
dl. w2 c5. ; w1,w2:=zone,share;
jl. e1. ; goto magnetic tape;
e2: 1<22+1<20+1<19+1<7 ; test parity, w. defect, overrun, b.l. error and position
e3: 1<15 ; = 8<12 ; test write-enable; move operation
e4: 1<16 ; test tape mark
e5: 6<12 ; erase operation
8<12 ; move operation
e6=h0-h1-2 ; displacement zone-name
e8: 0 ; saved various
e7: 0 ; erasures
e9: 8.5703 6031 ; hard error mask
e34: 1<22 ; test parity
e35: 0 ; reposition count
e31: <:<25><0><0>:> ;
; repeat:
e10: al w3 x1+h1+2 ; repeat:
e14: al w1 x2+6 ; w3:=name address;
jd 1<11+16 ; w1:=message address;
rs w2 x1-6 ; send message(w3,w1,buf);
al w2 x1-6 ; state.share:=buf addr;
e13: al w2 x2+h6 ; next share:
sh w2 (x3+e6+8) ; share:=share+share descr length;
jl. e11. ; if share>last share
rl w2 x3+e6+6 ; then share:=first share;
e11: rs. w2 e8. ; save share;
sn w2 (x3+e6+4) ; if share=used share
jl. e12. ; then goto check again;
rl w0 x2 ; if share is not pending
sh w0 1 ; then goto next share;
jl. e13. ; wait answer (buf,irr,irr);
al. w1 c10. ; restore saved share;
rl w2 x2 ; goto repeat;
jd 1<11+18 ; check again:
rl. w2 e8. ; goto wait transport;
jl. e14. ; return saved;
\f
; fgs 1989.01.25 file processor, magtape check, page ...1a...
e22: rl. w0 c22. ; stopped:
sn w0 0 ; if bytes transferred = 0
jl. e10. ; then repeat;
jl. e23. ; goto parity;
e20: ; update position:
se w3 10 ; if operation
sn w3 3 ; is input or output mark
jl. e15. ; then goto test tapemark;
sn w3 8 ; if operation = move then
jl. e15. ; goto check position;
sz w0 1<6 ; no update: if pos error
jl. e29. ; then prepare reposition;
jl. e16. ; else return;
e15: al w2 x3 ; check position:
dl. w0 c28. ;
se w2 8 ; if operation <> move then
ds w0 x1+h1+14 ; zone.file, block := answer.file, block;
sn w3 (x1+h1+12) ; if answer.file count <> zone.filecount
se w0 (x1+h1+14) ; or answer.block count <> zone.blockcount then
jl. e33. ; goto add position error bit;
rl. w2 c5. ; w2 := share;
bl w3 x2+6 ;
se w3 3 ; if operation <> input
jl. e16. ; then return;
; zone.first address := <:<25><0><0>:>;
rl. w0 e31. ; top transferred := first addr + 2;
rs w0 (x2+8) ; goto normal action;
rl w1 x2+8 ; comment: the return point to
al w1 x1+2 ; the io-segment must be set;
rs w1 x2+22 ;
e16: am h86-h87 ; normal action: set return
e12: am h87-h88 ; wait transport: set return
e17: al. w3 h88. ; give up: set return;
dl. w2 c5. ; w1,w2:=zone share;
ds. w3 c11. ; w3:=return point;
jl. h70. ; call and enter io-segment;
e33: al w3 1<6 ; add pos bit:
lo. w3 c10. ; status :=
rs. w3 c10. ; status or pos bit;
jl. e29. ; goto prepare reposition;
\f
; fgs 1989.01.31 file processor, magtape check, page ...2...
e1: bl w3 x2+6 ; magtape: w0:= remaining bits;
sz w0 1<5+1<2 ; if not exist or rejected message
jl. e21. ; then goto mount tape;
sz. w0 (e4.) ; if tape mark
jl. e20. ; then goto update position;
se w3 0 ; if operation = sense
sl w3 8 ; or operation = move , out tapemark or setmode then
jl. e29. ; goto prepare reposition;
sz. w0 (e2.) ; if parity or word defect or block l. err.or overrun
jl. e23. ; then goto parity;
e0: lo w0 x1+h2+0 ; no transport:
sn w3 3 ; if operation = input
jl. e16. ; goto return;
sz. w0 (e3.) ; if write-enable or give up mask
jl. e22. ; then goto stopped;
jl. w3 e37. ; parent message (<:mount ring:>);
jl. e24. ; goto reserve tape;
e21: sz w3 2.111 ; mount tape:
jl. e30. ; if sense or move then
jl. e16. ; goto return;
e30: ; <*the position is completed at next transfer*>
sz w0 1<5 ; if not exist then
e25: jl. w3 e38. ; parent message (<:mount:>);
e24: al w3 x1+h1+2 ; reserve tape:
jd 1<11+6 ; initialize process (proc.zone);
sl w0 2 ; if not existing or not user then
jl. e25. ; goto mount tape;
se w0 0 ; if not reserved then
jl. e17. ; goto give up;
rs. w0 c8. ; tries:= 0;
al w0 2047 ; operation :=
zl w3 x1+h1+0 ; 14 < 12 +
la w0 6 ; mode extract
al w3 14 ; 11;
hs w3 0 ;
al w3 e40 ; move action := repeat;
hs. w3 e39. ;
jl. e26. ; goto send;
\f
; fgs 1988.12.09 file processor, magtape check, page ...3...
; the following action implements the strategy for tape position. the
; routine will loop until the position matches the position count in
; the zone. when this is true, the switch -move action- determines what
; happens.
e29: al w1 0 ; prepare reposition:
rs. w1 e35. ; reposition count := 0;
e27: ; reposition:
dl. w2 c5. ; w1w2 := zone, share;
dl w0 x1+h1+14 ; w3w0 := zone.filecount, blockcount;
sn. w3 (c26.) ; if zone.filecount <> fileno in answer
se. w0 (c28.) ; or zone.blockcount <> block in answer then
jl. e28. ; goto prepare spool;
e39 = k + 1; move action ;
jl. e39. ; switch to move action;
e28: ; prepare spool:
ds. w0 c10.+6 ; mess.file, block := zone.file, block;
al w3 1<6 ; status :=
lo. w3 c10. ; status add
rs. w3 c10. ; position error;
rl. w3 e35. ; reposition_count :=
al w3 x3+1 ; reposition_count + 1;
sl w3 6 ; if reposition_count = 6 then
jl. e17. ; goto give up;
rs. w3 e35. ;
rl. w0 e3. ; w0 := move operation < 12 + 0;
al w3 6 ; w3 := setposition;
e26: rs. w0 c10. ; send: set operation from w0;
rs. w3 c10.+2 ; set move from w3;
al w3 x1+h1+2 ; w3:=name address;
al. w1 c10. ; w1:=message address;
jd 1<11+16 ; send message (w3,w1,buf);
jd 1<11+18 ; wait answer (buf,answer,result);
al w3 1 ; status:= 1 shift result;
ls w3 (0) ; if normal answer (result=1) then
dl. w2 c5. ; status:= status or statusword.answer;
sn w3 1<1 ;
lo. w3 c10. ; if not existing or rejected
rs. w3 c10. ; then goto magnetic tape;
al w0 x3 ;
sz w0 1<5+1<2 ; if hard errors then
jl. e1. ; goto give up;
sz. w0 (e9.) ;
jl. e17. ;
jl. e27. ; goto reposition;
\f
; fgs 1989.01.31 file processor, magtape check, page ...4...
e23: ; parity:
rl. w3 c8. ;
sl w3 15 ; if tries=15 then
jl. e17. ; goto give up;
al w3 x3+1 ; tries:= tries+1;
rs. w3 c8. ; erasures:= 0;
al w3 e42 ; move action:= prepare repeat;
hs. w3 e39. ;
rl w3 x1+h1+14 ; saved position :=
sl w3 1 ; if block count > 0 then
al w3 x3-1 ; block count - 1
al w0 0 ; else
ds. w0 e7. ; block count;
sl w3 1 ; block count :=
al w3 x3-1 ; if saved position > 0 then
rs w3 x1+h1+14 ; saved position - 1
; else
; saved position;
jl. e29. ; goto prepare reposition;
e42=k-e39+1 ; prepare repeat:
bz w0 x2+6 ; move action :=
rl. w2 c11. ; if -, parity
al w3 e43 ; or -, output then
sz. w2 (e34.) ; repeat
se w0 5 ; else
al w3 e40 ; erase; <*output and out mark*>
hs. w3 e39. ; block count :=
rl. w3 e8. ; saved position;
e48: rs w3 x1+h1+14 ;
jl. e29. ; goto prepare reposition;
e40=e10-e39+1 ; define repeat
e41=e16-e39+1 ; define return
\f
; fgs 1986.12.12 file processor, magtape check, page ...5...
e43=k-e39+1 ; erase:
rl. w3 e7. ; if erasures >= tries
sl. w3 (c8.) ; then goto repeat;
jl. e10. ; erasures:= erasures+1;
al w3 x3+1 ; operation:= erase;
rs. w3 e7. ; goto send;
rl. w0 e5. ;
jl. e26. ;
; mount ring message to parent:
e18: 9<13+0<5+1 ; m(0) , pattern word , wait
<:enable <0>:> ; m(2:6)
; mount tape message to parent:
e19: 7<13+0<5+1 ; m(0) , pattern word , wait
<:mount <0>:> ; m(2:6)
e37: am e18-e19 ; call parent message:
e38: al. w2 e19. ; w2 := message;
ds. w0 c22. ; save(w0,w3);
al w1 x1+h1+2 ; w1 := doc name addr;
rx w2 2 ; swap(w2,w1);
jl. w3 h35. ; parent message(w1,w2);
dl. w0 c22. ; restore(w0,w3);
dl. w2 c5. ; restore(w2,w1);
jl x3 ; return;
b. g1 ; begin
g1= (:h13+512-k:)/2 ; fill up segment to 512 bytes:
c. -g1 m.length error on fp segment 9
z. ;
w. 0 , r.g1 ; zero fill
e. ; end fill up;
m.fp magtape check 89.01.31
i. ; maybe names
e. ; end mag tape check;
\f
; fgs 1982.12.09 file processor, terminate zone, page ...1...
s. k=h13, e9,b6 ; begin segment: terminate zone;
w. 512 ; no of bytes on segment
e9: rl. w1 c16. ; terminate zone:
am. (c17.) ; w1 := zone addr;
se w3 x3+1 ; if called from io segment then
jl. e0. ; begin
rl. w2 c2. ; restore(w2: current share);
jl. (h19.+h4+4) ; return
; end;
e0: al w0 -1 ; start terminate:
rs. w0 h19.+h4+0 ; filemark := -1;
rx. w0 c17. ; called from io segment := true;
rs. w0 h19.+h2+6 ; save return to program;
rl w2 x1+h0+4 ; share := used share;
rs. w2 h19.+h4+2 ; saved used share := share;
e1: bz w0 x2+6 ; stop share:
al w3 18 ;
sn w0 5 ; if operation(share) = output then
rs. w3 h19.+h4+0 ; filemark := kind(magtape);
rl w3 x2 ; w3 := share state(share);
sh w3 1 ; if share is not pending then
jl. e3. ; goto set state;
sn w0 3 ; if operation(share) = input then
jl. e2. ; goto wait only;
jl. w3 e4. ; wait and free(share);
jl. e7. ; goto next share;
e2: ds. w2 c5. ; wait only: save(w1,w2);
al. w1 h66. ; w1 := answer area;
al w2 x3 ; w2 := share state;
jd 1<11+18 ; wait answer;
dl. w2 c5. ; restore(w1,w2);
e3: al w0 0 ; set state:
rs w0 x2 ; share state(share) := free;
e7: al w2 x2+h6 ; next share:
sh w2 (x1+h0+8) ; share := share + share length;
jl. 4 ; if share > last share then
rl w2 x1+h0+6 ; share := first share;
se. w2 (h19.+h4+2) ; if share <> saved used share then
jl. e1. ; goto stop share;
\f
; fgs 1984.09.04 file processor, terminate zone, page ...2...
bz w0 x1+h1+1 ; may be filemark:
se. w0 (h19.+h4+0) ; if process kind <> filemark then
jl. e8. ; goto blanks;
al w0 10 ; output filemark:
hs w0 x2+6 ; operation(share) := output mark;
al w3 x1+h1+2 ; w3 := addr(doc name);
al w1 x2+6 ; w1 := message address;
jd 1<11+16 ; send message;
sn w2 0 ; if buffer claim exceeded then
jd 1<11+18 ; provoke interrupt cause 6;
rs w2 x1-6 ; share state(share) := buffer address;
rl. w1 c16. ; restore zone addr;
rl. w2 h19.+h4+2 ; w2 := saved used share;
jl. w3 e4. ; wait and free(share);
e8: se w0 12 ; blanks:
jl. e5. ; if kind <> punch then
al w3 x1+h1+2 ; goto remove or release;
al. w0 b0. ;
al. w1 b1. ; set first and last core
ds. w1 b3. ; of message;
al. w1 b2. ;
jd 1<11+16 ; send message;
jd 1<11+18 ; wait answer;
rl. w1 c16. ; restore w1;
e5: al w3 x1+h1+2 ; remove or release:
bz w2 x1+h1+1 ; w3 := addr(doc name);
jd 1<11+10 ; release process;
sn w2 4 ; if process kind = backing store
jl. w2 e6. ; remove area process;
dl. w1 c16. ; finis terminate:
rl. w2 c17.-2 ; restore(w0,w1,w2);
rl. w3 h19.+h2+6 ; restore return to program;
ds. w3 c11. ; saved(w0,w3) := (w0,w3);
jl. h70. ; call and enter io segment;
\f
; fgs 1985.03.07 fileprocessor terminate zone, page ...2a...
e4: rs. w3 h19.+h4+4 ; call wait and free: save return;
ds. w1 c1. ; save(w0,w1);
al. w3 h78. ; return from io segment :=
ds. w3 c3. ; terminate zone segment;
al. w3 h48.+4 ; w3 := entry at wait and free;
ds. w3 c11. ;
jl. h70. ; call and enter io segment;
; procedure remove area process (zone);
;
;
;
; w0 : - destroyed
; w1 : c6 : zone address zone address
; w2 : link link
; w3 : zone.proc.name addr destroyed
;
e6: rs. w2 e9.-2 ; remove area process: save link;
rl w3 x1+h1+10 ; w3 := zone.proc.name table addr;
sl w3 (76) ; if name table adress does not belong
sl w3 (78) ; among area or pseudo processes then
jl x2 ; return;
rl w3 x3 ; w3 := proc descr addr;
al w0 4 ;
se w0 (x3) ; if proc.kind <> 4 then
jl x2 ; return;
dl w1 x3-2 ; area proc bases :=
ds. w1 b4. ; proc.bases;
rl. w3 h16. ;
dl w1 x3+70 ;
ds. w1 b6. ; save cat bases;
dl. w1 b4. ;
rl w2 x3+74 ; bases :=
sl w0 (x3+72) ; if lower proc base >= lower max base and
sl w1 x2+1 ; upper proc base <= upper max base then
dl w1 x3+74 ; proc base else max base;
al. w3 b0. ; w3 := name addr (null name);
jd 1<11+72 ; set cat base (bases);
rl. w1 c16. ; w1 := zone adddr;
al w3 x1+h1+2 ; w3 := name address (area process);
jd 1<11+64 ; remove area process;
al. w3 b0. ;
dl. w1 b6. ;
jd 1<11+72 ; set catbase (saved cat base);
rl. w1 c16. ; w1 := zone addr;
jl. (e9.-2) ; return;
b0: 0,r.40 ; 100 blanks
b1=k-2 ;
b2: 5<12+4 ; output, even parity;
0 ; first core;
b3: 0 ; last core;
0 ;
b4: 0 ; saved area proc bases;
0 ;
b6: 0 ; saved cat bases;
b. g1 ; begin block: fill segment with zeroes
g1 = (:h13+512-k:)/2 ;
c. -g1 m.length error, terminate zone
z.
w. 0, r.g1 ;
e. ; end block: fill segment
i. ; id list
e. ; end terminate zone
m.fp termin zone 85.03.07
m.
m.fp text 3 86.12.12
\f
; fp text 3
; fgs 1988.05.04 file processor, init, page ...1...
; initialize the file processor
s. k=h55, e48, b20 ; begin
w.1024 ; length ; segment 10:
e0: am. (h96.) ; fp init: skip next;
al w0 0 ; utility init: prim inout errors := 0;
rs. w0 h96. ;
al. w0 h12. ; word(first of process) :=
rs. w0 h12. ; first of process;
am. (h16.) ; parent:
rl w1 50 ; h17:=parent address;
rs. w1 h17. ; search the nametable
rl w2 78 ; to find the nametable address
al w2 x2+2 ; of the parent (to be used at
se w1 (x2-2) ; parent-messages);
jl. -4 ;
rx. w2 h44.+8 ;
rs. w2 b8. ; first:=(old addr=0);
al. w3 h10. ;
al w0 0 ;
jd 1<11+0 ; set interrupt (0,fp break);
am. (h16.) ; get parent name:
rl w2 50 ; w2:=parent;
dl w1 x2+4 ;
ds. w1 h44.+2 ; move parent name
dl w1 x2+8 ; to resident fp;
ds. w1 h44.+6 ;
rl. w1 h16. ; set catbase:
dl w1 x1+78 ; set catbase(standard);
al. w3 b4. ;
jd 1<11+72 ;
; initialize current out:
rl. w2 h15. ; create c:
rl w0 x2 ; kind := kind of prim out;
sl w0 20 ; if kind > 18 then
al w0 8 ; kind := tw;
wa. w0 b0. ;
al. w1 b1. ; tail(0) := 1<23 + kind;
rs w0 x1 ;
dl w0 x2+4 ;
ds w0 x1+4 ; tail(2:8) :=
dl w0 x2+8 ; process name(prim out);
ds w0 x1+8 ;
al. w3 b2. ;
e11: jd 1<11+40 ; create entry(<:c:>);
se w0 3 ; if not allready exists
jl. e12. ; then goto check created;
\f
; rc 06.10.72 file processor, init, page 2
al. w1 h54. ; c exists allready:
jd 1<11+42 ; lookup entry(c);
se w0 0 ; if not found
jl. e5. ; then goto failure;
dl. w3 b5. ; compare proc.names:
sn w2 (x1+2) ; if first part of name
se w3 (x1+4) ; does not fit
jl. e10. ; then goto remove c;
dl. w3 b6. ;
sn w2 (x1+6) ; if second part of name
se w3 (x1+8) ; does not fit
jl. e10. ; then goto remove c;
jl. e6. ; goto initialize curr in;
e10: al. w3 b2. ; remove c:
jd 1<11+48 ; remove entry(c);
al. w1 b1. ;
jl. e11. ; goto create c;
; check created:
e12: se w0 0 ; if not created then
jl. e5. ; goto failure;
; initialize current in:
e6: rl. w2 h17.-2 ; create v:
rl w0 x2 ; kind := kind of prim in;
sl w0 20 ; if kind > 18 then
al w0 8 ; kind := tw;
wa. w0 b0. ;
al. w1 b1. ; tail(0) := 1<23 + kind;
rs w0 x1 ;
dl w0 x2+4 ;
ds w0 x1+4 ; tail(2:8) :=
dl w0 x2+8 ; process name (prim in);
ds w0 x1+8 ;
al. w3 b3. ;
e13: jd 1<11+40 ; create entry(<:v:>);
se w0 3 ; if not allready exists
jl. e14. ; then goto check created;
al. w1 h54. ; v exists allready:
jd 1<11+42 ; lookup entry(v);
se w0 0 ; if not found
jl. e5. ; then goto failure;
dl. w3 b5. ; compare proc.names:
sn w2 (x1+2) ; if first part of name
se w3 (x1+4) ; does not fit
jl. e15. ; then goto remove v;
dl. w3 b6. ;
sn w2 (x1+6) ; if second part of name
se w3 (x1+8) ; does not fit
jl. e15. ; then goto remove v;
jl. e7. ; goto init zones;
e15: al. w3 b3. ; remove v:
jd 1<11+48 ; remove entry(v);
al. w1 b1. ;
jl. e13. ; goto create v;
; check created:
e14: se w0 0 ; if not created then
jl. e5. ; goto failure;
\f
; fgs 1986.12.12 file processor init, page ...3...
; initialize current zones and shares (max double buffered)
e7: rl. w3 h16. ; init current zones:
dl w2 x3+24 ;
al w1 x1-1+h53 ; base.prog:= first addr.proc - 1 + h53;
al w2 x2-21 ; last.prog:= top addr.proc -21;
ds. w2 h19.+h0+2 ;
al w1 x2-h91*512 ; base.out:= last.prog -h91*512;
ds. w2 h21.+h0+2 ; last.out:= last.prog;
al w3 x1+1 ; base.in:= base.out -h90*512-h53;
rs. w3 h82.+2 ; last.in:= base.out-h53;
e1: al w3 x3+512 ;
c. h91-2 ; comment: the init code will
rs. w3 h82.+2+h6 ; handle single and double
z. al w1 x1-h53 ;
al w0 x1-h90*512 ; buffered io zones;
ds. w1 h20.+h0+2 ;
ba. w0 1 ; first shared.first share.out:=
rs. w0 h81.+2 ; base.out +1;
c. h90-2 ;
ba. w0 e1.+1 ; first shared.last share.out:=
rs. w0 h81.+2+h6 ; base.out +1 + (h91-1)*512;
z. al. w0 h80. ; first shared.first share.in:=
rs. w0 h19.+h0+4 ; base.in +1;
rs. w0 h19.+h0+6 ; first shared.last share.in:=
rs. w0 h19.+h0+8 ; base.in +1 + (h90-1)*512;
al. w1 h81. ;
e2= (:h90-1:)*h6 ; set first,last share in prog;
al w2 x1+e2 ;
ds. w2 h20.+h0+8 ; set first,last share in out;
al. w1 h82. ;
e3= (:h91-1:)*h6 ; set first,last share in in;
al w2 x1+e3 ;
ds. w2 h21.+h0+8 ;
\f
; fgs 1986.12.12 file processor init, page ...3a...
rl. w2 h17.-2 ; prim proc := addr prim input proc;
; repeat:
e8: rl w0 x2 ; kind := prim proc.kind;
am. (h16.) ; addr (prim proc descr) :=
rl w1 +24 ; top own process -
e9=k+1 ; rel:
al w1 x1-20 ; rel;
rs w0 x1 ; stack.prim proc descr (0) :=
dl w0 x2+4 ; kind + 1<23;
ds w0 x1+4 ; stack.prim proc descr (2:8) :=
dl w0 x2+8 ; prim proc.name;
ds w0 x1+8 ;
el. w2 e9. ;
se w2 -20 ; if prim proc <> addr prim output proc then
jl. e18. ; begin
rs. w1 h17.-2 ; addr prim input proc := proc.top addr - 20;
al w0 -10 ; rel := -10;
hs. w0 e9. ; prim proc := addr prim output proc;
rl. w2 h15. ; goto repeat;
jl. e8. ; end;
e18: rs. w1 h15. ; addr prim output proc := proc.top addr - 10;
\f
; fgs 1988.05.02 file processor, init, page ...4...
e4: al w0 1<2 ; connect in and out:
al. w2 b2. ; no of segs := 1; permkey := 0;
jl. w3 h28.-2 ; connect out (c , out zone);
se w0 0 ; if result <> 0 then
jl. e5. ; goto failure;
al. w2 b3. ; connect in (v , in zone);
jl. w3 h27.-2 ; if result <> 0 then
se w0 0 ; goto failure;
jl. e5. ;
al w0 0 ; curr in.give up mask := curr out.give up mask :=
al. w1 h68. ; 1; <*i-bit*>
ds. w1 h92. ; curr prog.give up mask :=
al w0 1 ; 0;
ds. w1 h93. ; curr in.give up act. := curr out.give up act. :=
ds. w1 h94. ; curr prog.give up act. := fp std error;
rl. w3 h20.+h0+0 ; init command pointers:
al w3 x3-1-h53 ; current command pointer:=
rs. w3 h8. ; last of commands:=
rs. w3 h9. ; base.in -1-h53;
am. (b8.) ;
se w1 x1 ; if first init then
jl. e19. ; begin
; al. w3 b13. ;
; jd 1<11+4 ; addr of process (<:s:>);
; rl. w1 h17. ;
; sn w0 x1 ; if addr of parent process = addr of <:s:> then
; am 1<10 ; add bswait to fp mode bits;
al w2 1<9 ; mode.initmess :=
lo. w2 h51. ; yes;
rs. w2 h51. ;
jl. e16. ; end else
e19: ; begin <*not first*>
al. w3 h50. ; if stack chain is used
rl. w0 h50. ; then
se w0 0 ; remove entry(stack chain);
jd 1<11 + 48 ; comment do not check the result;
al w0 0 ; stack chain := 0;
rs. w0 h50. ;
rs. w0 h94.-2 ; curr out.give up mask := 0; <*i-bit*>
al w0 -1-1<7 ;
la. w0 h51. ; if bit := 0;
rs. w0 h51. ;
al. w0 b7. ; outtext(<:***fp reinitialized:>);
jl. w3 h31.-2 ;
rl. w0 h51. ;
so w0 1<9 ; if mode 14.no then <*mode reinitmess.no*>
jl. e17. ; begin mode initmess.yes
; the following code is skipped at reinit when mode.14 = 0;
al w2 10 ;
jl. w3 h26.-2 ; outchar (out, 'nl');
; am. (h16.) ;
; al w0 +2 ; outtext (out, <own process name>);
; jl. w3 h31.-2 ;
; al. w0 b12. ;
; jl. w3 h31.-2 ; outtext (out, <: started with :>);
al. w0 h40. ;
jl. w3 h31.-2 ; outtext (out, <:fp:>);
al. w0 b10. ;
jl. w3 h31.-2 ; outtext (out, <: version:>);
rl. w0 h52.-2 ;
jl. w3 h32.-2 ; outinteger (out, <<dd>, version);
32<12+2 ;
al. w0 b11. ;
jl. w3 h31.-2 ; outtext (out, <: release:>);
zl. w0 h52. ;
jl. w3 h32.-2 ; outinteger (out, <<ddd>, release);
32<12+3 ;
al w2 46 ;
jl. w3 h26.-2 ; outchar (out, '.');
zl. w0 h52.+1 ;
jl. w3 h32.-2 ; outinteger (out, <<d>, subrelease);
48<12+2 ;
al w2 10 ;
jl. w3 h26.-2 ; outchar (out, 'nl');
e17: ; end <*mode 14.no*>;
al w2 10 ;
jl. w3 h34.-2 ; close up (out, 'nl');
am 2 ; prepare call and enter end program; <*warn.yes, ok.no*>
e16: ; end not first;
al w2 1 ; comment warn.no, ok.no to fetch unused areas etc,
; in case of stop load start;
jl. h7. ; call and enter end program;
e5: al. w1 b9. ; failure:
al. w3 h44. ; parent message
jd 1<11+16 ; (<:***fp init troubles:>);
jd 1<11+18 ;
jl. w3 h14. ; goto finis;
jl. e4. ; at start: goto connect in and out;
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 ; zero used in set catbase
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:>
b. g1 ; begin
g1= (:h55+1024-k:)/2 ; fill up segment to 1024 bytes:
c. -g1 m.length error on fp segment 11
z.w. 0, r.g1 ; zero fill
e. ; end fill up;
c. h90-3 m.fp init, buf error: in
z. ;
c. h91-3 m.fp init, buf error:out
z. ;
m.fp init 89.01.12
i. ; maybe names
e. ; end init;
\f
; new fp syntax, dh 86.08.12, file processor, commands, page ***00***
s. d4, e1, f13, g27, i20
w. i20 = -1 ; i20 = 1 means that this is a utility program
; i20 = -1 means that this is a part of fp
c. i20 ; if this is a utility program then
d. p.<:fpnames:>, l. ; include fpnames
z. ;
w. k = h55
g18: i19. ; sign
; initially: code length
g19: jl. i0. ; bracket count
; initially: goto start in fp
g20: jl. i0. ; tastenext address as used from readstring
; initially: goto start as utility
g21: 0 ; integer
g22: 0 ; limit;
\f
; new fp syntax, dh 86.08.06, file processor, commands, page ***01***
b. a2, b0 w. ; local block for tastechar, tastenext, readchar
; procedure tastechar:
; call: w0: - return: w0: unchanged
; w1: - c1: w1: class
; w2: - c2: w2: char
; w3: return address w3: unchanged
;
; if a saved char exists, tastechar will deliver that char together
; with its class, otherwise tastechar will read a fresh character which
; is delivered together with its class. val can always be found in
; saved val (i.e. c0).
d0: dl. w2 g2. ;entry tastechar:
se w2 0 ; if a saved char exists then return
jl x3 ; else continue tastenext;
; procedure tastenext: call & return as for tastechar.
;
; reads the next character from current in, saves the character, its val,
; and its class. the class and the character value are delivered as
; return values.
d1: rs. w3 g2. ;entry taste next:
a0: jl. w3 h25.-2 ; save return(in saved char);
rl. w3 g3. ;rep:
al w3 x3+1 ; readchar(cur in);
sl. w3 g5. ; save char in char buffer cyclically;
al. w3 g4. ; increase char address
rs. w3 g3. ; cyclically;
hs w2 x3 ;
sl w2 128 ; if char >= 128
jl. f0. ; then goto syntax error;
al. w3 a0. ; if char = end medium then
sn w2 25 ; begin
jl. h30.-4 ; unstack(cur in); goto rep;
; end;
\f
; new fp syntax, dh 86.08.22, file processor, commands, page ***02***
el. w1 x2+e0. ; take valclass(char);
sn w1 0 ; if valclass = 0 then
jl. a0. ; then goto rep;
as w1 -5 ; val := valclass // 32;
rs. w1 g0. ;
el. w1 x2+e0. ; class := valclass mod 32;
la. w1 b0. ;
rl. w3 g2. ; savechar := char;
ds. w2 g2. ;
jl x3 ; return
; procedure readchar:
; call: w0: - return: w0: spoiled
; w1: - c1: w1: class
; w2: - w2: char (c2: 0)
; w3: return address w3: spoiled
;
; if no saved char exists, a character is read. saved char is cleared.
; note, however, that saved val and saved class are not cleared.
;
d2: al w0 x3 ;entry readchar:
jl. w3 d0. ; taste char;
al w3 0 ; saved char := 0;
rs. w3 g2. ;
jl (0) ; return;
b0: 2.11111 ; mask for last 5 bits
e. ; end block for character reading;
\f
; new fp syntax, dh 86.08.22, file processor, commands, page ***03***
b. a7, b0 w. ; common block for integers, texts and names
0 ; saved return and
b0: 0 ; partial word when both int and texts are read
f11: am 14-3 ;entry quote: limit := 14; skip next
f10: al w0 3 ;entry hyphen: limit := 3; tastenext;
al. w3 a0. ; if false then
jl. d1. ; begin
f2: ;entry letter:
jl. w3 d2. ; readchar; limit := 3;
al w0 3 ; end;
a0: sh w0 x1 ; if class >= limit
jl. i7. ; then goto test cancel;
al w1 x2+1<8 ; partial word := 1 shift 8 + char;
rl. w2 g6. ;
se w0 3 ; upper bound := cur addr +
am 64-8 ; (if delim was quote then 64 else 8) -2;
al w2 x2+8-2 ;
jl. w3 d3. ; readstring(limit, partial word, upper bound);
a1: ;endup:
wa. w1 g8. ; delim := delim + length;
jl. w3 d4. ; store delim;
jl. w3 d0. ; tastechar;
rl. w0 g17. ; delim := (sp, 2);
rs. w0 g8. ; if class = limit then
sn. w1 (g22.) ; readchar; <*to get rid of it*>
jl. w3 d2. ;
jl. i1. ; goto central;
\f
; new fp syntax, dh 86.08.11, file processor, commands, page ***04***
f9: al w0 10 ;entry digit:
rs. w0 g15. ; radix := 10;
al w0 1 ; sign := +1;
rs. w0 g18. ;
rl. w1 g0. ; int := val(char);
al. w0 a2. ; taste next addr in readstring := intercept;
ds. w1 g21. ; <* now simple integers and names may be read in
jl. f2. ; parallel *>
; goto letter; <* where each char is intercepted *>
a2: ds. w0 b0. ;intercept:
jl. w3 d1. ; save partial word and return;
al. w3 d1. ;
se w1 1 ; if class <> digit then
rs. w3 g20. ; reestablish tastenext address;
sn w1 2 ; if class = letter then
jl. (b0.-2) ; return <* to readstring *>;
rl. w0 g21. ; int := integer;
se w1 1 ; if class <> ditit then
jl. a4. ; goto special char;
wm. w0 g15. ; int := int * radix + val;
aa. w0 g0. ;
rs. w0 g21. ; integer := int;
se w3 0 ; if int > 16 777 215 then
jl. f0. ; goto syntax error;
dl. w0 b0. ; reestablish partial word and return;
jl x3 ; return <* to readstring *>;
\f
; new fp syntax, dh 86.08.18, file processor, commands, page ***05***
a4: se w2 58 ;special char:
jl. a7. ; while char <> ':' do
a5: rs. w0 g15. ; begin
jl. w3 d1. ;first digit: radix := int;
rl. w0 g0. ; taste next;
sh w1 2 ; int := val;
sl. w0 (g15.) ; if class neither letter nor digit or val > radix
jl. i7. ; then goto test cancel;
a6: jl. w3 d1. ; repeat
sl w1 3 ; tastenext;
jl. a4. ;
rl. w2 g15. ; if class either letter or digit then
wm w0 4 ; int := int * radix + extend val;
aa. w0 g0. ; if val >= radix
sn w3 0 ; or int > 16 777 215
sh. w2 (g0.) ; then goto syntax error;
jl. f0. ; until class neither letter nor digit;
jl. a6. ; end legal chars;
a7: wm. w0 g18. ; int := int * sign;
rs. w3 g22. ; limit := nonsense; <*signpart which is < 1*>
al w1 2 ; store int;
am. (g6.) ; length := 2;
rs w0 +2 ; goto endup;
jl. a1. ;<* end integer types *>;
f8: rl. w1 g0. ;entry sign:
rs. w1 g18. ; sign := val;
al w0 10 ; int := 10;
jl. a5. ; goto first digit;
e.
\f
; new fp syntax, dh 86.08.27, file processor, commands, page ***06***
b. a9, b2 w. ; local block for syntax error,
; initiate, and central logic
i7: sn w1 13 ;test cancel: if class = cancel
jl. f13. ; then goto fp cancel;
f0: ;
al. w0 g11. ;entry syntax error:
i4: jl. w3 h31.-2 ; outtext(out,<:***fp syntax :>);
rl. w1 g3. ;entry stack: outtext(out, <:***fp stack:>);
a0: al w1 x1+1 ; for i := char bufaddr + 1 step cyclic1
sl. w1 g5. ; until char bufaddr do
al. w1 g4. ; begin
rs. w1 b0. ;
zl w2 x1 ; char := hwd(i);
se w2 127 ; if char <> 127
sn w2 0 ; and char <> 0 then
jl. a2. ; begin
sh w2 126 ;
sh w2 32 ; if char > 126 or char <= 32 then
jl. 4 ; begin
jl. a1. ;
al w0 x2 ;
al w2 60 ; outchar(out, '<');
jl. w3 h26.-2 ; outinteger(out, <<zd>, char);
jl. w3 h32. ; outchar(out, '>');
48 < 12 + 2 ;
al w2 62 ; end
a1: jl. w3 h26.-2 ; else outchar(out, char);
rl. w1 b0. ; end <*nul chars not output*>;
al w0 0 ; hwd(i) := 0;
hs w0 x1 ;
a2: se. w1 (g3.) ;
jl. a0. ; end output of char buffer;
\f
; new fp syntax, dh 86.09.03, file processor, commands, page ***07***
rl. w2 g12. ; no of syntax errors :=
al w2 x2-1 ; no of syntax errors - 1;
rs. w2 g12. ;
al w0 -1-1<7 ;
la. w0 h51. ; if bit := 0;
rs. w0 h51. ;
al. w0 g24. ; write(out, <:<10>read from :>);
jl. w3 h31.-2 ;
rl. w1 h50. ; if stack chain = 0
se w1 0 ; then
jl. a9. ; begin
al. w0 g25. ; prepare(<:primary input:>);
sl w2 1 ; if no of syntax errors > 0 then
jl. a8. ; terminate:
a7: jl. w3 h31.-2 ; begin
al. w0 g26. ; write(out, prepared text,
jl. w3 h31. ; <:<10>***fp job termination:>);
jl. w3 h95. ; close up text(out); finis;
jl. h14. ; end;
a8: jl. w3 d2. ; repeat readchar;
se w1 15 ; until class = nl;
jl. a8. ; end
al. w0 g25. ;
jl. i3. ; else
a9: al. w0 h20.+h1+2; begin
jl. w3 h31.-2 ; write(out, name in current in zone);
jl. w3 h30.-4 ; unstack(current in);
al. w0 g27. ; write(out,
jl. w3 h31.-2 ; <:<10>unstacking to :>);
al. w0 h20.+h1+2; if stack chain <> 0 then
rl w2 x2 ; prepare(name in current in zone)
sn w2 0 ; else prepare(<:primary input:>);
al. w0 g25. ; end;
i3: jl. w3 h31.-2 ; write(out, prepared text, outend(nl));
jl. w3 h39. ; continue initiate;
\f
; new fp syntax, dh 86.08.08, file processor, commands, page ***08***
i0: al. w1 i10. ;entry initiate:
rl. w2 h8. ; cur addr := last program;
al w2 x2-70 ; top addr := cur command - 70;
ds. w2 g7. ;
al w0 0 ; saved char := 0;
rs. w0 g2. ;
al w3 1 ; sign := +1;
ds. w0 g19. ; bracket count := 0;
rs. w3 g14. ; state := 1;
rl. w0 g16. ; delim := (nl, 2);
rs. w0 g8. ;
al. w0 d1. ; taste next addr in readstring := taste next;
rs. w0 g20. ;
; continue central;
i1: rl. w0 g14. ;entry central:
se w0 0 ; if state = 0 then
jl. a6. ; begin
rl. w0 g19. ; if bracket count = 0 then
se w0 0 ;
jl. a5. ; begin comment this is the end of the beginning;
rl. w2 h9. ; to addr := last of commands;
c. -i20 ; if this is part of fp then
al w1 -1-1<7 ; begin
la. w1 h51. ; clear possible if bit;
rx. w1 h51. ; if if bit was set
sz w1 1<7 ; then
jl. i0. ; goto initiate;
dl. w1 i13. ; move endlist;
ds w1 x2 ; end part of fp
z. c. i20 ; else if this is a utility program then
al. w3 i13. ; begin
a3: dl w1 x3 ;<* starting at last of commands,
ds w1 x2 ; move the ending command et c
al w3 x3-4 ; while updating to address.
al w2 x2-4 ; note that when this is part of fp
sl. w3 i5. ; then only (nl, endlist) are moved
jl. a3. ; *>
se. w3 i15. ; if one word to much moved
al w2 x2+2 ; then to addr := to addr + 2;
al w2 x2+4 z.; end utility program part;
\f
; new fp syntax, dh 86.08.11, file processor, commands, page ***09***
rl. w3 g6. ;<*
a4: dl w1 x3-2 ; starting at last of commands - 2
ds w1 x2-4 ; move the entire command stack
al w3 x3-4 ; such as it has been read up until now,
al w2 x2-4 ; while updating the to address.
sl. w3 i16. ; *>
jl. a4. ;
sn. w3 i6. ; if one word to much moved
al w2 x2-2 ; then to addr := to addr + 2;
rs. w2 h8. ; current command := to addr;
c. -i20 ; if part of fp then
jl. h62. ; goto program load
z. ; else if utility program then
c. i20 ; begin
al w2 0 ; ok := true; warning := false;
jl. h7. ; goto end program;
z. ; end; end;
a5: rl. w1 g8. ; if delim <> (sp,2) then
se. w1 (g17.) ; store delim;;
jl. w3 d4. ; delim := (nl, 2);
rl. w1 g16. ;
al w0 1 ; state := 1;
rs. w1 g8. ; end state = 0;
a6: jl. w3 d0. ; tastechar;
wm. w0 b1. ; new stateact := stateacttable
wa w1 0 ; ( hwd(state * 15 + class) );
el. w1 x1+e1. ;
al w0 x1 ; state := new stateact extract 3;
la. w0 b2. ;
rs. w0 g14. ; act addr := new stateact // 4;
as w1 -2 ; <* it doesn't matter whether it is odd or even *>
i2: jl. x1 ; switch to action(act addr);
b0: 0 ; work cell
b1: 15 ; no of actions per state
b2: 2.111 ; 3 bits for extracting state
e. ; end local block for central et c.;
\f
; new fp syntax, dh 86.08.27, file processor, commands, page ***10***
; global variables and constants
0 ; zero (extends sign in case of integer reading)
g0: 0 ; saved val
g1: 0 ; saved class
g2: 0 ; saved char
g3: 8 388 600 ; address in char buffer, born well past the top
g4: h. 0, r.14, w. ; char buffer
g5: ; top char buffer
g6: 0 ; cur addr
g7: 0 ; top addr
g8: 0, g9=k-1 ; delim
g10: <:***fp stack: <0>:>
g11: <:***fp syntax: <0>:>
g12: 3 ; at most 3 syntax errors allowed per call
g14: 0 ; state
g15: 10 ; radix
g16: 2 < 12 + 2 ; nl, 2
g17: 4 < 12 + 2 ; sp, 2
; g18 .. g22 ; defined in page 00
g23: <:***fp cancel<0>:>
g24: <:<10> read from <0>:>
g25: <:primary input<0>:>
g26: <:<10><10>***fp job termination<10><0>:>
g27: <:<10>unstacking to <0>:>
i5 = k, i15 = k-2
c.i20, 2<12+2, -2<12+2, 2<12+10, <:newfpsyntax<0>:>, z. 2<12+2, -4<12+0
; (nl, 2), (right brack, 2), (nl, 10), this program, (nl, 2), endlist
i13 = k - 2
\f
; new fp syntax, dh 86.08.15, file processor, commands, page ***11***
; separators and special characters
f4: am 2 ;left hand brack: count := + 1; skip next;
f5: al w1 -1 ;right hand brack: count := - 1;
wa. w1 g19. ; bracket count := bracket count + count;
sh w1 -1 ; if bracket count <= -1 then
jl. f0. ; goto syntax error;
rs. w1 g19. ; continue store previous ... ;
f12: jl. w3 d2. ;store previous sep and prepare this:
rl. w1 g0. ; readchar <* to get rid of it *>;
ls w1 12 ; new item := val < 12 + 2;
al w1 x1+2 ; old item := delim;
rx. w1 g8. ; delim := new item;
se. w1 (g17.) ; if olditem <> space then
jl. w3 d4. ; store item
jl. i1. ; goto central
f7: ;komma:
f3: jl. w3 d2. ;semicolon:
se w1 15 ; while class <> 15 do
jl. f3. ; readchar;
jl. i1. ; goto central;
f6: rl. w1 g0. ;prepare this delim:
ls w1 12 ; delim := val < 12 + 2;
al w1 x1+2 ;
rs. w1 g8. ; continue blind;
f1: al. w3 i1. ;blind: readchar <* to get rid of it *>;
jl. d2. ; goto central;
f13: al. w0 g23. ;fp cancel: prepare(<:***fp cancel:>
jl. i3. ; goto textout;
; <* which continues in initiate *>;
\f
; new fp syntax, dh 86.08.07, file processor, commands, page ***12***
b. a6, b5 w. ; local block for readstring
; procedure readstring:
; call: w0: limit return: w0: spoiled
; w1: pwd w1: length
; w2: upper bound w2: spoiled
; w3: return addr w3: spoiled
;
; the procedure starts storing a string in cur addr + 2 (i.e. c6), and
; it continues upward against upper bound. at least one null character
; will terminate the string, and the string will occupy an integral
; multiple of 8 half words. the length will be the length that is to
; be used in the sep,length - word. the address of lthe tastenext
; procedure to be used must be stored in advance in g20.
d3: rs. w0 g22. ;entry readstring:
ds. w3 b2. ; save limit, upper bound,
al w0 x1 ; and return;
rl. w1 g6. ; start address := cur address;
rs. w1 b3. ;
a0: jl. w3 (g20.) ; for class := tastenext(char) while
sl. w1 (g22.) ; class < limit do
jl. a2. ; begin
so. w0 (b4.) ; if partial word full then
jl. a1. ; begin
rl. w3 b3. ; if upper bound reached
sl. w3 (b1.) ; then goto syntax error;
jl. f0. ;
ls w0 8 ; word(start address + 2) :=
wa w0 4 ; partial word shift 8 + char;
rs w0 x3+2 ;
al w3 x3+2 ; start address := start address + 2
rs. w3 b3. ; partial word := 1;
al w0 1 ; end
jl. a0. ; else
a1: ls w0 8 ; partial word :=
wa w0 4 ; partial word shift 8 + char;
jl. a0. ; end;
\f
; new fp syntax, dh 86.08.07, file processor, commands, page ***13***
a2: rl. w3 b3. ;
se w0 1 ; if partial word empty
jl. a3. ;
al w0 0 ; then partial word := 0
jl. a4. ;
a3: so. w0 (b4.) ; else partial word := partial word shift
am 8 ; (if partial word contains 2 characters
ls w0 8 ; then 16 else 8);
a4: rs w0 x3+2 ; save partial word;
al w0 0 ;
al w1 x3+2 ; length := start addr + 2 - cur addr;
ws. w1 g6. ;
a5: sl. w1 (g22.) ; while length < limit <* trick! *>
sz w1 2.111 ; and length mod 8 <> 0 do
jl. 4 ; begin
jl. (b2.) ; word(start addr + 4) := 0;
rs w0 x3+4 ; start addr := start addr + 2;
al w3 x3+2 ; length := length + 2;
al w1 x1+2 ; end;
jl. a5. ; return;
b1: 0 ; upper bound
b2: 0 ; return addr
b3: 0 ; start addr
b4: 1 < 16 ; test partial word full
e. ; end local block for readstring;
f00 = (:f00-i2:)<2, f01 = (:f01-i2:)<2, f02 = (:f02-i2:)<2
f03 = (:f03-i2:)<2, f04 = (:f04-i2:)<2, f05 = (:f05-i2:)<2
f06 = (:f06-i2:)<2, f07 = (:f07-i2:)<2, f08 = (:f08-i2:)<2
f09 = (:f09-i2:)<2, f10 = (:f10-i2:)<2, f11 = (:f11-i2:)<2
f12 = (:f12-i2:)<2, f13 = (:f13-i2:)<2
\f
; new fp syntax, dh 86.08.18, file processor, commands, page ***14***
; in the state-action table to follow, action addresses are packed as
; word addresses relative to the exit from the central action. the
; signed word addresses are packed into the 9 most significant bits
; of a halfword. in the least significant 3 bits, a new state is packed.
; state=0, the state before new line, contains only one action, namely
; preparing a new line separator, and preparing for a possible fp-cancel.
; character class 0, blind, is not described either, as the action for
; blind characters is taken in the character reading procedures.
e1 = k-16, h. m. state-action table as function of character class
;digit letter sp equal delim komma apostr l.bra. r.bra. ill. ; sign cancel quote nl
; 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15
;state = 1, before first name:
f00+0, f02+2, f01+1, f00+0, f00+0, f03+1, f00+0, f04+1, f05+7, f00+0, f03+1, f00+0, f13+0, f00+0, f01+1
;state = 2, possibly equals follows:
f09+5, f02+5, f01+2, f06+3, f00+0, f07+2, f10+5, f00+0, f05+7, f00+0, f03+0, f08+5, f13+0, f11+5, f01+0
;state = 3, after equals:
f00+0, f02+4, f01+3, f00+0, f00+0, f07+3, f00+0, f00+0, f00+0, f00+0, f00+0, f00+0, f13+0, f00+0, f00+0
;state = 4, after progname
f09+5, f02+5, f01+4, f00+0, f00+0, f07+4, f10+5, f00+0, f05+7, f00+0, f03+0, f08+5, f13+0, f11+5, f01+0
;state = 5, after param:
f09+5, f02+5, f01+5, f00+0, f06+6, f07+5, f10+5, f00+0, f05+7, f00+0, f03+0, f08+5, f13+0, f11+5, f01+0
;state = 6, before modifier:
f09+5, f02+5, f01+6, f00+0, f00+0, f07+6, f10+5, f00+0, f00+0, f00+0, f00+0, f08+5, f13+0, f11+5, f00+0
;state = 7, after right bracket:
f00+0, f00+0, f01+7, f00+0, f00+0, f00+0, f00+0, f00+0, f05+7, f00+0, f03+0, f00+0, f13+0, f00+0, f12+0
; short explanations:
; f00 = syntax error f01 = blind
; f02 = read name *) f03 = skip to and incl nl
; f04 = store and increase bracket f05 = store and decrease bracket
; f06 = prepare this delimiter f07 = possibly prepare space cont. f03
; f08 = read signed integer *) f09 = read name or integer *)
; f10 = read apostr.ized name *) f11 = read general text *)
; f12 = store delimiter **) f13 = back to nl, rev. bracket count
; *) these actions will prepare a space separator
; **) this action may be used in state 6, class 5, if sequences of de-
; limiters are to be allowed. the action continues as f06.
\f
; new fp syntax, dh 88.04.24, file processor, commands, page ***15***
; in the character table below, characters are described by an
; associated value and an associated class. the value is used for
; various purposes, such as separator value, and digit value when the
; character is used in integer reading. the class is used in lookup
; in the state-action table above.
; note that, only if both class and value are 0 (zero), a character
; is truly blind.
; the algorithms used are prepared for several delimiters and delimiters
; with values greater than 8. it is a simple matter to correct the
; character table, thus introducing new delimiters of class 5.
; capital letters, however, may give trouble with the interface to
; the rest of the system, i.e. the monitor and the catalog.
e0 = k m. character table containing val<5 + class
0, 0, 0, 0, 0; 0: NUL, SOH, STX, ETX, E0T
0, 0, 0, 0, 0; 5: ENQ, ACK, BEL, BS, HT
2<5+15, 0, 0, 0, 0; 10: NL, VT, FF, CR, S0
0, 0, 0, 0, 0; 15: SI, DLE, DC1, DC2, DC3
0, 0, 0, 0, 0; 20: DC4, NAK, SYN, ETB, CAN
25<5+ 0, 0, 0, 0, 0; 25: EM, SUB, ESC, FS, GS
0, 0, 4<5+ 3, 10<5+10, 4<5+14; 30: RS, US, SP, ! "
12<5+10, 14<5+10, 16<5+10, 18<5+10, 4<5+ 7; 35: # $ % & '
0<5+ 8, -2<5+ 9, 0<5+11, +1<5+12, 4<5+ 6; 40: ( ) * + ,
-1<5+12, 8<5+ 5, 8<5+ 5, 0<5+ 1, 1<5+ 1; 45: - . / 0 1
2<5+ 1, 3<5+ 1, 4<5+ 1, 5<5+ 1, 6<5+ 1; 50: 2 3 4 5 6
7<5+ 1, 8<5+ 1, 9<5+ 1, 0<5+10, 0<5+11; 55: 7 8 9 : ;
22<5+10, 6<5+ 4, 24<5+10, 0<5+13, 0<5+10; 60: < = > ? <64>
10<5+ 2, 11<5+ 2, 12<5+ 2, 13<5+ 2, 14<5+ 2; 65: A B C D E
15<5+ 2, 16<5+ 2, 17<5+ 2, 18<5+ 2, 19<5+ 2; 70: F G H I J
20<5+ 2, 21<5+ 2, 22<5+ 2, 23<5+ 2, 24<5+ 2; 75: K L M N O
25<5+ 2, 26<5+ 2, 27<5+ 2, 28<5+ 2, 29<5+ 2; 80: P Q R S T
30<5+ 2, 31<5+ 2, 32<5+ 2, 33<5+ 2, 34<5+ 2; 85: U V W X Y
35<5+ 2, 36<5+ 2, 37<5+ 2, 38<5+ 2, 0<5+10; 90: Z Æ Ø Å <94>
0, 0<5+10, 10<5+ 2, 11<5+ 2, 12<5+ 2; 95: _ <96> a b c
13<5 +2, 14<5+ 2, 15<5+ 2, 16<5+ 2, 17<5+ 2;100: d e f g h
18<5+ 2, 19<5+ 2, 20<5+ 2, 21<5+ 2, 22<5+ 2;105: i j k l m
23<5+ 2, 24<5+ 2, 25<5+ 2, 26<5+ 2, 27<5+ 2;110: n o p q r
28<5+ 2, 29<5+ 2, 30<5+ 2, 31<5+ 2, 32<5+ 2;115: s t u v w
33<5+ 2, 34<5+ 2, 35<5+ 2, 36<5+ 2, 37<5+ 2;116: x y z æ ø
38<5+ 2, 0<5+10, 0 ;120: å <126> DEL
w.
\f
; new fp syntax, dh 88.04.24, file processor, commands, page ***16***
; procedure store delim:
; call: w0: - return: w0: spoiled
; w1: delim w1: unchanged
; w2: - w2: cur addr
; w3: return addr w3: unchanged
;
; stores a delimiter, updates current address accordingly, and
; tests whether top address has been passed.
d4: rl. w2 g6. ;entry store delim:
rs w1 x2 ; store delim in word(cur addr);
ea w2 3 ; cur addr := cur addr + size(delim);
rs. w2 g6. ;
sh. w2 (g7.) ; if cur addr < top addr
jl x3 ; then return;
al. w0 g10. ; else goto stack alarm;
jl. i4. ;
i16 = k+2, i6 = i16-2 ; first command
2<12+10, <:this program:>; include a pseudo command
; for unstacking by end program;
i10:
m.fp comm. reading 88.04.24
; commands collected here
-1, r.256-(:i10-i10>9<9:)>1; fillup with -1 to ease testing
i19: ; end of segments
c. i20 ; if this is a utility program then
e. z. ; end fpnames
e. m. end of commands
\f
\f
; rc 12.07.79 file processor, load, page 1
; interpretation of commands; program loading
s. k=h55, e48 ; begin
w. 512 ; length ; segment 12:
al w0 1 ; give up mask.cur in:= 1;
al. w1 h68. ; give up mask.prog.cur out:= 0;
ds. w1 h93. ;
al w0 0 ; give up action.in.out.prog:=fp stderror;
ds. w1 h92. ;
ds. w1 h94. ;
e0: rl. w2 h8. ; upspace to next command:
ba w2 x2+1 ; cur comm:= param pointer:=
bl w0 x2+0 ; cur comm + item size;
rs. w2 h8. ; separator:= first byte.item;
rs. w2 e8. ; if separator= -4
sn w0 -4 ; then goto read commands;
jl. h61. ; if separator <> 2 (nl)
sz w0 -3 ; or <> 0 then goto
jl. e0.+2 ; upspace to next command;
e1: am. (e8.) ; find program name:
bz w2 +1 ; updated param pointer:=
wa. w2 e8. ; param pointer + size.param;
bl w3 x2+0 ; e8:= updated pointer;
rs. w2 h8. ; h8:= pointer;
rx. w2 e8. ; if end of commands in stack
sn w3 -4 ; then goto read commands;
jl. h61. ; w0:= separator.param;
bl w0 x2+0 ; w1:= kind.param;
bz w1 x2+1 ; w3:= next sep.param;
se w1 10 ; if kind.param <> 10 (i e name)
jl. e1. ; then goto find program name;
ds. w1 e33. ; save params for first name;
rs. w2 h8. ; h8:= current param pointer;
sn w3 6 ; if next sep = <equal>
al w2 x2+10 ; then upspace to next param;
rs. w2 c12. ; w3 at entry:=current param;
rs. w2 e12. ; addr of prog name param
\f
; rc 12.07.79 file processor, load, page 1a
al. w1 e4. ; test content of entry:
al w3 x2+2 ; lookup entry(program name, own filedescr.);
jd 1<11+42 ;
se w0 0 ; if unknown then
jl. e44. ; goto connect trouble;
bz. w3 e5. ; load content;
se w3 15 ; if content<>15 then
jl. e2. ; goto test content and load;
bz. w3 e6. ; load through sysldr:
sl w3 1000 ; if loaderno>999 then
jl. e47. ; goto call trouble;
al w1 -8 ; convert loaderno to text:
e11: al w1 x1+8 ; repeat
al w2 0 ; counter:=counter+8;
wd. w3 e10. ; w2:=loaderno mod 10;
al w2 x2+48 ; loaderno:=loaderno//10;
ls w2 x1 ; w2:=w2+48;
wa w0 4 ; w2:=w2 shift counter;
se w1 16 ; w0:=w0 add x2;
jl. e11. ; until counter=0;
rs. w0 e13. ; e13:=loaderno as text;
al. w2 e12. ; base for loader name
rs. w2 e12. ; used by connect trouble and size trouble
al. w1 e4. ; test content of loader entry:
al w3 x2+2 ;
jd 1<11+42 ; lookup_entry(loader name, own file descr);
se w0 0 ; if unknown then
jl. e44. ; goto connect trouble;
bz. w3 e5. ; load content;
\f
; rc 12.07.79 file processor, load, page 1b
; test content and load:
e2: se w3 2 ; if content<>2 and
sn w3 8 ; content <> 8
jl. 4 ; then
jl. e47. ; goto call trouble;
al w2 x2+2 ; file name pointer:= param pointer+2;
al. w1 h19. ; connect input (file name pointer,
jl. w3 h27. ; program zone,result);
se w0 0 ; if result <> 0 then
jl. e44. ; goto connect trouble;
bz. w0 e6. ; test size:
rl. w1 e7. ; if entry>=length
rs. w0 h19.+h3+6 ; or length<=0
sh w0 x1-1 ; then goto size trouble;
sh w1 0 ;
jl. e46. ; entry.pzone:= entry;
rl. w3 e4. ;
bz. w0 e9. ; if mode.kind >= 0
sl w3 0 ;
jl. 6 ; or
se w0 4 ; kind = 4
jl. e3. ;
al w1 x1+511 ; then
ls w1 -9 ; length:= (length+511)//512*512;
ls w1 +9 ;
\f
; rc 86.09.03 file processor, load, page 2
e3: rs. w1 h19.+h3+4 ; test room:
ac. w3 h55.+0 ; top length:= cur command pointer
wa. w3 h8. ; - base of transient;
sl w1 x3 ; if length>=top length
jl. e46. ; then goto size trouble;
al w1 x1-1 ; increment:= (length-1)//2*2;
ls w1 -1 ; adjust share:
ls w1 +1 ; first shared:= first address:=
al. w0 h55. ; base of transient;
al. w1 x1+h55. ; last addr:= first addr+increment;
ds. w1 h80.+10 ; last shared:= cur command pointer-2;
rl. w1 h8. ; set dump range:
al w1 x1-2 ; base.prog:= first addr.proc-1;
ds. w1 h80.+4 ; last.prog:= top addr.proc-1;
rl. w3 h16. ;
dl w2 x3+24 ; if list mode
al w1 x1-1 ; then list cur command;
al w2 x2-1 ;
ds. w2 h19.+h0+2 ; floating precision:= long;
rl. w3 h51. ;
sz w3 1<0 ; zone:= program zone;
jl. w3 e26. ; goto load and enter;
al. w1 h19. ;
xl. 0 ;
jl. h18. ;
e8: 0 ; ; current parameter pointer
e10: 10 ; ; constant 10
e31: 0 ; ; count
e32: 1 ; ; sep
e33: 1 ; ; kind
e34: 0 ; ; saved param pointer
e35: 0 ; w2 ; saved w2
e36: 0 ; w3 ; saved w3
e26: ds. w3 e36. ; list cur command:
dl. w1 e33. ; save (w2,w3);
rl. w2 h8. ; restore params for first name;
al w3 0 ; count:= 0;
rs. w3 e31. ;
e27: ds. w2 e34. ; print param:
sh w0 3 ;
al w2 42 ; char:= case separator of
sn w0 4 ; (<4: asterisk,
al w2 32 ; 4: space ,
sn w0 6 ; 6: equal ,
al w2 61 ; 8: dot );
sn w0 8 ;
al w2 46 ; if char=space
rl. w1 e31. ; and count>10
rl. w3 e33. ; then
ls w3 -2 ;
sl w3 3 ;
am x3-1 ;
al w1 x1+1 ; begin
rs. w1 e31. ; count := 0; outtext (cur out,<:,<10> :>);
sh w1 10 ; end;
jl. e28. ; count:= count+1+length shift(-3);
\f
; fgs 1988.07.21 file processor, load, page 3
al w1 0 ;
rs. w1 e31. ; outchar (cur out, char);
al. w0 e37. ;
jl. w3 h31.-2 ; if kind.param<>4
e28: jl. w3 h26.-2 ; then
dl. w2 e34. ;
al w0 x2+2 ;
sh w1 10 ; begin
jl. e14. ; if general text then
al w2 34 ; write(out, <:":>,
jl. w3 h26.-2 ; param, <:":>);
jl. w3 h31. ; else
al w2 34 ;
jl. w3 h26. ; outtext(out, param name)
jl. e29. ; end else
e14: se w1 4 ; <<d>,param integer);
jl. e15. ;
rl w0 x2+2 ;
jl. w3 h32.-2 ;
1<23 + 0<12 + 1 ;
jl. e29. ;
e15: rl w3 x2+2 ;
al w2 39 ;
sh. w3 (e16.) ;
jl. w3 h26.-2 ;
jl. w3 h31.-2 ;
e29: dl. w2 e34. ; take next param:
wa w2 2 ; param pointer:= pointer+size;
bl w0 x2+0 ; separator:= new separator;
bz w1 x2+1 ; kind:= new kind;
sl w0 4 ; if separator > 3 then
jl. e27. ; goto print param;
jl. w3 h39. ;
dl. w3 e36. ; outend (cur out,new line);
jl x3 ; return;
e37: <:,<10>* :> ; end list;
e38: <:***fp name<32><0>:> ; not found in catalog
e39: <:***fp connect<32><0>:> ; io trouble during connection
e40: <:***fp size<32><0>:> ; program to big
e41: <:***fp call<32><0>:> ; call convention error
e16: <:@<0><0>:> ; constant showing whether a name
; begins with a letter or a digit;
\f
; rc 86.10.10 file processor, load, page 3a
e44: sn w0 3 ; connect trouble:
am e38-e39 ; text:= if result <> 3 then <name>
am e39-e40 ; else <connect>
e46: am e40-e41 ; size trouble: or <size>
e47: al. w0 e41. ; call trouble: or <call>;
jl. w3 h31.-2 ; outtext (cur out, text);
rl. w3 e12. ; outtext(curr out,prog.name);
al w0 x3+2 ;
jl. w3 h31.-2 ;
jl. w3 h39. ; outend (cur out, new line);
al w2 3 ; warning:=true; ok:= false;
jl. h7. ; goto end program;
e4: 0 ; own filedescriptor: mode.kind
e9=e4+1 ; mode
0,r.7
e5: 0 ; content
e6=e5+1 ; entry
e7: 0 ; length
e12: 0 ; base of loader name or prog name param
<:sysldr:> ; space for loader name
0,r.2 ; space for number part of loader name
e13=e12+6 ; address of number part of loader name
b. g1 ; begin
g1= (:h55+512-k:)/2 ; fill up segment to 512 bytes;
c. -g1 m.length error on fp segment 13
z.w. 0, r.g1 ; zero fill
e. ; end fill up;
m.fp program load 88.07.21
i. ; maybe names
e. ; end load;
\f
; fgs 1986.12.12 file processor, end program, page ...1...
;this segment is entered when a utility program terminates by
;entering end program entry h7. the function is to stop the
;current out zone, to set the ok bit and to remove su-
;perfluos area processes and messages buffers.
;the segment calls either the load program segment, the device
;status segment or the break action.
;if load program is entered the current in zone will before be
;unstacked to the first i-bit.
;if device status is entered the current zone is unstacked to
;the i-bit unless there is hard error on the stacked curr in
;zone.
;in case of hard error on current out or on a curr in zone
;with i-bit the current out zone is connected to primary out.
;if this is impossible fp is reeinitialized.
s. k=h55, a10, e48, f7
w.
1024
e8: al w0 0 ; entry:
al. w3 h10. ; set interrupt;
jd 1<11+0 ;
dl. w3 c30. ; move troubled name
ds. w3 e35. ; to these segments:
dl. w3 c27. ;
ds. w3 e36. ;
al. w3 h68. ; restore give up action in:
al w2 0 ;
rs. w3 h19.+h2+2 ; program zone;
rs. w3 h20.+h2+2 ; curr in zone;
rs. w3 h21.+h2+2 ; curr out zone;
dl. w2 c20. ; set mode bits:
rs. w2 e7. ; save status word;
al w0 -1-1<6-1<5 ; w0:=mode bits -
la. w0 h51. ; (ok and warning);
al w3 2.11 ;
la w3 4 ;
bz. w3 x3+e6. ; w3:=table(w2.exit);
sz w2 -4 ; if device errors then
al w3 1<6 ; w3:=warn yes and ok no;
lo w0 6 ; mode bits := w0 or w3;
rs. w0 h51. ;
sz w2 -4 ; determine action:
jl. e1. ; if no device errors
al. w3 f1. ; get action and
jl. e5. ; goto start on actions;
e1: se. w1 c31. ; if hard error on curr out
jl. e2. ; then get actions
al. w3 f2. ;
jl. e5. ; and goto start on actions;
e7: 0 ; saved status word
;mode bit table:
h. ; warning: ok:
e6: 0<6+1<5 ; no yes
0<6+0<5 ; no no
1<6+1<5 ; yes yes
1<6+0<5 ; yes no
w.
\f
; fgs 86.12.12 file processor, end program, page 2
e2: se. w1 h20.+h1+2 ; if hard error curr in zone
jl. e3. ; then
rl. w0 h20.+h2+0 ;
al. w3 f3. ; get action(i-bit)
sz w0 2.1 ;
al. w3 f4. ;
jl. e5. ; and goto start on actions;
e3: al. w3 f5. ; other zone error:
jl. e5. ; get actions and goto actions;
e0: 0 ; action table pointer;
;central call of next action:
e4: rl. w3 e0. ; next action entry:
al w3 x3+1 ; pointer:=pointer+1;
e5: rs. w3 e0. ; start actions entry: save pointer;
bl w3 x3 ; action:=table(pointer);
a0: jl. x3+a0. ; goto action;
;outend and wait current out:
a1=k-a0
al w0 0 ; i-bit := curr out.give up mask;
rx. w0 h21.+h2 ; curr out.give up mask := 0 ;
sn w0 1 ; if i-bit = 1 then
jl. e4. ; goto next action; <*skip outend curr out*>
jl. w3 h59. ; outend(curr out,nl);
jl. w3 h89. ; check all(curr out);
jl. e39. ; goto free the share;
;unstack curr in to i-bit:
a2=k-a0
e33: rl. w0 h20.+h2+0 ; start: if bit 0 in give up
sz w0 2.1 ; is <> 0 then
jl. e4. ; goto next action else
jl. w3 h30.-4 ; unstack curr in and
jl. e33. ; goto start;
;close up and terminate curr out
a3=k-a0
al. w1 h21. ; char:=
bz w3 x1+h1+1 ; if kind(curr out) = bs
se w3 4 ; or kind(curr out) = mt
sn w3 18 ; then em
am 15 ; else nl;
al w2 10 ;
jl. w3 h34. ; terminate curr out;
jl. w3 h79. ; terminate zone;
jl. e4. ; goto next action;
\f
; rc 86.09.01 file processor, end program, page 3
;connect current out to primary out:
b. d10 w.
d1: 0 ; area for lookup entry:
0 ;
d2: 0 ; name first doubleword
0 ;
d3: 0 ; name second doubleword
0,r.5 ; rest of tail;
d4: <:c:>,0,0,0 ; name of primary output;
d0: 1<23
a4=k-a0
rl. w2 h15. ; start: create c:
rl w0 x2 ; kind:=kind(prim out process);
sl w0 20 ; if kind > 18
al w0 8 ; then kind = tw;
wa. w0 d0. ;
al. w1 d1. ;
rs w0 x1 ; tail(0):=1<23+kind;
dl w0 x2+4 ;
ds w0 x1+4 ; tail(2:8) := name(prim out);
dl w0 x2+8 ;
ds w0 x1+8 ;
al. w3 d4. ;
d5: jd 1<11+40 ; create entry(c);
se w0 3 ; if not allready exists
jl. d7. ; then goto check created;
al. w1 h54. ; c exists allready:
jd 1<11+42 ; lookup entry(c);
se w0 0 ; if not found
jl. e32. ; then goto give up;
dl. w3 d2. ; compare proc names:
sn w2 (x1+2) ;
se w3 (x1+4) ; if name cat entry (c)
jl. d6. ; < > name (prim out process)
dl. w3 d3. ; then goto remove c;
sn w2 (x1+6) ;
se w3 (x1+8) ;
jl. d6. ; else goto connect;
jl. d8. ;
d6: al. w3 d4. ; remove c:
jd 1<11+48 ; remove entry(c);
al. w1 d1. ;
jl. d5. ; goto create (c);
a10=k-a0
e32: rl. w1 h96. ;give up:
al w1 x1+1 ; prim inout errors :=
rs. w1 h96. ; prim inout errors + 1;
sh w1 10 ; if prim inout errors <= 10
jl. h60. ; then goto initialize fp;
al. w1 d10. ;
al. w3 h44. ;
jd 1<11+16 ; parent message:
jd 1<11+18 ; (<:***fp troubles with c:>);
jl. w3 h14. ; goto finis;
d10: 8<13+0<5
<:***fp trouble: c or v:>
\f
; fgs 1988.05.02 file processor, end program, page ...4...
d7: se w0 0 ; check created: if not created
jl. e32. ; then give up;
d8: al w0 1<2 ; connect c:
al. w2 d4. ;
jl. w3 h28.-2 ;
se w0 0 ; if not ok
jl. e32. ; then give up
jl. e4. ; else goto next action;
e.
a9=k-a0 ; goto (if stack empty) then commands else load;
b. b1 w. ;
dl. w3 h8. ; if first command address < stacktop - 10
sl w3 x2-10 ; then
jl. h61. ; begin
b0: ea w3 x3+1 ; for command := next in stack
el w1 x3 ; while kind > 2 do
sl w1 3 ; <* nothing *>;
jl. b0. ;
b1: el w1 x3+1 ; while
sl w1 10 ; length (command) < 10 do
jl. h62. ; begin
ea w3 x3+1 ; command := next in stack;
sl w3 x2-8 ; if command address >= stacktop - 8
jl. h61. ; then goto load;
jl. b1. ; end;
; end; goto commands
e.
\f
; fgs 1986.08.28 file processor, end program, page ...5...
; remove area processes :
b. d13 w.
; variables :
d9: -1 ; dummy message to fp (8 words):
0 ;
d13: 0 ; also first word of null name;
0 ; also save process bases;
d12: 0 ; -"-
0 ; also saved catalog bases;
d11: 0 ; -"-
d10: 0 ; also save buff addr and saved name table addr
; procedure remove area process (name table addr);
;
;
;
; w0: not used destroyed
; w1: name table addr name table addr
; w2: not used destroyed
; w3: link link
;
d3: rs. w3 e8.-2 ; remove area process: save link;
rs. w1 d10. ; save name table addr;
se. w1 (h20.+h1+10); if name table addr <> name table addr (in) and
sn. w1 (h21.+h1+10); name table addr <> name table addr (yt) then
jl x3 ; begin
rl w3 x1 ; w3 := proc addr;
al w0 4 ;
se w0 (x3) ; if proc.kind <> 4 then
jl. (e8.-2) ; return; <*pseudo process*>
dl w1 x3-2 ;
ds. w1 d12. ; save proc bases := bases.proc;
dl w1 x3+4 ;
ds. w1 h43.+2 ; save proc.name in answer area
dl w1 x3+8 ; lowest level in resident fp ;
ds. w1 h43.+6 ;
rl. w3 h16. ;
dl w1 x3+70 ;
ds. w1 d11. ; save cat bases;
dl. w1 d12. ; bases :=
rl w2 x3+74 ; if lower proc base >= lower max base and
sl w0 (x3+72) ; upper proc base <= upper max base then
sl w1 x2+1 ; proc bases else
dl w1 x3+74 ; max bases ;
al. w3 d13. ; w3 := addr null name;
jd 1<11+72 ; set cat base (bases);
al. w3 h43. ; w3 := addr proc name;
jd 1<11+64 ; remove area process ;
al. w3 d13. ; w3 := addr null name;
dl. w1 d11. ;
jd 1<11+72 ; set cat base (save cat base);
rl. w1 d10. ; restore name table addr;
; end;
jl. (e8.-2) ; return;
a5=k-a0
rl w1 76 ; remove area processes:
; name table index := first area proc;
d0: rl w2 x1 ; repeat
rl. w3 h16. ; w2 := area proc descr;
zl w0 64 ; w3 := own proc descr;
sl w0 9 ; if monitor release <= 8 then
jl. d1. ; w0 := user word from area proc
rl w0 x2+14 ; else
jl. d2. ; begin <*monitor release >= 9*>
d1: el w0 x3+12 ; w0 := rel addr of user half word in proc;
am (0) ; w0 := user half from area proc;
zl w0 x2 ; end;
d2: sz w0 (x3+12) ; if user word all zeroes in user id then
jl. w3 d3. ; remove area process;
al w1 x1+2 ; increase (name table index);
se w1 (78) ;
jl. d0. ; until name table index = top area proc ;
\f
; fgs 1986.08.28 file processor, end program, page ...6...
d4: al. w1 d9. ; remove buffers:
al. w3 h40. ; send dummy message to fp;
jd 1<11+16 ;
rs. w2 d10. ; save buffer address;
d5: al w2 0 ; first event: event:=first;
d6: jd 1<11+24 ; wait: wait event;
sn w2 0 ; if claims exceeded
jl. d7. ; then goto get clock buf;
sn w0 0 ; if event=message
jl. d6. ; then goto wait;
sn. w2 (h81.) ; if buf = sh.state(in) then
jl. d6. ; goto wait next;
jd 1<11+26 ; get event;
se. w2 (d10.) ; if buf <> clock buf
jl. d5. ; then goto first event;
jl. e4. ; goto next action;
d7: rl. w2 d10. ; get clock buf:
al. w1 d9. ;
jd 1<11+18 ; wait answer(clock buf);
jl. e4. ; goto next action;
e.
;free curr in - free cur out:
a6=k-a0
am h20-h21 ; zone:=curr in
a7=k-a0
e39: al. w1 h21. ; zone:=curr out;
al w0 0 ;
rl w2 x1+h0+6 ;
rs w0 x2 ; share state := free;
rl w3 x2+4 ; last address :=
rs w3 x2+10 ; last shared;
jl. e4. ; goto next action;
\f
; rc 86.09.01 file processor, end program, page ...7...
a8=k-a0
al. w0 e32. ;write device status alarm:
rs. w0 h21.+h2+2 ; giveup action(out) :=
al. w0 e47. ; reinitialize fp;
jl. w3 h31.-2 ; writetext(out,<:***device status:>);
al. w0 e34. ;
jl. w3 h31.-2 ; writetext(out,doc name);
al w2 0 ;
e46: rl. w1 e7. ; for bit := 0 step 1 until 21 do
ls w1 x2 ; begin
al. w0 e10. ;
ba. w0 x2+e45. ;
sh w1 -1 ; text := device status text(bit);
jl. w3 h31.-2 ; if bit = 1 then
al w2 x2+1 ; writetext(out,text);
se w2 22 ;
jl. e46. ; end;
jl. w3 h39. ; outend(nl);
rl. w0 h21.+h0+0 ; while base buffer area <> record base do
e37: sn. w0 (h21.+h3+0) ; begin
jl. e38. ; char := 127;
al w2 127 ; outchar current;
jl. w3 h26.-2 ; end;
jl. e37. ; comment either outend or this algorithm will
; force the block out thus preventing
e38: al w0 x1-h21+h68 ; endless looping on reselect out;
rs w0 x1+h2+2 ; giveup action(out) := fp std error;
al. w3 e34. ; examine hardware error:
jd 1<11+4 ; process description(document name);
sn w0 0 ; if non exist then
jl. e9. ; goto get mask;
rl w1 (0) ; w1 := kind(doc name);
se w1 4 ; if kind = 4 (bs)
sn w1 8 ; or kind = 8 (tw)
jl. +4 ; or
sn w1 14 ; kind = 14 (lp)
am 2 ; add parity to mask;
e9: rl. w1 e42. ; get mask;
rl. w0 e7. ; move status to message;
la w0 2 ;
rs. w0 e44. ;
sn w0 0 ; if status and mask(kind) <> 0
jl. e4. ; then
al. w1 e43. ;
al. w2 e34. ; parent message(<:status:>, doc name);
jl. w3 h35. ;
jl. e4. ; goto next action
; hard error message to parent, in case of hardware errors:
e43: 3<13+1<9+0 ; m(0) , pattern word
<:status:> ; m(2:4)
e44: 0 ; m(6) , logical status
e47: <:<10>***device status <0>:>
\f
; rc 86.08.28 file processor, end program, page ...8...
; mask(0:20) , to select hardware errors:
e42: 1<23+ 1<21+1<20+1<13+1<12+1<4 ; without parity bit
1<23+1<22+1<21+1<20+1<13+1<12+1<4 ; with parity bit
; device status text (0:21):
e10: <:<10>intervention<0>:> ;
e11: <:<10>parity error<0>:> ;
e12: <:<10>timer<0>:> ;
e13: <:<10>data overrun<0>:> ;
e14: <:<10>block length error<0>:> ;
e15: <:<10>end of document<0>:> ;
e16: <:<10>load point<0>:> ;
e17: <:<10>tape mark or attention<0>:> ;
e18: <:<10>writing enabled<0>:> ;
e19: <:<10>mode error<0>:> ;
e20: <:<10>read error<0>:> ;
e21: <:<10>card rejected or disk error<0>:> ;
e22: <:<10>checksum error<0>:> ;
e23: <:<10>bit 13<0>:> ;
e24: <:<10>bit 14<0>:> ;
e25: <:<10>stopped<0>:> ;
e26: <:<10>word defect<0>:> ;
e27: <:<10>position error<0>:> ;
e28: <:<10>process does not exist<0>:> ;
e29: <:<10>disconnected<0>:> ;
e30: <:<10>unintelligible<0>:> ;
e31: <:<10>rejected<0>:> ;
h.
e45: e10-e10, e11-e10, e12-e10, e13-e10, e14-e10, e15-e10
e16-e10, e17-e10, e18-e10, e19-e10, e20-e10, e21-e10
e22-e10, e23-e10, e24-e10, e25-e10, e26-e10, e27-e10
e28-e10, e29-e10, e30-e10, e31-e10
w.
e34: 0, e35: 0, 0, e36: 0 ; room for troubled device name
\f
; dh 86.08.28 file processor, end program, page ...9...
; table of sequences of actions
h.
; no device errors:
f1: a1, a2, a5, a9
;hard error on current out
f2: a7, a4, a2, a5, a8, a9
; hard error on stacked cur in zone
f3: a1, a6, a5, a8, a2, a9
; hard error on cur in zone:
f4: a3, a4, a6, a5, a8, a10
; hard error on other zone:
f5: a1, a2, a5, a8, a9
w.
; the actions are:
;a1: outend and free curr out
;a2: unstack curr in zone to i-bit
;a3: terminate curr out
;a4: connect primary out, if problems then reeinitialize fp
;a5: remove area processes and message buffers
;a6: free current in zone
;a7: free current out zone
;a8: write device status alarm, if problems then reinitialize fp
;a9: goto (if empty stack) then commands else load
;a10: reeinitialize fp
;comment if fp is reinitialized more than 10 times then
; the job will be terminated. this should take care
; of removed primary in and out.
e41 = (:h55+1024-k:)/2
0, r. e41 ; fill segment with zeroes
m.fp end program 88.05.02
m.fpnames follows:
e. ; end device status segment
\f
; fgs 1986.12.12 file processor, fpnames, insertproc page ...1...
e. i. ; list new fp names
b. g1 w. d. p.<:fpnames:>, w. l.; use old fpnames
b. w. ; a local block to cheat the i. in insertproc
g0: 18 ; segm
0, r.4 ; docname
s2 ; date
0, 0 ; fil, blok
3<12 + 2 ; contry
4096 ; length
g1: 1<23 + 4 ; secondary entry: init
0, r.4 ; room for docname
s2 ; date
0, 11 ; file, block
2<12 + 4 ; content, entry
1024 ; code length
d. p.<:insertproc:>, l.
e. ; end block with g-names
e. ; end file processor
▶EOF◀