0) Index to BIF HI-LEVEL disk
2) Title page, Copr. notice
3) MONITOR CALL TO DEBUG
4) ERROR MESSAGES
6) HIGH LEVEL TOOLS & UTILITIES
7) LIST, INDEX, TRIAD
8) HIGH LEVEL DISK & SCREEN
11) FORWARD REFERENCING
12) PERIPHERAL UTILITIES
13) SLIST
15) DUMP DEFINITION BY NAME
16) ASSEMBLER
32) DOUBLES IN ASSEMBLER

40) HLL COMPILER
64) PAIR ASSOCIATION EXAMPLE
66) A TRY AT DIVIDE BY CONSTANT

100) SARDIS DMC STUFF

144) HOOCH COMPILER REMAINS

















































              BIF
       EDITOR, UTILITIES,
    ASSEMBLER, AND EXAMPLES
          VERSION 1.0


       COPYRIGHT    1989
       JOEL MATTHEW REES

   THESE ALGORITHMS ARE
EXPRESSED IN THREE LANGUAGES:
BIF, BIF ASSEMBLER FOR THE
MOTOROLA M6809 MICROPROCESSOR,
AND HEXADECIMAL MACHINE CODE FOR
THE M6809.

   THE TEXT IS ORGANIZED FOR
EDITING ON A 32-COLUMN TERMINAL,
SUCH AS IS FOUND ON A RADIO
SHACK COLOR COMPUTER 2.

   THESE ALGORITHMS AND THEIR
TEXT ARE INTENDED FOR NO PURPOSE
OTHER THAN EXPERIMENTATION, AND
NO CLAIMS OR WARRANTIES ARE MADE
CONCERNING THEIR USEFULNESS IN
ANY PARTICULAR APPLICATION.

PUBLISHED 1989
   JOEL MATTHEW REES
   SOUTH SALT LAKE CITY, UTAH
























( CALL TO MONITOR, IF SWI IS BRE
AKPOINT           JMR-88OCT?? )

CREATE MON HEX 3F C, 6EB1 ,
  SMUDGE HERE 1- FENCE ! ;S
























( ERROR MESSAGES )
DATA STACK UNDERFLOW
DICTIONARY FULL
ADDRESS RESOLUTION ERROR
HIDES DEFINITION IN
NULL VECTOR WRITTEN
DISC RANGE?
DATA STACK OVERFLOW
DISC ERROR!
CAN'T EXECUTE A NULL!
CONTROL STACK UNDERFLOW
CONTROL STACK OVERFLOW
ARRAY REFERENCE OUT OF BOUNDS
ARRAY DIMENSION NOT VALID
NO PROCEDURE TO ENTER
               ( WAS REGISTER )

COMPILATION ONLY, USE IN DEF
EXECUTION ONLY
CONDITIONALS NOT PAIRED
DEFINITION INCOMPLETE
IN PROTECTED DICTIONARY
USE ONLY WHEN LOADING
OFF CURRENT EDITING SCREEN
DECLARE VOCABULARY
DEFINITION NOT IN VOCABULARY
IN FORWARD BLOCK
ALLOCATION LIST CORRUPTED: LOST
CAN'T REDEFINE nul!
NOT FORWARD REFERENCE
              ( WAS IMMEDIATE )
























( MORE ERROR MESSAGES )
HAS INCORRECT ADDRESS MODE
HAS INCORRECT INDEX MODE
OPERAND NOT REGISTER
HAS ILLEGAL IMMEDIATE
PC OFFSET MUST BE ABSOLUTE
ACCUMULATOR OFFSET REQUIRED
ILLEGAL MEMORY INDIRECTION
ILLEGAL INDEX BASE
ILLEGAL TARGET SPECIFIED
CAN'T STACK ON SELF
DUPLICATE IN LIST
REGISTER NOT STACK
EMPTY REGISTER LIST
IMMEDIATE OPERAND REQUIRED
REQUIRES CONDITION

COMPILE-TIME STACK UNDERFLOW
COMPILE-TIME STACK OVERFLOW
























( UTILITIES DUMP QLIST QINDEX )
( L/SCR ULIST      JMR-88NOV16)
 BIF DEFINITIONS HEX
 ( UTILITIES IS NOW IN KERNEL )
 UTILITIES DEFINITIONS
