% *********************************************************
% *							  *
% * PISTOL-Portably Implemented Stack Oriented Language	  *
% *			Version 1.3			  *
% * (C) 1982 by	Ernest E. Bergmann			  *
% *		Physics, Building #16			  *
% *		Lehigh Univerisity			  *
% *		Bethlehem, Pa. 18015			  *
% *							  *
% * Permission is hereby granted for all reproduction and *
% * distribution of this material provided this notice is *
% * is included.					  *
% *							  *
% *********************************************************

% BASIC DEFINITIONS IN PISTOL FOR PISTOL- "PBASE"
% FEBRUARY 6, 1982, RECURSE DEF. FIXED

% DECIMAL mode initially

-6 W * USER + W@ W@ % used for 'LAST-PRIMITIVE
'W*  W 1 - IF : W * ;
	ELSE $: ;$
	THEN
'USER+ USER IF $: USER + ;$
		ELSE $: ;$
		THEN
'TRANS $: W* USER+ ;$ % TRANSLATES LOGICAL ADDRESSES TO ACTUAL
		% RAM ADDR.
		% TRANS MUST USE "$:" FOR THE 'DIS PACKAGE
'TRANS@ : TRANS W@ ;
'ARGPATCH : -6 TRANS@  W@ W + W! ; % for 'CONSTANT 'VARIABLE,
				   %  and 'ARRAY
'CONSTANT : : 0 ; ARGPATCH ;

'LAST-PRIMITIVE CONSTANT

-1	'TRUE	CONSTANT
0	'FALSE	CONSTANT

-57 TRANS@	'MAXLINNO	CONSTANT
-56 TRANS@	'CHKLMT		CONSTANT
-55 TRANS@	'RAMMIN		CONSTANT
-54 TRANS@	'STRINGSMIN	CONSTANT
% -53 TRANS NOT CURRENTLY BEING USED
-52 TRANS	'ABORT-PATCH	CONSTANT
-51 TRANS	'CONVERT-PATCH	CONSTANT
-50 TRANS	'PROMPT-PATCH	CONSTANT
-49 TRANS@	'STRINGSMAX	CONSTANT
-48 TRANS@	'VBASE		CONSTANT
-47 TRANS@	'VSIZE		CONSTANT
VBASE VSIZE W* + 'VMAX	CONSTANT
-46 TRANS@	'CSIZE		CONSTANT
-45 TRANS@	'LSIZE		CONSTANT
-44 TRANS@	'RSIZE		CONSTANT
-43 TRANS@	'SSIZE		CONSTANT
-42 TRANS@	'LINEBUF	CONSTANT
LINEBUF 200 + 'EDITBUF		CONSTANT
-41 TRANS@	'COMPBUF	CONSTANT
-40 TRANS@	'RAMMAX		CONSTANT
-39 TRANS@	'MAXORD		CONSTANT
-38 TRANS@	'MAXINT		CONSTANT
% -37 TRANS NOT CURRENTLY BEING USED
-36 TRANS@	'VERSION	CONSTANT

'ON : TRUE SWAP W! ;
'OFF : FALSE SWAP W! ;
'INFILE : -11 TRANS@ ;

'BYE : -35 TRANS ON ;
-34 TRANS '(PISTOL<) CONSTANT
-32 TRANS '.V CONSTANT
-29 TRANS 'LOADFILE-STATUS CONSTANT
-28 TRANS '#GET-ADDR CONSTANT % FOR PATCHING #GETLINE
-27 TRANS 'TAB-SIZE CONSTANT
-26 TRANS 'TRACE-ADDR CONSTANT
-25 TRANS 'ENDCASE-PATCH CONSTANT
-24 TRANS 'COLUMN CONSTANT
-23 TRANS 'TERMINAL-WIDTH CONSTANT
-22 TRANS '#LINES CONSTANT
-21 TRANS 'TERMINAL-PAGE CONSTANT
-20  TRANS 'COMPILE-END-PATCH CONSTANT
-19 TRANS 'TRACE-LEVEL CONSTANT % USED AS BOOLEAN AND LEVEL
				% INDICATOR
-17 TRANS 'RAISE CONSTANT
-15 TRANS 'NEXTCH^ CONSTANT
-14 TRANS 'CONSOLE CONSTANT
-13 TRANS 'ECHO CONSTANT
-12 TRANS 'LIST CONSTANT
-6 TRANS 'CURRENT CONSTANT
-5 TRANS 'OLD-EOSTRINGS CONSTANT % END OF PERMANENT STRINGS
				 % VARIABLE
