|
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: 43776 (0xab00)
Types: TextFile
Names: »uti18«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦f8e4b63af⟧ »trcfput«
└─⟦this⟧
; rc 9.7.1971 fp utility, binout, page 1
; the program is translated like
; (binout=slang text entry.no
; binout)
b. g4 w. ; for insertproc
d.
p.<:fpnames:>
l.
; b. h99 ; begin block : fp names; this block must always
; w. ; be loaded from somewhere;
s. a44, b33, c12, d14, f16, g8, i5 ; begin segment: binout;
w. ;
k = h55
d11: i5 ; length of binout;
0 ; empty;
jl. d6. ; entry binout: goto initialize binout;
g3: <:create:> ; g3 create
0, r.4 ; g3+4 name
0, r.10 ; g3+12 tail
i0 = k - g3 ;
g4: <:perman:> ; g4 perman
0, r.4 ; g4+4 name
-1 ; g4+12 catalog key
i1 = k - g3 ;
g5: <:load:> ; g5 load
0, r.4 ; g5+4 name
0 ; g5+12 segments
i2 = k - g5 ;
f0: 0 ; remaining bytes
f3: 0 ; mode bits
f4: 0 ; first logical segment of input
f5: 0 ; segment - - - -
f6: 0 ; remaining segments - -
g0: 0 ; fp base
f7: 1<22 ; infinite
f8: 0 ; fp result
f9: 0 ; latest parameter delimiter
f10: 0 ; saved command pointer
; the mode bits are used so:
; prog.no<5 + program<4 + entry<3 + prog.a<2 + prog.s<1 + prog.p
; program is one if prog.a or prog.s or prog.p
\f
; rc 15.6.1969 fp utility, binout, page 2
; output zone descriptor (single buffer):
; part 0, buffer and share description:
w. 0 ; h0 base of buffer area
0 ; h0+2 last of buffer area
0 ; h0+4 used share
0 ; h0+6 firstshare
0 ; h0+8 last share
; part 1, process description:
h. 0 , 0 ; h1 1<11+mode, kind
w. 0 , r.4 ; h1+2 document name
0 ; h1+10 name address
0 ; h1+12 file count
0 ; h1+14 block count
0 ; h1+16 segment count
; part 2, status handling:
0 ; h2 give up mask
0 ; h2+2 give up action
0 ; h2+4 partial word
0 ; h2+6 free
; part 3, record description:
g1: 0 ; h3 record base
0 ; h3+2 last byte
0 ; h3+4 record length
0 ; h3+6 free
; part 4, users parameters
0 ; h4 free
0 ; h4+2 free
0 ; h4+4 free
; share descriptor:
g8: 0 ; 0 state
0 ; 2 first shared
0 ; 4 last shared
0 , r.8 ; 6 latest message
0 ; 22 top transferred
\f
; rc 15.8.1970 fp utility, binout, page 3
; input zone descriptor (single buffer):
; part 0, buffer and share description:
w. 0 ; h0 base of buffer area
0 ; h0+2 last of buffer area
0 ; h0+4 used share
0 ; h0+6 first share
0 ; h0+8 last share
; part 1, process description:
h. 0 , 0 ; h1 1<11+mode, kind
w. 0 , r.4 ; h1+2 document name
0 ; h1+10 name address
0 ; h1+12 file count
0 ; h1+14 block count
0 ; h1+16 segment count
; part 2, status handling:
5<16+1<9 ; h2 give up mask (end document, file mark)
0 ; h2+2 give up action
0 ; h2+4 partial word
0 ; h2+6 free
; part 3, record description:
g2: 0 ; h3 record base
0 ; h3+2 last byte
0 ; h3+4 record length
0 ; h3+6 free
; part 4, users parameters
0 ; h4 free
0 ; h4+2 free
0 ; h4+4 free
; share descriptor:
g6: 0 ; 0 state
0 ; 2 first shared
0 ; 4 last shared
0 , r.8 ; 6 latest message
0 ; 22 top transferred
\f
; rc 9.7.1971 fp utility, binout, page 4
; call: w2 : name (4 words)
; w2+8 : tail (10 words)
; jl. w3 c2.
; exit: w0, w1, w2 unchanged
; w3 = if permanent entry then
; catalog key else -1
; exit to call+2 if name not found
; exit to call+4 if name found
b. a4, b7 ; begin block: lookup;
w. ;
d10: ;
b0: <:catalog:>,0,0 ; name and name table address;
b1: 3<12 ; message: operation = input
0 ; f1-2 : first core
f1: 0 ; f1 : last core
b2: 0 ; segment
b3: 0 , r.8 ; answer
b4: 0 ; init key = first segment
f2: 0 ; catalog size (no of segments)
b5: 0 ; entry count
0 ; saved w0
b6: 0 ; saved w1
0 ; saved w2
b7: 0 ; saved w3
c2: ds. w1 b6. ; lookup:
ds. w3 b7. ; save all registers;
c. h57<2 ; if monitor 2 version then
dl w1 x2+6 ; get name key:
aa w1 x2+2 ; name key := (bits(0,47,name) +
wa w1 0 ; bits(48,95,name)) mod 2**48;
ba w1 2 ; name key := (bits(0,23,name key) +
al w0 0 ; bits(24,47,name key)) mod 2**24;
wd. w1 f2. ; name key := (bits(0,11,name key) +
rs. w0 b2. ; bits(12,23,name key)) mod catalog size;
rs. w0 b4. ; first segment := segment := name key;
a0: al. w3 b0. ; input segment: w3 := addr(<:catalog:>);
jd 1<11+6 ; initialize process(<:catalog:>);
se w0 0 ; if result <> 0 then
jl. d0. ; alarm(<:catalog:>);
al. w1 b1. ; w1 := message address;
jd 1<11+16 ; send message;
al. w1 b3. ; w1 := answer address;
\f
; rc 15.6.1969 fp utility, binout, page 5
jd 1<11+18 ; wait answer;
sn w0 2 ; if result = 2 then
jl. a0. ; goto input segment; comment: may happen
rl w1 0 ; if proc func reserves the catalog;
jd 1<11+64 ; remove process(<:catalog:>);
am. (b3.) ;
sn w3 x3 ; if status word <> 0
se w1 1 ; or result(wait answer) <> 1
jl. d0. ; then alarm(<:catalog:>);
am. (b3.+2) ;
sn w3 x3 ; if bytes transferred = 0 then
jl. a0. ; goto input segment;
rl. w2 b7.-2 ; restore(w2);
rl. w3 f1.-2 ; entry := first core;
rl. w0 b4. ; entry count :=
rl w1 x3+510 ; (if segment = first segment
sn. w0 (b2.) ; then last word(this cat segment)
rs. w1 b5. ; else entry count);
al w3 x3-28 ; entry := entry - entry size + 6;
a1: am. (b5.) ; next entry:
sn w3 x3 ; if entry count = 0 then
jl. a2. ; goto not found;
al w3 x3+34 ; entry := entry + entry size;
sh. w3 (f1.) ; if entry <= last core then
jl. a3. ; goto search;
rl. w1 b2. ; next segment:
al w1 x1+1 ; segment := segment + 1;
sl. w1 (f2.) ; if segment >= catalog size then
al w1 0 ; segment := 0;
rs. w1 b2. ;
se. w1 (b4.) ; if segment <> first segment then
jl. a0. ; goto input segment;
a2: dl. w1 b6. ; not found: restore(w0,w1);
jl. (b7.) ; return to call + 2;
a3: bz w0 x3-6 ; search:
se. w0 (b4.) ; if name key(entry) <> init key then
jl. a1. ; goto next entry;
rl. w1 b5. ; key count:
al w1 x1-1 ; entry count := entry count - 1;
rs. w1 b5. ;
\f
; rc 17.1.1972 fp utility, binout, page 6
dl w1 x3+2 ; compare names:
sn w0 (x2) ; if bytes(0,3,cat name)
se w1 (x2+2) ; <> bytes(0,3,name) then
jl. a1. ; goto next entry;
dl w1 x3+6 ;
sn w0 (x2+4) ; if bytes(4,7,cat name)
se w1 (x2+6) ; <> bytes(4,7,name) then
jl. a1. ; goto next entry;
a4: rl w0 x3+8 ; move tail:
rs w0 x2+8 ; word(tail+8) := word(entry+8);
al w3 x3+2 ; entry := entry + 2;
al w2 x2+2 ; tail := tail + 2;
am. (b7.-2) ;
se w2 20 ; if tail <> saved tail then
jl. a4. ; goto move tail;
bz w1 x3-25 ; get catalog key:
am (x3-24) ; w1 := catalog key;
se w3 x3 ; if creator number <> 0 then
al w1 -1 ; w1 := -1;
al w3 x1 ; w3 := w1;
z. ; else
c. h57<3 ; if monitor 3 version then
al w3 x2 ; lookup: w3:=addr(name)
al. w1 b0. ; w1:=addr(top of entry area)
jd 1<11+76 ; lookup head and tail
sn w0 0 ; if not found then
jl. a4. ; begin
dl. w1 b6. ; restore w0,w1
jl. (b7.) ; return
; end else
a4: dl w0 x1+16 ; move tail
sl w3 0 ; if kind >= 0 (area entry)
al w0 1 ; then doc.name := 1 (disc);
ds w0 x2+10 ;
dl w0 x1+20 ;
ds w0 x2+14 ;
dl w0 x1+24 ;
ds w0 x2+18 ;
dl w0 x1+28 ;
ds w0 x2+22 ;
dl w0 x1+32 ;
ds w0 x2+26 ;
al w3 2.111 ; get cat key
la w3 x1 ; (3 leftmost bits of top head)
sn w3 0 ; if key=0
al w3 -1 ; then key:=-1 (no perman command)
; go on to exit:
z. ; end conditional monitor 3 version code
; start common code
dl. w1 b6. ; exit:
rl. w2 b7.-2 ; restore(w0,w1,w2);
am. (b7.) ;
jl 2 ; return to call + 4;
i. ; id list
e. ; end block lookup
\f
; rc 29.1.1970 fp utility, binout, page 7
b. a2, b4 ; begin block: inbyte, inword, outhead;
w. ;
c4: am 1 ; inword: increment := 2; skip;
c1: al w0 1 ; inbyte: increment := 1;
rs. w3 b0. ; save return;
a0: al. w1 g2. ; repeat: w1 := address(input zone descr);
rl w2 x1+h3 ;
sl w2 (x1+h3+2) ; if record base >= last byte then
jl. a1. ; goto next block;
rl w3 x1+h3 ;
wa w3 0 ; record base :=
rs w3 x1+h3 ; record base + increment;
rl. w2 f0. ;
ws w2 0 ; remaining bytes :=
rs. w2 f0. ; remaining bytes - increment;
bz w2 x3 ; w2 := byte(record base); (>=0);
se w0 1 ; if increment <> 1 then
rl w2 x3 ; w2 := word(record base);
jl. (b0.) ; return;
a1: am. (g0.) ; next block:
jl w3 h22 ; inblock;
jl. a0. ; goto repeat;
b32: 2.111110100011110010111101
d1: sz. w3 (b32.) ; give up action:
jl. a2. ; if hard error then
al w2 -1 ; goto give up;
rs. w2 f0. ; remaining bytes := -1;
rs. w2 f6. ; remaining segments := -1;
jl. (b0.) ; w2 := -1; return;
d12:
a2: rs. w3 f8. ; give up: fp result := w2;
al. w0 g2.+h1+2 ;
rs. w0 f16. ; save doc name addr;
jl. d13. ; goto exit fp 2;
b0: 0 ; saved return (inbyte);
b1: 0 ; saved record base;
b2: 0 ; saved remaining bytes;
b3: 0 ; saved return (outhead);
b4: 0 ; saved last byte;
c3: al w0 x1+511 ; outhead: last core := first core + 511;
rx. w1 g2.+h3 ; swap(record base, first core);
rx. w0 g2.+h3+2 ; swap(last byte, last core);
rx. w2 f0. ; swap(bytes, remaining bytes);
ds. w2 b2. ; save(first core, bytes);
ds. w0 b4. ; save(last core, return);
jl. w3 c0. ; output segment;
dl. w2 b2. ; restore(first core, bytes);
dl. w0 b4. ; restore(last core, return);
rx. w1 g2.+h3 ; swap(first core, record base);
rx. w0 g2.+h3+2 ; swap(last core, last byte);
rx. w2 f0. ; swap(bytes, remaining bytes);
jl x3 ; return;
i. ; id list
e. ; end block: inbyte, inword, outhead
\f
; rc 16.6.1969 fp utility, binout, page 8
b. a3, b6 ; begin block: outsegment;
w. ;
b0: 0 ; saved return
b1: 0 ; saved byte;
b2: 1<7 ; parity bit
b3: 1<6 ; sumbit
b4: 0 ; char sum
b5: 2.111111 ; mask
c0: rs. w3 b0. ; outsegment: save return;
i4 = k + 1 ; first ;
se w3 x3+1 ; if first then
c. h57<2 ; if monitor 2 version then
jl. w3 c7. ; output blanks;
z. ; else
c. h57<3 ; if monitor 3 version then
am ; insert dummy instruction;
z. ;
al w3 0 ;
hs. w3 i4. ; first := false;
a0: am. (f0.) ; next byte:
sl w3 x3 ; if remaining bytes <= 0 then
jl. (b0.) ; return;
jl. w3 c1. ; inbyte; comment: decreases rem bytes;
sh w2 -1 ; if byte = <end doc. > or <eof> then
jl. (b0.) ; return;
rs. w2 b1. ; saved byte := byte;
ls w2 -6 ; char := bits(0,5,byte);
jl. w3 a1. ; outchar;
rl. w2 b1. ; char := saved byte;
la. w2 b5. ; char := bits(6,11,char);
jl. w3 a1. ; outchar;
jl. a0. ; goto next byte;
a1: rx. w2 b4. ; outchar:
wa. w2 b4. ; char sum := char sum + char;
rx. w2 b4. ;
al w0 x2 ; char1 := char;
lx. w2 b2. ; char := char + parity bit;
a2: sz w0 1 ; set parity: if bit(11,char1) = 1
lx. w2 b2. ; then char := char exor parity bit;
ls w0 -1 ; char1 := char1 shift - 1;
se w0 0 ; if char1 <> 0 then
jl. a2. ; goto set parity;
al. w1 g1. ; w1 := addr(output zone descr);
am. (g0.) ; enterfp:
jl h26 ; goto fp outchar;
c5: rs. w3 b0. ; outsum:
rl. w2 b4. ; save return;
la. w2 b5. ; char := bits(6,11,char sum);
lo. w2 b3. ; char := char + sum bit;
jl. w3 a1. ; outchar;
al w3 0 ;
rs. w3 b4. ; char sum := 0;
jl. (b0.) ; return;
i. ; id list
e. ; end block: outsegment, outsum
\f
; rc 21.6.1969 fp utility, binout, page 9
d2: rl. w0 f3. ; start output:
so w0 1<3 ; if entry not wanted then
jl. d3. ; goto next segment;
rl. w0 g4.+12 ; w0 := catalog key;
al. w1 g3.-1 ; first core := base command segment - 1;
al w2 i0 ; bytes := size(create command);
sl w0 0 ; if catalog key >= 0 then
al w2 i1 ; bytes := bytes + size(perman command);
jl. w3 c3. ; outhead;
rl. w0 f3. ; w0 := mode bits;
al. w1 g5.-1 ; first core := base(load command) - 1;
al w2 i2 ; bytes := size(load command);
sz w0 1<4 ; if program wanted then
jl. w3 c3. ; outhead;
jl. w3 c5. ; outsum;
d3: rl. w0 f3. ; next segment:
so w0 1<4 ; if program not wanted then
jl. a5. ; goto test end parameter list;
so w0 1<1 ; if -, prog.s then
jl. a33. ; goto test skip;
jl. w3 c4. ; first word := inword;
rl. w1 g2.+h3 ;
al w1 x1-2 ; record base :=
rs. w1 g2.+h3 ; record base - 2;
bz. w0 g2.+h1+1 ; w0 := process kind(input);
se w0 4 ; if input from backing store then
jl. a0. ; begin
rl. w0 f3. ; w0 := mode bits;
sz w0 1<1 ; if segmented program then
jl. a1. ; remaining bytes := first word;
jl. a33. ;
a0: rl. w2 g2.+h3+2 ; end else
ws. w2 g2.+h3 ; begin remaining bytes :=
a1: rs. w2 f0. ; last byte - record base;
sh w2 0 ; if remaining bytes <= 0 then
al w2 -1 ; remaining bytes := -1;
sh w2 0 ; if remaining bytes <= 0 then
rs. w2 f6. ; remaining segments := remaining bytes;
a33: rl. w1 f6. ; end;
sh w1 0 ; test skip: if remaining segments <= 0
jl. d4. ; then goto terminate input;
rl. w0 f5. ;
sl. w0 (f4.) ; if segment >= first segment then
jl. a3. ; goto output;
a2: jl. w3 c4. ; skip segment:
rl. w0 f0. ; inword;
sh w0 0 ; if remaining bytes <= 0 then
jl. a34. ; goto finis segment 1;
jl. a2. ; goto skip segment;
a3: rl. w0 f3. ; output:
sz w0 1<2 ; if prog.a then
jl. w3 c4. ; inword;
jl. w3 c0. ; output segment;
jl. w3 c5. ; outsum;
\f
; rc 21.6.1969 fp utility, binout, page 10
a4: rl. w1 f6. ; finis segment:
al w1 x1-1 ; remaining segments :=
rs. w1 f6. ; remaining segments - 1;
a34: rl. w0 f5. ; finis segment 1:
ba. w0 1 ; segment := segment + 1;
rs. w0 f5. ;
rl. w1 f6. ;
sl w1 1 ; if remaining segments > 0 then
jl. d3. ; goto next segment;
d4: al. w1 g2. ; terminate input:
am. (g0.) ; w1 := addr(input zone descr);
jl w3 h79 ; terminate zone;
rl. w0 f4. ; w0 := first segment;
se. w0 (f7.) ; if first segment <> infinite then
jl. a5. ; goto test end parameter list;
rl. w1 f5. ; remaining segments := segment;
rs. w1 f6. ; load segments :=
rs. w1 g5.+12 ; remaining segments;
al w1 0 ;
rs. w1 f4. ; first segment := 0;
rs. w1 f5. ; segment := 0;
jl. w3 c6. ; initialize input;
jl. d2. ; goto start output;
\f
; rc 29.07.71 fp utility, binout, page 10a
a5: rl. w1 f6. ; test end parameter list:
sl w1 0 ; if remaining segments < 0 then
jl. a6. ; begin
rl. w0 f3. ;
sz w0 1 ;
am. (f0.) ; if prog.p
sn w3 x3+2 ; and init no of bytes = -2 then
jl. a6. ; goto ok;
al. w2 b22. ;
jl. w3 c11. ; mess name(<:segments:>);
rl. w0 f5. ;
am. (g0.) ; writeinteger(segment);
jl w3 h32-2 ;
32<12 + 1 ; end;
a6: rl. w0 f9. ; ok:
sl w0 4 ; if latest parameter delimiter > 3
jl. d5. ; then goto scan parameter list;
d7: bz. w2 i4. ; exit fp:
se w2 0 ; if -, first then
jl. a36. ; begin
c. h57<2 ; if monitor 2 version then
jl. w3 c7. ; output blanks;
z. ;
al w2 0 ; w2 := 0;
al. w1 g1. ; w1 := output zone addr;
am. (g0.) ; close up;
jl w3 h34 ;
a36:
d13: al w2 10 ; exit fp 2:
am. (g0.) ; w2 := <new line>;
jl w3 h26-2 ; writechar(current out);
rl. w2 f8. ; w2 := fp result;
al. w1 g1. ; w1 := addr(output zone descr);
al w0 0 ; tapemark := true;
am. (g0.) ;
jl w3 h79 ; terminate zone;
c. h57<3 ; if monitor 3 version then include the following:
bz w2 x1+h1+1 ; the outputfile must be reduced to the
al w3 x1+h1+2 ; absolute minimum, in case of backing storage:
al. w1 h54. ;
jd 1<11+42 ; lookup entry(outfilename, tailaddr);
rl w0 x3+14 ; tail(0) := segment count (output zone);
rs w0 x1 ;
sn w2 4 ; if kind(output zone) = <bs> then
jd 1<11+44 ; change entry(outfile name, tail);
rl. w2 f8. ; w2 := fp result;
z. ;
rl. w1 f16. ; w1 := doc name addr;
am. (g0.) ;
jl h7 ; goto fp end program;
b22: <: segments <0>:> ;
b11: 10<12 ;
f16: 0 ; addr(doc name);
d14: rs. w3 f8. ; give up output:
al. w0 g1.+h1+2 ; save status and
rs. w0 f16. ; doc name addr;
jl. d13. ; goto exit fp 2;
\f
; rc 1976.03.11 fp utility, binout, page ...11...
d8: c. h57<2 ; if system 2 then begin
rl. w3 g0. ; search fp notes:
al w1 x3+h52+2 ; tail := abs addr(descr part first note);
rl. w0 g3.+4 ; name := first word(name of input);
a7: sn w0 (x1-2) ; may be next note:
jl. a9. ; if name = name part(note) then
al w1 x1+22 ; goto name is note;
sh w1 x3+h53 ; tail := tail + 22;
jl. a7. ; if tail <= top of notes then
; goto may be next note;
z.; end system 2
a8: al. w2 g3.+4 ; name is not note:
jl. w3 c2. ; lookup(name of input);
jl. d9. ; exit: not found; goto name not found;
rs. w3 g4.+12 ; perman key := catalog key; (or -1);
dl. w1 g3.+6 ;
ds. w1 g4.+6 ; move name part of create command
ds. w1 g5.+6 ; to name part of perman command
dl. w1 g3.+10 ; and to name part of load command;
ds. w1 g4.+10 ;
ds. w1 g5.+10 ;
jl. a11. ; goto file descriptor;
c. h57<2 ; if system 2 then begin
a9: rl. w0 f3. ; name is note:
la. w0 b1. ;
rs. w0 f3. ; entry wanted := false;
al w2 x1-8 ; w2 := tail - 8;
rl w0 x1 ;
sl w0 0 ; if tail(0) >= 0 then
jl. a10. ; goto no program file;
bz w0 1 ;
sn w0 18 ; if process kind = 18 then
jl. a12. ; goto test program;
se w0 4 ; if process kind <> 4 then
jl. a10. ; goto no program file;
al w3 x1+4 ; w3 := addr(document name);
al. w1 g3.+12 ; w1 := tail addr(create command);
jd 1<11+42 ; lookup entry;
jl. a12. ; goto test program;
z. ; end system 2
\f
; rc 21.6.1969 fp utility, binout, page 12
b4: <: prog or entry<0>:>;
a11: rl w0 x2+8 ; file descriptor:
bz w1 1 ; if tail(0) > 0 then
sh w0 0 ; goto test program;
sn w1 18 ; if process kind = 18 then
jl. a12. ; goto test program;
a10: rl. w0 f3. ; no program file:
la. w0 b2. ; program wanted := false;
rx. w0 f3. ;
al. w2 b4. ; w2 := addr(<:prog or entry:>);
so w0 1<4 ; if program wanted
so w0 1<3 ; or entry not wanted then
a14: jl. w3 c11. ; mess name(<:prog or entry:>);
jl. d2. ; goto start output;
a12: rl. w0 f3. ; test program:
so w0 1<5 ; if prog.no
sz w0 1<4 ; or program wanted then
jl. a13. ; goto prepare input;
bz w3 x2+24 ;
la. w0 b2. ; mode bits := mode bits and (-1-1<4-1<5-7);
am x3 ;
lo. w0 x3+b3. ; mode bits := mode bits or
rl w3 x2+8 ; content table(content);
so w0 1<4 ; if program not wanted then
jl. a44. ; goto not;
bz w1 x2+9 ;
sn w1 18 ;
sl w3 0 ; if process kind = 18 then
jl. a44. ; begin
la. w0 b2. ; mode bits := mode bits and (-1-15);
lo. w0 b18. ; mode bits := mode bits or (1<1 + 1);
a44: al w3 0 ; end;
bz. w1 g2.+h1+1 ; not:
se w1 18 ;
sz w0 1<1 ; first segment := 0;
rl. w3 f7. ; if prog.s or process kind = 18 then
rs. w3 f4. ; first segment := infinite;
rs. w0 f3. ;
al w3 1 ;
rs. w3 f6. ; remaining segments :=
rs. w3 g5.+12 ; load segments := 1;
\f
; rc 21.6.1969 fp utility, binout, page 12a
a13: rl. w0 f6. ; prepare input:
sn w0 0 ; if no of segments = 0 then
jl. a10. ; goto no program file;
rl w0 x2+8 ;
rl. w1 f0. ; if remaining bytes = -2 then
ls w0 9 ; remaining bytes :=
sn w1 -2 ; tail(0)*512;
jl. a43. ; else
rl w0 x2+26 ; begin
sl w1 0 ; if remaining bytes < 0 then
al w0 x1 ; remaining bytes := length part (tail);
sn w0 0 ; if remaining bytes = 0 then
jl. a10. ; goto no program file;
a43: rs. w0 f0. ; end;
rl w0 x2+20 ;
rs. w0 b33. ; save file count;
rl. w0 f3. ; if prog.no and entry.no
al. w2 b4. ; or program not wanted then
se w0 0 ; begin
sn w0 1<5 ; mess name(<:prog or entry:>);
jl. a14. ; goto start output
; end;
so w0 1<4 ; if program not wanted then
jl. d2. ; goto start output;
jl. w3 c6. ; initialize input;
rl. w0 f4. ;
se. w0 (f7.) ; if first segment <> infinite then
jl. d2. ; goto start output;
rl. w0 f7. ;
rs. w0 f6. ; remaining segments := infinite;
jl. d3. ; goto next segment;
\f
; rc 15.7.1969 fp utility, binout, page 13
b6: <:<10>***binout param <0>:>;
b28: <:<10>***binout input name missing<0>:>;
b7 = k - 4 ; delimiter table:
<: :>,<:=:>,<:.:> ;
b5: 4<12 + 10 ; (space,name)
b20: 8<12 + 4 ; (point,integer)
b10: 8<12 + 10 ; (point,name)
d5: rl. w2 f10. ; scan parameter list:
jl. w3 c12. ; restore command pointer;
rl w1 x2 ; next param;
bl w0 x2 ;
sl w0 4 ; if param list exhausted then
jl. a35. ; begin
al. w0 b28. ; w0 := text address;
am. (g0.) ; writetext(<***binout input name missing:>);
jl w3 h31-2 ; end;
jl. d7. ;
a35: sn. w1 (b5.) ; if parameter = (space,name) then
jl. a15. ; goto test name;
i3 = k + 1; alarm state ; alarm next:
a16: se w3 x3 ; if alarm state then
jl. a17. ; goto list parameter;
al w0 1 ;
hs. w0 i3. ; alarm state := true;
rs. w0 f8. ; fp result := 1;
al. w0 b6. ;
am. (g0.) ; enter fp:
jl w3 h31-2 ; writetext(<:***binout param:>);
a17: bz w1 x2 ; list parameter:
al. w0 x1+b7. ; writetext(string
am. (g0.) ; delimiter table(delimiter));
jl w3 h31-2 ;
bz w1 x2+1 ;
al w0 x2+2 ;
sn w1 4 ; if parameter is name then
jl. a18. ; begin
am. (g0.) ; writetext(name);
jl w3 h31-2 ; goto scan parameter list;
jl. d5. ; end;
a18: rl w0 x2+2 ; w0 := param;
am. (g0.) ; enter fp:
jl w3 h32-2 ; writeinteger;
32<12 + 1 ;
jl. d5. ; goto scan parameter list;
\f
; rc 15.7.1969 fp utility, binout, page 14
a15: al w1 0 ; test name:
hs. w1 i3. ; alarm state := false;
dl w1 x2+4 ;
ds. w1 g3.+6 ; move parameter to name
dl w1 x2+8 ; part of create command;
ds. w1 g3.+10 ;
al w0 1<3 ; mode bits :=
rs. w0 f3. ; prog.yes or entry.yes;
al w0 1 ;
rs. w0 f6. ; remaining segments :=
rs. w0 g5.+12 ; load segments := 1;
al w0 0 ;
rs. w0 f4. ; first segment := 0;
rs. w0 f5. ; segment := 0;
al w0 -2 ;
rs. w0 f0. ; remaining bytes := -2;
a19: bl w3 6 ; next option:
sn w3 4 ; next delimiter := bits(0,11,next item);
jl. d8. ; if next delimiter = <space> then
; goto search fp notes;
se w3 8 ; if next delimiter = <point> then
jl. d5. ; goto scan parameter list;
jl. w3 c12. ; search options: next param;
rl. w1 f3. ; w1 := mode bits;
sn. w0 (b9.) ; if param = <:ne:> then
jl. a20. ; goto entry.no;
la. w1 b2. ; w1 := w1 and (-1-1<4-1<5-7);
sn. w0 (b14.) ; if param = <:p:> then
jl. a22. ; goto prog.p;
sn. w0 (b15.) ; if param = <:s:> then
jl. a23. ; goto prog.s;
sn. w0 (b16.) ; if param = <:a:> then
jl. a24. ; goto prog.a;
sn. w0 (b31.) ; if param = <:b:> then
jl. a42. ; goto prog.b;
se. w0 (b8.) ; if param <> <:np:> then
jl. a16. ; goto alarm next;
al w0 1 ; prog.no:
al w3 0 ; w0 := 1; w3 := 0;
lo. w1 b26. ; w1 := w1 or (1<5);
jl. a25. ; goto store;
a20: la. w1 b1. ; entry.no:
rs. w1 f3. ; mode bits := w1 and 1<3;
jl. a19. ; goto next option;
a22: lo. w1 b17. ; prog.p:
al w0 1 ; w1 := w1 or (1<4+1);
al w3 0 ; w0 := 1; w3 := 0;
jl. a25. ; goto store;
\f
; rc 16.7.1969 fp utility, binout, page 15
a24: lo. w1 b19. ; prog.a: w1 := w1 or (1<4+1<2);
a23: lo. w1 b18. ; prog.s: w1 := w1 or (1<4+1<1);
sn. w3 (b20.) ; if next item is (point,integer)
jl. a26. ; then goto more;
rl. w0 f7. ; w0 := infinite;
rl. w3 f7. ; w3 := infinite;
jl. a25. ; goto store;
a26: jl. w3 c12. ; more:
sn. w3 (b20.) ; next param;
jl. a27. ; if next item <> (point, integer) then
al w3 0 ; begin w3 := 0;
jl. a25. ; goto store
; end;
a27: rs. w0 f6. ; save w0;
jl. w3 c12. ; next param;
rl w3 0 ; w3 := param;
rl. w0 f6. ; restore w0;
a25: rs. w0 f6. ; store: init no of segments := w0;
rs. w0 g5.+12 ; load segments := w0;
rs. w1 f3. ; init mode bits := w1;
rs. w3 f4. ; init first segment := w3;
rl. w3 b12. ; w3 := saved item;
jl. a19. ; goto next option;
a42: al w0 -1 ; prog.b: w0 := -1;
sn. w3 (b20.) ; if next item = (point,integer)
jl. w3 c12. ; then next param;
rs. w0 f0. ; init no of bytes := w0;
jl. a22. ; goto prog.p;
b21: 0 ; save return ;
b12: 0 ; saved item ;
c12: rs. w3 b21. ; next param;
ba w2 x2+1 ; save return;
rs. w2 f10. ; command point := command point +
; bits(12,23,item head);
al w3 x2 ; save command pointer;
ba w3 x2+1 ;
rl w3 x3 ; w3 := next item head;
bl w0 6 ;
rs. w0 f9. ; save latest parameter delimiter;
sh w0 3 ; if delimiter < 4 then
rl. w3 b5. ; w3 := (space, name);
rl w0 x2+2 ; w0 := first word(parameter);
rs. w3 b12. ; saved item := w3;
jl. (b21.) ; return;
b8: <:np:> ;
b9: <:ne:> ;
b14: <:p:> ;
b15: <:s:> ;
b16: <:a:> ;
b31: <:b:> ;
\f
; rc 26.6.1969 fp utility, binout, page 16
d0: al w2 x3 ; alarm: w2 := text address;
al w3 0 ; alarm := true;
c11: rs. w3 b21. ; mess name:
al. w0 b24. ; save return;
am. (g0.) ; enter fp:
jl w3 h31-2 ; writetext(<:***binout:>);
al. w0 g3.+4 ;
am. (g0.) ; enter fp:
jl w3 h31-2 ; writetext(name part of create command);
al w0 x2 ;
am. (g0.) ; enter fp:
jl w3 h31-2 ; writetext(parameter);
al w3 1 ;
rs. w3 f8. ; fp result := 1;
rl. w3 b21. ; restore w3;
se w3 0 ; if -,alarm then
jl x3 ; return;
jl. d7. ; goto exitfp;
d9: al. w2 b23. ; name not found:
jl. w3 c11. ; mess name(<:unknown:>);
jl. d5. ; goto scan parameter list;
b23: <: unknown<0>:> ;
b24: <:<10>***binout <0>:>;
b0: 1<3 ;
b1: -1-1<3 ;
b26: 1<5 ;
b2: -1-1<4-1<5-7 ;
b3: 0 ; content table:
0 ; 1
b17: 1<4+1 ; 2
1<4+1 ; 3
1<4+1 ; 4
0 ; 5
b18: 1<4+1<1 ; 6
b19: 1<4+1<2 ;
c. h57<2 ; if monitor 2 version then
c7: rs. w3 b21. ; output blanks:
bz. w0 g1.+h1+1 ; if process kind <> <punch> then
se w0 12 ; return;
jl x3 ;
al w0 100 ; count := 100;
al. w1 g1. ; w1 := addr(output zone descr);
a28: al w2 0 ; more blank:
am. (g0.) ; enter fp: w2 := 0;
jl w3 h26 ; fp outchar;
bs. w0 1 ; count := count - 1;
se w0 0 ; if count <> 0 then
jl. a28. ; goto more blank;
jl. (b21.) ;
z. ;
\f
; rc 12.5.1970 fp utility, binout, page 17
c6: rs. w3 b21. ; initialize input:
al. w1 g2. ; w1 := addr(input zone descr);
al. w2 g3.+4 ; w2 := addr(name of input file);
rl. w0 b33. ;
rs. w0 g2.+h1+12 ; restore filecount;
am. (g0.) ; enter fp:
jl w3 h27 ; connect input;
sn w0 0 ; if w0 <> 0 then
jl. a29. ; begin
al. w3 d5. ; set return(scan parameter list);
jl. w2 c11. ; w2 := addr(<:connect input:>);
<: input impossible<0>:>; goto mess name
; end;
a29: bz w0 x2+16 ;
se w0 4 ; if content(file descriptor) <> 4
jl. a32. ; then goto update;
al w0 0 ;
rs. w0 g2.+h1+14 ; block := 0;
rs. w0 g2.+h1+16 ; segment count := 0;
a32: dl. w0 g2.+h0+2 ; update:
bz. w2 g2.+h1+1 ; if process kind = 18 then
sn w2 18 ; begin first shared := first free core;
ds. w0 g6.+4 ; last shared := top command - 2;
rs. w0 g6.+10 ; last of transfer := last shared;
; end;
jl. (b21.) ; return;
b33: 0 ; saved filecount;
d6: rs. w1 g0. ; initialize binout: first free core:
rs. w3 f10. ; save fp base; save command pointer;
al. w3 d6. ; initialize output zone:
al w0 x3+510 ; base buffer := first free core;
ds. w0 g1.+h0+2 ; last of buffer := first free core + 510;
ds. w0 g8.+4 ; first shared := base buffer;
al. w0 g8. ; last shared := last of buffer;
rs. w0 g1.+h0+4 ; first share := last share :=
rs. w0 g1.+h0+6 ; used share := share descriptor addr;
rs. w0 g1.+h0+8 ;
al. w0 d14. ;
rs. w0 g1.+h2+2 ; set give up action(output);
al. w3 d6.+512 ; initialize input zone:
al w0 x2-2 ; base buffer := first free core + 512;
ds. w0 g2.+h0+2 ; last of buffer := top command - 2;
sl w0 x3+512 ; if last of buffer < base buffer+512 then
jl. a37. ; begin
al. w0 b30. ; writetext(<:***binout core size:>);
jl. a38. ; w2:=0; goto fp end program; end;
b30: <:<10>***binout core size<0>:>;
a37: ds. w0 g6.+4 ; first shared := base buffer;
al. w0 g6. ; last shared := last of buffer;
rs. w0 g2.+h0+4 ; first share := used share :=
rs. w0 g2.+h0+6 ; last share := share descriptor addr;
rs. w0 g2.+h0+8 ;
al. w0 d1. ;
rs. w0 g2.+h2+2 ; set give up action;
bz. w0 (f10.) ;
se w0 6 ; if no left hand side then
jl. a30. ; goto call alarm;
\f
; rc 1976.05.21 fp utility, binout, page ...18...
rl. w3 f10. ;
al w2 x3-8 ; w2 := addr(left hand side of call);
al. w1 g1. ; w1 := addr(output zone descr);
al w0 1<1+1 ; (one segment pref. on disc)
am. (g0.) ; enter fp:
jl w3 h28 ; connect output;
sn w0 0 ; if w0 = 0 then
jl. a31. ; goto set mode;
a30: al. w0 b25. ; call alarm:
a38: am. (g0.) ; enter fp:
jl w3 h31-2 ; writetext(<:***binout output impossible:>);
jl. d7. ; goto exitfp;
b25: <:<10>***binout output impossible<0>:>;
a31: bz. w0 g1.+h1+1 ; set mode:
se w0 12 ; if process kind = <punch> then
jl. a39. ; begin
al w1 4 ; mode := <no parity>;
hs. w1 g8.+7 ; goto on
jl. a40. ; end;
a39: se w0 18 ; if process kind <> <mag. tape>
sn w0 4 ; and process kind <> <back. store>
jl. a40. ; then
jl. a30. ; goto call alarm;
a40: rl. w3 f10. ;
al w2 x3-8 ; w2:=name addr
am. (g0.) ;
al w1 h54 ; w1:=lookup area
jl. w3 a41. ; prepare output
al. w1 d6. ; on: w1 := first free core;
al. w3 d10. ; w3 := addr(<:catalog:>);
jd 1<11+42 ; lookup entry;
se w0 0 ; if result <> 0 then
jl. d0. ; alarm(<:catalog:>);
rl w0 x1 ; catalog size := tail(0);
rs. w0 f2. ;
al. w3 d6.+512 ; first core cat buf := first free core;
al w0 x3+510 ; last core cat buf :=
ds. w0 f1. ; first core cat buf + 510;
jl. d5. ; goto scan parameter list;
a41:
; procedure prepare entry for textoutput
; w0 not used
; w1 lookup area
; w2 name addr, entry must be present
; w3 return addr
b. a2 w.
ds. w1 a1. ; save w0.w1
ds. w3 a2. ; save w2.w3
al w3 x2 ; w3:=name addr
jd 1<11+42 ; lookup
bz w2 x1+16 ;
sh w2 32 ; if contents=4 or
sn w2 4 ; contents>=32
jl. 4 ; then
jl. a0. ; file:=block:=0;
rs w0 x1+12 ;
rs w0 x1+14 ;
a0: rs w0 x1+16 ; contents.entry:=0;
rs w0 x1+18 ; loadlength:=0;
dl w1 110 ;
ld w1 5 ; shortclock;
rl. w1 a1. ;
rs w0 x1+10 ;
jd 1<11+44 ; changeentry;
dl. w1 a1. ; restore w0,w1
dl. w3 a2. ; restore w2,w3
jl x3 ; return
0 ; saved w0
a1: 0 ; saved w1
0 ; saved w2
a2: 0 ; saved w3
e.
i5 = k - d11 ; length of binout
0 ; zero, to terminate program segment;
i. ; id list
e. ; end segment: binout;
m. rc 1976.05.21 fp utility, binout
g2=k-h55 ; length
g0:g1: (:g2+511:)>9 ; segm
0, r.4
s2 ; date
0,0 ; file block
2<12+4 ; contents, entry
g2 ; length
d.
p.<:insertproc:>
l.
e. ; end block: fp names
▶EOF◀