\ Misc Functions Load Screen 5 /15/88 1 11 +THRU CR .( Misc Loaded ) \ Basic Utilities Load Screen 5 /15/88ONLY FORTH ALSO DEFINITIONS VOCABULARY HIDDEN VARIABLE FUDGE 151 FUDGE ! : MS ( n -- ) 0 ?DO FUDGE @ 0 ?DO LOOP LOOP ; : U<= ( u1 u2 -- f ) U> NOT ; : U>= ( u1 u2 -- f ) U< NOT ; : <= ( n1 n2 -- f ) > NOT ; : >= ( n1 n2 -- f ) < NOT ; : 0>= ( n1 n2 -- f ) 0< NOT ; : 0<= ( n1 n2 -- f ) 0> NOT ; \ Output Formatting 5 /15/88VARIABLE LMARGIN 0 LMARGIN ! VARIABLE RMARGIN 70 RMARGIN ! : ?LINE ( n -- ) #OUT @ + RMARGIN @ > IF CR LMARGIN @ SPACES THEN ; : (?CR) ( -- ) 0 ?LINE ; ' (?CR) IS ?CR : WAIT ( -- ) KEY BL <> ABORT" OK " ; : START/STOP ( -- ) KEY? IF WAIT WAIT THEN ; : LARGEST ( addr n -- addr' val ) OVER 0 SWAP ROT 0 DO 2DUP @ U< IF -ROT 2DROP DUP @ OVER THEN 2+ LOOP DROP ; CREATE THREADS #THREADS 2* ALLOT : FOLLOW ( voc -- ) THREADS #THREADS 2* CMOVE ; : ANOTHER ( -- adr ) THREADS #THREADS LARGEST TUCK HEAD-SEG L@ SWAP ! ; \ Managing Source Screens 5 /15/88: .SCR ( -- ) ." Scr # " SCR ? 8 SPACES FILE? ; : LIST ( n -- ) 1 ?ENOUGH CR DUP SCR ! .SCR L/SCR 0 DO CR I 3 .R SPACE DUP BLOCK I C/L * + C/L -TRAILING >TYPE KEY? ?LEAVE LOOP DROP CR ; : TRIAD ( n -- ) 12 EMIT ( form feed ) 3 / 3 * 3 BOUNDS DO I LIST LOOP ; : .LINE0 ( n -- ) DUP 3 MOD 0= IF CR THEN CR DUP 3 .R SPACE BLOCK C/L -TRAILING >TYPE ; : INDEX ( n1 n2 -- ) 2 ?ENOUGH 1+ SWAP DO I .LINE0 LOOP CR ; : IND ( n -- ) BEGIN DUP .LINE0 1+ START/STOP AGAIN ; \ Display the WORDS in the Context Vocabulary 5 /15/88DEFER EACH ( alf -- ) : EVERY ( voc -- ) FOLLOW BEGIN ANOTHER DUP WHILE EACH REPEAT DROP ; : OVERALL ( acf -- ) IS EACH CONTEXT @ EVERY ; : NEWLINE ( -- ) CR LMARGIN @ SPACES ; : .NAME ( alf -- ) START/STOP L>NAME DUP 1+ HEAD-SEG LC@ 31 AND 4 + ?LINE .ID SPACE ; : WORDS ( -- ) NEWLINE ['] .NAME OVERALL ; ROOT DEFINITIONS : WORDS WORDS ; FORTH DEFINITIONS \ Iterated Interpretation 5 /15/88VARIABLE #TIMES ( # times already performed ) 1 #TIMES ! : TIMES ( n -- ) 1 #TIMES +! #TIMES @ < IF 1 #TIMES ! ELSE >IN OFF THEN ; : MANY ( -- ) KEY? NOT IF >IN OFF THEN ; : :: ( -- ) ( HIDE ) HERE >R ,JSR [ ' : 1+ DUP @ + ] LITERAL HERE - , !CSP COMPILER R@ EXECUTE R> DP ! ; : N ( -- ) 1 SCR +! DISK-ERROR OFF ; : P ( -- ) -1 SCR +! DISK-ERROR OFF ; : L ( -- ) SCR @ LIST ; \ Managing Source Screens 5 /15/88: ESTABLISH ( n -- ) FILE @ SWAP 1 BUFFER# 2! ; : (COPY) ( from to -- ) OFFSET @ + SWAP IN-BLOCK DROP ESTABLISH UPDATE ; : COPY ( from to -- ) 2 ?ENOUGH FLUSH (COPY) FLUSH ; : @VIEW ( code-field -- scr file# ) >VIEW HEAD-SEG L@ DUP 255 AND DUP 0= ABORT" entered at terminal." SWAP FLIP 255 AND ; : (VIEW) ( -- ) [ DOS ] ' @VIEW ?DUP IF 2* VIEW-FILES + @ DUP IF ." is in " 2DUP >BODY .FILE ." screen " . CLOSE-FILE EXECUTE ELSE 2DROP ." no entry " THEN ELSE ." may be in current file: " FILE? ." screen " DUP . THEN ; : VIEW ( -- ) (VIEW) LIST ; \ Disk copy utility 5 /15/88VARIABLE HOPPED ( # screens copy is offset ) VARIABLE U/D DEFER CONVEY-COPY ' (COPY) IS CONVEY-COPY : HOP ( n -- ) ( specifies n screens to skip ) HOPPED ! ; : .TO ( #1 #2 -- #1 #2 ) CR OVER . ." to " DUP . ; : (CONVEY) ( blk n -- blk+-n ) 0 ?DO KEY? ?LEAVE DUP DUP HOPPED @ + .TO CONVEY-COPY U/D @ + LOOP FLUSH ; : CONVEY ( first last -- ) FLUSH HOPPED @ 0< IF 1+ OVER - 1 ELSE DUP 1+ ROT - -1 THEN U/D ! #BUFFERS /MOD >R (CONVEY) R> 0 ?DO #BUFFERS (CONVEY) LOOP DROP ; : TO ( #1st-source #last-source -- #1st-source #last-source ) ( #1st-dest must follow TO ) SWAP BL WORD NUMBER DROP OVER - HOP SWAP ; \ String Functions Load Screen 5 /15/88 : lowc ( c -- c' ) dup ascii A ascii Z between if bl + then ; \S \ String Functions SEARCH 5 /15/88EXIT VARIABLE FOUND : SCAN-1ST ( a n c -- a n ) CAPS @ IF UPC DUP ASCII A ASCII Z BETWEEN IF 3DUP SCAN >R >R LOWC SCAN R> R> 2 PICK OVER < IF 2SWAP THEN 2DROP ELSE SCAN THEN ELSE SCAN THEN ; : SEARCH ( sadr slen badr blen -- n f ) FOUND OFF SWAP >R 2DUP U<= IF OVER - 1+ 2 PICK C@ R@ -ROT >R BEGIN R@ SCAN-1ST DUP IF >R 3DUP SWAP COMPARE 0= IF FOUND ON R> DROP 0 >R THEN R> THEN DUP WHILE 1 /STRING REPEAT R> 2DROP -ROT THEN 2DROP R> - FOUND @ ; \ String operators 5 /15/88EXIT : DELETE ( buffer size count -- ) OVER MIN >R R@ - ( left over ) DUP 0> IF 2DUP SWAP DUP R@ + -ROT SWAP CMOVE THEN + R> BLANK ; : INSERT ( string length buffer size -- ) ROT OVER MIN >R R@ - ( left over ) OVER DUP R@ + ROT CMOVE> R> CMOVE ; : REPLACE ( string length buffer size -- ) ROT MIN CMOVE ; : SIFT? ( a n alf -- ) L>NAME COUNT 31 AND PAD PLACE 128 PAD COUNT + 1- CRESET 2DUP PAD COUNT SEARCH NIP IF PAD N>LINK .NAME THEN ; : SIFT ( -- ) BL WORD COUNT NEWLINE ['] SIFT? OVERALL 2DROP ; ROOT DEFINITIONS : SIFT SIFT ; FORTH DEFINITIONS \ Machine Dependant IO Words 24JAN86GEBCODE PC@ (S port# -- n ) BX DX MOV 0 AL IN AH AH SUB AX BX MOV NEXT C; CODE P@ (S port# -- n ) BX DX MOV 0 AX IN AX BX MOV NEXT C; CODE PC! (S n port# -- ) BX DX MOV AX POP 0 AL OUT BX POP NEXT C; CODE P! (S n port# -- ) BX DX MOV AX POP 0 AX OUT BX POP NEXT C; string load screen \ Basic Utilities Load Screen 5 /15/88 Set FUDGE to adjust period of MS. MS delays about n MilliSeconds. This clearly depends on your system clock speed. Adjust FUDGE until the delay is right. U<= Unsigned less than or equal. U>= Unsigned greater than or equal. <= Less than or equal. >= Greater than or equal. 0<= Less than or equal to zero. 0>= Greater than or equal to zero. \ Output Formatting 5 /15/88LMARGIN is the column number of the left margin. RMARGIN is the column number of the right margin. ?LINE Move to left margin on next line if we will be past the right margin after printing n characters. ?CR Move to left margin on next line if we are past the right margin. START/STOP wait for another key hit LARGEST ( addr n -- addr' val ) Given a address and a number of words to examine, return each. Pressing a key aborts the listing. LIST also makes array. These words are useful for a variety of output formatting needs. Only WORDS uses the margins currently. See chapter 12 of Starting Forth for more ideas. \ LIST INDEX 5 /15/88.SCR ( -- ) Print current screen number and file name. LIST ( n -- ) List the specified screen as 16 lines with 64 characters each. Pressing a key aborts the listing. LIST also makes the specified screen the current screen. TRIAD ( n -- ) Lists three screens per page. For 80 column printers. .LINE0 ( n -- ) print line 0 of block n. INDEX ( n1 n2 -- ) Lists the first line of every screen, from n1 through n2. This is very useful for getting a quick idea of what is in a file if you use the first line of every screen as a global screen comment. IND ( n -- ) is a single argument INDEX. Use INDEX for background printing. \ Display the WORDS in the Context Vocabulary 5 /15/88EACH defered word to do to each word in search order EVERY to each to all words OVERALL do every for context vocabulary NEWLINE do a CR and indent .NAME print a name field WORDS ( -- ) List the words in the context vocabulary. This can be interrupted any time by pressing any key. Add WORDS to ROOT. \ Iterated Interpretation 5 /15/88#TIMES A variable that keeps track of how many times. TIMES ( n -- ) Re-execute the input stream a specified number of times. MANY ( -- ) Re-execute the input stream until the user presses a key. :: compile and execute nameless FORTH code, then forget it. N list the next forth screen P list the previous forth screen L relist the current forth screen \ Managing Source Screens 5 /15/88ESTABLISH Sets the block number of the most recently referenced block. (COPY) The primitive that copies one screen to another. COPY Copies and screen and flushes it to disk. @VIEW pick up the given view-field and partition it into screen number and file number. File number indexes VIEW-FILES.VIEW <name> will display the name of the file and number of the screen containing the source code for <name>. The file will be opened if possible and the screen listed. \ Disk copy utility 5 /15/88HOPPED The number of screens to skip when copying U/D the direction of the copy, to prevent overlap. CONVEY-COPY deferred so that it can be used in different contextHOP Specifies the number of screens to hop over. .TO Prints a message to keep the user happy. (CONVEY) ( blk n -- blk+-n ) Moves a set of screens in the direction of the copy. CONVEY ( first last -- ) Moves a set of screens by first determining the direction to prevent overlap, and then moving them as a set whose size is determined by the number of available buffers. TO ( #1st-source #last-source -- #1st-source #last-source ) You can use TO instead of HOP if you know the destination screen number instead of the number of screens to skip. lowc convert a character to lower case \ String Functions Case Conversions 5 /15/88not currently used FOUND A local variable to make life easier. SCAN-1ST SCAN for first character of a string if ignoring case otherwise do nothing. This makes SEARCH much faster when case is significant. SEARCH ( sadr slen badr blen -- n f ) Search for the s string inside of the b string. If found f is true and n is the offset from the beginning of the string to where the pattern was found. If not found, f is false and n is meaningless.