-4 TRANS 'CURRENT-EOSTRINGS CONSTANT
-3 TRANS '.D CONSTANT
-2 TRANS '.C CONSTANT
-1 TRANS 'RADIX CONSTANT
STRINGSMIN 'RADIX-INDICATOR CONSTANT
STRINGSMIN 1 + 'SYNTAXBASE CONSTANT

'NOP : ;
'DUP : 0 S@ ;
'1+ : 1 + ;
'1- : 1 - ;
'W+ : W + ;
'W- : W - ;
'W<- : SWAP W! ;
'1+W! : DUP W@ 1+ W<- ;
'W+W! : DUP W@ W+ W<- ;
'CR : 13 TYO ;
'SPACE : 32 TYO ;
'SPACES : 0 DO SPACE LOOP ;
'DDUP : 1 S@ 1 S@ ;
'OVER : 1 S@ ;
'2OVER : 2 S@ ;
'3OVER : 3 S@ ; % USED BY DIS PACKAGE(DON'T CHANGE!)
'UNDER : SWAP DROP ;
'TYPE : 0 DO DUP C@ TYO 1+ LOOP DROP ;
'LT : SWAP GT ;
'LINE-SPACE? : COLUMN W@ + TERMINAL-WIDTH W@ LT
	IF ELSE CR THEN ;

'MSG : DUP C@ LINE-SPACE?
	 DUP 1+ SWAP C@ TYPE ;

'IFCR : COLUMN W@ 0 GT IF CR THEN ;
'ERR : IFCR ABORT ;

'MERR : CONSOLE ON MSG ERR ;


'INDENT : DUP TERMINAL-WIDTH W@ LT IF
	COLUMN W@ - SPACES
	ELSE IFCR DROP
	THEN ;

'TAB : 9 TYO ;

'TABS : 0 DO TAB LOOP ;

'ALLOT : W* .D W@ + .D W! ; % advances dictionary pointer
			% by the amount given by top of stack
'W, :		% PLACES TOS AT END OF DICTIONARY
	.D W@ W! 1 ALLOT
	;
'VARIABLE : : 3 ;	% create definition
	.D W@ ARGPATCH	% point it at end of dictionary
	W,		% initialize variable
	;		% finish with allocating space
'ARRAY : : 3 ;		% create definition
	.D W@ ARGPATCH	% point it at end of dictionary
	ALLOT ;		% allocate requested space and ;


% VOCABULARY RELATED DEFINITIONS:
'> : .V W@ DUP VBASE GT	% "POPS" VOCABULARY STACK
	IF W- .V W!
	ELSE "*** VSTACK UNDERFLOW***" MERR
	THEN
	;

'<V :	% TRANSFERS TOS TO TOP OF VSTACK
	.V W@ DUP VMAX LT
	IF W+ DUP .V W! W!
	ELSE "*** VSTACK OVERFLOW***" MERR
	THEN
	;

'PISTOL< : (PISTOL<) <V ;


(PISTOL<)	'BRANCH-LIST	VARIABLE

'BRANCH :	% CREATES AN ARRAY OF TWO ELEMENTS
		% AND A PROCEDURE THAT PUSHES A ^
		% TO THE FIRST ELEMENT OF THE ARRAY
		% THIS FIRST ELEMENT CONTAINS A ^
		% TO THE CURRENT HEAD OF THE VOCABULARY
		% BRANCH AND THE SECOND ELEMENT IS A
		% BACKWARD LINK TO THE PREVIOUS HEAD.
		% BRANCH-LIST CONTAINS THE ^ TO THE
		% THREADED LIST OF BRANCHES THAT HAVE
		% BEEN DEFINED; THE BACKWARD LINK FOR
		% (PISTOL<) IS "NIL"
	: 3 <V ; .D W@ ARGPATCH
	0 .D W@ W!
	BRANCH-LIST W@ .D W@ W+
	W!
	.D W@ BRANCH-LIST
	W!
	2 ALLOT
	;

'SYSTEM< BRANCH	% CAN BE USED FOR RARELY USED, OBSCURE,
		% OR DANGEROUS WORDS


