home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / soundpot / f / mvpforth.lbr / DDFORTH.SZR / DDFORTH.SCR
Encoding:
Text File  |  1993-10-26  |  60.0 KB  |  1 lines

  1. ( LOAD SCREEN FOR UTILITIES                     CRC VER = 29941)                                                                : THRU  1+ SWAP DO I U. I LOAD ?TERMINAL                                IF LEAVE THEN LOOP ;                                                                                                                                                                    248 256 THRU                                                                                                                    EXIT                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ( CASE STATEMENT                                CRC VER = 7982)                                                                 : !CSP  SP@ CSP ! ;                                                                                                             : CASE  ?COMP CSP @ !CSP 4 ; IMMEDIATE                                                                                          : OF  4 ?PAIRS COMPILE OVER COMPILE = COMPILE 0BRANCH                 HERE 0 , COMPILE DROP 5 ;  IMMEDIATE                                                                                      : ENDOF  5 ?PAIRS COMPILE BRANCH HERE 0 , SWAP 2                         [COMPILE] THEN 4 ; IMMEDIATE                                                                                           : ENDCASE  4 ?PAIRS COMPILE DROP BEGIN SP@ CSP @ =                         0 = WHILE 2 [COMPILE] THEN REPEAT CSP                           ! ;  IMMEDIATE                                                                                                       ( PAUSE COPY FLUSH  DSWAP ID. VLIST             CRC VER = 62358)                                                                : PAUSE ?TERMINAL IF KEY DROP 1000 0 DO LOOP BEGIN ?TERMINAL            UNTIL KEY DROP 2000 0 DO LOOP THEN  ;                   : COPY OFFSET @ + SWAP BLOCK 2- ! UPDATE   ;                    : FLUSH   SAVE-BUFFERS ;                                        : DSWAP  4 ROLL  4 ROLL ;                                                                                                       HEX                                                             : ID.  COUNT 1F AND TYPE ;                                      : VLIST  C/L OUT ! CONTEXT @ @                                     BEGIN C/L OUT @ - OVER C@ 1F AND 4 + < IF CR 0 OUT ! THEN            DUP ID. SPACE SPACE PFA 4 - @ DUP                                 NOT PAUSE ?TERMINAL OR UNTIL DROP ;                   DECIMAL                                                                                                                         ( SAVE-FORTH                                    CRC VER = 23595): SAVE-FORTH  FREEZE  13 0 SYSCALL DROP  14 0 SYSCALL DROP                    CR CR ." FILE NAME ? ---"                                       PAD 33 0 FILL PAD 1+ 11 BLANK QUERY                             46 WORD COUNT 8 MIN PAD 1+ SWAP CMOVE                           BL WORD COUNT 3 MIN PAD 9 + SWAP CMOVE                          19 PAD SYSCALL DROP  22 PAD SYSCALL DROP                        256 HERE 0 256 U/MOD SWAP DROP 1+ 2/ 2* 2*                      0 DO DUP 26 SWAP SYSCALL DROP                                            21 PAD SYSCALL DROP 128 +                                   LOOP DROP                                                  16 PAD SYSCALL DROP ;                                                                                                                                                                                                                                                                                             ( .INDEX INDEX .SS .SL .SR .S                   CRC VER = 58176)                                                                : .INDEX   CR DUP SCR ! U. 1 0 DO I 3 .R SPACE                             I SCR @ .LINE  LOOP  ;                                                                                               : INDEX    ( FROM TO --- LISTS LINE 0  OF SCREENS)                         BEGIN DUP ROT DUP .INDEX DUP ROT <                              WHILE 1+ SWAP REPEAT DDROP ;                                                                                         ( NON-DESTRUCTIVE STACK DISPLAY --- DEFAULT SET TO .SR)         0 CONSTANT .SS      ( .S LEFT OR RIGHT SWITCH)                  : .SL  0 ' .SS ! ;  ( .S WITH TOP OF STACK ON LEFT)             : .SR  -1 ' .SS ! ; ( .S WITH TOP OF STACK ON RIGHT)            : .S  CR DEPTH  IF .SS IF SP@ S0 2- ELSE SP@ S0 SWAP THEN             DO I @ 0 D. 2 .SS +- +LOOP ELSE ." EMPTY STACK"                 THEN CR ;    .SR                                          ( CHECKSUM FOR HAND-ENTERED SOURCE SCREENS      CRC VER = 18123): ACCUMULATE   ( OLDCRC\CHAR -- NEWCRC)                            256 * XOR 8 0 DO DUP 0< IF 16386 XOR DUP + 1+                                           ELSE DUP + THEN LOOP ;               : DISPOSE  ( CRCVALUE\ADR\LEN -- NEWCRCVALUE)                      OVER DUP  C@ 40 = SWAP 1+ C@ BL = AND OVER 1 = AND              IF ( COMMENT; SKIP IT) DDROP 41 WORD DROP                       ELSE 1+ OVER + SWAP DO I C@ ACCUMULATE  LOOP                    THEN ;  ( CAREFUL; LOOPS ON ADDRESSES)                       : MORE ( -- ADR F) BL WORD DUP C@ 2 <                                 OVER 1+ C@ 33 < AND NOT ;                                 : VERIFY  ( SCR# -- CRCVALUE) BLK @ >R >IN @ >R BLK ! 0 >IN !      0 BEGIN MORE WHILE BL OVER COUNT + C! COUNT DISPOSE             REPEAT DROP  R> >IN ! R> BLK ! ;                             : VER  SCR @ VERIFY U. ;                                        ( LIST NLIST LISTP NLISTP O-PAGE                CRC VER = 65379)0 WARNING !                                                     : LIST PAGE CR DUP SCR !  ." SCR #" U.                                 16 0 DO CR I 3 .R SPACE  I SCR @ .LINE                          ?TERMINAL IF LEAVE THEN LOOP CR ;                        : NLIST ( FROM TO --- LISTS SCREENS WITHOUT PAUSING)                    BEGIN DUP ROT DUP LIST DUP ROT <                                WHILE 1+ SWAP REPEAT DDROP ;                            : LISTP ( PUTS A PAUSE INTO LIST, FOR NLISTP -- BELOW)                  PAGE CR DUP SCR !  ." SCR #" U.                                 16 0 DO CR I 3 .R SPACE  I SCR @ .LINE                          ?TERMINAL IF LEAVE THEN LOOP CR KEY DROP  ;             : NLISTP  ( FROM TO --- LISTS SCREENS, PAUSES UNTIL KEY IS HIT)           BEGIN DUP ROT DUP LISTP DUP ROT <                               WHILE 1+ SWAP REPEAT DDROP ;  1 WARNING !             : O-PAGE   26 EMIT ;   ' O-PAGE CFA 'PAGE !                     ( N  B  L  GOTO-XY                              CRC VER = 13142)                                                                : N  1 SCR +! ;                                                                                                                 : B -1 SCR +! ;                                                                                                                 : L PAGE SCR @ LIST ;                                                                                                           : GOTO-XY 27 EMIT 61 EMIT 32 + EMIT 32 + EMIT ;                                                                                 : ASCII ( ASCII VALUE OF THE NEXT KEY HIT IS PUT ON THE STACK)    BL WORD 1+ C@ [COMPILE] LITERAL ; IMMEDIATE                                                                                                                                                                                                                                                                                   ( SCR#X-->Y COPYF                               CRC VER = 54584): SCR#X-->Y CR 2 PICK SCR ! ." SCR#" SWAP  3 .R 1 0                         ." -->" DO 3 .R SPACE I SCR @ .LINE                                     LOOP ;                                      : COPYF ( COPIES SCR# N1 THRU N2 TO N3 THRU  ?                            OR     SCR# N1 TO N2 .... BOTH WITH FLUSH                       CLEAR STACK BEFORE COPYING...HIT ANY KEY TO ABORT)    DEPTH 3 < IF DDUP ROT DROP                                                THEN ROT ROT SWAP DDUP =                                        IF ROT ROT 2 PICK PAGE 0 6 GOTO-XY SCR#X-->Y                       SWAP DUP 1+ SCR ! SWAP COPY FLUSH                            ELSE PAGE 0 6 GOTO-XY                                                BEGIN SWAP 2 PICK 4 PICK DDUP SCR#X-->Y COPY                    FLUSH ROT 1+ SWAP ROT 1+ DUP SCR ! DDUP <                       ?TERMINAL IF CR ." Aborted" ABORT THEN                          UNTIL DROP DROP DROP THEN CR ." Done" QUIT ;     ( WIPE                                          CRC VER = 12104): WIPE  ( N1 N2 -- CLEAR SCREENS N1 THROUGH N2  OR                           N1 -- CLEAR SCREEN  N1                                       CLEAR STACK BEFORE WIPING ... HIT ANY KEY TO ABORT)     DEPTH 2 < IF  DUP                                                         THEN SWAP PAGE 0 5 GOTO-XY                                           BEGIN DUP SCR ! SCR @ DUP CR                                          ." CLEARING SCR#-->" 3 .R                                       CLEAR FLUSH 1+ DDUP <                                           ?TERMINAL IF CR ." Aborted" ABORT THEN                    UNTIL SCR ! DROP CR  ." Done" QUIT ;                                                                                                                                                                                                                                                                                                                                           ( LOAD SCREEN FOR FORTH LINE EDITOR             CRC VER = 7952)                                                                                                                                 258 275 THRU                                                                                                                    EXIT                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ( <MATCH>                                       CRC VER = 25092)                                                                WARNING @ 0 WARNING !                                                                                                           : <MATCH>   ( ADDR-3, ADDR-2, COUNT-1 ---- FLAG)                  ?DUP  IF OVER + SWAP                                              DO                                                                DUP C@ I C@ -                                                   IF 0= LEAVE ELSE 1+ THEN                                      LOOP                                                          ELSE DROP 0= THEN ;                                                                                                                                                                                                                                                                                                                                                                           ( MATCH                                         CRC VER = 27930)                                                                : MATCH    ( CURSOR ADDR-4, BYTES LEFT-3, STRING ADDR-2)                   ( STRING COUNT-1, ---- FLAG-2, CURSOR OFFSET-1)        >R  >R  DDUP  R> R> DSWAP OVER + SWAP                           ( CADDR-6, BLEFT-5, $ADDR-4, $LEN-3, CADDR+BLEFT-2, CADDR-1)    DO                                                                DDUP  I SWAP  <MATCH>                                           IF                                                                >R  DDROP  R> - I SWAP - 0 SWAP 0 0 LEAVE                    ( CADR, BLEFT, $ADDR, $LEN  OR 0, OFFSET, 0, 0)                 THEN                                                         LOOP                                                            DDROP    ( CADDR-2, BLEFT-1  OR 0-2, OFFSET-1)                  SWAP  0=  SWAP ;                                                                                                                ( LINE                                          CRC VER = 36396)                                                                                                                                BASE @ HEX                                                                                                                      : LINE   ( RELATIVE TO SCR, LEAVE ADDRESS OF LINE)                DUP  FFF0 AND                                                   ABORT" NOT ON CURRENT EDITING SCREEN"                           SCR @ <LINE> DROP ;                                                                                                           BASE !                                                                                                                                                                                                                                                                                                                                                                                          ( #LOCATE                                       CRC VER = 4570)                                                                 VOCABULARY EDITOR IMMEDIATE BASE @ HEX                                                                                          EDITOR DEFINITIONS                                                                                                              : #LOCATE    ( ---- CURSOR OFFSET-2, LINE-1)                      R# @ C/L /MOD ;                                                                                                               BASE !                                                                                                                                                                                                                                                                                                                                                                                                                                                          ( #LEAD  #LAG  -MOVE  BUF-MOVE                  CRC VER = 27808)                                                                : #LEAD  ( ---- CURSOR ADDR-2, OFFSET TO CURSOR-1)                #LOCATE  LINE SWAP ;                                                                                                          : #LAG   ( ---- CURSOR ADDR-2, COUNT AFTER CURSOR-1)              #LEAD DUP >R + C/L R> - ;                                                                                                     : -MOVE  ( MOVE FROM ADDR-2 TO LINE-1 ----)                       LINE C/L CMOVE UPDATE ;                                                                                                       : BUF-MOVE   ( MOVE TEXT, IF ANY, TO BUFFER-1 ----)               HERE C@                                                         IF PAD SWAP C/L 1+ CMOVE                                        ELSE DROP                                                       THEN ;                                                        ( >LINE# FIND-BUF INSERT-BUF                    CRC VER = 59275)                                                                BASE @ HEX                                                                                                                      : >LINE#  ( CONVERT CURRENT CURSOR POSITION TO LINE#)             #LOCATE SWAP DROP ;                                                                                                                                                                           : FIND-BUF  ( BUFFER USED FOR ALL SEARCHES)                       PAD 50 + ;                                                                                                                                                                                    : INSERT-BUF ( BUFFER USED FOR ALL INSERTIONS)                    FIND-BUF 50 + ;                                                                                                               BASE !                                                          ( HOLD- <KILL> <SPREAD> X                       CRC VER = 41917)BASE @ HEX                                                      : <HOLD>  ( MOVE LINE-1 FROM BLOCK TO INSERT BUFFER)              LINE INSERT-BUF  1+ C/L DUP INSERT-BUF C! CMOVE ;                                                                             : <KILL>  ( ERASE LINE-1 WITH BLANKS)                             LINE C/L BLANK UPDATE ;                                                                                                       : <SPREAD> ( SPREAD, MAKING LINE# BLANK)                          >LINE# DUP  0E                                                  DO I LINE I 1+ -MOVE -1 +LOOP <KILL> ;                                                                                        : X    ( DELETE LINE# FROM BLOCK, PUT IN INSERT BUFFER)           >LINE# DUP <HOLD> 0F DUP ROT                                    DO I 1+ LINE I -MOVE LOOP <KILL> ;                            BASE !                                                          ( DISPLAY-CURSOR T L                            CRC VER = 14701)                                                                BASE @ HEX                                                                                                                      : DISPLAY-CURSOR   ( ----)                                        CR SPACE #LEAD TYPE 5E EMIT                                     #LAG TYPE #LOCATE 2 .R SPACE DROP ;                                                                                           : T       ( TYPE LINE#-1)                                         C/L * R# ! DISPLAY-CURSOR  ;                                                                                                  : L       ( LIST CURRENT SCREEN)                                  PAGE SCR @ LIST DISPLAY-CURSOR ;                                                                                              BASE !                                                                                                                          ( N B <TOP> SEEK-ERROR                          CRC VER = 39959)                                                                : N  ( SELECT NEXT SEQUENTIAL SCREEN)                             1 SCR +! ;                                                                                                                    : B  ( SELECT PREVIOUS SEQUENTIAL SCREEN)                         -1 SCR +! ;                                                                                                                   : <TOP>  ( RESET CURSOR TO TOP OF BLOCK)                          0 R# ! ;                                                                                                                      : SEEK-ERROR    ( OUTPUT ERROR MSG IF NO MATCH)                   <TOP> FIND-BUF HERE C/L 1+ CMOVE                                HERE COUNT TYPE                                                 ." NONE" QUIT ;                                                                                                               ( <R> P                                         CRC VER = 19509)                                                                BASE @ HEX                                                                                                                      : <R>  ( REPLACE CURRENT LINE WITH INSERT BUFFER)                 >LINE#                                                          INSERT-BUF 1+ SWAP -MOVE ;                                                                                                    : P  ( FOLLOWING TEXT IN INSERT BUFFER AND LINE)                  5E TEXT                                                         INSERT-BUF  BUF-MOVE                                            <R> ;                                                                                                                         BASE !                                                                                                                                                                                          ( 1LINE                                         CRC VER = 17269)                                                                                                                                                                                                : 1LINE    ( SCAN CURRENT LINE FOR MATCH WITH FIND BUFFER)                 ( UPDATE CURSOR, RETURN BOOLEAN               )        #LAG FIND-BUF  COUNT MATCH R# +! ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ( <SEEK> <DELETE>                               CRC VER = 24004)BASE @ HEX                                                                                                                      : <SEEK>   ( FIND BUFFER MATCH OVER FULL SCREEN, ELSE ERROR)     BEGIN 3FF R# @ <                                                  IF SEEK-ERROR  THEN                                             1LINE                                                         UNTIL ;                                                                                                                        : <DELETE>   ( BACKWARDS AT CURSOR BY COUNT-1)                    >R  #LAG + R@ -  ( SAVE BLANK FILL LOCATION)                    #LAG R@ NEGATE R# +! ( BACK AT CURSOR)                          #LEAD + SWAP CMOVE                                              R> BLANK UPDATE ;  ( FILL FROM END OF TEXT)                                                                                   BASE !                                                          ( <F> F <E> E                                   CRC VER = 1004) BASE @ HEX                                                      : <F>   ( FIND OCCURANCE OF FOLLOWING TEXT)                       5E TEXT                                                         FIND-BUF   BUF-MOVE                                             <SEEK>  ;                                                                                                                     : F    ( FIND AND DISPLAY FOLLOWING TEXT)                         <F> DISPLAY-CURSOR ;                                                                                                          : <E>  ( ERASE BACKWARDS FROM CURSOR)                             FIND-BUF C@ <DELETE> ;                                                                                                        : E    ( ERASE AND DISPLAY LINE)                                  <E> DISPLAY-CURSOR ;                                          BASE !                                                          ( D TILL                                        CRC VER = 32395)                                                                BASE @ HEX                                                                                                                      : D    ( FIND, DELETE, AND DISPLAY FOLLOWING TEXT)                <F> E ;                                                                                                                       : TILL  ( DELETE FROM CURSOR TO TEXT END)                         #LEAD + 5E TEXT                                                 FIND-BUF  BUF-MOVE                                              1LINE 0= IF SEEK-ERROR  THEN                                    #LEAD + SWAP - <DELETE>                                         DISPLAY-CURSOR ;                                                                                                               BASE !                                                                                                                         ( COUNTER BUMP                                  CRC VER = 39717)                                                                BASE @ HEX                                                                                                                      VARIABLE COUNTER 0 COUNTER !                                                                                                    : BUMP    ( THE LINE NUMBER AND HANDLE PAGING)                    1 COUNTER +! COUNTER @                                          38 > IF 0 COUNTER !                                             CR CR 0C EMIT THEN ;                                                                                                          BASE !                                                                                                                                                                                                                                                                                                                          ( S                                             CRC VER = 31910)                                                                BASE @ HEX                                                                                                                      : S    ( FROM CURRENT TO SCREEN-1 FOR STRING)                     0C EMIT 5E TEXT 0 COUNTER !                                     FIND-BUF  BUF-MOVE                                              SCR @ DUP >R DO I SCR !                                         <TOP>                                                           BEGIN                                                              1LINE IF DISPLAY-CURSOR SCR ? BUMP THEN                         3FE  R# @ < ?TERMINAL IF 1 ELSE 0 THEN OR                   UNTIL                                                             PAUSE ?TERMINAL IF KEY DROP LEAVE THEN LOOP R> SCR ! ;                                                                       BASE !                                                          ( I U                                           CRC VER = 20178)BASE @ HEX                                                      : I   ( INSERT TEXT WITHIN LINE)                                  5E TEXT   ( LOAD INSERT BUFFER WITH TEXT)                       INSERT-BUF   BUF-MOVE      ( IF ANY)                            INSERT-BUF COUNT #LAG ROT OVER MIN >R                           R@ R# +!   ( BUMP CURSOR)                                       R@ - >R    ( CHARACTERS TO SAVE)                                DUP HERE R@ CMOVE  ( FROM OLD CURSOR TO HERE)                   HERE #LEAD + R> CMOVE  ( HERE TO CURSOR LOCATION)               R> CMOVE UPDATE     ( PAD TO OLD CURSOR)                        DISPLAY-CURSOR ;    ( LOOK AT NEW LINE)                                                                                       : U   ( INSERT FOLLOWING TEXT UNDER CURRENT LINE)                 C/L R# +! <SPREAD> P ;                                        BASE !                                                          ( R M                                           CRC VER = 35806)                                                                : R    ( REPLACE FOUND TEXT WITH INSERT BUFFER)                   <E> I ;                                                                                                                       : M            ( MOVE FROM CURRENT LINE ON CURRENT SCREEN)        SCR @ >R     ( TO SCREEN-2, UNDER LINE-1)                      R# @ >R       ( SAVE ORIGINAL SCREEN AND CURSOR LOCATION)       >LINE# <HOLD> ( MOVE CURRENT LINE TO INSERT BUFFER)             SWAP SCR !    ( SET NEW SCREEN #)                               1+ C/L * R# ! ( TEXT IS STORED UNDER REQUESTED LINE)            <SPREAD> <R>  ( STORE INSERT BUFFER IN NEW SCREEN)              R> C/L + R# ! ( SET ORIGINAL CURSOR TO NEXT LINE)               R> SCR ! ;    ( RESTORE ORIGINAL SCREEN)                                                                                       FORTH  DEFINITIONS   ( VALUE ON STACK)  WARNING !                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               ( LOAD SCREEN FOR Z80 ASSEMBLER                 CRC VER = 44093)                                                                278 306 THRU                                                                                                                    EXIT                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ( CODE & NEXT                                   CRC VER = 35989)( COPYRIGHT 1982  MICHAEL M RUBENSTEIN )                        ( VERSION 1.0, MODIFIED FOR MVP FORTH)                          FORTH DEFINITIONS  HEX  VOCABULARY ASSEMBLER                    ASSEMBLER DEFINITIONS                                           HERE SP@ 1400 - DP !                                            : <> = 0= ;                                                     : IN >IN ;                                                      : ERROR  NOOP ;                                                 : CREATE1 BL WORD DUP DUP 1+ C@ 0 = ABORT" ATTEMPTED TO REDEFINE  NULL" DUP CONTEXT @ @ <FIND> IF DDROP WARNING @ IF DUP COUNT    TYPE SPACE ." ISN'T UNIQUE" THEN THEN HERE DUP C@ WIDTH @ MIN   1+ ALLOT DUP A0 TOGGLE HERE 1 - 80 TOGGLE LATEST , CURRENT @    ! HERE 2+ , DDROP  ;                                          : <BUILDS  CREATE ;                                             DECIMAL                                                         ( ASSEMBLER -- SINGLE REGISTER DEFINITIONS      CRC VER = 57759)HEX                                                             VARIABLE .REG1   VARIABLE .REG2                                 VARIABLE .PFX                                                   : (.REGDEF) .REG1 @ .REG2 ! .REG1 ! ;                           : .REGDEF <BUILDS ,                                                       DOES>   @ (.REGDEF) ;                                 0 WARNING ! ( TO HALT ERROR MESSAGES WHEN LOADING)              10 .REGDEF B     11 .REGDEF C     12 .REGDEF D                  13 .REGDEF E     14 .REGDEF H     15 .REGDEF L                  16 .REGDEF (HL)  17 .REGDEF A                                   : .IX DD .PFX ! ;    : .IY FD .PFX ! ;                          : (IX) (HL) .IX ;  : (IY) (HL) .IY ;                            1 WARNING !                                                     DECIMAL                                                                                                                         ( ASSEMBLER -- DBL & SPEC. REG DEFINITIONS      CRC VER = 12864)HEX                                                             20 .REGDEF BC    21 .REGDEF DE    22 .REGDEF HL                 23 .REGDEF SP    23 .REGDEF AF                                  : IX HL .IX ;    : IY HL .IY ;                                  30 .REGDEF (BC)  31 .REGDEF (DE)                                40 .REGDEF II    48 .REGDEF R                                   50 .REGDEF (SP)                                                 60 .REGDEF ()                                                   70 .REGDEF AF'   71 .REGDEF (C)                                 80 .REGDEF NZ    84 .REGDEF PO                                  81 .REGDEF Z     85 .REGDEF PE                                  82 .REGDEF NC    86 .REGDEF P                                                    87 .REGDEF M                                   : (ENDOP) 0 .REG1 ! 0 .REG2 ! 0 .PFX ! ;                        DECIMAL                                                         ( ASSEMBLER -- HELPER FUNCTIONS                 CRC VER = 21834)HEX                                                             : AERROR? SWAP F0 AND <> IF 31 ERROR THEN ;                     : (IPFX) .PFX @ ?DUP IF C, THEN ;                               : (IOFFSET) .PFX @                                                          IF   DUP -128 < OVER 127 > OR                                        IF 32 ERROR THEN                                                C, THEN ;                                      : (ZPFX) ED C, ;                                                : (LSHIFT) SWAP ?DUP IF 0 DO DUP + LOOP THEN ;                  : (REG1) .REG1 @ 0F AND (LSHIFT) ;                              : (REG2) .REG2 @ 0F AND (LSHIFT) ;                              : RREG? 10 AERROR? ;    : ZREG? 40 AERROR? ;                    : RPREG? 20 AERROR? ;   : (SP)? 50 AERROR? ;                    : (RPREG)? 30 AERROR? ; : (NN)? 60 AERROR? ;                    DECIMAL                                                         ( ASSEMBLER -- LD                               CRC VER = 58163)HEX                                                             : (LDS,S) .REG1 @ 16 = .REG2 @ 16 = AND                                   IF 31 ERROR THEN                                                .REG1 @ RREG? (IPFX)                                            40 3 (REG2) OR 0 (REG1) OR C,                                   (IOFFSET) ;                                           : (LDA,?) .REG1 @ F0 AND                                            CASE 10 OF (LDS,S) ENDOF                                             30 OF 0A 4 (REG1) OR C, ENDOF                                   40 OF (ZPFX) 57 0 (REG1) OR C, ENDOF                            60 OF 3A C, , ENDOF                                             31 ERROR                                                   ENDCASE ;                                                                                                                   DECIMAL                                                         ( ASSEMBLER -- LD CONTINUED                     CRC VER = 17327)HEX                                                             : (LDRP,?) .REG2 @                                                  CASE 22 OF .REG1 @ 60 =                                                    IF (IPFX) 2A C, ,                                               ELSE 31 ERROR THEN ENDOF                                  23 OF .REG1 @                                                         CASE 22 OF (IPFX) F9 C, ENDOF                                        60 OF (ZPFX) 7B C, , ENDOF                                            31 ERROR ENDCASE ENDOF                               .REG1 @ (NN)? (ZPFX)                                            4B 4 (REG2) OR C, SWAP ,                             ENDCASE ;                                                   : (LDZ,?) .REG1 @ 17 =                                                    IF (ZPFX) 47 0 (REG2) OR C,                                     ELSE 31 ERROR THEN ;   DECIMAL                        ( ASSEMBLER -- LD CONTINUED                     CRC VER = 13416)HEX                                                             : (LD(NN),?) .REG1 @                                                CASE 17 OF 32 C, , ENDOF                                             22 OF (IPFX) 22 C, , ENDOF                                            .REG1 @ RPREG?                                                  (ZPFX) 43 4 (REG1) OR C, SWAP ,                      ENDCASE ;                                                   : (LD?,N) .REG1 @ F0 AND                                            CASE 10 OF (IPFX) 06 3 (REG1) OR C,                                        .PFX @ IF SWAP C, THEN                                          C, ENDOF                                                  20 OF (IPFX) 01 4 (REG1) OR C, , ENDOF                                31 ERROR                                             ENDCASE ;                                                   DECIMAL                                                         ( ASSEMBLER -- LD CONTINUED                     CRC VER = 44666)HEX                                                             : (LD(RP),?) .REG1 @ 17 =                                                  IF 02 4 (REG2) OR C,                                            ELSE 31 ERROR THEN ;                                 DECIMAL                                                                                                                         EXIT                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ( ASSEMBLER -- LD CONTINUED                     CRC VER = 64437)HEX                                                             : LD, .REG2 @ F0 AND                                                CASE  0 OF (LD?,N) ENDOF                                             10 OF .REG2 @ 17 =                                                    IF (LDA,?)                                                      ELSE (LDS,S) THEN ENDOF                                   20 OF (LDRP,?) ENDOF                                            30 OF (LD(RP),?) ENDOF                                          40 OF (LDZ,?) ENDOF                                             60 OF (LD(NN),?) ENDOF                                                31 ERROR ENDCASE                                        (ENDOP) ;                                                DECIMAL                                                                                                                                                                                         ( ASSEMBLER -- POP & PUSH                       CRC VER = 13075)HEX                                                             : (POPPUSH) .REG1 @ RPREG?                                                  (IPFX) 4 (REG1) OR C,                                           (ENDOP) ;                                                                                                           : POP, C1 (POPPUSH) ;                                           : PUSH, C5 (POPPUSH) ;                                                                                                          DECIMAL                                                                                                                         EXIT                                                                                                                                                                                                                                                                                                                            ( ASSEMBLER -- ADC & SBC                        CRC VER = 59517)HEX                                                             : (ADCSBC) .REG2 @ FF AND                                           CASE  0 OF .REG1 @ 17 =                                                    IF DROP 46 OR C, C,                                             ELSE 31 ERROR THEN ENDOF                                  17 OF .REG1 @ RREG?                                                   DROP (IPFX) 0 (REG1) OR                                         C, (IOFFSET) ENDOF                                        22 OF .REG1 @ RPREG?                                                  .PFX @ IF 31 ERROR THEN                                         SWAP DROP (ZPFX) 4 (REG1) OR C,                                 ENDOF                                                           31 ERROR                                             ENDCASE                                                                 (ENDOP) ;    DECIMAL                                ( ASSEMBLER -- ADC & SBC CONTINUED, ADD         CRC VER = 38654)HEX                                                             : ADC, 88 4A (ADCSBC) ;                                         : SBC, 98 42 (ADCSBC) ;                                         : ADD, .REG2 @ 22 =                                                    IF .REG1 @ RPREG?                                                  (IPFX) 09 4 (REG1) OR C, (ENDOP)                             ELSE 80 0 (ADCSBC) THEN ;                                DECIMAL                                                                                                                         EXIT                                                                                                                                                                                                                                                                                                                                                                                            ( ASSEMBLER -- A OPERATIONS                     CRC VER = 24956)HEX                                                             : (AOP) .REG2 @ IF 31 ERROR THEN                                        .REG1 @ ?DUP                                                    IF RREG? (IPFX) 0 (REG1) OR C, (IOFFSET)                        ELSE 46 OR C, C, THEN                                           (ENDOP) ;                                               : AND, A0 (AOP) ;                                               : CP, B8 (AOP) ;                                                : OR, B0 (AOP) ;                                                : SUB, 90 (AOP) ;                                               : XOR, A8 (AOP) ;                                                                                                               DECIMAL                                                                                                                                                                                         ( ASSEMBLER -- BIT OPERATIONS                   CRC VER = 56578)HEX                                                             : (BITOP) .REG2 @ IF 31 ERROR THEN                                        .PFX @ IF ROT ELSE SWAP THEN                                    DUP -1 > OVER 9 < AND                                           IF   (IPFX) CB C,                                                    .PFX @ IF ROT C, THEN                                           3 SWAP (LSHIFT) OR                                              0 (REG1) OR C,                                             ELSE 32 ERROR THEN                                              (ENDOP) ;                                             : BIT, 40 (BITOP) ;                                             : RES, 80 (BITOP) ;                                             : SET, C0 (BITOP) ;                                                                                                             DECIMAL                                                         ( ASSEMBLER -- OPS WITH NO OPERANDS             CRC VER = 17104)HEX                                                             : DEFOP <BUILDS C, DOES> @ C, (ENDOP) ;                         : DEFZOP <BUILDS C, DOES> (ZPFX) @ C, (ENDOP) ;                 3F DEFOP CCF,      BA DEFZOP INDR,                              A9 DEFZOP CPD,     A2 DEFZOP INI,                               B9 DEFZOP CPDR,    B2 DEFZOP INIR,                              A1 DEFZOP CPI,     A8 DEFZOP LDD,                               B1 DEFZOP CPIR,    B8 DEFZOP LDDR,                              2F DEFOP CPL,      A0 DEFZOP LDI,                               27 DEFOP DAA,      B0 DEFZOP LDIR,                              F3 DEFOP DI,       44 DEFZOP NEG,                               FB DEFOP EI,        0 DEFOP NOP,                                D9 DEFOP EXX,      AB DEFZOP OUTD,                              76 DEFOP HALT,     BB DEFZOP OTDR,                              AA DEFZOP IND,     A3 DEFZOP OUTI,   DECIMAL                    ( ASSEMBLER -- OPS WITH NO OPERAND CONTINUED    CRC VER = 65355)HEX                                                             B3 DEFZOP OTIR,                                                 4D DEFZOP RETI,                                                 45 DEFZOP RETN,                                                 17 DEFOP RLA,                                                   07 DEFOP RLCA,                                                  6F DEFZOP RLD,                                                  1F DEFOP RRA,                                                   0F DEFOP RRCA,                                                  67 DEFZOP RRD,                                                  37 DEFOP SCF,                                                                                                                   DECIMAL                                                                                                                                                                                         ( ASSEMBLER -- INC & DEC                        CRC VER = 29940)HEX                                                             : (INCDEC) .REG2 @ IF 31 ERROR THEN                                        .REG1 @ F0 AND                                           CASE 10 OF DROP (IPFX) 3 (REG1) OR C,                                      (IOFFSET) ENDOF                                           20 OF SWAP DROP (IPFX) 4 (REG1) OR C,                                 ENDOF                                                           31 ERROR                                             ENDCASE                                                                 (ENDOP) ;                                           : DEC, 05 0B (INCDEC) ;                                         : INC, 04 03 (INCDEC) ;                                                                                                         DECIMAL                                                                                                                         ( ASSEMBLER -- EX                               CRC VER = 18693)HEX                                                             : EX, .REG2 @                                                       CASE 23 OF .REG1 @ 70 =                                                    IF 08 C, ELSE 31 ERROR THEN                                     ENDOF                                                     21 OF .REG1 @ 22 =                                                    IF EB C, ELSE 31 ERROR THEN                                     ENDOF                                                     50 OF .REG1 @ 22 =                                                    IF (IPFX) E3 C, ELSE ERROR THEN                                 ENDOF                                                           31 ERROR                                             ENDCASE                                                         (ENDOP) ;                                                   DECIMAL                                                         ( ASSEMBLER -- IM                               CRC VER = 16065)HEX                                                             : IM, CASE 0 OF 46 ENDOF                                                   1 OF 56 ENDOF                                                   2 OF 5E ENDOF                                                        32 ERROR                                              ENDCASE                                                         (ZPFX) C, (ENDOP) ;                                       DECIMAL                                                                                                                         EXIT                                                                                                                                                                                                                                                                                                                                                                                            ( ASSEMBLER -- IN                               CRC VER = 3473 )HEX                                                             : IN, .REG1 @                                                       CASE 60 OF .REG2 @ 17 =                                                    IF DB C, C, ELSE 31 ERROR THEN                                  ENDOF                                                     71 OF .REG2 @ RREG?                                                   (ZPFX) 40 3 (REG2) OR C,                                        ENDOF                                                ENDCASE                                                            (ENDOP) ;                                                DECIMAL                                                                                                                         EXIT                                                                                                                                                                                            ( ASSEMBLER -- OUT                              CRC VER = 50691)HEX                                                             : OUT, .REG2 @                                                      CASE 60 OF .REG1 @ 17 =                                                    IF D3 C, C, ELSE 31 ERROR THEN                                  ENDOF                                                     71 OF .REG1 @ RREG?                                                   (ZPFX) 41 3 (REG1) OR C,                                        ENDOF                                                ENDCASE                                                            (ENDOP) ;                                                DECIMAL                                                                                                                         EXIT                                                                                                                                                                                            ( ASSEMBLER -- SHIFTS AND ROTATES               CRC VER = 59387)HEX                                                             : (SHIFT) .REG2 @ IF 31 ERROR THEN                                        .REG1 @ RREG?                                                   (IPFX) CB C,                                                    .PFX @ IF SWAP C, THEN                                          0 (REG1) OR C,                                                  (ENDOP) ;                                             : RL, 10 (SHIFT) ;                                              : RLC, 0 (SHIFT) ;                                              : RR, 18 (SHIFT) ;                                              : RRC, 08 (SHIFT) ;                                             : SLA, 20 (SHIFT) ;                                             : SRA, 28 (SHIFT) ;                                             : SRL, 38 (SHIFT) ;                                             DECIMAL                                                         ( ASSEMBLER -- RST                              CRC VER = 3386 )HEX                                                             : RST, .REG1 @ .REG2 @ OR                                              IF 31 ERROR THEN                                                DUP DUP 38 AND =                                                IF   C7 OR C,                                                   ELSE 32 ERROR THEN                                              (ENDOP) ;                                                DECIMAL                                                                                                                         EXIT                                                                                                                                                                                                                                                                                                                                                                                            ( ASSEMBLER -- CALL & JP                        CRC VER = 35700)HEX                                                             : (CALLJP) .REG2 @ IF 33 ERROR THEN                                        .REG1 @                                                         IF   SWAP DROP .REG1 @ 11 =                                          IF 83 .REG1 ! THEN                                              3 (REG1) OR C,                                             ELSE DROP C,                                                    THEN , (ENDOP) ;                                     : CALL, CD C4 (CALLJP) ;                                        : JP, .REG1 @ 16 =                                                    IF   .REG2 @ IF 33 ERROR THEN                                        (IPFX) E9 C, (ENDOP)                                       ELSE C3 C2 (CALLJP)                                             THEN ;                                                    DECIMAL                                                         ( ASSEMBLER -- JR                               CRC VER = 20296)HEX                                                             : (JR) HERE - 1- DUP                                                   -128 < OVER 127 > OR                                            IF 32 ERROR THEN                                                C, (ENDOP) ;                                             : JR, .REG2 @ IF 33 ERROR THEN                                        .REG1 @                                                       CASE  0 OF 18 ENDOF                                                  80 OF 20 ENDOF                                                  81 OF 28 ENDOF                                                  82 OF 30 ENDOF                                                  11 OF 38 ENDOF                                                        33 ERROR                                             ENDCASE                                                           C, (JR) ;  DECIMAL                                        ( ASSEMBLER -- DJNZ & RET                       CRC VER = 48671)HEX                                                             : DJNZ, .REG1 @ .REG2 @ OR IF 33 ERROR THEN                             10 C, (JR) ;                                                                                                            : RET, .REG2 @ IF 33 ERROR THEN                                        .REG1 @ 11 = IF 83 .REG1 ! THEN                                 .REG1 @                                                         IF   C0 3 (REG1) OR                                             ELSE C9                                                         THEN                                                            C, (ENDOP) ;                                             DECIMAL                                                                                                                         EXIT                                                                                                                            ( ASSEMBLER -- CONTROL FUNCTIONS                CRC VER = 13676)HEX                                                             VARIABLE (ASTACK) 20 ALLOT                                      VARIABLE (AINDEX)                                               : (APUSH) (AINDEX) @ DUP 20 > IF 34 ERROR THEN                            (ASTACK) + ! 2 (AINDEX) +! ;                          : (APOP) (AINDEX) @ DUP                                                  IF   2- DUP (AINDEX) ! (ASTACK) + @                             ELSE 35 ERROR                                                   THEN ;                                                 : IF, 0 JP, HERE 2- (APUSH) ;                                   : THEN, HERE (APOP) ! ;                                         : ELSE, 0 JP, THEN, (APOP) !                                            HERE 2- (APUSH) ;                                       DECIMAL                                                                                                                         ( ASSEMBLER -- CONTROL FUNCTIONS CONTINUED      CRC VER = 39399)HEX                                                             : DO, HERE (APUSH) ;                                            : LOOP, (APOP) DJNZ, ;                                          : BEGIN, HERE (APUSH) ;                                         : UNTIL, (APOP) JP, ;                                           : WHILE, 0 .REG1 @ 11 IF 83 .REG1 ! THEN                                 .REG1 @ 1 XOR .REG1 !                                           0 JP, HERE 2- (APUSH) ;                                : REPEAT, (APOP) (APOP) SWAP JP, HERE SWAP ! ;                                                                                  DECIMAL                                                                                                                         EXIT                                                                                                                                                                                            ( ASSEMBLER -- FORTH VOCABULARY INTERFACE       CRC VER = 46556)HEX                                                                                                                             : NEXT,  (APOP) CONTEXT !                                                C3 C, 144 , SMUDGE ;                                                                                                   0 CONSTANT ASMTOP                                               HERE ' ASMTOP !                                                 DP ! ( RESET DICT POINTER TO VALUE BEFORE ASM )                 FORTH DEFINITIONS                                               : CODE  [ ASSEMBLER ] CONTEXT @ ASSEMBLER                               (ENDOP) 0 (AINDEX) ! (APUSH) CREATE1 ;                  FORTH DEFINITIONS DECIMAL