Annotation of gforth/arch/8086/prim.fs, revision 1.5

1.1       pazsan      1: \ **************************************************************
                      2: \ File:         PRIMS.FS
                      3: \                 Lowlevel routines for GFORTH on 8086 (PC)
                      4: \ Autor:        Klaus Kohl
                      5: \ Log:          30.07.97 KK:    file generated (from KK-FORTH)
                      6: \
                      7: \ * Register using for 8086 on PC (like KK-FORTH):
                      8: \  Intel  Forth    used for                       8bit-Register
                      9: \   BX     TOS   oberstes Stackelement             TOSH   TOSL
                     10: \   BP     FRP   Returnstack Pointer
                     11: \   SP     FSP   Stack Pointer
                     12: \   SI     FIP   Instruction Pointer
                     13: \   DI      W    Arbeitsregister
                     14: \
                     15: \ * Memory ( use only one 64K-Page ):
                     16: \    $0080-$00FF : TIB
                     17: \    $0100-$F800 : program
                     18: \    $F800-$FC00 : datastack
                     19: \    $FC00-$FFFF : returnstack
                     20: \ **************************************************************
                     21: 
                     22: 
                     23: start-macros
                     24:  \ register definition
                     25:   ' sp Alias fsp
                     26:   ' bp Alias frp
                     27:   ' bx Alias tos        ' bl Alias tosl  ' bh Alias tosh
                     28:   ' si Alias fip
                     29:   ' di Alias w
                     30: 
                     31:  \ system depending macros
                     32:   : next,
                     33:     lods,
                     34:     ax w xchg,
                     35:     w ) jmp, ;
                     36: \ note that this is really for 8086 and 286, and _not_ intented to run
                     37: \ fast on a Pentium (Pro). These old chips load their code from real RAM
                     38: \ and do it slow, anyway.
                     39: \ If you really want to have a fast 16 bit Forth on modern processors,
                     40: \ redefine it as
                     41: \ : next,  fip ) w mov,  2 # fip add,  w ) jmp, ;
                     42: 
                     43: end-macros
                     44: 
                     45:   unlock
                     46:     $0100 $f000 region dictionary
                     47:     setup-target
                     48:   lock
                     49: 
                     50: \ ==============================================================
                     51: \ rom starts with jump to GFORTH-kernel (must be at $0000 !!!)
                     52: \ ==============================================================
                     53:   Label into-forth
                     54:     $ffff # fip mov,            \ ip will be patched
                     55:     $fef0 # fsp mov,            \ sp at $FD80...$FEF0
                     56:     $fd80 # frp mov,            \ rp at $F.00...$FD80
                     57:     next,
                     58:   End-Label
                     59: 
                     60: 
                     61: \ output debug information
                     62:   Label (dout)   \ like (emit) with character in dl
                     63:     6 # ah mov,
                     64:     $21 int,
                     65:     ret,
                     66:   End-Label
                     67: 
                     68: Start-Macros
                     69: \  : dout,       ( char -- )
                     70: \     # dl byte mov,
                     71: \    (dout) # call, ;
                     72:  : dout,  drop ;               \ no debug output
                     73: end-macros
                     74: 
                     75: 
                     76: \ ==============================================================
                     77: \ GFORTH minimal primitive set
                     78: \ ==============================================================
                     79:  \ inner interpreter
                     80:   Code: :docol
                     81:      ': dout,                    \ only for debugging
                     82:      frp dec,   frp dec,   fip frp ) mov,        \ save ip
                     83:      4 w d) fip lea,                             \ calc pfa
                     84:      next,
                     85:    End-Code
                     86: 
                     87:   Code: :dovar
                     88:     '2 dout,                    \ only for debugging
                     89:     tos push,
                     90:     4 w d) tos lea,
                     91:     next,
                     92:   End-Code
                     93: 
                     94:   Code: :dodoes  ( -- pfa ) \ get pfa and execute DOES> part
                     95:     '6 dout,                    \ only for debugging
                     96:      frp dec,   frp dec,   fip frp ) mov,        \ save ip
                     97:      2 # w add,                                  \
                     98:      w ) fip mov,                                \ get does> address
                     99:      tos push,                                   \ save tos
                    100:      2 # w add,
                    101:      w tos mov,                                  \ copy pfa to tos
                    102:      next,                                       \ execute does> part
                    103:    End-Code
                    104: 
                    105: 
                    106:  \ program flow
                    107:   Code ;s       ( -- ) \ exit colon definition
                    108:     '; dout,                    \ only for debugging
                    109:     frp ) fip mov,   frp inc,  frp inc,         \ get ip
                    110:     next,
                    111:   End-Code
                    112: 
                    113:   Code execute   ( xt -- ) \ execute colon definition
                    114:     'E dout,                    \ only for debugging
                    115:     tos w mov,                                  \ copy tos to w
                    116:     tos pop,                                    \ get new tos
                    117:     w ) jmp,                                    \ execute
                    118:   End-Code
                    119: 
                    120:   Code ?branch   ( f -- ) \ jump on f<>0
                    121:     tos tos or,   tos pop,                      \ check and get new tos
                    122:     0= IF,  fip ) fip add,      next,           \ jump
                    123:     ELSE,   fip inc,  fip inc,  next,  THEN,    \ skip
                    124:    End-Code
                    125: 
                    126: 
                    127:  \ memory access
                    128:   Code @        ( addr -- n ) \ read cell
                    129:     tos ) tos mov,
                    130:     next,
                    131:    End-Code
                    132: 
                    133:   Code !        ( n addr -- ) \ write cell
                    134:     tos ) pop,
                    135:     tos pop,
                    136:     next,
                    137:    End-Code
                    138: 
                    139: 
                    140:  \ datastack and returnstack address
                    141:   Code sp@      ( -- sp ) \ get stack address
                    142:     tos push,
                    143:     fsp tos mov,
                    144:     next,
                    145:    End-Code
                    146: 
                    147:   Code sp!      ( sp -- ) \ set stack address
                    148:     tos fsp mov,
                    149:     tos pop,
                    150:     next,
                    151:   End-Code
                    152: 
                    153:   Code rp@      ( -- rp ) \ get returnstack address
                    154:     tos push,
                    155:     frp tos mov,
                    156:     next,
                    157:   End-Code
                    158: 
                    159:   Code rp!      ( rp -- ) \ set returnstack address
                    160:     tos frp mov,
                    161:     tos pop,
                    162:     next,
                    163:   End-Code
                    164: 
                    165: 
                    166:  \ arithmetic and logic
                    167:   Code +        ( n1 n2 -- n3 ) \ addition
                    168:     ax pop,
                    169:     ax tos add,
                    170:     next,
                    171:    End-Code
                    172: 
                    173:   Code xor      ( n1 n2 -- n3 ) \ logic XOR
                    174:     ax pop,
                    175:     ax tos xor,
                    176:     next,
                    177:    End-Code
                    178: 
                    179:   Code and      ( n1 n2 -- n3 ) \ logic AND
                    180:     ax pop,
                    181:     ax tos and,
                    182:     next,
                    183:    End-Code
                    184: 
                    185: 
                    186:  \ i/o
                    187:   Variable lastkey      \ Flag und Zeichencode der letzen Taste
                    188: 
                    189:   Code (key)    ( -- char ) \ get character
                    190:     tos push,
                    191:     lastkey #) ax mov,
                    192:     ah ah or,  0= IF, 7 # ah mov,  $21 int, THEN,
                    193:     0 # lastkey #) mov,
                    194:     ah ah xor,
                    195:     ax tos mov,
                    196:     next,
                    197:    End-Code
                    198: 
                    199:   Code (emit)     ( char -- ) \ output character
                    200:     tosl dl mov,
                    201:     6 # ah mov,
                    202:     $ff # dl cmp,  0= IF, dl dec, THEN,
                    203:     $21 int,
                    204:     tos pop,
                    205:     next,
                    206:   End-Code
                    207: 
                    208: \ ==============================================================
                    209: \ additional words (for awaitable response)
                    210: \ ==============================================================
                    211:  \ memory character access
                    212:   Code c@       ( addr -- c ) \ read character
                    213:     tos ) tosl mov,
                    214:     tosh tosh xor,
                    215:     next,
                    216:    End-Code
                    217: 
                    218:   Code c!       ( c addr -- ) \ write character
                    219:     ax pop,
                    220:     al tos ) mov,
                    221:     tos pop,
                    222:     next,
                    223:    End-Code
                    224: 
                    225: 
                    226:  \ moving datas between stacks
                    227:   Code r>       ( -- n ; R: n -- )
                    228:     tos push,
                    229:     frp ) tos mov,  frp inc,  frp inc,
                    230:     next,
                    231:    End-Code
                    232: 
                    233:   Code >r       ( n -- ; R: -- n )
                    234:     frp dec,  frp dec,  tos frp ) mov,
                    235:     tos pop,
                    236:     next,
                    237:    End-Code
                    238: 
                    239: \ ==============================================================
                    240: \ usefull lowlevel words
                    241: \ ==============================================================
                    242:  \ word definitions
                    243: 
                    244:   Code: :docon
                    245:     '1 dout,                    \ only for debugging
                    246:     tos push,
                    247:     4 w d) tos lea,
                    248:     tos ) tos mov,
                    249:     next,
                    250:   End-Code
                    251: 
                    252:   Code: :dodefer
                    253:     '4 dout,                    \ only for debugging
                    254:     4 w d) w mov,
                    255:     w ) jmp,
                    256:   End-Code
                    257: 
                    258: 
                    259:  \ branch and literal
                    260:   Code branch   ( -- ) \ unconditional branch
                    261:     fip ) fip add,
                    262:     next,
                    263:    End-Code
                    264: 
                    265:   Code lit     ( -- n ) \ inline literal
                    266:     tos push,
                    267:     lods,
                    268:     ax tos mov,
                    269:     next,
                    270:    End-Code
                    271: 
                    272: 
                    273:  \ data stack words
                    274:   Code dup      ( n -- n n )
                    275:     tos push,
                    276:     next,
                    277:    End-Code
                    278: 
                    279:   Code 2dup     ( d -- d d )
                    280:     ax pop,
                    281:     ax push,
                    282:     tos push,
                    283:     ax push,
                    284:     next,
                    285:    End-Code
                    286: 
                    287:   Code drop     ( n -- )
                    288:     tos pop,
                    289:     next,
                    290:    End-Code
                    291: 
                    292:   Code 2drop    ( d -- )
                    293:     2 # fsp add,
                    294:     tos pop,
                    295:     next,
                    296:    End-Code
                    297: 
                    298:   Code swap     ( n1 n2 -- n2 n1 )
                    299:     ax pop,
                    300:     tos push,
                    301:     ax tos mov,
                    302:     next,
                    303:    End-Code
                    304: 
                    305:   Code over     ( n1 n2 -- n1 n2 n1 )
                    306:     tos ax mov,
                    307:     tos pop,
                    308:     tos push,
                    309:     ax push,
                    310:     next,
                    311:    End-Code
                    312: 
                    313:   Code rot      ( n1 n2 n3 -- n2 n3 n1 )
                    314:     tos ax mov,
                    315:     cx pop,
                    316:     tos pop,
                    317:     cx push,
                    318:     ax push,
                    319:     next,
                    320:    End-Code
                    321: 
                    322:   Code -rot     ( n1 n2 n3 -- n3 n1 n2 )
                    323:     tos ax mov,
                    324:     tos pop,
                    325:     cx pop,
                    326:     ax push,
                    327:     cx push,
                    328:     next,
                    329:    End-Code
                    330: 
                    331: 
                    332:  \ return stack
                    333:   Code r@       ( -- n ; R: n -- n )
                    334:     tos push,
                    335:     frp ) tos mov,
                    336:     next,
                    337:   End-Code
                    338: 
                    339: 
                    340:  \ arithmetic
                    341:   Code -        ( n1 n2 -- n3 ) \ Subtraktion
                    342:     ax pop,
                    343:     tos ax sub,
                    344:     ax tos mov,
                    345:     next,
                    346:    End-Code
                    347: 
                    348:   Code um*      ( u1 u2 -- ud ) \ unsigned multiply
                    349:     tos ax mov,
                    350:     cx pop,
                    351:     cx mul,
                    352:     ax push,
                    353:     dx tos mov,
                    354:     next,
                    355:    End-Code
                    356: 
                    357:   Code um/mod   ( ud u -- r q ) \ unsiged divide
                    358:     tos cx mov,
                    359:     dx pop,
                    360:     ax pop,
                    361:     cx div,
                    362:     dx push,
                    363:     ax tos mov,
                    364:     next,
                    365:    End-Code
                    366: 
                    367: 
                    368:  \ logic
                    369:   Code or       ( n1 n2 -- n3 ) \ logic OR
                    370:     ax pop,   ax tos or,   next,
                    371:    End-Code
                    372: 
                    373: 
                    374:  \ shift
                    375:   Code 2/       ( n1 -- n2 ) \ arithmetic shift right
                    376:      tos sar,
                    377:      next,
                    378:    End-Code
                    379: 
                    380:   Code lshift   ( n1 n2 -- n3 ) \ shift n1 left n2 bits
                    381:      tos cx mov,
                    382:      tos pop,
                    383:      cx cx or,  0<> IF, tos c* shl, THEN,
                    384:      next,
                    385:    End-Code
                    386: 
                    387:   Code rshift   ( n1 n2 -- n3 ) \ shift n1 right n2 bits
                    388:      tos cx mov,
                    389:      tos pop,
                    390:      cx cx or,  0<> IF, tos c* shr, THEN,
                    391:      next,
                    392:    End-Code
                    393: 
                    394: 
                    395:  \ compare
                    396:   Code 0=       ( n -- f ) \ Test auf 0
                    397:     tos tos or,
                    398:     0 # tos mov,
                    399:     0= IF, tos dec, THEN,
                    400:     next,
                    401:    End-Code
                    402: 
                    403:   Code =        ( n1 n2 -- f ) \ Test auf Gleichheit
                    404:     ax pop,
                    405:     ax tos sub,
                    406:     0= IF,  -1 # tos mov,   next,
                    407:     ELSE,   0  # tos mov,   next,
                    408:     THEN,
                    409:    End-Code
                    410: 
                    411: 
                    412:  \ additon io routines
