Power-Programmierung/CD1.mdf/forth/compiler/f83/basic.blk

Text File | 1985-02-09 | 18KB | 1 lines

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \ BASIC compiler                                      06Feb84mapONLY FORTH ALSO DEFINITIONS                                     : .R  RP0 @ RP@ ?DO  I @ 2- @ >NAME .ID  2 +LOOP ;              VOCABULARY ARITHMETIC   ARITHMETIC ALSO DEFINITIONS             VOCABULARY LOGIC   VOCABULARY INPUTS   VOCABULARY OUTPUTS       : [   ASCII ] WORD DROP ;  IMMEDIATE                            : GET   BL WORD NUMBER DROP  ;                                  CREATE #S  130 ALLOT                                            FORTH DEFINITIONS                                               1 2 +THRU   ( precedence and variables )                        : BASIC  [ ARITHMETIC ]  0 #S 2+ #S 2!  START ALSO ; IMMEDIATE  ARITHMETIC DEFINITIONS                                          3 7 +THRU   ( BASIC )                                           : (   10 #( +! ;  IMMEDIATE                                     : ;   [ n]   . ;   1 PRECEDENCE ;                               FORTH DEFINITIONS                                               \ Precedence                                          06Feb84mapVARIABLE ADDRESS   VARIABLE #(                                  : )   -10 #( +!  #( @ 0< ABORT" Unmatched )" ;  IMMEDIATE       : DEFER  ( a n a n - a n)  #( @ +                                  BEGIN  2OVER NIP OVER  >= WHILE   2SWAP DROP  ,  REPEAT ;    : PRECEDENCE  (  n)   >IN @  ' >R  >IN !  CONSTANT  R> ,           IMMEDIATE  DOES>  2@  DEFER ;                                : RPN  ( n)  0 1 DEFER  2DROP  #( @ OR  ABORT" Syntax" ;        : ?IGNORE   #( @  IF  0 1 DEFER  2DROP  R> DROP  THEN ;                                                                         : NOTHING  ;                                                    : START ( - n)   0 #( !  0 ADDRESS !  ['] NOTHING 0                ARITHMETIC  ;                                                                                                                                                                                                                                                \ Variables                                           06Feb84map: INTEGER   VARIABLE  IMMEDIATE  DOES>  [COMPILE] LITERAL          ADDRESS @ IF  ADDRESS OFF  ELSE  COMPILE @  THEN ;                                                                           : (ARRAY) ( a a)  SWAP >R   7 DEFER  R> [COMPILE] LITERAL          ADDRESS @ IF ADDRESS OFF ELSE  ['] @  7 #( @ +  2SWAP  THEN ;                                                                : [+] ( a i - a)   1- 2* + ;                                    : ARRAY   INTEGER  1- 2* ALLOT   DOES>  ['] [+] (ARRAY) ;                                                                       : [*+] ( a x y - a)   >R  1-  OVER @ *  R> +  2* + ;            : 2ARRAY ( y x)   DUP CONSTANT  IMMEDIATE  * 2* ALLOT              DOES>  ['] [*+] (ARRAY) ;                                                                                                                                                                                                                                    \ Statement numbers  ( works at any address )         06Feb84map: FIND ( line# -- entry-adr )   TRUE  #S @ #S 2+                   ?DO  OVER I @ ABS = IF  2DROP I FALSE LEAVE  THEN  4 +LOOP      IF  0 SWAP  #S @ 2!  #S @  4 #S +!  THEN ;                   : RESOLVE ( n -- )   FIND  DUP @  0< ABORT" duplicated"            DUP @ NEGATE OVER !   2+ DUP @                                  BEGIN  ?DUP  WHILE  DUP @  HERE ROT !  REPEAT  HERE SWAP ! ;                                                                 : CHAIN ( n - a)   FIND  LENGTH 0<                                 IF  @   ELSE  DUP @  HERE ROT !  THEN ;                                                                                      : STATEMENT ( n -- )   HERE 2- @ >R  -4 ALLOT  RPN EXECUTE         R> RESOLVE  START ;                                                                                                                                                                                                                                          \ Branching - high level                              13Mar84map                                                                : JUMP   R> @ >R ;                                              : CALL   R> DUP @ SWAP 2+ >R >R ;                               : SKIP   0= IF  R> 4 + >R  THEN ;                               : (NEXT)                                                           2DUP +!  >R 2DUP R> @ SWAP                                      0< IF  SWAP  THEN -                                             0< IF  2DROP R> 2+  ELSE  R> @  THEN  >R ;                                                                                   : [1]      COMPILE 1  HERE ;                                    : [NEXT]   COMPILE (NEXT) , ;                                   : (GOTO)   GET  COMPILE JUMP  CHAIN , ;                         : (RET)    R> DROP ;                                                                                                                                                                            \ BASIC                                               19Jul84map: LET   STATEMENT  ADDRESS ON ; IMMEDIATE                       : FOR   [COMPILE] LET ;  IMMEDIATE                              : TO    RPN DROP  ['] [1] 0 ;  IMMEDIATE                        : STEP  RPN DROP  ['] HERE 0 ;  IMMEDIATE                       : NEXT  STATEMENT 2DROP ['] [NEXT] 0   ADDRESS ON ; IMMEDIATE   : REM   STATEMENT  [COMPILE] \  ; IMMEDIATE                     : DIM   [COMPILE] REM ; IMMEDIATE                               : STOP  STATEMENT  COMPILE (RET) ; IMMEDIATE                    : END   STATEMENT 2DROP [COMPILE] ; PREVIOUS FORTH ; IMMEDIATE  : GOTO   STATEMENT  (GOTO) ;  IMMEDIATE                         : IF     STATEMENT  LOGIC ;  IMMEDIATE                          : THEN   RPN 0  COMPILE SKIP  (GOTO) ; IMMEDIATE                : RETURN   STATEMENT  COMPILE (RET)  ; IMMEDIATE                : GOSUB  STATEMENT  GET  COMPILE CALL  CHAIN ,  ; IMMEDIATE                                                                     \ Input and Output                                    06Feb84map: ASK   ." ? "  QUERY ;                                         : PUT   GET  SWAP ! ;                                           : (INPUT)   COMPILE PUT ;                                       : (,) ( n)   (.)  14 OVER - SPACES  TYPE SPACE ;                OUTPUTS DEFINITIONS                                             : , ( n)   ?IGNORE  ['] (,)  1 DEFER  ;  IMMEDIATE              : "   [COMPILE] ."  2DROP ;  IMMEDIATE                          INPUTS DEFINITIONS                                              : ,   ?IGNORE  RPN 0  (INPUT)  ADDRESS ON ;  IMMEDIATE                                                                          ARITHMETIC DEFINITIONS                                          : PRINT   STATEMENT  COMPILE CR  ['] (,) 1 OUTPUTS ; IMMEDIATE  : INPUT   STATEMENT  2DROP  COMPILE ASK  ['] (INPUT) 0  INPUTS     ADDRESS ON ;  IMMEDIATE                                                                                                      \ Operators                                           06Feb84mapLOGIC DEFINITIONS                                               2 PRECEDENCE <>   2 PRECEDENCE <=   2 PRECEDENCE >=             2 PRECEDENCE =    2 PRECEDENCE <    2 PRECEDENCE >                                                                              ARITHMETIC DEFINITIONS                                          : = ( a n)   SWAP ! ;   1 PRECEDENCE =                          : ** ( n n - n)   1  SWAP 1 DO  OVER * LOOP  * ;                6 PRECEDENCE ABS                                                5 PRECEDENCE **                                                 4 PRECEDENCE *   4 PRECEDENCE /   4 PRECEDENCE */               3 PRECEDENCE +   3 PRECEDENCE -                                                                                                                                                                                                                                                                                                 \ [ Dwyer, page 17, Program 1]   ( works )            06Feb84mapINTEGER J   INTEGER K                                                                                                           : RUN   BASIC                                                   10 PRINT " THIS IS A COMPUTER"                                  20 FOR K = 1 TO 4                                               30 PRINT " NOTHING CAN GO"                                      40 FOR J = 1 TO 3                                               50 PRINT " WRONG"                                               60 NEXT J                                                       70 NEXT K                                                       80 END                                                                                                                          RUN                                                                                                                                                                                             \ [ basic: branching demo ]   ( works )               06Feb84mapINTEGER J   INTEGER K                                                                                                           : RUN   BASIC                                                   10 FOR K = 1 TO 15 STEP 3                                       15 LET J = J + K                                                20 IF K >= 8 THEN 35                                            25 PRINT K                                                      30 GOTO 40                                                      35 PRINT K , J , " SUM "                                        40 NEXT K                                                       50 PRINT " DONE  "                                              80 END                                                                                                                          RUN                                                                                                                             \ [ basic: array demo ]  ( works )                    06Feb84mapINTEGER K   9 ARRAY COORDINATE                                                                                                  : RUN   BASIC                                                   10 FOR K = 1 TO 9                                               20 LET COORDINATE K = ( 10 - K ) ** 3                           40 PRINT COORDINATE K + 5                                       60 NEXT K                                                       80 END                                                                                                                          RUN                                                                                                                                                                                                                                                                                                                                                                                             \  [ basic string printing demo ]                     06Feb84mapINTEGER X  INTEGER Y  INTEGER Z                                                                                                 : RUN   BASIC                                                   10 LET X = 5                                                    20 LET Y = 7                                                    30 PRINT  X ,   Y                                               60 PRINT X , " TEST "                                           90 END                                                                                                                          RUN                                                                                                                                                                                                                                                                                                                                                                                             \ [ basic program # 1 ]  ( works )                    06Feb84mapINTEGER K  INTEGER X  3 ARRAY Z                                                                                                 : RUN   BASIC                                                   10 LET Z 1 = 1                                                  15 LET Z 2 = 22                                                 20 LET Z 3 = 333                                                30 FOR K = 1 TO 3                                               40 LET X = Z K                                                  50 PRINT X                                                      60 NEXT K                                                       80 END                                                                                                                          RUN                                                                                                                                                                                             \ [ basic inputting demo ]                            06Feb84mapINTEGER K  INTEGER X  INTEGER Y                                                                                                 : RUN   BASIC                                                   10 INPUT X , Y                                                  20 LET K = X * Y ** 3                                           40 PRINT X , Y , K                                              80 END                                                                                                                          RUN                                                                                                                                                                                                                                                                                                                                                                                                                                                             \ [ basic: GOSUB demo ]                               19Jul84mapINTEGER K                                                       9 ARRAY COORDINATE                                                                                                              : RUN   BASIC                                                   10 FOR K = 1 TO 9                                               20 LET COORDINATE K = 10 - K                                    30 GOSUB 60                                                     40 NEXT K                                                       50 GOTO 80                                                      60 PRINT COORDINATE K                                           70 RETURN                                                       80 END