( Load Screen to Bring up Standard System 1/19/89 ) CR .( Loading system extensions.) CR 4 VIEW# ! WARNING OFF 3 LOAD ( BASICS ) \ : NLOAD ( n -- ) DUP . (LOAD) ; ' NLOAD IS LOAD 4 5 THRU 6 LOAD 16 18 THRU WARNING ON CR .( System has been loaded, Size = ) HERE U. SAVE-SYSTEM TEMP.DAT TEMP.COM CR .( System saved as TEMP.COM ) CR .( Now type BYE<cr>. Then TEMP<cr>, OPEN QUICK4.BLK OK <cr>) CR .( Finally BYE ) ( Commenting and Loading Words 6/21/88 ) 64 CONSTANT C/L 16 CONSTANT L/SCR : \ ( -- ) >IN @ NEGATE C/L MOD >IN +! ; IMMEDIATE : (S ( -- ) [COMPILE] ( ; IMMEDIATE : ? ( adr -- ) @ . ; : THRU ( n1 n2 -- ) 2 ?ENOUGH 1+ SWAP ?DO I LOAD LOOP ; : +THRU ( n1 n2 -- ) BLK @ + SWAP BLK @ + SWAP THRU ; : --> ( -- ) >IN OFF 1 BLK +! ; IMMEDIATE : INPUT BL WORD NUMBER DROP ; \ The ALSO and ONLY Concept 2 /21/88CONTEXT DUP @ SWAP 2+ ! ( Make FORTH also ) VOCABULARY ROOT ROOT DEFINITIONS : ALSO ( -- ) CONTEXT DUP 2+ #VOCS 2- 2* CMOVE> ; : ONLY ( -- ) ['] ROOT >BODY CONTEXT #VOCS 1- 2* 2DUP ERASE + ! ROOT ; \ : SEAL ( -- ) \ ' >BODY CONTEXT #VOCS 2* ERASE CONTEXT ! ; : PREVIOUS ( -- ) CONTEXT DUP 2+ SWAP #VOCS 2- 2* CMOVE CONTEXT #VOCS 2- 2* + OFF ; \ The ALSO and ONLY Concept 2 /21/88: FORTH FORTH ; : DEFINITIONS DEFINITIONS ; : ORDER ( -- ) CR ." Context: " CONTEXT #VOCS 0 DO DUP @ ?DUP IF BODY> >NAME .ID THEN 2+ LOOP DROP CR ." Current: " CURRENT @ BODY> >NAME .ID ; : VOCS ( -- ) CR VOC-LINK @ BEGIN DUP #THREADS 2* - BODY> >NAME .ID @ DUP 0= UNTIL DROP ; ONLY FORTH ALSO DEFINITIONS \ Load Screen for DOS Interface 2 /21/881 9 +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 2 /21/88DOS DEFINITIONS VARIABLE 'PATH \ flag for window updating : RESET ( -- ) 0 13 BDOS DROP ; : SELECT ( drive -- ) 'PATH ON ( DUP 9 BIOS 0= ABORT" Illegal drive " ) 14 BDOS DROP ; FORTH DEFINITIONS : A: ( -- ) [ DOS ] 0 SELECT ; : B: ( -- ) [ DOS ] 1 SELECT ; : C: ( -- ) [ DOS ] 2 SELECT ; : D: ( -- ) [ DOS ] 3 SELECT ; : .DRIVE ( -- ) [ DOS ] GET-DRIVE EMIT ." : " ; \ Save a Core Image as a File on Disk 2 /21/88DOS DEFINITIONS : >FILE ( file -- ) CLOSE-BOTH DUP !FILES OPEN-FILE ; : FILE: ( -- file ) >IN @ >R HOPEN ( handle ) DUP CLOSE R@ >IN ! CREATE HERE DUP 8 DUP ALLOT ERASE ( file ) R> >IN ! BL WORD C@ 1+ ALLOT TUCK 1+ ! DOES> >FILE ; : ?DEFINE ( -- file ) >IN @ DEFINED IF NIP >BODY ELSE DROP >IN ! FILE: THEN ; \ Define and Open files 2 /21/88FORTH DEFINITIONS : DEFINE ( -- ) [ DOS ] ?DEFINE DROP ; : OPEN ( -- ) [ DOS ] ?DEFINE >FILE ; : FROM ( -- ) [ DOS ] ?DEFINE DUP IN-FILE ! OPEN-FILE ; : REOPEN ( -- ) [ DOS ] CLOSE-FILE FILE @ OPEN-FILE ; : MORE ( n --) CAPACITY SWAP BOUNDS OVER 255 U> ABORT" too big" ?DO I BLOCK B/BUF BLANK UPDATE LOOP FLUSH REOPEN ; : FCREATE ( -- handle ) [ DOS ] BL WORD COUNT >ASCIZ 0 FCREAT .ERROR ; : CREATE-FILE ( #blocks -- ) [ DOS ] >IN @ >R FCREATE CLOSE R> >IN ! OPEN MORE ; \ Extended DOS Calls 2 /21/88DOS DEFINITIONS : @TO-HANDLE ( -- h ) FILE @ HANDLE ; : @IN-HANDLE ( -- h ) IN-FILE @ HANDLE ; VARIABLE LCOMMAND VARIABLE RETURNED : LDOS ( addr seg # handle -- ) LCOMMAND @ (LDOS) .ERROR RETURNED ! ; : >READ ( -- ) $3F00 LCOMMAND ! ; : >WRITE ( -- ) $4000 LCOMMAND ! ; : DOS32K ( addr seg h -- ) $8000 SWAP LDOS ; : +32K ( n1 n2 -- n1+32K n2 ) $800 + ; ONLY FORTH DEFINITIONS ALSO DOS ALSO : FILE-TYPE ( addr len -- ) DUP #OUT +! @TO-HANDLE (DOS-TYPE) ; DOS DEFINITIONS \ READ AND WRITE BIG FILES TO FAR MEMORY 2 /21/88: @HANDLE LCOMMAND @ $3F00 = ( READ? ) IF @IN-HANDLE ELSE @TO-HANDLE THEN ; : DO-32K @HANDLE DOS32K +32K ; : BIGDOS ( addr seg d#bytes -- ) SWAP >R >R BEGIN R@ WHILE 2DUP DO-32K 2DUP DO-32K R> 1- >R REPEAT R> DROP R> @HANDLE LDOS ; VARIABLE C/B ( character buffer ) FORTH DEFINITIONS ALSO DOS ALSO : LREAD ( addr seg d# -- ) >READ BIGDOS ; : LWRITE ( addr seg d# -- ) >WRITE BIGDOS ; : C-READ ( -- c ) C/B CSEG 1 @IN-HANDLE >READ LDOS C/B C@ ; : C-WRITE ( c -- ) C/B C! C/B CSEG 1 @TO-HANDLE >WRITE LDOS ; \ SAVE-SYSTEM 6 /21/88: LSAVE ( Addr seg len --- ) [ DOS ] FCREATE DUP >R >WRITE LDOS R> CLOSE ; CREATE HEAD.FILE 50 ALLOT : SAVE-SYSTEM ( -- ) [ DOS ] 0 HEAD-SEG DP-HEAD @ LSAVE HEAD.FILE 50 ERASE \ HEAD-SEG >R 0 ['] HEAD-SEG >BODY ! ( MARK TO RESTORE ) 'WORD COUNT HEAD.FILE PLACE 256 CSEG DP-BODY @ 256 - LSAVE ( R> ['] HEAD-SEG >BODY !) ; DOS DEFINITIONS : (LOAD.HEADS) ( addr seg -- ) HEAD.FILE 1+ 2 FOPEN .ERROR DUP >R FILE-SIZE ABORT" Heads too big" R@ >READ LDOS R> CLOSE ; : LOAD.HEADS ( HEAD-SEG 0= IF) 0 HEAD-SEG (LOAD.HEADS) ( THEN) ; FORTH DEFINITIONS \ Viewing Source Screens 2 /21/88255 CONSTANT MAX-VIEW CREATE VIEW-FILES HERE MAX-VIEW 1+ 2* DUP ALLOT ERASE : !VIEW ( n file -- ) [ DOS ] 2DUP 2+ ! BODY> SWAP 2* VIEW-FILES + ! ; : VIEWS ( n -- ) [ DOS ] ?DEFINE !VIEW ; VARIABLE NEXT-VIEW 1 NEXT-VIEW ! : VIEW++ ( -- view ) NEXT-VIEW @ DUP MAX-VIEW > IF ." No more view-file space " DROP 0 THEN 1 NEXT-VIEW +! ; : VISA VIEW++ VIEWS ; VISA KERNEL86.BLK VISA IO.SCR VISA KDOS.SCR VISA EXTEND.SCR \ Viewing Source Screens 2 /21/88: INCLUDE ( -- ) [ DOS ] FROM VIEW++ IN-FILE @ DUP >R !VIEW 1 LOAD R> HANDLE CLOSE ; : ?SET-DRIVE ( a n -- a' n' ) [ DOS ] 2DUP 1 > SWAP 1+ C@ ASCII : = AND IF OVER C@ ASCII A - SELECT 2 /STRING THEN ; : (.PATH) ( -- addr len ) \ fetch just path to pad [ DOS ] PAD 50 + 0 GETDIR .ERROR DROP PAD 50 + DUP ZLENGTH ; : .PATH \ type path name [ DOS ] GET-DRIVE EMIT ." :\" (.PATH) TYPE ; : CD ( -- ) [ DOS ] BL WORD C@ IF 'WORD COUNT ?SET-DRIVE DUP IF >ASCIZ CHDIR .ERROR 'PATH ON ELSE DROP THEN DROP ELSE .PATH THEN ; \ DIR 2 /21/88VARIABLE (BIG?) 2VARIABLE DIR-TOT DEFER ?CR ' NOOP IS ?CR : UPDATE-TOT ( -- d ) PAD 26 + LENGTH SWAP @ 2DUP DIR-TOT 2@ D+ DIR-TOT 2! ; : SET-DTA ( a -- ) 26 BDOS DROP ; : .NAME ( -- ) [ DOS ] ?CR PAD 30 + TYPEZ 15 #OUT @ 15 MOD - SPACES ; : (DIR) [ DOS ] PAD SET-DTA 0. DIR-TOT 2! >ASCIZ 16 FIND1 BEGIN WHILE DROP .NAME UPDATE-TOT (BIG?) @ IF 11 D.R CR ELSE 2DROP THEN FIND+ REPEAT DROP CR 10 SPACES ." TOTAL" DIR-TOT 2@ 11 D.R ; : ?DIR ( -- ) BL WORD ?UPPERCASE C@ IF HERE COUNT ELSE " *.*" THEN CR (DIR) ; : DIR (BIG?) ON ?DIR ; : DIR/W (BIG?) OFF ?DIR ; \ Load Standard Utilities 3 /16/88DEFER BLOT DEFER -LINE DEFER AT DEFER DARK : IBM ['] IBM-AT IS AT ['] IBM-DARK IS DARK ['] DOS-TYPE IS TYPE ; IBM INCLUDE ASM86.SCR INCLUDE UTIL.SCR INCLUDE NEED.BLK INCLUDE MULTI.SCR INCLUDE DUMP.SCR INCLUDE EDITOR.TST ONLY FORTH ALSO DEFINITIONS INCLUDE SEE.SCR INCLUDE SHOW.SCR \ INCLUDE DEBUG.SCR INCLUDE CLOCK.SCR \ My normal configuration 2 /21/88CAPS ON ' EPSON IS INIT-PR ' FORM-FEED IS PAGE \ Load up the system 2 /21/88NEED @INT NEED FOR.ME NEED DATE.FOOT : HELLO ( -- ) EMPTY-BUFFERS ONLY FORTH ALSO DEFINITIONS $103 CSEG $23 @INT D= NOT IF START $103 CSEG $23 !INT ( CONTROL-C WARM START ) $1000 FOR.ME $1000 [ALLOCATE:] HEAD-SEG [ DOS ] LOAD.HEADS THEN ; ' HELLO IS BOOT : MARK ( -- ) CREATE DOES> BODY> >VIEW (FORGET) FORTH DEFINITIONS ; MARK EMPTY DP-HEAD @ FENCE ! ( Load Screen to Bring up Standard System 2/21/88 ) This is set so that definitions in this file can be VIEWed. BASICS are needed by everything else. ( Commenting and Loading Words 2/21/88 ) 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 ( n -- ) Issue an error message if too few parameters on the stack. THRU ( n1 n2 -- ) Load a bunch of screens. +THRU ( n1 n2 -- ) Load a bunch of screens relative to the current screen. --> ( -- ) Load the next screen. \ The ALSO and ONLY Concept 2 /21/88 ROOT A small vocabulary for controlling search order. ALSO ( -- ) 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 2 /21/88We initialize the ROOT vocabulary with a few definitions that allow us to do vocabulary related things. ORDER ( -- ) Displays the search order currently in effect. Also displays the CURRENT vocabulary, which is were definitions are placed. VOCS ( -- ) Lists all of the vocabularies that have been defined so far, in the order of their definition. 2 /21/88 Load the dos interface \ DOS Interface 2 /21/88 RESET reset dos interface SELECT ( drive -- ) select the current default drive A: B: make these the current default drive C: D: .DRIVE print which drive is current \ Save a Core Image as a File on Disk 2 /21/88 >FILE ( file -- ) make file the default for read and write FILE: ( -- file ) create a FORTH file name for an existing file on disk Later invocation of the name will make it the default ?DEFINE ( -- file ) return the file for the following name, if no FORTH file name exists, then create it. \ Define and Open files 2 /21/88 DEFINE user word to FORTH name an exsisting dos file OPEN do DEFINE and open the file FROM only open from file REOPEN close & open - used for positioning file pointer to 0 MORE ( n --) add n more blocks to the current file FCREATE ( -- handle ) create a dos file with the following name CREATE-FILE ( #blocks -- ) create a dos file, make a FORTH name, and open it \ Extended DOS Calls 2 /21/88 @TO-HANDLE ( -- h ) fetch the to file's handle @IN-HANDLE ( -- h ) LCOMMAND a place to save the current LDOS command LDOS ( addr seg # handle -- ) execute a dos command >READ note that following LDOS commands will do READs >WRITE " " " " " " " WRITEs DOS32K ( addr seg h -- ) do a 32K LDOS +32K ( n1 n2 -- n1+32K n2 ) internal primitive : FILE-TYPE ( addr len -- ) type to the current to-file \ READ AND WRITE BIG FILES TO FAR MEMORY 2 /21/88@HANDLE return the current handle DO-32K do 32K part of a file BIGDOS ( addr seg d#bytes -- ) a version of LDOS that supports >64K files C/B a single character buffer LREAD ( addr seg d# -- ) read from file to memory LWRITE ( addr seg d# -- ) write to file from memory C-READ ( -- c ) read next character from from-file C-WRITE ( c -- ) write character to to file \ SAVE-SYSTEM 2 /21/88LSAVE ( Addr seg len --- ) save the data to a file of the following name ( <64K ) HEAD.FILE where the head file name is kept SAVE-SYSTEM save the system to disk. The first name following is the head file, the second name is the .COM ( NUL is allowed for heads ) (LOAD.HEADS) given a location in memory ( addr & seg ) load the heads from disk using the name stored in HEAD.FILE LOAD.HEADS load the heads into the head segment \ Viewing Source Screens 2 /21/88MAX-VIEW how many view files there can be VIEW-FILES array of the currently viewable files !VIEW ( n file -- ) given a number and a file, add it to the view-files array VIEWS ( n -- ) assign the following file to view-files NEXT-VIEW the next available view number VIEW++ ( -- view ) retrieve the next view number bumping up next-view VISA assign the following file the next view number \ Viewing Source Screens 2 /21/88INCLUDE load starting from screen 1 of the following file ?SET-DRIVE remove drive selection from string and make it the default (.PATH) ( -- addr len ) fetch just path to pad .PATH type path name CD ( -- ) similar to dos CD \ DIR 2 /21/88(BIG?) DIR-TOT temp variables ?CR allow for right margin checking in CR UPDATE-TOT ( -- d ) find file length and add to total SET-DTA just like it sounds (ref: a good dos book) .NAME print a file name (DIR) given a string to match, print a dir ?DIR ( -- ) do a dir DIR a normal dir DIR/W like dos's /w option \ Load Standard Utilities 2 /21/88BLOT -LINE primitive screen handlers AT DARK IBM default for big blue now we need to load a bunch of other files \ My normal configuration 2 /21/88I like all caps on boot up I also have an EPSON printer which uses a form feed for a form feed \ Load up the system 2 /21/88 a few other requirements HELLO the hello message this is what is used to say. MARK allow for forgetting back to a mark'ed pointer EMPTY set here as the empty point
