Annotation of gforth/arch/r8c/prim.fs, revision 1.16

1.1       pazsan      1: \ r8c/m16c primitives
                      2: 
                      3: \ Copyright (C) 2006 Free Software Foundation, Inc.
                      4: 
                      5: \ This file is part of Gforth.
                      6: 
                      7: \ Gforth is free software; you can redistribute it and/or
                      8: \ modify it under the terms of the GNU General Public License
                      9: \ as published by the Free Software Foundation; either version 2
                     10: \ of the License, or (at your option) any later version.
                     11: 
                     12: \ This program is distributed in the hope that it will be useful,
                     13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
                     14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     15: \ GNU General Public License for more details.
                     16: 
                     17: \ You should have received a copy of the GNU General Public License
                     18: \ along with this program; if not, write to the Free Software
                     19: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
                     20: 
                     21: \ * Register using for r8c
                     22: \  Renesas  Forth    used for
                     23: \   R0      TOS   oberstes Stackelement
                     24: \   R3      RP    Returnstack Pointer
                     25: \   SP      SP    Stack Pointer
                     26: \   A1      IP    Instruction Pointer
                     27: \   A0      W     Arbeitsregister
                     28: \
                     29: \ * Memory ( use only one 64K-Page ): TBD
                     30: \ **************************************************************
                     31: 
                     32: 
                     33: start-macros
                     34:  \ register definition
1.2       pazsan     35:   ' R0L Alias tos.b
1.1       pazsan     36: 
1.7       pazsan     37:  \ hfs wichtig, damit der erste Befehl richtig compiliert wird
                     38:    reset  \ hfs
                     39: 
1.1       pazsan     40:  \ system depending macros
1.8       pazsan     41:   : next1,
                     42:       [w] , r1 mov.w:g  r1 jmpi.a ;
1.1       pazsan     43:   : next,
                     44:       [ip] , w mov.w:g
1.8       pazsan     45:       # 2 , ip add.w:q  next1, ;
1.1       pazsan     46: \ note that this is really for 8086 and 286, and _not_ intented to run
                     47: \ fast on a Pentium (Pro). These old chips load their code from real RAM
                     48: \ and do it slow, anyway.
                     49: \ If you really want to have a fast 16 bit Forth on modern processors,
                     50: \ redefine it as
                     51: \ : next,  [ip] w mov,  2 # ip add,  [w] jmp, ;
                     52: 
                     53: end-macros
                     54: 
                     55:   unlock
1.2       pazsan     56:     $0000 $FFFF region address-space
                     57:     $C000 $4000 region rom-dictionary
1.5       pazsan     58:     $0400 $0400 region ram-dictionary
1.2       pazsan     59:   .regions
                     60:   setup-target
1.1       pazsan     61:   lock
                     62: 
                     63: \ ==============================================================
                     64: \ rom starts with jump to GFORTH-kernel (must be at $0000 !!!)
                     65: \ ==============================================================
                     66:   Label into-forth
                     67:     # $ffff , ip mov.w:g            \ ip will be patched
1.15      pazsan     68:     # $0780 , sp ldc                \ sp at $0600...$0700
1.13      pazsan     69:     # $07FE , rp mov.w:g            \ rp at $0700...$07FE
1.9       pazsan     70:     # $0F , $E3  mov.b:g
                     71:     # $0F , $E1  mov.b:g
1.16    ! pazsan     72:   Label mem-init
        !            73:     $01 , $0A bset
        !            74:     $00 , $05 bset
        !            75:     $01 , $0A bclr
