Annotation of gforth/arch/c165/asm.fs, revision 1.1

1.1     ! pazsan      1: \ Assembler für den 80C165                      ( 25.07.97/KK )
        !             2: \
        !             3: \ System:         KKF_PC V1.2/2
        !             4: \ Änderungen:     25.07.97  KK: Umsetzung auf GFORTH
        !             5: \
        !             6: \                    Hinweise:
        !             7: \ Dieser Assembler wurde für das KK-FORTH entwickelt und unter-
        !             8: \ liegt dem Copyright von Ing. Büro Klaus Kohl. Es unterstützt
        !             9: \ auch die Prozessoren 80C166 und 80C167, wobei dann die zusätz-
        !            10: \ lichen Befehle nicht genutzt werden dürfen.
        !            11: \ (c) 1995/1996 Ing. Büro Klaus Kohl
        !            12: 
        !            13: 
        !            14: include asm/basic.fs
        !            15: 
        !            16: also  Assembler Definitions
        !            17: 
        !            18: : | ;
        !            19: : restrict ;
        !            20: : u2/ 1 rshift ;
        !            21: 
        !            22: \ Redefinitionen wegen Namenskonflikte          ( 14.01.96/KK )
        !            23: | ' ,           Alias dic,
        !            24: | ' c,          Alias dic,c
        !            25:   ' Forth       Alias [Forth]       immediate
        !            26: 
        !            27:   Forth Definitions
        !            28:   ' Assembler   Alias [Assembler]   immediate
        !            29:   Assembler Definitions
        !            30: 
        !            31: 
        !            32: \ Alias-Definitionen                            ( 06.01.96/KK )
        !            33:   : asshere ( -- dp ) X here ;         \ Zieladresse
        !            34:   : ass,c   ( byte -- ) X c, ; \ Byte compilieren
        !            35:   : ass,    ( word -- ) X , ;  \ Wort compilieren, Lowbyte zuerst
        !            36:   : ass@    ( addr -- w ) X @ ; \ Wort holen
        !            37:   : ass@c   ( addr -- w ) X c@ ; \ Byte holen
        !            38:   : ass!    ( w addr -- ) X ! ;  \ Wort schreiben
        !            39:   : ass!c   ( w addr -- ) X c! ; \ Byte schreiben
        !            40: 
        !            41: \ Variablen                                     ( 25.07.97/KK )
        !            42: | Create mode  4 chars allot    \ Adreßmode
        !            43: | Variable offset               \ Offsetwert für Opcode
        !            44: | Variable komma                \ Flag, ob Komma verwendet wurde
        !            45: | Variable ssp                  \ Gespeicherte Stackposition
        !            46: | Variable <ssp>                \ Stacktiefe 1. Operand
        !            47: | Create $tab &20 cells allot   \ Tabelle mit Adressen
        !            48: 
        !            49: | : reset       ( -- ) \ Setzt Flags zurück
        !            50:     mode 4 chars erase   0 offset !   0 komma !
        !            51:     depth   dup ssp !   <ssp> ! ;
        !            52: 
        !            53: : clearstack
        !            54:    depth <ssp> @ - dup 0> 
        !            55:    IF 0 ?DO drop LOOP ELSE ABORT" stackschwund!" THEN ;
        !            56: 
        !            57: | : -reset?     ( ... f -- -1 | ... 0 )
        !            58:     dup IF  clearstack
        !            59:            reset  true  THEN ;
        !            60: 
        !            61:   : ready       ( -- ) \ Alle Assembler-Register zurücksetzen
        !            62:     reset  $tab &20 cells  erase ;
        !            63: 
        !            64: \ Tools                                         ( 06.01.96/KK )
        !            65: \ | : (aerror"    ( flag -- )
        !            66: \    -reset? IF   r>  $7fff  error             \ Fehler ausgeben
        !            67: \            ELSE r>  count 1+  +  align >r THEN ; restrict
        !            68: \ | : AError"     ( string" ; f -- ) \ Assembler-Fehlerausgabe
        !            69: \    compile (aerror"   Ascii " $, ;          immediate restrict
        !            70: 
        !            71: : AError" postpone -reset? postpone abort" ; immediate
        !            72: 
        !            73: | : mode@       ( -- n ) \ nur Lowbyte holen
        !            74:     mode c@ ;
        !            75: 
        !            76: | : mode!       ( n -- ) \ Modus setzen
        !            77:     mode c! ;
        !            78: 
        !            79: | : +mode!      ( n -- ) \ Wert zu MODE addieren
        !            80:     mode c@  +  mode! ;
        !            81: 
        !            82: \ Tests                                         ( 25.07.97/KK )
        !            83: | : stack?      ( -- n )
        !            84:     depth ssp @ - ;
        !            85: 
        !            86: | : ?arg        ( n -- )
        !            87:     stack? 1-  -  Aerror" Falsche Anzahl von Argumenten" ;
        !            88: 
        !            89: | : ?mode0      ( -- ) \ Test, ob Mode $00
        !            90:     mode@  Aerror" Komma erwartet" ;
        !            91: 
        !            92: | : ?wreg       ( -- ) \ Test auf Wortregister
        !            93:     mode@  $30 $20 within  Aerror" Wortregister erwartet" ;
        !            94: 
        !            95: | : ?waddr      ( addr -- ) \ Test auf Wortadresse
        !            96:     dup 1 and  AError" Nur Wortadresse erlaubt" ;
        !            97: 
        !            98: | : ?baddr      ( baddr -- bitoff )
        !            99:     ?waddr
        !           100:     dup $fd00 $fe00 within IF $fd00 - u2/  exit THEN
        !           101:     dup $ff00 $ffe0 within IF $fe00 - u2/  exit THEN
        !           102:     -1  AError" Bitadresse erwartet" ;
        !           103: 
        !           104: | : ?rel        ( addr -- rel ) \ 16Bit-Befehl erwartet
        !           105:     asshere X cell+  -  X cell /
        !           106:     dup $80 $ff80 within  AError" Relativsprungziel zu fern" ;
        !           107: 
        !           108: | : ?8b         ( n -- n ) \ Test auf 8Bit-Wert
        !           109:     dup $ff u>  AError" Datenbyte größer als 8 Bit" ;
        !           110: | ' ?8b  Alias  ?seg       \ Test auf Segment
        !           111: | : ?page       ( n -- n ) \ Test auf Page (10 Bit)
        !           112:     dup $3ff u>  AError" Pagenummer größer als 10 Bit" ;
        !           113: 
        !           114: 
        !           115: \ Registerdefinition (8Bit)                     ( 30.12.95/KK )
        !           116: | : Rb:         ( -- ; C: Reg -- ) \ Register definieren
        !           117:     Create $10 +  dic,c
        !           118:     Does>  c@ >r   0 ?arg  ?mode0                       \ Tests
        !           119:               r>  +mode! ;
        !           120: 
        !           121:   $00 Rb: rl0     $01 Rb: rh0     $02 Rb: rl1     $03 Rb: rh1
        !           122:   $04 Rb: rl2     $05 Rb: rh2     $06 Rb: rl3     $07 Rb: rh3
        !           123:   $08 Rb: rl4     $09 Rb: rh4     $0a Rb: rl5     $0b Rb: rh5
        !           124:   $0c Rb: rl6     $0d Rb: rh6     $0e Rb: rl7     $0f Rb: rh7
        !           125: 
        !           126: \ Registerdefinition (16Bit)                    ( 15.01.96/KK )
        !           127: | : Rw:         ( -- ; C: Reg -- ) \ Register definieren
        !           128:     Create $20 +  dic,c
        !           129:     Does>  c@ >r   0 ?arg  ?mode0                       \ Tests
        !           130:               r>  +mode! ;
        !           131: 
        !           132:   $00 Rw: r0      $01 Rw: r1      $02 Rw: r2      $03 Rw: r3
        !           133:   $04 Rw: r4      $05 Rw: r5      $06 Rw: r6      $07 Rw: r7
        !           134:   $08 Rw: r8      $09 Rw: r9      $0a Rw: r10     $0b Rw: r11
        !           135:   $0c Rw: r12     $0d Rw: r13     $0e Rw: r14     $0f Rw: r15
        !           136: 
        !           137: \ Adreßmodes                                    ( 29.12.95/KK )
        !           138:   : ]+      ( -- ) \ Wortregister mit Postincrement
        !           139:     ?wreg   0 ?arg   $10 +mode! ;
        !           140: 
        !           141:   : -]      ( -- ) \ Wortregister mit Predecrement
        !           142:     ?wreg   0 ?arg   $20 +mode! ;
        !           143: 
        !           144:   : ]       ( -- ) \ Wortregister indirekt, evtl. Displacement
        !           145:     mode@  ?dup
        !           146:     IF   $20 $30 within IF $30 +mode!  exit THEN
        !           147:     ELSE stack? 1 =  over 1 and 0=  or IF $60 +mode!  exit THEN
        !           148:     THEN -1 AError" Wortregister oder -adresse erwartet" ;
        !           149: 
        !           150:   : #]      ( -- ) \ Wortregister mit Displacement
        !           151:     ?wreg   1 ?arg   $50 +mode! ;
        !           152: 
        !           153:   : s#          ( data -- data ) \ Kurzwert
        !           154:     ?mode0   1 ?arg    $80 +mode! ;
        !           155: 
        !           156:   : #           ( data -- data ) \ Langwert
        !           157:     ?mode0   1 ?arg   $90 +mode! ;
        !           158: 
        !           159:   : .           ( data|wreg -- data ) \ Bitadresse
        !           160:     mode@  ?dup
        !           161:     IF   dup $20 $30 within IF $d0 +  $a0 mode!  exit THEN
        !           162:     ELSE 1 ?arg   ?baddr   $a0 mode!  exit
        !           163:     THEN -1  AError" Bitadresse erwartet" ;
        !           164: 
        !           165: 
        !           166: \ Bedingungen                                   ( 03.01.96/KK )
        !           167: | : CC:         ( -- ; C: cc -- ) \ Bedingungen definieren
        !           168:     Create $b0 +  dic,c
        !           169:     Does>  c@ >r   0 ?arg  ?mode0                       \ Tests
        !           170:               r>  +mode! ;
        !           171: 
        !           172:   $00 CC: cc_uc   $01 CC: cc_net  $02 CC: cc_z    $02 CC: cc_eq
        !           173:   $03 CC: cc_nz   $03 CC: cc_ne   $04 CC: cc_v    $05 CC: cc_nv
        !           174:   $06 CC: cc_n    $07 CC: cc_nn   $08 CC: cc_c    $08 CC: cc_ult
        !           175:   $09 CC: cc_nc   $09 CC: cc_uge  $0a CC: cc_sgt  $0b CC: cc_sle
        !           176:   $0c CC: cc_slt  $0d CC: cc_sge  $0e CC: cc_ugt  $0f CC: cc_ule
        !           177: 
        !           178: 
        !           179: \ Lokale Labels                                 ( 30.12.95/KK )
        !           180: | : $:          ( -- ; C: # -- ) \ Adresse merken
        !           181:     Create 2 cells *  cell+  dic,c
        !           182:     Does>  c@  $tab  +
        !           183:            dup @  AError" Label schon verwendet"
        !           184:            asshere swap ! ;
        !           185:   $00 $:  1$:     $01 $:  2$:     $02 $:  3$:     $03 $:  4$:
        !           186:   $04 $:  5$:     $05 $:  6$:     $06 $:  7$:     $07 $:  8$:
        !           187:   $08 $:  9$:     $09 $: 10$:
        !           188: 
        !           189: | : $           ( -- ; C: # -- ) \ Referenz merken
        !           190:     Create $c0 +  dic,c
        !           191:     Does>  >r   0 ?arg   ?mode0   r> c@  +mode! ;
        !           192:   $00 $   1$      $01 $   2$      $02 $   3$      $03 $   4$
        !           193:   $04 $   5$      $05 $   6$      $06 $   7$      $07 $   8$
        !           194:   $08 $   9$      $09 $  10$
        !           195: 
        !           196:   : check       ( -- ) \ teste $TAB
        !           197:    $tab  &10 2* cells  +   $tab
        !           198:    DO   i @  ?dup
        !           199:         IF i cell+ @  tuck 0= AError" Label nicht definiert"
        !           200:            BEGIN  dup ass@        >r
        !           201:                   over swap ass!  r> ?dup 0=
        !           202:            UNTIL  drop
        !           203:         THEN
        !           204:    4 +LOOP ready ;
        !           205: 
        !           206: \ Adreßmodes                                    ( 01.01.96/KK )
        !           207:   : ,       ( -- ) \ Es folgt nächster Operand
        !           208:     komma @  2 u>  AError" Komma maximal zweimal erlaubt"
        !           209:     mode@  dup >r  0=
        !           210:     IF       stack? 1-  AError" Ein Operand erwartet"
        !           211:     ELSE r@ $60 u<  r@ $af u>  or
        !           212:           IF stack?     AError" Kein Operand erlaubt"    THEN
        !           213:          r@ $60 $a0 within
        !           214:           IF stack? 1-  AError" Nur ein Operand erlaubt" THEN
        !           215:          r@ $a0 =
        !           216:           IF stack? 2 -  AError" . erwartet Bitnummer"
        !           217:              dup $0f u> AError" Bitnummer ungültig"        THEN
        !           218:     THEN mode 2 + c@  mode 3 + c!   mode 1+ c@  mode 2 +  c!
        !           219:          r>          mode 1+  c!   0 mode!
        !           220:          1 komma +!   depth  ssp ! ;
        !           221: 
        !           222: \ Tools für Umsetzung                           ( 14.01.96/KK )
        !           223: | : modes@      ( -- modes ) \ alle Modes holen
        !           224:     ,   stack?   dup 4 0 within AError" Stacktiefe"  2* 2*
        !           225:         komma @                       or
        !           226:         mode 3 + c@ $f0 and  8 lshift  or
        !           227:         mode 2 +  c@ $f0 and  4 lshift  or
        !           228:         mode 1+  c@ $f0 and           or ;
        !           229: 
        !           230: | : n@          ( -- m ) \ Register aus Mode+2 holen
        !           231:     mode 2 + c@  $0f and ;
        !           232: | : n@<<4       ( -- $m0 ) \ Register ins High-Nibble
        !           233:     n@ 2* 2* 2* 2* ;
        !           234: | : m@          ( -- n ) \ Register aus Mode+1 holen
        !           235:     mode 1+ c@  $0f and ;
        !           236: | : o@          ( -- n ) \ Register aus Mode+2 holen
        !           237:     mode 3 + c@  $0f and ;
        !           238: 
        !           239: | : reg?        ( addr -- addr 0 | reg -1 ) \ Test auf Register
        !           240:     dup 1 and IF 0  exit THEN              \ Keine Wortadresse
        !           241:     dup $fe00 $ffe0 within IF $fe00 -  u2/  -1  exit THEN
        !           242:     0 ;
        !           243: | : ?reg        ( addr -- reg )
        !           244:     reg? 0=  AError" Register erwartet" ;
        !           245: 
        !           246: | : code,       ( opcode -- ) \ Opcode mit Offset compilieren
        !           247:     offset @ +   ass,c ;
        !           248: | : codexx,     ( opcode -- ) \ Achtung: Low/Highbyte vertauscht
        !           249:     offset @ +   ass, ;
        !           250: | : protect,    ( opcode -- )
        !           251:     offset @ +   dup ass,c  dup invert ass,c  dup ass,c  ass,c ;
        !           252: | : label,      ( -- ) \ Label als letzter Operant
        !           253:     asshere   m@ 2 cells * $tab +   dup @  ass,  ! ;
        !           254: 
        !           255: 
        !           256: \ Umsetzung                                     ( 18.03.96/KK )
        !           257: | : w,          ( opcode -- )
        !           258:     code,   m@ $f0               +  ass,c ;
        !           259: | : w0,         ( opcode -- ) \ Modus: Rw
        !           260:     code,   m@ 2* 2* 2* 2*          ass,c ;
        !           261: | : ww,         ( opcode -- ) \ Modus: Rw
        !           262:     code,   m@  dup 2* 2* 2* 2*  +  ass,c ;
        !           263: | : #d2,        ( data offset -- ) \ Modus:  data2 #
        !           264:     over 5 1 within  AError" Nur 1..4 zulässig"
        !           265:     $d1 ass,c   swap 1- 2* 2* 2* 2* +  code, ;
        !           266: | : w,w         ( opcode -- ) \ Modus: Rw,Rw  oder  Rb,Rb
        !           267:     code,   n@<<4  m@ +  ass,c ;
        !           268: | : -w,w    code,  m@ 2* 2* 2* 2* n@ +  ass,c ;
        !           269: | : w,w+d       ( data opcode -- ) \ Modus: [Rw],[Rw+#data16]
        !           270:     w,w   ass, ;
        !           271: | : -w,w+d  -w,w  ass, ;
        !           272: | : w,l         ( label opcode -- )
        !           273:                       code,   n@ $f0 +  ass,c   label, ;
        !           274: | : w,mem       ( mem opcode -- ) \ Modus: Rw,mem
        !           275:     swap ?waddr  swap code,   n@ $f0 +  ass,c   ass, ;
        !           276: | : w],mem      ( mem opcode -- ) \ Modus: [Rw],mem
        !           277:     swap ?waddr  swap code,   n@        ass,c   ass, ;
        !           278: | : mem,w]      ( mem opcode -- ) \ Modus: mem,[Rw]
        !           279:     swap ?waddr  swap code,   m@        ass,c   ass, ;
        !           280: 
        !           281: | : b,bmem      ( mem opcode -- ) \ Modus: Rb,mem
        !           282:                       code,   n@ $f0 +  ass,c   ass, ;
        !           283: | : mem,w       ( mem opcode -- ) \ Modus: mem,Rw
        !           284:     swap ?waddr  swap code,   m@ $f0 +  ass,c   ass, ;
        !           285: | : bmem,b      ( mem opcode -- ) \ Modus: mem,Rb
        !           286:                       code,   m@ $f0 +  ass,c   ass, ;
        !           287: | : w,#         ( data opcode -- ) \ Modus: Rw,#data16
        !           288:     code,   n@ $f0 +  ass,c   ass, ;
        !           289: | : w,#4        ( data4 opcode -- ) \ Modus: Rw,(s)#data4
        !           290:     over &15 u> AError" Nur 0..15 erlaubt"
        !           291:     code,   2* 2* 2* 2* n@ +  ass,c ;
        !           292: | : b,#         ( data opcode -- ) \ Modus: Rb,#data8
        !           293:     swap ?8b swap   w,# ;
        !           294: 
        !           295: | : reg,#       ( reg data opcode -- ) \ Modus: reg,#data16
        !           296:     rot ?reg   swap code,   ass,c   ass, ;
        !           297: | : breg,#      ( reg data opcode -- ) \ Modus: reg,#data8
        !           298:     swap ?8b swap   reg,# ;
        !           299: 
        !           300: | : w,s#        ( data3 opcode -- ) \ Modus: Rw,#data3
        !           301:     over 7 u> AError" Nur 0..7 erlaubt"
        !           302:     code,   n@<<4  +  ass,c ;
        !           303: 
        !           304: | : w,w]        ( opcode -- ) \ Modus: Rw,[Rw] (Register<4)
        !           305:     m@ 3 u>  AError" Nur Wortregister 0..3 erlaubt"
        !           306:     code,   n@<<4  m@ $08 +  +  ass,c ;
        !           307: 
        !           308: | : w,w+]       ( opcode -- ) \ Modus: Rw,[Rw+] (Register<4)
        !           309:     m@ 3 u>  AError" Nur Wortregister 0..3 erlaubt"
        !           310:     code,   n@<<4  m@ $0c +  +  ass,c ;
        !           311: 
        !           312: | : (r|bm,bm|r  ( a1 a2 code offset -- ) \ Offset für mem,reg
        !           313:     >r >r  swap reg?
        !           314:     IF       r> code,  rdrop  ass,c   ass,   exit
        !           315:     ELSE swap reg?
        !           316:          IF  r> r> +   code,  ass,c   ass,   exit THEN
        !           317:          rdrop rdrop  drop drop
        !           318:     THEN -1 AError" Speicher zu Speicher nicht erlaubt" ;
        !           319: | : r|bm,bm|r2  2 (r|bm,bm|r ;
        !           320: | : r|bm,bm|r3  3 (r|bm,bm|r ;
        !           321: | : r|bm,bm|r4  4 (r|bm,bm|r ;
        !           322: 
        !           323: | : reg,bmem    ( reg mem code -- )
        !           324:     >r            swap ?reg   r> code,   ass,c   ass, ;
        !           325: 
        !           326: | : (r|m,m|r    ( a1 a2 code offset -- ) \ Offset für mem,reg
        !           327:     >r >r  swap reg?
        !           328:     IF       swap ?waddr swap
        !           329:              r> code,  rdrop  ass,c   ass,   exit
        !           330:     ELSE swap reg?
        !           331:          IF  swap ?waddr swap
        !           332:              r> r> +   code,  ass,c   ass,   exit THEN
        !           333:          rdrop rdrop  drop drop
        !           334:     THEN -1 AError" Speicher zu Speicher nicht erlaubt" ;
        !           335: | : r|m,m|r2    2 (r|m,m|r ;
        !           336: | : r|m,m|r3    3 (r|m,m|r ;
        !           337: | : r|m,m|r4    4 (r|m,m|r ;
        !           338: 
        !           339: | : reg,mem     ( reg mem code -- )
        !           340:     swap ?waddr swap   reg,bmem ;
        !           341: 
        !           342: | : bit,        ( addr bit opcode -- )
        !           343:     swap 4 lshift  +  code,  ass,c ;
        !           344: | : bit,bit     ( addr bit addr bit opcode -- )
        !           345:     code,   4 lshift >r  ass,c   swap ass,c   r> or  ass,c ;
        !           346: 
        !           347: | : ba_rel,     ( baddr bit addr opcode -- )
        !           348:     swap ?waddr X cell - ?rel  swap code,
        !           349:     rot ass,c   ass,c   4 lshift ass,c ;
        !           350: 
        !           351: | : rmd,        ( mask data opcode -- )
        !           352:     rot ?8b >r   swap ?8b >r   >r
        !           353:     r> code,   o@ ass,c   r> ass,c   r> ass,c ;
        !           354: | : amd,        ( baddr mask data opcode -- )
        !           355:     rot ?8b >r   swap ?8b >r   >r   ?baddr
        !           356:     r> code,   ass,c   r> ass,c   r> ass,c ;
        !           357: 
        !           358: | : segaddr,    ( seg addr opcode -- )
        !           359:     >r  ?waddr  swap ?8b  r>   code,  ass,c  ass, ;
        !           360: 
        !           361: | : ca_l,       ( opcode -- )
        !           362:     code,  n@<<4  ass,c   label, ;
        !           363: | : ca_a,       ( addr opcode -- )
        !           364:     swap ?waddr swap  code,  n@<<4  ass,c   ass, ;
        !           365: | : ci_r,       ( opcode -- )
        !           366:     code,  n@<<4  m@  or  ass,c ;
        !           367: | : cr_a,       ( addr opcode -- )
        !           368:     swap ?waddr ?rel  swap code,  ass,c ;
        !           369: | : cs_a,       ( seg addr opcode -- )
        !           370:     >r  ?waddr  swap ?seg  r> code,  ass,c  ass, ;
        !           371: 
        !           372: | : $dc_#d2,    ( data offset -- ) \ Modus:  data2 #
        !           373:     over 5 1 within  AError" Nur 1..4 zulässig"
        !           374:     $dc ass,c   swap 1- 2* 2* 2* 2* + n@ +  code, ;
        !           375: 
        !           376: | : $d7_#p_#d2, ( page data offset -- ) \ Modus:  data2 #
        !           377:     >r >r  ?page  r> r>                         \ Test auf Page
        !           378:     over 5 1 within  AError" Nur 1..4 zulässig"
        !           379:     $d7 ass,c   swap 1- 2* 2* 2* 2* +  code,   ass, ;
        !           380: 
        !           381: | : $d7_#s_#d2, ( page data offset -- ) \ Modus:  data2 #
        !           382:     >r >r  ?8b  r> r>                        \ Test auf Segment
        !           383:     over 5 1 within  AError" Nur 1..4 zulässig"
        !           384:     $d7 ass,c   swap 1- 2* 2* 2* 2* +  code,   ass, ;
        !           385: 
        !           386: | : reg,        ( reg opcode -- )
        !           387:     swap ?reg  swap code,  ass,c ;
        !           388: | : reg,l       ( reg opcode -- )
        !           389:     reg, label, ;
        !           390: 
        !           391: | : $xd_rel,    ( addr opcode -- )
        !           392:     swap ?waddr ?rel swap   n@<<4 +  code,   ass,c ;
        !           393: | : $yd_rel,    ( addr opcode -- ) \ Bedingung negieren
        !           394:     n@ 2 u< AError" cc_UC und cc_NET nicht erlaubt"
        !           395:     swap ?waddr ?rel swap
        !           396:     n@  1 xor  2* 2* 2* 2* +  code,   ass,c ;
        !           397: 
        !           398: | : trap7,      ( addr opcode -- )
        !           399:     over $7f u> AError" Nur 0..127 erlaubt"
        !           400:     code,  2* ass,c ;
        !           401: 
        !           402: 
        !           403: \ Generierung der Befehlstabellen               ( 02.01.96/KK )
        !           404: | : Table:      ( Name ; -- addr )
        !           405:     Create  here   reset   0 dic,
        !           406:     Does>   >r  modes@   r@ @   r> cell+
        !           407:             ?DO  dup i @  =               \ Adreßmodes gleich ?
        !           408:                IF drop  i cell+  unloop  dup @ swap \ code addr
        !           409:                   cell+  perform  reset  exit THEN  \ ausführen
        !           410:             6 +LOOP drop  -1 AError" Adreßmode nicht erlaubt" ;
        !           411: 
        !           412: | : opc:        ( routine ; ??? opcode -- )
        !           413:     >r   modes@ dic,   clearstack    r> dic,   ' dic,  reset ;
        !           414: 
        !           415: | : ;Table      ( addr -- ) \ Anzahl compilieren
        !           416:     here swap ! ;
        !           417: 
        !           418: | : +Table:     ( Name ; cfa offset -- )
        !           419:     Create  dic,  dic,
        !           420:     Does>   dup @  offset !   cell+ perform ;
        !           421: 
        !           422: | : 0Table:     ( Name ; cfa opcode -- )
        !           423:     Create  dic,  dic,
        !           424:     Does>   >r  stack?  mode@  or  komma @  or
        !           425:              AError" Keine Parameter erwartet"
        !           426:             r@ @  r> cell+  perform ;
        !           427: 
        !           428: 
        !           429: \ Opcodes  (ohne Parameter)                     ( 06.01.96/KK )
        !           430:   ' codexx,     $00cc 0Table: nop,
        !           431:   ' codexx,     $00cb 0Table: ret,
        !           432:   ' codexx,     $88fb 0Table: reti,
        !           433:   ' codexx,     $00db 0Table: rets,
        !           434: 
        !           435:   ' protect,      $a5 0Table: diswdt,
        !           436:   ' protect,      $b5 0Table: einit,
        !           437:   ' protect,      $87 0Table: idle,
        !           438:   ' protect,      $97 0Table: pwrdn,
        !           439:   ' protect,      $b7 0Table: srst,
        !           440:   ' protect,      $a7 0Table: srvwdt,
        !           441: 
        !           442: 
        !           443: \ Opcodes  (ein Parameter)                      ( 25.03.96/KK )
        !           444:   Table: atomic,  1 #                 $00  opc: #d2,     ;Table
        !           445:   ' atomic, $80 +Table: extr,
        !           446: 
        !           447:   Table: cpl,     r0                  $91  opc: w0,      ;Table
        !           448:   ' cpl,    $f0 +Table: neg,
        !           449: 
        !           450:   Table: cplb,    rl0                 $b1  opc: w0,      ;Table
        !           451:   ' cplb,   $f0 +Table: negb,
        !           452: 
        !           453:   Table: push,  ( -- )
        !           454:     r0                  $ec  opc: w,
        !           455:     0                   $ec  opc: reg,
        !           456:    ;Table
        !           457:   ' push,   $10 +Table: pop,
        !           458:   ' push,   $ff +Table: retp,
        !           459: 
        !           460: 
        !           461: \ Opcodes  (Bitoperationen)                     ( 14.01.96/KK )
        !           462:   Table: bclr,    r0 . 0              $0e  opc: bit,     ;Table
        !           463:   ' bclr,   $01 +Table: bset,
        !           464: 
        !           465:   Table: band,    r0 . 0 , r0 . 0     $6a  opc: bit,bit  ;Table
        !           466:   ' band,   $c0 +Table: bcmp,
        !           467:   ' band,   $e0 +Table: bmov,
        !           468:   ' band,   $d0 +Table: bmovn,
        !           469:   ' band,   $f0 +Table: bor,
        !           470:   ' band,   $10 +Table: bxor,
        !           471: 
        !           472:   Table: bfldh,
        !           473:     r0    , 0 # , 0 #   $1a  opc: rmd,
        !           474:     0     , 0 # , 0 #   $1a  opc: amd,
        !           475:    ;Table
        !           476:   ' bfldh,  $f0 +Table: bfldl,
        !           477: 
        !           478: 
        !           479: \ Opcodes  (Shift)                              ( 06.01.96/KK )
        !           480:   Table: ashr,  ( -- )
        !           481:     r0    , r1          $AC  opc: w,w
        !           482:     r0    , 1     #     $BC  opc: w,#4
        !           483:    ;Table
        !           484:   ' ashr,   $a0 +Table: shl,
        !           485:   ' ashr,   $c0 +Table: shr,
        !           486: 
        !           487:   ' ashr,   $60 +Table: rol,
        !           488:   ' ashr,   $80 +Table: ror,
        !           489: 
        !           490:   Table: prior,   r0 , r0             $2b  opc: w,w      ;Table
        !           491: 
        !           492: 
        !           493: \ Opcodes  (Division und Multiplikationen)      ( 06.01.96/KK )
        !           494:   Table: div,     r0                  $4b  opc: ww,      ;Table
        !           495:   ' div,    $20 +Table: divl,
        !           496:   ' div,    $30 +Table: divlu,
        !           497:   ' div,    $10 +Table: divu,
        !           498: 
        !           499:   Table: mul,     r0 , r0             $0b  opc: w,w      ;Table
        !           500:   ' mul,    $10 +Table: mulu,
        !           501: 
        !           502: 
        !           503: \ Opcodes  (Call´s)                             ( 06.01.96/KK )
        !           504:   Table: calla,
        !           505:     cc_nc , 1$          $ca  opc: ca_l,
        !           506:     cc_nc , 0           $ca  opc: ca_a,
        !           507:    ;Table
        !           508: 
        !           509:   Table: calli,   cc_nc , r0 ]        $ab  opc: ci_r,    ;Table
        !           510:   Table: callr,   0                   $bb  opc: cr_a,    ;Table
        !           511:   Table: calls,   0 , 0               $da  opc: cs_a,    ;Table
        !           512: 
        !           513:   Table: pcall,
        !           514:     r0    , 1$          $e2  opc: w,l
        !           515:     r0    , 0           $e2  opc: w,mem
        !           516:     0     , 1$          $e2  opc: reg,l
        !           517:     0     , 0           $e2  opc: reg,mem
        !           518:    ;Table
        !           519: 
        !           520: \ Opcodes  (Jumps und TRAP)                     ( 06.01.96/KK )
        !           521:   Table: jb,      r0 . 0 , 0          $8a  opc: ba_rel,  ;Table
        !           522:   ' jb,     $20 +Table: jbc,
        !           523:   ' jb,     $10 +Table: jnb,
        !           524:   ' jb,     $30 +Table: jnbs,
        !           525: 
        !           526:   Table: jmpr,    cc_nc , 0           $0d  opc: $xd_rel, ;Table
        !           527: | Table: -jmpr,   cc_nc , 0           $0d  opc: $yd_rel, ;Table
        !           528: 
        !           529:   ' calla,  $20 +Table: jmpa,
        !           530: 
        !           531:   ' calli,  $f1 +Table: jmpi,
        !           532: 
        !           533:   Table: jmps,    0 , 0               $fa  opc: segaddr, ;Table
        !           534: 
        !           535:   Table: trap,    0 #                 $9b  opc: trap7,   ;Table
        !           536: 
        !           537: 
        !           538: \ Opcodes  (EXTS ... EXTPR)                     ( 14.01.96/KK )
        !           539:   Table: exts,  ( -- )
        !           540:     r0    , 0     #     $00  opc: $dc_#d2,
        !           541:     0 #   , 0     #     $00  opc: $d7_#s_#d2,
        !           542:    ;Table
        !           543:   ' exts,   $80 +Table: extsr,
        !           544: 
        !           545:   Table: extp,  ( -- )
        !           546:     r0    , 0     #     $40  opc: $dc_#d2,
        !           547:     0 #   , 0     #     $40  opc: $d7_#p_#d2,
        !           548:    ;Table
        !           549:   ' extp,   $80 +Table: extpr,
        !           550: 
        !           551: 
        !           552: \ Opcodes  (ADD,-Type)                          ( 06.01.96/KK )
        !           553:   Table: add,   ( -- )
        !           554:     r0    , r0          $00  opc: w,w
        !           555:     r0    , 0           $02  opc: w,mem
        !           556:     0     , 0           $02  opc: r|m,m|r2
        !           557:     0     , r0          $04  opc: mem,w
        !           558:     r0    , 0     #     $06  opc: w,#
        !           559:     $fe00 , 0     #     $06  opc: reg,#
        !           560:     r0    , r0    ]     $08  opc: w,w]
        !           561:     r0    , r0    ]+    $08  opc: w,w+]
        !           562:     r0    , 0     s#    $08  opc: w,s#
        !           563:    ;Table
        !           564: 
        !           565:   ' add,    $10 +Table: addc,     ' add,    $20 +Table: sub,
        !           566:   ' add,    $30 +Table: subc,     ' add,    $50 +Table: xor,
        !           567:   ' add,    $60 +Table: and,      ' add,    $70 +Table: or,
        !           568: 
        !           569: \ Opcodes  (ADDB-Types)                         ( 06.01.96/KK )
        !           570:   Table: addb,  ( -- )
        !           571:     rl0   , rl0         $01  opc: w,w
        !           572:     rl0   , 0           $03  opc: b,bmem
        !           573:     0     , 0           $03  opc: r|bm,bm|r2
        !           574:     0     , rl0         $05  opc: bmem,b
        !           575:     rl0   , 0     #     $07  opc: b,#
        !           576:     $fe00 , 0     #     $07  opc: breg,#
        !           577:     rl0   , r0    ]     $09  opc: w,w]
        !           578:     rl0   , r0    ]+    $09  opc: w,w+]
        !           579:     rl0   , 0     s#    $09  opc: w,s#
        !           580:    ;Table
        !           581: 
        !           582:   ' addb,   $10 +Table: addbc,    ' addb,   $20 +Table: subb,
        !           583:   ' addb,   $30 +Table: subbc,    ' addb,   $50 +Table: xorb,
        !           584:   ' addb,   $60 +Table: andb,     ' addb,   $70 +Table: orb,
        !           585: 
        !           586: \ Opcodes  (CMP)                                ( 06.01.96/KK )
        !           587:   Table: cmp,   ( -- )
        !           588:     r0    , r0          $40  opc: w,w
        !           589:     r0    , 0           $42  opc: w,mem
        !           590:     $fe00 , 0           $42  opc: reg,mem
        !           591:     r0    , 0     #     $46  opc: w,#
        !           592:     $fe00 , 0     #     $46  opc: reg,#
        !           593:     r0    , r0    ]     $48  opc: w,w]
        !           594:     r0    , r0    ]+    $48  opc: w,w+]
        !           595:     r0    , 0     s#    $48  opc: w,s#
        !           596:    ;Table
        !           597: 
        !           598: \ Opcodes  (CMPB)                               ( 06.01.96/KK )
        !           599:   Table: cmpb,  ( -- )
        !           600:     rl0   , rl0         $41  opc: w,w
        !           601:     rl0   , 0           $43  opc: b,bmem
        !           602:     $fe00 , 0           $43  opc: reg,bmem
        !           603:     rl0   , 0     #     $47  opc: b,#
        !           604:     $fe00 , 0     #     $47  opc: breg,#
        !           605:     rl0   , r0    ]     $49  opc: w,w]
        !           606:     rl0   , r0    ]+    $49  opc: w,w+]
        !           607:     rl0   , 0     s#    $49  opc: w,s#
        !           608:    ;Table
        !           609: 
        !           610: \ Opcodes  (CMPD1 ... CMPI2)                    ( 06.01.96/KK )
        !           611:   Table: cmpd1, ( -- )
        !           612:     r0    , 0     s#    $a0  opc: w,#4
        !           613:     r0    , 0           $a2  opc: w,mem
        !           614:     r0    , 0     #     $a6  opc: w,#
        !           615:    ;Table
        !           616:   ' cmpd1,  $10 +Table: cmpd2,
        !           617: 
        !           618:   ' cmpd1,  $e0 +Table: cmpi1,
        !           619:   ' cmpd1,  $f0 +Table: cmpi2,
        !           620: 
        !           621: \ Opcodes  (MOV)                                ( 18.03.96/KK )
        !           622:   Table: mov,   ( -- )
        !           623:     r0    , r0          $f0  opc: w,w
        !           624:     r0    , 0     s#    $e0  opc: w,#4
        !           625:     r0    , 0     #     $e6  opc: w,#
        !           626:     $fe00 , 0     #     $e6  opc: reg,#
        !           627:     r0    , r0    ]     $a8  opc: w,w
        !           628:     r0    , r0    ]+    $98  opc: w,w
        !           629:     r0 ]  , r0          $b8  opc: -w,w
        !           630:     r0 -] , r0          $88  opc: -w,w
        !           631:     r0 ]  , r0    ]     $c8  opc: w,w
        !           632:     r0 ]+ , r0    ]     $d8  opc: w,w
        !           633:     r0 ]  , r0    ]+    $e8  opc: w,w
        !           634:     r0    , r0 0  #]    $d4  opc: w,w+d
        !           635:     r0 0 #] , r0        $c4  opc: -w,w+d
        !           636:     r0 ]  , 0           $84  opc: w],mem
        !           637:     0     , r0 ]        $94  opc: mem,w]
        !           638:     r0    , 0           $f2  opc: w,mem
        !           639:     0     , 0           $f2  opc: r|m,m|r4
        !           640:     0     , r0          $f6  opc: mem,w
        !           641:    ;Table
        !           642: 
        !           643: \ Opcodes  (MOVB)                               ( 18.03.96/KK )
        !           644:   Table: movb,  ( -- )
        !           645:     rl0   , rl0         $f1  opc: w,w
        !           646:     rl0   , 0     s#    $e1  opc: w,#4
        !           647:     rl0   , 0     #     $e7  opc: b,#
        !           648:     $fe00 , 0     #     $e7  opc: breg,#
        !           649:     rl0   , r0    ]     $a9  opc: w,w
        !           650:     rl0   , r0    ]+    $99  opc: w,w
        !           651:     r0 ]  , rl0         $b9  opc: -w,w
        !           652:     r0 -] , rl0         $89  opc: -w,w
        !           653:     r0 ]  , r0    ]     $c9  opc: w,w
        !           654:     r0 ]+ , r0    ]     $d9  opc: w,w
        !           655:     r0 ]  , r0    ]+    $e9  opc: w,w
        !           656:     rl0   , r0 0  #]    $f4  opc: w,w+d
        !           657:     r0 0 #] , rl0       $e4  opc: -w,w+d
        !           658:     r0 ]  , 0           $a4  opc: w],mem
        !           659:     0     , r0 ]        $b4  opc: mem,w]
        !           660:     rl0   , 0           $f3  opc: b,bmem
        !           661:     0     , 0           $f3  opc: r|bm,bm|r4
        !           662:     0     , rl0         $f7  opc: bmem,b
        !           663:    ;Table
        !           664: 
        !           665: \ Opcodes  (MOVBS  MOVBZ  SCXT)                 ( 14.01.96/KK )
        !           666:   Table: movbs, ( -- )
        !           667:     r0    , rl0         $d0  opc: w,w
        !           668:     r0    , 0           $d2  opc: b,bmem
        !           669:     0     , 0           $d2  opc: r|m,m|r3
        !           670:     0     , rl0         $d5  opc: bmem,b
        !           671:    ;Table
        !           672:   ' movbs,  $f0 +Table: movbz,
        !           673: 
        !           674:   Table: scxt,  ( -- )
        !           675:     r0    , 0     #     $c6  opc: w,#
        !           676:     $fe00 , 0     #     $c6  opc: reg,#
        !           677:     r0    , 0           $d6  opc: w,mem
        !           678:     0     , 0           $d6  opc: reg,mem
        !           679:    ;Table
        !           680: 
        !           681: 
        !           682: \ Zusätze für Kontrollstrukturen                ( 25.07.97/KK )
        !           683: | : >jrcc       ( -- ) \ JMPR mit Bedingung compilieren
        !           684:     ,  asshere X cell+  -jmpr, ;
        !           685: | : <jrcc       ( addr flag -- addr flag )
        !           686:     ,  over        -jmpr, ;
        !           687: 
        !           688: | : -?rel       ( addr -- rel ) \ 16Bit-Befehl erwartet
        !           689:     asshere  swap - X cell /
        !           690:     dup $80 $ff80 within  AError" Relativsprungziel zu fern" ;
        !           691: | : >jrres      ( addr -- )
        !           692:     dup -?rel  swap 1- ass!c ;
        !           693: | : >jrresume   ( 2 [ addr -2 ] -- )
        !           694:     BEGIN -2 = WHILE >jrres REPEAT  reset ;
        !           695: 
        !           696: : ?pairs - ABORT" C165: unstructured!" ;
        !           697: 
        !           698: \ Kontrollstrukturen                            ( 06.01.96/KK )
        !           699:   : IF,         ( -- addr 1 ) \ Bedingung erwartet
        !           700:     >jrcc  asshere  1  reset ;
        !           701: 
        !           702:   : ELSE,       ( addr 1 -- addr2 -1 ) \ Nichts vorher erlaubt
        !           703:     dup 1 ?pairs                                         \ Test
        !           704:     cc_UC , asshere X cell+ jmpr,       \ unbedingter Vorwärtssprung
        !           705:     drop >jrres                                  \ IF, auflösen
        !           706:     asshere  -1  reset ;              \ Flags/Adresse für THEN,
        !           707: 
        !           708:   : THEN,       ( addr 1|addr2 -1 -- )
        !           709:     dup abs 1 ?pairs
        !           710:     drop >jrres  reset ;
        !           711: 
        !           712: 
        !           713:   : BEGIN,      ( -- 2 addr 2 )
        !           714:     2 asshere 2  reset ;
        !           715: 
        !           716:   : WHILE,      ( addr 2 -- addr2 -2 addr 2 )
        !           717:     dup 2 ?pairs
        !           718:     >jrcc  asshere -2  2swap  reset ;
        !           719: 
        !           720:   : REPEAT,     ( 2 [ addr2 -2 ] addr 2 -- )
        !           721:     dup 2 ?pairs
        !           722:     drop >r   depth 2 + ssp !   cc_UC ,  r> jmpr,
        !           723:     >jrresume ;
        !           724: 
        !           725:   : UNTIL,      ( 2 [ addr2 -2 ] addr 2 -- )
        !           726:     dup 2 ?pairs   <jrcc   2drop >jrresume ;
        !           727: 
        !           728: 
        !           729: 
        !           730: \ Register des 80C165                           ( 03.02.96/KK )
        !           731:   $f108 Constant _rp0h          \ System Startup Conf. R.
        !           732:   $ff12 Constant _syscon        \ CPU System Conf. R.
        !           733:   $ff10 Constant _psw           \ CPU Program Status Word
        !           734:   $fe10 Constant _cp            \ CPU Context Ptr R.
        !           735: 
        !           736:   $ffae Constant _wdtcon        \ Watchdog Timer C.R.
        !           737:   $feae Constant _wdt           \ Watchdog Timer R.
        !           738: 
        !           739:   $f1c0 Constant _exicon        \ External Interrupt C.R.
        !           740:   $f186 Constant _xp0ic         \ X-Peripheral 0 Interrupt C.R.
        !           741:   $f18e Constant _xp1ic         \ X-Peripheral 1 Interrupt C.R.
        !           742:   $f196 Constant _xp2ic         \ X-Peripheral 2 Interrupt C.R.
        !           743:   $f19e Constant _xp3ic         \ X-Peripheral 3 Interrupt C.R.
        !           744: 
        !           745:   $ffac Constant _tfr           \ Trap Flag R.
        !           746: 
        !           747: \ Register des 80C165 (Stack, Page Ptr)         ( 03.02.96/KK )
        !           748:   $fe12 Constant _sp            \ CPU System Stack Ptr R.
        !           749:   $fe14 Constant _stkov         \ CPU Stack Overflow Ptr R.
        !           750:   $fe16 Constant _stkun         \ CPU Stack Underflow Ptr R.
        !           751: 
        !           752:   $fe08 Constant _csp           \ CPU Code Segment Ptr R.
        !           753:   $fe00 Constant _dpp0          \ CPU Data Page Ptr 0 R.
        !           754:   $fe02 Constant _dpp1          \ CPU Data Page Ptr 1 R.
        !           755:   $fe04 Constant _dpp2          \ CPU Data Page Ptr 2 R.
        !           756:   $fe06 Constant _dpp3          \ CPU Data Page Ptr 3 R.
        !           757: 
        !           758: \ Register des 80C165 (PEC, 0, -1, MD)          ( 03.02.96/KK )
        !           759:   $fec0 Constant _pecc0         \ PEC Channel 0 C.R.
        !           760:   $fec2 Constant _pecc1         \ PEC Channel 1 C.R.
        !           761:   $fec4 Constant _pecc2         \ PEC Channel 2 C.R.
        !           762:   $fec6 Constant _pecc3         \ PEC Channel 3 C.R.
        !           763:   $fec8 Constant _pecc4         \ PEC Channel 4 C.R.
        !           764:   $feca Constant _pecc5         \ PEC Channel 5 C.R.
        !           765:   $fecc Constant _pecc6         \ PEC Channel 6 C.R.
        !           766:   $fece Constant _pecc7         \ PEC Channel 7 C.R.
        !           767: 
        !           768:   $ff1c Constant _zeros         \ Constant 0
        !           769:   $ff1e Constant _ones          \ Constant $ffff
        !           770: 
        !           771:   $ff0e Constant _mdc           \ CPU Multiply Divide C.R.
        !           772:   $fe0c Constant _mdh           \ CPU Multiply Divide R. (High)
        !           773:   $fe0e Constant _mdl           \ CPU Multiply Divide R. (Low)
        !           774: 
        !           775: \ Register des 80C165                           ( 03.02.96/KK )
        !           776:   $ff0c Constant _buscon0       \ Bus Configuration R. 0
        !           777:   $ff14 Constant _buscon1       \ Bus Conf. R. 1
        !           778:   $ff16 Constant _buscon2       \ Bus Conf. R. 2
        !           779:   $ff18 Constant _buscon3       \ Bus Conf. R. 3
        !           780:   $ff1a Constant _buscon4       \ Bus Conf. R. 4
        !           781: 
        !           782:   $fe18 Constant _addrsel1      \ Adress Select R. 1
        !           783:   $fe1a Constant _addrsel2      \ Adress Select R. 2
        !           784:   $fe1c Constant _addrsel3      \ Adress Select R. 3
        !           785:   $fe1e Constant _addrsel4      \ Adress Select R. 4
        !           786: 
        !           787:   $fe4a Constant _caprel        \ GPT1 Capture/Reload R.
        !           788:   $ff6a Constant _cric          \ GPT2 CAPREL Interrupt C.R.
        !           789: 
        !           790: \ Register des 80C165 (Timer)                   ( 03.02.96/KK )
        !           791:   $ff40 Constant _t2con         \ GPT1 Timer 2 C.R.
        !           792:   $ff42 Constant _t3con         \ GPT1 Timer 3 C.R.
        !           793:   $ff44 Constant _t4con         \ GPT1 Timer 4 C.R.
        !           794:   $ff46 Constant _t5con         \ GPT2 Timer 5 C.R.
        !           795:   $ff48 Constant _t6con         \ GPT2 Timer 6 C.R.
        !           796:   $ff60 Constant _t2ic          \ GPT1 Timer 2 Interrupt C.R.
        !           797:   $ff62 Constant _t3ic          \ GPT1 Timer 3 Interrupt C.R.
        !           798:   $ff64 Constant _t4ic          \ GPT1 Timer 4 Interrupt C.R.
        !           799:   $ff66 Constant _t5ic          \ GPT2 Timer 5 Interrupt C.R.
        !           800:   $ff68 Constant _t6ic          \ GPT2 Timer 6 Interrupt C.R.
        !           801:   $fe40 Constant _t2            \ GPT1 Timer 2 R.
        !           802:   $fe42 Constant _t3            \ GPT1 Timer 3 R.
        !           803:   $fe44 Constant _t4            \ GPT1 Timer 4 R.
        !           804:   $fe46 Constant _t5            \ GPT1 Timer 5 R.
        !           805:   $fe48 Constant _t6            \ GPT1 Timer 6 R.
        !           806: 
        !           807: \ Register des 80C165 (Ports)                   ( 03.02.96/KK )
        !           808:   $f100 Constant _dp0l          \ P0L Direction Control Register
        !           809:   $ff00 Constant _p0l           \ Port 0 Low R.
        !           810:   $f102 Constant _dp0h          \ P0H Direction C.R.
        !           811:   $ff02 Constant _p0h           \ Port 0 High R.
        !           812: 
        !           813:   $f104 Constant _dp1l          \ P1L Direction C.R.
        !           814:   $ff04 Constant _p1l           \ Port 1 Low R.
        !           815:   $f106 Constant _dp1h          \ P1H Direction C.R.
        !           816:   $ff06 Constant _p1h           \ Port 1 High R.
        !           817: 
        !           818:   $ffc2 Constant _dp2           \ Port 2 Direction C.R.
        !           819:   $f1c2 Constant _odp2          \ Port 2 Open Drain C.R
        !           820:   $ffc0 Constant _p2            \ Port 2 R.
        !           821: 
        !           822:   $ffc6 Constant _dp3           \ Port 3 Direction C.R.
        !           823:   $f1c6 Constant _odp3          \ Port 3 Open Drain C.R
        !           824:   $ffc4 Constant _p3            \ Port 3 R.
        !           825: 
        !           826:   $ffca Constant _dp4           \ Port 4 Direction C.R.
        !           827:   $ffc8 Constant _p4            \ Port 4 R. (8 Bit)
        !           828: 
        !           829:   $ffa2 Constant _p5            \ Port 5 R.
        !           830: 
        !           831:   $ffce Constant _dp6           \ Port 6 Direction C.R.
        !           832:   $f1ce Constant _odp6          \ Port 6 Open Drain C.R
        !           833:   $ffcc Constant _p6            \ Port 6 R. (8 Bit)
        !           834: 
        !           835: \ Register des 80C165 (SC0 und SCC)             ( 03.02.96/KK )
        !           836:   $feb0 Constant _s0tbuf        \ SC0 TX Data
        !           837:   $feb2 Constant _s0rbuf        \ SC0 RX Data
        !           838:   $feb4 Constant _s0bg          \ SC0 Baud Rate Generator Reload
        !           839:   $f19c Constant _s0tbic        \ SC0 TX Interrupt C.R.
        !           840:   $ff6c Constant _s0tic         \ SC0 TX Interrupt C.R.
        !           841:   $ff6e Constant _s0ric         \ SC0 RX Interrupt C.R.
        !           842:   $ff70 Constant _s0eic         \ SC0 Error Interrupt C.R.
        !           843:   $ffb0 Constant _s0con         \ SC0 C.R.
        !           844:   $f0b0 Constant _ssctb         \ SSC Transmit Buffer
        !           845:   $f0b2 Constant _sscrb         \ SSC Receive Buffer
        !           846:   $f0b4 Constant _sscbr         \ SSC Baudrate Register
        !           847:   $ff72 Constant _ssctic        \ SSC TX Interrupt C.R.
        !           848:   $ff74 Constant _sscric        \ SSC RX Interrupt C.R.
        !           849:   $ff76 Constant _ssceic        \ SSC Error Interrupt C.R.
        !           850:   $ffb2 Constant _ssccon        \ SSC C.R.
        !           851: 
        !           852: \ End-Proc   End-Code                           ( 02.01.96/KK )
        !           853: \  : End-Proc    ( -- )
        !           854: \    check  reveal  Forth ;
        !           855: 
        !           856: \  : End-Code    ( -- )
        !           857: \    [compile] end-proc ;
        !           858: 
        !           859: \ ;Code  Proc  Code                             ( 25.07.97/KK )
        !           860: 
        !           861: \ forth definitions
        !           862: 
        !           863: \  : ;Code       ( 0 -- )
        !           864: \    dup  0 ?pairs  drop
        !           865: \    compile (;code   [compile] [
        !           866: \    [Assembler] ready [Forth]   Assembler ;  immediate
        !           867: 
        !           868: \  : Proc        ( name ; -- )
        !           869: \    Create  hide
        !           870: \    [Assembler] ready [Forth]   Assembler ;
        !           871: 
        !           872: : (Code)-c165  ( name ; -- )
        !           873:     (code)-1 ready ;   ' (code)-c165 IS (code)
        !           874: 
        !           875: : (end-code)-c165    
        !           876:     check (end-code)-1 ;
        !           877: 
        !           878: previous definitions
        !           879: 
        !           880: \ Beschreibung der Adreßmodes                   ( 25.07.97/KK )
        !           881: \ mode ->  $00xx : Nur ein Operant (kein Komma)
        !           882: \          $xxyy : xx=1. Mode ; yy=2. Mode
        !           883: \
        !           884: \ Mode  Stack  Typ                Mode  Stack  Typ
        !           885: \ $00    0/1   ---                $1n     0    Byteregister
        !           886: \ $2n     0    Wortregister       $3n     0    [Wortregister+]
        !           887: \ $4n     0    [-Wortregister]    $5n     0    [Wortregister]
        !           888: \ $60     1    [Memory]           $7n     1    [Rw+d]
        !           889: \ $80     1    3Bit-Wert          $90     1    Wert
        !           890: \ $A0     2    Bitadresse         $Bc     0    Bedingung
        !           891: \ $Cn     0    Label
        !           892: 
        !           893: \ -------------------------------------------------------------
        !           894: \ Logbuch                                       ( 25.07.97/KK )
        !           895: \
        !           896: \ 27.12.95  KK: File angefangen
        !           897: \ 06.01.95  KK: Assembler fertig
        !           898: \ 03.02.96  KK: Register hinzugefügt
        !           899: \ 12.02.96  KK: Korrektur in JB, (Sprung+2) und 0Table:
        !           900: \ 18.03.96  KK: IP auf Register R3 gelegt (wegen BRANCH)
        !           901: \               Korrekturen in MOV, und MOVB, (n<>m)
        !           902: \ 25.03.96  KK: POP korrigiert (Offset $10 statt $6B)
        !           903: \               w,w] korrigiert ($08 statt $04 addieren)
        !           904: \ 04.01.96  KK: Opcode für JMPS korrigiert
        !           905: \ 12.02.96  KK: Korrekturen
        !           906: \ 25.07.97  KK: Anpassung an GFORTH (BLK->Seq.)
        !           907: 
        !           908: 
        !           909: 
        !           910: 

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