( Electives source code file 11/03/83 ) Copyright (c) 1983 Ray Duncan, Laboratory Microsystems Inc. This file is provided for PC/FORTH users who wish to create a smaller runtime system by removing some of the auxiliary functions. First edit screens 1 and 2 to "comment out" the load lines for any definitions you do not wish to use. Then return to PC-DOS and enter: A>NUCLEUS ELECTIVE <return> (when you see the system id. and "ok", enter:) 1 LOAD <return> A new FORTH.COM file will be automatically written on the "current" disk drive. ( Build distributed FORTH file for DOS 2.0 11/04/83 ) VOCABULARY EDITOR IMMEDIATE ( declare all ) VOCABULARY ASSEMBLER IMMEDIATE ( utility vocabularies) VOCABULARY HIDDEN IMMEDIATE ( in advance ) FORTH DEFINITIONS DECIMAL DECIMAL 20 LOAD CR .( .T, ASCII, MYSELF, LIT-Quote ) DECIMAL 7 LOAD CR .( SAVE ) DECIMAL 9 LOAD CR .( DUMP ) DECIMAL 10 LOAD CR .( CASE statement ) DECIMAL 11 LOAD CR .( #IN ) DECIMAL 12 LOAD CR .( .STACK ) DECIMAL 13 LOAD CR .( USING ) DECIMAL 15 LOAD CR .( LOAD-USING ) DECIMAL 16 LOAD CR .( QX ) DECIMAL 17 LOAD CR .( DIR ) --> ( Build distributed FORTH file for DOS 2.0 11/14/83 ) DECIMAL 21 LOAD CR .( SHOWC ) DECIMAL 23 LOAD CR .( Double Precision Extensions ) DECIMAL 25 LOAD CR .( binary overlay for EDITOR, ASM ) ( DECIMAL 34 LOAD CR .( ANSI Cursor Control Functions ) DECIMAL 35 LOAD CR .( Index & List ) DECIMAL 36 LOAD CR .( Triad & Show ) DECIMAL 37 LOAD CR .( Words ) DECIMAL 38 LOAD CR .( Vocs ) DECIMAL 39 LOAD CR .( Background Tasker Support ) DECIMAL 42 LOAD CR .( Run command ) DECIMAL 45 LOAD CR .( Chdir command ) DECIMAL 46 LOAD CR .( Chdisk command ) .STACK SAVE FORTH ( System messages ) empty stack dictionary full has incorrect address mode is redefined is undefined disk address out of range stack overflow disk error BASE must be DECIMAL missing decimal point PC/FORTH 2.0 Laboratory Microsystems( System messages ) compilation only, use in definition execution only conditionals not paired definition not finished in protected dictionary use only when loading off current editing screen declare vocabulary illegal dimension in array definition negative array index array index too large ( 8086 Assembler messages ) 16 bit register not allowed 8 bit register not allowed address out of range immediate data value not allowed missing source register missing destination register illegal operation illegal operand instruction not implemented illegal destination register illegal source register illegal condition code register mismatch destination address missing ( FREEZE and SAVE 10/28/83 ) FORTH DEFINITIONS HEX : FREEZE [COMPILE] FORTH DEFINITIONS DECIMAL LATEST 10C ! ( top NFA ) HERE 12A ! ( FENCE ) HERE 12C ! ( DP ) VOC-LINK @ 12E ! ; ( vocabulary list ) DECIMAL --> ( FREEZE and SAVE 11/14/83 ) DECIMAL : SAVE SAVE-BUFFERS CLOSE-SCR FREEZE SCREEN-FCB DUP 37 ERASE 1+ DUP 11 BLANK BL WORD 1+ SWAP HERE C@ 8 MIN CMOVE LIT" COM" 1+ SCREEN-FCB 9 + 3 CMOVE 22 SCREEN-FCB FDOS DROP 255 AND 255 = IF CR ." Can't create COM file." 0 0 FDOS THEN HERE 256 - SCREEN-FCB 14 + ! ( set rec len) 26 256 FDOS 2DROP ( set dta ) 21 SCREEN-FCB FDOS DROP 255 AND ( write seq ) IF CR ." Not enough disk space" 7 EMIT CR ELSE HERE 256 - CR U. ." bytes written into " SCREEN-FCB .FCB THEN 16 SCREEN-FCB FDOS 2DROP 0 0 FDOS ; ( Memory dump, byte format ) FORTH DEFINITIONS DECIMAL : DUMP ( addr n --- ) BASE @ >R HEX CR CR 5 SPACES 16 0 DO I 3 .R LOOP 2 SPACES 16 0 DO I 0 <# # #> TYPE LOOP CR OVER + SWAP DUP 15 AND XOR DO CR I 0 4 D.R SPACE I 16 + I 2DUP DO I C@ SPACE 0 <# # # #> TYPE LOOP 2 SPACES DO I C@ DUP 32 < OVER 126 > OR IF DROP 46 THEN EMIT LOOP 16 +LOOP CR R> BASE ! ; ;S ( CASE statement by Charles Eaker ) ( from FORTH DIMENSIONS, II/3 page 37 ) FORTH DEFINITIONS DECIMAL : 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 ( Input number from console and leave on stack ) FORTH DEFINITIONS DECIMAL : #IN ( --- n ) 0 BEGIN KEY DUP 13 = IF DROP EXIT THEN DUP 8 = IF EMIT 32 EMIT 8 EMIT 10 / ELSE DUP 48 < OVER 57 > OR IF DROP 7 EMIT ELSE DUP EMIT 48 - SWAP 10 * + THEN THEN AGAIN ; ;S ( Display stack ) DECIMAL : .STACK BASE @ >R SP@ S0 @ = IF CR ." <empty stack> " ELSE SP@ S0 @ SWAP DO CR I @ DUP DECIMAL 4 .R HEX ." (" 0 4 D.R ." h)" 2 +LOOP CR THEN R> BASE ! ; ( Source for USING 11/03/83 ) FORTH DEFINITIONS DECIMAL VARIABLE PREV-FILE 64 ALLOT : USING 3 SPACES SCREEN-HANDLE 2+ PREV-FILE 64 CMOVE SAVE-BUFFERS CLOSE-SCR BL WORD OPEN-SCR EMPTY-BUFFERS IF CR ." Can't find " .SCREEN-FILE CR 7 EMIT PREV-FILE OPEN-SCR DROP THEN ." Current screen file - " .SCREEN-FILE CR ; ( Source for LOAD-USING 11/14/83 ) ( Load screens from another file, returning control to the ) ( current screen file when finished. Can be used while ) ( LOADing --- e.g. a master LOAD screen can compile from ) ( other screen files, however LOAD-USING's cannot be nested.) : LOAD-USING DEPTH 1 < 1 ?ERROR USING LOAD CLOSE-SCR EMPTY-BUFFERS PREV-FILE OPEN-SCR DROP ; ( Quick screen index 02/06/84 ) FORTH DEFINITIONS DECIMAL : QX SAVE-BUFFERS BASE @ >R DECIMAL CR CR 0 BEGIN DUP BLOCK DISK-ERROR @ ?TERMINAL DUP IF KEY DROP THEN OR 0= WHILE OVER 3 .R SPACE 2+ 14 TYPE OUT @ 60 > IF CR ELSE OUT @ 20 MOD 20 SWAP - SPACES THEN 1+ REPEAT EMPTY-BUFFERS DROP DROP CR CR R> BASE ! ; ( Source for DIR 11/02/83 ) HIDDEN DEFINITIONS DECIMAL VARIABLE DIR-FCB 35 ALLOT VARIABLE DIR-FCB2 35 ALLOT 128 CONSTANT DIR-BUFF 20 CONSTANT DIR_WIDTH ( Initialize memory and file control block ) : DIR-INIT 26 DIR-BUFF FDOS DROP DROP DIR-FCB 37 ERASE BL WORD 1+ DIR-FCB 1 parse-filename DROP DIR-FCB 1+ C@ BL = IF DIR-FCB 1+ 8 ASCII ? FILL THEN DIR-FCB 9 + C@ BL = IF DIR-FCB 9 + 3 ASCII ? FILL THEN ; ( Search for first or next directory entry ) : DIR-SCH-FST 17 DIR-FCB FDOS DROP 255 AND ; : DIR-SCH-NXT 18 DIR-FCB FDOS DROP 255 AND ; --> ( Source for DIR, continued 11/02/83 ) HEX ( format fully qualified filename from directory entry ) : DIR-PFCB OUT @ 0<> IF 0B3 EMIT THEN 1+ 0B 0 DO I 8 = IF 02E EMIT THEN DUP I + C@ DUP 020 > IF DUP 40 > IF 20 OR THEN EMIT ELSE DROP THEN LOOP DROP ; : DIR-DISP DIR-BUFF DIR-PFCB DIR-FCB2 25 ERASE DIR-BUFF DIR-FCB2 0C CMOVE 0F DIR-FCB2 FDOS 2DROP DIR-FCB2 10 + DUP @ SWAP 2+ @ 0C OUT @ 14 MOD - SPACES 6 D.R ; DECIMAL --> ( Source for DIR, continued 11/02/83 ) ( print file directory for selected or default disk ) FORTH DEFINITIONS DECIMAL : DIR HIDDEN BASE @ >R DECIMAL DIR-INIT DIR-SCH-FST 255 - IF CR CR ." Directory for drive " DIR-BUFF C@ ASCII @ + EMIT ASCII : EMIT CR DIR-DISP BEGIN DIR-SCH-NXT 255 - WHILE DIR-DISP OUT @ 65 > IF CR THEN REPEAT THEN CR CR R> BASE ! FORTH ; ( misc routines: exact time, ascii and string lit 11/03/83 ) FORTH DEFINITIONS DECIMAL : .T .TIME 58 EMIT @TIME 0 256 UM/MOD 0 <# # # #> TYPE 46 EMIT 0 <# # # #> TYPE DROP SPACE ; : ASCII BL WORD 1+ C@ STATE @ IF [COMPILE] LITERAL THEN ; IMMEDIATE : MYSELF LATEST NAME> , ; IMMEDIATE ( allows recursion) ( Compiling: stores the string preceded by 1-byte count. ) ( Executing: leaves addr of count byte on the stack ) : (LIT") R@ DUP C@ 1+ R> + >R ; : LIT" ?COMP COMPILE (LIT") 34 WORD C@ 1+ ALLOT ; IMMEDIATE ( SHOWC compact screen printer RJW 07/03/83 ) FORTH DEFINITIONS HEX 0C CONSTANT FORMF : ESC-SEQ ( n -- ) 1B EMIT EMIT ; : COMP 0F EMIT ; : -COMP 12 EMIT ; : EMPH 45 ESC-SEQ ; : -EMPH 46 ESC-SEQ ; : ITAL 34 ESC-SEQ ; : -ITAL 35 ESC-SEQ ; : .BANNER -COMP ITAL EMPH CR CR CR ." Laboratory Microsystems PC/FORTH 2.0" 07 SPACES .TIME 2 SPACES .DATE 2 SPACES .SCREEN-FILE -ITAL -EMPH COMP ; : ."SCR#" ." Screen # " ; : .BLK# ( n -- ) ( prints block#'s ) CR CR -COMP ITAL EMPH ."SCR#" DUP S>D <# #S #> DUP >R TYPE R> 1F SWAP - SPACES ."SCR#" 1+ S>D <# #S #> TYPE CR -ITAL -EMPH COMP ; --> ( SHOWC, continued 08/08/83 ) : SHOWC ( from to -- ) 2DUP > IF 2DROP EXIT THEN PRINTER FORMF EMIT 0 ROT ROT 1+ SWAP DO I .BLK# HERE 84 BLANK 400 0 DO J BLOCK I + HERE 40 CMOVE J 1+ BLOCK I + HERE 44 + 40 CMOVE HERE 84 -TRAILING TYPE CR 40 +LOOP 1+ DUP 3 = IF DROP 0 .BANNER FORMF EMIT THEN 2 +LOOP ?DUP IF 3 SWAP - 13 * 0 DO CR LOOP .BANNER THEN -COMP FORMF EMIT CONSOLE ; DECIMAL ;S ;S ( Double precision extensions 11/04/83 ) : 2VARIABLE CREATE 0 , 0 , DOES> ; : 2CONSTANT CREATE HERE 2! 4 ALLOT DOES> 2@ ; : D* ( d u --- d ) DUP ROT * ROT ROT UM* ROT + ; : D/ ( d u --- d ) SWAP OVER /MOD >R SWAP UM/MOD SWAP DROP R> ; : D<> D= NOT ; : D<= D> NOT ; : D>= D< NOT ; --> ( Double precision extensions 11/13/83 ) : 2ROT 5 ROLL 5 ROLL ; : D0= OR 0= ; : DU< ROT SWAP 2DUP U< IF 4DROP -1 ELSE <> IF 2DROP 0 ELSE U< THEN THEN ; : DMIN 2OVER 2OVER D> IF 2SWAP THEN 2DROP ; : DMAX 2OVER 2OVER D< IF 2SWAP THEN 2DROP ; ;S ( Binary overlay 11/13/83 ) HIDDEN DEFINITIONS DECIMAL 128 CONSTANT B/SEC VARIABLE BINFILE 35 ALLOT : SET-FCB DUP 37 ERASE 1+ 11 CMOVE ; : CLOSE 16 SWAP FDOS DROP 255 AND 255 = 8 ?ERROR ; : OPEN 1 OVER 14 + ! CR ." Wait..." 15 SWAP FDOS DROP 255 AND 255 = IF CR ." Can't find " BINFILE .FCB CR QUIT THEN ; : READFILE ( fcb-addr dma-addr --- new-dma-addr ) SWAP OVER 26 SWAP FDOS 2DROP ( set dma ) DUP 16 + @ SWAP OVER ( length) DUP DP @ + 384 + SP@ U> IF CR ." Not enough room in dictionary" CR BINFILE CLOSE QUIT THEN block-read 2DROP + 128 - ; --> ( Binary overlay, continued 11/14/83 ) ' ABORT @ CONSTANT COL.CFA ( CFA of 'docol' ) ' ;S CONSTANT SEMI.CFA ( ;S or EXIT mark) ' (.") CONSTANT DOTQ.CFA ( various string ) ' (LIT") CONSTANT LITQ.CFA ( runtime words) ' (ABORT") CONSTANT ABORTQ.CFA ' BLIT CONSTANT BLIT.CFA ( various literal ) ' LIT CONSTANT LIT.CFA ( runtime words ) ' DLIT CONSTANT DLIT.CFA ' BRANCH CONSTANT BRANCH.CFA ( runtime BRANCH ) ' 0BRANCH CONSTANT 0BRANCH.CFA ( runtime BRANCH if 0) ' (LOOP) CONSTANT LOOP.CFA ' (+LOOP) CONSTANT +LOOP.CFA --> ( Binary overlay, continued 11/14/83 ) HEX VARIABLE OFFSET ( between read & comp ) VARIABLE FIRST.NFA ( first NFA in module ) DECIMAL ( relocate the contents of colon def's parameter field ) : COL.DEF DUP ( lfa --- lfa ) BEGIN 2+ DUP @ SEMI.CFA = NOT WHILE DUP @ CASE ( offset the word if needed) DOTQ.CFA OF 2+ DUP C@ + 1- ENDOF ( skip text strings ) ABORTQ.CFA OF 2+ DUP C@ + 1- ENDOF LITQ.CFA OF 2+ DUP C@ + 1- ENDOF --> ( Binary overlay, continued 11/13/83 ) LIT.CFA OF 2+ ENDOF ( skip literal constants) BLIT.CFA OF 1+ ENDOF DLIT.CFA OF 4 + ENDOF BRANCH.CFA OF 2+ ENDOF ( skip offsets of branches) 0BRANCH.CFA OF 2+ ENDOF ( since they are relative ) LOOP.CFA OF 2+ ENDOF ( ditto with loop offsets) +LOOP.CFA OF 2+ ENDOF ( OTHERWISE: CFA doesn't match any special words) FIRST.NFA @ U> ( is def in new module? ) IF OFFSET @ OVER +! THEN ( if so, offset it ) DUP ENDCASE ( endcase consumes one item ) REPEAT DROP ; ( drop address of 'semis' ) --> ( Binary overlay, continued 11/13/83 ) : GETADDR ( addr --- size voc-link last-LFA ) DUP @ SWAP ( size of module in bytes ) 2+ DUP @ HERE + SWAP ( new LFA of last word ) 2+ DUP @ DUP FIRST.NFA ! ( first NFA before relocation ) HERE SWAP - OFFSET ! ( calculate offset at new addr ) 2+ @ SWAP ; ( last vocabulary in module ) --> ( Binary overlay, continued 11/13/83 ) : RE-LINK ( first-LFA --- ) BEGIN OFFSET @ OVER +! ( patch the LFA ) DUP LINK> @ CASE ( get CFA of definition ) COL.CFA OF COL.DEF ENDOF ( process colon definition ) ( code for VOCs and DOES> words goes here ) ( OTHERWISE it's a Constant Variable etc ) ENDCASE DUP @ HERE U< NOT ( until next NFA < HERE ) WHILE @ N>LINK ( follow linked list to next) REPEAT LATEST SWAP ! ; ( link dictionary of overlay) --> ( to previous last def ) ( Binary overlay, continued 11/14/83 ) : BGET ( --- ; filename previously placed by caller) CONTEXT @ CURRENT @ <> 24 ?ERROR BINFILE OPEN ( open the filename ) ." Reading..." BINFILE HERE READFILE ( read entire file at DP ) GETADDR ( get the addresses from file ) ." Relocating..." DUP RE-LINK ( relocate all definitions ) 2+ >NAME CONTEXT @ ! ( update the addr in LATEST ) DROP ( *** ) ( discard vocab link for now ) ALLOT ( extend the DP for new defs ) BINFILE CLOSE ; ( close the file ) --> ( Binary overlay, continued 11/13/83 ) ( patches the link field of the last word of the overlay ) ( to point to the NFA of the first word of the overlay, which) ( should be defined as OVERLAY. Then all words of the module) ( are hidden from the user to avoid cluttering the dictionary) ( and he can discard it by entering FORGET OVERLAY. ) : LINK-OVER-OVERLAY ( old-HERE --- ) LATEST N>LINK ! ; --> ( Binary overlay, continued 11/14/83 ) FORTH DEFINITIONS DECIMAL : EDIT HIDDEN LIT" EDITOR BIN" 1+ BINFILE SET-FCB HERE BGET LINK-OVER-OVERLAY FORTH LATEST NAME> EXECUTE ; : SCOPY HIDDEN LIT" SCOPY BIN" 1+ BINFILE SET-FCB HERE BGET LINK-OVER-OVERLAY FORTH LATEST NAME> EXECUTE ; ;S ( ANSI Cursor Control Functions 02/06/84 ) FORTH DEFINITIONS DECIMAL 27 CONSTANT Esc ( --- ) : CLEARSCREEN Esc EMIT ASCII [ EMIT ASCII 2 EMIT ASCII J EMIT ; ( x y --- ) : GOTOXY Esc EMIT ASCII [ EMIT 1+ . ASCII ; EMIT 1+ . ASCII H EMIT ; ( --- ) : CLREOL Esc EMIT ASCII [ EMIT ASCII K EMIT ; ;S ( INDEX & LIST 02/06/84 ) HEX : INDEX SAVE-BUFFERS DEPTH 2 < 1 ?ERROR ?DECIMAL ?DEVICE 1 = IF 0C EMIT THEN CR 1+ SWAP DO CR I 3 .R SPACE 0 I .LINE ?TERMINAL DUP IF KEY DROP THEN DISK-ERROR @ DUP IF EMPTY-BUFFERS THEN OR IF LEAVE THEN LOOP CR ; : LIST DEPTH 1 < 1 ?ERROR ?DECIMAL ?DEVICE IF CR ELSE CLEARSCREEN THEN DUP SCR ! ." Screen # " . 10 0 DO CR I 3 .R SPACE I SCR @ .LINE LOOP CR ; ;S ( TRIAD & SHOW 10/29/83 ) HEX : TRIAD DEPTH 1 < 1 ?ERROR ?DECIMAL ?DEVICE 1 = IF 0C EMIT THEN 3 / 3 * 3 OVER + SWAP DO CR I LIST LOOP CR CR ." Laboratory Microsystems PC/FORTH 2.0" 2B OUT @ - SPACES .TIME 2 SPACES .DATE 2 SPACES .SCREEN-FILE CR ; : SHOW DEPTH 2 < 1 ?ERROR ?DECIMAL PRINTER 1+ SWAP DO I TRIAD ?TERMINAL IF KEY DROP LEAVE THEN 3 +LOOP CONSOLE ; ;S ( WORDS 10/29/83 ) HEX : WORDS BASE @ >R HEX CR CR CONTEXT @ @ ?DUP IF BEGIN DUP DUP 0 <# # # # # #> TYPE DUP 1+ C@ IF SPACE .NAME ELSE ." null" DROP THEN OUT @ 3C > IF CR ELSE 14 OUT @ OVER MOD - SPACES THEN N>LINK @ DUP 0= ?TERMINAL DUP IF KEY DROP THEN OR UNTIL DROP ELSE ." Empty vocabulary." THEN CR CR R> BASE ! ; ;S ( VOCS 10/29/83 ) : VOCS CR CR ." Search order: " CONTEXT @ 4 - >NAME CR ." Context voc = " .NAME CURRENT @ 4 - >NAME CR ." Current voc = " .NAME CR ." Default voc = FORTH " BASE @ >R HEX VOC-LINK CR CR ." Defined vocabularies:" CR CR ." link nfa name" BEGIN @ DUP WHILE CR DUP 4 U.R 3 SPACES DUP 6 - >NAME DUP 4 U.R 3 SPACES .NAME REPEAT DROP R> BASE ! CR CR ; ( Background tasker support 12/01/82 ) ( display names of active tasks ) : .TASKS CLEARSCREEN ." Active tasks:" #TASKS 0 DO I 2* TASK_LIST + @ ?DUP IF 0 I 2+ GOTOXY I 1+ 2 .R 2 SPACES >NAME .NAME THEN LOOP CR ; --> ( Multi-tasker, cont. 12/01/82 ) : START ( --- ) BL WORD FIND REVERSE HERE COUNT TYPE REVERSE-OFF IF 0 FIND-TASK IF ! ( *** store CFA into task table *** ) ." --- added to task list" ELSE ." --- too many tasks" DROP THEN ELSE ." --- not in dictionary" THEN CR ; --> ( Multi-tasker, cont. 08/07/83 ) : KILL BL WORD FIND REVERSE HERE COUNT TYPE REVERSE-OFF IF FIND-TASK IF DUP 2+ SWAP TASK_LIST #TASKS 1+ 2* + 2 PICK - CMOVE ." --- removed from task list" ELSE ." --- not in task list" THEN ELSE ." --- not in dictionary" THEN CR ; : KILL-TASKS TASK_LIST #TASKS 2 * ERASE ; ;S ( MS-DOS RUN command 11/02/83 ) HIDDEN DEFINITIONS DECIMAL VARIABLE PGM_NAME 62 ALLOT VARIABLE FCB1 35 ALLOT VARIABLE FCB2 35 ALLOT VARIABLE CMD_LINE 62 ALLOT VARIABLE PAR_BLK -2 ALLOT 0 , ( 0,1 = environment descr ) CMD_LINE , 0 , ( offset, segment command line) FCB1 , 0 , ( offset, segment FCB for 5CH ) FCB2 , 0 , ( offset, segment FCB for 6CH ) --> ( MS-DOS RUN command 11/02/83 ) FORTH DEFINITIONS ( --- ; used in the form RUN program ) : RUN CR CR HIDDEN ?cs: DUP DUP PAR_BLK 4 + ! PAR_BLK 8 + ! PAR_BLK 12 + ! PGM_NAME 64 ERASE CMD_LINE 64 ERASE 13 CMD_LINE 1+ C! FCB1 37 ERASE FCB2 37 ERASE FCB1 1+ 11 BLANK FCB2 1+ 11 BLANK BL WORD DUP 1+ SWAP C@ PGM_NAME SWAP CMOVE BL WORD DUP C@ 1+ CMD_LINE SWAP CMOVE 13 CMD_LINE DUP C@ 1+ + C! CMD_LINE 1+ FCB1 1 parse-filename DROP --> ( MS-DOS RUN command 11/02/83 ) PGM_NAME PAR_BLK run CASE 0 OF 0 24 GOTOXY ENDOF -1 OF CR ." Memory release failed" ENDOF 2 OF CR ." Program not found" ENDOF ( default case ) CR ." Program load failed" ENDCASE CR CR FORTH ; ( MSDOS CHDIR command 11/03/83 ) ( --- ; used in the form CHDIR name ) : CHDIR BL WORD 0 OVER DUP C@ + 1+ C! chdir CASE -1 OF CR ." Need PC-DOS 2.0 " ENDOF 0 OF CR ." Current directory is " HERE COUNT TYPE ENDOF ( default case ) CR ." Path not found" ENDCASE CR CR ; ( CHDISK command 01/31/84 ) FORTH DEFINITIONS DECIMAL ( used in the form: CHDISK unit ) : CHDISK BL WORD 1+ C@ ASCII A - 0 MAX 63 MIN DUP 14 SWAP FDOS DROP 255 AND >= IF CR ." Illegal drive." CR THEN ;
