/*****************************************************************************\
*                           Systems Research Group                            *
*******************************************************************************


           #######   ########  ##    ##   ######   ########  ######## 
           ########  ########  ###  ###  ########  ########  ######## 
           ##    ##  ##        ########  ##    ##     ##     ##       
           ########  ######    ## ## ##  ##    ##     ##     ######   
           #######   ##        ##    ##  ##    ##     ##     ##       
           ##  ##    ##        ##    ##  ##    ##     ##     ##       
           ##   ##   ########  ##    ##  ########     ##     ######## 
           ##    ##  ########  ##    ##   ######      ##     ######## 

                ######    ########  #######   ##    ##   ######  
                #######   ########  ########  ##    ##  ######## 
                ##    ##  ##        ##    ##  ##    ##  ##       
                ##    ##  ######    #######   ##    ##  ##  #### 
                ##    ##  ##        ##    ##  ##    ##  ##    ## 
                ##    ##  ##        ##    ##  ##    ##  ##    ## 
                #######   ########  ########  ########  ######## 
                ######    ########  #######    ######    ######  


*******************************************************************************
*   I. D. Wilson           Last Modified   -   IDW   -   10/07/84             *
\*****************************************************************************/



//  Version of DEBUG for use with remote 68000 machines.



GET "LIBHDR"
GET "sys:idw.bcpl.idwhdr"


GLOBAL
$(
envtrace:ug+0
writearg:ug+1
isfun:ug+2
deletebpt:ug+3
lexp:ug+4
rbexp:ug+5
bexp:ug+6
exp:ug+7
adr:ug+8
val:ug+9
printadd:ug+11
print:ug+12
checkdig:ug+13
checkaddr:ug+14
cont:ug+15
selectask:ug+16
error:ug+17
testbreak:ug+18
rch:ug+19
wch:ug+20

rec:ug+21
wwrch:ug+22
save.rdch:ug+23
save.wrch:ug+24

add:ug+25
tch:ug+26
style:ug+27
salev:ug+28
lev:ug+29
currtcb:ug+30
globv:ug+31
regs:ug+32
vars:ug+33
sptr:ug+34
sbase:ug+35
standalone:ug+36
bpt:ug+37
bpt.addr:ug+39
bpt.instr:ug+40
wrflag:ug+41
lch:ug+42
ch:ug+43
rdflag:ug+44
copyregs:ug+45
getregs:ug+46
putregs:ug+47

memorylimit:ug+48
currtask:ug+49
dbpkt:ug+50
cstackp:ug+51
remoteread:ug+52
cachepages:ug+53
cacheaddresses:ug+54
cacherobin:ug+55
flushcache:ug+56
$)


MANIFEST
$(
r.d1 =  1
r.p  =  9
r.g  = 10
r.sr = 16
r.pc = 17

r.upb = 18
tcb.sp = 10

g.sbase=12

libword=23456

instr.bpt  =#X4E4D  // TRAP 13

unglob  = #X474C0001  //  unglob+2n  is the unset value for global n
idletcb = #X518 >> 2

cacheblocksize  =  128
cacheentries    =  20
$)
.



SECTION "REMOTE-DEBUG"



GET ""



LET start()  BE  m68k.start()



AND remoteread( address )  =  VALOF
$(
//  Check the address given for validity, and then return the result.

    UNLESS  0 <= (address >> 10) < memorylimit  DO  error()

    RESULTIS  performread( address )
$)



AND performread( address )  =  VALOF
$(
//  Read a location from the remote machine.  First, look in the cache to see
//  if the relevant entry is already there.  If not, then we must read it.

    LET offset  =  address REM cacheblocksize
    LET base    =  address  -  offset

    FOR  i = 1  TO  cacheentries  DO
        IF  cacheaddresses!i = base  THEN
            RESULTIS  cachepages!i!offset

    //  If we drop through here, then the address was not in the cache.  We
    //  should look to see if there are any null cache entries, and if so use
    //  one.
    
    FOR  i = 1  TO  cacheentries  DO
        IF cacheaddresses!i = -1  THEN
            RESULTIS  cacheread( i, base, offset )

    //  Otherwise, we should throw out the next entry, and cycle round.
    
    cacherobin  :=  cacherobin REM cacheentries  +  1
    
    RESULTIS  cacheread( cacherobin, base, offset )
$)