1.9       pazsan     76:   Label clock-init                  \ default is 125kHz/8
1.12      pazsan     77:     $00 , $0A  bset
1.10      pazsan     78:     # $28 , $07  mov.b:g
1.9       pazsan     79:     # $08 , $06  mov.b:g
1.16    ! pazsan     80:     AHEAD  THEN
1.12      pazsan     81:     2 , $0C bclr
1.9       pazsan     82:     # $00 , $08  mov.b:g            \ set to 20MHz
1.12      pazsan     83:     $00 , $0A  bclr
1.5       pazsan     84:   Label uart-init
1.13      pazsan     85:     # $27 , $B0  mov.b:g      \ hfs
                     86:     # $8105 , $A8  mov.w:g    \ ser1: 9600 baud, 8N1  \ hfs
1.10      pazsan     87:     # $0500 , $AC  mov.w:g      \ hfs
1.14      pazsan     88:   Label lcd-init
                     89:     $02 , $0A bset
                     90:     # $FD , $E2 mov.b:g
                     91:   next,
1.1       pazsan     92:   End-Label
                     93: 
                     94: 
                     95: \ ==============================================================
                     96: \ GFORTH minimal primitive set
                     97: \ ==============================================================
                     98:  \ inner interpreter
                     99:   Code: :docol
                    100:   \     ': dout,                    \ only for debugging
                    101:      # -2 , rp add.w:q
1.7       pazsan    102:      w , r1 mov.w:g
1.1       pazsan    103:      rp , w mov.w:g  ip , [w] mov.w:g
1.7       pazsan    104:      # 4 , r1 add.w:q  r1 , ip mov.w:g
1.1       pazsan    105:      next,
                    106:    End-Code
                    107: 
                    108:   Code: :dovar
                    109: \    '2 dout,                    \ only for debugging
1.2       pazsan    110:     tos push.w:g
1.1       pazsan    111:     # 4 , w add.w:q
                    112:     w , tos mov.w:g
                    113:     next,
                    114:   End-Code
                    115: 
1.4       pazsan    116:   Code: :docon
                    117: \    '2 dout,                    \ only for debugging
                    118:     tos push.w:g
1.10      pazsan    119:     4 [w] , tos mov.w:g
1.4       pazsan    120:     next,
                    121:   End-Code
                    122: 
1.8       pazsan    123:   Code: :dovalue
                    124: \    '2 dout,                    \ only for debugging
                    125:     tos push.w:g
1.10      pazsan    126:     4 [w] , w mov.w:g  [w] , tos mov.w:g
1.8       pazsan    127:     next,
1.4       pazsan    128:   End-Code
                    129: 
1.13      pazsan    130:   Code: :dofield
                    131:       4 [w] , tos add.w:g
                    132:       next,
                    133:   end-code
                    134:   
1.9       pazsan    135:   Code: :dodefer
1.10      pazsan    136: \      # $05 , $E1 mov.b:g
                    137:      4 [w] , w mov.w:g  [w] , w mov.w:g
1.9       pazsan    138:      next1,
                    139:   End-Code
1.8       pazsan    140: 
1.1       pazsan    141:   Code: :dodoes  ( -- pfa ) \ get pfa and execute DOES> part
                    142: \    '6 dout,                    \ only for debugging
1.8       pazsan    143: \      # $06 , $E1 mov.b:g
                    144:      tos push.w:g
                    145:      w , tos mov.w:g   # 4 , tos add.w:q
1.7       pazsan    146:      # -2 , rp add.w:q
1.13      pazsan    147:      rp , w mov.w:g  ip , [w] mov.w:g
1.10      pazsan    148:      2 [w] , r1 mov.w:g
1.7       pazsan    149:      # 4 , r1 add.w:q  r1 , ip mov.w:g
1.1       pazsan    150:      next,                                       \ execute does> part
1.5       pazsan    151:   End-Code
                    152:   
1.1       pazsan    153:  \ program flow
                    154:   Code ;s       ( -- ) \ exit colon definition
                    155: \    '; dout,                    \ only for debugging
                    156:       rp , w mov.w:g  # 2 , rp add.w:q
                    157:       [w] , ip mov.w:g
                    158:       next,
                    159:   End-Code
                    160: 
                    161:   Code execute   ( xt -- ) \ execute colon definition
                    162: \    'E dout,                    \ only for debugging
