1 0) Index to BIF HI-LEVEL disk
\r2) Title page, Copr. notice
\r3) MONITOR CALL TO DEBUG
\r4) ERROR MESSAGES
\r6) HIGH LEVEL TOOLS & UTILITIES
\r7) LIST, INDEX, TRIAD
\r8) HIGH LEVEL DISK & SCREEN
\r11) FORWARD REFERENCING
\r12) PERIPHERAL UTILITIES
\r13) SLIST
\r15) DUMP DEFINITION BY NAME
\r16) ASSEMBLER
\r32) DOUBLES IN ASSEMBLER
\r\r40) HLL COMPILER
\r64) PAIR ASSOCIATION EXAMPLE
\r66) A TRY AT DIVIDE BY CONSTANT
\r\r100) SARDIS DMC STUFF
\r\r144) HOOCH COMPILER REMAINS
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r BIF
\r EDITOR, UTILITIES,
\r ASSEMBLER, AND EXAMPLES
\r VERSION 1.0
\r\r\r COPYRIGHT 1989
\r JOEL MATTHEW REES
\r\r THESE ALGORITHMS ARE
\rEXPRESSED IN THREE LANGUAGES:
\rBIF, BIF ASSEMBLER FOR THE
\rMOTOROLA M6809 MICROPROCESSOR,
\rAND HEXADECIMAL MACHINE CODE FOR
\rTHE M6809.
\r\r THE TEXT IS ORGANIZED FOR
\rEDITING ON A 32-COLUMN TERMINAL,
\rSUCH AS IS FOUND ON A RADIO
\rSHACK COLOR COMPUTER 2.
\r\r THESE ALGORITHMS AND THEIR
\rTEXT ARE INTENDED FOR NO PURPOSE
\rOTHER THAN EXPERIMENTATION, AND
\rNO CLAIMS OR WARRANTIES ARE MADE
\rCONCERNING THEIR USEFULNESS IN
\rANY PARTICULAR APPLICATION.
\r\rPUBLISHED 1989
\r JOEL MATTHEW REES
\r SOUTH SALT LAKE CITY, UTAH
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( CALL TO MONITOR, IF SWI IS BRE
\rAKPOINT JMR-88OCT?? )
\r\rCREATE MON HEX 3F C, 6EB1 ,
\r SMUDGE HERE 1- FENCE ! ;S
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( ERROR MESSAGES )
\rDATA STACK UNDERFLOW
\rDICTIONARY FULL
\rADDRESS RESOLUTION ERROR
\rHIDES DEFINITION IN
\rNULL VECTOR WRITTEN
\rDISC RANGE?
\rDATA STACK OVERFLOW
\rDISC ERROR!
\rCAN'T EXECUTE A NULL!
\rCONTROL STACK UNDERFLOW
\rCONTROL STACK OVERFLOW
\rARRAY REFERENCE OUT OF BOUNDS
\rARRAY DIMENSION NOT VALID
\rNO PROCEDURE TO ENTER
\r ( WAS REGISTER )
\r\rCOMPILATION ONLY, USE IN DEF
\rEXECUTION ONLY
\rCONDITIONALS NOT PAIRED
\rDEFINITION INCOMPLETE
\rIN PROTECTED DICTIONARY
\rUSE ONLY WHEN LOADING
\rOFF CURRENT EDITING SCREEN
\rDECLARE VOCABULARY
\rDEFINITION NOT IN VOCABULARY
\rIN FORWARD BLOCK
\rALLOCATION LIST CORRUPTED: LOST
\rCAN'T REDEFINE nul!
\rNOT FORWARD REFERENCE
\r ( WAS IMMEDIATE )
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( MORE ERROR MESSAGES )
\rHAS INCORRECT ADDRESS MODE
\rHAS INCORRECT INDEX MODE
\rOPERAND NOT REGISTER
\rHAS ILLEGAL IMMEDIATE
\rPC OFFSET MUST BE ABSOLUTE
\rACCUMULATOR OFFSET REQUIRED
\rILLEGAL MEMORY INDIRECTION
\rILLEGAL INDEX BASE
\rILLEGAL TARGET SPECIFIED
\rCAN'T STACK ON SELF
\rDUPLICATE IN LIST
\rREGISTER NOT STACK
\rEMPTY REGISTER LIST
\rIMMEDIATE OPERAND REQUIRED
\rREQUIRES CONDITION
\r\rCOMPILE-TIME STACK UNDERFLOW
\rCOMPILE-TIME STACK OVERFLOW
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( UTILITIES DUMP QLIST QINDEX )
\r( L/SCR ULIST JMR-88NOV16)
\r BIF DEFINITIONS HEX
\r ( UTILITIES IS NOW IN KERNEL )
\r UTILITIES DEFINITIONS
\r: BYTE-DUMP -DUP IF
\r 0 DO DUP I + C@ 4 .R LOOP
\r ENDIF DROP ; ( BASE > 6)
\r BIF DEFINITIONS
\r: DUMP -DUP IF OVER + SWAP
\r DO I 0 6 D.R I 4
\r [ UTILITIES ] BYTE-DUMP
\r [ BIF ] 3A EMIT I 4 TYPE
\r CR ?TERMINAL 0< IF
\r KEY 0< IF LEAVE ENDIF
\r ENDIF 4 +LOOP ENDIF ;
\r: QLIST BLOCK [ EDITOR ] QDUMP
\r [ BIF ] 500 88 ! ( CENTER ) ;
\r: QINDEX 1+ SWAP DO I QLIST
\r ." SCREEN=" I 4 /MOD .
\r 3A EMIT . ." BLOCK=" I .
\r KEY 0< IF LEAVE ENDIF
\r LOOP ;
\r UTILITIES DEFINITIONS
\r: L/SCR B/BUF B/SCR C/L */ ;
\r: ULIST ( SCREEN N, FLAG BRK )
\r DUP SCR ! ." SCR # " . 0 ( F )
\r L/SCR 0 DO CR I 3 .R SPACE
\r I SCR @ .LINE
\r ?TERMINAL 0< IF ( BREAK? )
\r KEY 0< IF 1- LEAVE ENDIF
\r ENDIF LOOP CR ; -->
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( LIST INDEX TRIAD )
\r ( JMR-88NOV16 )
\r BIF DEFINITIONS
\r: LIST ( WIDE OUTPUT ) DECIMAL
\r CR UTILITIES ULIST BIF DROP ;
\r\r: INDEX ( PRINT COMMENT LINES )
\r 0C EMIT ( FORM FEED ) CR
\r 1+ SWAP DO
\r CR I 3 .R SPACE
\r 0 I .LINE
\r C/L 49 < IF 1 I .LINE ENDIF
\r ?TERMINAL 0< IF
\r KEY 0< IF LEAVE ENDIF
\r ENDIF
\r LOOP ;
\r\r: TRIAD ( LIST MULTIPLE ) >PRT
\r 0C EMIT ( FORM FEED )
\r [ DECIMAL ] UTILITIES L/SCR
\r BIF 22 > IF 2 ELSE 3 ENDIF
\r >R R / R * DUP R> + SWAP
\r DO I UTILITIES ULIST BIF
\r 0< IF LEAVE ENDIF
\r UTILITIES L/SCR BIF DUP
\r 32 = SWAP 22 = OR NOT IF
\r CR CR ENDIF
\r LOOP >VID ; HEX
\r\r\r\r -->
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( HOME CLS QSAVE SAVE-BUFFERS
\r QCAN ) ( JMR-88DEC10 )
\r UTILITIES DEFINITIONS HEX
\r: HOME 400 88 ! ;
\r: MID 500 88 ! ;
\r BIF DEFINITIONS
\r: CLS 400 200 60 FILL
\r UTILITIES HOME BIF ;
\r UTILITIES DEFINITIONS
\r: CAN-UP ( CANCEL UPDATE IN BUF)
\r DUP @ 7FFF AND OVER ! ;
\r\r: W-BUF ( WRITE BUF AT ADR )
\r DUP 2+ OVER @ 7FFF AND 0 R/W
\r CAN-UP ;
\r\r: SAVE-BUF ( IF UPDATED )
\r DUP @ 0< IF W-BUF ENDIF ;
\r\r BIF DEFINITIONS
\r: QSAVE PREV @ ( SAVE PREVIOUS )
\r UTILITIES SAVE-BUF BIF DROP ;
\r\r\r: SAVE-BUFFERS PREV @
\r BEGIN UTILITIES SAVE-BUF BIF
\r +BUF NOT UNTIL DROP ;
\r\r: QCAN PREV @ ( CAN UP OF PREV )
\r UTILITIES CAN-UP BIF DROP ;
\r-->
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( CANCEL-UPDATES RE-QUICK .PREV
\r .BUFFERS QPREV JMR-88DEC10 )
\r: CANCEL-UPDATES PREV @
\r BEGIN UTILITIES CAN-UP BIF
\r +BUF NOT UNTIL DROP ;
\r\r: RE-QUICK ( QUICK OLD PREVIOUS)
\r PREV @ DUP @ 7FFF AND 0 ROT !
\r [ EDITOR ] QUICK BIF ;
\r\rUTILITIES DEFINITIONS
\r: .BUF ( QLIST BUFFER, . BLOCK )
\r DUP @ DUP 7FFF AND DUP QLIST
\r MID ." BLOCK=" .
\r 0< IF ." UPDATED" ENDIF CR ;
\r\r BIF DEFINITIONS
\r: .BUFFERS PREV @ ( .BUF, PAUSE)
\r BEGIN UTILITIES .BUF BIF
\r +BUF DROP KEY 0< ( BREAK? )
\r UNTIL DROP ;
\r\r: .PREV PREV @ UTILITIES .BUF
\r BIF DROP ;
\r\r: EDIT DUP UTILITIES MID BIF
\r ." BLOCK=" . CR [ EDITOR ]
\r QUICK BIF PREV @ @
\r 0< IF ." UPDATED" ENDIF ;
\r\r: QPREV PREV @ @ 7FFF AND
\r EDIT ; -->
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( QOPY COPY QBACK BACK-UP )
\r ( JMR-88DEC11 )
\r: QOPY SWAP BLOCK SWAP BLOCK
\r B/BUF 2/ MOVE UPDATE ;
\r\r: COPY 2* 2* ( SCREEN )
\r SWAP 2* 2* DUP 4 + SWAP
\r DO I OVER QOPY 1+ LOOP DROP ;
\r: QBACK 1+ SWAP DO I QLIST
\r I BLOCK DUP [ EDITOR ] QDUMP
\r ." BLOCK " I . ." TO "
\r 0 DRIVE-OFFSET @ I + DUP .
\r KEY 59 = IF 0 R/W ( YES? )
\r ELSE DROP DROP
\r ENDIF LOOP ;
\r\r: EEDIT ( ERASE AND EDIT BLOCK )
\r DUP BLOCK 2- UTILITIES .BUF 2+
\r MID BIF ." BLOCK=" OVER .
\r ." CLEAR?" CR
\r KEY 59 = IF ( YES? )
\r B/BUF BLANKS UPDATE
\r ELSE DROP ( DON'T CLEAR )
\r ENDIF EDIT ; -->
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( RES-ERROR FORWARD :RESOLVE
\r :RESOLVE ;RES JMR-16MAY89 )
\r UTILITIES DEFINITIONS HEX
\r: RES-ERROR ( ADR RESOLUTION )
\r 3 ERROR ;
\r\r BIF DEFINITIONS UTILITIES
\r: FORWARD ( REFERENCE HEADER )
\r CREATE 7E C, ( JMP EXTENDED )
\r IP, [ ' RES-ERROR CFA , ]
\r ( INIT TO RES-ERROR ) SMUDGE
\r FOREWARD @ 0= IF ( EARLIEST? )
\r LATEST FOREWARD ! ENDIF ;
\r ASSEMBLER DEFINITIONS
\r UTILITIES
\r: :RESOLVE ( :ASM FORWARD REFS )
\r ?EXEC !CSP [COMPILE] ' DUP
\r CFA DUP 1+ SWAP C@ 7E - ( JMP)
\r OVER @ ' RES-ERROR CFA -
\r OR 1D ?ERROR ( HEADER? )
\r HERE SWAP ! ( LINK IT )
\r FOREWARD @ = IF ( END FORWD? )
\r 0 FOREWARD ! ENDIF ;
\r IMMEDIATE
\r\r BIF DEFINITIONS ASSEMBLER
\r: :RES ( RESOLVE : FORWARDS )
\r [COMPILE] :RESOLVE [ BIF ]
\r ( ASSEMBLE JMP <XCOL, COMPILE)
\r IP, [ LATEST CFA @ , ] ] ;
\r: ;RES [COMPILE] ; SMUDGE ;
\r IMMEDIATE
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( PL PTEST )
\r ( JMR-89AUG25 )
\r BIF DEFINITIONS DECIMAL
\r: PL 79 0 DO I 33 + EMIT LOOP ;
\r\r: PT ( PL UNTIL KEY PRESS )
\r BEGIN PL ?TERMINAL UNTIL ;
\r\r: PTEST >PRT PT >VID ;
\r ;S
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( SLIST )
\r ( JMR-16OCT90 )
\r ROOT @ UTILITIES
\r\r: SLIST ( LIST SCREENS TO PRT )
\r >PRT 1+ SWAP DO
\r I ULIST 0< IF LEAVE ENDIF
\r LOOP >VID ;
\r ROOT ! ;S
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( DISK ACCESS WORDS JMR-900228)
\r\rHEX
\r: CM! FF48 C! ; : ST@ FF48 C@ ;
\r: TR! FF49 C! ; : TR@ FF49 C@ ;
\r: SE! FF4A C! ; : SE@ FF4A C@ ;
\r: DA! FF4B C! ; : DA@ FF4B C@ ;
\r: DR FF40 ! ;
\r: DWAIT BEGIN ST@ DUP 1 AND
\r WHILE DROP REPEAT ;
\r: 1I DR 40 CM! DWAIT 0 DR . ;
\r: 1O DR 60 CM! DWAIT 0 DR . ;
\r: IN 0 DO DUP 1I LOOP DROP ;
\r: OUT 0 DO DUP 1O LOOP DROP ;
\r: ?ADR 0 FF42 C! 0 FF46 C!
\r 28 OR DR ( MOTOR ON, DBL DNS)
\r C4 FF4C C! DWAIT . FF44 @ DROP
\r 0 FF42 C! 0 FF46 C!
\r FF4E ? FF4E ? FF4E ? ; ;S
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( NAMES )
\r ( JMR-89MAY16 )
\r BIF DEFINITIONS HEX
\r: NAME ( CFA TO NAME )
\r 2+ NFA ID. ;
\r\r\r\r: NAMES ( DUMP BY NAME )
\r -DUP IF 2* OVER + SWAP ( 0? )
\r DO I 0 6 D.R ( ADR )
\r I @ DUP 0 5 D.R ( NUMERIC)
\r 3A EMIT NAME CR
\r ?TERMINAL 0< IF
\r KEY 0< IF LEAVE ENDIF
\r ENDIF 2 +LOOP ENDIF ; ;S
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( ^asm-util DREG REGISTERS #
\r DPREG DPR SETDP JMR-88DEC19 )
\r ASSEMBLER DEFINITIONS HEX
\rVOCABULARY ^asm-util ( HIDDEN )
\r ^asm-util DEFINITIONS
\r: DREG ( REGISTER OPERANDS )
\r 0FF0F AND 5245 DCONSTANT ;
\r ASSEMBLER DEFINITIONS
\r ^asm-util ( INDEX IN HI BYTE )
\r8B00 DREG D 8608 DREG A
\r8509 DREG B 8C05 DREG PC
\r4003 DREG U 6004 DREG S
\r2002 DREG Y 0001 DREG X
\rEF0A DREG CC EF0B DREG DP
\r ( ALL OPERANDS ARE DBL INTS )
\r\r( ABSOLUTE IS 0 OR -1 HI WORD )
\r( DIRECT IS ABSOLUTE IN DPAGE )
\r494D CONSTANT # ( HI WORD )
\r\r ^asm-util DEFINITIONS
\r ( ASSEMBLY TIME DIRECT PAGE )
\r42 USER DPREG ( EMULATOR )
\r ( INIT DPREG ) UTILITIES DP@
\r ASSEMBLER ^asm-util DPREG !
\r\r ASSEMBLER DEFINITIONS
\r ( ACCESS DPREG )
\r: DPR [ ^asm-util ] DPREG
\r BIF @ ;
\r: SETDP 0FF00 AND [ ^asm-util ]
\r DPREG BIF ! ; -->
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( OFF, ABS, V, PCOFF PCR, )
\r ( JMR-89JAN2 )
\r ^asm-util DEFINITIONS
\r: OFF, ( SET IX b0, COMPILE 2 )
\r OVER DUP 80 < SWAP -81 > AND
\r IF C, C, ( SHORT )
\r ELSE 1 OR C, , ( LONG )
\r ENDIF ;
\r\r: OP, ( COMPILE BYTE OR WORD )
\r DUP 0FF00 AND
\r IF , ELSE C, ENDIF ;
\r\r: ABS, >R ( COMPILE ABS ADR OP )
\r OVER 0FF00 AND DPR =
\r IF R> DROP OP, C, ( DIR PAGE)
\r ELSE R> OR OP, , ( EXT )
\r ENDIF ;
\r\r: PCOFF ( ABSOLUTE TO PC REL )
\r HERE + 1+ - ( CALC OFFSET )
\r DUP 7F > OVER -80 < OR
\r IF 1- 0 ( WORD OFF )
\r ELSE -1 ( BYTE OFF ) ENDIF ;
\r\r: ?ABS ( TRUE IF ABSOLUTE )
\r DUP NOT 0= = ; ( USE T/F VAL)
\r\r: PCR, ( COMPILE A PC REL INDEX)
\r >R ?ABS NOT 25 ?ERROR
\r 1 PCOFF IF R> C, C, ( BYTE )
\r ELSE R> 1 OR C, , ENDIF ; -->
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( AUTO MASK, REG, IXOFF, EI, )
\r ( JMR-89JAN2 )
\r ASSEMBLER DEFINITIONS
\r4155.0082 DCONSTANT -) ( AUTO )
\r4155.0081 DCONSTANT )++ ( REG )
\r4155.0080 DCONSTANT )+ ( MODE )
\r4155.0083 DCONSTANT --) ( CONS)
\r ^asm-util DEFINITIONS
\r\r: MASK, OR C, ; ( FOR POSTBYTE)
\r\r: REG, ( REG OFF TO POST-BYTE )
\r SWAP DUP D DROP =
\r OVER A DROP = OR OVER
\r B DROP = OR NOT 26 ?ERROR
\r SWAB OR C, ;
\r ( REG, USES DUAL CODED REGS )
\r\r: IXOFF, ( REGISTER + CONSTANT )
\r OVER IF OVER ( NON-ZERO? )
\r DUP 0F > SWAP -10 < OR
\r OVER 10 AND OR ( []? )
\r IF 88 OR OFF, ( EXTERNAL )
\r ELSE ( OFFSET IN POST-BYTE)
\r SWAP 1F AND OR C,
\r ENDIF
\r ELSE 84 OR C, DROP ( 0 OFF )
\r ENDIF ;
\r\r: EI, ( EXTENDED INDIRECT )
\r SWAP ?ABS NOT 27 ?ERROR
\r C, , ; -->
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( IX, , INDIRECT )
\r ( JMR-89JAN4 )
\r: IX, ( COMPILE AN INDEX MODE )
\r DUP 9F = IF EI,
\r ELSE DUP 8F AND 8C = IF PCR,
\r ELSE SWAP DUP 4155 =
\r IF DROP MASK, ( AUTO )
\r ELSE DUP 5245 =
\r IF DROP REG,
\r ELSE ?ABS NOT 22 ?ERROR
\r IXOFF, ENDIF
\r ENDIF ENDIF ENDIF ;
\r\r ASSEMBLER DEFINITIONS
\r: , ( CONVERT TO INDEX )
\r 5245 = ( REGISTER? )
\r OVER 00FF AND DUP 0 > SWAP
\r 6 < AND ( X Y U S PC ? )
\r AND NOT 28 ?ERROR
\r SWAB 4958 ;
\r\r: ) ( CONVERT TO INDIRECT )
\r DUP 5245 = ( REGISTER? )
\r IF ( ASSEMBLER ) ,
\r ELSE DUP [ ^asm-util ] ?ABS
\r [ ASSEMBLER ] IF 4958.009F
\r ELSE ( INDEX? )
\r DUP 4958 = NOT 27 ?ERROR
\r ENDIF ENDIF ( SET BIT 4 )
\r SWAP 10 OR SWAP ; -->
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( ACCM UNARY REG )
\r ( JMR-89JAN5 )
\r ^asm-util DEFINITIONS HEX
\r: ACCM ( ENCODE ACCUMULATOR )
\r SWAP DUP 0FE AND ( A OR B? )
\r 8 = NOT 29 ?ERROR
\r 1 AND ( MASK B IN? )
\r IF OR ELSE DROP ENDIF ;
\r\r: UNARY ( OP-CODE COMPILER )
\r <BUILDS 0F AND C, ( OP-CODE )
\r DOES> C@ ( OP-CODE )
\r OVER 5245 = ( REGISTER? )
\r IF DUP 0E = 29 ?ERROR ( JMP?)
\r 40 OR ROT 10 ACCM C, DROP
\r ELSE OVER 4958 = ( INDEX? )
\r IF 60 OR C, DROP IX,
\r ELSE SWAP ?ABS NOT 21 ?ERROR
\r 70 ( EXT BITS ) ABS,
\r ENDIF ENDIF ;
\r\r: REG ( ENCODE TARGET REG )
\r DUP C@ 8D = IF C@ 1 ( JSR )
\r ELSE SWAP 5245 - 29 ?ERROR
\r OVER DUP A DROP =
\r SWAP B DROP = OR
\r IF C@ SWAP 40 ACCM 0 ( BYTE)
\r ELSE SWAP 00FF AND ( REG? )
\r OVER 1+ C@ ( CT? ) OVER
\r > NOT 29 ?ERROR ( RANGE )
\r 2* + 2+ @ -1 ( WORD REG )
\r ENDIF ENDIF ; -->
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( #, BINARY REG-REG )
\r ( JMR-89JAN12 )
\r: #, ( COMPILE AN IMMEDIATE )
\r SWAP DUP 0F AND 5 - ( BIT OK)
\r OVER 5 AND 5 = ( ST OR JSR? )
\r AND 24 ?ERROR OP,
\r IF BIF , [ ^asm-util ] ( WORD)
\r ELSE C, ENDIF ; ( BYTE )
\r\r: BINARY ( OP-CODE COMPILER )
\r <BUILDS 8F AND C, ( A/B OP )
\r 05 AND DUP C, -DUP IF ( OP CT)
\r 0 DO 11CF AND BIF , ( DXYUS)
\r [ ^asm-util ] LOOP ENDIF
\r DOES> REG ROT ( SOURCE )
\r DUP 4958 = IF ( INDEX ? )
\r DROP DROP 20 OR OP, IX,
\r ELSE DUP 494D = ( IMMEDIATE? )
\r IF DROP #,
\r ELSE ?ABS NOT 21 ?ERROR
\r DROP 10 OR 20 ABS,
\r ENDIF ENDIF ;
\r\r\r: REG-REG ( OP-CODE COMPILER )
\r <BUILDS C, ( OP-CODE ) DOES>
\r C@ C, ( OP-CODE )
\r 5245 = ROT 5245 = AND
\r NOT 23 ?ERROR ( 2 REGS? )
\r 0F AND SWAP SWAN 0F0 AND
\r OR C, ; -->
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( REG-BITS PACK MOVEM )
\r ( JMR-89JAN12 )
\r0 0B 1 1ARRAY REG-BITS ( PACK )
\r 0 REG-BITS ( INITIALIZE )
\r 06 OVER C! 1+ 10 OVER C! 1+
\r 20 OVER C! 1+ 40 OVER C! 1+
\r 40 OVER C! 1+ 80 OVER C! 1+
\r -1 OVER ! 2+ ( UNDEFINED )
\r 02 OVER C! 1+ 04 OVER C! 1+
\r 01 OVER C! 1+ 08 SWAP C!
\r ( STABILIZE PACK: UNDEF=ALL )
\r\r: PACK >R 0 ( PSH/PUL LIST )
\r BEGIN OVER 5245 = WHILE
\r SWAP DROP SWAP ( REG )
\r DUP R = 2A ?ERROR ( SELF? )
\r 0FF AND REG-BITS C@ ( BIT )
\r OVER OVER AND 2B ?ERROR
\r OR REPEAT ( ^ IS DUPLICATE?)
\r R> DROP ;
\r\r: MOVEM ( OP-CODE COMPILER )
\r <BUILDS 0FD AND C, DOES> ( OP)
\r C@ >R ( OP ) 5245 = OVER
\r 1+ 0FE AND 4 = AND ( S OR U?)
\r NOT 2C ?ERROR
\r R> OVER U DROP = ( SELECT S/U)
\r IF 2 OR ENDIF C,
\r PACK DUP 0= 2D ?ERROR
\r C, ; -->
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( BR DCOND CC-IMM IMPLY )
\r ( JMR-89JAN13 )
\r ASSEMBLER DEFINITIONS
\r: BR ( COMPILE CONDITIONAL BR )
\r 434F - 2F ?ERROR ( CONDITION?)
\r [ ^asm-util ] SWAP ( ADR? )
\r ?ABS NOT 21 ?ERROR
\r SWAP 1 PCOFF IF ( SHORT )
\r SWAP DUP 0<
\r IF 0FF AND ( BSR )
\r ELSE 0F AND 20 OR ENDIF
\r C, C, ( BOTH BYTES )
\r ELSE SWAP DUP 01000 AND
\r IF SWAB 017 AND ( BSR/BRA )
\r ELSE 0F AND 1020 OR
\r SWAP 1- SWAP ENDIF
\r OP, BIF , ENDIF ; ASSEMBLER
\r ^asm-util DEFINITIONS
\r: DCOND ( CONDITIONAL OPERANDS)
\r 434F DCONSTANT ;
\r\r: CC-IMM ( OP-CODE COMPILER )
\r <BUILDS C, ( OP-CODE ) DOES>
\r C@ C, ( OP-CODE )
\r 494D - 2E ?ERROR ( IMMEDIATE?)
\r C, ;
\r\r: IMPLY ( OP-CODE COMPILER )
\r <BUILDS BIF , ( OP-CODE )
\r DOES> @ OP, ; -->
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( MNEMONICS )
\r ( JMR-89JAN13 )
\r ASSEMBLER DEFINITIONS
\r ^asm-util
\r 10CE 0CE 108E 8E 0CC 5 86
\rBINARY LD
\r 10CF 0CF 108F 8F 0CD 5 87
\rBINARY ST
\r 118C 1183 108C 8C 1083 5 81
\rBINARY CMP
\r35 MOVEM PUL 34 MOVEM PSH
\r46 UNARY ROR 49 UNARY ROL
\r39 IMPLY RTS 3B IMPLY RTI
\r0 82 BINARY SBC 978D DCOND SR
\r1F REG-REG TFR 4D UNARY TST
\r83 1 80 BINARY SUB
\r103F IMPLY SWI2 113F IMPLY SWI3
\r3F IMPLY SWI 13 IMPLY SYNC
\r0 84 BINARY AND 0 89 BINARY ADC
\r48 UNARY ASL 47 UNARY ASR
\r0C3 1 8B BINARY ADD
\r3A IMPLY ABX 5 DCOND CS
\r43 UNARY COM 4F UNARY CLR
\r1600 DCOND AL 0 85 BINARY BIT
\r4A UNARY DEC 19 IMPLY DAA
\r2 DCOND HI 0B DCOND MI
\r7 DCOND EQ 0C DCOND GE
\r1E REG-REG EXG 4C UNARY INC
\r0 8D BINARY JSR 4E UNARY JMP
\r0 88 BINARY EOR 0E DCOND GT
\r4 DCOND HS 12 IMPLY NOP
\r3 DCOND LS 0A DCOND PL -->
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( MORE MNEMONICS )
\r ( JMR-89JAN13 )
\r44 UNARY LSR 48 UNARY LSL
\r0D DCOND LT 6 DCOND NE
\r3D IMPLY MUL 40 UNARY NEG
\r0 8A BINARY OR 1A CC-IMM ORCC
\r1 DCOND NV 1D IMPLY SEX
\r1C CC-IMM ANDCC 3C CC-IMM CWAI
\r8 DCOND VC 9 DCOND VS
\r4 DCOND CCLR ( LO LE FOLLOW )
\r\r ^asm-util DEFINITIONS
\r1 4 1 1ARRAY EA-IX ( TRANSLATE)
\r 1 EA-IX ( INITIALIZE )
\r 0 OVER C! 1+ 1 OVER C! 1+
\r 3 OVER C! 1+ 2 SWAP C!
\r\r ASSEMBLER DEFINITIONS
\r: LEA ( OP-CODE ASSEMBLER )
\r 5245 - 23 ?ERROR ( REGISTER?)
\r 0F BIF AND [ ^asm-util ]
\r EA-IX C@ 30 BIF OR C,
\r 4958 - 21 ?ERROR ( INDEX? )
\r [ ^asm-util ] IX, ;
\r\r0F DCOND LE 5 DCOND LO -->
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( [CD] & ! ^ NEXT )
\r ( JMR-89JAN17 )
\r ASSEMBLER DEFINITIONS BIF HEX
\r: [CD] ( CFA OF DEF )
\r -IFIND DROP DUP 0= 0 ?ERROR
\r CFA 0 [COMPILE] DLITERAL ;
\r IMMEDIATE
\r\rCREATE & [CD] AND JMP SMUDGE
\rCREATE ! [CD] OR JMP SMUDGE
\rCREATE ^ [CD] XOR JMP SMUDGE
\r\r ASSEMBLER
\r: NEXT )++ Y ) JMP ; -->
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( INVERTCC LIF IF )
\r ( JMR-89FEB3 )
\r ^asm-util DEFINITIONS HEX
\r\rCREATE INVERTCC ( CONDITIONS )
\r 0. U , X LD 434F # X CMP
\r HERE DUP 2+ 0 NE BR ( CC? )
\r 2. U , D LD ( BSR? )
\r HERE DUP 2+ 0 MI BR
\r A CLR 1 # B EOR ( TOGGLE CC )
\r HERE 4 + 0 NE BR ( ALWAYS? )
\r AL DROP SWAB # A LD
\r 2. U , D ST NEXT ( FILL BR)
\r 1+ HERE OVER 1+ - SWAP C!
\r 1+ HERE OVER 1+ - SWAP C!
\r 2F # D LD D U PSH ( TO ERROR)
\r [CD] ERROR JMP SMUDGE
\r\r ASSEMBLER DEFINITIONS
\r\r: LIF ( MARK AND ASM LONG BR )
\r [ ^asm-util ] INVERTCC
\r [ ASSEMBLER ] >R >R
\r HERE 4146 ( MARK )
\r [ UTILITIES ] [CD] RES-ERROR
\r [ ASSEMBLER ] R> R> BR ;
\r\r: IF ( MARK AND ASM SHORT BR )
\r [ ^asm-util ] INVERTCC
\r [ ASSEMBLER ] >R >R
\r HERE 4146 ( MARK )
\r OVER 2+ 0 R> R> BR ; -->
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( FILL-IN )
\r ( JMR-89FEB7 )
\r ^asm-util DEFINITIONS
\r\rCREATE FILL-IN ( BR OFFSETS )
\r UTILITIES DP@ 0 X LD DP DP@ @
\r - ASSEMBLER 0 X , D LD
\r 0. U , D SUB D U PSH ( OFFS)
\r 2. U , X LD 0. X , D LD ( BR)
\r 16 # A CMP ( ALWAYS? )
\r HERE DUP 2+ 0 EQ BR
\r 0FE # A AND 0F0 # B AND
\r 1020 # D CMP ( LONG? )
\r HERE DUP 2+ 0 EQ BR
\r ( SHORT BRANCH )
\r 0F0 # A AND 20 # A CMP ( BR?)
\r UTILITIES [CD] RES-ERROR
\r ASSEMBLER NE BR
\r 0. U , D LD 7E # D ADD A TST
\r UTILITIES [CD] RES-ERROR
\r ASSEMBLER NE BR ( TOO FAR? )
\r 80 # B SUB
\r 1. X , B ST ( OFFSET )
\r HERE 4. U , U LEA NEXT
\r ROT 1+ HERE OVER 1+ - SWAP C!
\r 0. U , D LD ( LONG BR ALWAYS)
\r 3 # D SUB 1. X , D ST
\r DUP 0 AL BR SWAP
\r 1+ HERE OVER 1+ - SWAP C!
\r 0. U , D LD ( LONG BR COND )
\r 4 # D SUB 2. X , D ST
\r 0 AL BR SMUDGE -->
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( ELSE LELSE ENDIF )
\r ( JMR-89FEB6 )
\r ASSEMBLER DEFINITIONS HEX
\r ^asm-util
\r\r: ELSE ( SHORT BRANCH, RESOLVE)
\r 4146 ?PAIRS
\r >R NV IF R> FILL-IN ;
\r\r: LELSE ( LONG BRANCH, RESOLVE)
\r 4146 ?PAIRS
\r >R NV LIF R> FILL-IN ;
\r\r: ENDIF 4146 ?PAIRS FILL-IN ;
\r\r: BEGIN HERE 4142 ;
\r\r: UNTIL ( COND BR TO BEGIN )
\r >R >R 4142 ?PAIRS 0
\r R> R> INVERTCC BR ;
\r\r: WHILE ( COND BR PAST REPEAT )
\r ROT 4142 ?PAIRS
\r IF DROP 4157 ;
\r\r: REPEAT ( LOOP, RESOLVE WHILE)
\r 4157 ?PAIRS SWAP 0 AL BR
\r FILL-IN ;
\r\r: LWHILE ( LONG WHILE )
\r ROT 4142 ?PAIRS
\r LIF DROP 4157 ; -->
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( :ASM ;ASM )
\r ( JMR-89MAR28 )
\r ASSEMBLER DEFINITIONS HEX
\r\r: :ASM CREATE !CSP ;
\r\r: ;ASM ?CSP SMUDGE ;
\r\r: I-CODE ( SHIFT TO HI-LEVEL )
\r [ ' :ASM CFA @ ] LITERAL
\r [ BIF ] , ( ASMBL JMP <XCOL )
\r DROOT @ ROOT ! ] ; ( COMPILE)
\r ASSEMBLER
\r\r\r\r: MACHINE ( SHIFT TO LO-LEVEL )
\r COMPILE (MACHINE) ( IN DEF )
\r [COMPILE] [ ( NOW INTERPRET )
\r [COMPILE] ASSEMBLER ;
\r IMMEDIATE ;S
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( D! D@ )
\r ( JMR-89FEB16 )
\r BIF DEFINITIONS ASSEMBLER
\r\r:ASM D! ( STORE DBL ) X U PUL
\r D U PUL 0. X , D ST
\r D U PUL 2. X , D ST
\r NEXT ;ASM
\r\r:ASM D@ ( FETCH DBL ) X U PUL
\r 0. X , D LD 2. X , X LD
\r D X U PSH NEXT ;ASM
\r\r:ASM DOVER ( DOUBLE OVER DOUBLE)
\r 4. U , D LD 6. U , X LD
\r D X U PSH NEXT ;ASM
\r\r:ASM DSWAP ( SWAP DOUBLES )
\r 4. U , D LD 0. U , X LD
\r 4. U , X ST 0. U , D ST
\r 6. U , D LD 2. U , X LD
\r 6. U , X ST 2. U , D ST
\r NEXT ;ASM
\r ;S
\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r
OSDN Git Service
