File:  [gforth] / gforth / arch / c165 / prim.fs
Revision 1.1: download - view: text, annotated - select for diffs
Sat May 2 21:33:51 1998 UTC (23 years, 7 months ago) by pazsan
Branches: MAIN
CVS tags: v0-5-0, v0-4-0, HEAD
Mega-Patch; added directories

    1: 
    2: start-macros
    3: 
    4:   $04 Rb: tosl    $05 Rb: tosh
    5:   $08 Rb: temp1l  $09 Rb: temp1h
    6: 
    7:   $00 Rw: sp      $01 Rw: rp      $02 Rw: tos     $03 Rw: ip
    8:   $04 Rw: temp1   $05 Rw: temp2
    9: 
   10: : next,
   11:    \  cc_uc , (debug calla,       \ Debugger-Aufruf
   12:     temp1 , ip ]+ mov,          \ fetch cfa
   13:     temp2 , temp1 ]+ mov,        \ get code address
   14:     cc_uc , temp2 ] jmpi, 
   15:     ;
   16: 
   17: : next1,
   18:     temp2 , temp1 ]+ mov,
   19:     cc_uc , temp2 ] jmpi,
   20:    ;
   21: 
   22: end-macros
   23: 
   24: Label into-forth
   25:     ip , $ffff # mov,
   26:     sp , $fd80 # mov,
   27:     rp , $fde0 # mov,
   28:     next,
   29: End-Label
   30: 
   31: Label (dout)
   32:     _s0tic . 7 , here jnb,   _s0tic . 7 bclr,
   33:     _s0tbuf , rl6 movb,   ret,
   34: End-Label
   35: 
   36: Start-Macros
   37: 
   38: \ : dout,	>r rl6 , r> # movb,
   39: \	cc_uc , (dout) Calla, ;
   40: 
   41: : dout,  drop ;
   42: 
   43: end-macros
   44: 
   45: Code: :docol
   46:     ': dout,
   47:     rp -] , ip mov,             \ store IP on return stack
   48:     ip , temp1 mov,             \ 
   49:     ip , 2 # add,               \ zum PFA
   50:     next,
   51: End-Code
   52: 
   53: Code ;s
   54:     '; dout,
   55:     ip , rp ]+ mov,             \ fetch callback address
   56:     next,
   57: End-Code
   58: 
   59: \ Rest						25jul97jaw
   60: 
   61: Code: :dovar
   62:     '2 dout,
   63:     sp -] , tos mov,
   64:     temp1 , 2 # add,
   65:     tos , temp1 mov,
   66:     next,
   67: End-Code
   68: 
   69: Code: :docon
   70:     '1 dout,
   71:     sp -] , tos mov,
   72:     temp1 , 2 # add,
   73:     tos , temp1 ] mov,
   74:     next,
   75: End-Code
   76: 
   77: Code: :dodoes
   78:     '6 dout,
   79:     rp -] , ip mov,
   80:     ip , temp1 ] mov,
   81:     sp -] , tos mov,
   82:     temp1 , 2 # add,
   83:     tos , temp1 mov,
   84:     next,
   85: End-Code
   86:     
   87: Code: :dodefer
   88:     '4 dout,
   89:     temp1 , 2 # add,
   90:     temp1 , temp1 ] mov,
   91:     Next1,
   92: End-Code
   93: 
   94: Code execute	( xt -- ) \ execute colon definition
   95:     'E dout,
   96:     rp -] , ip mov,             \ store IP on return stack
   97:     temp1 , tos mov,
   98:     tos , sp ]+ mov,
   99:     Next1,
  100: End-Code   
  101: 
  102: \ Zusatzroutinen zu bedingten Befehlen          ( 17.06.96/KK )
  103:   Code branch   ( -- ) \ Inline-Sprung ausfhren
  104:     ip , ip ] add,  next,
  105:    End-Code
  106: 
  107:   Code ?branch  ( f -- ) \ Test und Sprung bei 0
  108:     tos , tos mov,
  109:     cc_z IF,  tos , sp ]+ mov,   ip , ip ] add,    next,  THEN,
  110:               tos , sp ]+ mov,   ip , 2 s#  add,   next,
  111:    End-Code
  112: 
  113:   Code lit     ( -- n ) \ Inline-Literal lesen
  114:     sp -] , tos mov,   tos , ip ]+ mov,   next,
  115:    End-Code
  116: 
  117: \ Stack Words                                     ( 17.06.96/KK )
  118: 
  119:   Code dup      ( n -- n n ) \ TOS verdoppeln
  120:     sp -] , tos mov,   next,
  121:    End-Code
  122: 
  123:   Code 2dup     ( d -- d d ) \ TOS/NOS verdoppeln
  124:     temp1 , sp ] mov,   sp -] , tos mov,
  125:     sp -] , temp1 mov,   next,
  126:    End-Code
  127: 
  128:   Code drop     ( n -- ) \ TOS entfernen
  129:     tos , sp ]+ mov,   next,
  130:    End-Code
  131: 
  132:   Code 2drop    ( d -- ) \ TOS/NOS entfernen
  133:     sp , 2 s# add,   tos , sp ]+ mov,   next,
  134:    End-Code
  135: 
  136:   Code swap     ( n1 n2 -- n2 n1 ) \ TOS/NOS vertauschen
  137:     temp1 , sp ] mov,   sp ] , tos mov,   tos , temp1 mov,
  138:     next,
  139:    End-Code
  140: 
  141:   Code over     ( n1 n2 -- n1 n2 n1 ) \ NOS verdoppeln
  142:     sp -] , tos mov,   tos , sp 2 #] mov,   next,
  143:    End-Code
  144: 
  145:   Code rot     ( n1 n2 n3 -- n2 n3 n1 ) \ Rotieren
  146:     temp1 , sp ]+ mov,   temp2 , sp ]+ mov,
  147:     sp -] , temp1 mov,   sp -] , tos mov,
  148:     tos , temp2 mov,   next,                           End-Code
  149: 
  150:   Code -rot     ( n1 n2 n3 -- n3 n1 n2 ) \ Rotieren
  151:     temp1 , sp ]+ mov,   temp2 , sp ]+ mov,
  152:     sp -] , tos mov,   sp -] , temp2 mov,
  153:     tos , temp1 mov,   next,                           End-Code
  154: 
  155: Code sp@
  156:     sp -] , tos mov,
  157:     tos , sp mov,
  158:     next,
  159: End-Code
  160: 
  161: Code sp!
  162:     sp , tos mov,
  163:     tos , sp ]+ mov,
  164:     next,
  165: End-Code
  166: 
  167: Code rp@
  168:     sp -] , tos mov,
  169:     tos , rp mov,
  170:     next,
  171: End-Code
  172: 
  173: Code rp!
  174:     rp , tos mov,
  175:     tos , sp ]+ mov,
  176:     next,
  177: End-Code
  178: 
  179: Code r>
  180:     sp -] , tos mov,
  181:     tos , rp ]+ mov,
  182:     next,
  183: End-Code
  184: 
  185: Code >r
  186:     rp -] , tos mov,
  187:     tos , sp ]+ mov,
  188:     next,
  189: End-Code
  190:     
  191: Code r@
  192:     sp -] , tos mov,
  193:     tos , rp ] mov,
  194:     next,
  195: End-Code
  196: 
  197: \ Arithmetik					 ( 17.06.96/KK )
  198: 
  199:   Code +        ( n1 n2 -- n3 ) \ Addition
  200:     tos , sp ]+ add,   next,
  201:    End-Code
  202: 
  203:   Code -        ( n1 n2 -- n3 ) \ Subtraktion
  204:     temp1 , tos mov,   tos , sp ]+ mov,
  205:     tos , temp1 sub,   next,
  206:    End-Code
  207: 
  208:   Code and      ( n1 n2 -- n3 ) \ Logische AND-Verknpfung
  209:     tos , sp ]+ and,   next,
  210:    End-Code
  211: 
  212:   Code xor      ( n1 n2 -- n3 ) \ Logische AND-Verknpfung
  213:     tos , sp ]+ xor,   next,
  214:    End-Code
  215: 
  216:   Code or       ( n1 n2 -- n3 ) \ Logische OR-Verknpfung
  217:     tos , sp ]+ or,   next,
  218:    End-Code
  219: 
  220:   Code 0=       ( n -- f ) \ Test auf 0
  221:     tos , tos mov,
  222:     cc_z IF,  tos , -1 # mov,  ELSE,  tos , 0 s# mov,  THEN,
  223:     next,
  224:    End-Code
  225: 
  226:   Code =        ( n1 n2 -- f ) \ Test auf Gleichheit
  227:     tos , sp ]+ sub,
  228:     cc_z IF,  tos , -1 # mov,  ELSE,  tos , 0 s# mov,  THEN,
  229:     next,
  230:    End-Code
  231: 
  232: \ Memory                                     ( 01.01.97/KK )
  233: 
  234:   Code c@       ( addr -- c ) \ Byte auslesen
  235:     tosl , tos ] movb,   tosh , 0 s# movb,   next,
  236:    End-Code
  237: 
  238:   Code @        ( addr -- n ) \ Wort auslesen
  239:     tos , tos ] mov,   next,
  240:    End-Code
  241: 
  242:   Code c!       ( c addr -- ) \ Byte schreiben
  243:     temp1 , sp ]+ mov,   tos ] , temp1l movb,
  244:     tos , sp ]+ mov,   next,
  245:    End-Code
  246: 
  247:   Code !        ( n addr -- ) \ Wort schreiben
  248:     temp1 , sp ]+ mov,   tos ] , temp1 mov,
  249:     tos , sp ]+ mov,   next,
  250:    End-Code
  251: 
  252: 
  253: \ SIO-Grundroutinen                             ( 09.06.96/KK )
  254:   Code key?     ( -- f ) \ Flag, ob Zeichen anliegt
  255:     sp -] , tos mov,   tos , 0 s# mov,
  256:     _s0ric . 7 , here 6 + jnb,
  257:     tos , 1 s# sub,   next,                            End-Code
  258:   Code (key)      ( -- char ) \ Zeichen holen
  259:     _s0ric . 7 , here jnb,   _s0ric . 7 bclr,   sp -] , tos mov,
  260:     tosh , 0 s# movb,   tosl , _s0rbuf movb,   next,   End-Code
  261:   Code emit?    ( -- f ) \ Flag, ob Zeichen ausgebbar
  262:     sp -] , tos mov,   tos , 0 s# mov,
  263:     _s0tic . 7 , here 6 + jnb,
  264:     tos , 1 s# sub,   next,                            End-Code
  265:   Code (emit)     ( char -- ) \ Zeichen ausgeben
  266:     _s0tic . 7 , here jnb,   _s0tic . 7 bclr,
  267:     _s0tbuf , tosl movb,   tos , sp ]+ mov,   next,    End-Code

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>