|
|
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: 28416 (0x6f00)
Types: TextFile
Names: »movestacktx«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦80900d603⟧ »giprocfile«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦80900d603⟧ »giprocfile«
└─⟦this⟧
; move_stack_tx * page 1 28 09 77, 12.47;
; movestack
; *********
; integer procedure movestack(p1, p2, p3);
; ________________________________________
; undefined p1, p2, p3;
; the procedure moves a stack to or from a document
; described by a zone and the corearea desribed by
; the top and bottom identifier.
; movestack (return value, integer). The number of
; segments moved.
; the stack is moved from core to the document (normal) if
; type(p1)=simple and type(p2)=simple and type(p3)=zone.
; the stack is moved from the document to core (reverse) if
; type(p1)=zone and type(p2)=simple and type(p3)=simple.
; simple = <simple boolean identifier>/
; <simple integer identifier>/
; <simple real identifier>/
; <simple long identifier>.
; zonestate = 0 i.e. after open or setposition
; the top identifier is if normal then p1 else p2.
; the bottom identifier is if normal then p2 else p3.
; the top identifier is declared prior to the bottom
; identifier or it is the same identifier (then only
; one element is moved).
; entrypoint see page 5.
; absaddr
; *******
; integer procedure abs_addr(var);
; ________________________________
; undefined var;
; the procedure gives the absolute address of the parameter.
; abs_addr (return value, integer). The absolute address
; of the parameter.
; var (call value, name). Any simple identifier
; or array exept zonearray.
; entry point see page 4.
\f
; move_stack_tx * page 2 28 09 77, 12.47;
; integer procedure short_real(r);
; ________________________________
;
; short_real (return, integer ) first byte is the rounded 12 bit
; fraction of r, last byte is the exponent of r;
; r (call, real ) see above.
;
; real procedure extend_real(i);
; ______________________________
;
; extend_real (return, real) the first byte of i is extended to a
; 36-bit fraction, the last byte of i is used as
; exponent.
; i ( call, integer ) see above.
;
; integer procedure short_clock;
; ______________________________
;
; short_clock (return, integer) see rc8000 information, December 1976.
; The shortclock is written by the procedure outshortclock
; procedure outshortclock( shortclock);
; integer shortclock;
; begin real r;
; write( out, <:d.:>, <<zdddd>,
; _ systime( 4,( if short_clock>0 then shortclock
; _ else shortclock + extend 1 shift 24)
; _ / 625 * 1 shift 15 + 12, r ),
; _ <:.:>, <<zddd>, r/100 );
; end out_short_clock;
;
; girc 4000 own constants
; ***********************
; name type content application
; pi real pi gen. purp.
; exp1 real exp(1) gen. purp.
; mu real 1/ln(10.0) gen. purp.
; rg real pi/abs max long gen. purp.
; rho real 180*60*60/pi gen. purp.
; longone long extend 1 gen. purp.
; inclass integer inchar class char input
; sp boolean 32 (=blank char) write param
; nl boolean 10 (=nl char) write param
; ff boolean 12 (=ff char) write param
; em boolean 25 (=em char) write param
; not_eof boolean true false at em
; mtr boolean false true after m input
; longzero long extend 0 gen. purp.
; prvers long extend 0 prog version
; tr_control integer 0 entry for transproc
; tr_status integer 0 status for trproc
; read_status integer 0 status for readgeot
; work0 integer 0 g.purp. var
; work1 integer 0 g.purp. var
; work2 integer 0 g.purp. var
; work3 integer 0 g.purp. var
; tchar integer 0 terminator char
; udt integer 0 default terminator
\f
; move_stack_tx * page 3 28 09 77, 12.47;
(movestack = set 36 disc
absaddr = set bs movestack
short_real = set bs movestack
extend_real = set bs movestack
short_clock = set bs movestack
pi = set bs movestack
exp1 = set bs movestack
mu = set bs movestack
rg = set bs movestack
rho = set bs movestack
longone = set bs movestack
inclass = set bs movestack
sp = set bs movestack
nl = set bs movestack
ff = set bs movestack
em = set bs movestack
not_eof = set bs movestack
mtr = set bs movestack
longzero = set bs movestack
prvers = set bs movestack
tr_control = set bs movestack
tr_status = set bs movestack
read_status = set bs movestack
work0 = set bs movestack
work1 = set bs movestack
work2 = set bs movestack
work3 = set bs movestack
tchar = set bs movestack
udt = set bs movestack
movestack = slang entry.no
movestack absaddr shortreal extendreal shortclock,
pi exp1 mu rg rho longone inclass,
sp nl ff em noteof mtr longzero prvers tr_control tr_status,
read_status work0 work1 work2 work3 tchar udt)
\f
; move_stack_tx * page 4 28 09 77, 12.47;
b. ; outermost block
m.girc 4000 movestack absaddr constants 10.05.77
p.<:fpnames:>
b. g1, e30 ; block with names for tail
w. ; and inser proc
k=10000 ; load address
s.g10, j50, f20 ; start slang segment
h.
g0=0 ; number of externals
e4:
g6: g8, g7 ; head word
; abs words:
g7=k-2-g6
; last of abs words
; points:
g8=k-2-g6
; last of points
; fill with jl -1
w.
jl -1 , r.250-(:4+12*g0+36:)>1 ; <* 36 = g10 *>
;external list
w.
e0: g0 ;no. of externals
g10 ;no. of bytes to be initialized
f.
3.141 592 653 6 ; pi
2.718 281 828 5 ; exp(1.0)
0.434 294 481 92 ; mu
2.232 235 838 8 '-14; rg
2.062 648 062 5 '5 ; rho
w.
0, 1 ; long one
6 ; inclass
32 ; sp (blank)
10 ; nl (new line)
12 ; ff (format feed)
25 ; em (end of medium)
-1 ; not eof
g10=k-e0-4 ; no. of bytes to initialize
g9 ; rel. continuation on next segm
g4:
c.g4-e4-506
m.code too long segm. no.0
z.
c.502-g4+e4
jl -1 , r.252-(:g4-e4:)>1; fill
z.
<:movestack:>, 0
; finis first segm.
\f
; move_stack_tx * page 5 28 09 77, 12.47;
; start second segm.
h.
e5:
g1: g3, g2 ;head word: rel of last point,
; rel of last abs word
;abs words
j4: g0+4, 0 ;rs entry take expr
j6: g0+6, 0 ;rs entry fin by register expr
j13: g0+13, 0 ;rs entry last used
j21: g0+21, 0 ;rs entry general alarm
j29: g0+29, 0 ;rs entry param alarm
j30: g0+30, 0 ;rs entry saved w3, save w2w3
g2=k-2-g1
;last of abs words
;points
j34: g0+34, 0 ;rs entry inblock
j35: g0+35, 0 ;rs entry outblock
g3=k-2-g1
;last of points
w.
; continuation of ext. list:
g9=k-g1
s3 ; version date
s4 ; version time
1<11 ; round fraction to short_real
f0: 0 ; recordbase=addr(z(0)), sum , exp. of round to shortreal
f1: 0 ; addr(zonedescr.) , portion to move, last addr(to-area)
f2: <:<10>length :> ; alarmtext
f3: <:<10>sumerror :> ; alarmtext
f4: 4095<12 ; mask to extend real
f8: <:<10>illeg_tp:> ; alarmtext
; integer procedure abs_addr(var); undefined var;
e1:
; entry point abs_addr:
rl. w2 (j13.) ; w2:=last used
ds. w3 (j30.) ; save w2w3
; take formals:
dl w1 x2+8 ; w0w1:=param1param2
so w0 8 ; if array
rl w1 x1 ; then take addd(array(0))
so w0 16 ; if ok then gotostop
se w0 16 ; else goto alarm
; stop:
jl. (j6.) ;
; alarm:
al. w0 f8. ; alarm text addr
jl. w3 (j21.) ; general alarm
\f
; move_stack_tx * page 6 28 09 77, 12.47;
e10:
; entrypoint short_real
; **********
rl. w2 (j13.) ; last used
ds. w3 (j30.) ; saved w3
dl w1 x2+8 ; load formals
so w0 16 ; if expression then
jl. w3 (j4.) ; take this;
ds. w3 (j30.) ;
dl w1 x1 ; take value
rl w3 x2+6 ; load kind
so w3 1 ; if integer then
ci w1 0 ; float this;
bz w3 3 ;
rs. w3 f0.+1 ; set exponent of round constant
fa. w1 f0. ; round
hl w0 3 ; w0:= byte(0) , byte(3);
rl w1 0 ; w1:= w0;
al w0 0 ; w0:= 0;
jl. (j6.) ; finis by reg expr.
e11:
; entrypoint extend_real
; ***********
rl. w2 (j13.) ; last used
ds. w3 (j30.) ;
dl w1 x2+8 ; load formals
so w0 16 ; if expression then
jl. w3 (j4.) ; take this;
ds. w3 (j30.) ;
dl w1 x1 ; take value
rl w3 x2+6 ; load kind
sz w3 1 ; if real then
cf w1 0 ; convert to integer;
rl w0 2 ; w0:= byte(2), 0;
la. w0 f4. ;
bz w1 3 ; w1:= 0, byte(3);
jl. (j6.) ; finis by reg exp
e12:
; entrypoint shortclock
; **********
rl. w2 (j13.) ; last used
ds. w3 (j30.) ; saved w3
dl w1 110 ; load monitor clock
ld w1 5 ; w0 = shortclock
rl w1 0 ; w1:= w0;
al w0 0 ; w0:= 0;
jl. (j6.) ; finis by reg exp
\f
; move_stack_tx * page 7 28 09 77, 12.47;
; integer procedure movestack(p1,p2,p3); undefined p1,p2,p3;
; stack picture:
; x2+ 6 : p1, 1.formal, recordbase = addr(z(0))
; x2+ 8 : p1, 2.formal, corebase = addr(top identifier)
; x2+10 : p2, 1.formal, no. of segments moved
; x2+12 : p2, 2.formal, rest after this portion
; x2+14 : p3, 1.formal, (normal=-4)/(reverse=0)
; x2+16 : p3, 2.formal, addr(zonedescr.)
b. c8,d6,a20 ; block
w.
e2:
; entry point movestack:
rl. w2 (j13.) ; w2:=last used
ds. w3 (j30.) ; saved w3
; find zone param:
al w3 -4 ; normal
dl w1 x2+16 ; w0w1:=1.formal 2.formal p3
sn. w0 (a0.) ; if zone
jl. c0. ; then goto check zonestate
dl w0 x2+8 ; w3w0:=1.formal 2.formal p1
se. w3 (a0.) ; if -,zone
jl. w3 (j29.) ; then param alarm
; p1 is the zone. inblock the first portion:
ls w0 4 ; entrycondition to
rl. w1 j34. ; inblock
jl. w3 (j4. ) ; take expr.
ds. w3 (j30.) ; saved stack ref
al w3 0 ; reverse
rl w1 x2+8 ; addr(z.descr)
c0:
; check zonestate:
rl w0 x1+h2+6 ; zonestate
se w0 0 ; if zonestate>0
jl. w3 (j29.) ; then param alarm
se w3 0 ; set
am 1 ; z.state
al w0 5 ; and
rs w0 x1+h2+6 ; store
rl w0 x1+h3 ; record base
rs. w0 f0. ; store recordbase
rs. w1 f1. ; store zonedescr. addr.
ws w0 x1+h3+2 ; w0:=-record length
se w0 -512 ; if length<>512
jl. w3 (j29.) ; then param alarm
; check bottom identifier:
am x3 ; if normal then p2 else p3
dl w1 x2+16 ; w0w1:=1.formal 2.formal p2/p3
sh w0 28 ; if kind>28
sh w0 24 ; or kind<25
jl. w3 (j29.) ; then param alarm
rl. w0 f1. ; w0:=addr(zonedescr.)
ds w0 x2+16 ; store normal/reverse, addr(zonedescr.)
rx w3 2 ; w3:=bottom addr; w1:=normal/reverse;
\f
; move_stack_tx * page 8 28 09 77, 12.47;
; check top identifier:
am x1 ; if normal then p1 else p2
dl w1 x2+12 ; w0w1:=1.formal 2.formal p1/p2
sh w0 28 ; if kind>28
sh w0 24 ; or kind<25
jl. w3 (j29.) ; then param alarm
; get movesize:
sl w0 27 ; if real or long
am -2 ; then w1:=w1-4
al w1 x1-2 ; else w1:=w1-2
ws w3 2 ; bytes to move w3:=w3-w1;
sh w3 0 ; if bytes<0 then
jl. w3 (j29.) ; param alarm
; get movesize of first portion:
sl w3 509 ; if bytes>508 then fist portion
al w0 508 ;
sh w3 508 ; else last portion
rl w0 6 ;
ws w3 0 ; rest after this portion
rs. w0 f1. ; store portionsize
rs w3 x2+12 ; store rest after this portion
al w3 0 ; store no. of moved segm.
rs w3 x2+10 ;
rs w1 x2+8 ; store core base
; addr(z(1)):
rl. w3 f0. ; load z.base
rs w3 x2+6 ; store z.base
al w3 x3+4 ; addr(z(1))
rl w1 x2+14 ; normal/reverse
rx w0 2 ; w0:=normal/reverse; w1:=portionsize
d5:
; prepare sum:
rl w2 x2+8 ; w2:=core base
al w1 x1+4 ;
rs. w1 f0. ; sum:=length
sl w0 0 ; if normal
jl. c4. ; then
rs w1 x3-2 ; store length goto move
jl. c3. ; else
c4:
; lengthcheck:
rx w2 6 ; swop(w2,w3)
sn w1 (x2-2) ; if length=zon.fistword
jl. c3. ; then goto move
ws w1 x2-2 ; lengthdeviation
al. w0 f2. ; alarm text addr
rl. w2 (j13.) ;
jl. w3 (j21.) ; general alarm
c3:
; move:
al w1 x1-4 ;
jl. d2. ;
\f
; move_stack_tx * page 9 28 09 77, 12.47;
d0:
dl w1 x2-4 ; move two doublewords
ds w1 x3-4 ;
wa. w0 f0. ; add sum
wa w1 0 ;
rs. w1 f0. ;
d1:
dl w1 x2, ds w1 x3 ; move doubleword
wa. w0 f0. ; add sum
wa w1 0 ;
rs. w1 f0. ;
rl. w1 f1. ;
d2:
; update pointers:
sh w1 7 ; if more than 3 words
jl. d3. ; then move 4 words
al w1 x1-8 ;
rs. w1 f1. ; store bytes
al w2 x2+8 ;
al w3 x3+8 ;
jl. d0. ;
d3:
sh w1 3 ; if more than 1 word
jl. d4. ; then move doubleword
al w1 x1-4 ;
rs. w1 f1. ; store bytes
al w2 x2+4 ;
al w3 x3+4 ;
jl. d1. ;
d4:
sh w1 0 ; if more
jl. d6. ; then move word
al w2 x2+2 ;
al w3 x3+2 ;
rl w0 x2, rs w0 x3 ;
wa. w0 f0. ; add sum
rs. w0 f0. ;
d6:
; store/check sum:
rl. w1 (j13.) ; w1:=last used
rl w0 x1+14 ; w0:= normal/reverse
sn w0 0 ; if reverse
al w2 x3 ; then w2:=w3:=core base
rs w2 x1+8 ; store core base
rs. w3 f1. ; store last addr(to-area)
al w2 x1 ; w2:=last used
rl w3 x2+6 ; addr(z(0))
rl. w1 f0. ; w1:=sum
ac w1 x1 ;
al w1 x1-3 ;
sl w0 0 ; if reverse
jl. c5. ; then goto sumcheck
rs w1 x3+4 ; else store sum-3
jl. c6. ; goto update moved segm
\f
; move_stack_tx * page 10 28 09 77, 12.47;
c5:
; sumcheck:
sn w1 (x3+4) ; else checksum
jl. c6. ;
al. w0 f3. ;
jl. w3 (j21.) ; alarm
c6:
; update moved segm:
rl w1 x2+10 ; moved segm:=
al w1 x1+1 ; moved segm
rs w1 x2+10 ; +1
rl w3 x2+16 ; w3:=addr(zonedescr.)
sn w0 0 ; if reverse
jl. c8. ; then goto transfer block
; fill rest of record:
al w0 0 ; fill
rl. w1 f1. ; load last addr(to-area)
al w1 x1+2 ; rest
jl. c2. ; of
a1:
rs w0 x1 ; share
al w1 x1+2 ; with
c2:
sh w1 (x3+h3+2) ; zeroes
jl. a1. ;
; prepare for outblock:
rl w0 x3+h3+2 ;
rl w1 x3+h0+4 ; addr(share.descr)
bs. w0 1 ; w0:=w0-1
rs w0 x1+10 ;
al w0 -4 ;
c8:
; transfer block:
al w1 512 ; segment-length
rs w1 x3+h3+4 ; set rec.length
al w1 0 ; if (rest after this portion
sn w1 (x2+12) ; = 0)
jl. c7. ; then goto stop
rx w0 6 ; swop(w0,w3)
ls w0 4 ; entrycondition to
sn w3 -4 ; if normal
rl. w1 j35. ; then outblock
sn w3 0 ; else
rl. w1 j34. ; inblock
jl. w3 (j4. ) ; take expr
ds. w3 (j30.) ; saved stack ref
rl w0 x2+12 ; w0:=rest
\f
; move_stack_tx * page 11 28 09 77, 12.47;
; set movesize next portion:
sl w0 509 ;
al w1 508 ;
sh w0 508 ;
rl w1 0 ;
ws w0 2 ; rest after this portion
rs w0 x2+12 ; store w0
rs. w1 f1. ;
rl w0 x2+14 ; normal/reverse
rl w3 x2+16 ;
rl w3 x3+h3 ; addr(z(0))
rs w3 x2+6 ; store record base
al w3 x3+4 ; addr(z(1))
jl. d5. ; goto prepare sum
c7:
; stop:
rl w1 x2+10 ; movestack:=moved segm
jl. (j6. ) ; end_reg_expr
a0: 6<12+23 ; kind = zone
i.
e.
g5: ; end_of code
c.g5-e5-506
m. code movestack too long
z.
c. 502-g5+e5
jd -1, r.252-(:g5-e5:)>1
z.
<:movestack:>,0
i.
e.
\f
; move_stack_tx * page 12 28 09 77, 12.47;
;entry tails:
e21=1<23+4 ;modekind=bs
e24=-1 ; byte addr in own core
g0:
;move stack
2 ; fist tail: 2segm
0,0,0,0 ; fill
1<23+e2-e5 ; entry point
3<18+41<12+41<6+41; integer proc undefined,
0 ; undefined, undefined, fill
e26 ; codeproc. start of ext.list
e22 ; code segm, bytes in core
; abs addr
e21 ; modekind=bs
0,0,0,0 ; dummy fill for name
1<23+e1-e5 ; entry point for abs_addr
3<18+41<12 ;integer proc, undefined param
0 ; rest of param
e25 ; code proc, start of ext list
e22 ; code segm, bytes in core
; short_real
e21 ; mode kind = backing storage
0, 0, 0, 0 ; fill
1<23+e10-e5 ; entrypoint
3<18+14<12+0, 0 ; integer proc, real value
e25 ; code proc start of extern. list
e22 ; 1 code segm. 0 bytes in perm core
; extend_real
e21 ; modekind = backing storage
0, 0, 0, 0 ; fill
1<23+e11-e5 ; entrypoint
4<18+13<12+0, 0 ; real proc, integer value
e25 ; code proc start of extern. list
e22 ; 1 segm, 0 bytes in perm core
; short_clock
e21 ; modekind = backing storage
0, 0, 0, 0 ; fill
1<23+e12-e5 ; entrypoint
3<18, 0 ; integer proc
e25 ; code proc start of extern. list
e22 ; 1 segm, 0 bytes in perm core
; pi
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+4 ; 1 real
e24 ; byte addr in own core
10<18 ; spec own real
0 ; rest of spec
e25 ; code var, start of ext list
e22 ; code segm, bytes in core
\f
; move_stack_tx * page 13 28 09 77, 12.47;
; exp1
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+4 ; 1 real
e24 ; byte addr in own core
10<18,0 ; spec own real
e25 ; code var, start of ext list
e22 ;
; mu
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+4 ; 1 real
e24 ; byte addr in own core
10<18,0 ; spec own real
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
; rg
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+4 ; 1 real
e24 ; byte addr in own core
10<18,0 ; spec own real
e25 ; code var, start of ext list
e22 ; code segm bytes in own core
; rho
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+4 ; 1 real
e24 ; byte addr in own core
10<18,0 ; spec own real
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
; longone
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+4 ; 1 long
e24 ; byte addr in own core
11<18,0 ; spec own long
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
; inclass
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+2 ; 1 integer
e24 ; byte addr in own core
9<18,0 ; spec own integer
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
; sp
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+2 ; 1 boolean
e24 ; byte addr in own core
8<18,0 ; spec own boolean
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
\f
; move_stack_tx * page 14 28 09 77, 12.47;
; nl
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+2 ; 1 boolean
e24 ; byte addr in own core
8<18,0 ; spec own boolean
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
; ff
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+2 ; 1 boolean
e24 ; byte addr in own core
8<18,0 ; spec own boolean
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
; em
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+2 ; 1 boolean
e24 ; byte addr in own core
8<18,0 ; spec own boolean
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
; not eof
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+2 ; 1 boolean (2 bytes)
e24 ; byte addr in own core
8<18,0 ; spec own boolean
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
; mtr
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+2 ; 1 boolean (2 bytes)
e24 ; byte addr in own core
8<18,0 ; spec own boolean
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
; longzero
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+4 ; 1 long
e24 ; byte addr in own core
11<18,0 ; spec own long
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
; prvers
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+4 ; 1 long
e24 ; byte addr in own core
11<18,0 ; spec own long
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
\f
; move_stack_tx * page 15 28 09 77, 12.47;
; tr_control
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+2 ; 1 integer
e24 ; byte addr in own core
9<18,0 ; spec own integer
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
; tr_status
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+2 ; 1 integer
e24 ; byte addr in own core
9<18,0 ; spec own integer
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
; read_status
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+2 ; 1 integer
e24 ; byte addr in own core
9<18,0 ; spec own integer
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
; work0
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+2 ; 1 integer
e24 ; byte addr in own core
9<18,0 ; spec own integer
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
; work1
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+2 ; 1 integer
e24 ; byte addr in own core
9<18,0 ; spec own integer
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
; work2
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+2 ; 1 integer
e24 ; byte addr in own core
9<18,0 ; spec own integer
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
; work3
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+2 ; 1 integer
e24 ; byte addr in own core
9<18,0 ; spec own integer
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
\f
; move_stack_tx * page 16 28 09 77, 12.47;
; tchar
e21 ; modekind=bs
0,0,0,0 ; fill for name
e24=e24+2 ; 1 integer
e24
9<18,0 ; spec own integer
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
g1:
; udt
e21 ; last tail: modekind=bs
0,0,0,0 ; fill for name
e24=e24+2 ; 1 integer
e24
9<18,0 ; spec own integer
e25 ; code var, start of ext list
e22 ; code segm, bytes in own core
e25=4<12 ; code var, start of ext list
e26=e25+e0-e4
e24=e24+1
e22=1<12+e24 ; code segm, bytes in own core
p.<:insertproc:>
e. ; end outermost block
if ok.no
(mode 0.yes
message movestack not ok
lookup movestack)
lookup ,
movestack absaddr shortreal extendreal shortclock,
pi exp1 mu rg rho longone inclass,
sp nl ff em noteof mtr longzero prvers tr_control tr_status,
read_status work0 work1 work2 work3 tchar udt
▶EOF◀