'BLIST :	% LISTS THE NAMES OF ALL DEFINED BRANCHES
	BRANCH-LIST W@
	BEGIN
		DUP W+ W@ DUP	% GET LINK
		IF
			SWAP 6 W* -
			W@ MSG CR
	REPEAT
	DROP DROP
	IFCR
	'PISTOL< MSG
	;

% DO LOOP INDICES:
'I : 0 L@ ;
'J : 3 L@ ;
'K : 6 L@ ;

'I' : 2 L@ 1 L@ + 1- 0 L@ - ;
'J' : 5 L@ 4 L@ + 1- 3 L@ - ;
'K' : 8 L@ 7 L@ + 1- 6 L@ - ;

% SOME LOGICAL OPERATORS:

'LOR : IF DROP TRUE THEN ;		% LOGICAL OR

'LAND : IF ELSE DROP FALSE THEN ;	% LOGICAL AND

'NOT : IF FALSE ELSE TRUE THEN ;

% NUMBER OUTPUT ROUTINE:

% ASCII <-- DIGIT
'ASCII : DUP 9 GT IF 55
		ELSE 48
	THEN + ;


'MINUS : 0 SWAP - ;

'<U#> : -1 SWAP BEGIN RADIX W@ /MOD SWAP DUP NOT END DROP ;

'#TYPE : BEGIN DUP -1 GT IF ASCII TYO REPEAT DROP ;

'= : DUP 0 LT IF  45 TYO MINUS THEN
	<U#> #TYPE ;
'? : W@ = ;

% BELOW ARE WORDS THAT CONTROL DISPLAY OF CODE PRODUCED
% BY THE COMPILER; CAN BE USEFUL FOR DEBUGGING AND EDUCATION

'CODESHOW : IFCR "COMPILE BUFFER CONTAINS:" MSG CR
	COMPBUF	BEGIN DUP ? TAB W+
			.C W@ OVER GT NOT
		END
	DROP IFCR
	;
'SHOWCODE : 'CODESHOW FIND COMPILE-END-PATCH W! ;
% SHOWCODE SHOULD NOT BE CHANGED WITHOUT CHECKING 'DIS PACKAGE

'NOSHOWCODE : COMPILE-END-PATCH OFF ;

'PROMPT :	% DUPLICATES PRIMITIVE PROMPT
	IFCR	% FUNCTION
	SP IF SP = THEN	% EXCEPT STACK SIZE SHOWN
	RADIX-INDICATOR C@ TYO
	SYNTAXBASE MSG
	"> " MSG
	;
'PROMPT FIND PROMPT-PATCH W!	% PATCHING IT

0 'FENCE VARIABLE

'ADDRESS : DUP FIND DUP IF UNDER
			ELSE IFCR
				39 TYO DROP MSG
				" NOT FOUND" MERR
			THEN ;


'FORGET : ADDRESS DUP FENCE W@
	GT IF % ADDRESS OK, SO TRUNCATE EVERYTHING:
	DUP W- W- W@ DUP OLD-EOSTRINGS W!
	CURRENT-EOSTRINGS W!
	W- W- W- DUP W@ CURRENT W@ W! W- .D W!
	ELSE % ADDRESS BELOW FENCE
		"BELOW FENCE" MERR THEN ;

% PROTECT 'FORGET WITH THE FENCE:

'FORGET FIND FENCE W!


'/ : /MOD DROP ;
'MOD : /MOD UNDER ;


% CHANGING NUMBER BASES:
'HEX : 72 RADIX-INDICATOR C! 16 RADIX W! ;
'DECIMAL : 88 RADIX-INDICATOR C! 10 RADIX W! ;
'OCTAL : 81 RADIX-INDICATOR C! 8 RADIX W! ;
'BINARY : 66 RADIX-INDICATOR C! 2 RADIX W! ;

'LTZ	: 0 LT	;
'GTZ	: 0 GT	;
'EQZ	: NOT	;
'ABS	: DUP LTZ IF MINUS THEN ;
'EQ	: - NOT ;
'MIN : DDUP GT IF SWAP THEN DROP ;

'MAX : DDUP LT IF SWAP THEN DROP ;

% RANGE TEST:
'.. : 2OVER LT SWAP 2OVER GT LOR NOT UNDER ;


%
'STACK : IFCR 40 TYO SP = 41 TYO % (STACKSIZE)
	SP SP 12 MIN 1- 0 DO 2 SPACES DUP S@ = 1- LOOP
	DROP ;