1.10      pazsan    163: \    # $07 , $E1 mov.b:g
1.8       pazsan    164:     tos , w mov.w:g                          \ copy tos to w
                    165:     tos pop.w:g                              \ get new tos
                    166:     next1,
1.1       pazsan    167:   End-Code
                    168: 
1.10      pazsan    169:   Code ?branch   ( f -- ) \ jump on f=0
1.7       pazsan    170:       # 2 , ip add.w:q
1.10      pazsan    171:       tos , tos tst.w   0= IF  -2 [ip] , ip mov.w:g   THEN
1.11      pazsan    172:       tos pop.w:g
1.2       pazsan    173:       next,
1.1       pazsan    174:   End-Code
                    175: 
1.10      pazsan    176:   Code (for) ( n -- r:0 r:n )
                    177:       # -4 , rp add.w:q  rp , w mov.w:g
                    178:       r3 , 2 [w] mov.w:g
                    179:       tos , [w] mov.w:g
                    180:       tos pop.w:g
                    181:       next,
                    182:   End-Code
                    183:   
                    184:   Code (?do) ( n -- r:0 r:n )
                    185:       # 2 , ip add.w:q
                    186:       # -4 , rp add.w:q  rp , w mov.w:g
                    187:       tos , [w] mov.w:g
                    188:       r1 pop.w:g
                    189:       r1 , 2 [w] mov.w:g
                    190:       tos pop.w:g
                    191:       [w] , r1 sub.w:g
                    192:       0= IF  -2 [ip] , ip mov.w:g   THEN
                    193:       next,
                    194:   End-Code
                    195:   
                    196:   Code (do) ( n -- r:0 r:n )
                    197:       # -4 , rp add.w:q  rp , w mov.w:g
                    198:       tos , [w] mov.w:g
                    199:       tos pop.w:g
                    200:       tos , 2 [w] mov.w:g
                    201:       tos pop.w:g
                    202:       next,
                    203:   End-Code
                    204:   
                    205:   Code (next) ( -- )
                    206:       # 2 , ip add.w:q
                    207:       rp , w mov.w:g  [w] , r1 mov.w:g
                    208:       # -1 , r1 add.w:q  r1 , [w] mov.w:g
                    209:       u>= IF  -2 [ip] , ip mov.w:g  THEN
                    210:       next,
                    211:   End-Code
                    212: 
                    213:   Code (loop) ( -- )
                    214:       # 2 , ip add.w:q
                    215:       rp , w mov.w:g  [w] , r1 mov.w:g
                    216:       # 1 , r1 add.w:q  r1 , [w] mov.w:g
                    217:       2 [w] , r1 sub.w:g
                    218:       0<> IF  -2 [ip] , ip mov.w:g  THEN
                    219:       next,
                    220:   End-Code
1.1       pazsan    221: 
                    222:  \ memory access
                    223:   Code @        ( addr -- n ) \ read cell
1.2       pazsan    224:       tos , w mov.w:g  [w] , tos mov.w:g
1.1       pazsan    225:       next,
                    226:    End-Code
                    227: 
                    228:   Code !        ( n addr -- ) \ write cell
