home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
drdobbs
/
1988
/
02
/
tracy
/
tracy.lst
Wrap
File List
|
1987-01-04
|
12KB
|
368 lines
LISTINGS FOR TRACY Feb 1988 issue
( Stream data and text read and write )
These utilities read and write streams of data and text from
standard or BLOCKed files.
Text lines are read into the user buffer until either the buffer
is full, or the file is empty, or an #EOF or #EOL is read.
The terminating #EOF or #EOL , if present, is not read into the
buffer. #LF ( linefeeds) are read but ignored.
Output files are assumed to be extensible.
For your convenience, the Standard Prelude and DDJ Controlled
Reference Word Set are duplicated in this file.
( LOAD screen for DDJ Standard Prelude and String Extension)
( MJT Nov 22 1987 for DDJ February 1987)
( 2 LOAD ( Standard prelude)
3 LOAD ( Augmented interpretation)
4 5 THRU ( Controlled words)
6 9 THRU ( Strings)
10 13 THRU ( General file support)
\ 14 LOAD ( Read and write data files)
15 16 THRU ( Read and write BLOCKed data files)
17 LOAD ( Read text file, no #EOL)
\ 18 LOAD ( Read text file, with #EOL)
19 LOAD ( Write text file)
20 22 THRU ( Some examples)
( FORTH-83 functions-- typical definitions)
( Adjust these words for your Forth. See DDJ Oct 1987.)
( Note: functions already provided need not be redefined.)
: RECURSE [COMPILE] MYSELF ; IMMEDIATE
: INTERPRET INTERPRET ;
: I> ( - 'data) COMPILE R> ; IMMEDIATE
: >I ( - 'data) COMPILE >R ; IMMEDIATE
( Used for alignment: )
: ALIGN ( HERE 1 AND ALLOT) ;
: REALIGN ( a - a' ) ( DUP 1 AND +) ;
2 CONSTANT CELL : CELL+ 2+ ; : CELLS 2* ;
: UNDO I> R> R> 2DROP >I ; \ Undoes a DO-- LOOP.
( Required definitions - used to support further compilation)
: THRU ( n n2) 1+ SWAP DO I LOAD LOOP ;
\ LOADS screens n through n2.
: \ >IN @ 64 + -64 AND >IN ! ; IMMEDIATE
\ comment to end of line. For use in screens only.
: \\ 1024 >IN ! ; IMMEDIATE
\ stops interpreting or compiling screen immediately.
: \IF ( f ) 0= IF [COMPILE] \ THEN ; IMMEDIATE
\ conditional interpretation or compilation.
: NEED ( - f) 32 ( ie blank) WORD FIND SWAP DROP 0= ;
\ true if the following word is in the search order.
\ FORTH-83 Controlled Words
NEED 2* \IF : 2* DUP + ;
NEED D2* \IF : D2* 2DUP D+ ;
NEED HEX \IF : HEX 16 BASE ! ;
NEED C, \IF : C, ( n ) HERE 1 ALLOT C! ;
NEED BL \IF 32 CONSTANT BL
NEED ERASE \IF : ERASE ( a n) 00 FILL ;
NEED BLANK \IF : BLANK ( a n) BL FILL ;
NEED .R \IF : .R ( n width) >R DUP 0< R> D.R ;
\ DDJ Forth Column Controlled Words
NEED 2>R
\IF : 2>R COMPILE SWAP COMPILE >R COMPILE >R ; IMMEDIATE
NEED 2R>
\IF : 2R> COMPILE R> COMPILE R> COMPILE SWAP ; IMMEDIATE
NEED @EXECUTE \IF : @EXECUTE @ EXECUTE ;
NEED AGAIN
\IF : AGAIN 0 [COMPILE] LITERAL [COMPILE] UNTIL ; IMMEDIATE
NEED DLITERAL
DUP \IF : DLITERAL SWAP [COMPILE] LITERAL [COMPILE] LITERAL ;
\IF IMMEDIATE
NEED S>D \IF : S>D ( n - d) DUP 0< ;
NEED WITHIN \IF : WITHIN ( n n2 n3 - f) OVER - >R - R> U< ;
NEED TRUE \IF -1 CONSTANT TRUE
\ String operators See DDJ December 1987
\ Only /STRING and EVAL are used in this application.
: /STRING ( a n n2 - a+n2 n-n2) ROT OVER + ROT ROT - ;
\ truncates leftmost n chars of string. n may be negative.
: EVAL ( a n )
\ evaluates ("text interprets") a string.
DUP >R TIB SWAP CMOVE R@ #TIB !
0 >IN ! 0 BLK ! INTERPRET R> >IN ! ;
\\ String operators from STRINGS.ARC are summarized here:
ASCII ( - c) \ returns value of following character.
CTO"" ( c - a 1) \ converts character to string.
SKIP ( a l c - a2 l2)
\ returns shorter string from first position unequal to byte.
SCAN ( a l byte - a2 l2)
\ returns shorter string from first position equal to byte.
" ( - a n) \ STATE-smart string literal.
\\ String operators from STRINGS.ARC continue here:
VAL? ( a n - d 2 , n2 1 , 0)
\ string to number conversion primitive. True if d is valid.
\ Returns d if number contains ",-./:" and sets DPL = 0
\ Returns n if no punctuation present and sets DPL = 0<
VAL ( a n - d f)
\ converts string to double number. True if number is valid.
\ If number contains ",-./:" then sets DPL = 0
\ If no punctuation present then sets DPL = 0<
-TEXT ( a n a2 - -1 , 0 , 1)
\ returns -1 if string a n < a2 n , 0 if equal, and 1 if >.
COMPARE ( a n a2 n2 - -1 , 0 , 1)
\ returns -1 if a n < a2 n2 , 0 if equal, and 1 if >.
\ The corrected version of MATCH
: MATCH ( a n a2 n2 - ???? 0 , offset -1)
\ returns the position of string a2 n2 in (a n).
\ Offset is zero if ( a n ) is found in first char position.
\ Returns false with invalid offset if ( a n ) isn't in a2 n2.
DUP 0= IF 2DROP 2DROP 0 TRUE EXIT THEN
2SWAP 2 PICK OVER SWAP -
DUP 0< IF 2DROP 2DROP 0 EXIT THEN
0 ( index ) SWAP 1+ 0
DO ( index ) >R
2OVER 2OVER DROP -TEXT 0= ( equal? )
IF 2DROP 2DROP R> TRUE UNDO EXIT THEN
1 /STRING R> 1+
LOOP 2DROP 2DROP 0 ;
\ Data stream general support
1024 CONSTANT 1K
: UMIN ( u u2 - u3) 2DUP U< 0= IF SWAP THEN DROP ;
\ Adjust these constants for your system:
10 CONSTANT #LF \ linefeed character.
13 CONSTANT #EOL \ end-of-line character.
26 CONSTANT #EOF \ end of file character (control-Z).
\ Adjust end-of-line and end-of-file sequence for your system:
CREATE ENDLINE 2 ( count) C, #EOL C, #LF C,
CREATE ENDFILE 1 ( count) C, #EOF C,
\ File size and position
\ Example of some of the structure of a file control block:
\ VARIABLE FCB HERE FCB ! 5 CELLS ALLOT ( Containing: )
\ 1 cell current file handle-- ie selects current file.
\ 2 cells current file size in bytes (double number).
\ 2 cells current file position (double number).
\\ You can implement CAPACITY and POSITION as 2VARIABLES.
\\ You must initialize CAPACITY to the size of your file.
2VARIABLE POSITION
2VARIABLE CAPACITY ( eg DSIZE CAPACITY 2! )
\ Set and reset file position
\ Given POSITION you can control the position of file access:
: MARKDATA ( - d) POSITION 2@ ;
\ determines the position of the current file.
: SEEKDATA ( d ) POSITION 2! ;
\ changes the position of the current file.
\ Extend the file
\ If your Forth or operating system requires explicit extension,
\ supply an appropriate definition for EXTEND .
\ Otherwise, use : EXTEND ( d ) COMPILE 2DROP ; IMMEDIATE
: EXTEND ( d ) COMPILE 2DROP ; IMMEDIATE
\\
: EXTEND ( d )
\ properly extends current file by d bytes.
\ This example converts d to blocks and calls a MORE function.
1K UM/MOD SWAP IF 1+ THEN ( # of blocks to extend ) MORE ;
\ Read and write data files directly
: GETDATA ( a n - n2) ;
\ reads n bytes of data from input file into address, n < 64K
\ Returns n2 bytes not read ( ie beyond end of file ).
\ Implement as a system call using CAPACITY and POSITION
: PUTDATA ( a n) ;
\ writes n bytes of data to output file from address, n < 64K
\ Implement as a system call using CAPACITY POSITION and EXTEND
\ Read BLOCKed file as data file
: GETDATA ( a n - n2)
\ reads n bytes of data from input file into address, n < 64K
\ Returns n2 bytes not read ( ie beyond end of file ).
( calculate # of bytes to move < 64K : ) POSITION 2@
BEGIN 2 PICK ( n ) DUP
IF ( n ) >R 2DUP 1K UM/MOD SWAP DROP 1+ 1K UM*
CAPACITY 2@ DMIN 2OVER D- 0= NOT OR R> UMIN
THEN ?DUP
WHILE >R 2DUP 1K UM/MOD BLOCK + 4 PICK R@ CMOVE
R@ 0 D+ 2SWAP R> /STRING 2SWAP
REPEAT POSITION 2! SWAP DROP ;
\ Write BLOCKed file as data file
: PUTDATA ( a n)
\ writes n bytes of data to output file from address, n < 64K
( extend the file as needed : )
DUP 0 POSITION 2@ D+ CAPACITY 2@ 2SWAP D- DUP 0<
IF 2DUP EXTEND 2OVER CAPACITY 2! THEN 2DROP
( calculate # of bytes to move < 64K : ) POSITION 2@
BEGIN 2 PICK ( n ) DUP
IF ( n ) >R 2DUP 1K UM/MOD SWAP DROP 1+ 1K UM*
CAPACITY 2@ DMIN 2OVER D- 0= NOT OR R> UMIN
THEN ?DUP
WHILE >R 2DUP 1K UM/MOD BLOCK + 4 PICK SWAP R@ CMOVE
R@ 0 D+ 2SWAP R> /STRING 2SWAP UPDATE
REPEAT POSITION 2! 2DROP ;
\ Read text file with #EOF
: GETTEXT ( a n - n2 f)
\ reads n bytes of text from input file into address, n < 64K
\ Returns n2 bytes not read ( ie end-of-line or beyond file)
\ Returns true if #EOL terminates line; false otherwise.
POSITION 2@ CAPACITY 2@ 2OVER D- 0= NOT OR ( limit to 64K)
3 PICK UMIN ?DUP 0= IF 2DROP SWAP DROP 0 EXIT THEN 0
DO 2DUP 1 0 D+ 2SWAP 1K UM/MOD BLOCK + C@ ( read a char )
DUP #EOL = OVER #EOF = OR
IF >R POSITION 2! SWAP DROP R> #EOL = UNDO EXIT THEN
DUP #LF - ( a n dpos ch f )
IF >R 2SWAP R@ 2 PICK C! 1 /STRING 2SWAP R> THEN
DROP
LOOP POSITION 2! SWAP DROP 0 ;
\ Read text file without #EOF
: GETTEXT ( a n - n2 f)
\ reads n bytes of text from input file into address, n < 64K
\ Returns n2 bytes not read ( ie end-of-line or beyond file)
\ Returns true if #EOL terminates line; false otherwise.
POSITION 2@ CAPACITY 2@ 2OVER D- 0= NOT OR ( limit to 64K)
3 PICK UMIN ?DUP 0= IF 2DROP SWAP DROP 0 EXIT THEN 0
DO 2DUP 1 0 D+ 2SWAP 1K UM/MOD BLOCK + C@ ( read a char )
DUP #EOL =
IF >R POSITION 2! SWAP DROP R> #EOL = UNDO EXIT THEN
DUP #LF - ( a n dpos ch f )
IF >R 2SWAP R@ 2 PICK C! 1 /STRING 2SWAP R> THEN
DROP
LOOP POSITION 2! SWAP DROP 0 ;
\ Read and write lines of text
: GETLINE ( a n - a n2 f)
\ reads n bytes of text from input file into address, n < 64K
\ n2 bytes are actually read; this is the opposite of GETTEXT
\ Returns true if #EOL terminates line; false otherwise.
2DUP GETTEXT >R - DUP 0= 0= R> OR ;
: PUTLINE ( a n ) PUTDATA ENDLINE COUNT PUTDATA ;
\ writes n bytes of data to output file from address, n < 64K
\ Text stream examples
: TYPE-FILE \ reads and prints the input text file.
\ Assumes zero-length string TYPEs nothing.
SWITCH ( to input file saving currently active file)
BEGIN PAD 80 GETLINE ( n2 f)
WHILE CR TYPE REPEAT 2DROP
SWITCH ( back to current file) ;
: COPY-FILE
\ copies the input text file to the output text file.
\ Save and restore current file as needed.
BEGIN SWITCH ( to input file) PAD 80 GETLINE
SWITCH ( to output file)
WHILE PUTLINE REPEAT 2DROP ENDFILE COUNT PUTDATA ;
\ Text stream examples
: BLOCK-TO-TEXT
\ copies the input BLOCK file to the output text file.
\ Save and restore current file as needed.
BEGIN SWITCH ( to input file) PAD 64 GETLINE
SWITCH ( to output file)
WHILE -TRAILING PUTLINE
REPEAT 2DROP ENDFILE COUNT PUTDATA ;
: TEXT-TO-BLOCK 0 ( previous line length )
\ copies the input text file to the output BLOCK file.
BEGIN SWITCH ( to input file)
PAD 64 2DUP BLANK GETLINE ROT ( a ) DROP
SWITCH ( to output file)
WHILE DUP 0= ROT 64 = AND NOT IF PAD 64 PUTDATA THEN
REPEAT 2DROP ;
\ Text stream examples
: EVAL-FILE \ reads and interprets the input text file.
\ Assumes zero-length interpreted string does nothing.
SWITCH ( to input file saving currently active file)
BEGIN PAD 80 GETLINE ( n2 f)
WHILE EVAL REPEAT 2DROP
SWITCH ( back to current file) ;