|
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: 26880 (0x6900)
Types: TextFile
Names: »retprint3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »retprint3tx «
mode list.yes
print4tx=edit print3tx
;
; new : format hex
; 4.1.2 : print from relocated processes
; 4.1.3 : print from bs areas exceeding 32768 segments
; : print from addresses beyound 4194304 up to 8388606
; 4.1.3 : print accesses each segment from 0 up until the first one to print
; 4.1.4 : print does not connect via bs entries
;
l./1985.03.26/, r/85.03.26/88.11.21/
l./i24/, r/i24/i30/
l./jl. e2./, d
l./f8:/, i/
f31: 0 ; block base
f32: 0 ; hwd base
/
l./f8:/, r/1<22 /1<23-1/
l./f11:/, r/1<22 /1<23-1/
l./f12:/, i/
0 ;
/, l1, r/total/total (double)/, p-1
l./print, page 2/, r/rc 8.7.1970 /fgs 1988.07.17/
l./rl. w0 f12./, r/rl/dl/
l./a5:/, d1, i/
a5: al w0 x3 ; ok:
al w3 0 ;
aa. w0 f12. ; no := first + total;
/, p-2
l./rl. w0 f12./, r/f12./f1. /
l1, r/wa/aa/, r/f1. /f12./
l1, r/rs/ds/
l./page ...3/, r/rc 1977.09.14/fgs 1988.07.12/
l./a2:/, l./bz. w0 i4./,
r/i4. /i14./, r/blocked/bs area/, i#
rl. w0 f17. ;
sn w0 0 ; if input descr.name (1) <> 0 then
jl. a54. ; begin
am. (f13.) ;
dl w0 +4 ;
sn. w3 (f17. ) ; if name in area descr in parameter <>
se. w0 (f17.+2) ;
jl. a53. ;
am. (f13.) ;
dl w0 +8 ;
sn. w3 (f17.+4) ; name in input descriptor then
se. w0 (f17.+6) ;
jl. a53. ;
jl. a54. ; begin
a53:
jl. w3 c3. ; writecr;
al w2 40 ;
jl. w3 c9. ; write (<:(:>);
al. w0 f17. ;
jl. w3 c5. ; writetext (input descr name);
al w2 41 ;
jl. w3 c9. ; write (<:):>);
a54: ; end;
\f
; fgs 1988.07.12 fp utility, print, page ...3a...
#
l./a3:/, l-1, d, i/
32<12 +1 ;
zl. w0 i1. ;
se w0 6 ; if segmented then
jl. a3. ; begin
jl. w3 c3. ; writesp;
al w2 40 ;
jl. w3 c9. ; writechar (<:(:>);
rl. w0 f21. ;
bs. w0 1 ; w0 := segm count - 1;
jl. w3 c4. ; writeinteger (<<d>, w0);
32<12 +1 ;
al w2 46 ;
jl. w3 c9. ; writechar (<:.:>);
zl. w0 i0. ; w0 := rel;
jl. w3 c4. ; writeinteger (<<d>, w0);
32<12 +1 ; writechar (<:):>);
al w2 41 ; end;
jl. w3 c9. ; end;
/, p2
l./a7:/, l./32<12 +6/, r/6/8/, r/dddddd/dddddddd/
l./i20=/, l-1, d./jl. w3 c9./, i#
rl. w0 f6. ; w0 := address;
\f
; fgs 1988.07.12 fp utility, print, page ...3b...
i20=k+1 ;
; jl. 2 ; (if octal)
jl. i22. ; skip;
jl. w3 c31. ; writeoctal (addr);
al w2 46 ;
jl. w3 c9. ; writechar (point);
rl. w0 f6. ; w0 := address;
i22=k+1 ;
; jl. 2 ; (if hex)
jl. i3. ; skip;
jl. w3 c33. ; writehex (addr);
al w2 46 ;
jl. w3 c9. ; writechar (point);
#, p-14
l./page 4/, r/rc 14.8.1969 /fgs 1988.07.12/
l./jl. a10./, r/a10./a52./
l./a10:/, i/
i26 = k + 1; hex ; print octal:
a52: sn w3 x3 ; if octal then
jl. a51. ; begin
rl. w0 f10. ; w0 := current word;
jl. w3 c31. ; write_octal (word);
i25 = k + 1; hex ; print hexadecimal:
a51: sn w3 x3 ; if hex then
jl. a10. ; begin
rl. w0 f10. ; w0 := current word;
jl. w3 c33. ; write_hex (word);
/, p-10
l./page ...5/, r/rc 1977.10.12 /fgs 1988.07.12/
l./se w1 0/, d./jl. a14./
l./sz w2 3<2/, d, i/
sz w2 3<2 ; if x-field <> 0 and
sn w1 0 ; displacement <> 0 then
jl. a55. ;
/, p-3
l./sh w1 -1/, r/ /a55: /
l./b2 =/, l2, i/
sz w2 3<2 ; if x-field <> 0 and
se w0 0 ; displacement = 0 then
jl. a56. ; begin
al. w0 g14. ; writetext (<:____:>);
jl. w3 c5. ; goto print right bracket;
jl. a14. ; end;
/
l./sh w0 -1/, r/ /a56: /
l./jl. w3 c4./, r/<<d>/<<dddd>/
l1, r/+1/+4/
l./rs. w0 f29./, r/f29./ f29./
l1, r/c4./c4. /
l./1<23+32<12+1/, r/+1/+9/, r/<<-d>/<<-dddddddd>/
l1, r/f29./f29. /
l2, r/2/2 /
l1, r/a6./i23./, r/increase number/hex/
l1, r/;/ ;/
l./jl. a6./, d,
i/
i23=k+1 ;
; jl. 2 ; (if hex)
jl. a6. ; goto increase number;
jl. w3 c33. ; writehex (final addr);
jl. a6. ; goto increase number;
/, p-5
l./page ...5a/, r/rc 1977.10.13 /fgs 1988.07.12/
l./al w1 9/, i/
al. w0 g12. ;
jl. w3 c5. ; outtext (out, <:8.:>);
/, p-3
l./al w1 9/, r/9 /-3/, r/9/-3/
l./i3:/, l2, i#
;procedure write_hex (value);
;
; call : return : saved in:
;
; w0 : value unch b0
; w1 : - unch b1
; w2 : - unch b2
; w3 : link unch b3
;
b. a10, b10 ;
w. ;
c33: ds. w1 b1. ; entry:
ds. w3 b3. ; save registers;
jl. w3 c3. ; outchar (out, sp);
al. w0 g13. ;
jl. w3 c5. ; outtext (<:16.:>);
al w0 -24 ; shifts := -24;
a0: rl. w2 b0. ; for shifts := shifts + 4
wa. w0 b4. ; while shifts <= 0 do
sl w0 1 ; begin
jl. a1. ; char :=
ls w2 (0) ; value shift shifts
la. w2 b6. ; 4;
zl. w2 x2+b5. ; hex :=
jl. w3 c9. ; hextable (char);
jl. a0. ; end;
a1: dl. w1 b1. ; restore registers;
dl. w3 b3. ;
jl x3 ; return;
b0: 0 ; saved w0
b1: 0 ; - w1
b2: 0 ; - w2
b3: 0 ; - w3
b4: 4 ; constant
b6: 2.1111 ; mask
h. ; hextable (0:15):
b5: 48, 49, 50, 51 ; 0, 1, 2, 3
52, 53, 54, 55 ; 4, 5, 6, 7
56, 57, 65, 66 ; 8, 9, A, B
67, 68, 69, 70 ; C, D, E, F
w. ;
i.
e. ; end block
#
l./page ...6/, r/85.03.26/88.07.12/
l./g9:/, l1, i/
g12: <:8.:> ;
g13: <:16.<0>:> ;
g14:<:<32><32><32><32>:>;
/, l1, p-3
l./c0:/, l./wa. w1 f9./, d1, i/
rl w0 x1-2 ; current word := word (current core relative - 2);
/, p-1
l./page 8/, r/rc 31.1.1974 /fgs 1988.07.14/
l./b4:/, r/numbering/limit violation/
l./b7:/, r/core/memory/
l./c25:/, l1, d./hs. w0 i0./, i/
ld w1 -9 ; current core relative := w0;
ls w1 -15 ; rel :=
hs. w1 i0. ; (w3, w0) extract 9;
ld w1 9 ;
ld w0 -9 ; segment :=
ba. w0 1 ; (w3, w0) shift (-9) +
rs. w0 f0. ; 1;
/, p-7
l./page ...8a/, r/rc 1976.03.11 /fgs 1988.07.22/
l./f30:/, r/14/h76/, r/16/h76+2/
l./page ...9/, r/rc 1977.09.14 /fgs 1988.07.12/
l./c.h57<3/, d./z./
l./page 10/, r/rc 7.7.1970 /fgs 1988.07.17/
l./al w0 0/, d./ds. w1 f3./, i/
al w0 0 ; from word := 0;
rl. w1 f11. ; to word := infinite ;
ds. w1 f3. ;
rl. w0 f31. ; from block := block base;
ds. w1 f5. ; to block := infinite ;
rs. w0 f7. ; block := block base;
al w3 0 ;
ld w0 9 ; total := double
wa. w0 f32. ; (block base < 9 +
ds. w0 f12. ; hwd base );
/, p-10
l./page ...11/, r/rc 1970.07.15 /fgs 1988.07.14/
l./al w1 0/, d./rs. w1 f5./, i/
rl. w1 f31. ; save pointer (field specification);
rs. w1 f4. ; from block := block base;
rs. w1 f5. ; to block := block base;
rs. w1 f7. ; block := block base;
rl w2 0 ; save w0;
al w0 0 ;
ld w1 9 ; total := double
wa. w1 f32. ; (block base < 9 +
ds. w1 f12. ; hwd base );
al w0 x2 ; restore w0;
rl. w2 g9. ; restore w2;
al w1 0 ;
/, p-11
l./a27:/, l./sn w1 4/, d1, i/
se w1 4 ; if w1 = 4 then
jl. a68. ; begin
rl. w0 x1+f2. ; from block :=
wa. w0 f31. ; from block +
rs. w0 x1+f2. ; block base;
rs. w0 f7. ; block :=
al w3 0 ; from block;
ld w0 9 ; total := block <
ds. w0 f12. ; 9;
rl. w0 x1+f2.+2 ; to block :=
wa. w0 f31. ; to block +
rs. w0 x1+f2.+2 ; block base;
jl. a28. ; goto execute;
a68: ; end;
/, p-7
l./page 11a/, r/rc 7.7.1970 /fgs 1988.07.17/
l./jl. w2 c25./, l-1, d1, i/
dl. w0 f12. ; begin
wa. w0 f2. ; (w3, w0) :=
jl. w2 c25. ; total + from word;
/, p1
l1, l./jl. w2 c25./, l-1, d, i/
dl. w0 f12. ; (w3, w0) :=
wa. w0 f3. ; total + to word;
/, p1
l1, l./jl. w2 c25./, l-1, d, i/
dl. w0 f12. ; (w3, w0) :=
wa. w0 b34. ; total + center address;
/, p1
l./a64:/, d
l./page 11b/, r/rc 16.7.1970 /fgs 1988.07.14/
l./a28:/, d, i/
a64: rl. w2 d0. ;
al w0 0 ;
rl. w1 f31. ;
rs. w1 f7. ; block := block base;
ld w1 9 ; total := double
wa. w1 f32. ; (block base < 9 +
ds. w1 f12. ; hwd base );
a28: al w3 x2 ; execute:
/, p-5
l./rs. w0 f7./, d1
l./page ...12/, r/rc 1977.10.13 /fgs 1988.07.21/
l./b19:/, d./b40:/, i#
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 ;
#
l./page ...12a/, r/rc 1977.10.13 /fgs 1988.07.12/
l./c30:/, l./rl. w1 b39./, d15, r/a31./a20./, i/
hs. w0 i26. ; octal := true; <*in write word*>
/
l./c18:/, i/
; hex:
c32: se w3 4 ; if next delim <> sp then
jl. a22. ; goto param error;
jl. w3 c14. ; clear format list;
al w0 2 ;
hs. w0 i22. ; hex := true; <*in write address*>
hs. w0 i23. ; hex := true; <*in write final addr*>;
hs. w0 i25. ; hex := true; <*in write word*>
jl. a20. ; goto scan parameterlist1;
/, p-10
l./page ...14/, r/rc 1977.09.26 /fgs 1988.07.12/
l./g10:/, d./g11:/, i#
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 ;
<:hex:>,0,0 , 0 , c32-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 ;
#, p-13
l./page ...15/, d b, i#
\f
; fgs 1988.07.12 fp utility, print, page ...15...
b28: <:s:> ;
b29: <:,xi:> ; replaces <:,ri:> in instr table in mpu
b35: <:connect out<0>:>;
e2: am -2000 ; initialize print:
rs. w1 f15.+2000 ;
am -2000 ;
rs. w2 f24.+2000 ; save top command;
am -2000 ;
rs. w3 f16.+2000 ; save fp base; save command pointer;
rl. w0 b29. ;
gg w3 2*17 ;
sl w3 60 ; if cpu ident >= 60 then
rs. w0 i24. ; replace <:,ri:> with <:,xi:> in instr.table;
al. w3 d5. ;
al w0 x3+510 ; first core := first free core;
am -2000 ;
ds. w0 f20.+2000 ; last core := first core + 510;
al w3 x3+512 ; comment: bs segment buffer;
am -2000 ;
rs. w3 f14.+2000 ; base bit group table := last core + 2;
am -2000 ;
rs. w3 f25.+2000 ; 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 ;
am -2000 ;
rs. w0 f28.+2000 ; secondary out := current out;
am -2000 ;
rl. w2 f16.+2000 ; w2 := command pointer(point);
\f
; fgs 1988.07.12 fp utility, print, page ...16...
bz w1 x2 ;
se w1 6 ; if delimiter = <=> then
jl. a37. ; begin
am -2000 ;
am. (f15.+2000);
jl w3 h29-4 ; stack current input;
am -2000 ;
rl. w2 f16.+2000 ;
al w2 x2-8 ;
am -2000 ;
rl. w3 f15.+2000 ;
al w1 x3+h20 ; zone := current in;
al w0 1<2+0 ; comment: one segm. , temporary;
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: am -2000 ;
rs. w1 f28.+2000 ; 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;
am -2000;
rl. w2 f16.+2000;
al w2 x2-8 ; w2:=name addr
am -2000 ;
am. (f15.+2000);
al w1 h54 ; w1:=lookup area
jl. w3 a65. ; prepare output
\f
; fgs 1988.07.12 fp utility, print, page ...17...
a44: am -2000 ;
rl. w2 f16.+2000 ;
a37: al w0 0 ; again:
am -2000 ;
hs. w0 i1.+2000 ;
am -2000 ;
rs. w0 f9.+2000 ;
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;
a43: am -2000 ;
rs. w2 f13.+2000 ; save pointer(area description);
bz w1 x2+1 ;
se w1 4 ; if param = integer then
jl. a66. ;
am -2000 ;
rs. w0 f27.+2000 ; current core relative := param;
am -2000 ;
rs. w0 f32.+2000 ; hwd base := param;
a66: 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
; fgs 1988.07.12 fp utility, print, page ...18...
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 ;
am -2000 ;
hs. w0 i1.+2000 ; 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;
al w1 1 ;
hs. w1 i27. ; first number read in memory area :=
hs. w1 i28. ; first number read in bs area := true;
jl. a38. ; goto test space;
a42: am -2000 ; area or process name:
rs. w2 f16.+2000 ;
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;
\f
; fgs 1988.07.12 fp utility, print, page ...19...
rl w2 0 ; proc := process descr addr;
rl w0 x2+22 ; first addr :=
wa w0 x2+98 ; proc.first logical + proc.base;
am -2000 ;
rs. w0 f27.+2000 ; current core relative := first address;
am -2000 ;
rs. w0 f32.+2000 ; hwd base := first address;
rl w1 x2+24 ; last addr :=
wa w1 x2+98 ; proc.top logical addr +
al w1 x1-2 ; proc.base - 2;
am -2000 ;
rs. w1 f8.+2000 ;
am 1 ; internal process := true;
a50: al w1 0 ; ready:
am -2000 ;
rl. w0 f32.+2000 ; w0 := current core relative; <* = first address*>
am -2000 ;
rx. w0 f9. +2000 ;
i27 = k + 1; first number read:
sn w3 x3 ; if first number read then
jl. a70. ; first number := if internal process then
se w1 0 ; first number + proc.first logical addr else
wa w0 x2+22 ; first number ;
am -2000 ; else
rx. w0 f9.+2000 ; first number :=
a70: rl w1 x2+24 ; current core relative;
al w0 0 ;
hs. w0 i17. ; blocked := false;
am -2000 ;
rl. w2 f16.+2000 ; restore command pointer;
jl. a48. ; restore command pointer; goto all1;
\f
; fgs 1988.07.12 fp utility, print, page ...20...
d11: am -2000 ; area:
am. (f13.+2000); w1 := tail := first free core;
al w3 2 ; w3 := addr(area name);
dl w1 x3+2 ;
am -2000;
ds. w1 f17.+2+2000; move name from
dl w1 x3+6 ; parameter stack
am -2000; to
ds. w1 f17.+6+2000; input description;
al. w1 d5. ;
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
; fgs 1988.07.12 fp utility, print, page ...21...
a46: am -2000 ; descriptor found:
zl. w0 i1.+2000 ;
sn w0 6 ; if content <> 6 <*segmented*> then
jl. a58. ;
zl w0 x1+16 ; content :=
am -2000 ;
hs. w0 i1.+2000 ; entry tail (16);
a58: rl w2 x1+14 ; blockno := entry tail (14);
zl w0 x1+16 ;
sh w0 31 ; if content >= 32 then
jl. a67. ; begin
rl w2 0 ; blockno :=
al w2 x2-32 ; content - 32;
a67: rl w0 x1 ; end;
sl w0 0 ; if tail(0) >= 0 then
jl. a47. ; goto prepare area process;
al w3 x1+2 ; w3 := addr(document name);
dl w1 x3+2 ;
am -2000;
ds. w1 f17.+2+2000; move name from
dl w1 x3+6 ; entry tail
am -2000; to
ds. w1 f17.+6+2000; input description;
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;
am -2000 ;
rs. w2 f31.+2000 ; blockbase := blockno;
rl w0 x1 ;
sh w0 -1 ; if entry tail.size < 0 then
jl. a46. ; goto descriptor found;
\f
; fgs 1988.07.12 fp utility, print, page ...22...
a47: am -2000 ; prepare area process:
al. w3 f17.+2000 ; prepare area process:
jd 1<11+52 ; create area process;
se w0 0 ; if result <> 0 then;
jl. d4. ; goto area alarm;
am -2000 ;
rl. w1 f11.+2000 ;
am -2000 ;
rs. w1 f5. +2000 ; to block := infinite ;
am -2000 ;
rl. w1 f31.+2000 ;
am -2000 ;
rs. w1 f4. +2000 ; from block := block base;
am -2000 ;
rs. w1 f7. +2000 ; block := blockbase;
ld w1 9 ; total := double
am -2000 ;
wa. w1 f32.+2000 ; (block base < 9 +
am -2000 ;
ds. w1 f12.+2000 ; hwd base );
am -2000 ;
bz. w0 i1. +2000 ;
i28 = k + 1; first number read:
sn w3 x3 ; if first number read
se w0 7 ; or content <> 7 then
jl. d12. ; goto start print;
al w0 0 ;
hs. w0 i17. ; blocked := false;
am -2000 ;
dl. w0 f12.+2000 ; (w3, w0) := total;
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 ; start print:
rl. w2 f16.+2000 ; restore command pointer;
al w0 1 ;
hs. w0 i14. ; bs area := true;
jl. a48. ; goto all1;
\f
; fgs 1988.07.12 fp utility, print, page ...23...
; procedure prepare entry for textoutput
; w0 not used
; w1 lookup area
; w2 name addr, entry must be present
; w3 return addr
b. a2 w.
a65: 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.
\f
; fgs 1988.07.12 fp utility, print, page ...24...
d1 = k - d0 , d5 = k, d6 = k + 512, d13 = k + 10
0 ; zero, to terminate program segment
m0 = k - h55 ; load length
m1 = e2 - h55 ; entry point
i. ; id list
e. ; end segment: print
m.rc 1988.11.21 fp utility, print
\f
; fgs 1988.07.12 fp utility, print, page ...25...
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:>
#
f
end
▶EOF◀