DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦931418905⟧ TextFile

    Length: 28416 (0x6f00)
    Types: TextFile
    Names: »movestacktx«

Derivation

└─⟦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⟧ 

TextFile



;       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◀