1.2       pazsan    229:       tos , w mov.w:g  tos pop.w:g  tos , [w] mov.w:g
                    230:       tos pop.w:g
                    231:       next,
                    232:    End-Code
                    233: 
                    234:   Code c@        ( addr -- n ) \ read cell
                    235:       tos , w mov.w:g  tos , tos xor.w  [w] , tos.b mov.b:g
                    236:       next,
                    237:    End-Code
                    238: 
                    239:   Code c!        ( n addr -- ) \ write cell
                    240:       tos , w mov.w:g  tos pop.w:g  tos.b , [w] mov.b:g
                    241:       tos pop.w:g
                    242:       next,
                    243:    End-Code
                    244: 
                    245:  \ arithmetic and logic
                    246:   Code +        ( n1 n2 -- n3 ) \ addition
                    247:       r1 pop.w:g
                    248:       r1 , tos add.w:g
                    249:       next,
                    250:   End-Code
                    251:   
                    252:   Code -        ( n1 n2 -- n3 ) \ addition
                    253:       r1 pop.w:g
                    254:       tos , r1 sub.w:g
                    255:       r1 , tos mov.w:g
                    256:       next,
                    257:   End-Code
                    258: 
                    259:   Code and        ( n1 n2 -- n3 ) \ addition
                    260:       r1 pop.w:g
                    261:       r1 , tos and.w:g
                    262:       next,
                    263:   End-Code
                    264:   
                    265:   Code or       ( n1 n2 -- n3 ) \ addition
                    266:       r1 pop.w:g
                    267:       r1 , tos or.w:g
                    268:       next,
                    269:   End-Code
                    270:   
                    271:   Code xor      ( n1 n2 -- n3 ) \ addition
                    272:       r1 pop.w:g
                    273:       r1 , tos xor.w
                    274:       next,
                    275:    End-Code
                    276: 
                    277:  \ moving datas between stacks
                    278:   Code r>       ( -- n ; R: n -- )
                    279:       tos push.w:g
                    280:       rp , w mov.w:g
                    281:       [w] , tos mov.w:g
1.7       pazsan    282:       # 2 , rp add.w:q  \ ? hfs
1.1       pazsan    283:       next,
                    284:    End-Code
                    285: 
1.2       pazsan    286:    Code >r       ( n -- ; R: -- n )
1.7       pazsan    287:        # -2 , rp add.w:q  \ ? hfs
1.2       pazsan    288:        rp , w mov.w:g
                    289:        tos , [w] mov.w:g
                    290:        tos pop.w:g
                    291:        next,
                    292:    End-Code
                    293: 
1.10      pazsan    294:    Code rdrop       ( R:n -- )
                    295:       # 2 , rp add.w:q  \ ? hfs
                    296:       next,
                    297:    End-Code
                    298: 
                    299:    Code unloop       ( R:n -- )
                    300:       # 4 , rp add.w:q  \ ? hfs
                    301:       next,
                    302:    End-Code
                    303: 
1.1       pazsan    304:  \ datastack and returnstack address
                    305:   Code sp@      ( -- sp ) \ get stack address
1.2       pazsan    306:       tos push.w:g
                    307:       sp , tos stc
                    308:       next,
                    309:   End-Code
1.1       pazsan    310: 
                    311:   Code sp!      ( sp -- ) \ set stack address
1.2       pazsan    312:       tos , sp ldc
                    313:       tos pop.w:g
                    314:       next,
1.1       pazsan    315:   End-Code
                    316: 
                    317:   Code rp@      ( -- rp ) \ get returnstack address
1.2       pazsan    318:     tos push.w:g
                    319:     rp , tos mov.w:g
1.1       pazsan    320:     next,
                    321:   End-Code
                    322: 
                    323:   Code rp!      ( rp -- ) \ set returnstack address
1.2       pazsan    324:       tos , rp mov.w:g
                    325:       tos pop.w:g
                    326:       next,
                    327:   End-Code
1.1       pazsan    328: 
1.2       pazsan    329:   Code branch   ( -- ) \ unconditional branch
                    330:       [ip] , ip mov.w:g
                    331:       next,
1.1       pazsan    332:    End-Code
                    333: 
1.2       pazsan    334:   Code lit     ( -- n ) \ inline literal
                    335:       tos push.w:g
                    336:       [ip] , tos mov.w:g
1.3       pazsan    337:       # 2 , ip add.w:q
1.2       pazsan    338:       next,
1.1       pazsan    339:    End-Code
                    340: 
1.2       pazsan    341: Code: :doesjump
                    342: end-code
