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

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
        !           413:   Code key?     ( -- f ) \ check for read sio character
        !           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: 
        !           435:   Code bye     ( -- ) \ back to DOS
        !           436:      0 # al mov,  $4c # ah mov,  $21 int,
        !           437:     End-Code
        !           438: 

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