: BYTE-DUMP -DUP IF
    0 DO DUP I + C@ 4 .R LOOP
  ENDIF DROP ;  ( BASE > 6)
 BIF DEFINITIONS
: DUMP -DUP IF OVER + SWAP
    DO I 0 6 D.R I 4
      [ UTILITIES ] BYTE-DUMP
      [ BIF ] 3A EMIT I 4 TYPE
      CR ?TERMINAL 0< IF
        KEY 0< IF LEAVE ENDIF
      ENDIF 4 +LOOP ENDIF ;
: QLIST BLOCK [ EDITOR ] QDUMP
  [ BIF ] 500 88 ! ( CENTER ) ;
: QINDEX 1+ SWAP DO I QLIST
    ." SCREEN=" I 4 /MOD .
    3A EMIT . ."  BLOCK=" I .
    KEY 0< IF LEAVE ENDIF
  LOOP ;
 UTILITIES DEFINITIONS
: L/SCR B/BUF B/SCR C/L */ ;
: ULIST ( SCREEN N, FLAG BRK )
  DUP SCR ! ." SCR # " . 0 ( F )
  L/SCR 0 DO CR I 3 .R SPACE
    I SCR @ .LINE
    ?TERMINAL 0< IF  ( BREAK? )
      KEY 0< IF 1- LEAVE ENDIF
    ENDIF LOOP CR ; -->
























( LIST INDEX TRIAD )
                ( JMR-88NOV16 )
 BIF DEFINITIONS
: LIST ( WIDE OUTPUT ) DECIMAL
  CR UTILITIES ULIST BIF DROP ;

: INDEX ( PRINT COMMENT LINES )
  0C EMIT ( FORM FEED ) CR
  1+ SWAP DO
    CR I 3 .R SPACE
    0 I .LINE
    C/L 49 < IF 1 I .LINE ENDIF
    ?TERMINAL 0< IF
      KEY 0< IF LEAVE ENDIF
    ENDIF
  LOOP ;

: TRIAD ( LIST MULTIPLE ) >PRT
  0C EMIT ( FORM FEED )
  [ DECIMAL ] UTILITIES L/SCR
  BIF 22 > IF 2 ELSE 3 ENDIF
  >R R / R * DUP R> + SWAP
  DO I UTILITIES ULIST BIF
    0< IF LEAVE ENDIF
    UTILITIES L/SCR BIF DUP
    32 = SWAP 22 = OR NOT IF
      CR CR ENDIF
  LOOP >VID ;    HEX



                             -->
























( HOME CLS QSAVE SAVE-BUFFERS
 QCAN )         ( JMR-88DEC10 )
 UTILITIES DEFINITIONS HEX
: HOME 400 88 ! ;
: MID 500 88 ! ;
 BIF DEFINITIONS
: CLS 400 200 60 FILL
  UTILITIES HOME BIF ;
 UTILITIES DEFINITIONS
: CAN-UP ( CANCEL UPDATE IN BUF)
  DUP @ 7FFF AND OVER ! ;

: W-BUF ( WRITE BUF AT ADR )
  DUP 2+ OVER @ 7FFF AND 0 R/W
  CAN-UP ;

: SAVE-BUF     ( IF UPDATED )
  DUP @ 0< IF W-BUF ENDIF ;

 BIF DEFINITIONS
: QSAVE PREV @ ( SAVE PREVIOUS )
  UTILITIES SAVE-BUF BIF DROP ;


: SAVE-BUFFERS PREV @
  BEGIN UTILITIES SAVE-BUF BIF
    +BUF NOT UNTIL DROP ;

: QCAN PREV @ ( CAN UP OF PREV )
  UTILITIES CAN-UP BIF DROP ;
-->
























( CANCEL-UPDATES RE-QUICK .PREV
 .BUFFERS QPREV   JMR-88DEC10 )
: CANCEL-UPDATES PREV @
  BEGIN UTILITIES CAN-UP BIF
    +BUF NOT UNTIL DROP ;

: RE-QUICK ( QUICK OLD PREVIOUS)
  PREV @ DUP @ 7FFF AND 0 ROT !
  [ EDITOR ] QUICK BIF ;