1.2       pazsan    413:   Code (key?)     ( -- f ) \ check for read sio character
1.1       pazsan    414:     tos push, lastkey # tos mov,
                    415:     1 tos d) ah mov,   ah ah or,
                    416:     0= IF,  $ff # dl mov,  6 # ah mov,  $21 int,
                    417:             0 # ah mov,
                    418:             0<> IF, dl ah mov,   ax tos ) mov, THEN,
                    419:     THEN,  ah tosl mov,   ah tosh mov,
                    420:     next,
                    421:    End-Code
                    422: 
                    423:   Code emit?    ( -- f ) \ check for write character to sio
                    424:     tos push,
                    425:     -1 # tos mov,             \ output always possible
                    426:     next,
                    427:    End-Code
                    428: 
                    429: \ ======================== not ready ============================
                    430: 0 [IF]  \ not jet adapted
                    431: 
                    432: \ ======================== not ready ============================
                    433: [ENDIF]
                    434: 
1.5     ! pazsan    435:   Code (bye)     ( -- ) \ back to DOS
        !           436:      ax pop,  $4c # ah mov,  $21 int,
1.1       pazsan    437:     End-Code
                    438: 
1.5     ! pazsan    439: : bye ( -- )  0 (bye) ;
        !           440:     
        !           441: Code: :doesjump
        !           442: end-code

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