Power-Programmierung

home *** CD-ROM | disk | FTP | other *** search

/ Power-Programmierung / CD1.mdf / forth / compiler / love / rpn_asm.txt < prev next >

Wrap

Text File | 1993-04-11 | 16.2 KB | 452 lines

(( L.O.V.E. FORTH - RPN Assembler - completed with all op-codes by Homer Seywerd changes/additions also placed in the public domain - support for CODE and ;CODE - virtual vocabulary *** An example provided to illustrate the programming of a traditional RPN assembler in Forth. Serious assembly language programmers should use the LOVE Forth standard assembler interface instead. The standard assembler interface allows the use of Borland's , Microsoft's or Isaacson's assemblers to produce object code for LOVE Forth. *** )) ( ASSEMBLER SOURCE ) : 8* 8 * ; ( N -- N) : 6+ 6 + ; ( N -- N) : OFF ( addr-- ) 0 SWAP ! ; : ON ( addr-- ) 1 SWAP ! ; : 3C, C, C, C, ; VARIABLE <#> VARIABLE <TD> VARIABLE <TS> VARIABLE <RD> VARIABLE <RS> VARIABLE <W> VARIABLE <WD> VARIABLE <OD> VARIABLE <OS> VARIABLE <D> VARIABLE INTER VARIABLE <SP> : A, CS:C, ; : !<SP> SP@ <SP> ! ; : ?<SP> <SP> @ SP@ - 2- 2/ ; : ?ERR1 ABORT" ADDRESS OUT OF RANGE" ; : ?ERR2 ABORT" IMMEDIATE DATA VALUE NOT ALLOWED" ; : ?ERR3 ABORT" ILLEGAL OPERAND" ; : ?ERR4 ABORT" DESTINATION ADDRESS MISSING" ; : ERR5 1 ABORT" REGISTER MISMATCH" ; : ERR3 1 ?ERR3 ; 0 CONSTANT DIRECT 1 CONSTANT IMMED 2 CONSTANT REG8 3 CONSTANT REG16 4 CONSTANT INDEXED 5 CONSTANT SEGREG HEX : DREG CREATE 3C, DOES> DUP C@ DUP FF = IF DROP ELSE DUP <W> ! <WD> ! THEN 1+ DUP C@ <TD> ! 1+ C@ <RD> ! <#> @ ?ERR2 <TD> @ 4 = IF ?<SP> 0> IF <OD> ! THEN THEN ; : SREG CREATE 3C, DOES> DUP C@ DUP FF = IF DROP ELSE <W> ! THEN 1+ DUP C@ <TS> ! 1+ C@ <RS> ! <TS> @ 4 = IF ?<SP> 0> IF <OS> ! THEN THEN ; 0 2 0 SREG AL 0 2 0 DREG AL, 0 3 1 SREG AX 0 3 1 DREG AX, 1 2 0 SREG CL 1 2 0 DREG CL, 1 3 1 SREG CX 1 3 1 DREG CX, 2 2 0 SREG DL 2 2 0 DREG DL, 2 3 1 SREG DX 2 3 1 DREG DX, 3 2 0 SREG BL 3 2 0 DREG BL, 3 3 1 SREG BX 3 3 1 DREG BX, 4 2 0 SREG AH 4 2 0 DREG AH, 4 3 1 SREG SP 4 3 1 DREG SP, 5 2 0 SREG CH 5 2 0 DREG CH, 5 3 1 SREG BP 5 3 1 DREG BP, 6 2 0 SREG DH 6 2 0 DREG DH, 6 3 1 SREG SI 6 3 1 DREG SI, 7 2 0 SREG BH 7 2 0 DREG BH, 7 3 1 SREG DI 7 3 1 DREG DI, 0 5 -1 SREG ES 0 5 -1 DREG ES, 1 5 -1 SREG CS 1 5 -1 DREG CS, 2 5 -1 SREG SS 2 5 -1 DREG SS, 3 5 -1 SREG DS 3 5 -1 DREG DS, 0 4 -1 SREG [BX+SI] 0 4 -1 DREG [BX+SI], 0 4 -1 SREG [SI+BX] 0 4 -1 DREG [SI+BX], 1 4 -1 SREG [BX+DI] 1 4 -1 DREG [BX+DI], 1 4 -1 SREG [DI+BX] 1 4 -1 DREG [DI+BX], 2 4 -1 SREG [BP+SI] 2 4 -1 DREG [BP+SI], 2 4 -1 SREG [SI+BP] 2 4 -1 DREG [SI+BP], 3 4 -1 SREG [BP+DI] 3 4 -1 DREG [BP+DI], 3 4 -1 SREG [DI+BP] 3 4 -1 DREG [DI+BP], 4 4 -1 SREG [SI] 4 4 -1 DREG [SI], 5 4 -1 SREG [DI] 5 4 -1 DREG [DI], 6 4 -1 SREG [BP] 6 4 -1 DREG [BP], 7 4 -1 SREG [BX] 7 4 -1 DREG [BX], : ?W <W> @ ; : ?TD <TD> @ ; : ?TS <TS> @ ; : ?RD <RD> @ ; : ?RS <RS> @ ; : ?OD <OD> @ ; : ?OS <OS> @ ; : +D <D> @ 2* + ; : +W ?W + ; : +RD ?RD + ; : +RS ?RS + ; : MOD1 3F AND 040 OR ; : MOD2 3F AND 080 OR ; : MOD3 3F AND 0C0 OR ; : RESET <#> OFF <W> OFF <OS> OFF <RD> OFF <TD> OFF <TS> OFF <OD> OFF <D> OFF <WD> OFF <RS> OFF !<SP> INTER OFF ; : DSET ?TS INDEXED = IF <D> ON THEN ; : Dt <D> ON ; : BIG? ABS -80 AND 0= NOT ; : +S ( instr,word--instr) FF80 AND ?DUP IF FF80 = ELSE -1 THEN ?W 0= NOT AND IF 2+ <W> OFF THEN ; : ASMHERE DPCODE @ ; ( for revectoring) : OFFSET8, ASMHERE 1+ - DUP ABS 07F > ?ERR1 A, ; : OFFSET16, ASMHERE 2+ - CS:, ; : DISP, <D> @ IF ?OS ELSE ?OD THEN DUP IF DUP ABS 07F > IF SWAP MOD2 A, CS:, ELSE SWAP MOD1 A, A, THEN ELSE DROP DUP 7 AND 6 = IF MOD1 A, 0 A, ELSE A, THEN THEN ; : 1MI CREATE C, DOES> C@ A, RESET ; : 2MI CREATE C, DOES> C@ A, OFFSET8, RESET ; : 3MI CREATE C, DOES> C@ +W A, RESET ; : 4MI CREATE 3C, C, ( PUSH POP) DOES> ?TS CASE DIRECT OF 2+ DUP C@ A, 1+ C@ 6 + A, CS:, ENDOF REG16 OF 1+ C@ +RS A, ENDOF INDEXED OF 2+ DUP C@ A, DSET 1+ C@ +RS DISP, ENDOF SEGREG OF C@ ?RS 8* + A, ENDOF ERR3 ENDCASE RESET ; : 6MI CREATE C, C, DOES> DUP C@ 2 AND IF ?TD ?TS ELSE ?TS ?TD THEN REG16 = IF <W> ON ELSE <W> OFF THEN REG16 = IF ( dx) 1+ C@ +W A, ELSE ( dir) C@ +W A, A, THEN RESET ; : 5MI CREATE 3C, ( JMP CALL) DOES> ?TS CASE DIRECT OF INTER @ IF 2+ C@ A, CS:, CS:, ( intersegment) ELSE C@ ( intraseg) SWAP ASMHERE - 2- SWAP ( disp,op--) DDUP 1 AND SWAP BIG? NOT AND IF 2+ A, A, ( short jmp) ELSE A, 1- CS:, ( jm/cl) THEN THEN ENDOF REG16 OF INTER @ ?ERR3 FF A, 1+ C@ +RS MOD3 A, ENDOF INDEXED OF DSET FF A, 1+ C@ +RS INTER @ IF 8 + THEN DISP, ENDOF ERR3 ENDCASE RESET ; : 7MI CREATE 3C, C, C, DOES> ?TS IMMED = IF 1+ DUP 2+ C@ 0= ?ERR2 ?TD REG8 = ?TD REG16 = OR IF ?RD IF DUP 1+ C@ +W OVER 3 + C@ IF 2 PICK +S THEN A, C@ MOD3 +RD A, ELSE 2+ C@ +W A, ( AL/AX) THEN ELSE DUP 1+ C@ +W OVER 3 + C@ IF 2 PICK +S THEN A, ?TD CASE DIRECT OF C@ 6+ A, SWAP CS:, ENDOF INDEXED OF DSET C@ +RD DISP, ENDOF ERR3 ENDCASE THEN ?W IF CS:, ELSE A, THEN ELSE DSET ?TS DIRECT = IF Dt THEN C@ +D +W A, ?TD CASE REG8 OF ?TS CASE ( REG8 is dest) DIRECT OF ?RD 8* 6+ A, CS:, ENDOF REG8 OF ?RS 8* +RD MOD3 A, ENDOF INDEXED OF ?RD 8* +RS DISP, ENDOF ERR3 ENDCASE ENDOF REG16 OF ?TS CASE DIRECT OF ?RD 8* 6+ A, CS:, ENDOF REG16 OF ?RS 8* +RD MOD3 A, ENDOF INDEXED OF ?RD 8* +RS DISP, ENDOF ERR3 ENDCASE ENDOF INDEXED OF ?TS CASE REG8 OF ?RS 8* +RD DISP, ENDOF REG16 OF ?RS 8* +RD DISP, ENDOF ERR3 ENDCASE ENDOF DIRECT OF ?TS CASE REG8 OF ?RS 8* 6+ A, CS:, ENDOF REG16 OF ?RS 8* 6+ A, CS:, ENDOF ERR3 ENDCASE ENDOF ERR3 ENDCASE THEN RESET ; : 8MI CREATE C, C, DOES> DUP 1+ C@ +W A, ?TS CASE DIRECT OF C@ 6+ A, CS:, ENDOF REG8 OF C@ +RS MOD3 A, ENDOF REG16 OF C@ +RS MOD3 A, ENDOF INDEXED OF DSET C@ +RS DISP, ENDOF ERR3 ENDCASE RESET ; : 9MI CREATE C, C, DOES> DUP 1+ C@ <WD> @ + ?TS 1 > IF 2+ ( CL reg) ELSE ROT DROP ( 1) THEN A, ?TD CASE DIRECT OF C@ 6+ A, CS:, ENDOF REG8 OF C@ MOD3 +RD A, ENDOF REG16 OF C@ MOD3 +RD A, ENDOF INDEXED OF DSET C@ +RD DISP, ENDOF ERR3 ENDCASE RESET ; : 10MI CREATE C, C, ( AAD AAM ) DOES> DUP C@ SWAP 1+ C@ A, A, RESET ; : 11MI CREATE C, C, ( INC DEC ) DOES> ?TS CASE DIRECT OF FE +W A, 1+ C@ 6+ A, CS:, ENDOF REG8 OF 0FE A, 1+ C@ MOD3 +RS A, ENDOF REG16 OF C@ +RS A, ENDOF INDEXED OF DSET 0FE +W A, 1+ C@ +RS DISP, ENDOF ERR3 ENDCASE RESET ; : MOV DSET ?TD CASE DIRECT OF ?TS CASE REG8 OF ?RS IF 088 A, ?RS 8* 6+ A, CS:, ELSE 0A2 +W A, CS:, THEN ENDOF REG16 OF ?RS IF 089 A, ?RS 8* 6+ A, CS:, ELSE 0A2 +W A, CS:, THEN ENDOF SEGREG OF 08C A, ?RS 8* 6+ A, CS:, ENDOF IMMED OF C6 +W A, 6 A, SWAP CS:, ?W IF CS:, ELSE A, THEN ENDOF ERR3 ENDCASE ENDOF REG8 OF ?TS CASE DIRECT OF ?RD IF 08A A, ?RD 8* 6+ A, CS:, ELSE 0A0 +W A, CS:, THEN ENDOF IMMED OF 0B0 +RD A, A, ENDOF REG8 OF Dt 88 +D A, ?RD 8* +RS MOD3 A, ENDOF REG16 OF ERR5 ENDOF INDEXED OF 88 +D +W A, ?RD 8* +RS DISP, ENDOF ERR3 ENDCASE ENDOF REG16 OF ?TS CASE DIRECT OF ?RD IF 08B A, ?RD 8* 6+ A, CS:, ELSE 0A0 +W A, CS:, THEN ENDOF IMMED OF 0B8 +RD A, CS:, ENDOF REG16 OF Dt 88 +W +D A, ?RD 8* +RS MOD3 A, ENDOF INDEXED OF 088 +D +W A, ?RD 8* +RS DISP, ENDOF SEGREG OF 08C A, ?RS 8* +RD MOD3 A, ENDOF ERR3 ENDCASE ENDOF INDEXED OF ?TS CASE IMMED OF 0C6 +W A, ?RD DISP, ?W IF CS:, ELSE A, THEN ENDOF REG8 OF 088 +D +W A, ?RS 8* +RD DISP, ENDOF REG16 OF 088 +D +W A, ?RS 8* +RD DISP, ENDOF SEGREG OF 08C A, ?RS 8* +RD DISP, ENDOF ERR3 ENDCASE ENDOF SEGREG OF ?TS CASE DIRECT OF 08E A, ?RD 8* 6+ A, CS:, ENDOF REG16 OF 08E A, ?RD 8* +RS MOD3 A, ENDOF INDEXED OF 08E A, ?RD 8* +RS DISP, ENDOF ERR3 ENDCASE ENDOF ERR3 ENDCASE RESET ; : XCHG DSET ?TD CASE DIRECT OF ?TS REG16 = IF 90 +RS A, ELSE ERR3 THEN ENDOF REG8 OF 86 +W A, ?TS CASE DIRECT OF ?RD 8* 6+ A, CS:, ENDOF REG8 OF ?RD 8* +RS MOD3 A, ENDOF INDEXED OF ?RD 8* +RS DISP, ENDOF ERR3 ENDCASE ENDOF REG16 OF 86 +W A, ?TS CASE DIRECT OF ?RD 8* 6+ A, CS:, ENDOF REG16 OF ?RD 8* +RS MOD3 A, ENDOF INDEXED OF ?RD 8* +RS DISP, ENDOF ERR3 ENDCASE ENDOF ERR3 ENDCASE RESET ; : TEST ?TS IMMED = IF ?TD DUP REG8 = SWAP REG16 = OR IF ?RD IF F6 +W A, ?RD MOD3 A, ELSE A8 +W A, THEN ELSE F6 +W A, ?TD CASE DIRECT OF 6 A, SWAP CS:, ENDOF INDEXED OF ?RD DISP, ENDOF ERR3 ENDCASE THEN ?W IF CS:, ELSE A, THEN ELSE ?TD REG8 < ?TD REG16 > OR ?ERR3 84 +W A, DSET ?TS CASE DIRECT OF ?RD 8* 6+ A, CS:, ENDOF REG8 OF ?RD 8* +RS MOD3 A, ENDOF REG16 OF ?RD 8* +RS MOD3 A, ENDOF INDEXED OF ?RD 8* +RS DISP, ENDOF ERR3 ENDCASE THEN RESET ; : INT CD A, A, RESET ; : 16MI CREATE C, ( RET ) DOES> C@ DUP INTER @ IF 8 + THEN A, 1 AND 0= IF CS:, THEN RESET ; 37 1MI AAA 1 3C 80 38 38 7MI CMP ( INT ) D5 0A 10MI AAD A6 3MI CMPS CE 1MI INTO D4 0A 10MI AAM 99 1MI CWD CF 1MI IRET 3F 1MI AAS 27 1MI DAA 77 2MI JA 1 14 80 10 10 7MI ADC 2F 1MI DAS 73 2MI JAE 1 04 80 00 00 7MI ADD 08 48 11MI DEC 72 2MI JB 0 24 80 20 20 7MI AND F6 30 8MI DIV 76 2MI JBE 9A 10 E8 5MI CALL ( ESC ) E3 2MI JCXZ 98 1MI CBW F4 1MI HLT 74 2MI JE F8 1MI CLC F6 38 8MI IDIV 7F 2MI JG FC 1MI CLD F6 28 8MI IMUL 7D 2MI JGE FA 1MI CLI EC E4 6MI IN 7C 2MI JL F5 1MI CMC 00 40 11MI INC 7E 2MI JLE EA 20 E9 5MI JMP 75 2MI JNZ ( E2 2MI LOOP ) 76 2MI JNA 70 2MI JO E1 2MI LOOPE 72 2MI JNAE 7A 2MI JP E0 2MI LOOPNE 73 2MI JNB 7A 2MI JPE E0 2MI LOOPNZ 77 2MI JNBE 7B 2MI JPO E1 2MI LOOPZ 75 2MI JNE 78 2MI JS ( MOV ) 7E 2MI JNG 74 2MI JZ A4 3MI MOVS 7C 2MI JNGE 9F 1MI LAHF F6 20 8MI MUL 7D 2MI JNL 0 0 0 0 C2 7MI LDS F6 18 8MI NEG 7F 2MI JNLE 0 0 0 0 8A 7MI LEA 90 1MI NOP 71 2MI JNO 0 0 0 0 C1 7MI LES F6 10 8MI NOT 7B 2MI JNP F0 1MI LOCK 0 0C 80 08 08 7MI OR 79 2MI JNS AC 3MI LODS EE E6 6MI OUT 0 8F 58 07 4MI POP D0 08 9MI ROR 1 2C 80 28 28 7MI SUB 9D 1MI POPF 9E 1MI SAHF ( TEST ) 30 FF 50 06 4MI PUSH D0 38 9MI SAR 9B 1MI WAIT 9C 1MI PUSHF 1 1C 80 18 18 7MI SBB ( XCHG ) D0 10 9MI RCL AE 3MI SCAS D7 1MI XLAT D0 18 9MI RCR ( SEG ) 0 34 80 30 30 7MI XOR F3 1MI REP D0 20 9MI SAL C2 16MI +RET F3 1MI REPE D0 20 9MI SHL F2 1MI REPNE D0 28 9MI SHR F2 1MI REPNZ F9 1MI STC F3 1MI REPZ FD 1MI STD C3 16MI RET FB 1MI STI D0 00 9MI ROL AA 3MI STOS : BYTE <W> OFF <WD> OFF ; : WORD <W> ON <WD> ON ; : # <#> ON <TS> ON ; : , DEPTH 1 < ?ERR4 <TD> OFF ; : ES: 26 A, ; : CS: 2E A, ; : SS: 36 A, ; : DS: 3E A, ; : FAR INTER ON ; ( AGAIN and REPEAT are two byte relative jumps ) ( All of the other logical tests are one byte relative jumps ) ( e.g., max decimal one byte jump is +/- 127 bytes ) : ERR1? - DUP ABS 7F > ?ERR1 ; ( VERY IMPORTANT NOTE: MUST have count in CX REG !!! ) ( CX max can be 1 THRU 65535 <$FFFF> ) : DO DPCODE @ RESET ; ( Will set CX=1 to exit upon reaching LOOP ) ( E.G., A, B CMP IF= LEAVE THEN ) : LEAVE B9 A, 1 CS:, RESET ; ( Will first decrement CX and then JMP to DO if CX is not 0 ) : LOOP E2 A, DPCODE @ 1+ ERR1? A, RESET ; ( The following are used after: A, B CMP <or CMPS> ) ( A or B can be any MEM, REG, or # NO.; byte or word ) : IF= 75 A, DPCODE @ 0 A, RESET ; ( IF A = B ) : IF< 7D A, DPCODE @ 0 A, RESET ; ( IF A < B ) : IFU< 73 A, DPCODE @ 0 A, RESET ; ( IF A U< B ) : IF0< 79 A, DPCODE @ 0 A, RESET ; ( IF SF = 1 ) : IF-OVERFLOW 71 A, DPCODE @ 0 A, RESET ; ( If overflow flag 1) : ELSE EB A, DUP DPCODE @ SWAP ERR1? SWAP CS:C! DPCODE @ 0 A, RESET ; : THEN DUP 1+ DPCODE @ SWAP ERR1? SWAP CS:C! RESET ; : BEGIN DPCODE @ RESET ; : AGAIN E9 A, DPCODE @ 2+ - CS:, RESET ; ( Use after: A, B CMP <or CMPS> e.g., repeat UNTIL A=B ) : UNTIL= 75 A, DPCODE @ 1+ ERR1? A, RESET ; : UNTIL0< 79 A, DPCODE @ 1+ ERR1? A, RESET ; : UNTIL< 7D A, DPCODE @ 1+ ERR1? A, RESET ; : UNTILU< 73 A, DPCODE @ 1+ ERR1? A, RESET ; ( next word can be followed by "not" ) : UNTIL-OVERFLOW 71 A, DPCODE @ 1+ ERR1? A, RESET ; ( ovrflo = 1 ) : WHILE= IF= ; ( example: BEGIN...A, B CMP WHILE=...REPEAT ) : WHILE< IF< ; : WHILE0< IF0< ; : WHILEU< IFU< ; : WHILE-OVERFLOW IF-OVERFLOW ; ( can be followed by "not" ) ( Use "non" to invert logical operators, e.g., IF= non ) ( or UNTIL< non means repeat until A is not less than B ) ( Lower case is used to avoid conflict with opcode word NOT ) : non DPCODE @ 2- DUP CS:C@ 1- SWAP CS:C! ; : REPEAT SWAP AGAIN THEN ; ( Assembler TEST Logical Operators ) ( Use after A, B TEST since logic is reversed <TEST = AND> ) : IFTEST IF= non ; : UNTILTEST UNTIL= non ; : WHILETEST WHILE= non ; : IFNOTEST IF= ; : UNTILNOTEST UNTIL= ; : WHILENOTEST WHILE= ; ( Do not compile two not's together. Do not compile IFTEST non) ( as two separate words.) ( WORD LODS BX, AX MOV WORD [BX] JMP ) : NEXT-JMP AD A, 8B A, D8 A, FF A, 27 A, RESET ; : APUSH-JMP 50 A, NEXT-JMP ; DECIMAL : C; RESET ?CSP SMUDGE VDROP ; : END-CODE C; ; : LABEL ( define assembler label ( -- ) ( this takes advantage of L.O.V.E Forth characteristic that: CONSTANT does not add anything to the code segment ) SMUDGE ( previous code word ) CS:HERE CONSTANT SMUDGE ( for C; to unsmudge) ; : ;CODE ?CSP COMPILE <;CODE> DPCODE @ TS:, [COMPILE] [ ALSO ASSEMBLER RESET ; IMMEDIATE : CODE !CSP CREATE: DPCODE @ TS:HERE TS:BODY> TS:! ALSO ASSEMBLER RESET SMUDGE ;