1.1       pazsan    343: 
                    344: \ ==============================================================
                    345: \ usefull lowlevel words
                    346: \ ==============================================================
                    347:  \ word definitions
                    348: 
                    349: 
                    350:  \ branch and literal
                    351: 
                    352:  \ data stack words
                    353:   Code dup      ( n -- n n )
1.3       pazsan    354:     tos push.w:g
1.1       pazsan    355:     next,
                    356:    End-Code
                    357: 
                    358:   Code 2dup     ( d -- d d )
1.3       pazsan    359:     r1 pop.w:g
                    360:     r1 push.w:g
                    361:     tos push.w:g
                    362:     r1 push.w:g
1.1       pazsan    363:     next,
                    364:    End-Code
                    365: 
                    366:   Code drop     ( n -- )
1.3       pazsan    367:     tos pop.w:g
1.1       pazsan    368:     next,
                    369:    End-Code
                    370: 
                    371:   Code 2drop    ( d -- )
1.3       pazsan    372:     tos pop.w:g
                    373:     tos pop.w:g
1.1       pazsan    374:     next,
                    375:    End-Code
                    376: 
                    377:   Code swap     ( n1 n2 -- n2 n1 )
1.5       pazsan    378:     r1 pop.w:g
                    379:     tos push.w:g
                    380:     r1 , tos mov.w:g
1.1       pazsan    381:     next,
                    382:    End-Code
                    383: 
                    384:   Code over     ( n1 n2 -- n1 n2 n1 )
1.5       pazsan    385:     tos , r1 mov.w:g
                    386:     tos pop.w:g
                    387:     tos push.w:g
                    388:     r1 push.w:g
1.1       pazsan    389:     next,
                    390:    End-Code
                    391: 
                    392:   Code rot      ( n1 n2 n3 -- n2 n3 n1 )
1.5       pazsan    393:     tos , r1 mov.w:g
1.7       pazsan    394:     r3 pop.w:g
1.5       pazsan    395:     tos pop.w:g
1.7       pazsan    396:     r3 push.w:g
1.5       pazsan    397:     r1 push.w:g
1.7       pazsan    398:     r3 , r3 xor.w
1.1       pazsan    399:     next,
                    400:    End-Code
                    401: 
                    402:   Code -rot     ( n1 n2 n3 -- n3 n1 n2 )
1.5       pazsan    403:     tos , r1 mov.w:g
                    404:     tos pop.w:g
1.7       pazsan    405:     r3 pop.w:g
1.5       pazsan    406:     r1 push.w:g
1.7       pazsan    407:     r3 push.w:g
                    408:     r3 , r3 xor.w
1.1       pazsan    409:     next,
                    410:    End-Code
                    411: 
                    412: 
                    413:  \ return stack
                    414:   Code r@       ( -- n ; R: n -- n )
1.5       pazsan    415:     tos push.w:g
                    416:     rp , w mov.w:g
                    417:     [w] , tos mov.w:g
1.1       pazsan    418:     next,
                    419:   End-Code
                    420: 
                    421: 
                    422:  \ arithmetic
                    423: 
                    424:   Code um*      ( u1 u2 -- ud ) \ unsigned multiply
1.7       pazsan    425:       rp , r3 mov.w:g
1.5       pazsan    426:       r2 pop.w:g
                    427:       r2 , r0 mulu.w:g
                    428:       r0 push.w:g
                    429:       r2 , tos mov.w:g
1.7       pazsan    430:       r3 , rp mov.w:g
                    431:       r3 , r3 xor.w
1.5       pazsan    432:       next,
1.1       pazsan    433:    End-Code
                    434: 
1.16    ! pazsan    435:   Code m*      ( u1 u2 -- ud ) \ unsigned multiply
        !           436:       rp , r3 mov.w:g
        !           437:       r2 pop.w:g
        !           438:       r2 , r0 mul.w:g
        !           439:       r0 push.w:g
        !           440:       r2 , tos mov.w:g
        !           441:       r3 , rp mov.w:g
        !           442:       r3 , r3 xor.w
        !           443:       next,
        !           444:    End-Code
        !           445: 