UTILITIES DEFINITIONS
: .BUF ( QLIST BUFFER, . BLOCK )
  DUP @ DUP 7FFF AND DUP QLIST
  MID ." BLOCK=" .
  0< IF ."  UPDATED" ENDIF CR ;

 BIF DEFINITIONS
: .BUFFERS PREV @ ( .BUF, PAUSE)
  BEGIN UTILITIES .BUF BIF
    +BUF DROP KEY 0< ( BREAK? )
  UNTIL DROP ;

: .PREV PREV @ UTILITIES .BUF
  BIF DROP ;

: EDIT DUP UTILITIES MID BIF
  ." BLOCK=" . CR [ EDITOR ]
  QUICK BIF PREV @ @
  0< IF ." UPDATED" ENDIF ;

: QPREV PREV @ @ 7FFF AND
  EDIT ;                     -->
























( QOPY COPY QBACK BACK-UP )
                ( JMR-88DEC11 )
: QOPY SWAP BLOCK SWAP BLOCK
  B/BUF 2/ MOVE UPDATE ;

: COPY 2* 2*      ( SCREEN  )
  SWAP 2* 2* DUP 4 + SWAP
  DO I OVER QOPY 1+ LOOP DROP ;
: QBACK  1+ SWAP DO I QLIST
  I BLOCK DUP [ EDITOR ] QDUMP
  ." BLOCK " I . ." TO "
  0 DRIVE-OFFSET @ I + DUP .
  KEY 59 = IF 0 R/W ( YES? )
    ELSE DROP DROP
  ENDIF LOOP ;

