|
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: 39168 (0x9900)
Types: TextFile
Names: »uti17«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦f8e4b63af⟧ »trcfput«
└─⟦this⟧
; rc 1977.02.04 fp utility, binin, page ...1...
; the program is translated like
; (binin=slang text entry.no
; binin)
b. g4 w. ; for insertproc
d.
p.<:fpnames:>
l.
; b. h99 ; begin block: fp names; this block must always
; w. ; be loaded from some where;
s. a32, b26, c16, d26, f16, g9, i9 ;
w. ;
k = h55
d22: i4 ; length of binin
0 ; empty;
jl. d20. ; entry binin: goto initialize binin;
; 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 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:
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 22.05.72 fp utility, binin, page 2
; 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 ; 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 19.02.1973 fp utility, binin, page 3
; procedure inbyte:
; call : jl. w3 c0.
; exit 0 : end segment (sumerror) , w0, w1 unchanged
; exit 2 : end segment (ok) , - - -
; exit 4 : normal, w2 = byte , - - -
b. a11, b10 ; begin block: inbyte, exit fp
w. ;
0 ; saved w0
b0: 0 ; saved w1
b1: 0 ; saved return (inbyte)
b2: 0 ; saved return ( next char)
b3: 2.111111 ; mask
b4:f6:-1 ; sum
b5: <: sumerror<0>:>;
b6: 2.111110100011110010111100 ; mask for hard errors
b7: 1<16 ; bit 7, i.e. file mark
b8: 0 ; char1
d24: -1 ; char count
b10: 1<22 ; parity bit
h. ; parity table:
b9: 0 ; 0000
1 ; 0001
1 ; 0010
0 ; 0011
1 ; 0100
0 ; 0101
0 ; 0110
1 ; 0111
1 ; 1000
0 ; 1001
0 ; 1010
1 ; 1011
0 ; 1100
1 ; 1101
1 ; 1110
0 ; 1111
w. ; end parity table
\f
;rc 19.02.1973 fp utility, binin, page 3a
c0: ds. w1 b0. ; inbyte:
rs. w3 b1. ; save(w0,w1,w3);
jl. w3 a1. ; exit := saved return;
al w0 x2 ; next char;
rs. w0 b8. ; char1 := byte;
jl. w3 a1. ; next char;
ls w0 6 ; byte :=
ba w2 1 ; byte + char1 shift 6;
rl. w3 b1. ;
a0: dl. w1 b0. ; finis: restore(w0,w1);
jl x3+4 ; return(exit+6);
a11: rl. w3 b10. ; parity error:
jl. a4. ; status:=parity;goto giveup;
a1: rs. w3 b2. ; next char: save return;
d4: al. w1 g2. ; repeat: w1 := addr(input zone descr);
am. (g0.) ; enter fp:
jl w3 h25 ; byte := inchar;
sn w2 0 ; if char = 0
jl. a5. ; then terminate;
al w3 15 ; check parity:
la w3 4 ;
bl. w1 x3+b9. ; w1:=parity(rightmost 4 bits)
ld w3 -4 ; +
ba. w1 x2+b9. ; parity(leftmost 4 bits);
ld w3 4 ; if parity
se w1 1 ; not odd
jl. a11. ; then goto parity error;
sz w2 1<6 ; if char = sum character then
jl. a2. ; goto check sum;
rl. w0 b8. ; restore(char1);
la. w2 b3. ; byte := bits(6,11,byte);
rx. w2 b4. ; swap(byte,sum);
wa. w2 b4. ; byte := byte + sum;
rx. w2 b4. ; swap(byte,sum);
jl. (b2.) ; return;
\f
; rc 22.05.1972 fp utility, binin, page 4
a2: ws. w2 b4. ; check sum:
la. w2 b3. ; byte := bits(6,11,byte-sum);
sn w2 0 ; if sum = 0 then
jl. a3. ; goto sum ok;
al. w2 b5. ; sum error:
jl. w3 c3. ; inmessage(<:sumerror:>);
am -2 ; exit := exit - 2;
a3: al w3 -2 ; sum ok:
wa. w3 b1. ; exit := exit - 2;
al w2 0 ;
rs. w2 b4. ; sum := 0;
jl. a0. ; goto finis;
d0: sz w3 1 ; give up action on input file:
jl. a4. ; if hard error then give up;
so. w3 (b7.) ; if file mark then
jl. a6. ; begin
bz w0 x2+6 ; if operation = input
sn w0 3 ; then goto terminate
jl. a5. ; else goto return to fp
jl. a7. ; end;
a6: am (0) ; end document:
rl w0 4 ;
sn w0 0 ; if no of chars = 0
jl. a5. ; then terminate;
a7: am. (g0.) ; return to fp:
jl h36 ; goto after check;
a5: jl. w3 c14. ; terminate: terminate input;
jl. d5. ; goto more input;
a4: rs. w3 f0. ; give up:
al. w0 g2.+h1+2 ;
rs. w0 f9. ; save doc name addr;
; fp result := logical status;
d1: al w2 10 ; exit fp:
am. (g0.) ; w2 := 10;
jl w3 h26-2 ; writechar(new line);
rl. w2 f0. ; w2 := fp result;
rl. w1 f9. ; w1 := addr(doc name);
am. (g0.) ;
jl h7 ; goto fp end program;
i. ; id list
e. ; end block: inbyte, exit fp
c6: am. (g0.) ; writetext:
jl h31-2 ; goto fp outtext;
c7: am. (g0.) ; writeinteger:
jl h32-2 ; goto fp outinteger;
c14: al. w1 g2. ; terminate input:
am. (g0.) ; w1 := addr(input zone descr);
jl h79 ; goto terminate zone;
g0: 0 ; fp base
f0: 0 ; fp result
f9: 0 ; addr(doc name)
\f
; rc 14.5.1970 fp utility, binin, page 5
; procedure outbyte:
; call: w2 := byte; jl. w3 c1.
; exit: w0, w1 unchanged
b. a1, b0 ; begin block: outbyte
w. ;
0 ; saved return(outbyte)
b0: 0 ; saved w0
i0 = k + 1 ; check
c1: se w3 x3 ; ch ; outbyte:
jl x3 ; if check then return;
ds. w0 b0. ; save(w0,return);
a0: rl. w0 g1.+h3 ; test record base:
sl. w0 (g1.+h3+2) ; if record base >= last byte then
jl. a1. ; goto test block;
ba. w0 1 ;
rs. w0 g1.+h3 ; record base := record base + 1;
hs. w2 (g1.+h3) ; byte(record base) := w2;
al w0 0 ;
hs. w0 i1. ; empty := false;
rl. w3 f10. ;
al w3 x3+1 ;
rs. w3 f10. ; length := length + 1;
dl. w0 b0. ; restore(w0,w1);
jl x3 ; return;
a1: bz. w0 g1.+h1+1 ; test block:
al. w3 a0. ; set return(test record base);
se w0 18 ; if process kind <> 18 then
jl. c2. ; goto output block;
jl. w2 c9. ; inalarm(<:core size:>);
<: core size<0>:> ;
i. ; id list
e. ; end block outbyte
d26: rs. w3 f0. ; give up output:
al. w1 g1.+h1+2 ; save fp result;
rs. w1 f9. ; save addr(doc name);
jl. d1. ; goto exit fp;
\f
; rc 18.08.1972 fp utility, binin, page 6
; procedure output block:
; call: jl. w3 c2.
; exit: w0, w1, w2 unchanged
b. a1, b3 ; begin block: output block, terminate output
w. ;
0 ; saved w0
b0: 0 ; saved w1
b1: 0 ; saved return
c2: ds. w1 b0. ; output block:
bz. w0 i0. ; save(w0,w1);
i1 = k + 1 ; empty ;
sn w3 x3+1;empty;
se w0 0 ; if mpty or check then
jl. a0. ; return;
rs. w3 b1. ; save return;
al w0 -2 ; remove last bit of record base;
la. w0 g1.+h3 ;
bz. w1 g1.+h1+1 ;
se w1 4 ; if process kind <> 4 then
rs. w0 g8.+10 ; last of transfer := record base ;
al. w1 g1. ; w1 := addr(output zone descr);
am. (g0.) ; enter fp:
jl w3 h23 ; output block;
al w0 1 ;
hs. w0 i1. ; empty := true;
rl. w3 b1. ; restore(return);
a0: dl. w1 b0. ; restore(w0,w1);
jl x3 ; return;
\f
; rc 18.08.1972 fp utility, binin, page 6a
c10: bz. w0 i0. ; terminate output:
se w0 0 ; if check then
jl x3 ; return;
rs. w3 b2. ; save(return);
jl. w3 c2. ;
bz. w0 g1.+h1+1 ; output block;
i5 = k + 1 ; no output ;
se w3 x3 ; if -, no output
se w0 18 ; and process kind = 18 then
jl. a1. ; begin
al w0 0 ;
hs. w0 i5. ; filemark:= no output := true;
a1: al. w1 g1. ; end;
am. (g0.) ; w1 := addr(output zone descriptor);
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 minumum, 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);
z. ;
jl. (b2.) ; return;
b2: 0 ; saved return
b3: 10<12 ; message (write file mark)
i. ; id list
e. ; end block outblock, terminate output
\f
; rc 06.10.1972 fp utility, binin, page 7
b. a7, b4 ; begin block: initialize input, initialize output
w. ;
a7: 1<23+4<12+10 ; mode.kind no.parity.reader
0 ; saved w0
b0: 0 ; saved w1
0 ; saved w2
b1: 0 ; saved w3
b2: <: input impossible<0>:> ;
b3: <: output impossible<0>:>;
b4: 0 , r.10 ; area for lookup input file descriptor
f2: 0 , r.5 ; name of input file descriptor (+ 0)
f3: 0, r.5 ; name of output file descriptor(+ 0)
c12: ds. w1 b0. ; initialize input:
ds. w3 b1. ; save(all registers);
al. w1 b4. ; lookup input file:
al. w3 f2. ;
jd 1<11+42 ;
se w0 0 ; if not found then
jl. a5. ; goto check result;
rl w0 x1 ; if mode.kind >= 0
sl w0 0 ; then goto connect;
jl. a6. ;
bz w3 1 ; w3:=kind;
rl. w0 a7. ; if kind = 10
sn w3 10 ; then (reader)
rs w0 x1 ; mode.kind := 1<23+4<12+10;
am b4-f2 ; modify addr to file descr;
a6: al. w2 f2. ; connect:
al. w1 g2. ; w1:=addr(zone);
am. (g0.) ; enter fp:
jl w3 h27 ; connect input;
a5: al. w3 d2. ; check result: set return(scan parameter list);
al. w2 b2. ; w2 := addr(<:input impossible:>);
se w0 0 ; if conect error then
jl. c3. ; goto inmessage;
bz. w0 g2.+h1+1 ;
sn w0 10 ; if process kind = <reader>
jl. a0. ; then goto exit;
a4: se w0 18 ; if process kind = <magnetic tape>
sn w0 4 ; or process kind = <area> then
jl. a0. ; goto exit
jl. c3. ; goto inmessage;
a0: dl. w1 b0. ; exit:
dl. w3 b1. ; restore(all registers);
jl x3 ; return;
\f
; rc 29.07.1971 fp utility, binin, page 8
c11: bz. w0 i0. ; initialize output:
se w0 0 ; if check then
jl x3 ; return;
ds. w1 b0. ; save(all registers);
ds. w3 b1. ;
al. w1 g1. ; w1 := addr(output zone descr);
al. w2 f3. ; w2 := addr(name of output file descr);
al w0 1<1+1 ; if new area then connect one segment on disc;
am. (g0.) ; enter fp:
jl w3 h28 ; connect output;
sn w0 0 ; if connect error then
jl. a1. ; begin
a2: al. w2 b3. ; connect alarm:
jl. w3 c4. ; outmessage(<:output impossible:>);
al w0 1 ;
hs. w0 i0. ; check := true;
rl. w2 b1.-2 ; goto exit;
jl. a0. ; end;
a1: bz. w0 g1.+h1+1 ; test content:
se w0 4 ; if process kind = 4
sn w0 18 ; or process kind = 18 then
jl. a3. ; goto update;
jl. a2. ; goto connect alarm;
a3: al w0 0 ; update:
al w3 0 ; if content(file descriptor) = 4 then
bz w1 x2+16 ; begin
sn w1 4 ; segment count := 0; block := 0;
ds. w0 g1.+h1+16 ; end;
rl. w0 g1.+h1+16 ;
rs. w0 f15. ; bssegment := segment count;
al w0 0 ;
hs. w0 i8. ; rel := 0;
rs. w0 f10. ; length := 0;
rs. w0 f11. ; total := 0;
bz. w0 g1.+h1+1 ;
se w0 18 ; if process kind <> 18 then
jl. a0. ; goto exit;
dl. w1 g1.+h0+2 ; first shared := base of buffer;
ds. w1 g8.+4 ; last shared := last of buffer;
bs. w0 1 ;
al w1 x1+1 ; record base := first shared - 1;
ds. w1 g1.+h3+2 ; last byte := last shared + 1;
jl. a0. ; goto exit;
i. ; id list
e. ; end block: initialize input, initialize output
\f
; rc 4.7.1969 fp utility, binin, page 8a
b. a0, b3 ; begin block: alarm, message:
w. ;
b0: 0 ; saved w2
b1: 0 ; saved w3
c9: al w3 0 ; inalarm: message call := false;
c3: al. w1 f2. ; inmessage:
jl. a0. ; goto message1:
c5: al w3 0 ; outalarm: message call := false;
c4: al. w1 f3. ; outmessage:
a0: ds. w3 b1. ; message1:
al w2 x1 ; save(w2,w3);
jl. w3 c8. ; message(name of i/o);
rl. w0 b0. ; w0 := text address;
jl. w3 c6. ; writetext;
rl. w3 b1. ; restore(w3);
se w3 0 ; if message call then
jl x3 ; return;
d3: jl. w3 c10. ; terminate exit: terminate output;
jl. w3 c14. ; terminate input;
jl. d1. ; goto exit fp;
c8: rs. w3 b2. ; message:
al. w0 b3. ; save return;
jl. w3 c6. ; writetext(<:***binin:>);
al w0 x2 ;
jl. w3 c6. ; writetext(text parameter);
al w3 1 ;
rs. w3 f0. ; fp result := 1;
jl. (b2.) ; return;
b2: 0 ; saved return (message)
b3: <:<10>***binin <0>:>
i. ; id list
e. ; end block: alarm, message
\f
; rc 2.8.1969 fp utility, binin, page 9
f5: 1<22 ; segments
f8: 0 ; first segment
b22: 0 ; segment
b0: <: in load <0>:> ;
b21: 1<22 ; infinite
d17: dl w1 x2+6 ; load:
ds. w1 f3.+2 ; move name part of load
dl w1 x2+10 ; command to name part of
ds. w1 f3.+6 ; output file descriptor;
rl w0 x2+12 ;
rs. w0 f5. ; segments := load segments;
jl. w3 c11. ; initialize output;
d7: al w1 0 ; load program: segment := 0;
a0: bz. w0 i7. ; next segment:
sl. w1 (f8.) ; if segment >= first segment
sn w0 0 ; and s then
jl. a29. ; begin
al w2 0 ; w2 := 0;
jl. w3 c1. ; outbyte;
jl. w3 c1. ; outbyte;
; end;
a29: al w2 x1 ;
ws. w2 f8. ; test := segment - first segment;
sl. w2 (f5.) ; if test >= segments then
jl. a4. ; goto finis load;
a1: jl. w3 c0. ; next byte: inbyte;
jl. a2. ; exit 0 : goto sumerror;
jl. a3. ; exit 2 : goto end segment;
sl. w1 (f8.) ; exit 4 : if segment >= first segment
jl. w3 c1. ; then outbyte;
jl. a1. ; goto next byte;
a2: rs. w1 b22. ; sumerror:
al. w0 b0. ; save segment;
jl. w3 c6. ; writetext(<:in load:>);
al. w0 f3. ;
jl. w3 c6. ; writetext(name of output file);
rl. w1 b22. ; restore segment;
a3: al w1 x1+1 ; end segment:
sh. w1 (f8.) ; segment := segment + 1;
jl. a0. ; if segment <= first segment then
; goto next segment;
i7 = k + 1 ; s ;
sn w3 x3 ; if -,s
jl. a30. ; goto test block;
rs. w1 b22. ; save segment;
rl. w0 f15. ;
se. w0 (g1.+h1+16); if bssegment <> segment count then
jl. a25. ; goto update segment;
\f
; rc 2.8.1969 fp utility, binin, page 9a
a28: rl. w0 f10. ; update buffer:
bz. w3 i8. ;
am. (g1.+h0) ;
rs w0 x3 ; word(first of output + rel) := length;
jl. a26. ; goto clear;
a25: bz. w0 g1.+h1+1 ; update segment:
se w0 4 ; if process kind <> 4 then
jl. a28. ; goto update buffer;
jl. w3 c16. ;
rl. w0 f10. ; input bssegment;
am. (f13.) ;
i8 = k + 1 ; rel ;
rs w0 0 ; word(bssegment base + rel) := length;
jl. w3 c15. ; output bssegment;
a26: al w2 0 ; clear:
rl. w3 f11. ;
wa. w3 f10. ;
rs. w3 f11. ; total := total + length;
ld w0 -9 ;
rs. w3 f15. ; bssegment := total//512;
al w3 0 ;
ld w0 9 ;
hs. w3 i8. ; rel := total mod 512;
al w2 0 ;
rs. w2 f10. ; length := 0;
rl. w1 b22. ; restore segment;
a30: bz. w0 g1.+h1+1 ; test block:
sn w0 18 ; if process kind = 18 then
jl. w3 c2. ; output block;
al w2 0 ;
sn w0 18 ; if process kind = 18 then
hs. w2 i8. ; rel := 0;
al w3 1 ;
hs. w3 i5. ; no output := false;
jl. a0. ; goto next segment;
i6 = k + 1 ; other output
a4: se w3 x3 ; finis load: if -, other output then
jl. a22. ; begin
jl. w3 c10. ; terminate output;
jl. d6. ; goto next command;
; end;
a22: ; prepare next source:
al. w3 d7. ; w3 := <load program>;
jl. d25. ; goto store return;
\f
; rc 2.8.1969 fp utility, binin, page 9b
b. a1, b0 ; segment transfer
w. ;
f10: 0 ; length;
f11: 0 ; total;
f12: 0 ; message: operation;
f13: 0 ; first core;
f14: 0 ; last core;
f15: 0 ; bssegment;
f16: 0,r.8; answer;
c15: am 2 ; output bssegment:
c16: al w0 3 ; input bssegment:
hs. w0 f12. ; set operation;
rs. w3 b0. ; save return;
a0: al. w1 f12. ; repeat:
al. w3 g1.+h1+2 ; w1 := message address;
jd 1<11+16 ; w3 := addr(doc name); send message;
al. w1 f16. ; w1 := answer address;
jd 1<11+18 ; wait answer;
rl. w3 f16. ;
sn w3 0 ; if status word <> 0
se w0 1 ; or result <> 1 then
jl. a1. ; goto error;
rl. w3 f16.+2 ;
sn w3 0 ; if bytes transferred = 0 then
jl. a0. ; goto repeat;
jl. (b0.) ; return;
a1: al w3 1 ; error:
ls w3 (0) ; w3 := 1 shift result;
sn w0 1 ; if normal answer then
wa. w3 f16. ; w3 := w3 + status word;
jl. d26. ; goto give up output;
b0: 0 ; saved return ;
i. ; id list
e. ; end block segment transfer
\f
; rc 19.02.1973 fp utility, binin, page 10
d9: jd 1<11+48 ; create: remove entry;
jd 1<11+40 ; create entry;
jl. a10. ; goto check result;
d10: jd 1<11+48 ; remove: remove entry;
jl. a10. ; goto check result;
d11: jd 1<11+44 ; change: change entry;
jl. a10. ; goto check result;
d12: jd 1<11+46 ; rename: rename entry;
jl. a10. ; goto check result;
d13: rl w1 x1 ; permanent: w1:=cat key;
jd 1<11+50 ; permanent entry;
se w0 0 ; if result <> 0
jl. a10. ; then goto check result;
se w1 3 ; if cat key <> 3 then
jl. d6. ; goto next command;
am. (g0.) ; set entry base:
dl w1 h58 ;
jd 1<11+74 ; set entry base(name,user base);
jl. d6. ; goto next command;
a10: se w0 0 ; check result: if result <> 0
jl. w1 d18. ; then command alarm;
d6: rl. w2 g3. ; next command:
sl. w2 (g9.) ; if current command >= last command
jl. d8. ; then goto load command segment;
dl w1 x2+2 ; index := first of command table;
al. w3 g4. ; search:
a8: al w3 x3+6 ; index := index + 6;
sl. w3 g5. ; if index >= top of command table
jl. a9. ; then goto syntax error;
sn w0 (x3-6) ; if command part(current command)
se w1 (x3-4) ; <> name part (command table(index-6))
jl. a8. ; then goto search;
\f
; rc 1977.02.04 fp utility, binin, page ...11...
a20: ba w2 x3-1 ; ok: current command := current command +
rx. w2 g3. ; size part(command table(index-1));
am 6 ;
se. w3 g4. ; if create
jl. a11. ;
rl. w1 i9. ; and
sn w1 0 ;
jl. a11. ; message.yes
ds. w3 b5. ; then
al w2 10 ; begin
jl. w3 h26.-2 ; writenl;
dl. w3 b5. ;
al w0 x2+4 ;
jl. w3 h31.-2 ; write(out,<:entryname:>);
dl. w3 b5. ; end;
a11:
bz. w0 i0. ;
sn w0 0 ; if -, check then
jl. a12. ; goto execute;
dl w1 x2+2 ;
sn. w0 (d15.) ;
se. w1 (d16.) ; if command = <:load:> then
jl. d6. ; goto next command;
a12: bl w0 x3-2 ; execute:
hs. w0 i2. ; action := action part of
al w3 x2+4 ; command table(index-2);
al w1 x2+12 ; w3 := addr(name part(table));
i2 = k + 1 ; action ; w1 := addr(tail part(table));
d14: jl. 0 ; call action;
a9: se. w0 (d23.) ; syntax error:
jl. a19. ; if first word command = <:end:> then
al w2 x2+2 ; begin
sn. w2 (g9.) ; if current command = last command - 2
jl. d3. ; then goto terminate exit
a19: ds. w1 f3.+2 ; end;
al. w2 b4. ;
jl. c5. ; outalarm(<:syntax error:>);
b1: <: in command segment<0>:> ;
b2: <: sizeerror<0>:> ;
b4: <: syntaxerror<0>:> ;
d8: al. w1 d20. ; load command segment:
rs. w1 g3. ; current command := current byte :=
; first free core;
a5: sl. w1 g7. ; next byte:
jl. a7. ; if current byte >= first free core + 512
; then goto size error;
jl. w3 c0. ; inbyte;
jl. a6. ; exit 0 : goto command sumerror;
jl. d6. ; exit 2 : goto next command;
hs w2 x1 ; exit 4 : byte(current byte) := byte;
al w1 x1+1 ; current byte :=
rs. w1 g9. ; last command := current byte + 1;
jl. a5. ; goto next byte;
a6: al. w0 b1. ; command sumerror:
jl. w3 c6. ; writetext(<:in command segment:>);
jl. d6. ; goto next command;
a7: al. w2 b2. ; sizeerror:
jl. c9. ; inalarm(<:sizeerror:>);
g3: 0 ; current command
g9: 0 ; last of command
\f
; rc 25.6.1969 fp utility, binin, page 12
; command table:
; command action size
g4: <:create:>, h. d9 -d14, 32, w.
d21: <:remove:>, h. d10-d14, 12, w.
<:change:>, h. d11-d14, 32, w.
<:rename:>, h. d12-d14, 20, w.
<:perman:>, h. d13-d14, 14, w.
<:oldcat:>, h. d6 -d14, 4 , w.
<:newcat:>, h. d6 -d14, 4 , w.
d15: <:load:> , h. d17-d14, 14, w.
d23: <:end:>,0 , h. d3 -d14, 4 , w.
g5 = k, d16 = d15 + 2, b3 = d21 + 2
f7: 0 ; saved w0
0 ; saved w1
b5: 0 ; saved w2
<:<127><127><32>:> ; b26 - 4
0 ;
b6: 0 ,0 ; saved command
b7: <: result <0>:> ;
d18: rs. w0 f7. ; command alarm: save result;
d19: ds. w2 b5. ; command alarm1: save(w1,w2);
dl w1 x2+2 ;
ds. w1 b6. ; save command;
al. w2 b6.-4 ;
jl. w3 c3. ; inmessage(name of command);
al w2 32 ;
am. (g0.) ;
jl w3 h26-2 ; writechar(space);
rl. w2 b5. ; restore w2;
al w0 x2+4 ;
jl. w3 c6. ; writetext(catalog name);
al. w0 b7. ;
jl. w3 c6. ; writetext(<:result:>);
rl. w0 f7. ; w0 := saved result;
jl. w3 c7. ; writeinteger;
32<12 + 1 ;
dl. w2 b5. ; restore(w1,w2);
jl x1 ; return;
f4: 0 ; current parameter pointer
0 ; saved w0
b8: 0 ; saved w1
0 ; saved w2
b9: 0 ; saved w3
b10: 0 ; return after scan parameter list
\f
; rc 1977.02.04 fp utility, binin, page ...13...
d5: ds. w1 b8. ; more input:
ds. w3 b9. ; save all registers;
al. w3 d4. ; w3 := <repeat inbyte>;
d25: rs. w3 b10. ; store return;
rl. w3 b21. ;
rs. w3 f5. ; segments := infinite;
al w3 0 ;
rs. w3 f8. ; first segment := 0;
d2: rl. w2 f4. ; scan parameter list:
ba w2 x2+1 ; next param;
rs. w2 f4. ;
al w0 0 ;
hs. w0 i0. ; check := false;
hs. w0 i7. ; s := false;
rl w0 x2 ; if param = (space,name) then
se. w0 (b11.) ; goto not name;
jl. a32. ;
rl w0 x2+2 ;
se. w0 (b24.) ; if name<> <:mes:>
jl. a18. ; then goto next tape;
rl w0 x2+10 ;
se. w0 (b12.) ; if nexttape<>pointname
jl. a18. ; then goto next tape;
rl w0 x2+12 ; if nextname
sn. w0 (b25.) ; = <:no:>
jl. a31. ; then goto messageno;
se. w0 (b26.) ; if nextname <> <:yes:>
jl. a18. ; then goto nexttape;
am 1 ; messageyes:
a31: al w0 0 ; messageno:
rs. w0 i9. ; save message;
rl. w2 f4. ;
al w2 x2+10 ; ready for next param
rs. w2 f4. ;
jl. d2. ; goto scan param list;
b24: <:lis:> ;
b25: <:no:> ;
b26: <:yes:> ;
i9: 0 ; saved message
a32: bl w0 x2 ; not name:
sl w0 4 ; if parameter list exhausted then
jl. a13. ; begin
rl. w0 f6. ;
sn w0 0 ; if sum = 0 then
jl. d3. ; goto terminate exit;
rl. w0 f2. ;
al. w2 b18. ; w2 := addr(<:exhausted:>);
sn w0 0 ; if first word(input name) = 0 then
al. w2 b19. ; w2 := addr(<:input name missing:>);
jl. c9. ; goto inalarm;
b18: <: exhausted<0>:> ;
b19: <:input name missing<0>:>;
i3 = k + 1 ; alarm state; param alarm:
a13: se w3 x3 ; if alarm state then
jl. a14. ; goto list parameter;
al w0 1 ;
hs. w0 i3. ; alarm state := true;
al. w2 b13. ;
jl. w3 c8. ; message(<:param:>);
a14: bz. w1 (f4.) ; list parameter:
al. w0 x1+b14. ; writetext(string
jl. w3 c6. ; delimiter table(delimiter));
al. w3 d2. ; set return(scan parameter list);
rl. w2 f4. ;
al w0 x2+2 ; w0 := address(parameter value);
bz w1 x2+1 ;
sn w1 10 ; if parameter is name then
jl. c6. ; goto writetext;
rl w0 x2+2 ;
jl. w3 c7. ;
32<12 + 1 ; writeinteger(parameter value);
jl. d2. ; goto scan parameter list;
\f
; rc 2.8.1969 fp utility, binin, page 14
b13: <:param <0>:> ;
b14 = k - 4 ; delimiter table:
<: :>,<:=:>,<:.:> ;
b11: 4<12 + 10 ; (space,name);
b12: 8<12 + 10 ; (point,name);
b20: 8<12 + 4 ; (point,integer);
b15: <:c:> ;
b23: <:s:> ;
a18: al w0 0 ; next tape:
rs. w0 f6. ; sum := 0;
dl w1 x2+4 ;
ds. w1 f2.+2 ; move parameter to name
dl w1 x2+8 ; input file descriptor;
ds. w1 f2.+6 ;
al w3 x2 ;
a24: ba w3 x3+1 ; expect integer: next param;
dl w1 x3+2 ;
se. w0 (b12.) ; if item <> (point,name) then
jl. a15. ; goto prepare input;
se. w1 (b23.) ; if param <> <:s:> then
jl. a27. ; goto check;
al w0 1 ;
hs. w0 i7. ; s := true;
rs. w3 f4. ; save parameter pointer;
jl. a24. ; goto expect integer;
a27: se. w1 (b15.) ; if param <> <:c:> then
jl. a15. ; goto prepare input;
al w0 1 ;
hs. w0 i0. ; check := true;
rs. w3 f4. ; save parameter pointer;
jl. a24. ; goto expect integer;
a15: se. w0 (b20.) ; prepare input:
jl. a23. ; if item <> (point,integer) then
rs. w1 f5. ; goto return input;
rs. w3 f4. ; save parameter pointer;
ba w3 x3+1 ; segments := param;
dl w1 x3+2 ; next param;
se. w0 (b20.) ; if item <> (point integer) then
jl. a23. ; goto return input;
rs. w3 f4. ; save parameter pointer;
rs. w1 f8. ; first segment := param;
a23: al w0 0 ; return input:
hs. w0 i3. ; alarm state := false;
jl. w3 c12. ; initialize input;
dl. w1 b8. ;
dl. w3 b9. ; restore all registers;
jl. (b10.) ; return;
g7 = k + 1024 ; first free core: base command segment:
d20: rs. w1 g0. ; initialize binin:
rs. w3 f4. ; save fp base;
al. w1 d6. ; save parameter pointer;
bz w0 x3 ; exit := next command;
sn w0 6 ; if there is left hand side then
al. w1 d7. ; exit := load program;
rs. w1 b10. ; set return(exit);
\f
; rc 76.02.02 fp utility, binin, page ...15...
se w0 6 ; if there is left hand side then
jl. a16. ; begin
al w0 1 ;
hs. w0 i6. ; finis := true;
dl w1 x3-6 ; move left hand side to
ds. w1 f3.+2 ; name of output file descr;
dl w1 x3-2 ;
ds. w1 f3.+6 ; end;
a16: al. w3 g7.+512 ; initialize output zone:
al w0 x2-2 ; base of buffer := first free core + 1536;
ds. w0 g1.+h0+2 ; last of buffer := top command stack - 2;
ds. w0 g8.+4 ; first shared := base buffer;
sl w0 x3+512 ; if last of buffer < base buffer + 512 then
jl. a17. ; begin
al. w2 b16. ; message(<:core size:>);
jl. w3 c8. ; goto exit fp;
jl. d1. ; end;
b16: <:core size<0>:> ;
a17: al. w0 g8. ; last shared := last of buffer;
rs. w0 g1.+h0+4 ; first share := last share :=
rs. w0 g1.+h0+6 ; used share :=
rs. w0 g1.+h0+8 ; share descriptor address;
bz. w0 i6. ;
se w0 0 ; if other output then
jl. w3 c11. ; initialize output;
al. w0 d26. ;
rs. w0 g1.+h2+2 ; set give up action;
al. w3 g7. ; initialize input zone:
al w0 x3+510 ; base of buffer := first free core + 512;
ds. w0 g2.+h0+2 ; last of buffer := base buffer + 510;
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 :=
rs. w0 g2.+h0+8 ; share descriptor address;
al. w0 d0. ;
rs. w0 g2.+h2+2 ; set give up action;
al. w3 g7.-512 ;
al w0 x3+510 ; set first and last core in bsmessage;
ds. w0 f14. ;
jl. d2. ; goto scan parameter list;
i4 = k - d22 ; length of binin
0 ; zero, to terminate program segment
i. ; id list
e. ; end segment binin
m. rc 1977.02.04 fp utility, binin
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
\f
▶EOF◀