1.1       pazsan    446:   Code um/mod   ( ud u -- r q ) \ unsiged divide
1.7       pazsan    447:       rp , r3 mov.w:g
1.5       pazsan    448:       tos , r1 mov.w:g
                    449:       r2 pop.w:g
                    450:       tos pop.w:g
                    451:       r1 divu.w
                    452:       r2 push.w:g
1.7       pazsan    453:       r3 , rp mov.w:g
                    454:       r3 , r3 xor.w
1.5       pazsan    455:       next,
1.1       pazsan    456:    End-Code
                    457: 
                    458:  \ shift
                    459:   Code 2/       ( n1 -- n2 ) \ arithmetic shift right
1.7       pazsan    460:  \ hfs geht noch nicht !!!     # -1 , tos sha.w 
                    461:      # -1 , r1h mov.b:q
                    462:      r1h , tos sha.w
1.1       pazsan    463:      next,
                    464:    End-Code
                    465: 
                    466:   Code lshift   ( n1 n2 -- n3 ) \ shift n1 left n2 bits
1.7       pazsan    467:  \     tos.b , r1h mov.w:g
1.14      pazsan    468:       tos.b , r1h mov.b:g  \ ? hfs
                    469:       tos pop.w:g
                    470:       r1h , tos shl.w
                    471:       next,
1.1       pazsan    472:    End-Code
                    473: 
                    474:   Code rshift   ( n1 n2 -- n3 ) \ shift n1 right n2 bits
1.7       pazsan    475: \     tos.b , r1h mov.w:g
1.14      pazsan    476:       tos.b , r1h mov.b:g  \ ? hfs
                    477:       r1h neg.b
                    478:       tos pop.w:g
                    479:       r1h , tos shl.w
1.1       pazsan    480:      next,
                    481:    End-Code
                    482: 
                    483:  \ compare
                    484:   Code 0=       ( n -- f ) \ Test auf 0
1.5       pazsan    485:     tos , tos tst.w
                    486:     0= IF  # -1 , tos mov.w:g   next,
                    487:     THEN   # 0  , tos mov.w:g   next,
1.1       pazsan    488:     next,
                    489:    End-Code
                    490: 
1.10      pazsan    491:    Code 0<       ( n -- f ) \ Test auf 0
                    492:     tos , tos tst.w
                    493:     0< IF  # -1 , tos mov.w:g   next,
                    494:     THEN   # 0  , tos mov.w:g   next,
                    495:     next,
                    496:    End-Code
                    497: 
1.1       pazsan    498:   Code =        ( n1 n2 -- f ) \ Test auf Gleichheit
1.5       pazsan    499:     r1 pop.w:g
                    500:     r1 , tos sub.w:g
                    501:     0= IF  # -1 , tos mov.w:g   next,
                    502:     THEN   # 0  , tos mov.w:g   next,
1.1       pazsan    503:    End-Code
                    504: 
1.16    ! pazsan    505:    ' = alias u=
        !           506:    
1.10      pazsan    507:   Code u<        ( n1 n2 -- f ) \ Test auf Gleichheit
                    508:     r1 pop.w:g
                    509:     r1 , tos sub.w:g
                    510:     u> IF  # -1 , tos mov.w:g   next,
                    511:     THEN   # 0  , tos mov.w:g   next,
                    512:    End-Code
                    513: 
                    514:   Code u>        ( n1 n2 -- f ) \ Test auf Gleichheit
                    515:     r1 pop.w:g
                    516:     r1 , tos sub.w:g
                    517:     u< IF  # -1 , tos mov.w:g   next,
                    518:     THEN   # 0  , tos mov.w:g   next,
                    519:    End-Code
                    520: 