: EEDIT ( ERASE AND EDIT BLOCK )
  DUP BLOCK 2- UTILITIES .BUF 2+
  MID BIF ." BLOCK=" OVER .
  ."  CLEAR?" CR
  KEY 59 = IF ( YES? )
    B/BUF BLANKS UPDATE
  ELSE DROP ( DON'T CLEAR )
  ENDIF EDIT ;             -->
























( RES-ERROR FORWARD :RESOLVE
 :RESOLVE ;RES    JMR-16MAY89 )
 UTILITIES DEFINITIONS HEX
: RES-ERROR ( ADR RESOLUTION )
  3 ERROR ;

 BIF DEFINITIONS UTILITIES
: FORWARD ( REFERENCE HEADER )
  CREATE 7E C, ( JMP EXTENDED )
  IP, [ ' RES-ERROR CFA , ]
  ( INIT TO RES-ERROR ) SMUDGE
  FOREWARD @ 0= IF ( EARLIEST? )
    LATEST FOREWARD ! ENDIF ;
 ASSEMBLER DEFINITIONS
 UTILITIES
: :RESOLVE ( :ASM FORWARD REFS )
  ?EXEC !CSP [COMPILE] ' DUP
  CFA DUP 1+ SWAP C@ 7E - ( JMP)
  OVER @ ' RES-ERROR CFA -
  OR 1D ?ERROR ( HEADER? )
  HERE SWAP ! ( LINK IT )
  FOREWARD @ = IF ( END FORWD? )
    0 FOREWARD ! ENDIF ;
 IMMEDIATE

 BIF DEFINITIONS ASSEMBLER
: :RES ( RESOLVE : FORWARDS )
  [COMPILE] :RESOLVE [ BIF ]
  ( ASSEMBLE JMP <XCOL, COMPILE)
  IP, [ LATEST CFA @ , ]  ] ;
: ;RES [COMPILE] ; SMUDGE ;
 IMMEDIATE
























( PL PTEST )
                ( JMR-89AUG25 )
 BIF DEFINITIONS DECIMAL
: PL 79 0 DO I 33 + EMIT LOOP ;

: PT    ( PL UNTIL KEY PRESS )
  BEGIN PL ?TERMINAL UNTIL ;

: PTEST >PRT PT >VID ;
 ;S
























( SLIST )
                ( JMR-16OCT90 )
 ROOT @ UTILITIES

: SLIST ( LIST SCREENS TO PRT )
 >PRT 1+ SWAP DO
  I ULIST 0<  IF LEAVE ENDIF
 LOOP >VID ;
 ROOT ! ;S
























( DISK ACCESS WORDS JMR-900228)

HEX
: CM! FF48 C! ; : ST@ FF48 C@ ;
: TR! FF49 C! ; : TR@ FF49 C@ ;
: SE! FF4A C! ; : SE@ FF4A C@ ;
: DA! FF4B C! ; : DA@ FF4B C@ ;
: DR FF40 ! ;
: DWAIT BEGIN ST@ DUP 1 AND
  WHILE DROP REPEAT ;
: 1I DR 40 CM! DWAIT 0 DR . ;
: 1O DR 60 CM! DWAIT 0 DR . ;
: IN 0 DO DUP 1I LOOP DROP ;
: OUT 0 DO DUP 1O LOOP DROP ;
: ?ADR 0 FF42 C! 0 FF46 C!
  28 OR DR ( MOTOR ON, DBL DNS)
  C4 FF4C C! DWAIT . FF44 @ DROP
  0 FF42 C! 0 FF46 C!
  FF4E ? FF4E ? FF4E ? ;  ;S
























( NAMES )
                ( JMR-89MAY16 )
 BIF DEFINITIONS HEX
: NAME ( CFA TO NAME )
  2+ NFA ID. ;



: NAMES ( DUMP BY NAME )
  -DUP IF 2* OVER + SWAP ( 0? )
    DO I 0 6 D.R ( ADR )
      I @ DUP 0 5 D.R ( NUMERIC)
      3A EMIT NAME CR
      ?TERMINAL 0< IF
        KEY 0< IF LEAVE ENDIF
    ENDIF 2 +LOOP ENDIF ; ;S
























( ^asm-util DREG REGISTERS #
 DPREG DPR SETDP  JMR-88DEC19 )
 ASSEMBLER DEFINITIONS HEX
VOCABULARY ^asm-util ( HIDDEN )
 ^asm-util DEFINITIONS
: DREG ( REGISTER OPERANDS )
  0FF0F AND 5245 DCONSTANT ;
 ASSEMBLER DEFINITIONS
 ^asm-util ( INDEX IN HI BYTE )
8B00 DREG D     8608 DREG A
8509 DREG B     8C05 DREG PC
4003 DREG U     6004 DREG S
2002 DREG Y     0001 DREG X
EF0A DREG CC    EF0B DREG DP
 ( ALL OPERANDS ARE DBL INTS )

( ABSOLUTE IS 0 OR -1 HI WORD )
( DIRECT IS ABSOLUTE IN DPAGE )
494D CONSTANT # ( HI WORD )

 ^asm-util DEFINITIONS
 ( ASSEMBLY TIME DIRECT PAGE )
42 USER DPREG ( EMULATOR )
 ( INIT DPREG ) UTILITIES DP@
 ASSEMBLER ^asm-util DPREG !

 ASSEMBLER DEFINITIONS
 ( ACCESS DPREG )
: DPR [ ^asm-util ] DPREG
  BIF @ ;
: SETDP 0FF00 AND [ ^asm-util ]
  DPREG BIF ! ; -->
























( OFF, ABS, V, PCOFF PCR, )
                 ( JMR-89JAN2 )
 ^asm-util DEFINITIONS
: OFF, ( SET IX b0, COMPILE 2 )
  OVER DUP 80 < SWAP -81 > AND
  IF C, C, ( SHORT )
  ELSE 1 OR C, , ( LONG )
  ENDIF ;

: OP, ( COMPILE BYTE OR WORD )
  DUP 0FF00 AND
  IF , ELSE C, ENDIF ;

: ABS, >R ( COMPILE ABS ADR OP )
  OVER 0FF00 AND DPR =
  IF R> DROP OP, C, ( DIR PAGE)
  ELSE R> OR OP, ,   ( EXT )
  ENDIF ;

: PCOFF  ( ABSOLUTE TO PC REL )
  HERE + 1+ - ( CALC OFFSET )
  DUP 7F > OVER -80 < OR
  IF 1- 0 ( WORD OFF )
  ELSE -1 ( BYTE OFF ) ENDIF ;

: ?ABS ( TRUE IF ABSOLUTE )
  DUP NOT 0= = ; ( USE T/F VAL)

: PCR, ( COMPILE A PC REL INDEX)
  >R ?ABS NOT 25 ?ERROR
  1 PCOFF IF R> C, C, ( BYTE )
  ELSE R> 1 OR C, , ENDIF ; -->
























( AUTO MASK, REG, IXOFF, EI, )
                 ( JMR-89JAN2 )
 ASSEMBLER DEFINITIONS
4155.0082 DCONSTANT -) ( AUTO )
4155.0081 DCONSTANT )++ ( REG )
4155.0080 DCONSTANT )+ ( MODE )
4155.0083 DCONSTANT --) ( CONS)
 ^asm-util DEFINITIONS

