( Copyright PPC Paris 1986 ) ( XASMB extensions pour l'assembleur Forth et ) ( corrections des erreurs connues. ) ( 1- correction du bug sur B=B+B ) ( 2- ajout de la pseudo-op XEQUS qui inclue une ) ( table de symboles ) ( 3- visualisation du nombre d'erreurs en fin ) ( d'exÅcution ) ( par Henrik Helnaes ) ( {sauf +BASE, ERRORS, ?PASS=1, DONE et une ) ( partie de CODER par J. Taillandier} ) CR .( Loading .. XASMB ) BASE @ HEX : XASMB ; : +BASE [ E9900 , ] ; : ERRORS 11D +BASE ; : ?PASS=1 [ EC9F0 , ] ; : DONE 19 +BASE ; : INSERT ( sadr tadr -- ) DUP 12 ADJUSTF 0= IF ABORT" No mem" THEN 12 NMOVE ; : SEEK " ASMBSY" FINDF 20 + DUP DUP @ + 12 - SWAP 5+ OVER SWAP DO DROP DUP 6 I 6 S< I SWAP IF LEAVE THEN 12 + 12 +LOOP ; : MERGE ( eadr sadr ) DO I SEEK 2DUP 6 SWAP 6 S= IF 2DROP ELSE INSERT THEN 12 +LOOP ; : TIME " TIME" BASICF ; : DEC. BASE @ SWAP DECIMAL . BASE ! ; : N, HERE N! 1 NALLOT ; : NNUM 20 WORD NUMBER DROP ; : BYTE NNUM C, ; : NYB NNUM N, ; : CODE NNUM , ; : TEXT 20 WORD DUP 2+ SWAP C@ 2DUP " ENDTAB" S= NOT ; : ATEXT 6 0 DO C@+ ?DUP 0= IF BL THEN C, LOOP 2DROP ; 6 STRING CTXT : CODETAB CREATE HERE 0 , BEGIN TEXT WHILE CTXT S! BYTE NYB CTXT ATEXT BYTE NYB CODE BYTE REPEAT 2DROP HERE SWAP ! DOES> DUP @ SWAP 5+ ; : SEARCH DO 2DUP I 2+ DUP N@ SWAP 1+ SWAP S= IF 2DROP I -1 LEAVE THEN 19 +LOOP DUP -1 <> IF 2DROP 0 THEN ; ( Le format des donnÅes dans CODETAB est: ) ( nom groupe longueur-du-texte flags ) ( longueur-du-code code variables-A-B ) CODETAB OPCODES END 28 3 00 0 00000 00 XEQUS 29 5 00 0 00000 00 B=B+B 02 5 04 3 00005 01 ENDTAB : SYMTAB CREATE HERE 0 , BEGIN TEXT WHILE ATEXT CODE 2 N, REPEAT 2DROP HERE SWAP ! DOES> DUP @ SWAP 5+ ; ( Le format des donnÅes dans SYMTAB est: ) ( nom valeur ) SYMTAB XEQUATES ENDBIN 0764B MGOSUB 1AF01 HEXDEC 0ECAF DECHEX 1B202 HEXASC 17148 ADHEAD 181B7 DSPCNB 0971F ARGERR 0BF19 D=AVMS 1A460 STKCHR 18504 uRES12 0C994 BF2DSP 01C0E FNRTN1 0F216 NXTSTM 08A48 EXPR 0F23C ENDTAB : PARSER OPCODES SEARCH ; : CODER ( optype -- codelength ) CASE 28 OF ?PASS=1 IF 0 ELSE ERRORS @ CR DEC. ." error(s)" THEN -1 DONE ! ENDOF 29 OF ?PASS=1 IF XEQUATES 2DUP - 12 / F5 +BASE +! MERGE 0 THEN ENDOF ENDCASE ; : ASSEMBLE TIME HERE PAD OVER - 0 NFILL PAD 2+ DUP C@ 2* + 2+ SP@ 2DUP < IF OVER - 0 NFILL ELSE 2DROP THEN ['] PARSER 2FC79 ! ['] CODER 2FC7E ! ASSEMBLE 2FC79 0A 0 NFILL TIME X<>Y F- F. " BEEP" BASICX ; BASE !