1.3       pazsan    521:   Code (key)    ( -- char ) \ get character
1.5       pazsan    522:       tos push.w:g
1.13      pazsan    523:       BEGIN  3 , $AD  btst  0<> UNTIL
                    524:       $AE  , tos mov.w:g
1.3       pazsan    525:     next,
                    526:    End-Code
                    527: 
                    528:   Code (emit)     ( char -- ) \ output character
1.13      pazsan    529:       BEGIN  1 , $AD  btst  0<> UNTIL
1.7       pazsan    530:       tos.b , $AA  mov.b:g
1.5       pazsan    531:       tos pop.w:g
                    532:       next,
1.3       pazsan    533:   End-Code
                    534: 
1.1       pazsan    535:  \ additon io routines
                    536:   Code (key?)     ( -- f ) \ check for read sio character
1.5       pazsan    537:       tos push.w:g
1.13      pazsan    538:       3 , $AD  btst
1.5       pazsan    539:       0<> IF  # -1 , tos mov.w:g   next,
                    540:       THEN   # 0  , tos mov.w:g   next,
1.1       pazsan    541:    End-Code
                    542: 
                    543:   Code emit?    ( -- f ) \ check for write character to sio
1.5       pazsan    544:       tos push.w:g
1.13      pazsan    545:       1 , $AD  btst
1.12      pazsan    546:       0<> IF  # -1 , tos mov.w:g   next,
1.5       pazsan    547:       THEN   # 0  , tos mov.w:g   next,
1.1       pazsan    548:    End-Code
                    549: 
1.14      pazsan    550:    \ Useful code for R8C
                    551: 
1.16    ! pazsan    552:    Code us ( n -- ) \ n microseconds delay
        !           553:        BEGIN  AHEAD  THEN  AHEAD  THEN
        !           554:            r1 , r1 mov.w:g
        !           555:            # -1 , tos  add.w:q  0= UNTIL
1.14      pazsan    556:        tos pop.w:g
                    557:        next,
                    558:    end-code
1.16    ! pazsan    559:    
        !           560:    : ms ( n -- )  0 ?DO  &1000 us  LOOP ;
1.14      pazsan    561: 
                    562:    $E0 Constant port0
                    563:    $E1 Constant port1
                    564:    
                    565:    : led!  port1 c! ;
1.16    ! pazsan    566:    : >lcd ( 4bit -- )
        !           567:        1+ dup port0 c! dup 8 + port0 c!  1 us  port0 c!
        !           568:        &40 us ;
1.14      pazsan    569:    : lcdctrl!  ( n -- )
                    570:        dup $F0 and >lcd
                    571:        4 lshift >lcd
1.16    ! pazsan    572:        &100 us ;
        !           573:    : lcdemit ( n -- )  &100 us
1.14      pazsan    574:        dup $F0 and 4 + >lcd
                    575:        4 lshift 4 + >lcd
1.16    ! pazsan    576:        &250 us ;
1.14      pazsan    577:    : lcdtype  bounds ?DO  I c@ lcdemit  LOOP ;
1.16    ! pazsan    578:    : lcdpage  $01 lcdctrl! &15 ms ;
1.14      pazsan    579:    : lcdcr    $C0 lcdctrl! ;
                    580:    : lcdinit ( -- )
1.16    ! pazsan    581:        &20 ms  $20 >lcd
        !           582:        &5 ms  $28 lcdctrl!
        !           583:        &1 ms  $0C lcdctrl!
        !           584:        &1 ms  lcdpage ;
1.14      pazsan    585:    : r8cboot ( -- )  lcdinit s" Gforth EC R8C" lcdtype boot ;
                    586:    ' r8cboot >body $C002 !
                    587:    
1.3       pazsan    588: : (bye)     ( 0 -- ) \ back to DOS
                    589:     drop ;
1.1       pazsan    590: 
                    591: : bye ( -- )  0 (bye) ;
                    592:     
1.3       pazsan    593: : x@+/string ( addr u -- addr' u' c )
                    594:     over c@ >r 1 /string r> ;

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