home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / f83 / extend86.blk < prev    next >
Text File  |  1985-02-09  |  31KB  |  1 lines

  1. \               The Rest is Silence                   03Apr84map*************************************************************   *************************************************************   ***                                                       ***   ***    Please direct all questions, comments, and         ***   ***    miscellaneous personal abuse to:                   ***   ***                                                       ***   ***    Henry Laxen          or    Michael Perry           ***   ***    1259 Cornell Avenue        1125 Bancroft Way       ***   ***    Berkeley, California       Berkeley, California    ***   ***    94706                      94702                   ***   ***                                                       ***   *************************************************************   *************************************************************                                                                                                                                   ( Load Screen to Bring up Standard System             07Apr84map)   CR  .( Loading system extensions.)  CR                      2 VIEW# !    ( This will be view file# 2 )                      WARNING OFF                                                                                                                       3 LOAD    ( BASICS )                                            6 LOAD    ( FILE-INTERFACE )                                    FROM CPU8086.BLK    1 LOAD ( Machine Dependent Code )           FROM UTILITY.BLK    1 LOAD ( Standard System Utilities )                                                                      WARNING ON                                                      -->                                                                                                                                                                                                                                                                                                                             \ Load up the system                                  08MAY84HHL: HELLO   (S -- )                                                  CR ." 8086 Forth 83 Model "                                     CR ." Version 2.1.0 Modified 01Jun84 "                          START   ONLY FORTH ALSO DEFINITIONS   ;                      ' HELLO IS BOOT                                                 \ 13 LOAD   ( Configuration: change and load as desired. )                                                                      : MARK    (S -- )                                                  CREATE    DOES> (FORGET)  FORTH DEFINITIONS  ;               MARK EMPTY     HERE FENCE !                                                                                                     CR .( System has been loaded, Size = ) HERE U.                  SAVE-SYSTEM F83.COM                                             CR .( System saved as F83.COM )                                                                                                 ( Commenting and Loading Words                        16Oct83map)                                                               64 CONSTANT C/L                                                 16 CONSTANT L/SCR                                               : \   ( -- )     >IN @ NEGATE  C/L MOD  >IN +!  ; IMMEDIATE     : (S  ( -- )     [COMPILE] (   ;   IMMEDIATE                    : ?   (S adr -- )   @ .   ;                                     : ?ENOUGH   (S n -- )                                              DEPTH 1- >   ABORT" Not enough Parameters"   ;               : THRU   (S n1 n2 -- )                                             2 ?ENOUGH   1+ SWAP ?DO   I LOAD   LOOP   ;                  : +THRU   (S n1 n2 -- )                                            BLK @ + SWAP   BLK @ + SWAP   THRU   ;                       : -->      (S -- )                                                 >IN OFF   1 BLK +!   ;   IMMEDIATE                           1 2 +THRU   ( Rest of Basic Utilities )                         \ The ALSO and ONLY Concept                           07Feb84mapCONTEXT DUP @ SWAP 2+ !   ( Make FORTH also )                   VOCABULARY ROOT   ROOT DEFINITIONS                              : ALSO   (S -- )                                                   CONTEXT DUP 2+ #VOCS 2- 2* CMOVE>   ;                        : ONLY   (S -- )                                                   ['] ROOT >BODY  CONTEXT #VOCS 1- 2* 2DUP ERASE + !  ROOT ;   : SEAL   (S -- )                                                   ' >BODY   CONTEXT #VOCS 2* ERASE   CONTEXT !   ;             : PREVIOUS   (S -- )                                               CONTEXT DUP 2+ SWAP #VOCS 2- 2* CMOVE                           CONTEXT #VOCS 2- 2* + OFF   ;                                                                                                                                                                                                                                                                                                \ The ALSO and ONLY Concept                           06Apr84map: FORTH   FORTH ;                                               : DEFINITIONS   DEFINITIONS   ;                                 : ORDER   (S -- )                                                  CR ." Context: " CONTEXT   #VOCS 0 DO   DUP @ ?DUP IF              BODY> >NAME .ID THEN   2+ LOOP DROP                          CR ." Current: " CURRENT @ BODY> >NAME .ID    ;              : VOCS   (S -- )                                                   ." : "   VOC-LINK @                                             BEGIN   DUP #THREADS 2* - BODY> >NAME .ID  @ DUP 0=             UNTIL   DROP   ;                                             ONLY FORTH ALSO DEFINITIONS                                                                                                                                                                                                                                                                                                     \ Load Screen for DOS Interface                       07Apr84mapDOS DEFINITIONS    1 6 +THRU   FORTH DEFINITIONS                CR .( File Interface Loaded )  \S                               The DOS interface consists of a set of words that access the    BDOS functions of DOS, such as making, opening, and deleting    files.  There is also a word that parses a string and creates   a file control block.  Finally the word SAVE can be used to     save the contents of memory as a DOS file.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      \ DOS Interface                                       10Apr84mapCREATE FCB2   B/FCB ALLOT                                       : RESET    (S -- )   0  13 BDOS DROP ;                          : CLOSE    (S fcb -- )                                             16 BDOS DOS-ERR? ABORT" Close error"  ;                      : SEARCH0  (S fcb -- n )   17 BDOS ;                            : SEARCH   (S fcb -- n )   18 BDOS ;                            : DELETE   (S fcb -- n )   19 BDOS ;                            : READ     (S fcb -- )                                             20 BDOS DOS-ERR? ABORT" Read error"  ;                       : WRITE    (S fcb -- )                                             21 BDOS DOS-ERR? ABORT" Write error"  ;                      : MAKE-FILE   (S fcb -- )                                          22 BDOS DOS-ERR? ABORT" Can't MAKE File "  ;                                                                                                                                                 \ Create File Control Blocks                          19Apr84map: (!FCB)          (S Addr len FCB-addr --- )                       DUP B/FCB ERASE   DUP 1+ 11 BLANK                               >R  OVER 1+ C@ ASCII : =                                        IF   OVER C@ [ ASCII A 1- ] LITERAL -  R@ C!   2 /STRING        THEN   R> 1+ -ROT 0                                             DO   DUP C@ ASCII . =                                             IF   SWAP 8 I - +                                               ELSE   2DUP C@ SWAP C!   SWAP 1+  THEN  SWAP 1+               LOOP 2DROP   ;                                               : !FCB   (S FCB-addr )                                             BL WORD COUNT  CAPS @ IF  2DUP UPPER  THEN  ROT  (!FCB)  ;   : SELECT   (S drive -- )                                           ( DUP 9 BIOS 0= ABORT" Illegal drive " )  14 BDOS  DROP ;                                                                                                                                    \ Save a Core Image as a File on Disk                 06Apr84map\ : CPM86-HEADER   (S -- )                                      \    [ HEX ]   80 80 ERASE   1 80 C!   10 82 C!   10 86 C!      \    80 SET-DMA   FCB2 DUP WRITE                                \    80 80 ERASE  DUP WRITE WRITE   [ DECIMAL ]   ;             DEFER HEADER   ' NOOP IS HEADER                                 : SAVE   (S Addr len --- )                                         FCB2 DUP !FCB  DUP DELETE DROP  DUP MAKE-FILE -ROT  HEADER      BOUNDS ?DO  I SET-DMA  DUP WRITE  128 +LOOP  CLOSE  ;        FORTH DEFINITIONS                                               : MORE   (S n -- )   [ DOS ]                                       1 ?ENOUGH  CAPACITY SWAP   DUP 8* FILE @ MAXREC# +!  BOUNDS     ?DO  I BUFFER B/BUF BLANK UPDATE  LOOP                          SAVE-BUFFERS  FILE @ CLOSE  ;                                : CREATE-FILE   (S #blocks -- )                                    [ DOS ]  FCB2 DUP !FILES  DUP !FCB  MAKE-FILE  MORE  ;       \ Display Directory                                   13Apr84mapDOS DEFINITIONS                                                 : .NAME   (S n -- )                                                #OUT @ C/L > IF CR THEN  32 * PAD + 1+                          8 2DUP TYPE SPACE + 3 TYPE 3 SPACES  ;                       FORTH DEFINITIONS                                               : DIR   (S -- )   [ DOS ]                                          " ????????.???" FCB2 (!FCB)                                     CR  PAD SET-DMA  FCB2 SEARCH0                                   BEGIN  .NAME  FCB2 SEARCH  DUP DOS-ERR? UNTIL  DROP  ;       : DRIVE?   (S -- )   0 25 BDOS ASCII A + EMIT ." : "  ;         : A:   (S -- )   [ DOS ]  0 SELECT ;                            : B:   (S -- )   [ DOS ]  1 SELECT ;                            DOS DEFINITIONS                                                                                                                                                                                 \ Define and Open files                               04Apr84map: FILE:   (S -- fcb )                                              >IN @   CREATE   >IN !   HERE DUP   B/FCB ALLOT   !FCB          DOES>  !FILES  ;                                             : ?DEFINE   (S -- fcb )                                            >IN @  DEFINED                                                  IF   NIP >BODY   ELSE   DROP  >IN ! FILE:   THEN  ;          FORTH DEFINITIONS                                               : DEFINE  (S -- )   [ DOS ]  ?DEFINE  DROP  ;                   : OPEN    (S -- )   [ DOS ]  ?DEFINE  !FILES     OPEN-FILE  ;   : FROM    (S -- )   [ DOS ]  ?DEFINE  IN-FILE !  OPEN-FILE  ;   : SAVE-SYSTEM   (S -- )                                            [ DOS HEX ] 100 HERE SAVE  ;  DECIMAL                                                                                                                                                                                                                        \ Viewing Source Screens                              08MAY84HHLCREATE VIEW-FILES   32 ALLOT  VIEW-FILES 32 ERASE               : VIEWS   (S n -- )   [ DOS ]                                      ?DEFINE 2DUP  40 + !   BODY> SWAP 2* VIEW-FILES + !  ;                                                                       1 VIEWS KERNEL86.BLK                                            2 VIEWS EXTEND86.BLK                                            3 VIEWS CPU8086.BLK                                             4 VIEWS UTILITY.BLK                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             \ My normal configuration                             07Apr84mapCAPS ON                                                         ' EPSON IS INIT-PR                                              ' FORM-FEED IS PAGE                                             ' (WHERE) IS WHERE                                              EDITOR QUME FORTH                                                                                                               5 VIEWS CLOCK.BLK                                               FROM CLOCK.BLK 1 LOAD                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           ( Load Screen to Bring up Standard System             04Apr84map)                                                               This is set so that definitions in this file can be VIEWed.     BASICS  are needed by everything else.                          FILE-INTERFACE  allows convenient use of files.                 CPU8080.BLK   Contains all of the 8080 machine dependent stuff     such as the Assembler, the Debug Utility which patches          NEXT, and the MultiTasker, which needs some code words in       order to function efficiently.                               UTILITY.BLK    Contains all of the standard utilities that are     usually resident in a Forth system, such as the editor, the     decompiler, a print utility, etc.                                                                                                                                                                                                                                                                                            \ Load up the system                                  07Apr84mapHELLO   (S -- )                                                    Gives the user the sign on message, making him foolishly        believe that he is running an 83 Standard System.  It also      does all of the one time start up code required, such as        relocating the heads and opening the screen file, if any.    Load configuration. Personalize here.                                                                                           MARK    (S -- )                                                    A Defining word that allows you to restore the dictionary       to a known state.                                            EMPTY   The current state of the dictionary.                                                                                                                                                                                                                                                                                    ( Commenting and Loading Words                        25Jul83map)                                                               C/L   The number of characters per line.                        L/SCR The number of lines per screen.                           \     A comment word.  Ignores the rest of the line             (S    Used for Stack Comments.  Behaves just like (             ?     Displays the contents of an address.                      ?ENOUGH   (S n -- )                                                Issue an error message if too few parameters on the stack.   THRU   (S n1 n2 -- )                                               Load a bunch of screens.                                     +THRU   (S n1 n2 -- )                                              Load a bunch of screens relative to the current screen.      -->      (S -- )                                                   Load the next screen.                                                                                                        \ The ALSO and ONLY Concept                           03Apr84map                                                                ROOT   A small vocabulary for controlling search order.         ALSO   (S -- )                                                     Adds another vocabulary to the search order.                 ONLY                                                               Erases the search order and forces the ROOT vocabulary to be    the first and last.                                          SEAL   Usage: SEAL FORTH will change the search order such that    only FORTH will be searched. Used for turn-key applications. PREVIOUS                                                           The inverse of ALSO, removes the most recently referenced       vocabulary from the search order.                                                                                                                                                                                                                            \ The ALSO and ONLY Concept                           03Apr84mapWe initialize the ROOT vocabulary with a few definitions that   allow us to do vocabulary related things.                       ORDER   (S -- )                                                    Displays the search order currently in effect.  Also displays   the CURRENT vocabulary, which is were definitions are placed.                                                                VOCS   (S -- )                                                     Lists all of the vocabularies that have been defined so far,    in the order of their definition.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            \ DOS BDOS Interface                                  10Apr84mapFCB2   Space for a second FCB when needed.                      RESET  Reset the DOS disk system                                CLOSE  Close the given file,  and report errors.                                                                                SEARCH0   Search for the first occurance                        SEARCH    Search for the next occurance.                        DELETE  Remove an old file.                                     READ    Read the next sequential record, and report errors.                                                                     WRITE   Write the next sequential record,  and report errors.                                                                   MAKE-FILE  create a directory entry for a new file,               and report errors.                                                                                                                                                                            \ Create File Control Blocks                          11Apr84map(!FCB)          (S Addr len FCB-addr --- )                         Set up the filce control block per the specified string.        This is the primitive file parse word, which breaks the         drive/file name string into a drive specifier, file name,       and extension, and leaves the parsed result in the given        file control block address.                                                                                                                                                                  !FCB   (S FCB-addr )                                               Parse the next word in the input stream as a file.              If CAPS is false, allow lower case names.                    SELECT   make given drive the default.                                                                                                                                                                                                                          \ Save a Core Image as a File on Disk                 22FEB84MAPHEADER   This is different for CP/M-80, CP/M-86, and CP/M-68K.                                                                                                                                  SAVE   (S addr len -- )                                            Save the string specified as a CP/M file whose name is          specified following the SAVE word.  The current screen          file is not disturbed.                                                                                                       MORE   Extend the size of the current file by n Blocks.                                                                                                                                                                                                         CREATE-FILE  creates a new file containing the given number       of blocks.                                                                                                                    \ Display Directory                                   13Apr84map                                                                .NAME  prints one filename.                                                                                                                                                                     DIR  prints a directory of the current dirve.                                                                                                                                                                                                                                                                                   DRIVE?  prints currently selected drive.                        A:  selects drive A as the default.                             B:  selects drive B as the default.                                                                                                                                                                                                                             \ Open files and list directories                     29Mar84mapFILE:   (S -- fcb )                                                Define the next word as a file by allocating an FCB in the      dictionary and parsing the next word as a file name.            Leave the address of the file control block.                 ?DEFINE   (S -- fcb )                                              Define the next word as a file if it does not already exist.    Leave the address of the file control block.                 DEFINE   (S -- )                                                   Define the following word as a file name without opening it. OPEN     (S -- )                                                   Open the following file and make it the current file.        FROM     (S -- )                                                   Open the following file and make it the current input file.  SAVE-SYSTEM   (S -- )  Usage:  SAVE-SYSTEM NEWNAME.68K            Saves an executable image of the system as a file.            \ Set up VIEW-FILES table                             07Apr84mapVIEW-FILES  is an array of pointers to fcbs.                    VIEWS  installs a file into the VIEW-FILES array, and sets the    fcb to contain the matching view number.                      Now initialize the VIEW-FILES array:                            KERNEL86.BLK  was used to generate the precompile code.         EXTEND86.BLK  was opened on the execute line, loads all extras. CPU8086.BLK  has the machine dependent post-compile code.       UTILITY.BLK  has the machine independent post-compile code.