AND cacheread( entry, address, offset )  =  VALOF
$(
    LET cachep       =  cachepages!entry

    LET byteaddress  =  0
    LET highaddress  =  0
    LET lowaddress   =  0
        
    byteaddress  :=  address * bytesperword
    highaddress  :=  (byteaddress >> 16)  &  #XFFFF
    lowaddress   :=  (byteaddress)        &  #XFFFF

    selectpage( highaddress )
 
    m68k.readbuff( cachep, lowaddress, cacheblocksize*bytesperword )

    cacheaddresses!entry  :=  address

    RESULTIS  cachep!offset
$)



AND flushcache()  BE
$(
    FOR  i = 1  TO  cacheentries  DO
        cacheaddresses!i  :=  -1

    cacherobin  :=  0
$)



AND main()  BE
$(
//  Main routine of the remote debugger.  Find out which machine we should
//  be debugging, and look its address up in the name server.  Having found
//  it, we should start debugging.

    LET args      =  "MACHINE/A"
    LET argv      =  VEC 50
    LET regv      =  VEC r.upb
    
    LET ca        =  VEC cacheentries
    LET cp        =  VEC cacheentries

    LET opened    =  FALSE
    LET verified  =  FALSE
    LET mc        =  0

    UNLESS  rdargs( args, argv, 50 )  DO
    $(
        writef( "****** Bad arguments for string *"%S*"*N", args )
        
        stop( 20 )
    $)

    mc  :=  argv!0

    UNLESS  selectmachine( mc )  DO
    $(
        writef( "****** Unknown machine *"%S*"*N", mc )
        
        RETURN
    $)

    cacheaddresses  :=  ca
    cachepages      :=  cp

    FOR  i = 1  TO  cacheentries  DO
    $(
        LET page  =  getvec( cacheblocksize )
        
        IF  page = 0  THEN
        $(
            writef( "****** Cannot allocate cache block of size %N*N", cacheblocksize )

            FOR  j = 1  TO  i-1  DO  freevec( cachepages!j )
            
            RETURN
        $)
        
        cachepages!i  :=  page
    $)

    flushcache()

    lev          :=  level()
    memorylimit  :=  remoteread( rootnode+rtn.memsize )
    
    standalone   :=  FALSE

    regs         :=  regv
    wwrch        :=  wrch
    wrch         :=  wch
    add          :=  0
    tch          :=  0
    style        :=  0
    vars         :=  TABLE  0, 0, 0, 0, 0, 0, 0, 0, 0, 0

    FOR  i = 0  TO  r.upb  DO  regs!i  :=  0

    selectask( 1 )

    writes( "Remote Debug  Version 1.00*N" )
    writef( "%NK Machine*N*N", memorylimit )
    writef( "%S** ", mc )

    rch()

    // REPEAT loop to get commands
    $( LET v = 0
       LET oldstyle = style

       rdflag := FALSE
       SWITCHON ch INTO

       $( CASE 'A': CASE 'G': CASE 'L':
          CASE 'R': CASE 'V': CASE 'W':
          CASE 'Y':
             add := lexp()
             ENDCASE

          CASE '0': CASE '1': CASE '2':
          CASE '3': CASE '4': CASE '5':
          CASE '6': CASE '7': CASE '8':
          CASE '9': CASE '#': CASE '*'':
          CASE '(': CASE '@':
             tch := 0
             add := bexp()
             ENDCASE

          CASE '+': CASE '-': CASE '**':
          CASE '%':
          CASE '?': CASE '|': CASE '&':
          CASE '!':
          CASE '<': CASE '>':
             add := exp(val(add))
             tch := 0
             ENDCASE

          CASE 'J':
             add := val(add)>>2
             GOTO ind

          CASE 'I':
             add := val(add)
       ind:  tch := 'A'
             GOTO pra

          CASE 'N':
             IF tch=0 DO error()
             add := add+1
       pra:  printadd(tch, add)
||            CASE '/':
||               IF tch=0 DO error()
||               opened := TRUE
          CASE '=':
       ver:  print(val(add))
             verified := TRUE
             style := oldstyle
          CASE '*E': CASE '*S':
             rch()
             LOOP

          CASE '$':
             rch()
             style :=  ch
             IF verified GOTO ver
             GOTO nxt

          CASE 'T':
             IF tch=0 DO error()
             FOR i=0 TO rbexp()-1 DO
             $( IF i REM 5 = 0 DO printadd(tch, add+i)
                print(val(add+i))
                testbreak()
             $)
             newline()
             ENDCASE

||            CASE 'U':
||               UNLESS opened DO error()
||               !adr(add) := exp(rbexp())
||               LOOP

||            CASE 'P':
||               rch()
||               v := val(add)
||               add := lexp()
||               !adr(add) := v
||               ENDCASE

||            CASE 'X':
||               UNLESS isfun(val(add)) DO error()
||               add := val(add)(rbexp(),bexp(),bexp(),bexp())
||               tch := 0
||               ENDCASE

||            CASE 'C': // continue execution (normal)
||            CASE '.': // continue execution with trace bit set
||               UNLESS standalone DO
||               $( IF ch='C' DO
||                  $( release(currtcb)
||                     GOTO nxt
||                  $)
||                  error()
||               $)
||  
||               FOR i = 1 TO 9 DO  // plant break points in the code
||               $( LET ba = bpt.addr!i
||                  UNLESS ba=0 TEST ba=arg & mode>=2
||                              THEN ch := '.'
||                              ELSE pbytes(ba, 2, instr.bpt)
||               $)
||  
||               copyregs(putregs)
||               standalone := FALSE
||               rdch, wrch := save.rdch, save.wrch // Restore for task DEBUG
||               RESULTIS ch='.'

||            CASE 'H':
||               TEST standalone
||               THEN $( LET crntsk = rootnode!rtn.crntask
||                       IF currtcb=crntsk & currtask<=0 DO error()
||                       currtcb!tcb.state := currtcb!tcb.state | #B0010
||                    $)
||               ELSE hold(currtask)
||               GOTO nxt

          CASE 'S':
||               copyregs(putregs)
             selectask(rbexp())
||               copyregs(getregs)
             ENDCASE

        //CASE 'Z':
        //   #173104(?,#177406)  // reboot the system!!! PDP/11 magic
        //   boot()              // this Series/1 magic is in MLIB

||            CASE 'B':
||            $( LET n = checkdig(rbexp())
||               TEST n=0 THEN
||               $( FOR i=1 TO 9 DO
||                  $( LET ba=bpt.addr!i
||                     UNLESS ba=0 DO
||                     $( writef("*N%N %X6 ",i,ba)
||                        IF isfun(ba) DO writearg(ba)
||                     $)
||                  $)
||                  newline()
||               $)
||               ELSE
||               $( v := val(add)
||                  deletebpt(n)
||                  IF v=0 ENDCASE
||                  FOR i=1 TO 9 DO
||                     IF bpt.addr!i=v DO deletebpt(i)
||                  bpt.addr!n := v
||                  bpt.instr!n := gbytes(v,2)
||                  UNLESS standalone DO pbytes(v,2,instr.bpt)
||               $)
||               ENDCASE $)

          CASE 'Q':
                 UNTIL  ch = '*N'  |  ch = '*E'  |  ch = endstreamch  DO  
                     ch  :=  rdch()

          CASE endstreamch:
                 BREAK

          DEFAULT:
             writef("*NBad ch '%C' (=%X2)*N", ch, ch)
             error()

          CASE 'E':
             envtrace(cstackp)

          CASE '*N':
             IF  ch = '*N'  THEN 
             $(
                 writef( "%S** ", mc )
                 
                 flushcache()
             $)

nxt:         rch()
       $)
rec:   opened := FALSE
       verified := FALSE

    $) REPEAT

    FOR  i = 1  TO  cacheentries  DO
        freevec( cachepages!i )
$)