: MASK, OR C, ; ( FOR POSTBYTE)

: REG, ( REG OFF TO POST-BYTE )
  SWAP DUP D DROP =
    OVER A DROP = OR OVER
    B DROP = OR NOT 26 ?ERROR
  SWAB OR C, ;
 ( REG, USES DUAL CODED REGS )

: IXOFF, ( REGISTER + CONSTANT )
  OVER IF OVER ( NON-ZERO? )
    DUP 0F > SWAP -10 < OR
    OVER 10 AND OR ( []? )
    IF 88 OR OFF, ( EXTERNAL )
    ELSE ( OFFSET IN POST-BYTE)
      SWAP 1F AND OR C,
    ENDIF
  ELSE 84 OR C, DROP ( 0 OFF )
  ENDIF ;

: EI,  ( EXTENDED INDIRECT )
  SWAP ?ABS NOT 27 ?ERROR
  C, , ; -->
























( IX, , INDIRECT )
                 ( JMR-89JAN4 )
: IX, ( COMPILE AN INDEX MODE )
  DUP 9F = IF EI,
  ELSE DUP 8F AND 8C = IF PCR,
    ELSE SWAP DUP 4155 =
      IF DROP MASK, ( AUTO )
      ELSE DUP 5245 =
        IF DROP REG,
        ELSE ?ABS NOT 22 ?ERROR
          IXOFF, ENDIF
  ENDIF ENDIF ENDIF ;

 ASSEMBLER DEFINITIONS
: , ( CONVERT TO INDEX )
  5245 = ( REGISTER? )
  OVER 00FF AND DUP 0 > SWAP
  6 < AND ( X Y U S PC ? )
  AND NOT 28 ?ERROR
  SWAB 4958 ;

: ) ( CONVERT TO INDIRECT )
  DUP 5245 = ( REGISTER? )
  IF ( ASSEMBLER ) ,
  ELSE DUP [ ^asm-util ] ?ABS
    [ ASSEMBLER ] IF 4958.009F
    ELSE ( INDEX? )
      DUP 4958 = NOT 27 ?ERROR
  ENDIF ENDIF ( SET BIT 4 )
  SWAP 10 OR SWAP ;       -->
























( ACCM UNARY REG )
                 ( JMR-89JAN5 )
 ^asm-util DEFINITIONS HEX
: ACCM ( ENCODE ACCUMULATOR )
  SWAP DUP 0FE AND ( A OR B? )
  8 = NOT 29 ?ERROR
  1 AND ( MASK B IN? )
  IF OR ELSE DROP ENDIF ;

: UNARY ( OP-CODE COMPILER )
  <BUILDS 0F AND C, ( OP-CODE )
  DOES> C@ ( OP-CODE )
  OVER 5245 = ( REGISTER? )
  IF DUP 0E = 29 ?ERROR ( JMP?)
    40 OR ROT 10 ACCM C, DROP
  ELSE OVER 4958 = ( INDEX? )
    IF 60 OR C, DROP IX,
    ELSE SWAP ?ABS NOT 21 ?ERROR
      70 ( EXT BITS ) ABS,
  ENDIF ENDIF ;

: REG ( ENCODE TARGET REG )
  DUP C@ 8D = IF C@ 1 ( JSR )
  ELSE SWAP 5245 - 29 ?ERROR
    OVER DUP A DROP =
    SWAP B DROP = OR
    IF C@ SWAP 40 ACCM 0 ( BYTE)
    ELSE SWAP 00FF AND ( REG? )
      OVER 1+ C@ ( CT? ) OVER
      > NOT 29 ?ERROR ( RANGE )
      2* + 2+ @ -1 ( WORD REG )
  ENDIF ENDIF ; -->
