%
'RSTACK : IFCR 'R( MSG RP 1- = 41 TYO % RSTACK SIZE
	RP 1- DUP 12 MIN 0 DO 2 SPACES DUP R@ = 1-
	LOOP DROP ;

% RECURSE ALOWS ROUTINE OR COMPBUF TO CALL ITSELF
'RECURSE :	1 R@ W-	% FIND ADDRESS OF WORD RECURSE IS IN
		0 R@ W- % FIND WHERE RECURSE IS USED
		W!	% "PATCH"
		R> W- <R % BACK UP INSTRUCTION POINTER
	;
%
'TELL : W- W- W@ DUP STRINGSMIN STRINGSMAX .. IF MSG
		ELSE "NOT VALID WORD ADDRESS" MERR THEN
	;
'NEXT-LINK : W- W- W- W@ ;
%
% THIS BOMBS WHEN > NUMINSTRUCTIONS
'PNAME : DUP IF
		LAST-PRIMITIVE
		BEGIN	DUP
			IF	DDUP W@ EQ
				IF	TELL	TRUE
				ELSE	NEXT-LINK FALSE
				THEN
			ELSE	'(NO_NAME) MSG	NOT
			THEN
		END
		DROP
	    ELSE '; MSG DROP
	    THEN
	;
%
'NAME : DUP KERNEL? IF
	PNAME
	ELSE TELL
	THEN ;
% LLIST ADDRESS AND NAME:
'LNAME : DUP = 3 SPACES NAME CR ;
%
% LIST LAST TEN WORDS:
'NEXT10 : IFCR 10 0 DO DUP NOT IF ERR THEN
		DUP LNAME NEXT-LINK LOOP ;
'TOP10 : % OF VOCBULARY TO WHICH DEFINITIONS ARE
	 % CURRENTLY BEING ADDED

	CURRENT W@ W@ NEXT10 ;

'VLIST : % TOP TEN WORDS IN FIRST VOCABULARY TO BE SEARCHED
	.V W@ W@ W@ NEXT10 ;

% CASE INDICES:
'ICASE : 0 CASE@ ;
'JCASE : 2 CASE@ ;
'CASE-ADDR : 1 CASE@ ;
'(ENDCASE) : IFCR "ENDCASE ENCOUNTERED WITH VALUE = " MSG
	ICASE = " AT " MSG CASE-ADDR = ERR ;
'(ENDCASE) ADDRESS ENDCASE-PATCH W! % PATCH ENDCASE
'(ENDCASE) ADDRESS FENCE W! % RAISE FENCE

% SPECIAL STRING ROUTINES:

% PACK puts TOS onto the end of the strings area.
'PACK : CURRENT-EOSTRINGS W@ C!
	CURRENT-EOSTRINGS 1+W! ;

'=PACK : CURRENT-EOSTRINGS W@ <R
	CURRENT-EOSTRINGS 1+W!
	DUP LTZ IF 45 PACK MINUS THEN
	<U#> BEGIN DUP -1 GT IF ASCII PACK REPEAT
	DROP R> CURRENT-EOSTRINGS W@ OVER -
	1- OVER C! ;
% =PACK IS USED TO CREATE A NUMBER STRING. IT
% TAKES THE TOP SIGNED NUMBER ON STACK AND CONVERTS IT
% TO A STRING THAT COULD BE OUTPUT BY MSG

% THE NEXT TWO ROUTINES TAKE AS INPUT
% A BUNCH OF STRING POINTERS
% AND THEIR NUMBER FROM THE TOP OF STACK.
'MSGS-COUNT : SP 1- OVER LT IF "NOT ENOUGH STRINGS"
	MERR THEN
	0 SWAP 1+ 1 DO I S@ C@ + LOOP ;

'MSGS : DUP <R DUP <R MSGS-COUNT LINE-SPACE?
	R> 0 DO I' S@ MSG LOOP R> 0 DO DROP LOOP
	;
% In the above, MSGS will output a bunch of strings
% that were left on stack IN THE ORDER they were placed
% on stack, trying to place them all on the same line;
% failing that, it will try and not split the individual
% strings across lines.  It will be used to improve the

% DISASSEMBLER PACKAGE

'DIS-TRIAL :	% CONTAINS ALL REL-OPS IN THE KERNEL
	DO +LOOP
	DO LOOP
	IF ELSE
	THEN
	OFCASE C: ;C ENDCASE
	: ;
	$: ;$
;
'NEXT-TRIAL :	% CONVENIENCE TO STEP THROUGH DIS-TRIAL
	W+ W+ DUP W@
	;
'OP-TYPE :	% USED TO DEFINE WORDS FOR TESTING KERNEL OPS
	DUP	:
		3 EQ IF "" TRUE ELSE FALSE THEN
		;
		CURRENT W@ W@ 6 W* + W!	% GET THE NAME OF
					% DEFINITION
		ARGPATCH	% RECORD THE VALUE OF OPCODE
	;

'3OVER FIND	% IT STARTS WITH A LITERAL CONSTANT
W@ 'LITERAL	CONSTANT

'SHOWCODE FIND	% IT STARTS WITH A STRING LITERAL
W@ 'STRING-LIT	CONSTANT

'TRANS FIND	% IT IS A "$:" WORD
W- W@ '[$:]	OP-TYPE

'DIS-TRIAL FIND
DUP W- W@ '[:]		OP-TYPE
NEXT-TRIAL '(+LOOP)	OP-TYPE
NEXT-TRIAL '(DO)	OP-TYPE
NEXT-TRIAL '(LOOP)	OP-TYPE
NEXT-TRIAL '(IF)	OP-TYPE
NEXT-TRIAL '(ELSE)	OP-TYPE
NEXT-TRIAL '(OFCASE)	OP-TYPE
NEXT-TRIAL '(C:)	OP-TYPE
W+ W+
NEXT-TRIAL '(:)		OP-TYPE
NEXT-TRIAL '(;)		OP-TYPE
W-
NEXT-TRIAL '($:)	OP-TYPE
DROP

'REL-OP	:
	SWAP W+ W@ =PACK
	" [" SWAP ']
	4 MSGS W W+
	;
'DIS-TOKEN :
	DUP W@ OFCASE
	(;)	C: MSG DROP W ;C
	LITERAL EQ	C: W+ W@ =PACK MSG W W+ ;C
	STRING-LIT EQ	C: W+ W@ '" SWAP OVER
				3 MSGS W W+	;C
	(DO)	C: REL-OP ;C
	(LOOP)	C: REL-OP ;C
	(+LOOP)	C: REL-OP ;C
	(IF)	C: REL-OP ;C
	(ELSE)	C: REL-OP ;C
	(OFCASE) C: REL-OP ;C
	(C:)	C: REL-OP ;C
	(:)	C: REL-OP ;C
	($:)	C: REL-OP ;C
	TRUE	C: NAME DROP W ;C
	ENDCASE
	;
'WORD-ID : IFCR 39 TYO DUP MSG SPACE ADDRESS ;

'DIS : WORD-ID
	DUP W- DUP W@ DUP
	[:] IF MSG DROP
	ELSE [$:] IF MSG
		ELSE "NON-STANDARD IMMEDIATE WORD"
			MERR
		THEN
	THEN
	W- W- W- W@	% GET ^ TO END OF CODE
	SWAP	DO
		TAB I DIS-TOKEN
		+LOOP
	TAB '; MSG
;

% TRACE PACKAGE:

% ROUTINE THAT DISPLAYS THE STATE OF THE MACHINE
% AT EACH TRACE AND TERMINATES TRACE AT END OF
% ROUTINE BEING TRACED.
'(TRACE) : STACK 48 INDENT 0 R@ W@ DUP
	(;)	IF MSG DROP 0 TRACE-LEVEL W!
		ELSE NAME 2 SPACES
		THEN
	;
% PERFORM PATCH:
'(TRACE) ADDRESS TRACE-ADDR W!

'TRACE : WORD-ID "BEING TRACED:" MSG
		RP 3 + TRACE-LEVEL W!
		EXEC IFCR "TRACE COMPLETED" MSG
		CR
	;


% EDIT PACKAGE:


-31 TRANS	'OUTFILE-STATUS		CONSTANT
-30 TRANS	'INPUTFILE-STATUS	CONSTANT
STRINGSMAX 200 -
	'SAFE-END		CONSTANT
1	'OLDLINE#	VARIABLE
EDITBUF	'OLDLINE^	VARIABLE
EDITBUF		'EOT	VARIABLE

'NEWF : 1 OLDLINE# W!
	EDITBUF OLDLINE^ W!
	0 EDITBUF C!
	EDITBUF EOT W!
	;

NEWF	% INITIALIZE EDITBUFFER

'NEXTLINE : DUP C@ DUP IF + 1+
		ELSE "***NO SUCH LINE***" MERR
		THEN ;

'LISTALL : 1 EDITBUF
	BEGIN DUP C@
	IF OVER = ": " MSG DUP MSG NEXTLINE
	SWAP 1+ SWAP REPEAT DROP DROP ;

'ILLEGLIN : "***ILLEGAL LINE #***" MERR ;


'LFIND : DUP OLDLINE# LT IF DUP 1 LT
		IF ILLEGLIN THEN
		DUP MAXLINNO GT IF ILLEGLIN THEN
		EDITBUF OVER 1 DO
			NEXTLINE LOOP
		ELSE DUP OLDLINE#	% CALCULATE # OF
			- OLDLINE^ W@	% LINES NEEDED TO
			SWAP 0 DO
			NEXTLINE LOOP	% ADVANCE
		THEN
		SWAP OLDLINE# W!
		DUP OLDLINE^ W!
	;

'LDIR : % CHARACTER BLOCK MOVE, INCREASING
	% ON ENTRY: SOURCE, DESTINATION, #
	% ON EXIT: SOURCE+#, DESTINATION+#

	0 DO OVER C@ OVER C!
		1+ SWAP 1+ SWAP
	LOOP
	;

'LDDR :	% CHARACTER BLOCK MOVE, DECREASING
	% ON ENTRY: SOURCE, DESTINATION, #
	% ON EXIT: SOURCE-#, DESTINATION-#

	0 DO
	OVER C@ OVER C!
	1- SWAP 1- SWAP
	LOOP
	;

'#GETLINE :	% TAKES THE LINE NUMBERED BY THE
		% TOP OF THE STACK AND TRANSFERS
		% IT INTO LINEBUF
		LFIND
		LINEBUF 1+ NEXTCH^ W!	% SYSTEM ^S
		LINEBUF
		OVER C@ 1+
		LDIR
		DROP DROP
		ECHO W@ IF LINEBUF MSG THEN	% ECHO IF
						% APPROPRIATE
	;

'#GETLINE FIND #GET-ADDR W!	% DO THE PATCH


'MTUP :	% ON ENTRY: ^ TO BAS OF BLOCK BOUNDED BY EOT
	% ON EXIT: ^ TO BASE OF MOVED BLOCK AT STRINGSMAX

	EOT W@ 1+ SWAP -	% # BYTES
	EOT W@ SWAP	% SOURCE
	STRINGSMAX SWAP	% DESTINATION
	LDDR
	UNDER 1+
	;

'OVERWRITE :	% TAKES THE ^BOTTOM OF TEXT TO BE MOVED DOWN
		%	^TEXT TO BE OVERWRITTEN
		% AND	^LAST CHAR OF TEXT TO BE MOVED DOWN

		% ON EXIT LEAVES NO ARGS BUT HAS ADJUSTED EOT

	1+ 2OVER -
	LDIR
	1-
	EOT W!
	DROP
	;


'MTDN :	% ON ENTRY: ^ TO BASE OF BLOCK AT STRINGSMAX
	%	AND ^ TO BASE OF DESTINATION

	STRINGSMAX
	OVERWRITE
	;



'LENTER : % TAKES ADDRESS ON TOP OF STACK AND MOVES INPUT
	  % LINE THERE; LEAVES A POINTER TO NEXT AVAILABLE
	  % LOCATION.
	LINEBUF NEXTLINE LINEBUF
	DO
		I C@ OVER C! 1+
	LOOP
	;

'1POSARG? :	% TESTS STACK TO SEE IF THERE IS EXACTLY
		% ONE ARGUMENT; IT MUST BE POSITIVE.

		% ON EXIT IT LEAVES THAT ARGUEMENT.

	SP 1 EQ OVER -1 GT LAND
	NOT
	IF "NOT SINGLE, POSITIVE ARGUEMENT" MERR
	THEN
	;

'ARG#ERR : "WRONG NUMBER OF ARGUMENTS" MERR ;

'LI : SP OFCASE
	EQZ	C: LISTALL ;C
	1 EQ	C: LFIND MSG ;C
	2 EQ	C: DDUP GT IF OVER + 1- THEN
			1+ SWAP DO I = ": " MSG
					I LFIND MSG LOOP ;C
	TRUE	C: ARG#ERR ;C
	ENDCASE
	;


'INPUT :
	1POSARG?
		DUP
		LFIND
		MTUP
		SWAP DUP LFIND
		BEGIN
			SWAP DUP
			= ": " MSG
			1+ SWAP
			GETLINE
			LINEBUF C@ 1 GT
		IF
			LENTER
		REPEAT
		UNDER
		MTDN
	;

'(DELETE) :	LFIND
		DUP NEXTLINE
		SWAP
		EOT W@
		OVERWRITE
	;

'DELETE : 1POSARG?
		(DELETE)
	;

'REPLACE : 1POSARG?
		DUP
		(DELETE)
		INPUT
	;

'DELETES : SP 2 EQ
		IF
		DDUP LT IF OVER - 1+ THEN % IF ARG1<ARG2
					% THEN INTERPRET
					% AS RANGE !
			0 DO DUP (DELETE) LOOP
			DROP
		ELSE
			ARG#ERR
		THEN
	;

'1READ :	% NO ERROR CHECKING
		% TAKES A LINE FROM THE INPUT FILE AND
		% APPENDS IT TO THE END OF THE
		% TEXT IN THE EDIT BUFFER.

	READLINE
	0 EOT W@
	LENTER
	DUP
	EOT W!	% UPDATE EOT
	C!	% EMPLACE NEW EMPTY LINE
	;

'READ :	% TAKES A SINGLE ARGUMENT FROM STACK AS THE
	% NUMBER OF LINES TO BE READ FROM THE INPUT
	% FILE AND APPEND THEM TO THE END OF THE EDIT
	% BUFFER.

	1POSARG?
	BEGIN
		EOT W@ SAFE-END LT
		OVER LAND
	IF
		1READ
		1-	% DECREASE COUNT
	REPEAT
	IF
		"PREMATURE EOF ENCOUNTERED" MSG
	THEN
	;

'WRITE :	% TAKES A SINGLE ARGUMENT FROM STACK AS
		% THE NUMBER OF LINES TO BE TRANSFERRED
		% FROM THE BEGINNING OF THE EDIT BUFFER
		% TO THE OUTPUT FILE.
	1POSARG?
	1 LFIND	% ADJUSTS POINTERS
	BEGIN	% IF NOT EOT, STILL MORE LINES TO SEND
		DUP C@ 2OVER LAND
	IF
		DUP WRITELINE
		NEXTLINE
		SWAP 1- SWAP
	REPEAT
		% AT THIS POINT HAVE POINTER TO TEXT
		% THAT IS NOT YET SENT AND NUMBER OF LINES
		% YET TO BE SENT AFTER EOT

	EDITBUF	% DESTINATION
	EOT W@
	OVERWRITE
	IF IFCR "PREMATURE EOT ENCOUNTERED" MSG THEN
	;


'FINISH :	% USED AT END OF EDIT SESSION TO TRANSFER
		% CONTENTS OF EDIT BUFFER AND ANY ADDITIONAL
		% REMAINING TEXT IN THE INPUT FILE TO THE
		% OUTPUT FILE.

	EDITBUF
	BEGIN	% EMPTY EDIT BUFFER
		DUP C@
	IF
		DUP
		WRITELINE
		NEXTLINE
	REPEAT
	DROP
	NEWF
	BEGIN	% TRANSFER REMAINDER OF INPUT FILE
		INPUTFILE-STATUS
		W@ -1 GT
	IF
		READLINE
		LINEBUF WRITELINE
	REPEAT
	% SUMARIZE:
	IFCR
	"SUMARIZING: " MSG
	INPUTFILE-STATUS W@ MINUS =
	" LINES READ AND " MSG
	OUTFILE-STATUS W@ MINUS =
	" LINES WRITTEN." MSG
	% CLOSING STATUS OF OUTPUT FILE:
	+1 OUTFILE-STATUS W!
	;


% TEST INPUT:
1 INPUT
THIS IS THE FIRST LINE
THIS IS THE SECOND LINE
THIS IS THE THIRD LINE
THIS IS THE FOURTH LINE
THIS IS THE LAST LINE




;F


