|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 52224 (0xcc00)
Types: TextFile
Names: »uti19«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦f8e4b63af⟧ »trcfput«
└─⟦this⟧
; the program is translated like
; (print=slang text entry.no
; print)
;
b. g1, m3 w.
d.
p.<:fpnames:>
l.
; rc 1977.10.12 fp utility, print, page ...1...
; b. h99 ; begin block: fpnames; this block head must
; w. ; always be loaded from somewhere;
s. a70, b40, c40, d20, e20, f40, g15, i21 ; begin segment: print;
w. ;
k = h55 ;
d0: d1 ; length of print (in bytes)
0 ; saved out call
jl. e2. ; entry print: goto initialize print;
f0: 0 ; segment
f1: 0 ; block length
f2: 0 ; from word
f3: 0 ; to word
f4: 0 ; from block
f5: 0 ; to block
f6: 0 ; number
f7: 0 ; block
f8: 1<22 ; last byte
f9: 0 ; first number
f10: 0 ; current word
f11: 1<22 ; infinite
f12: 0 ; total
f13: 0 ; saved pointer (area description)
f14: 0 ; base bit group table
f15: 0 ; fp base
f16: 0 ; saved command pointer
f17: 0, r.5 ; name and name table address for area description
f18: 3<12 ; message: operation = input
f19: 0 ; first core
f20: 0 ; last core
f21: -1 ; segment count
f22: 0, r.8 ; answer
f23: 0 ; fp result
f24: 0 ; top command
f25: 0 ; bit group pointer
f26: 0 ; bytes
f27: 0 ; current core relative
f28: 0 ; secondary output zone;
f29: 0 ; final addr
; output procedures. if they are called from page 2-6, the
; output will appear on secondary out, otherwise on current out
c2: am -22 ; writecr:
c3: al w2 32 ; writesp:
c9:c6:am h26-h31 ; writechar:
c5: am h31-h32 ; writetext:
c4: al. w1 h32. ; writeinteger:
rs. w1 d0.+2 ;
rl. w1 f28. ; zone := secondary out;
i18 = k + 1 ; called from page 2-6
sl. w3 i15 ; if called from page 2-6 then
al. w1 h21. ; then zone := current out;
jl. (d0.+2) ; goto selected output proc;
\f
; rc 8.7.1970 fp utility, print, page 2
a0: jl. w3 c0. ; next word:
rl. w3 f26. ; get word;
al w3 x3-2 ;
rs. w3 f26. ; bytes := bytes - 2;
sl w3 0 ; if bytes >= 0 then
jl. a7. ; goto print it;
e0: rl. w3 f7. ; change block:
sh. w3 (f5.) ; if block > to block then
jl. a57. ;
jl. e1. ; goto next field;
a57: rl. w0 f11. ; blocklength := infinite;
i4 = k + 1 ; blocked ;
sn w3 x3 ; if blocked then
jl. a1. ; begin
rl. w0 f12. ; w0 := total;
jl. w2 c25. ; set position;
jl. w3 c0. ; get word;
rl. w0 f10. ; blocklength := current word;
i1 = k + 1 ; content ;
am 0 ;
se w3 x3-6 ; if content <> 6 then
al w0 512 ; blocklength := 512;
a1: rs. w0 f1. ; end;
rl. w3 f2. ; first := from word;
sh. w3 (f1.) ; if first > blocklength
sh w3 -1 ; or first < 0 then
rl. w3 f1. ; first := blocklength;
rl. w1 f3. ;
al w1 x1+2 ;
ws. w1 f2. ;
rs. w1 f26. ; bytes := to word - from word + 2;
wa w1 6 ; last := first + bytes;
sh. w1 (f1.) ; if last <= blocklength then
jl. a5. ; goto ok;
rx. w1 f26. ;
ws. w1 f26. ; bytes := bytes - last +
wa. w1 f1. ; blocklength ;
rs. w1 f26. ;
a5: rl. w0 f12. ; ok:
wa w0 6 ; no := total + first;
jl. w2 c25. ; set position;
rl. w0 f12. ;
wa. w0 f1. ;
rs. w0 f12. ; total := total + blocklength;
am. (f7.) ;
al w2 1 ;
sh. w2 (f4.) ; if block < from block then
rl. w3 f1. ; first := block length;
\f
; rc 1977.09.14 fp utility, print, page ...3...
se. w3 (f1.) ; if first = blocklength then
jl. a2. ; begin
al w2 0 ; blocklength := 0;
rs. w2 f26. ; bytes := 0;
rs. w2 f1. ; goto end block change;
jl. a4. ; end;
a2: jl. w3 c2. ; print block head:
jl. w3 c2. ; writecr;
rl. w2 f13. ; writecr;
al w3 i19 ;
hs. w3 i18. ; set select;
jl. w3 c1. ; list parameter(area description);
al w3 i15 ;
hs. w3 i18. ; restore select out;
bz. w0 i4. ; if blocked then
sn w0 0 ; begin
jl. a3. ; writesp;
jl. w3 c3. ;
rl. w0 f7. ; w0 := block;
jl. w3 c4. ; writeinteger(<<d>,w0)
32<12 +1 ; end;
a3: al w0 0 ;
hs. w0 i2. ; printcount := words per line;
a4: rl. w1 f7. ; end block change:
al w1 x1+1 ;
rs. w1 f7. ; block := block + 1;
rl. w1 f2. ;
i10 = k + 1 ; relative out
sn w3 x3 ; if -,relative out then
wa. w1 f9. ; number := from word + first number else
rs. w1 f6. ; number := from word;
jl. a0. ; goto next word;
a6: am. (f6.) ; increase number:
al w1 2 ; number := number + 2;
rs. w1 f6. ; goto next word
jl. a0. ;
a7: am -1 ; print it:
i2 = k + 1 ; print count;
al w0 0 ; print count := print count - 1;
hs. w0 i2. ;
sl w0 1 ; if print count <= 0 then
jl. a8. ; begin
jl. w3 c2. ; writecr;
rl. w0 f6. ; w0 := number;
jl. w3 c4. ;
32<12 +6 ; writeinteger(<<dddddd>,w0);
al w2 46 ;
jl. w3 c9. ; writechar(point);
rl. w0 f6. ;
i20=k+1
; jl. 2 ; (if octal)
jl. 8 ; skip
jl. w3 c31. ; writeoctal(addr);
al w2 46 ;
jl. w3 c9. ; writechar(point);
i3 = k + 1 ; words per line;
al w0 0 ; print count := words per line;
hs. w0 i2. ; end
jl. a9. ; else
a8: al w2 44 ;
jl. w3 c9. ; writechar(comma);
a9: jl. w3 c3. ; writesp;
al w3 1 ;
hs. w3 i7. ; print := true;
\f
; rc 14.8.1969 fp utility, print, page 4
i5 = k + 1 ; text ; print text:
sn w3 x3 ; if text then
jl. a10. ; begin
rl. w1 f10. ; w1 := current word;
jl. w2 c10. ; test graphic;
jl. w2 c10. ; test graphic;
jl. w2 c10. ; test graphic;
al w0 x3 ; w0 := text word;
jl. w3 c11. ; print textword;
; end;
a10: rl. w2 f14. ; print bit groups: group no := 0;
a11: bl w1 x2 ; next bit group:
sn w1 -1 ; if first bit(groupno) = -1 then
jl. a12. ; goto print code;
rl. w0 f10. ; s := first bit(groupno);
ls w0 x1 ; w0 := current word shift s;
ac w1 x1 ;
ba w1 x2+1 ; s := last bit(groupno) - s;
rl w3 x2+2 ;
sl w3 0 ; if layout >= 0 then
ls w0 x1-23 ; w0 := w0 shift s - 23;
sh w3 -1 ; if layout < 0 then
as w0 x1-23 ; w0 := w0 arithshift s - 23;
rs. w3 b0. ; store layout;
jl. w3 c4. ; writeinteger(layout,w0);
b0: 0 ; layout ;
al w2 x2+4 ; groupno := groupno+4;
jl. a11. ; goto next bit group;
i6 = k + 1 ; code ; print code:
a12: sn w3 x3 ; if -,code then
jl. a6. ; goto increase number;
jl. w3 c3. ; writesp;
bz. w1 f10. ; print instruction:
ld w2 -6 ; w2 := bits(6,11,current word) shift 18;
hl. w2 f10. ; + bits(0,11,current word);
am x1 ;
rl. w0 x1 + g0. ; no := bits(0,5,current word)*2;
ld w1 -16 ; instruction := instruction table(no);
hs. w0 b1. ; w0 := <:<instruction letters><0>:>;
ld w1 16 ; mark := bits(0,7,w0);
ls w0 8 ; comment: mark is <space> or <,>;
jl. w3 c11. ; print text word;
al. w0 g5. ; print relative:
sz w2 1<3 ; writetext(
al. w0 g6. ; if bit(20,w2) = 0 then <: :>
jl. w3 c5. ; else <:. :>);
al w1 0 ; print w-register: w1 := 0;
ld w2 2 ; (w1,w2) := (w1,w2) shift 2;
b1 = k + 1 ; mark ; comment: w1 = register no;
al w3 x1 ; test := mark + w1;
wa. w1 g2. ;
ld w1 32 ; w0 := <:w<register no><0>:>;
sn w3 44 ; if test = 44 then
rl. w0 g5. ; w0 := <: :>;
jl. w3 c11. ; print text word;
\f
; rc 1977.10.12 fp utility, print, page ...5...
al. w0 g5. ; print left bracket:
sz w2 1<4 ; writetext(
al. w0 g3. ; if bit(19,w2) = 0 then <: :>
jl. w3 c5. ; else <: (:>);
bz. w0 f10. ; print index register:
la. w0 g8. ; w0 := x-field of current word
wa. w0 g7. ; + <:<0>x0:>;
sn. w0 (g7.) ; if w0 = <:<0>x0:> then
rl. w0 g1. ; w0 := <: :>;
ls w0 8 ; w0 := w0 shift 8;
jl. w3 c11. ; print text word;
bl. w1 f10.+1 ; print displacement:
hs. w1 b2. ; displacement := bits(12,23,current word);
se w1 0 ; if displacement <> 0 then
jl. a13. ; goto print space or sign;
sz w2 3<2 ; if x-field of current word <> 0 then
jl. a14. ; goto print right bracket;
a13: al w0 32 ; print space or sign: text := <: :>;
sz w2 3<2 ; if x-field of current word <> 0 then
al w0 43 ; text := <:+:>;
sh w1 -1 ; if displacement < 0 then
al w0 45 ; text := <:-:>;
ls w0 16 ; w0 := text;
jl. w3 c11. ; print text word;
b2 = k + 1 ; displacement ;
al w0 0 ; w0 := displacement;
sh w0 -1 ; if displacement < 0 then
ac w0 (0) ; displacement := -displacement;
jl. w3 c4. ; writeinteger(<<d>,w0);
32<12 +1 ; comment: layout;
a14: al. w0 g5. ; print right bracket:
sz w2 1<4 ; writetext(
al. w0 g4. ; if bit(19,w2) = 0 then <: :>
jl. w3 c5. ; else <:) :>);
so w2 1<5 ; print final address:
jl. a6. ; if bit(18,w2) = 0 then
rl. w0 f6. ; goto increase number;
ba. w0 b2. ; final address :=
rs. w0 f29. ; displacement + number;
jl. w3 c4. ; save final addr
1<23+32<12+1 ; writeinteger(<<-d>,final address);
rl. w0 f29. ; final addr
i21=k+1
; jl. 2 ; (if octal)
jl. a6. ; goto increase number;
jl. w3 c31. ; writeoctal(final addr);
jl. a6. ; goto increase number;
\f
; rc 1977.10.13 print, page ...5a...
c31:
; procedure writeoctal(addr);
b. i3
w.
ds. w0 i3. ; save w3.w0
jl. w3 c3. ; writesp;
al w1 9 ; count:=9;
rs. w1 i1. ;
i0: rl. w1 i1. ; loop:
al w1 x1+3 ; count:=count+3;
sl w1 22 ; if count>22 then
jl. (i2.) ; return;
rs. w1 i1. ;
rl. w0 i3. ; octal:=addr
ls w0 x1 ; shift count
ls w0 -21 ; shift (-21);
jl. w3 c4. ; writeinteger(z,<<z>,octal);
48<12+1 ;
jl. i0. ; goto loop;
i1: 0 ; count
i2: 0 ; saved return
i3: 0 ; saved addr
e.
\f
; rc 1977.09.26 fp utility, print, page ...6...
e1: ; next field:
i7 = k + 1 ; print ;
se w3 x3 ; if -,print then
jl. a18. ; begin
al. w1 b4. ;
jl. w3 c12. ; message(<:numbering:>);
rl. w2 g9. ; list parameter(field specification);
jl. w3 c1. ; end;
a18: ;
jl. w3 c2. ; writecr;
; each call of output procedures up to this point will cause
; output on secondary out, otherwise on current out
i15 = k - i18 + 3
i8 = k + 1 ; end param ;
se w3 x3 ; if end param then
jl. d3. ; goto exit fp;
jl. e3. ; goto scan parameter list;
g1: <:<32><32><32>:> ;
g2: <:<0>w0:> ;
g3: <:<32>(:> ;
g4: <:)<32>:> ;
g5: <:<32><32>:> ;
g6: <:.<32>:> ;
g7: <:<0>x0:> ;
g8: 1<1+1 ;
g9: 0 ; saved pointer(field specification);
; comma in front of instr means: w0 irrelevant
g0: <:,aw do el hl la lo lx wa ws,am wm al,ri,jl,jd,je:>
<:,xl es ea zl rl,sp,re rs wd rx hs,xs gg di,ms,is:>
<: ci ac ns nd as ad ls ld sh sl se sn so sz,sx gp:>
<: fa fs fm,ks fd cf dl ds aa ss,58,59,60,61,62,63:>
i14 = k + 1 ; bs area
c0: se w3 x3 ; get word:
jl. c26. ; if bs area then goto inword;
rl. w1 f27. ; get word from core:
sh. w1 (f8.) ;
jl. 4 ; if current core relative > last byte
jl. e1. ; then goto next field;
al w1 x1+2 ; current core relative :=
rs. w1 f27. ; current core relative + 2;
wa. w1 f9. ; current word :=
rl w0 x1-2 ; word(current core relative + first number);
; this load instruction might cause interrupt (outside core)
c27: rs. w0 f10. ;
jl x3 ; return;
e4: rl. w1 f15. ; interrupt in print:
rl w0 x1+h10+10 ;
sn. w0 c27. ; if called from get word then
jl. e1. ; goto next field;
al w0 h10+h76 ;
hs. w0 i16. ; exit := fp break;
jl. d3. ; goto exit fp;
\f
; rc 7.7.1970 fp utility, print, page 7
b. a3, b0 ; begin block: get word
w. ;
c26: rs. w3 b0. ; inword:
rl. w0 f0. ; save return;
sn. w0 (f21.) ; if segment = segment count then
jl. a0. ; goto test relative;
bs. w0 1 ;
rs. w0 f21. ; segment count := segment - 1;
jl. a1. ; goto input segment;
i0 = k + 1 ; rel ; test relative:
a0: al w2 0 ;
sh w2 511 ; if rel < 512 then
jl. a2. ; goto store word;
al w2 0 ;
hs. w2 i0. ; rel := 0;
a1: al. w1 f18. ; input segment: w1 := message address;
al. w3 f17. ; w3 := addr(area name);
jd 1<11+16 ; send message;
al. w1 f22. ; w1 := answer address;
jd 1<11+18 ; wait answer;
bz w2 x1 ;
sn w0 1 ; if result <> 1
se w2 0 ; or status <> 0 then
jl. a3. ; goto may be alarm;
am (x1+2) ;
sn w3 x3 ; if bytes transferred = 0 then
jl. a1. ; goto input segment;
rl. w1 f21. ;
al w1 x1+1 ;
rs. w1 f21. ; segment count := segment count + 1;
rs. w1 f0. ; segment := segment segment count;
jl. a0. ; goto test relative;
a2: am. (f19.) ; store word:
rl w0 x2 ; current word :=
rs. w0 f10. ; word(first core + rel);
al w2 x2+2 ;
hs. w2 i0. ; rel := rel + 2;
jl. (b0.) ; return;
b0: 0 ; saved return ;
a3: se w2 1<6 ; may be alarm:
jl. d4. ; if status word(5) <> 1 then
al w2 0 ; goto area alarm;
rs. w2 f1. ; blocklength := 0;
jl. e1. ; goto next field;
i. ; id list
e. ; end block: get word
\f
; rc 31.1.1974 fp utility, print, page 8
d2: al w0 0 ; area alarm 1: result := 0;
d4: al w3 1 ; area alarm:
ls w3 (0) ; w3 := 1 shift result;
sn w0 1 ; if result = 1 then
wa w3 4 ; w3 := w3 + statusword;
rs. w3 f23. ; fpresult := w3;
al. w1 b3. ;
jl. w3 c13. ; mess name(area);
jl. d3. ; goto exit fp:
b3: <: area<0>:> ;
b4: <:numbering<0>:> ;
b5: <:param <0>:> ;
b6: <: unknown<0>:> ;
b7: <:core size<0>:> ;
b8: <:***print <0>:> ;
0 ; saved text address
b9: 0 ; saved w2
b10: 0 ; saved return
c12: al w2 1 ;
rs. w2 f23. ; fpresult:=1;
am 1 ; message: w2 := 1; skip next;
c13: al w2 0 ; mess name: w2 := 0;
ds. w2 b9. ; save(w1,w2);
rs. w3 b10. ; save return;
jl. w3 c2. ; writecr;
al. w0 b8. ;
jl. w3 c5. ; writetext(<:***print :>);
am. (b9.) ;
se w3 x3 ; if w2 = 0 then
jl. a15. ; begin
am. (f13.) ; w0 := addr(name of area descript);
al w0 2 ; writetext;
jl. w3 c5. ; end;
a15: rl. w0 b9.-2 ;
jl. w3 c5. ; writetext(message);
jl. (b10.) ; return;
c25: rs. w0 f27. ; setposition:
ld w1 -9 ; current core relative := w0;
ba. w0 1 ;
rs. w0 f0. ; segment := w0 shift -9 + 1;
al w0 0 ;
ld w1 9 ;
hs. w0 i0. ; rel := w0 mod 512;
jl x2 ; return;
\f
; rc 1976.03.11 fp utility, print, page ...8a...
d3: rl. w2 f15. ; exit fp:
dl. w1 f30. ;
ds w1 x2+h10+h76+2; restore fp break routine;
al. w3 f17. ;
rl. w0 f17. ;
sn w0 0 ;
jl. d9. ; if name=0 then goto close secondary out;
bz. w0 i14. ;
se w0 0 ; if bs area then
jd 1<11+64 ; remove process(area);
d9: rl. w1 f28. ; close secondary out:
sn w1 x2+h21 ; if secondary out <> current out then
jl. d8. ; begin
bz w3 x1+h1+1 ; char := if file=bs
se w3 4 ; or file=mag tape
sn w3 18 ;
am 25 ; then em
al w2 0 ; else null;
am. (f15.) ; close up(secondary out, char);
jl w3 h34 ;
am. (f15.) ; terminate zone(secondary out);
jl w3 h79-4 ;
c. h57 < 3 ; if system 3 then
al w3 x1+h1+2 ; if backing storage then
al. w1 d10. ; reduce area to ne used size;
jd 1<11+42 ;
rl w0 x3+14 ;
rs w0 x1 ;
bz w0 x3-1 ;
sn w0 4 ;
jd 1<11+44 ;
z. ; end system 3;
am. (f15.) ; unstack(current in);
jl w3 h30-4 ; end;
d8: rl. w1 f28. ;
rl. w2 f23. ;
se w2 0 ; if fp result <> 0 then
jl. w3 c2. ; writecr;
al. w1 f17. ; w1 := addr(area name);
rl. w2 f23. ; w2 := fp result;
am. (f15.) ; enter fp:
i16 = k + 1 ; exit
jl h7 ; goto fp end program or break;
jl. (2) ; the instructions replace temporary
f30: 0 ; e4 ; h10+14 and h10+16 in fp break;
\f
; rc 1977.09.14 fp utility, print, page ...9...
b11: 8<12 +4 ; (point,integer)
b12: 4<12 +4 ; (space,integer)
b13: 4<12 +10 ; (space,name)
b14: 8<12 +10 ; (point,name)
b15 = k - 4 ; delimiter table:
<: :>,<:=:>,<:.:>; <space>, <equal>, <point>
b16: 0, 0 ; saved return, zero
c1: rs. w3 b16. ; list parameter:
bz w1 x2 ; save(return);
a16: al. w0 x1+b15. ; print next:
jl. w3 c5. ; writetext(<delimiter>);
al. w3 a17. ; set return(get next);
bz w1 x2+1 ;
al w0 x2+2 ; w0 := addr(param);
sn w1 10 ; if param = <text> then
jl. c5. ; goto writetext;
rl w0 x2+2 ; w0 := param;
jl. w3 c4. ; writeinteger;
32<12 +1 ; comment: layout;
a17: al w3 x2 ; get next:
ba w2 x2+1 ; save w2;
bz w1 x2 ; w2 := w2 + right(w2);
sl w1 5 ; if delimiter > <space> then
jl. a16. ; goto print next;
al w2 x3 ; restore w2;
jl. (b16.) ; return;
i19=k-i18-1 ; top of list parameter
c8: rs. w3 b16. ; next param:
ba w2 x2+1 ; save return;
al w3 x2 ; command pointer :=
ba w3 x2+1 ; command pointer + bits(12,23,itemhead);
rl w3 x3 ; w3 := next item head;
bl w0 6 ;
sl w0 4 ; if next param = <end param> then
jl. a19. ; begin
rl. w3 b13. ; w3 := (space,name);
al w0 1 ; end param := true;
hs. w0 i8. ; end;
a19: rl w0 x2+2 ; w0 := param;
jl. (b16.) ; return;
c11: rs. w0 b16. ; print text word: text word := w0;
al. w0 b16. ; w0 := address(text word);
jl. c5. ; goto writetext;
c10: al w0 0 ; test graphic:
ld w1 8 ; w0 := 0;
c.h57<3 ; if system 3 then
se w0 35 ; if char=35 or
sn w0 36 ; if char=36 or
al w0 32 ;
se w0 64 ; if char=64 or
sn w0 94 ; if char=94 or
al w0 32 ;
sn w0 96 ; if char=96
al w0 32 ; then char=<space>;
z. ; end system 3 code
sl w0 32 ; (w0,w1) := (w0,w1) shift 8;
sl w0 127 ; if w0 < 32 or w0 > 126 then
al w0 32 ; w0 := <space>;
ls w0 16 ;
ld w0 8 ; w3 := w3 shift 8 + w0;
jl x2 ;
\f
; rc 7.7.1970 fp utility, print, page 10
b17: 4<12 +10 ; pointer(end param);
<:end param:>, 0 ;
4<12 +10 ;
e3: rl. w2 f16. ; scan parameter list: restore command point;
a20: jl. w3 c8. ; scan parameter list 1:
bz w1 x2 ; next param;
sl w1 4 ; if param = <end param> then
jl. a21. ; begin
al. w1 b17. ; saved pointer(field spec) :=
rs. w1 g9. ; pointer(end param);
al w0 0 ; from word := 0;
rl. w1 f11. ; to word := infinite;
ds. w1 f5. ; from block := 0;
ds. w1 f3. ; to block := infinite;
i17 = k + 1 ; 0 for process and dump area otherwise 1
al w0 1 ; blocked := true for bs area, false for process
hs. w0 i4. ; goto execute 1;
jl. a49. ; end;
a21: rs. w2 f16. ; save parameter pointer;
rl w1 x2 ;
sn. w1 (b13.) ; if parameter = (space,name) then
jl. a23. ; goto format list;
sn. w1 (b12.) ; if parameter = (space,integer) then
jl. a26. ; goto field specification;
a22: al. w1 b5. ; param error:
a30: jl. w3 c12. ; message(<:param:>);
rl. w2 f16. ; param error 1: restore param pointer;
jl. w3 c1. ; list parameter;
jl. a20. ; goto scan parameter list;
a23: rs. w3 b18. ; format list: save(delim);
al. w3 g10. ; index := 0;
a24: dl w1 x3+2 ; search:
sn w0 (x2+2) ; if first double word(format table(index))
se w1 (x2+4) ; <> first double word(parameter) then
jl. a25. ; goto try next;
dl w1 x3+6 ;
sn w0 (x2+6) ; if second double word(format table(index))
se w1 (x2+8) ; <> second double word(parameter) then
jl. a25. ; goto try next;
rl w1 x3+8 ; found:
bl. w3 b18. ; w3 := next delimiter;
d7: jl. x1 ; goto format table(index+8);
a25: sn. w3 g11. ; try next:
jl. a22. ; if index = top index then goto param error;
al w3 x3+10 ; index := index + 10;
jl. a24. ; goto search;
b18: 0 ; saved delim ;
\f
; rc 1970.07.15 fp utility, print, page ...11...
b30: <:r:> ; test relative out
b31: <:a:> ; test absolute
b32: <:i:> ; test indirect
b33: <:c:> ; test center
b34: 0 ; center address
a26: rs. w2 g9. ; field specification:
al w1 0 ; save pointer(field specification);
rs. w1 f4. ; from block := w1 := 0;
rs. w1 f5. ; to block := 0;
hs. w1 i11. ; absolute in := false;
hs. w1 i12. ; indirect := false;
hs. w1 i13. ; center := false;
a27: hs. w1 i4. ; next pair:
hs. w1 i10. ; blocked := relative out := w1=4;
rs. w0 x1+f2. ; word(w1+addr(from)) := param;
sn. w3 (b11.) ; if next item = ( point, integer) then
jl. w3 c8. ; next param;
rs. w0 x1+f2.+2 ; word(w1+addr(from)+2) := param;
sn w1 4 ; if w1 = 4 then
jl. a28. ; goto execute;
sn. w3 (b14.) ; if next item = (point,name) then
jl. a59. ; goto test field modifier;
se. w3 (b11.) ; if next item <> (point,integer) then
jl. a28. ; goto execute;
jl. w3 c8. ; block: next param;
al w1 4 ; w1 := 4;
jl. a27. ; goto next pair;
a59: jl. w3 c8. ; test field modifier: next param;
rl w1 x2 ;
se. w1 (b14.) ; if item <> (point,name) then
jl. a22. ; goto param error;
al w1 0 ; modifier := 0;
sn. w0 (b30.) ; if item = <:r:> then
al. w1 i10. ; modifier := relative out;
sn. w0 (b31.) ; if item = <:a:> then
al. w1 i11. ; modifier := absolute in;
sn. w0 (b32.) ; if item = <:i:> then
al. w1 i12. ; modifier := indirect;
se. w0 (b33.) ; if param <> <:c:> then
jl. a60. ; goto test syntax;
al. w1 i13. ; modifier := center;
jl. w3 c8. ; next param;
rs. w0 b34. ; center address := param;
rl w0 x2 ; if param <> (point,integer);
sn. w0 (b11.) ; then goto syntax;
a60: sn w1 0 ; test syntax: if modifier = 0 then
jl. a22. ; syntax : goto param alarm;
al w0 1 ;
hs w0 x1 ; modifier := true;
bl w1 6 ;
se w1 4 ; if next delim <> space then
jl. a59. ; goto test field modifier;
\f
; rc 7.7.1970 fp utility, print, page 11a
a61: rs. w2 d0. ; set field modifiers:
i11 = k + 1 ; absolute in
sn w3 x3 ; set absolute:
jl. a62. ; if absolute in then
dl. w1 f3. ; begin
ws. w0 f9. ; from word := from word - first number;
ws. w1 f9. ; to word := to word - fist number;
ds. w1 f3. ;
rl. w0 b34. ; center address :=
ws. w0 f9. ; center address - first number;
rs. w0 b34. ; end;
i12 = k + 1 ; indirect
a62: sn w3 x3 ; set indirect:
jl. a63. ; if indirect then
rl. w0 f2. ; begin
jl. w2 c25. ; w0 := from word;
jl. w3 c0. ; setposition; get word;
rl. w0 f10. ;
ws. w0 f9. ; from word :=
rs. w0 f2. ; current word - first number;
rl. w0 f3. ; w0 := to word;
jl. w2 c25. ; setposition;
jl. w3 c0. ; get word;
rl. w0 f10. ; to word :=
ws. w0 f9. ; current word - first number;
rs. w0 f3. ; end;
i13 = k + 1 ; center ; set center interval:
a63: sn w3 x3 ; if center then
jl. a64. ; begin
rl. w0 b34. ; w0 := center address;
jl. w2 c25. ; setposition;
jl. w3 c0. ; get word;
rl. w0 f10. ; w0 := current word - first number;
ws. w0 f9. ;
rx. w0 f3. ; to word :=
wa. w0 f3. ; to word + w0;
rx. w0 f3. ; from word :=
ws. w0 f2. ; w0 - from word;
rs. w0 f2. ; end;
a64: rl. w2 d0. ;
\f
; rc 16.7.1970 fp utility, print ,page 11b
a28: al w3 x2 ; execute:
ba w3 x3+1 ;
bl w0 x3 ;
sl w0 5 ; if next delim <> space then
jl. a22. ; goto param alarm;
a49: al w0 0 ; execute 1:
al w3 1 ;
rs. w3 f0. ; segment := 1;
rs. w0 f26. ; bytes := 0;
rs. w0 f7. ; block := 0;
rs. w0 f12. ; total := 0;
hs. w0 i7. ; print := false;
hs. w0 i0. ; rel := 0;
hs. w0 i9. ; new format := false;
rs. w2 f16. ; save parameter pointer;
jl. a0. ; goto next word;
c24: bz. w0 i9. ; clear format list 1:
se w0 0 ; if new format then
jl x3 ; return;
jl. a69. ; goto clear 1;
i9 = k + 1 ; new format ; clear format list:
c14: se w3 x3 ; if new format then
jl x3 ; return;
al w0 0 ;
hs. w0 i5. ; text := false;
hs. w0 i6. ; code := false;
al w0 1 ;
hs. w0 i9. ; new format := true;
a69: rl. w0 f14. ; clear 1:
rs. w0 f25. ; bit group pointer :=
al w0 -1 ; base bit group pointer;
rs. w0 (f25.) ; terminate bit group table;
jl x3 ; return;
\f
; rc 1977.10.13 fp utility, print, page ...12...
b19: 32<12 +1 ;
b20: 32<12 +2 ;
12<12 +23 ;
b21: 1<23+32<12+6 ;
b22: 1<23+32<12+9 ;
b23: 3 ;
b25: 32<12 +5 ;
b36: 32<12+4
b37: 8<12+15
b38: 16<12+23
b39: 48<12+1
b40: 3<12+3
c15: rx. w2 f25. ; stack group:
al w2 x2+4 ; bit group pointer := bit group pointer + 4;
sl. w2 (f24.) ; if bit group pointer >= top command then
jl. a29. ; goto pattern error;
ds w1 x2-2 ; double word(bit group pointer - 2) :=
rx. w2 f25. ; (w0,w1);
jl x3 ; return;
a29: al. w1 b7. ; pattern error: w1 := addr(<:core size:>);
jl. w3 c12. ; message;
rl. w2 f16. ; w2 := saved command pointer;
jl. w3 c1. ; list parameter;
jl. d3. ; goto exit fp;
c16: se w3 4 ; integer:
jl. a22. ; if next delim <> space then
jl. w3 c14. ; goto param error;
al w0 23 ; clear format list;
rl. w1 b22. ; w0 := 0<12+23; w1 := <<-dddddddd>;
jl. w3 c15. ; stack group;
a31: al w0 -1 ; terminate group table:
rs. w0 (f25.) ; word(bit group pointer) := -1;
jl. a20. ; goto scan parameter list 1;
c17: se w3 4 ; byte:
jl. a22. ; if next delim <> space then
jl. w3 c14. ; goto param error;
al w0 11 ; clear format list;
rl. w1 b21. ; w0 := 0<12+11; w1 := <<-ddddd>;
jl. w3 c15. ; stack group;
rl. w0 b21.-2 ; w0 := 12<12+23;
jl. w3 c15. ; stack group;
jl. a31. ; goto terminate group table;
c28: se w3 4 ; char: if next delim<>space
jl. a22. ; then param error else
jl. w3 c14. ; clear format
al w0 7 ; w0:=0<12+7
rl. w1 b36. ; w1:=<<ddd>
jl. w3 c15. ; stack group
rl. w0 b37. ; w0:=8<12+15
jl. w3 c15. ; stack group
rl. w0 b38. ; w0:=16<8+23
jl. w3 c15. ; stack group
jl. a31. ; goto terminate group table
\f
; rc 1977.10.13 print, page ...12a...
c29: se w3 4 ; abshalf:
jl. a22. ; if next delim<>space then
jl. w3 c14. ; goto param error;
al w0 11 ; clear format list;
rl. w1 b25. ; w0:=0<12+11; w1:=<<ddddd>;
jl. w3 c15. ; stack group;
rl. w0 b21.-2 ; w0:=12<12+23;
jl. w3 c15. ; stack group;
jl. a31. ; goto terminate group table;
c30: se w3 4 ; octal:
jl. a22. ; if nextdelim<>space then
jl. w3 c14. ; goto param error;
al w0 2 ; w0:=0<12+2;
hs. w0 i20. ; save octal for addr
hs. w0 i21. ; save octal for code
rl. w1 b39. ; w1:=<<z>;
jl. w3 c15. ; stack group;
wa. w0 b40. ; w0:=w0+3<12+3;
jl. w3 c15. ; stack group;
wa. w0 b40. ; w0:=w0+3<12+3;
jl. w3 c15. ; stack group;
wa. w0 b40. ; w0:=w0+3<12+12;
jl. w3 c15. ; stack group;
wa. w0 b40. ; w0:=w0+3<12+3;
jl. w3 c15. ; stack group;
wa. w0 b40. ; w0:=w0+3<12+3;
jl. w3 c15. ; stack group;
wa. w0 b40. ; w0:=w0+3<12+3;
jl. w3 c15. ; stack group;
wa. w0 b40. ; w0:=w0+3<12+3;
jl. w3 c15. ; stack group;
jl. a31. ; goto terminate grouptable;
c18: se w3 4 ; all:
jl. a22. ; if next delim <> space then
jl. w3 c14. ; goto param error;
a48: al w0 23 ; clear format list;
hs. w0 i6. ; all 1: code := true; w0 := 0<12+23;
rl. w1 b22. ; w1 := <<-dddddddd>;
jl. w3 c15. ; stack group;
al w0 11 ; w0 := 0<12+11;
rl. w1 b25. ; w1 := <<ddddd>;
jl. w3 c15. ; stack group;
jl. a31. ; terminate group table;
\f
; rc 16.04.1972 fp utility, print, page ...13...
b26: 0 ; from bit, to bit
c19: se w3 4 ; code:
jl. a22. ; if next delim <> <space> then
jl. w3 c14. ; goto param error;
al w0 1 ; clear format list;
hs. w0 i6. ; code := true;
jl. a20. ; goto scan parameter list 1;
c20: se w3 4 ; text:
jl. a22. ; if next delim <> space then
jl. w3 c14. ; goto param error;
al w0 1 ; clear format list;
hs. w0 i5. ; text := true;
jl. a20. ; goto scan parameter list 1;
c21: sn w3 4 ; bits:
jl. a33. ; if next delim = space then
jl. w3 c24. ; goto bit pattern 1:
rl. w3 b18. ; clear format list 1;
; next group:
a32: jl. w1 c22. ; next bit;
hs. w1 b26. ; from bit := param;
jl. w1 c22. ; next bit;
hs. w1 b26.+1 ; to bit := param;
bs. w1 b26. ; w1 := to bit - from bit;
sh w1 -1 ; if w1 < 0 then
jl. a34. ; goto pattern error;
al w0 0 ; w0 := 0;
wd. w1 b23. ;
wa. w1 b20. ; w1 := w1//3 add <<dd>;
rl. w0 b26. ; w0 := (from bit,to bit);
jl. w3 c15. ; stack group;
rl. w3 b18. ;
sn. w3 (b11.) ; if next param = (point, integer) then
jl. a32. ; goto next group;
bz w3 6 ; finis pattern:
se w3 4 ; if next delim <> space then
jl. a34. ; goto pattern error;
rl. w1 f25. ; save(bit group point);
rs. w2 f16. ; save(parameter pointer);
rl. w2 (f14.) ; save(first of bit group table);
jl. w3 c14. ; clear format list;
rs. w1 f25. ; restore(bit group pointer);
rs. w2 (f14.) ; restore(first of bit group table);
rl. w2 f16. ; restore parameter pointer;
jl. a31. ;
\f
; rc 1977.09.26 fp utility, print, page ...14...
a33: rs. w2 f16. ; bit pattern: save param pointer;
jl. w3 c14. ; clear format list;
al w2 0 ; bit := 0;
rl. w1 b20. ; w1 := <<d>;
a35: hs w2 0 ; next pair:
hs w2 1 ; w0 := bit shift 12 + bit;
jl. w3 c15. ; stack group;
rl. w1 b19. ; w1 := <<d>;
al w2 x2+1 ; bit := bit + 1;
sh w2 23 ; if bit <=23 then
jl. a35. ; goto next pair;
rl. w2 f16. ; restore command pointer;
jl. a31. ; goto terminate group table;
c22: rs. w1 b24. ; next bit: save return;
se. w3 (b11.) ; if next param <> (point,integer) then
jl. a34. ; goto pattern error;
jl. w3 c8. ; next param;
rs. w3 b18. ; save next item head;
sl w0 24 ; if param > 23 then
jl. a34. ; goto pattern error;
rl w1 0 ; w1 := param;
jl. (b24.) ; return;
b24: 0 ; saved return ;
a34: rl. w1 f14. ; pattern error:
rs. w1 f25. ; bit group point :=
al w0 -1 ; base bit group table;
rs w0 x1 ; word(bit group point) := -1;
jl. a22. ; goto param error;
c23: rl. w3 b18. ; words:
se. w3 (b11.) ; if next param <> (point,integer) then
jl. a22. ; goto parameter error;
jl. w3 c8. ; next param;
bz w3 6 ;
se w3 4 ; if next delim <> space then
jl. a22. ; goto param error;
hs. w0 i3. ; words per line := param;
jl. a20. ; goto scan parameter list 1;
g10: <:integer:> , 0 , c16-d7 ; format table:
<:word:>,0 , 0 , c16-d7
<:char:>,0 , 0 , c28-d7
<:half:>, 0 , 0 , c17-d7
<:abshalf:>, 0 , c29-d7
<:octal:>,0 , 0 , c30-d7
<:byte:>, 0 , 0 , c17-d7 ;
<:code:>, 0 , 0 , c19-d7 ;
<:text:>, 0 , 0 , c20-d7 ;
<:bits:>, 0 , 0 , c21-d7 ;
<:words:>,0 , 0 , c23-d7 ;
g11: <:all:>,0,0 , 0 , c18-d7 ;
\f
; rc 1977.10.13 fp utility, print, page ...15...
b28: <:s:> ;
b29: 0 ;
b35: <:connect out<0>:>
e2: rs. w1 f15. ; initialize print:
rs. w2 f24. ; save top command;
rs. w3 f16. ; save fp base; save command pointer;
al. w3 d5. ;
al w0 x3+510 ; first core := first free core;
ds. w0 f20. ; last core := first core + 510;
al w3 x3+512 ; comment: bs segment buffer;
rs. w3 f14. ; base bit group table := last core + 2;
rs. w3 f25. ; bit group point := last core + 2;
sh w3 x2-4 ; if last core + 2 >= top command then
jl. a36. ; begin
al. w1 b7. ; message(<:core size:>);
jl. w3 c12. ; goto exit fp
jl. d8. ; end;
a36: dl w0 x1+h10+h76+2;
rx. w3 f30.-2 ; exchange two first words of
rx. w0 f30. ; fp break with entries at print;
al. w0 e4. ;
ds w0 x1+h10+h76+2;
al w0 x1+h21 ;
rs. w0 f28. ; secondary out := current out;
rl. w2 f16. ; w2 := command pointer(point);
bz w1 x2 ;
se w1 6 ; if delimiter = <=> then
jl. a37. ; begin
am. (f15.) ;
jl w3 h29-4 ; stack current input;
rl. w2 f16. ; restore w2;
al w2 x2-8 ;
rl. w3 f15. ;
al w1 x3+h20 ; zone := current in;
al w0 1<1+1 ; comment: one segm. on disc;
jl w3 x3+h28 ; connect out(zone); (=secondary output);
sn w0 0 ; if result <> 0 then
jl. d10. ; begin
al. w1 b35. ;
jl. w3 c12. ; message(<:connect out:>);
jl. d3. ; goto exit fp;
d10: rs. w1 f28. ; secondary out zone := current in;
bl w0 x1+h1+1 ;
sn w0 4 ; if -,bs and
jl. 6 ; -,mt
se w0 18 ; then
jl. a44. ; skip;
rl. w2 f16. ;
al w2 x2-8 ; w2:=name addr
am. (f15.) ;
al w1 h54 ; w1:=lookup area
jl. w3 a65. ; prepare output
a44:
rl. w2 f16. ;
a37: al w0 0 ; again:
hs. w0 i1. ; content := 0;
am -2000
rs. w0 f9.+2000 ; first number := 0;
jl. w3 c8. ; next param;
bl w1 x2 ;
sl w1 4 ; if param = <end list> then
jl. a43. ; begin
al. w1 b3. ; message(<:area:>);
jl. w3 c12. ; goto exit fp
jl. d3. ; end;
\f
; rc 1977.10.13 fp utility, print, page ...15a...
a43: am -2000
rs. w2 f13.+2000 ; save pointer(area description);
bz w1 x2+1 ;
se w1 10 ; if param <> name then
am -2000
rs. w0 f9.+2000 ; first number := param;
sn. w3 (b11.) ; if next param = (point,integer) then
jl. a41. ; goto numbering;
sn. w3 (b14.) ; if next param = (point,name) then
jl. a40. ; goto segmented;
a38: bl w1 6 ; test space:
sn w1 4 ; if delimiter = space then
jl. a42. ; goto area or process name;
\f
; rc 1977.10.13 fp utility, print, page ...16...
a39: al. w1 b5. ; syntax error:
jl. w3 c12. ; message(<:param:>);
am -2000
rl. w2 f13.+2000 ; w2 := addr(area description);
jl. w3 c1. ; list parameter;
jl. a37. ; goto again;
a40: jl. w3 c8. ; segmented: next param;
se. w0 (b28.) ; if param <> <:s:> then
jl. a39. ; goto syntax error;
al w0 6 ;
hs. w0 i1. ; content := 6;
se. w3 (b11.) ; if next param <> (point,integer) then
jl. a38. ; goto test space;
a41: jl. w3 c8. ; numbering:
am -2000
rs. w0 f9.+2000 ; first number := next param;
jl. a38. ; goto test space;
a42: am -2000
rs. w2 f16.+2000 ; area or process name:
am -2000
rl. w3 f13.+2000 ;
al w3 x3 +2 ;
jd 1<11+4 ; process description;
sn w0 0 ; if process does not exist then
jl. d11. ; goto area;
rl w2 (0) ;
se w2 0 ; if process kind <> internal then
jl. d11. ; goto area;
rl w2 0 ; w2 := process descr. addr.;
rl w0 x2+22 ;
am -2000
rx. w0 f9.+2000 ;
sn w0 0 ; if first number = 0 then
jl. 6
am -2000
rx. w0 f9.+2000 ; first number := first core(process description);
rl w1 x2+24 ;
ws w1 x2+22 ;
al w1 x1-2 ; last byte := last core - first core;
am -2000
rs. w1 f8.+2000 ;
a50: al w0 0 ; ready:
hs. w0 i17. ; blocked := false;
am -2000
rl. w2 f16.+2000 ; restore command pointer;
jl. a48. ; restore command pointer; goto all1;
d11: rl w0 x3 ; area: name := first word(area name);
am -2000
rl. w3 f15.+2000 ; tail := abs addr(descr part first note);
c.h57<2 ; if system 2 then
al w1 x3+h52+2 ; may be next note:
a44: sn w0 (x1-2) ; if name = namepart(note) then
jl. a46. ; goto descriptor found;
al w1 x1+22 ; tail := tail + 22;
sh w1 x3+h53 ; if tail <= first after last note then
jl. a44. ; goto may be next note;
z. ; end system 2 code
al. w1 d5. ; name is not note:
am -2000
am. (f13.+2000); w1 := tail := first free core;
al w3 2 ; w3 := addr(area name);
jd 1<11+42 ; lookup entry;
sn w0 0 ; if result <> 0 then
jl. a46. ; begin
sn w0 6 ; if name format illegal then
jl. a50. ; abs core addr: goto ready;
a45: al. w1 b6. ; unknown: mess name(<:unknown);
al w2 1 ;
am -2000
rs. w2 f23.+2000 ; fpresult:=1;
jl. w3 c13. ; goto exit fp
jl. d3. ; end;
\f
; rc 1977.09.14 fp utility, print, page...17...
a46: bz w0 x1+16 ; descriptor found:
am -2000
bz. w2 i1.+2000 ;
se w2 6 ; if content <> 6 then
am -2000
hs. w0 i1.+2000 ; content := tail(16);
rl w0 x1 ;
sl w0 0 ; if tail(0) >= 0 then
jl. a47. ; goto prepare area process;
al w3 x1+2 ; w3 := addr(document name);
al. w1 d13. ; w1 := first free core + 10;
jd 1<11+42 ; lookup entry;
se w0 0 ; if result <> 0 then
jl. a45. ; goto unknown;
a47: jd 1<11+52 ; prepare area process:
se w0 0 ; create area process;
jl. d4. ; if result <> 0 then
dl w1 x3+2 ; goto area alarm;
am -2000
ds. w1 f17.+2+2000;
dl w1 x3+6 ; move name to name part
am -2000
ds. w1 f17.+6+2000; of input description;
am -2000
bz. w0 i1.+2000 ;
am -2000
rl. w1 f9.+2000 ;
sn w1 0 ;
se w0 7 ; if first number <> 0 or content <> 7 then
jl. d12. ; goto start print;
al w0 0 ; w0 := 0;
hs. w0 i17. ; blocked := false;
jl. w2 c25. ; setposition;
jl. w3 c26. ;
am -2000 ;
rl. w0 f10.+2000 ; get word;
am -2000 ;
rs. w0 f9.+2000 ; first number := current word;
d12: am -2000, rl. w2 f16.+2000 ; start print: restore command pointer;
al w0 1 ;
hs. w0 i14. ; bs area := true;
jl. a48. ; goto all1;
a65:
; 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.
d1 = k - d0 , d5 = k, d6 = k + 512, d13 = k + 10
0 ; zero, to terminate program segment
i. ; id list
e. ; end segment: print
m.rc 1977.10.13 fp utility, print
m0=k-h55
m1=4; entry
g0:g1: (:m0+511:)>9 ; segm
0,r.4
s2 ; date
0,0 ; file, block
2<12+m1 ; contents, entry
m0 ; length
d.
p.<:insertproc:>
▶EOF◀