( #, BINARY REG-REG )
                ( JMR-89JAN12 )
: #, ( COMPILE AN IMMEDIATE )
  SWAP DUP 0F AND 5 - ( BIT OK)
  OVER 5 AND 5 = ( ST OR JSR? )
  AND 24 ?ERROR    OP,
  IF BIF , [ ^asm-util ] ( WORD)
  ELSE C, ENDIF ;      ( BYTE )

: BINARY ( OP-CODE COMPILER )
  <BUILDS 8F AND C, ( A/B OP )
  05 AND DUP C, -DUP IF ( OP CT)
    0 DO 11CF AND BIF , ( DXYUS)
      [ ^asm-util ] LOOP ENDIF
  DOES> REG ROT ( SOURCE )
  DUP 4958 = IF ( INDEX ? )
    DROP DROP 20 OR OP, IX,
  ELSE DUP 494D = ( IMMEDIATE? )
    IF DROP #,
    ELSE ?ABS NOT 21 ?ERROR
      DROP 10 OR 20 ABS,
  ENDIF ENDIF ;


: REG-REG ( OP-CODE COMPILER )
  <BUILDS C, ( OP-CODE ) DOES>
  C@ C, ( OP-CODE )
  5245 = ROT 5245 = AND
  NOT 23 ?ERROR ( 2 REGS? )
  0F AND SWAP SWAN 0F0 AND
  OR C, ; -->
























( REG-BITS PACK MOVEM )
                ( JMR-89JAN12 )
0 0B 1 1ARRAY REG-BITS ( PACK )
 0 REG-BITS ( INITIALIZE )
 06 OVER C! 1+ 10 OVER C! 1+
 20 OVER C! 1+ 40 OVER C! 1+
 40 OVER C! 1+ 80 OVER C! 1+
 -1 OVER ! 2+ ( UNDEFINED )
 02 OVER C! 1+ 04 OVER C! 1+
 01 OVER C! 1+ 08 SWAP C!
 ( STABILIZE PACK: UNDEF=ALL )

: PACK >R 0 ( PSH/PUL LIST )
  BEGIN OVER 5245 = WHILE
    SWAP DROP SWAP ( REG )
    DUP R = 2A ?ERROR ( SELF? )
    0FF AND REG-BITS C@ ( BIT )
    OVER OVER AND 2B ?ERROR
    OR REPEAT ( ^ IS DUPLICATE?)
  R> DROP ;

: MOVEM ( OP-CODE COMPILER )
  <BUILDS 0FD AND C, DOES> ( OP)
  C@ >R ( OP ) 5245 = OVER
  1+ 0FE AND 4 = AND ( S OR U?)
  NOT 2C ?ERROR
  R> OVER U DROP = ( SELECT S/U)
  IF 2 OR ENDIF C,
  PACK DUP 0= 2D ?ERROR
  C, ; -->
























( BR DCOND CC-IMM IMPLY )
                ( JMR-89JAN13 )
 ASSEMBLER DEFINITIONS
: BR ( COMPILE CONDITIONAL BR )
  434F - 2F ?ERROR ( CONDITION?)
  [ ^asm-util ] SWAP ( ADR? )
  ?ABS NOT 21 ?ERROR
  SWAP 1 PCOFF IF ( SHORT )
    SWAP DUP 0<
    IF 0FF AND ( BSR )
    ELSE 0F AND 20 OR ENDIF
    C, C, ( BOTH BYTES )
  ELSE SWAP DUP 01000 AND
    IF SWAB 017 AND ( BSR/BRA )
    ELSE 0F AND 1020 OR
      SWAP 1- SWAP ENDIF
    OP, BIF , ENDIF ; ASSEMBLER
 ^asm-util DEFINITIONS
: DCOND ( CONDITIONAL OPERANDS)
  434F DCONSTANT ;

: CC-IMM ( OP-CODE COMPILER )
  <BUILDS C, ( OP-CODE ) DOES>
  C@ C, ( OP-CODE )
  494D - 2E ?ERROR ( IMMEDIATE?)
  C, ;

: IMPLY    ( OP-CODE COMPILER )
  <BUILDS BIF , ( OP-CODE )
  DOES> @ OP, ; -->
























( MNEMONICS )
                ( JMR-89JAN13 )
 ASSEMBLER DEFINITIONS
 ^asm-util
 10CE 0CE 108E 8E 0CC 5 86
BINARY LD
 10CF 0CF 108F 8F 0CD 5 87
BINARY ST
 118C 1183 108C 8C 1083 5 81
BINARY CMP
35 MOVEM PUL    34 MOVEM PSH
46 UNARY ROR    49 UNARY ROL
39 IMPLY RTS    3B IMPLY RTI
0 82 BINARY SBC 978D DCOND SR
1F REG-REG TFR  4D UNARY TST
83 1 80 BINARY SUB
103F IMPLY SWI2 113F IMPLY SWI3
3F IMPLY SWI    13 IMPLY SYNC
0 84 BINARY AND 0 89 BINARY ADC
48 UNARY ASL    47 UNARY ASR
0C3 1 8B BINARY ADD
3A IMPLY ABX    5 DCOND CS
43 UNARY COM    4F UNARY CLR
1600 DCOND AL   0 85 BINARY BIT
4A UNARY DEC    19 IMPLY DAA
2 DCOND HI      0B DCOND MI
7 DCOND EQ      0C DCOND GE
1E REG-REG EXG  4C UNARY INC
0 8D BINARY JSR 4E UNARY JMP
0 88 BINARY EOR 0E DCOND GT
4 DCOND HS      12 IMPLY NOP
3 DCOND LS      0A DCOND PL -->
























( MORE MNEMONICS )
                ( JMR-89JAN13 )
44 UNARY LSR    48 UNARY LSL
0D DCOND LT     6 DCOND NE
3D IMPLY MUL    40 UNARY NEG
0 8A BINARY OR  1A CC-IMM ORCC
1 DCOND NV      1D IMPLY SEX
1C CC-IMM ANDCC 3C CC-IMM CWAI
8 DCOND VC      9 DCOND VS
4 DCOND CCLR ( LO LE FOLLOW )

 ^asm-util DEFINITIONS
1 4 1 1ARRAY EA-IX ( TRANSLATE)
 1 EA-IX ( INITIALIZE )
 0 OVER C! 1+    1 OVER C! 1+
 3 OVER C! 1+    2 SWAP C!

 ASSEMBLER DEFINITIONS
: LEA ( OP-CODE ASSEMBLER )
  5245 - 23 ?ERROR ( REGISTER?)
  0F BIF AND [ ^asm-util ]
  EA-IX C@  30 BIF OR C,
  4958 - 21 ?ERROR ( INDEX? )
  [ ^asm-util ] IX, ;

0F DCOND LE     5 DCOND LO -->
























( [CD]  & ! ^ NEXT )
                ( JMR-89JAN17 )
 ASSEMBLER DEFINITIONS BIF HEX
: [CD]   ( CFA OF DEF )
  -IFIND DROP DUP 0= 0 ?ERROR
  CFA 0 [COMPILE] DLITERAL ;
 IMMEDIATE

CREATE &  [CD] AND JMP SMUDGE
CREATE !  [CD]  OR JMP SMUDGE
CREATE ^  [CD] XOR JMP SMUDGE

 ASSEMBLER
: NEXT )++ Y ) JMP ; -->
























