File:  [gforth] / gforth / arch / c165 / prim.fs
Revision 1.2: download - view: text, annotated - select for diffs
Sun Sep 16 10:26:42 2001 UTC (20 years, 2 months ago) by jwilke
Branches: MAIN
CVS tags: v0-7-0, v0-6-2, v0-6-1, v0-6-0, HEAD
fix

    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:     temp1 , tos mov,
   97:     tos , sp ]+ mov,
   98:     Next1,
   99: End-Code   
  100: 
  101: \ Zusatzroutinen zu bedingten Befehlen          ( 17.06.96/KK )
  102:   Code branch   ( -- ) \ Inline-Sprung ausfhren
  103:     ip , ip ] add,  next,
  104:    End-Code
  105: 
  106:   Code ?branch  ( f -- ) \ Test und Sprung bei 0
  107:     tos , tos mov,
  108:     cc_z IF,  tos , sp ]+ mov,   ip , ip ] add,    next,  THEN,
  109:               tos , sp ]+ mov,   ip , 2 s#  add,   next,
  110:    End-Code
  111: 
  112:   Code lit     ( -- n ) \ Inline-Literal lesen
  113:     sp -] , tos mov,   tos , ip ]+ mov,   next,
  114:    End-Code
  115: 
  116: \ Stack Words                                     ( 17.06.96/KK )
  117: 
  118:   Code dup      ( n -- n n ) \ TOS verdoppeln
  119:     sp -] , tos mov,   next,
  120:    End-Code
  121: 
  122:   Code 2dup     ( d -- d d ) \ TOS/NOS verdoppeln
  123:     temp1 , sp ] mov,   sp -] , tos mov,
  124:     sp -] , temp1 mov,   next,
  125:    End-Code
  126: 
  127:   Code drop     ( n -- ) \ TOS entfernen
  128:     tos , sp ]+ mov,   next,
  129:    End-Code
  130: 
  131:   Code 2drop    ( d -- ) \ TOS/NOS entfernen
  132:     sp , 2 s# add,   tos , sp ]+ mov,   next,
  133:    End-Code
  134: 
  135:   Code swap     ( n1 n2 -- n2 n1 ) \ TOS/NOS vertauschen
  136:     temp1 , sp ] mov,   sp ] , tos mov,   tos , temp1 mov,
  137:     next,
  138:    End-Code
  139: 
  140:   Code over     ( n1 n2 -- n1 n2 n1 ) \ NOS verdoppeln
  141:     sp -] , tos mov,   tos , sp 2 #] mov,   next,
  142:    End-Code
  143: 
  144:   Code rot     ( n1 n2 n3 -- n2 n3 n1 ) \ Rotieren
  145:     temp1 , sp ]+ mov,   temp2 , sp ]+ mov,
  146:     sp -] , temp1 mov,   sp -] , tos mov,
  147:     tos , temp2 mov,   next,                           End-Code
  148: 
  149:   Code -rot     ( n1 n2 n3 -- n3 n1 n2 ) \ Rotieren
  150:     temp1 , sp ]+ mov,   temp2 , sp ]+ mov,
  151:     sp -] , tos mov,   sp -] , temp2 mov,
  152:     tos , temp1 mov,   next,                           End-Code
  153: 
  154: Code sp@
  155:     sp -] , tos mov,
  156:     tos , sp mov,
  157:     next,
  158: End-Code
  159: 
  160: Code sp!
  161:     sp , tos mov,
  162:     tos , sp ]+ mov,
  163:     next,
  164: End-Code
  165: 
  166: Code rp@
  167:     sp -] , tos mov,
  168:     tos , rp mov,
  169:     next,
  170: End-Code
  171: 
  172: Code rp!
  173:     rp , tos mov,
  174:     tos , sp ]+ mov,
  175:     next,
  176: End-Code
  177: 
  178: Code r>
  179:     sp -] , tos mov,
  180:     tos , rp ]+ mov,
  181:     next,
  182: End-Code
  183: 
  184: Code >r
  185:     rp -] , tos mov,
  186:     tos , sp ]+ mov,
  187:     next,
  188: End-Code
  189:     
  190: Code r@
  191:     sp -] , tos mov,
  192:     tos , rp ] mov,
  193:     next,
  194: End-Code
  195: 
  196: \ Arithmetik					 ( 17.06.96/KK )
  197: 
  198:   Code +        ( n1 n2 -- n3 ) \ Addition
  199:     tos , sp ]+ add,   next,
  200:    End-Code
  201: 
  202:   Code -        ( n1 n2 -- n3 ) \ Subtraktion
  203:     temp1 , tos mov,   tos , sp ]+ mov,
  204:     tos , temp1 sub,   next,
  205:    End-Code
  206: 
  207:   Code and      ( n1 n2 -- n3 ) \ Logische AND-Verknpfung
  208:     tos , sp ]+ and,   next,
  209:    End-Code
  210: 
  211:   Code xor      ( n1 n2 -- n3 ) \ Logische AND-Verknpfung
  212:     tos , sp ]+ xor,   next,
  213:    End-Code
  214: 
  215:   Code or       ( n1 n2 -- n3 ) \ Logische OR-Verknpfung
  216:     tos , sp ]+ or,   next,
  217:    End-Code
  218: 
  219:   Code 0=       ( n -- f ) \ Test auf 0
  220:     tos , tos mov,
  221:     cc_z IF,  tos , -1 # mov,  ELSE,  tos , 0 s# mov,  THEN,
  222:     next,
  223:    End-Code
  224: 
  225:   Code =        ( n1 n2 -- f ) \ Test auf Gleichheit
  226:     tos , sp ]+ sub,
  227:     cc_z IF,  tos , -1 # mov,  ELSE,  tos , 0 s# mov,  THEN,
  228:     next,
  229:    End-Code
  230: 
  231: \ Memory                                     ( 01.01.97/KK )
  232: 
  233:   Code c@       ( addr -- c ) \ Byte auslesen
  234:     tosl , tos ] movb,   tosh , 0 s# movb,   next,
  235:    End-Code
  236: 
  237:   Code @        ( addr -- n ) \ Wort auslesen
  238:     tos , tos ] mov,   next,
  239:    End-Code
  240: 
  241:   Code c!       ( c addr -- ) \ Byte schreiben
  242:     temp1 , sp ]+ mov,   tos ] , temp1l movb,
  243:     tos , sp ]+ mov,   next,
  244:    End-Code
  245: 
  246:   Code !        ( n addr -- ) \ Wort schreiben
  247:     temp1 , sp ]+ mov,   tos ] , temp1 mov,
  248:     tos , sp ]+ mov,   next,
  249:    End-Code
  250: 
  251: 
  252: \ SIO-Grundroutinen                             ( 09.06.96/KK )
  253:   Code key?     ( -- f ) \ Flag, ob Zeichen anliegt
  254:     sp -] , tos mov,   tos , 0 s# mov,
  255:     _s0ric . 7 , here 6 + jnb,
  256:     tos , 1 s# sub,   next,                            End-Code
  257:   Code (key)      ( -- char ) \ Zeichen holen
  258:     _s0ric . 7 , here jnb,   _s0ric . 7 bclr,   sp -] , tos mov,
  259:     tosh , 0 s# movb,   tosl , _s0rbuf movb,   next,   End-Code
  260:   Code emit?    ( -- f ) \ Flag, ob Zeichen ausgebbar
  261:     sp -] , tos mov,   tos , 0 s# mov,
  262:     _s0tic . 7 , here 6 + jnb,
  263:     tos , 1 s# sub,   next,                            End-Code
  264:   Code (emit)     ( char -- ) \ Zeichen ausgeben
  265:     _s0tic . 7 , here jnb,   _s0tic . 7 bclr,
  266:     _s0tbuf , tosl movb,   tos , sp ]+ mov,   next,    End-Code

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