\ OK - Load Screen                                    20sep83mcs4 load        \ FPLS jedec                                      exit                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            \ FPLS - Load Screen for JEDEC of compiler            20sep83mcsBLK @ LIST                                                      1 2 +THRU                       \ Errors & FPLS                 12 22 +THRU                     \ TEXT file through .COM                                                                        SAVE-SYSTEM                                                     256 HERE CP/M SAVE FPLS.COM                                                                                                     CR CR   ." System Saved as PFLS.COM"                                                                                            EXIT                                                                                                                              This screen loads the FPLS compiler. The resulting fuse map   is transmitted to a DATA I/O PLDS module in JEDEC format via    a Morrow SWITCHBOARD.                                                                                                           \ ABORT ABORT" FATAL"                                 28jan83mcsVARIABLE ERRORS                                                 : ABORT ( -- ) CR CR ." Aborted" CR  3 EXECUTE ;                : (ABORT")  ( f -- ) IF CR CR  7 EMIT  ." Error --> "              ASCII " EMIT  HERE COUNT TYPE ASCII " EMIT  SPACE               R COUNT TYPE  ."  <RET> to continue, <ESC> to abort. "          BEGIN KEY DUP 27 = IF ABORT THEN 13 = UNTIL CR                  1 ERRORS +!  THEN    R> COUNT + >R  ;                        : ABORT" ( -- ) ?COMP  COMPILE (ABORT")                            ASCII " WORD C@ 1+ ALLOT ; IMMEDIATE                         : (FATAL") ( f -- ) IF R COUNT TYPE ABORT THEN                     R> COUNT + >R ;                                              : FATAL" ( -- ) ?COMP  COMPILE (FATAL")                            ASCII " WORD C@ 1+ ALLOT ; IMMEDIATE                                                                                                                                                         \ FPLS COMPILER - Load Screen                         28jan83mcsBLK @ LIST   1 5 +THRU   EXIT                                                                                                   Declare Inputs ( input number or pin number )                   Declare States ( STATE name - assigned in order declared )      Declare Outputs ( output number e.g. F0 or pin number e.g. 14. )Define Terms   ( TERM name    input    / input  )               Define Comp    ( COMP name )                                    Define Products                                                    SET state                                                       CLR state                                                       SET output                                                      CLR output                                                                                                                                                                                                                                                   \ FPLS COMPILER - MAP MAPSIZE ADDR BLOW MEND FPLS.    20sep83mcs0  CONSTANT  MAP                                                74 48 *  CONSTANT  MAPSIZE                                      0000  CONSTANT  DEVCD                                                                                                           : ADDR ( row col -- addr ) 74 *  +  MAP + ;                                                                                     : BLOW ( row col -- ) ADDR  1 SWAP  C! ;                                                                                        : MEND ( row col -- ) ADDR  0 SWAP  C! ;                                                                                        : FPLS.                                                            CR  74 0 DO  I 4 .R  4 SPACES                                   48 0 DO  I  8 MOD  0=  IF SPACE THEN                               J  47 I -  ADDR C@  IF 1 ELSE 0 THEN  0 .R  LOOP  CR         ?KEY  IF LEAVE THEN  LOOP  CR DECIMAL ;                      \ FPLS COMPILER - ?TERMS ?STATES ?ORGATE              20sep83mcsVARIABLE TERM#               VARIABLE NSTATES                   VARIABLE INVERT              VARIABLE ORGATE                                                                                    : ?TERMS  ( -- ) TERM# @     DUP 0<   SWAP 48 < NOT   OR           ABORT" Term Number Range Error" ;                                                                                            : ?STATES ( -- ) NSTATES @   DUP 0<   SWAP 6 < NOT   OR            ABORT" State Number Range Error" ;                                                                                           : ?ORGATE ( -- ) ORGATE @    DUP 45 <   SWAP 74 < NOT   OR         ABORT" Output Number Range Error" ;                                                                                          : .STATE ." Terms = " TERM# ?  ." States = " NSTATES ?             ." Orgates = " ORGATE ? CR ;                                                                                                 \ FPLS COMPILER - FACTOR INPUT STATE TERM OUTPUT      18sep83mcs                                                                : FACTOR  ?TERMS  INVERT @ +  0 INVERT !  TERM# @  MEND ;                                                                       : INPUT  ( N --- ) ( NAME ) CREATE ,  DOES>  @  FACTOR ;                                                                        : TERM    1 TERM# +!   ?TERMS   45 0 DO I TERM# @ BLOW LOOP       CREATE  TERM# @ ,   DOES>  @  ?ORGATE  ORGATE @ SWAP MEND ;                                                                   : STATE  ( N --- ) ( NAME ) CREATE ,                               DOES> @  14 -  FACTOR ;                                                                                                      : OUTPUT  ( N --- ) ( NAME ) CREATE , DOES>                        ABORT" User In SET or RST Expression" ;                                                                                                                                                      \ FPLS COMPILER - SET/CLR SET CLR COMP INITIALIZE     19sep83mcs                                                                : SET/CLR  [COMPILE] '   @  +  ORGATE ! ?ORGATE                     TERM# @ 1+  0 DO ORGATE @ I BLOW LOOP ;                                                                                     : SET 0 SET/CLR ;                                                                                                               : CLR 1 SET/CLR ;                                                                                                               : COMP  CREATE 45 , DOES> @ 1 - FACTOR ;                                                                                        : INITIALIZE -1 TERM# !  -1 NSTATES !  0 INVERT !                   0 ORGATE !  MAP  MAPSIZE  ERASE ;                           DECIMAL                                                                                                                                                                                         \ FPLS VOCABULARY                                     19sep83mcs: DEVICE-TYPE ( n -- ) CREATE   ,                                  DOES> @ [ BLK @ ] LITERAL + LOAD   INITIALIZE ;              VOCABULARY FPLS   IMMEDIATE   FPLS DEFINITIONS                  : STATE ( -- ) STATE ;                                          : TERM  ( -- ) TERM ;                                           : SET   ( -- ) SET ;                                            : CLR   ( -- ) CLR ;                                            : /     ( -- ) 1 INVERT ! ;                                     : +     ( -- ) ;                                                : *     ( -- ) ;                                                : NC    ( -- ) ;                                                : =     ( -- ) ;                                                1 DEVICE-TYPE 82S104            3 DEVICE-TYPE 82S100            1 DEVICE-TYPE 82S105            3 DEVICE-TYPE 82S101            FORTH DEFINITIONS                                               \ 82S104 82S105                                       19sep83mcs                                                                : I0   0 INPUT ;                : I1   2 INPUT ;                : I2   4 INPUT ;                : I3   6 INPUT ;                : I4   8 INPUT ;                : I5  10 INPUT ;                : I6  12 INPUT ;                : I7  14 INPUT ;                : I8  16 INPUT ;                : I9  18 INPUT ;                : I10 20 INPUT ;                : I11 22 INPUT ;                : I12 24 INPUT ;                : I13 26 INPUT ;                : I14 28 INPUT ;                : I15 30 INPUT ;                                                                                : F0  58 OUTPUT ;               : F1  60 OUTPUT ;               : F2  62 OUTPUT ;               : F3  64 OUTPUT ;               : F4  66 OUTPUT ;               : F5  68 OUTPUT ;               : F6  70 OUTPUT ;               : F7  72 OUTPUT ;               -->                                                             \ 82S104 82S105                                       20sep83mcs                                                                : P0   46 STATE ;               : P1   48 STATE ;               : P2   50 STATE ;               : P3   52 STATE ;               : P4   54 STATE ;               : P5   56 STATE ;                                                                               9603  ' DEVCD !                                                                                                                                                                                 EXIT                                                                                                                                                                                                                                                                                                                                                                                                                                                            \ 82S100 82S101                                      119sep83mcs                                                                : I0   0 INPUT ;                : I1   2 INPUT ;                : I2   4 INPUT ;                : I3   6 INPUT ;                : I4   8 INPUT ;                : I5  10 INPUT ;                : I6  12 INPUT ;                : I7  14 INPUT ;                : I8  16 INPUT ;                : I9  18 INPUT ;                : I10 20 INPUT ;                : I11 22 INPUT ;                : I12 24 INPUT ;                : I13 26 INPUT ;                : I14 28 INPUT ;                : I15 30 INPUT ;                                                                                : F0  58 OUTPUT ;               : F1  60 OUTPUT ;               : F2  62 OUTPUT ;               : F3  64 OUTPUT ;               : F4  66 OUTPUT ;               : F5  68 OUTPUT ;               : F6  70 OUTPUT ;               : F7  72 OUTPUT ;               -->                                                             \ 82S100 82S101                                      119sep83mcs                                                                : P0   46 STATE ;               : P1   48 STATE ;               : P2   50 STATE ;               : P3   52 STATE ;               : P4   54 STATE ;               : P5   56 STATE ;                                                                               EXIT                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            \ TEXT-LINE                                           20sep83mcs 92 CONSTANT FCB1                                               128 CONSTANT BUF                                                VARIABLE EOF   : END ( -- ) 1 EOF ! ;                           : CH>PAD ( C --- ) >IN @ PAD + C!  1 >IN +! ;                   : ERROR ( -- ) 1 ABORT" is undefined." ;                        : INTERPRET ( -- )                                                 BEGIN -FIND IF DROP EXECUTE ELSE ERROR THEN AGAIN ;          : INTERP ( -- ) PAD TIB @ >IN @ CMOVE                              0 >IN !  INTERPRET  (  .state ) ;                            : TEXT-LINE ( -- )                                                PAD >IN @ ( -TRAILING ) TYPE CR                                 0 CH>PAD   0 CH>PAD   INTERP   0 >IN ! ;                      : TAB ( -- ) 8  >IN @  OVER  MOD  -  0 DO BL CH>PAD LOOP ;                                                                                                                                      \ TEXT-BUF                                            09NOV82MCS: TEXT-BUF ( -- ) BUF 128 RANGE DO                                 I C@  127 AND ( MASK 8 BIT )  DUP BL < IF ( CTL )                 DUP 13 = IF ( CR  ) TEXT-LINE        ELSE                       DUP  9 = IF ( TAB ) TAB              ELSE                       DUP 26 = IF ( EOF ) TEXT-LINE  1 EOF ! LEAVE ELSE                               DROP THEN THEN THEN  ELSE ( PRINTABLE )         DUP ASCII ; = IF 0 CH>PAD CH>PAD ELSE                           DUP 127 < IF ( NOT DELETE ) CH>PAD ELSE DROP                         THEN THEN THEN EOF @ IF LEAVE THEN LOOP ;             EXIT                                                              SEND PRINTABLE CHARACTERS TO PAD. EXPAND TABS. EXECUTES       TEXT-LINE AT END OF LINE ( CR ). CTL Z DOES TEXT-LINE, THEN SETSEND OF FILE AND LEAVES. OTHER CONTROL CHARACTERS ARE DROPPED.                                                                                                                                   \ DOS-FNC FCBQ BUF FILE-TYPE ...                      09NOV82MCS 92 CONSTANT FCB1                                               128 CONSTANT BUF                                                : DOS-FNC (   n --   ) CREATE , DOES>                                     ( arg -- f )   @  FCB @ SWAP  BDOS ;                  20 DOS-FNC SEQ-READ                                             21 DOS-FNC SEQ-WRITE                                            19 DOS-FNC DELETE                                               22 DOS-FNC MAKE                                                 16 DOS-FNC CLOSE                                                15 DOS-FNC OPEN                                                 : FILE-TYPE ( -- addr ) FCB @  9 + ;                                                                                                                                                                                                                                                                                            \ Morrow SWITCHBOARD                                  20sep83mcsHEX                                                               00 CONSTANT DATA                                                02 CONSTANT STAT                                                08 CONSTANT TBE                                                    VARIABLE CHECKSUM                                          : PROG-EMIT ( c -- )                                               DUP (EMIT)                                                      DUP CHECKSUM +!                                                 BEGIN  ?KEY IF KEY 1B = ABORT" Aborted" THEN                    STAT P@ TBE AND UNTIL                                           DATA P! ;                                                                                                                    : PON  ( -- ) ['] PROG-EMIT IS EMIT ;                           : POFF ( -- ) ['] (EMIT)    IS EMIT ;                           DECIMAL                                                         \ JEDEC file                                          20sep83mcs: ARRAY ( N -- ) ( NAME )                                         CREATE  2* ALLOT  DOES> SWAP 2* + ;                           8 ARRAY CHKSUMS                                                 : ####. ( n -- ) 0 <# # # # # #> TYPE ;                         : NSEND ( addr n -- )                                              RANGE DO   I MAP +  C@                                             IF  1  I  7 AND  CHKSUMS +!  ." 1"                              ELSE                         ." 0"  THEN  LOOP  CR ;      : SEND-DATA ( -- ) ['] CHKSUMS 16 ERASE                            0 BEGIN   DUP   MAPSIZE   <  WHILE                                 DUP   200 MOD   0= IF ." *L"   DUP ####.  SPACE  CR  THEN       MAPSIZE   OVER   -   20 MIN   2DUP NSEND   +   REPEAT ;   : SUM-CHECK ( -- n )                                               0  -1 7 DO  2*  I CHKSUMS @  +  -1 +LOOP ;                                                                                   \ JEDEC file                                          20sep83mcd: STX     2 EMIT ( ." STX" )  ;                                 : ETX     3 EMIT ( ." ETX" )  ;                                                                                                 : SEND-JEDEC ( -- )                                                0 CHECKSUM !   DECIMAL     PON                                  STX      CR       ( Design identifier )                         ." *D"   DEVCD  ####.           ( Device identifier )           ." *F0"  CR                     ( Default Value )            \    ." *G0"  SPACE  CR              ( Protect fuse )              SEND-DATA                       ( Fuse data )                   ." *C"  HEX   SUM-CHECK    ####.   CR ( Data sum-check )        ." *"   ETX                     ( End of checked stream )       CHECKSUM @   ####.    POFF ;    ( Message checksum )                                                                                                                                         \ WRITE-FILE                                          18sep83mcsexit                                                            : WRITE-FILE ( -- )  FCB1 FCB !  FILE-TYPE 28 ERASE                " BIN" FILE-TYPE SWAP CMOVE   ( Insert default output type )    DELETE DROP ( Remove any old output file )                      MAKE CPM-ERR? FATAL" File Make Error" ( Make file & check )     MAP 1792 RANGE DO                                                 I SET-DMA  SEQ-WRITE CPM-ERR? FATAL" Disk Write Error"       128 +LOOP  CLOSE CPM-ERR? FATAL" File Close Error"              ." Binary File Written" CR CR ;                                                                                                                                                                                                                                                                                                                                                                                                                               \ OPEN-SOURCE READ-FILE APPL                          28jan83mcs: NAME. ( addr -- ) CR ." Source File = "  DUP C@ ?DUP IF          [ ASCII A 1- ] LITERAL + EMIT ." :" THEN 1+                     DUP 8 -TRAILING TYPE  ." ." 8 + 3 -TRAILING TYPE CR CR ;     : OPEN-SOURCE ( -- ) FCB1 FCB !                                    FILE-TYPE 28 ERASE                                              " TXT" FILE-TYPE SWAP CMOVE  FCB @ NAME.                        OPEN-FILE CPM-ERR? FATAL" File Open Error" ;                 : READ-FILE ( -- ) 0 >IN !   0 EOF !                               BEGIN  BUF SET-DMA  FCB1 FCB !  SEQ-READ                        EOF @  OR  NOT WHILE TEXT-BUF REPEAT ;                       EXIT                                                                                                                                                                                                                                                                                                                            \ APPL                                                20sep83mcs: PATCH ( -- ) " FPLS    BLK"  ['] DEFAULT 3 +   SWAP CMOVE ;                                                                   : APPL ( -- )                                                      ['] DROP IS WARN   80 ['] C/L !                                 HERE ['] MAP !   MAPSIZE ALLOT                                  OPEN-SOURCE    [COMPILE] FPLS DEFINITIONS   READ-FILE           ERRORS @ NOT IF  FPLS.  SEND-JEDEC  THEN                        CR ." Errors = "  ERRORS ?  CR  3 EXECUTE ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  \ SIGN-ON                                             20sep83mcs: SIGN-ON ( -- )                                                   24 0 DO CR LOOP                                                 ." FPLS Logic Compiler  - Version 3.0"  CR CR                   ."    JEDEC format to DATA I/O FPLS"  CR                        ."    On Morrow Designs SWITCHBOARD" CR CR                      ." Copyright 1983 by Michael Stolowitz"  CR CR ;                                                                             : (QUIT) 0 BLK !  [COMPILE]  [  RP!  APPL  3 EXECUTE  ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                         \ COLD for RAM system   TASK                          20sep83mcsHEX                                                             : COLD                                                             12 +ORIGIN 22 +ORIGIN @ 6 + 10 CMOVE                            FIRST USE !   FIRST PREV !                                      INIT-VEC  SP!  SIGN-ON                                          0C +ORIGIN @ ['] FORTH !    0 OFFSET !  EMPTY-BUFFERS           ['] DROP IS WARN   ['] NOOP IS WHERE                            0 FILES !   PATCH  ( DEFAULT-FILE )                             FORTH DEFINITIONS DECIMAL                                       ['] (QUIT) IS QUIT  QUIT ;                                   DECIMAL                                                         ' COLD CFA  ' TASK 2+ !  ( BYE )