( INVERTCC LIF IF )
                 ( JMR-89FEB3 )
 ^asm-util DEFINITIONS  HEX

CREATE INVERTCC ( CONDITIONS )
  0. U , X LD 434F # X CMP
  HERE DUP 2+ 0 NE BR ( CC? )
  2. U , D LD ( BSR? )
  HERE DUP 2+ 0 MI BR
  A CLR 1 # B EOR ( TOGGLE CC )
  HERE 4 + 0 NE BR ( ALWAYS? )
  AL DROP SWAB # A LD
  2. U , D ST   NEXT ( FILL BR)
  1+ HERE OVER 1+ - SWAP C!
  1+ HERE OVER 1+ - SWAP C!
  2F # D LD D U PSH ( TO ERROR)
  [CD] ERROR JMP SMUDGE

 ASSEMBLER DEFINITIONS

: LIF ( MARK AND ASM LONG BR )
  [ ^asm-util ] INVERTCC
  [ ASSEMBLER ] >R >R
  HERE 4146 ( MARK )
  [ UTILITIES ] [CD] RES-ERROR
  [ ASSEMBLER ] R> R> BR ;

: IF ( MARK AND ASM SHORT BR )
  [ ^asm-util ] INVERTCC
  [ ASSEMBLER ] >R >R
  HERE 4146 ( MARK )
  OVER 2+ 0 R> R> BR ; -->
























