|
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: 72192 (0x11a00)
Types: TextFile
Names: »write2tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »write2tx «
; rc 75.11.04. list of pageheads; write(seg. ); page 0
; list of pageheads; write(seg. ); page 0
; definition of stack variables; write(seg. ); page 1
; start write; take the zone; write(seg.1); page 2
; take next formal; type switch; write(seg.1); page 3
; long; string; write(seg.1); page 4
; unpack layout; unpack string portion; write(seg.1); page 5
; boolean; long array; integer; write(seg.1); page 6
; real; return; kind error; write(seg.1); page 7
; start segment 2; explanation; write(seg.2); page 8
; conv. number: utility procedures; write(seg.2); page 9
; outchar; variables for conv. number; write(seg.2); page 10
; start number conversion; write(seg.2); page 11
; conv. number: generate digits; write(seg.2); page 12
; print digits before the point; write(seg.2); page 13
; print digits after the point; write(seg.2); page 14
; all spaces out for b-format; write(seg.2); page 15
; conv. real: const. and variables; write(seg.3); page 16
; real to number, exp10, and zeroes; write(seg.3); page 17
; real to number, exp10, and zeroes; write(seg.3); page 18
; print the exponent part; write(seg.3); page 19
; print the exponent part; write(seg.3); page 20
; prodedures outchar, -text, -integer; write(seg.4); page 21
; prodedures outchar, -text, -integer; write(seg.4); page 22
; prodedures outchar, -text, -integer; write(seg.4); page 23
; prodedures outchar, -text, -integer; write(seg.4); page 24
; prodedures outchar, -text, -integer; write(seg.4); page 25
; prodedures outchar, -text, -integer; write(seg.4); page 26
; prodedures outchar, -text, -integer; write(seg.4); page 27
; prodedures outchar, -text, -integer; write(seg.4); page 28
; definition of entry points; write(seg.4); page 29
; tails for catalog; write(seg. ); page 30
\f
; jz 81.06.23.. definition of stack variables; write(seg. ); page 1
;b. h100 ; outer block with fp names
b. g10,d15 w.
d.
p. <:fpnames:>
l.
s. a102,b69,c25,e39,f11,g34,i42,j56
w.
;constants
g0=68 ; number of reserved bytes
;stack variable and constant addresses relative to sref
i0= -g0 ;word ; param addr
i2= 4-g0 ;double word ; string; spaces remaining
i3= 6-g0 ;byte ; b )
i4= 7-g0 ; - ; h, ) must
i5= 8-g0 ; - ; d ) be
i6= 9-g0 ; - ; pnfn(rt.byte) consecutive
i7=10-g0 ; - ; s )
i8=11-g0 ; - ; pefe )
i9=12-g0 ;word ; spaces in layout
i10=14-g0 ;byte ; state: procedure < 6 +layouttype
; procedure = 1 means write
; - = 0 - writeint
; layouttype = 2.00 - no layout
; - = 2.01 - integer -
; - = 2.10 - real -
i11=15-g0 ;byte ; sign (character);
i12=16-g0 ;word ; following zeroes, new s
i13=18-g0 ; - ; exp10
i14=20-g0 ; - ; haddr
i15=8 ; - ; record base addr
i16=6 ; - ; partial word addr
i17=26-g0 ; - ; last formal addr
i18=28-g0 ; - ; last literal addr
i19=30-g0 ; - ; general return save
i20=32-g0 ; - ; boolchar
i21=34-g0 ; - ; remaining bits in spaceword
i22=22-g0 ;double ; character count
i23=24-g0 ;word ; error (1=false, -1=true)
i24=36-g0 ;word ; pointer, long array; daddr
i25=38-g0 ; - ; upper index, long array; digit base
i32=40-g0 ; leading space char
i33=41-g0 ; space in number char
i34=42-g0 ; positive sign char
i35=43-g0 ; negative sign char
i36=44-g0 ; decimal point char
i37=45-g0 ; exponent mark char
i38=46-g0 ; ending space
i39=47-g0 ; termination star
i40=48-g0 ; terminating sign (even=false, odd=true)
i41=49-g0 ; exponent sign
i42=51-g0 ; max char count
; now follow 15 bytes to hold digits of converted
; number part i.e. g0 must be >= 40 + 15;
; notice in the code below it is used that h3=0, that
; is that the address of base address = zone descriptor
; address
\f
; jz.fgs 1981.06.09 segment 0 write, page 1a
k = 0 , g1 = 0 ; no of externals = 0
h. ;
g31: g32 , g33 ; rel of last point , rel of last absword
j41: 1<11 + 1 , 0 ; segment 1 address
j42: g1 + 21 , 0 ; rs entry 21 : general alarm
j44: g1 + 13 , 0 ; rs entry 13 : last used
j45: g1 + 30 , 0 ; rs entry 30 : (saved sref, saved w3)
j46: g1 + 6 , 0 ; rs entry 6 : end register expression
j47: g1 + 4 , 0 ; rs entry 4 : take expression
j55: g1 + 29 , 0 ; rs entry 29 : param alarm
j48: 0 , 0 ; own core : own base
j52: 0 , e29 ; own core : outtable base
j53: 0 , e31 ; own core : outtable(lower index)
g33 = k - 2 - g31 ; rel of last abs word
j43: 1<11+0 , e19 ; alarm text point
g32 = k - 2 - g31 ; rel of last point
w. ;
f2: 0 ; start external list:
e28 ; no of owns to initialize = e28
h. ;
f11: 32, 32, 43 , 45; leading space, space in number, plus , minus
46, 39, 32 , 42; point , exp mark , ending sp, star
1, 1, 2.11<10, 0; std int layout: b=h=1, leading sp=1, rest=0
0, 32, 43 , 0;
w. ;
\f
; jz.fgs 1981.06.23 segment 0 write, page 1b
b61: e29 = k-f11 , 0 ; outtable base
b62: e30 = k-f11 , 0 ; upper index(outtable)
b63: e31 = k-f11 , 0 ; lower index(outtable)
b65: e33 = k-f11 , 0 ; outindex
e34 = k-f11 ; entry convert char:
sz w0 -1<8 ; convert char:
jl x1 ; if char shift (-8) <> 0
am. (b61.) ; then return;
sn w3 x3 ; if base = 0 then
jl x1+2 ; return 2;
hs. w0 b69. ; save char;
a101:wa. w0 b65. ; lookup: field := ( char + outindex )
ls w0 1 ; * 2;
sh. w0 (b62.) ; if field > upper field or
sh. w0 (b63.) ; field <=lower field
jl x1 ; then return0 (= skip char)
wa. w0 b61. ; entry := field + outtable base
rl w0 (0) ; w0 := class shift 12 + value;
hs. w0 b68. ; save value;
zl w0 0 ; w0 := class;
se w0 1 ; if class = 1 <* shift character *> then
jl. a102. ; begin
zl. w0 b68. ; outindex := value;
rs. w0 b65. ; goto lookup;
b69 = k + 1; saved char
al w0 0 ; w0 := saved char;
jl. a101. ; end;
b68 = k + 1; saved value
a102:al w0 0 ; w0 := value;
sz w0 -1<8 ; if conv char shift (-8) <> 0
jl x1 ; then return0 (= skip char)
jl x1+2 ; else return2 (= normal char)
e28 = k - f11 ; no of owns to initialize
s3 , s4 ; time and date
; end external list
e24: rl w1 0 ; zone alarm:
al. w0 b0. ; w1 := zone state;
jl. (j42.) ; general alarm(<:z. state:>);
b0: <:<10>z. state:> ;
e23: rl. w0 j43. ; kind error:
al w1 -1 ; w0 := alarm text point;
rs w1 x2+i23 ; error := -1;
rl. w3 (j41.) ;
jl x3+e25 ; goto long string (segment 1);
<:aram<10><0>:> ; alarm text: (stored backwords)
<:ite: p:> ;
<:<10>***wr:> ;
e19 = k - 2 ; address of string point
\f
; jz 1980.01.07 segment 0 write, page 1c
e27: rl. w2 (j44.) ; replace char:
ds. w3 (j45.) ; (saved w2,w3) := lastused,call
dl w1 x2+8 ; first param:
so w0 16 ;
jl. w3 (j47.) ;
ds. w3 (j45.) ;
rl w1 x1 ; charindex := w1 := value(first param);
al. w0 b67. ;
sl w1 0 ; if charindex < 0
sl w1 8 ; or charindex >= 8
jl. w3 (j42.) ; general alarm(<:replace:>);
wa. w1 j48. ; charaddr := charindex + ownbase;
rs w1 x2+6 ;
dl w1 x2+12 ; second param:
so w0 16 ;
jl. w3 (j47.) ;
ds. w3 (j45.) ;
rl w0 x1 ;
bl w1 (x2+6) ; replacechar:=w1:=core(charaddr);
hs w0 (x2+6) ; core(charaddr) := value(second param extract 8;
rl. w3 j48. ;
bz w0 x3+2 ;
hs w0 x3+14 ; plus in signtable := plus;
bz w0 x3+0 ;
hs w0 x3+13 ; space in signtable := leading space;
jl. (j46.) ; goto end reg. expression;
b67: <:<10>replace:>
\f
; jz.fgs 1981.06.09 segment 0 write, page 1d
e35: rl. w2 (j44.) ; entry outtable:
ds. w3 (j45.) ; (saved sref,saved w3) := (last used,return);
al w0 2.11111 ; type :=
la w0 x2+6 ; first word of param extract 5;
se w0 18 ; if type <> 18 them
jl. e36. ; goto check integer;
rl w1 (x2+8) ; integer array:
rs. w1 (j52.) ; outtable base := base word(array);
bl w1 x2+6 ; dope address :=
wa w1 x2+8 ; base word address + dope rel;
dl w1 x1 ; (upper,lower) of outtable :=
ds. w1 (j53.) ; dope vector(array);
jl. (j46.) ; goto end register expression;
e36: sn w0 10 ; check integer:
jl. e37. ; if type <> integer expression
se w0 26 ; and type <> integer variable
jl. w3 (j55.) ; then param alarm;
e37: al w0 0 ;
rs. w0 (j52.) ; outtable base := 0;
jl. (j46.) ; goto end register expression;
\f
; jz 1980.01.09 segment 0 write, page 1e
e7: rl. w2 (j44.) ; entry isotable:
ds. w3 (j45.) ; (saved sref,saved w3) := (last used,this seg);
rl w3 x2+8 ;
ba w3 x2+6 ; w3 := addr(dope vector(param));
al w1 0 ; check array bounds:
sh w1 (x3-2) ; if 0 > upper index
sh w1 (x3) ; or 0 <=lower index then
jl. a9. ; index alarm;
al w1 254 ;
sh w1 (x3-2) ; if 254 > upper index
sh w1 (x3) ; or 254 <=lower index then
jl. a9. ; index alarm;
rl w3 (x2+8) ; index := addr(array(0,...));
al w2 0 ; char := 0;
al w1 -2 ; table_index :=
rs. w1 b2. ; -1;
a6: sz w2 2.111 ; next char:
jl. a8. ; if char extract 3 = 0 then
rl. w1 b2. ; begin
al w1 x1+2 ; table_index := table_index + 1;
rs. w1 b2. ; entry := class_table(table_index);
rl. w1 x1+b1. ; end;
a8: al w0 0 ; class :=
ld w1 3 ; bits(0,2,entry);
hs w0 4 ; entry := entry shift 3;
rs w2 x3 ; array(index) := class shift 12 + char;
al w2 x2+1 ; char := char + 1;
al w3 x3+2 ; index := index + 1;
sz w2 2.1111111 ; if char extract 7 <> 0 then
jl. a6. ; goto next char;
\f
; jz 1980.01.09 segment 0 write, page 1f
al w1 8 ;
rl. w2 (j44.) ; restore w2;
rl w3 (x2+8) ;
hs w1 x3+19 ; array(10) := 8 shift 12 + 10;
hs w1 x3+23 ; array(12) := 8 shift 12 + 12;
hs w1 x3+49 ; array(25) := 8 shift 12 + 25; em;
jl. (j46.) ; goto end register expression;
b4: <:<10>index :>
a9: al. w0 b4. ; index alarm:
ls w1 -1 ;
jl. w3 (j42.) ;
; class table:
b1: 8.07777777, 8.77070077, 8.77777777, 8.70777777 ; 0 -31
8.77777775, 8.77737347, 8.22222222, 8.22777777 ; 32 - 63
8.76666666, 8.66666666, 8.66666666, 8.66666677 ; 64 - 95
8.76666666, 8.66666666, 8.66666666, 8.66666670 ; 96 -127
b2: 0 ; table_index
g34: c. g34 - 506,
m. seg. 0 code too long
z.
m. segment 0
c. 502-g34, 0, r.252-g34>1 z. ; fill segment
<:write:>,0,0
\f
; jz.fgs 1981.06.09. start write; take the zone; write(seg.1); page 2
k=0
h.
g2: g15, g3; rel. last point, rel. last abs word
j0: g1+30 , 0 ; rs entry 30, save sref
j1: g1+ 3 , 0 ; - 3, reserve
j3: g1+ 4 , 0 ; - 4, take expression
j4: g1+13 , 0 ; - 13, last used
j5: g1+16 , 0 ; - 16, seg table base
j7: g1+ 6 , 0 ; - 6, end reg expr
j24: g1+60 , 0 ; - 60, last of segment table
j8: 1<11+1, 0 ; seg. 2 addr
j9: 1<11+2, 0 ; seg. 3 addr
j10: 1<11 o. (:-1:),0 ; seg. 0 addr
j36: 0 , 3 ; own core: fillchars(1:4);
j37: 0 , 7 ; own core: fillchars(5:8);
j23: g1+46 , j30 ; rs entry 46, float long, chain for rel
g3=k-g2-2
g15=k-g2-2
w.
f3:
e0: am 1<6 ; entry write: state := 1<6; skip next;
e18:al w0 0 ; entry writeint: state := 0;
rl. w2 (j4.) ; write(z, any number of variables
ds. w3 (j0.) ; or expressions);
al w1 -g0-6 ; w2:=saved sref:=last used;
jl. w3 (j1.) ; reserve local variables;
al w1 x1+6 ; check room for 3 words for
rs. w1 (j4.) ; take expression(outblock);
hs w0 x2+i10 ; save state
dl. w1 (j36.) ; move fillchars
ds w1 x2+i35 ;
dl. w1 (j37.) ; to
ds w1 x2+i39 ; stack;
al w0 0 ; initialize char count
al w1 1 ;
ds w1 x2+i23 ; char count :=0; error:=1;
al w1 -1 ;
rs w1 x2+i42 ; maxcount := -1;
rl w1 x2+8 ; get zone formals: w1:=zone descr;
rl w0 x1+h2+6 ; w0:=zone state;
se w0 3 ; if zone state=after write
sn w0 0 ; or zone state=after open
jl. a2. ; then goto zone addr;
rl. w3 (j10.) ;
jl w3 x3+e24 ; goto zone alarm (segment 0)
a2: al w0 x1+h2+4 ; partial woerd addr:=
rs w0 x2+i16 ; zone descr+h2+4;
al w0 3 ; zone state:=
rs w0 x1+h2+6 ; after write;
al w1 x2+9 ; init formal count:
rs w1 x2+i17 ; last formal addr:=2nd word of
ba w1 x2+4 ; first formal addr;
al w1 x1-2 ; last literal addr:=1st word of
rs w1 x2+i18 ; first formal addr+appetite;
\f
; jz 79.01.30. take next formal; type switch; write(seg.1); page 3
c25:al w3 0 ; take formal1: w3:=0;
e13:rs w3 x2+i19 ; save state after boolean
rl w1 x2+i17 ;
al w1 x1+4 ; w1:=last formal addr+4;
sl w1 (x2+i18) ; if w1>=last literal addr
jl. e2. ; then goto end write;
rs w1 x2+i17 ; check formal: save last formal addr;
dl w1 x1 ; w01:=formal;
al w3 2.11111; kind:= first formal
la w3 0 ; extract 5
sn w3 20 ; if kind = 20 then
jl. c6. ; goto long array;
sl w3 16 ; if (kind > 16
sl w3 23 ; and kind <= 23)
sn w3 0 ; or kind = 0
jl. e4. ; then goto kind error
so w0 16 ; if expression
jl. w3 (j3.) ; then take expression;
ds. w3 (j0.) ; w2:=saved sref;
a21:sl w1 (x2+i17) ; if last formal addr<
sl w1 (x2+i18) ; abs addr of result<
jl. a0. ; last literal addr
rs w1 x2+i18 ; then last literal addr:=abs addr;
a0:rs w1 x2+i0 ; param addr:=abs addr;
al w3 7 ; type switch:
am (x2+i17) ; w3:=type;
la w3 -2 ;
sl w3 5 ; if type>=5
jl. e4. ; then goto kind error
ls w3 1 ; type:=2*type;
am (x2+i19) ; if general return<>0 then
jl. a61. ; goto after boolean return (a17)
a61:jl. x3+a1. ; else goto case(type) of
a1:jl. c0. ; string,
jl. c3. ; boolean,
jl. c4. ; integer,
jl. c5. ; real,
; long;
\f
; jz 79.01.30. long; string; write(seg.1); page 4
dl w1 x1 ; long: w0w1 := long;
bz w3 x2+i10 ; if state = real layout
so w3 1<6+1<1 ; and procedure = write then
jl. a18. ; begin
rl. w3 ( j23.) ; convert long
jl w3 x3+0 ; goto real jump;
j30=k-1 ; comment chain for rel;
jl. a25. ; end;
a18:rl w3 x2+i17 ; number taken:
ds w1 x3 ; formal(last formal) := number;
rs w3 x2+i0 ; param addr := last formal;
rl. w3 ( j8.) ; goto integer
jl x3+e5 ; on segment 2;
e25: ; entered from segment 0 (kind alarm)
c1:rl w3 0 ; long string: w3:=addr bytes;
a5:rs w3 x2+i0 ; save addr bytes:
hs. w3 a22. ; store rel addr;
bz w3 6 ; w3:=2*seg. table entry
ls w3 1 ; +seg. table base;
wa. w3 (j5.) ;
rl. w1 (j24.) ;
sl w3 x1 ; if w3 >= last of segment table
jl. e4. ; then kind error
rl w3 x3 ; w3:=seg. table word;
a22=k+1
dl w1 x3 ; w01:=string words;
sh w1 -1 ; if w1=string pointer
jl. c1. ; then goto long string;
jl. w3 e12. ; unpack string;
rl w3 x2+i0 ; w3:=seg. number shift 12
al w3 x3-4 ; +rel addr-4;
jl. a5. ; goto save addr bytes;
c2: jl. w3 e12. ; short string: unpack string
dl w1 (x2+i17) ; take string formal
sz w0 16 ; if not expression
jl. e1. ; then goto take formal
jl. w3 (j3.) ; take expression
ds. w3 (j0.) ; save sref
c0: dl w1 x1 ; string: take portion
c7: sh w1 -1 ; if long string
jl. c1. ; then goto long string
sl w0 0 ; if short string
jl. c2. ; then goto short string
; else continue unpack layout;
\f
; jz 79.01.30. unpack layout; unpack string portion; write(seg.1); page 5
; unpack layout:
rs w0 x2+i9 ; spaces in layout := first layoutword;
al w0 0 ;
ld w1 6 ; b := b-bits;
hs w0 x2+i3 ;
al w0 0 ;
ld w1 4 ;
hs w0 x2+i4 ; h := h-bits;
bs w0 x2+i3 ;
sn w0 0 ; if h-b = 0 and
sz. w1 ( b10.) ; d = s = pefe = 0 then
am 1<1-1 ; newstate := integer layout
al w3 1 ; else newstate := real layout;
bz w0 x2+i10 ;
sz w0 1<6 ; if state = in writeinteger then
al w3 x3+1<6 ; state := newstate else
hs w3 x2+i10 ; state := newstate + 1<6;
al w0 0 ;
ld w1 4 ;
hs w0 x2+i5 ; d := d-bits;
al w0 0 ;
ld w1 4 ;
hs w0 x2+i6 ; pnfn := pnfn-bits;
al w0 0 ;
ld w1 2 ; s := s-bits;
hs w0 x2+i7 ;
ls w1 -20 ; pefe := pefe-bits;
hs w1 x2+i8 ;
jl. c25. ; goto take formal1;
b10: 2.1111 0000 11 1111 < 10; mask to determine if layout is integer
; d pnfn s pefe ; the selected bits must be null.
e12:rs w3 x2+i13 ; procedure unpack string
ac. w3 a7. ; relative return:=
wa w3 x2+i13 ; -abs addr of a7
rs w3 x2+i13 ; + abs addr of return
a7: ds w1 x2+i2 ; repeat : rest:=string
ls w0 -16 ; char:=rest.first part shift(-16)
sn w0 0 ; if char = 0
jl. e1. ; then goto take formal
rl. w3 ( j8.) ;
jl w3 x3+e15 ; outchar(char)
ds. w3 (j0.) ; save sref
dl w1 x2+i2 ; string:=rest
ld w1 8 ; shift 8 add 255
a50:al w1 x1+2.11111111; nb! mask 8 bits;
sn w0 -1 ; if string = -1
am (x2+i13) ; then return
jl. a7. ; else goto repeat
\f
; jz 1979.08.15 boolean; long array; integer; write(seg.1); page 6
c3:bz w0 x1 ; boolean:
hs w0 x2+i20 ; boolchar:=boolean parameter extract 8;
al w3 a62 ; w3:=after boolean rel. ret.
jl. e13. ; after boolean;
a17:rl w1 x1 ; w1:=index:=new param;
a62=a17-a61
se w3 4 ; if param type<>integer
jl. e4. ; then goto kind error;
bl w0 x2+i20 ;
sl w0 0 ; if boolchar >= 0
jl. a16. ; then goto index test;
wa w1 x2+i22 ;
rs w1 x2+i42 ; maxcount := index+charcount;
jl. c25. ; goto take formal1;
e1: bz w0 x2+i38 ; take formal:
hs w0 x2+i20 ; boolchar := ending space;
al w1 -1 ; index :=
rx w1 x2+i42 ; maxcharcount - charcount;
ws w1 x2+i22 ; maxcharcount := -1;;
sh w0 255 ; if boolchar>255 then goto formal1
a16:sh w1 0 ; index test: if index<=0
jl. c25. ; then goto take formal1;
al w1 x1-1 ; index:=index-1;
rs w1 x2+i13 ; save index;
bz w0 x2+i20 ; load boolchar;
la. w0 a50. ; char := boolchar extract 8;
rl. w3 ( j8.) ;
jl w3 x3+e15 ; outchar;
ds. w3 (j0.) ; save sref
rl w1 x2+i13 ; load index;
jl. a16. ; goto index test;
c6: rl w3 x1 ; long array:
sh w1 (x2+i18) ; if baseword addr <= last litteral addr
rs w1 x2+i18 ; then last litteral addr := baseword addr;
ba w1 0 ;
al w0 x1-2 ; if dope addr - 2 <=
sh w0 (x2+i18) ; last litteral addr then
rs w0 x2+i18 ; last litteral addr := dope addr - 2;
dl w1 x1 ; if lower index > 1
sl w1 2 ; then goto kind error;
jl. e4. ;
wa w0 6 ;
al w3 x3+3 ; pointer := baseword + 3;
ds w0 x2+i25 ; upper bound := upper index + baseword;
a24:rl w3 x2+i24 ; while upper index not reached do
sl w3 (x2+i25) ; begin
jl. e1. ; comment exit to take formal;
al w3 x3+4 ; pointer := pointer + 4;
rs w3 x2+i24 ;
dl w1 x3-3 ; text portion := element (pointer - 3);
sl w0 0 ; if first word < 0
sh w1 -1 ; or second word < 0 then
jl. c7. ; goto string, portion taken;
jl. w3 e12. ; unpack string;
jl. a24. ; end;
; goto take formal;
c4: rl w1 x1 ; integer:
bz w0 x2+i10 ; take number;
so w0 1<6+1<1 ; if real layout and procedure is write then
jl. a19. ; begin convert integer to real;
ci w1 0 ; goto real taken;
jl. a25. ; end;
a19:bl w0 2 ; extend integer;
bl w0 0 ;
jl. a18. ; goto number taken;
\f
; rc 75.11.04. real; return; kind error; write(seg.1); page 7
c5: bz w0 x2+i10 ; real:
so w0 1<6 ; if procedure not write then
jl. e4. ; goto kind error;
dl w1 x1 ; take number;
a25:rl. w3 ( j9.) ; real taken:
jl x3+e6 ; goto real on segment 3;
e2:rl w0 x2+i19 ; end write: wo:=general return;
se w0 0 ; if general return<>0
jl. e4. ; then goto kind error;
rl w1 x2+i15 ;
rs w0 x1+h3+4 ; record length:=0
rl w1 x2+i23 ;write:=
wm w1 x2+i22 ; charcount*error
rs. w2 (j4.) ; last used:=sref;
jl. (j7.) ; end reg expr;
e4: rl. w3 (j10.) ; kind error:
jl x3+e23 ; goto kind error on segment 0;
g8:
c. g8-506,
m. seg. 1 code too long
z.
m. segment 1
c. 502-g8, 0, r. 252-g8>1
z.
g11:<:write:>,0,0
\f
; jz 80.01.07. start segment 2; explanation; write(seg.2); page 8
k=0 ; start segment 2;
h.
g4: g7 , g5 ; headword: last point, last absword;
j11: -1 , 0 ; segment 1 address
j12: 1<11+1 , 0 ; segment 3 address
j13: g1+30 , 0 ; rs entry 30, save sref,w3;
j38: 0 , 11 ; own core: std int layout, sign table(0:3);
j49: 0 , e34 ; own core: entry convert char
j16: g1+ 4 , 0 ; rs entry 4, take expression;
g5=j16-g4 ; last absword;
j18: g1+35 , 0 ; rs entry 35, outblock;
g7=j18-g4 ; last point;
w.
;explanation of integer write:
; this code is also used to write reals after they have been converted
; to one binary long, representing the significant digits, and two binary
; integers giving the ten's exponent to be used, and the number of un-
; used digit positions following the number part.
; in case of realy integer write, the ten's exponent and the following
; zero positions are set to null.
; the significant digits of the - possibly long - integer are generated
; from the least significant end, and stored into the stack in the positions:
; sref-1, sref-2, ... etc.
; when the conversion has been made, the stack variable digit base points
; at the position just before the most significant digit.
; a logical position of the decimal point, daddr, is calculated as
; daddr = sref + following zeroes - d.
; the logical position in which printing starts is called haddr, and it
; is calculated as haddr = min ( daddr + h, base + 1).
; the logical position where printing ends is always sref - 1 + following
; zeroes;
; now, starting with the first logical position and ending with the last
; logical position, all positions before base+1 are printed as either null
; or space, depending on the layout. all positions between base+1 and sref-1
; are printed as converted digits, and all positions after sref-1 are
; printed as null if they come before daddr and as space otherwise.
; during the printing, sign, decimal point, and intermediate spaces are
; output according to the layout. the conversion of a possible exponent
; part is explained on segment 3.
\f
; jz 80.01.08 conv. number: utility procedures; write(seg.2); page 9
e9: ac. w0 g4. ; procedure outdigit:
wa w3 0 ; rel of return :=
rs w3 x2+i19 ; abs return - segment base;
al w0 x1+48 ;
jl. w3 e15. ; comment make return relative on this segment;
ds. w3 (j13.) ; char := digit + 48; outchar;
rl w1 x2+i21 ;
ls w1 1 ; bitword := bitword shift 1;
rs w1 x2+i21 ;
bz w0 x2+i33 ; char := space in number;
sh w1 -1 ; if bitword < 0 then
jl. w3 e15. ; outchar;
ds. w3 (j13.) ;
c15: am (x2+i19) ; general return on this segment:
jl. g4. ; goto segment start + relative return;
e26: al. w3 c14. ; outspaces as digits: (called from segment 3)
; set return(end number);
e17: rl w0 x2+i21 ; procedure outspaces as digits:
rs w3 x2+i19 ; save return;
al w3 x1 ; call: w1>0: digit positions, w3=return on this seg;
a13: ls w0 1 ; i := digit positions;
sh w0 -1 ; repeat
al w1 x1+1 ; bitword := bitword shift 1;
al w3 x3-1 ; if bitword < 0 then
sl w3 1 ; digit positions := digit positions + 1;
jl. a13. ; i:= i- 1;
rl w3 x2+i19 ; until i < 1;
rs w0 x2+i21 ; spaces := digit positions;
e14: am i32-i38; outspaces: boolchar := leading space else
e22: bz w0 x2+i38 ; ending spaces: boolchar := endingspace;
c23: hs w0 x2+i20 ; spaces: save boolchar;
ac. w0 g4. ; rel of return :=
wa w3 0 ; abs return - segment base;
rs w3 x2+i19 ; comment make return relative on this segment;
a12: al w1 x1-1 ; for spaces := spaces - 1 while spaces > -1 do
sh w1 -1 ;
jl. c15. ; begin
rs w1 x2+i2 ; comment ends via general return;
bz w0 x2+i20 ; char := boolchar;
jl. w3 e15. ; outchar;
ds. w3 (j13.) ;
rl w1 x2+i2 ; end;
jl. a12. ; goto general return on this segment;
\f
; jz 80.01.07 outchar; variables for conv. number; write(seg.2); page 10
e15: jl. w1 (j49.) ; outchar: char := convert char(char);
jl x3+2 ; if char<0 or char > 255 then return;
rl w1 x2+i22 ; check count:
sn w1 (x2+i42) ; if charcount=maxcharcount then
jl. e11. ; goto finis;
hs. w0 b9. ; save char;
al w1 x1+1 ; charcount :=
rs w1 x2+i22 ; charcount + 1;
sn w1 (x2+i42) ; if charcount=maxcharcount then
bz w0 x2+i39 ; char := star; (alarmprint)
sh w0 255 ; if char <= 255 then
hs. w0 b9. ; save char;
rl w1 (x2+i16) ; pack char:
al w0 0 ; w0 := 0;
ld w1 8 ; partial word :=
b9=k+1; saved char ; partial word shift 8
al w1 x1+0 ; + saved char;
rs w1 (x2+i16) ;
se w0 1 ; if partial word not full
jl x3+2 ; then return;
rx w0 (x2+i16) ; next word:
rl w1 (x2+i15) ; record base := record base + 2;
al w1 x1+2 ; buffer(record base) := partial word;
rs w0 x1 ; partial word := 1;
rs w1 (x2+i15) ;
am (x2+i15) ;
sl w1 (2) ; if buffer not filled
jl. a10. ; then goto return + 2;
jl x3+2 ;
; next block:
a10: rl w0 x2+i15 ; w0 := zone shift 4;
ls w0 4 ; w1 := outblock;
rl. w1 j18. ; take expression and return directly to
jl. (j16.) ; outchar return;
; constants and variables in convert long integer:
b30: 1<23 ; constant to test for -2**47;
b51: 10 ; ten
b52: 20 ; twenty;
-10 ; pair used in long div:
b53: 1 ; (-10, 1);
\f
; jz 79.01.18. start number conversion; write(seg.2); page 11
e5: bz w3 x2+i10 ; convert integer:
sz w3 2.11 ;
jl. a63. ; if state = no layout then
dl. w0 (j38.) ; begin
ld w1 -24 ;
ds w0 x2+i6 ; layout := unpacked << d>
ds w1 x2+i9 ; end;
dl w1 (x2+i0) ;
a63: al w3 2.11 ; comment it is used here that pnfn
la w3 x2+i6 ; is a right hand byte;
am. (j38.) ;
bz w3 x3+1 ; sign := leading char for
sh w0 -1 ; positive numbers (pefe extract 2);
bz w3 x2+i35 ; if number is negative then
hs w3 x2+i11 ; sign := -;
sn. w0 (b30.) ; a:=number;
se w1 0 ; if a <> -2**47
sl w0 0 ; and a < 0 then
jl. a64. ; a := -a;
ld w1 -100 ; comment beware of overflow
ss w1 (x2+i0) ;
ds w1 (x2+i0) ; number := a;
a64: ld w1 -100 ; zeroes := 0;
ds w1 x2+i13 ; exp10 := 0;
e20: al w0 2.11111 ; start for reals:
la w0 x2+i9 ; max := spaceword extract 5;
wa w0 x2+i22 ;
se w0 (x2+i22) ; if max <> 0 then
rs w0 x2+i42 ; maxcount := max + charcount;
al w0 -64 ;
la w0 x2+i9 ; remaining bits in space word :=
ns w0 3 ; normalized spaces in
ls w0 1 ; bits(0,22,layout) shift 1;
rs w0 x2+i21 ; leading spaces :=
bl w1 3 ; -normalization(spaces in layout);
ac w1 x1 ;
jl. w3 e14. ; outspace(leading spaces);
dl w1 (x2+i0) ;
sn w1 0 ;
se w0 0 ; if number = 0 then
jl. a65. ; begin
bz w3 x2+i6 ; if first letter = b then
so w3 2.1100 ; goto all spaces out(segment 3);
jl. a65. ;
hs w0 x2+i11 ; sign := 0;
rl. w3 (j12.) ;
jl x3+c16 ; end;
a65: al w3 x2-1 ; digit index := sref -1;
\f
; jz 1980.01.08 conv. number: generate digits; write(seg.2); page 12
;long division:
; w0 w1 w3
; a = ( a1 , a2 )
; -- -- 0
; a1 // 10 , -- a1 mod 10
; a3= (a1 mod 10 , -- ) a1 // 10
; a3 mod 20 , a3 // 20 --
; -- 2*(a3//20) --
; if >= 10 then
; a3 mod 10 a3 // 10 --
; ( a//10 ) a mod 10
a66: rs w3 x2+i25 ; long division:
sn w0 0 ; if not long then
jl. a67. ; goto short division;
al w3 0 ; digit := a mod 10;
wd. w0 b51. ;
rx w3 0 ; a := a//10;
wd. w1 b52. ;
ls w1 1 ;
sl w0 10 ; stack (digit index) := digit;
aa. w1 b53. ;
rx w3 0 ; digit index := digit index - 1;
hs w3 (x2+i25) ;
rl w3 x2+i25 ;
al w3 x3-1 ; goto long division;
jl. a66. ;
a67: sn w1 0 ; short division:
jl. a68. ; while a <> 0 do
al w0 0 ; begin
wd. w1 b51. ; stack (digit index) := a mod 10;
hs w0 x3 ; a := a // 10;
al w3 x3-1 ; digit index := digit index - 1;
jl. a67. ; end;
a68: rs w3 x2+i25 ; digit base := digit index;
al w1 x2 ;
wa w1 x2+i12 ; daddr := sref + zeroes - d;
bs w1 x2+i5 ; comment the decimal point is to be
rs w1 x2+i24 ; placed just before daddr;
bs w1 x2+i4 ; haddr := min(daddr-h,
sl w1 x3+1 ; base +1);
al w1 x3+1 ; comment this will yield at least one
rs w1 x2+i14 ; position before the point;
bz w3 x2+i6 ; switch on first letter:
ls w3 -2 ; goto case pn + 1 of
bl. w3 x3+c12. ; ( dandb, f, z, dandb);
c8: jl. x3 ; comment integer zero and b sorted out;
\f
; jz 79.06.20. print digits before the point; write(seg.2); page 13
c9: jl. w3 c21. ; f:
ds. w3 (j13.) ; printsign;
c10: dl w1 x2+i25 ; dandb:
rl w3 x2+i14 ;
sl w3 x1+1 ; if haddr < base + 1 then
jl. c11. ; begin
sl w0 x1+2 ; if daddr < base + 1
jl. a69. ; then
rl w1 0 ; leading := daddr - haddr - 1
al w1 x1-2 ; else
a69: ws w1 6 ; leading := base - haddr + 1;
al w1 x1+1 ; if leading > 0 then
wa w3 2 ; begin
sh w1 0 ; haddr := haddr + leading;
jl. c11. ; outspace as digits(leading);
rs w3 x2+i14 ; end;
jl. w3 e17. ; end;
c11: jl. w3 c21. ; z:
ds. w3 (j13.) ; printsign;
a71: rl w3 x2+i14 ; zout:
sl w3 (x2+i24) ; while haddr < daddr do
jl. a72. ; begin
al w3 x3+1 ; haddr := haddr + 1;
rs w3 x2+i14 ; digit := stack(haddr-1);
bz w1 x3-1 ;
am (x2+i25) ; if haddr <= base
sl w3 +2 ; or haddr > last digit
sl w3 x2+1 ; then
al w1 0 ; digit := 0;
jl. w3 e9. ; outdigit(digit);
jl. a71. ; end;
\f
; jz 79.01.18. print digits after the point; write(seg.2); page 14
a72: bz w3 x2+i5 ; if d <> 0 then
sn w3 0 ; begin
jl. a44. ;
bz w0 x2+i36 ; outchar(decimal point);
jl. w3 e15. ;
ds. w3 (j13.) ;
a73: rl w3 x2+i14 ; while haddr < sref do
sl w3 x2 ; begin
jl. a43. ;
bz w1 x3 ; digit := stack(haddr);
sh w3 (x2+i25) ; if haddr <= digit base then
al w1 0 ; digit := 0;
al w3 x3+1 ;
rs w3 x2+i14 ; haddr := haddr + 1;
jl. w3 e9. ; outdigit(digit);
jl. a73. ; end;
a43: rl w1 x2+i12 ;
ac w3 x2 ; zeroes := if daddr > sref
wa w3 x2+i24 ; then zeroes
sl w3 1 ; else zeroes - daddr + sref;
ws w1 6 ; if zeroes > 1 then
sl w1 1 ; outspace as digits(zeroes);
jl. w3 e17. ; end;
a44: bz w1 x2+i7 ; if s <> 0
lo w1 x2+i13 ; or exp10 <> 0 then
rl. w3 (j12.) ; goto print exp
se w1 0 ; on segment 3
jl x3+e10 ; else end number:
\f
; jz 79.01.30. write(seg.2); page 15
e21:
c14: bz w0 x2+i6 ; end number:
ls w0 -2 ;
se w0 1 ; if pn <> 1 <* f *> then
jl. c24. ; goto print ending sign;
rl w1 x2+i42 ; fill:
ws w1 x2+i22 ; count :=
al w1 x1-2 ; maxcount - charcount - 2;
jl. w3 e22. ; outspace(count,ending space);
c24: jl. w3 c22. ; print ending sign:
ds. w3 (j13.) ; printsign1;
e11: rl. w3 (j11.) ; finis:
jl x3+e1 ; goto take formal on segment 1;
c21: rl w0 x2+i9 ; print sign:
sz w0 1<5 ; if front sign not wanted
jl x3+2 ; then return;
c22: bz w0 x2+i11 ; printsign1:
sn w0 0 ; if sign = 0 then
jl x3+2 ; return;
al w1 0 ; char := sign;
hs w1 x2+i11 ; sign := 0;
jl. e15. ; goto outchar;
h. ; switch on first letter pn:
c12: c10-c8, c9-c8 ; d, f,
c11-c8, c10-c8 ; z, b;
w.
g9: c. g9-506
m. segment 2: code too long
z.
m. segment 2
c. 502 - g9, 0, r. 252 - g9 > 1
z.
<:write:>, 0, 0 ; alarm text
\f
; jz.fgs 1981.06.09. conv. real: const. and variables; write(seg.3); page 16
k=0
h.
g6: g16, g16; rel. last point, rel. last abs word
j14: -1, 0; seg. 2 addr
j39: 0, 12; own core: sign table(0:3);
j15: g1+30, 0; rs entry 30, save sref
g16=k-2-g6
1024, 0;
b25: 0, 0; 0.5
1024, 0;
b17: 0, 1; 1
1280, 0;
b24: 0, 4; 10**(2**0)
1600, 0;
0, 7; 10**(2**1)
1250, 0;
0, 14; 10**(2**2)
1525, 3600;
0, 27; 10**(2**3)
1136, 3556;
3576, 54; 10**(2**4)
1262, 726;
3393, 107; 10**(2**5)
1555, 3087;
2640, 213; 10**(2**6)
1181, 3363;
3660, 426; 10**(2**7)
1363, 3957 ;
4061, 851 ; 10**(2**8)
1816, 3280 ;
b20: 1397, 1701 ; 10**(2**9)
b21=b24+44
b18=b24+88
b14: 0, 9, 99, 999 ; exp limits
w.
b16: 0; new zeroes
b15: 0; exp10 and also nlim
b19: -1233; -l=-entier(log 2*2**12)
0;
b3: 0; real
e6: ds. w1 b3. ; convert real: save real;
bz w3 x2+i10 ;
sz w3 2.11 ;
jl. a40. ; if state = no layout then
dl. w1 b40. ;
ds w1 x2+i6 ; layout :=
dl. w1 b41. ; << -dd.dddd>;
ds w1 x2+i9 ;
rl. w0 b3.-2 ; comment it is now used that
a40:al w3 2.11 ; pnfn is a right hand byte;
la w3 x2+i6 ;
am. (j39.) ;
bz w3 x3 ; sign := leading char for positive
sh w0 -1 ; numbers(pefe extract 2);
bz w3 x2+i35 ; sign := negative sign;
hs w3 x2+i11 ; sign := <minus>;
\f
; rc 75.11.04. real to number, exp10, and zeroes; write(seg.3); page 17
sn w0 0 ; if number = 0 then
jl. e3. ; goto real zero;
bl w1 x2+i7 ; w1:=s;
bl. w1 x1+b14. ; w1:=10**s;
al w3 1 ;
bs w3 x2+i3 ;
sh w3 -12 ; w3 := 1 +
al w3 -11 ; if b <= 12
ba w3 x2+i5 ; then d + h - b
ba w3 x2+i4 ; else d + h - 12;
al w0 0 ; w0:=0;
ds. w0 b15. ; nlim:=0; new zeroes:=zeroes+1;
al w3 x1 ; w3:=10**s;
wd. w1 b16. ; w0:=(10**s)mod new zeroes
ws w0 6 ; -10**s+1
bs w0 x2+i5 ; -d;
hs. w0 b15. ; nlim:=w0;
bl w0 x2+i3 ; w0:=
sl w0 13 ; if b<=12 then b
al w0 12 ; else 12
dl. w3 b17. ; w23:=1;
al w1 -1 ; w01:=first sig. bit of b;
ns w0 3 ; w1:=bit no.:=no.sig.bits-23;
as w1 2 ; w1:=4*bit no.;
a27:ls w0 1 ; shift bits:
sh w0 -1 ; if bit=1
fm. w3 x1+b18. ; then w23:=w23*10**(2**(bit no.+22));
al w1 x1-4 ; bit no.:=bit no.-1;
sl w1 -88 ; if bit no.>=-22
jl. a27. ; then goto shift bits;
; comment: w23=10**b;
dl. w1 b3. ; w01:=real;
ds. w3 b3. ; number:=10**b;
bl w3 7 ;
bs w3 3 ; w3:=(newexp-exp-2)
al w3 x3-2 ; *(-l)*2**12;
wm. w3 b19. ; comment: 0<(log2-l)<0.000005;
sh. w3 (b15.) ;
rl. w3 b15. ; w3:=max(w3, nlim*2**12);
rs. w3 b15. ; nlim:=entier(max((exp-newexp+2)*l, nlim));
al w2 -1 ; w3(1):=first sig. bit of n;
ns w3 5 ; w2:=bit no.:=no.of sig.bits-11;
as w2 2 ; w2:=4*bit no.;
sh w3 -1 ; if n<0
jl. a28. ; then goto multiply;
sh w2 -48 ;
al w2 -44 ; bit no.:=max(bit no., -11);
sh w2 -8 ; if bit no.>-2
jl. a29. ; then begin
fd. w1 b20. ; w01:=w01/10**(2**9);
am -4 ; end;
a29:fd. w1 x2+b21. ; w01:=w01/10**(2**(bit no.+11));
\f
; rc 79.03.06. real to number, exp10, and zeroes; write(seg.3); page 18
a28:al w2 x2-4 ; multiply: bit no.:bit no.-1;
sh w2 -48 ; if bit no.=-12
jl. a30. ; then goto next;
ls w3 1 ; w3(0):=next bit;
sl w3 0 ; if bit=0
fm. w1 x2+b21. ; then w01:=w01*10**(2**(bit no.+11));
jl. a28. ; goto multiply; wo1=real*10**(2**(-n-1));
a30:sl w0 0 ; next: if w01<0
jl. a31. ; then
ld w3 50 ; begin
fs w3 2 ; w23:=0;
ds w3 2 ; w01:=-w01 end;
a31:dl. w3 (j15.) ; w2:=sref;
bl. w3 b15. ; w3:=n;
ba w3 x2+i5 ; w3:=n+d;
hs. w3 b15. ; n:=n+d;
dl. w3 b3. ; w23:=number;
ds. w1 b3. ; digits:=w01;
fm. w1 b24. ; w01:=10*digits;
fa. w1 b25. ; w01:=10*digits+0.5;
fs w3 2 ; w23:=digits-10*digits-0.5;
bl. w3 b15. ; w3:=n;
sl w2 1 ; if 10*digits>=number
jl. a32. ; then
dl. w1 b3. ; begin
fa. w1 b25. ; w01:=digits+0.5;
al w3 x3+1 ; n:=n+1; end;
hs. w3 b15. ;
a32:bl w2 6 ; extend sign of w3 to w2
bl w2 4 ;
wd. w3 b16. ; w2:=n mod new zeroes;
sh w2 -1 ; if w2 < 0 then
wa. w2 b16. ; w2:=w2+new zeroes;
bl. w3 b15. ; w3:=n;
ws w3 4 ; w3:=exp10:=n-k;
rs. w3 b15. ;
bl w3 3 ; w3:=exp2;
sh w3 0 ; if w01<=1
jl. e3. ; then goto real zero ;
rs. w2 b16. ; new zeroes:=w2;
ad w1 x3-47 ; w0:=last 6 digits;
a34:dl. w3 ( j15.) ; end conversion:
rl w3 x2+i17 ; reestablish w2
ds w1 x3 ; last formal := number;
rs w3 x2+i0 ; param addr := last formal;
dl. w1 b15. ; following zeroes := new zeroes;
ds w1 x2+i13 ; exp10(stack := exp10(this segment);
rl. w3 ( j14.) ; goto start for reals
jl x3+e20 ; on segment 2;
e3: ld w1 -100 ; real zero:
ds. w1 b15. ; exp10 := new zeroes := 0;
jl. a34. ; number := 0;
; goto end conversion;
\f
; jz 1979.01.30 print the exponent part; write(seg.3); page 19
e10:rl w0 x2+i13 ; print exp:
bz w1 x2+i8 ;
sn w0 0 ; if exp10 = 0
sz w1 2.1000 ; and first letter <> z then
jl. a3. ; begin comment b cannot occur;
al w1 0 ; spaces := 0;
jl. c13. ; goto exp as space;
a3: la. w1 b43. ; sign := signswitch(fe);
am. (j39.) ;
bz w1 x1 ;
sl w0 0 ; if exp10 < 0 then
jl. a4. ; begin
ac w0 ( 0) ; exp10 := -exp10;
rs w0 x2+i13 ; sign := <minus>;
bz w1 x2+i35 ; end;
a4: hs w1 x2+i41 ; store sign for later use;
bz w0 x2+i37 ; char := exponent mark;
rl. w3 ( j14.) ;
jl w3 x3+e15 ; outchar ( char);
ds. w3 ( j15.) ;
rl w0 x2+i13 ; news := s;
bz w1 x2+i7 ;
a14:rs w1 x2+i12 ;
bz. w3 x1+b44. ; while 10**news <= exp10 do
al w1 x1+1 ; news := news + 1;
sl w0 x3 ;
jl. a14. ;
bz w3 x2+i8 ; comment notice please that first letter
ls w3 -2 ; b cannot occur legally;
bz. w3 x3+b45. ; goto case pe+1 of
a15:jl. x3 ; (d, f, z, z);
a45:bz w0 x2+i41 ; f:
rl. w3 ( j14.) ;
se w0 0 ; if sign <> 0 then
jl w3 x3+e15 ; outchar(sign);
ds. w3 ( j15.) ; sign := 0;
al w0 0 ; comment continue as for d;
hs w0 x2+i41 ;
a46:dl w0 x2+i13 ; d:
bz. w1 x3+b46. ; comment notice please news >= 1 always;
sl w0 x1 ; while exp10 < 10**(news-1) do
jl. a47. ; begin
al w3 x3-1 ;
rs w3 x2+i12 ; news := news - 1;
rl. w3 ( j14.) ;
bz w0 x2+i32 ; outchar(leading space);
jl w3 x3+e15 ;
ds. w3 ( j15.) ; end;
jl. a46. ; comment continue as z;
\f
; jz 79.01.30. print the exponent part; write(seg.3); page 20
a47:bz w0 x2+i41 ; z: char := sign;
a42:rl. w3 ( j14.) ; rep:
se w0 0 ; if char <> 0 then
jl w3 x3+e15 ; outchar(char);
ds. w3 ( j15.) ;
dl w1 x2+i13 ;
sn w0 0 ; if news = 0 then
jl. a48. ; goto finito;
bs. w0 1 ; news := news - 1;
rs w0 x2+i12 ;
am ( 0) ;
bz. w3 +b44. ; divisor := 10 ** news;
al w0 0 ;
wd w1 6 ; number := number mod divisor;
rs w0 x2+i13 ;
al w0 x1+48 ; char := number // divisor + 48;
jl. a42. ; goto rep;
a48:rl. w3 ( j14.) ; finito:
jl x3+e21 ; goto end number on segm 2;
\f
; jz 1979.03.06 write(seg.3); page 20a
c16: bz w1 x2+i4 ; spaces :=
ba w1 x2+i5 ; h+d;
bz w0 x2+i5 ; spaces := spaces +
se w0 0 ; (if d <> 0 then
al w1 x1+1 ; 1 else 0) +
bz w3 x2+i6 ;
sz w3 2.11 ; (if fn <> 0 then
al w1 x1+1 ; 1 else 0 );
c13: bz w3 x2+i7 ; exp as space:
se w3 0 ; spaces := spaces +
am x3+1 ; (if s <> 0 then
al w1 x1 ; s + 1 else 0) +
bz w3 x2+i8 ;
sz w3 2.11 ; (if fe <> 0 then
al w1 x1+1 ; 1 else 0);
rl. w3 (j14.) ;
jl x3+e26 ; goto outspaces(segment 2);
; standard real layout:
6<12 + 2 ; b=6, h=2,
b40: 4<12 + 1 ; d=4, pnfn=1,
0<12 + 0 ; s=0, pefe=0,
b41: 2.11 < 22 ; one leading space;
b43: 2.11 ; mask: last two bits;
h.
b44: 1, 10, 100, 1000; list of powers of ten;
; switch on first letter pe:
b45: a46-a15, a45-a15 ; d, f,
a47-a15, a47-a15 ; z, b handled as z;
b46 = b44 - 1 ; powers-1 of ten;
w.
g12:
c. g12 - 506
m. segment 3: code too long
z.
m. segment 3
c. 502 - g12, 0, r. 252 - g12 > 1
z.
<:write:>, 0, 0 ; alarm text;
m. jz 80.01.09 algol8, write and writeint
\f
; jz 80.01.07 prodedures outchar, -text, -integer; write(seg.4); page 21
;the three code procedures outchar, outtext, and outinteger
;are stored on 1 segment. the usage of these procedures is found
;in the publication rcsl 31-d72.
;contents:
;label, page, name
; 22 initiate first two parameters of proc
;e2 22 entry outchar
;e3 22 entry outtext
;e4 22 entry outinteger
;e5 23 write into zone(space)
;e6 23 write into zone(char)
;e1 24 outchar
;e8 24 outtext
;e9 26 outinteger
;e10 28 store in stack
; 29 definition of entry points
b.b8,c4,e12,f1,g2,i20,j74; slang block for procedures
k=10000
i6=6,i8=8,i10=10,i12=12,i14=14,i16=16,i18=18,i20=20
h.
g0=0 ; g0=number of externals
e0: g2 , g1 ; rel of point, rel of abs words
;
;abs words:
j3: g0+3 , 0 ; rs entry 3, reserve
j4: g0+4 , 0 ; 4, take expression
j8: g0+8 , 0 ; 8, end address expression
j13: g0+13 , 0 ; 13, last used
j17: g0+17 , 0 ; 17, index alarm
j21: g0+21 , 0 ; 21, general alarm
j29: g0+29 , 0 ; 29, param alarm
j30: g0+30 , 0 ; 30, saved stack ref, saved w3
j41: 0, 6 ; own core: ending space
j42: 0, 3 ; own core: negative sign;
j43: 0, 4 ; own core: decimal point;
j44: 0, 0 ; own core: leading space
j50: 0, e34 ; own core: entry convert char
j51: -4 , 0 ; segment 0 address
g1=k-2-e0 ; end abs words
;points:
j35: g0+35 , 0 ; rs entry 35, outblock
g2=k-2-e0 ; end rel words
w.
;global variables
f0: 0 ; dec for outinteger
f1: 0 ; print for store in stack
\f
; jz 80.01.08. prodedures outchar, -text, -integer; write(seg.4); page 22
;constants and texts
b3=132 ; max number of char per line
b0: 10 ;
b1: 20 ;
-10 ;
b2: 1 ;
b4: 1<16 ; end mark
b5: 1<23 ; bit(0)=1
b7: 255 ; bit(16:23)=ones
;initiate first two parameters of proc(zone,integer,...)
;saves the stack reference and checks the validity of the
;formal parameters for the zone. partial word addr and
;record base addr are stored in the words +i6 and +i8
;of the stack, respectively. the integer parameter is
;evaluated both as an integer and as a result addr.
; entry: exit:
;w0: integer mod 2**24
;w1: result addr.integer
;w2: stack
;w3:
;stack
; +i6: zone param partial word addr
; i8: record base addr
;+i10: integer param unchanged
;+i12: destroyed
b.a1 w.
;c1=e7-e8,c2=e8-e9,c3=e9-e11
e2: am c1 ; entry outchar:
e3: am c2 ; entry outtext:
e4: al w1 c3 ; entry outinteger:
rl. w2 (j13.) ; w2 := last used;
ds. w3 (j30.) ; (saved sref, saved w3) := (w2,return);
rx w1 x2+8 ; swap(proc selector,word 1 of zone param);
rl w0 x1+h2+6 ; state := zone.state;
sn w0 0 ; if state = 0 then
al w0 3 ; state := 3 (after char print);
sn w0 3 ; if state <> 3 then
jl. a1. ;
rl. w3 (j51.) ; call zone state alarm
jl w3 x3+e24 ; on segment 0;
a1: rs w0 x1+h2+6 ; zone.state := state;
al w0 x1+h2+4 ; partial word address :=
rs w0 x2+6 ; zone.partial word address;
rx w1 x2+8 ; swap(proc selector,word 1 of zone param);
rx w1 x2+12 ; swap(proc selector,word 1 of int param);
rl w0 x2+10 ; w0 := word 0 of int param;
so w0 16 ; if expression then
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; (saved sref,w3) := (w2,return);
rl w0 x1 ; w0 := value (integer param);
am (x2+12) ; goto
e11: jl. 0 ; procedure.proc selector;
e. ; end initiate first two parameters
\f
; jz 80.01.07 prodedures outchar, -text, -integer; write(seg.4); page 23
;procedure write into zone(char); procedure writechar(char);
;outputs the right-most 8 bits of the character to the zone
;buffer. the block is changed if necessary.
; entry: exit: writeintozone writechar
;w0: char destroyed dstroyed
;w1: unchanged destroyed
;w2: stack ref stack ref stackref
;w3: link destroyed destroyed
;stack
; +i6: partial word addr partial word addr
; +i8: record base addr record base addr
;+i10: destroyed unchanged
;+i12: destroyed unchanged
b.a3 w.
e12: bz. w0 (j44.) ; leading sp:
jl. e6. ; char := leading space else
e5: bz. w0 (j41.) ; char := ending space;
e6: rs w1 x2+i10 ; save w1
ac. w1 e0. ; relative return:=
wa w1 6 ; link - segment start
rs w1 x2+i12 ;
jl. w1 (j50.) ; char := convert char(char);
jl. a3. ; if char > 255 then goto finis;
rl w1 (x2+i6) ; pack char:
hs. w0 b8. ; save char;
al w0 0 ;
ld w1 8 ; partial word :=
b8 = k + 1 ; saved char
al w1 x1+0 ; partial word shift 8
rs w1 (x2+i6) ; + saved char;
se w0 1 ; if partial word not full
jl. a3. ; then return;
rx w0 (x2+i6) ; next word:
rl w1 (x2+i8) ; record base := record base + 2;
al w1 x1+2 ;
rs w1 (x2+i8) ; buffer(record base) := partial word;
rs w0 x1 ; partial word := 1;
am (x2+i8) ; check block change:
sl w1 (2) ; if buffer filled
jl. a2. ; then goto output buffer
jl. a3. ; else goto finis
a2: rl w0 x2+i8 ; output buffer:
ls w0 4 ; w0:=zone shift 4
rl. w1 j35. ; w1:=outblock
jl. w3 (j4.) ; take expression;
a3: rl w3 x2+i8 ; finis:
al w0 0 ; zone.record length := 0;
rs w0 x3+h3+4 ;
rl w1 x2+i10 ; restore w1;
am (x2+i12) ;
jl. e0. ; return;
e. ; end write into zone;
\f
; jz 79.08.15 prodedures outchar, -text, -integer; write(seg.4); page 24
;code procedure outchar(z,i); zone z; integer i;
; entry: usage:
;w0: integer mod 2**24
;w1: result addr.integer
;w2: stack
; +i6: partial word addr partial word addr
; +i8: record base addr record base addr
;+i10: formal i for write into zone
;+i12: undefined for write into zone
b.w.
e1: la. w0 b7. ; i := i extract 8;
jl. w3 e6. ; write into zone(i);
jl. (j8.) ; end address expression;
e. ; end outchar
;code procedure outtext(z,pos,ra,i)
; zone z; integer pos,i; real array ra;
; entry: usage:
;w0: integer mod 2**24
;w1: result addr.integer
;w2: stack
; +i6: partial word addr partial word addr
; +i8: record base addr record base addr
;+i10: formal pos pos, for write into zone
;+i12: undefined for write into zone
;+i14: formal ra last addr of ra
;+i16: current addr of ra
;+i18: formal i current value of pos
;+i20: upper index
b. a7 w.
e8: rs w0 x2+i10 ; begin
dl w1 x2+i20 ; take i parameter:
so w0 16 ; if expression then
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; saved stack ref:= w2;
rl w1 x1 ; index:= i;
rl w3 x2+i16 ; take ra parameter:
ba w3 x2+i14 ; dope addr:= base addr+dope rel;
ls w1 2 ; index:= index*4;
sh w1 (x3-2) ; if index>upper
sh w1 (x3) ; or index<lower
a1: jl. w3 (j17.) ; then begin
; index error: index alarm(alarm)
; end;
wa w1 (x2+i16) ;
al w1 x1-2 ; cur word addr:= index+base addr-2;
rl w0 x3-2 ;
rs w0 x2+i20 ;
wa w0 (x2+i16) ; upper addr:= upper+base addr;
ds w1 x2+i16 ;
\f
; jz 79.08.16 prodedures outchar, -text, -integer; write(seg.4); page 25
rl w1 x2+i10 ;
sn w1 0 ; if pos=0 then
jl. (j8.) ; end address expression;
al w0 10 ;
sh w1 -1 ; if pos <0 then
jl. w3 e6. ; write into zone(nl);
sl w1 1 ; if pos >=0 then
ac w1 x1 ; pos:= -pos;
sh w1 -b3-1 ; if pos <-max number then
al w1 -b3 ; pos:= -max number;
rs w1 x2+i18 ;
a2: rl w1 (x2+i16) ; next word:
ld w1 8 ; word:= word shift 8
al w1 x1+1 ; + endmark;
jl. a4. ; goto test;
a3: ld w1 8 ; next char: word := word shift 8;
a4: la. w0 b7. ; char := next char extract 8;
sn w0 0 ;
jl. a6. ; goto spaces;
a5: jl. w3 e6. ; write into zone(char);
rl w3 x2+i18 ;
al w3 x3+1 ; pos:= pos+1;
sn w3 0 ; if pos=0 then
jl. (j8.) ; end address expression;
rs w3 x2+i18 ;
se. w1 (b4.) ; if not end mark then
jl. a3. ; goto next char;
rl w3 x2+i16 ;
al w3 x3+2 ; cur word addr:= cur word addr+2;
rs w3 x2+i16 ; if cur word addr
sh w3 (x2+i14) ; <=last addr then
jl. a2. ; goto next word;
rl w1 x2+i20 ; index:= upper;
jl. a1. ; goto index error;
a6: ; spaces:
rl w1 x2+i18 ; char:= ending space;
a7: jl. w3 e5. ; next space:
al w1 x1+1 ; write into z(space);
se w1 0 ; pos:= pos+1;
jl. a7. ; goto if pos >0
jl. (j8.) ; then next space
; else end address expression;
e. ; end outtext
\f
; jz 1979.08.16 prodedures outchar, -text, -integer write(seg.4); page 26
;code procedure outinteger(z,pos,dec,i);
;value i; zone z; integer pos, dec,i;
; entry: usage:
;w0: pos
;w1: result addr.pos
;w2: stack
;w3:
;stack
; +i6: partial word addr partial word addr
; +i8: record base addr record base addr
;+i10: formal pos pos.for write into zone
;+i12: undefined for write into zone
;+i14: formal dec dec
;+i16: print
;+i18: formal i i
;+i20:
b. a11 w.
e9: rs w0 x2+i10 ; begin
dl w1 x2+i16 ; take dec parameter:
so w0 16 ; if expression then
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; saved stack ref:= w2;
rl w1 x1 ;
sh w1 15 ;
sh w1 -1 ; if dec>15 or dec<0
jl. w3 (j29.) ; then param alarm;
sn w1 0 ; if dec=0
al w1 -1 ; then dec:=-1
rs w1 x2+i14 ;
al w1 -18 ; reserve buffer:
jl. w3 (j3.) ; reserve 18 bytes in stack;
al w0 2.1111 ; take i parameter:
la w0 x2+i20-2 ; type := formal(0) extract 4;
se w0 10 ; if type <> 10 <*integer *>
sn w0 12 ; and type <> 12 <* long *>
jl. a4. ; then
jl. w3 (j29.) ; param alarm;
a4: dl w1 x2+i20 ; (w0,w1) := formal;
so w0 16 ; if expression then
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; saved stack ref:=w2;
dl w1 x1 ;
rl w3 x2+i18 ;
sz w3 4 ; if kind=integer then
jl. a0. ; convert i to long;
sh w1 -1 ;
am -1 ;
al w0 0 ;
a0: rs. w2 f1. ; print:= stack ref;
ds w1 x2+i20 ;
\f
; jz 79.08.16 prodedures outchar, -text, -integer write(seg.4); page 27
rl w3 x2+i10 ;
sn w1 0 ; if i=0 and pos<0
se w0 0 ; then goto determine spaces;
jl. a1. ;
sh w3 -1 ;
jl. a10. ;
a1: sn. w0 (b5.) ; if i<0 and i<>-2**47
se w1 0 ; then i:= -i;
sl w0 0 ; comment avoid, integer overflow;
jl. a2. ;
ld w1 -100 ;
ss w1 x2+i20 ;
a2: al w3 x2 ;
ws w3 x2+i14 ;
rs. w3 f0. ; dec:= stack ref - dec;
al w3 0 ;
;calculate the digits corresponding to positive i.
;long division of a long integer a is performed as follows
; w0 w1 w3
; a= ( a1 , a2 )
; -- -- 0
; a1//10 -- a1 mod 10
; a3=(a1 mod 10, -- ) a1//10
; a3 mod 20 a3//20 --
; -- 2*(a3//20) --
; if >= 10 then
; a3 mod 10 a3//10 --
; ( a//10 ) a mod 10
a3: wd. w0 b0. ; long division:
rx w3 0 ;
wd. w1 b1. ; digit:= i mod 10; i:= i//10;
ls w1 1 ;
sl w0 10 ; store in stack (digit);
aa. w1 b2. ;
rx w3 0 ;
jl. w2 e10. ; <* at return: w3=0 *>
rl. w2 f1. ;
al w2 x2+1 ;
sn w0 0 ;
se w1 0 ; if i <> 0 then
jl. a3. ; goto long division;
sl. w2 (f0.) ; if print+1 >= dec then
jl. a3. ; goto long division;
dl. w2 (j30.) ; sign:
sh w0 (x1+i18) ; if i<0 then
jl. a6. ; begin
bz. w3 (j42.) ; char := negative sign;
jl. w2 c4. ; stack sign(char);
a6: al w2 x1 ; end;
\f
; jz 79.01.18. prodedures outchar, -text, -integer; write(seg.4); page 28
a10: rl. w1 f1. ; determine spaces:
rs w1 x2+i16 ;
rl w1 x2+i10 ;
sl w1 1 ; if pos>0 then
ac w1 x1 ; pos:= -pos;
sh w1 -b3-1 ; if pos <=132 then
al w1 -b3 ; pos:= -132;
wa w1 4 ; pos:= pos+stack ref;
sl w1 (x2+i16) ; if pos>=print then
jl. a11. ; goto unbuffer stack;
a7: ; spaces:
jl. w3 e12. ; write into zone(leading space);
al w1 x1+1 ; pos:= pos+1;
se w1 (x2+i16) ; if pos<>print then
jl. a7. ; goto spaces;
a11: rl w1 x2+i16 ; unbuffer stack:
a8: sn w1 x2 ; move stack:
jl. a9. ; if print=stack ref then
bz w0 x1 ; goto finish;
jl. w3 e6. ; write into zone(stack buf(print));
al w1 x1+1 ; print:= print+1;
jl. a8. ; goto move stack;
; finish:
a9: rs. w2 (j13.) ; last used:= stack ref;
jl. (j8.) ; end address expression;
;procedure store in stack(digit);
;converts the digit to the corresponding iso-character and
;stores it in the halfword stack(print). furthermore, the
;procedure inserts the decimal point as defined by dec.
; entry: exit:
;w0: unchanged
;w1: unchanged
;w2: link link
;w3: digit 0
;st(f1):print print
b. a0 w.
e10: al w3 x3+48 ; stack char:
c4: rx. w2 f1. ; stack sign:
a0: al w2 x2-1 ; stack char1: print:=print-1;
hs w3 x2 ; char:= digit+48;
bz. w3 (j43.) ; stack(print) := char;
sn. w2 (f0.) ; if print=dec then
jl. a0. ; begin
al w3 0 ; char:= decimal point;
rx. w2 f1. ; goto stack char;
jl x2 ; end;
; return;
e. ; end store in stack
e. ; end outinteger
\f
; jz 80.01.09. definition of entry points; write(seg.4); page 29
e7:
c. e7-e0-506
m. code on segment 4 too long
z.
m. segment 4
c. 502-e7+e0,-1,r. 252-(:e7-e0:)>1
; fill the rest of the segment with -1
z.
<:outchar <0>:> ; alarm text
c1=e1-e8,c2=e8-e9,c3=e9-e11
d4=e2-e0 ; entry point outchar
d5=e3-e0 ; entry point outtext
d6=e4-e0 ; entry point outinteger
m. jz 80.01.08 algol8, outchar, outtext and outinteger
i.
e. ; end block for outchar outtext outinteger
d0=e18 ; entry point writeint
d3=f3 ; entry point write
d2=f2 ; external list
d11=e27 ; entry point: replace char
d12=e28 ; no of owns
d13=e33 ; outindex (rel addr in own core)
d14=e35 ; entry point: outtable
d15=e7 ; entry point: isotable
i.
e. ; end slang segments
\f
; jz 80.01.07 tails for catalog write(seg. ); page 30
;tails to be inserted in catalog
;write
g0:
5 ; 5 segments
0,0,0,0 ; room for name
1<23 + d3 + 1<12 ; entry point
3<18+40<12+8<6 ; integer proc ( zone, gen. addr.)
0 ;
4<12 + d2 ; code proc, ext list
5<12 +d12 ; 5 segments , owns
; writeint
1<23 + 4 ; modekind = backing store;
0, 0, 0, 0 ; room for name;
1<23 + d0 + 1<12 ; entry point on first segment;
3<18+40<12+8<6, 0 ; integer procedure(zone, general address);
4<12 + d2 ; code procedure, ext list;
5<12 +d12 ; 5 segments , owns
;outchar
1<23+4 ; modekind=backing store
0,0,0,0 ; fill for name
1<23+4<12+d4 ; entry point
1<18+3<12+8<6 ; no type proc(integer,zone)
0 ;
4<12+d2 ; code proc, ext list
5<12 +d12 ; 5 code segments , owns
;outtext
1<23+4 ; modekind=backing store
0,0,0,0 ; fill for name
1<23+4<12+d5 ; entry point
1<18+3<12+26<6+3 ; no type proc(integer, real array,
8<18 ; integer, zone)
4<12+d2 ; code proc, ext list
5<12 +d12 ; 5 code segments , owns
;outinteger
1<23+4 ; modekind=backing store
0,0,0,0 ; fill for name
1<23+4<12+d6 ; entry point
1<18+41<12+3<6+3 ; no type proc(general,integer,
8<18 ; integer,zone)
4<12+d2 ; code proc, ext list
5<12 +d12 ; 5 code segments , owns
\f
; jz.fgs 1981.06.09 tails for insertp. (1) page 31
; replace char:
1<23+4 ; modekind = backing store
0,0,0,0 ; fill for name
1<23 + d11 ; entry point (segment 0)
3<18+19<12+19< 6,0; integer procedure replacechar(intaddr,intaddr);
4<12 + d2 ; code proc , start ext list
5<12 +d12 ; 5 code segments , owns
; outindex:
1<23 + 4 ; modekind = backing store
0,0,0,0 ; fill for doc name
d13 ; rel address in own core
9<18 , 0 ; integer variable
4<12 + d2 ; code proc, start ext list
5<12 + d12 ; 5 code segments + owns
; outtable:
1<23 + 4 ; modekind = backing store
0,0,0,0 ; fill for docname
1<23+0<12+d14 ; entry point(segment 0)
1<18 + 41<12 , 0 ; procedure(undef)
4<12 + d2 ; code proc , start ext list
5<12 + d12 ; 5 code segments + owns
; isotable:
g1: 1<23 + 4 ; modekind = backing store
0,0,0,0 ; fill for doc name
1<23 +0<12 +d15 ; entry point(segment 0)
1<18 +25<12 , 0 ; procedure(integer array)
4<12 + d2 ; code proc , start ext list
5<12 + d12 ; 5 code segments + owns
; use of own core initialized to
; 0 leading space space (=32)
; 1 space in number space (=32)
; 2 positive sign + (=43)
; 3 negative sign - (=45)
; 4 decimal point . (=46)
; 5 exponent mark ' (=39)
; 6 ending space space (=32)
; 7 termination star * (=42)
; 8 integer layout: b 1
; 9 integer layout: h 1
; 10 integer layout: spaceword(0:11) 2.11<10
; 11 integer layout: spaceword(12:23) 0
; 12 signtable(0) null (= 0)
; 13 signtable(1) space (=32)
; 14 signtable(2) + (=43)
; 15 signtable(3) null (= 0)
m. jz 81.06.23 algol8, write, writeint, outchar, outtext,
m. outinteger, replacechar, outindex, isotable, outtable
d.
p. <:insertproc:>
▶EOF◀