.

SECTION "REMOTE-DEBUG2"



GET ""



LET envtrace(p) BE // p = BCPL P pointer  (MC addr)
 $( LET nbase = 0
    LET fsize = 9  // stack frame size
    rch()
    rdflag := FALSE
    SWITCHON ch INTO
    $( DEFAULT:
          error()

       CASE '*N':
          RETURN

       CASE '*E':CASE '*S':
          LOOP

       CASE 'S':
          nbase := val(add)
          GOTO newb

       CASE 'L':
          sptr := val(add)
          GOTO newp

       CASE 'N':
 nxtb:    nbase := cont(sbase+co.cllr)  // select the parent cortn stk
          UNLESS nbase=0 | nbase=-1 DO
          $( writes("*N*NCalled from")
             GOTO newb $)
          nbase := sbase
          nbase := cont(nbase) REPEATUNTIL
             nbase=0 | cont(nbase+co.cllr)=0
          GOTO newb

       CASE 'T': CASE 'B':
          nbase := cont(globv+g.sbase)
 newb:    IF nbase=0 DO
          $( writes("*N*NEnd of backtrace*N*N")
             RETURN $)
          sbase := nbase
       CASE 'U':
          newline(); newline()
          nbase := cont(sbase+co.cllr)
          TEST nbase=-1 THEN
             writes("Root stack")
          ELSE
          $( UNLESS nbase=0 DO writes("Active ")
             writes("Coroutine")
             writearg(cont(sbase+co.func))
          $)
          sptr :=
               (sbase=cont(globv+g.sbase) -> p, cont(sbase+co.resp))>>2
          GOTO newp

 nxtp: CASE 'D':
          IF sptr=sbase GOTO nxtb
          fsize := sptr - (cont(sptr-3)>>2)
          sptr := sptr-fsize
       CASE 'V':
 newp:    IF fsize>8 DO fsize := 8
          newline()
          TEST sptr=sbase THEN
          $( LET send = cont(sbase+co.send)  // no safety margin
             LET shwm = send
             WHILE cont(shwm)=0 DO shwm:=shwm-1
             writef("Stack base %U6 end %U6 *
                    *hwm %U6 ",sbase,send,shwm)
          $)
          ELSE
          $( LET f = cont(sptr-1)
             writearg(f)
             writef("%U6",sptr-3)
             FOR i=0 TO fsize-4 DO
                print(cont(sptr+i))
          $)
          IF fsize<1 DO error()
          testbreak()
          IF ch='B' GOTO nxtp
    $)
    wrch('E')
 $) REPEAT


AND writearg(n) BE  // in width 11
$( LET gn = (n - unglob)/2

   IF isfun(n) DO
   $( writes( "  " )
      writestring( funstring( n ), 7 )
      writes( "  " )
      RETURN
   $)

   IF 0<gn<1000 DO
   $( writef("   glob%I3 ", gn)
      RETURN
   $)

   IF -1000000<n<1000000 DO
   $( writef(" %I9 ", n)
      RETURN
   $)

   writef(" #%X8 ", n)
$)


AND funstring(f) = VALOF
$( 
    LET a     =  f >> 2
    LET name  =  a - 2

    LET word0  =  0
    LET word1  =  0

    word0  :=  remoteread( name + 0 )
    word1  :=  remoteread( name + 1 )
    
    UNLESS  (word0 >> 24) = 7  DO
    $(
        LET len  =  (word1 & #XFF)

        name  :=  a - (len + 1)/bytesperword - 1
    $)

    RESULTIS  name
$)


AND isfun(f) = VALOF
$( 
    LET a     =  f >> 2
    LET name  =  a - 2

    LET word0  =  0
    LET word1  =  0

    UNLESS  a > 3  &  (a >> 10) < memorylimit  &  (f & #B11) = 0  DO
        RESULTIS  FALSE

    word0  :=  remoteread( name + 0 )
    word1  :=  remoteread( name + 1 )
    
    //  Either the length must be 7 (old style BCPL), or the length is at the
    //  end of the string.

    TEST  (word0 >> 24) = 7  THEN  RESULTIS  TRUE
    ELSE
    $(
        LET len  =  (word1 & #XFF)

        name   :=  a - (len + 1)/bytesperword - 1

        UNLESS  name > 0  &  len > 0  DO  RESULTIS  FALSE

        word0  :=  remoteread( name )

        RESULTIS  len = (word0 >> 24)
    $)
$)


||  AND deletebpt(n) BE
||   $( LET ba = bpt.addr!n
||      UNLESS ba=0 DO
||      $( pbytes(ba,2,bpt.instr!n)
||         bpt.addr!n := 0
||      $)
||   $)


AND lexp() = VALOF
    SWITCHON ch INTO
    $( CASE 'A': CASE 'G': CASE 'L':
       CASE 'R': CASE 'V': CASE 'W':
       CASE 'Y':
          tch := ch
          RESULTIS rbexp()

       DEFAULT:
          error()
    $)


AND rbexp() = VALOF
 $( rch()
    RESULTIS bexp() $)


AND bexp() = VALOF
 $( LET t = tch
    LET n = 0
    LET r = 10
    WHILE ch='*S' | ch='+' DO rch()
    SWITCHON ch INTO
    $( CASE '-':
          RESULTIS -rbexp()

       CASE '(':
          n := exp(rbexp())
          UNLESS ch=')' DO error()
          rch()
          ENDCASE

       CASE '!':
          RESULTIS cont(rbexp())

       CASE '@':
          rch()
          n := adr(lexp())
          ENDCASE

       CASE 'A': CASE 'G': CASE 'L':
       CASE 'R': CASE 'V': CASE 'W':
       CASE 'Y':
          n := val(lexp())
          ENDCASE

       CASE '*'':
          rch()
          n := lch
          rch()
          ENDCASE

       CASE '#':
          r := 16
          rch()
          IF ch='O' DO
          $( r := 8
             rch() $)
       DEFAULT:
          $( LET d = '0'<=ch<='9' -> ch-'0',
              r=16 & 'A'<=ch<='F' -> ch-'A'+10,
                                     VALOF BREAK
             n := n*r+d
             rch()
          $) REPEAT
    $)
    tch := t
    RESULTIS n
 $)

AND exp(a) = VALOF
    SWITCHON ch INTO
    $( CASE '<': a := a<<1; rch();    LOOP
       CASE '>': a := a>>1; rch();    LOOP
       CASE '+': a := a  +  rbexp();  LOOP
       CASE '-': a := a  -  rbexp();  LOOP
       CASE '**':a := a  *  rbexp();  LOOP
       CASE '%': a := a  /  rbexp();  LOOP
       CASE '?': a := a REM rbexp();  LOOP
       CASE '&': a := a  &  rbexp();  LOOP
       CASE '|': a := a  |  rbexp();  LOOP
       CASE '!': a := cont(a+rbexp());LOOP
       CASE '*S':rch();               LOOP
       DEFAULT:  RESULTIS a
    $) REPEAT


AND adr(a) = tch='Y' -> a, checkaddr(a+VALOF
       SWITCHON tch INTO
       $( CASE 'A': RESULTIS 0
          CASE 'G': RESULTIS globv
          CASE 'L': RESULTIS sptr
          CASE 'R': RESULTIS regs
          CASE 'V': checkdig(a)
                    RESULTIS vars
          CASE 'W': RESULTIS currtcb
       $) )


AND val(a) = tch=0  -> a, remoteread( adr(a) )


AND printadd(tch, add) BE
    writef("*N%X6: %C%U2/ ", adr(add)<<2, tch, add)


AND print(n) BE SWITCHON style INTO
$( CASE 'C': writef("%C%C%C%C ", n>>24, n>>16, n>>8, n)
             RETURN
   CASE 'D': writef("%I9 ", n);     RETURN
   CASE 'U': writef("%U9 ", n);     RETURN
   CASE 'S': writestring( n, 0 );   RETURN
   CASE 'X': writef("%X8 ", n);     RETURN
   CASE 'F':
   DEFAULT:  writearg(n);           RETURN
$)



AND writestring( address, width )  BE
$(
    LET buffer  =  VEC 256/bytesperword
    LET word0   =  remoteread( address )
    LET length  =  (word0 >> 24) / bytesperword
    
    FOR  i = 0  TO  length  DO  buffer!i  :=  remoteread( address+i )

    writes( buffer )

    FOR  i = buffer % 0  TO  width-1  DO  wrch( '*S' )
$)


AND checkdig(n) = VALOF
 $( UNLESS 0<=n<=9 DO error()
    RESULTIS n $)


AND checkaddr(a) = VALOF
$( IF (a>>10)>=memorylimit DO error()
   RESULTIS a
$)


AND cont(a) = remoteread( checkaddr(a) )


AND selectask(n) BE
$( 
    LET t       =  remoteread( rootnode+rtn.tasktab )
    LET tsize   =  remoteread( t )
    
    LET stackp  =  0
    LET state   =  0
    LET waitsp  =  0
    LET suspsp  =  0
    LET intsp   =  0
    LET sbase   =  0
    LET send    =  0
    LET mcbase  =  0
    LET mcend   =  0

    UNLESS -1<=n<=tsize DO error()
    IF n>0 & remoteread( t+n )=0 DO error()

    currtask := n
    currtcb  := idletcb

    IF n>0 DO currtcb := remoteread( t+n )
    IF n<0 DO currtcb := remoteread( rootnode+rtn.crntask )

    globv    :=  remoteread( currtcb+tcb.gbase )
    cstackp  :=  0

    stackp   :=  remoteread(currtcb+tcb.sp)
    state    :=  remoteread(currtcb+tcb.state)

    waitsp   :=  longword( stackp, 0 )
    suspsp   :=  longword( stackp, 4 )
    intsp    :=  longword( stackp, 60 )

    sbase    :=  remoteread( globv + g.sbase )
    send     :=  remoteread( sbase + co.send )
        
    mcbase   :=  sbase * bytesperword
    mcend    :=  send  * bytesperword

    SWITCHON  state & #B1100  INTO
    $( 
        DEFAULT     :  //  Should never happen ...

        CASE #B0000 :  //  Task was active, so cannot read true stack 
                       //  pointer.  There are three possibilities:
                       //  
                       //      a)  The task was last waiting
                       //      b)  The task was last interrupted
                       //      c)  The task is suspended

                       TEST  mcbase < waitsp < mcend  THEN  cstackp  :=  waitsp  ELSE
                       TEST  mcbase < suspsp < mcend  THEN  cstackp  :=  suspsp  ELSE
                       TEST  mcbase < intsp  < mcend  THEN  cstackp  :=  intsp
                       ELSE
                       $(
                           //  Not one of the above, so we had better attempt
                           //  to search for the stack pointer in some
                           //  other way.  Search back up the TCB from where
                           //  the stack pointer is pointing, and look for
                           //  something which points into the stack frame.
                           //  Then check that the stack frame is valid.
                           
                           LET tcblow  =  (currtcb)           * bytesperword
                           LET tcbupb  =  (currtcb + tcb.upb) * bytesperword
                           
                           UNLESS  tcblow <= stackp <= tcbupb  DO  error()
                           
                           FOR  p = stackp  TO  tcbupb  BY  4  DO
                           $(
                               LET item  =  longword( p, 0 )

                               IF  (item & #B11) = 0  &  (mcbase < item < mcend)  THEN
                               $(
                                   //  Looks hopeful.  This points into the
                                   //  stack frame.  Is it a frame pointer
                                   //  though ?
                                   
                                   LET rvitem  =  longword( item, -12 )
                                   
                                   IF  (rvitem & #B11) = 0  &  (mcbase < rvitem < mcend)  THEN
                                   $(
                                       //  Cor.  This could be it folks.
                                       //  Assume that it is, and stop looking.
                                       
                                       cstackp  :=  item
                                       
                                       BREAK
                                   $)
                               $)
                           $)

                           IF  cstackp = 0  THEN
                           
                               //  Still no joy.  There is one last hope, and
                               //  that is to look for the bcpl stack pointer
                               //  one halfword offset from where we would
                               //  naively expect.

                               FOR  p = stackp+2  TO  tcbupb  BY  4  DO
                               $(
                                   LET item  =  longword( p, 0 )

                                   IF  (item & #B11) = 0  &  (mcbase < item < mcend)  THEN
                                   $(
                                       //  Looks hopeful.  This points into the
                                       //  stack frame.  Is it a frame pointer
                                       //  though ?
                                   
                                       LET rvitem  =  longword( item, -12 )
                                   
                                       IF  (rvitem & #B11) = 0  &  (mcbase < rvitem < mcend)  THEN
                                       $(
                                           //  Cor.  This could be it folks.
                                           //  Assume that it is, and stop looking.
                                       
                                           cstackp  :=  item
                                       
                                           BREAK
                                       $)
                                   $)
                               $)

                           IF  cstackp = 0  THEN
                               writef( "Task %N active  -  cannot find stack pointer*N", currtask )
                       $)
                       ENDCASE
                           

        CASE #B0100 :  cstackp  :=  waitsp
                       ENDCASE


        CASE #B1000 :  cstackp  :=  intsp
                       ENDCASE
    $)
$)



AND longword( address, offset )  =  VALOF
$(
    LET mcaddr  =  address + offset
    LET addr    =  mcaddr  /  bytesperword
    LET left    =  mcaddr REM bytesperword
    
    TEST  left = 0
        THEN  RESULTIS  remoteread( addr )
        ELSE  RESULTIS  (remoteread( addr ) << 16) + (remoteread( addr+1 ) >> 16)
$)


AND error() BE
 $( writes("??*N")
    UNLESS rdflag DO rch()
    longjump(standalone->salev,lev, rec)
 $)


AND testbreak() BE UNLESS standalone DO
    IF testflags(1) DO error()              // ARW
// RETURN //**************************************************

AND rch() BE
 $( TEST standalone THEN
    $( lch := sardch()
       IF lch=#X7F DO error() // ASCII DEL! ARW
     $)
    ELSE
    $( IF wrflag DO wrch('*E')
       wrflag := FALSE
       testbreak()
       lch := rdch()
       testflags(1) //************************************* ARW
    $)
    ch := capitalch(lch)
    rdflag := TRUE
 $)


AND wch(c) BE
 $( c := c&#377
    TEST standalone THEN
       sawrch(c)
    ELSE
    $( wrflag := TRUE
       wwrch(c)
    $)
 $)