( FILL-IN )
                 ( JMR-89FEB7 )
 ^asm-util DEFINITIONS

CREATE FILL-IN ( BR OFFSETS )
  UTILITIES DP@ 0 X LD DP DP@ @
   - ASSEMBLER 0 X , D LD
  0. U , D SUB  D U PSH ( OFFS)
  2. U , X LD  0. X , D LD ( BR)
  16 # A CMP ( ALWAYS? )
  HERE DUP 2+ 0 EQ BR
  0FE # A AND  0F0 # B AND
  1020 # D CMP ( LONG? )
  HERE DUP 2+ 0 EQ BR
  ( SHORT BRANCH )
  0F0 # A AND  20 # A CMP ( BR?)
  UTILITIES [CD] RES-ERROR
  ASSEMBLER NE BR
  0. U , D LD  7E # D ADD A TST
  UTILITIES [CD] RES-ERROR
  ASSEMBLER NE BR ( TOO FAR? )
  80 # B SUB
  1. X , B ST ( OFFSET )
  HERE 4. U , U LEA NEXT
  ROT 1+ HERE OVER 1+ - SWAP C!
  0. U , D LD ( LONG BR ALWAYS)
  3 # D SUB  1. X , D ST
  DUP 0 AL BR SWAP
  1+ HERE OVER 1+ - SWAP C!
  0. U , D LD ( LONG BR COND )
  4 # D SUB  2. X , D ST
  0 AL BR SMUDGE -->
























( ELSE LELSE ENDIF )
                 ( JMR-89FEB6 )
 ASSEMBLER DEFINITIONS HEX
 ^asm-util

: ELSE ( SHORT BRANCH, RESOLVE)
  4146 ?PAIRS
  >R NV IF R> FILL-IN ;

: LELSE ( LONG BRANCH, RESOLVE)
  4146 ?PAIRS
  >R NV LIF R> FILL-IN ;

: ENDIF 4146 ?PAIRS FILL-IN ;

: BEGIN HERE 4142 ;

: UNTIL ( COND BR TO BEGIN )
  >R >R 4142 ?PAIRS 0
  R> R> INVERTCC BR ;

: WHILE ( COND BR PAST REPEAT )
  ROT 4142 ?PAIRS
  IF DROP 4157 ;

: REPEAT ( LOOP, RESOLVE WHILE)
  4157 ?PAIRS SWAP 0 AL BR
  FILL-IN ;

: LWHILE ( LONG WHILE )
  ROT 4142 ?PAIRS
  LIF DROP 4157 ;  -->
























( :ASM ;ASM )
                ( JMR-89MAR28 )
 ASSEMBLER DEFINITIONS HEX

: :ASM CREATE !CSP ;

: ;ASM ?CSP SMUDGE ;

: I-CODE ( SHIFT TO HI-LEVEL )
  [ ' :ASM CFA @ ] LITERAL
  [ BIF ] , ( ASMBL JMP <XCOL )
  DROOT @ ROOT !  ] ; ( COMPILE)
 ASSEMBLER



: MACHINE ( SHIFT TO LO-LEVEL )
  COMPILE (MACHINE) ( IN DEF )
  [COMPILE] [ ( NOW INTERPRET )
  [COMPILE] ASSEMBLER ;
 IMMEDIATE  ;S

















































( D! D@ )
                ( JMR-89FEB16 )
 BIF DEFINITIONS ASSEMBLER

:ASM D! ( STORE DBL ) X U PUL
  D U PUL  0. X , D ST
  D U PUL  2. X , D ST
  NEXT ;ASM

:ASM D@ ( FETCH DBL ) X U PUL
  0. X , D LD    2. X , X LD
  D X U PSH   NEXT  ;ASM

:ASM DOVER ( DOUBLE OVER DOUBLE)
  4. U , D LD   6. U , X LD
  D X U PSH     NEXT  ;ASM

:ASM DSWAP ( SWAP DOUBLES )
  4. U , D LD    0. U , X LD
  4. U , X ST    0. U , D ST
  6. U , D LD    2. U , X LD
  6. U , X ST    2. U , D ST
  NEXT ;ASM
 ;S