(*********************************************************)
(*							 *)
(* PISTOL-Portably Implemented Stack Oriented Language	 *)
(*			Version 2.0			 *)
(* (C) 1983 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 *)
(* included.						 *)
(*							 *)
(*********************************************************)

PROGRAM PISTOL(INPUT:/);
(*SEP 7, 1982: DOTDOT *)
(* SEP 4:CRDMP,INIT,MININT *)
(* AUG 30:FIX OF TTYI FOR LINE ORIENTATION *)
(*$C- JULY 19.., 1982 -> VER2.0;USER->USR *)
(* JULY 13: CHANGED MOVE,FENTER;DEFINED NEWLINE *)
(* JULY 12: REMOVED SCRATCH -10..-8;DEFINED FNAME *)
(* JULY 8: VFIND MADE PRIMITIVE;PREV -.>USR+W*6 *)
(*JULY 5,82:FIND,VFIND REDEFINED*)
(*JUNE 28,82: POP ADDED*)
(*JUNE 17,82: KRNQ->PRMQ ; KERNEL?->PRIMITIVE? *)

(*DECEMBER 22, 1981 --FOR BEST PERFORMANCE IN PASCAL,
	THIS PROGRAM SHOULD BE EDITED TO MAKE FULL USE
	OF THE OPTIONS, USR=0,W=1,S=1,CSTEP=1,L=1,R=1
	AND STRINGSMIN=-1 *)

LABEL 99;
CONST
VERSION=20;(*10* THE VERSION NUMBER,READABLE BY USER*)
USR=0;(*DISPLACEMENT FOR USER'S RAM AREA; IT SHOULD
	BE CHANGED TO SIMPLIFY ADDRESS CALCULATION IN
	ASSEMBLY CODE IMPLEMENTATIONS*)
W=1;(*RAM ADDRESS INCREMENT SIZE; TYPICALLY WOULD BE
	2 OR 4 FOR 8-BIT MICROS AND OTHER BYTE ADDRESSABLE
	MACHINES*)
R=1;(*INCREMENT SIZE FOR RSTACK,HIDDEN FROM USER*)
S=1;(*INCREMENT SIZE FOR (PARAMETER) STACK,HIDDEN*)
STACKMIN=0;(*WHATEVER IS CONVENIENT,HIDDEN FROM USER*)
MSTACKMIN=-3;(*STACKMIN-S*3*)
PSTACKMAX=203;(*STACKMAX+S*3*)
STACKMAX=200;(*STACKMIN+SSIZE*S*)
LSTACKMIN=0;(*WHATEVER IS CONVENIENT,HIDDEN FROM USER*)
L=1;(*LSTACK INCREMENT,HIDDEN FROM USER*)
LSTACKMAX=30;(*LSTACKMIN+LSIZE*L*)
CSTACKMIN=0;(*WHATEVER IS CONVENIENT*)
CSTEP=1;(*CSTACK INCREMENT*)
CSTACKMAX=30;(*CSTACKMIN+CSIZE*CSTEP*)
NUMINSTR=73;
RAMMIN=-21(*USR-W*21,OR LOWER,READABLE*);
NEWLINE=10;(*ASCII TOKEN USED TO MARK LINE END,
		USUALLY A CR OR A LF *)
MAXORD=127;(*7 BIT FOR DEC-20,READABLE*)
RAMMAX=8000;(*=RAMMIN+W*5000 AT LEAST,READABLE BY USER*)
COMPBUF=7000;(*=RAMMAX-W*200,OR LOWER,READABLE BY USER*)
SSIZE=200;(*READABLE BY USER*)
RSIZE=30;(*READABLE BY USER*)
RSTACKMIN=0;(*ARBITRARY,HIDDEN*)
RSTACKMAX=30;(*RSTACKMIN+R*RSIZE*)
LSIZE=30;(*READABLE BY USER*)
CSIZE=30;(*READABLE BY USER*)
(*VOCABULARY STACK IS LOCATED IN RAM*)
VSIZE=8;(*VOCAB STACK,READABLE BY USER*)
VBASE=41;
STRINGSMIN=8000(*READABLE BY USER*);
(*IF STRINGSMIN>RAMMAX,PROTECTION IS MORE COMPLETE*)
SYNTAXBASE=8001(*STRINGSMIN+1*);
STRINGSMAX=13500;(*STRINGSMIN+ 3500..5500 INTENDED FOR EDIT AREA *)
MAXLINNO=300;(*MAX # OF LINES POSSIBLE IN EDIT BUFFER,
		READABLE BY USER*)
LINEBUF=11300;(*STRINGSMIN+3300,READABLE BY USER*)
CHKLMT=20(*SIZE OF CHECK STACK,READABLE BY USER*);
FALS=0; TRU=-1;

(* OPCODES WHOSE VALUES ARE NOT CRITICAL; THEY MUST BE
   UNIQUE AND RECOGNIZEABLE BY PRIMQ, AND SEPERABLE
   INTO PINT1 AND PINT2 *)
	PSEMICOLON=0;
	WSTORE=1;
	TIMES=2;
	PLUS=3;
	SUBTRACT=4;
	DIVMOD=5;
	PIF=6;
	WAT=7;
	ABRT=8;
	SP=9;
	LOAD=10;
	PELSE=11;
	WRD=12;
	RP=13;
	DROPOP=14;
	PUSER=15;
	EXEC=16;
	EXITOP=17;
	LIT=18;
	STRLIT=19;
	RPOP=20;
	SWP=21;
	TYI=22;
	TYO=23;
	RPSH=24;
	SEMICF=25;
	RAT=26;
	COMPME=27;
	COMPHERE=28;
	DOLLARC=29;
	COLON=30;
	SEMICOLON=31;
	IFOP=32;
	ELSEOP=33;
	THENOP=34;
	DOOP=35;
	LOOPOP=36;
	BEGINOP=37;
	ENDOP=38;
	REPET=39;
	PERCENT=40;
	PDOLLAR=41;
	PCOLON=42;
	CASAT=43;
	PDOOP=44;
	PPLOOP=45;
	PLLOOP=46;
	CAT=47;
	CSTORE=48;
	PLOOP=49;
	DOTDOT=50;
	SEMIDOL=51;
	PRMQ=52;
	CORDMP=53;
	RESTOR=54;
	SAT=55;
	FINDOP=56;
	LISTFIL=57;
	VFINDOP=58;
	LAT=59;
	OFCAS=60;
	CCOLON=61;
	SEMICC=62;
	NDCAS=63;
	POFCAS=64;
	PCCOL=65;
	PSEMICC=66;
	GTLIN=67;
	WORD=68;
	OPENR=69;
	OPENW=70;
	READL=71;
	WRITL=72;
(* END OF OPCODE DECLARATIONS *)




TYPE DALFA = PACKED ARRAY[1..20] OF CHAR;

IMAGE=	RECORD
	STRINGS:PACKED ARRAY[STRINGSMIN..STRINGSMAX] OF CHAR;
	RAM:ARRAY[RAMMIN..RAMMAX] OF INTEGER;
	END(*RECORD*);

IMFILE=FILE OF IMAGE;

VAR
IMAGENAME,NAMEIN,NAMOUT,INFIL,LISTNAME,NULLNAME:DALFA;
IP:INTEGER;(*INSTRUCTION POINTER*)
INSTR:INTEGER;(*INSTRUCTION CURRENTLY EXECUTED BY INTERPRET*)
SAVINSTR:INTEGER(*SAVES INSTR DURING TRACING*);
SAVLEVEL:INTEGER(*SAVES LEVEL DURING TRACING*);
TEMP: INTEGER;
EDIN,EDOUT,LDFIL,LIST,OUTPUT:TEXT;
(*SAVEFILE:IMFILE; IN CRDMP,RSTOR ROUTINES *)
READV,WRITV:INTEGER;(*READ_PROTECT,WRITE_PROTECT*)
NOPEN,FEOF,UNDFLO,OVFLO,SYNT,ID,REDEF,ADDR,VAL,I,DIVBY0:INTEGER;
C:CHAR;
KEYCURS,KEYLEN:INTEGER;
KEYSTRING:PACKED ARRAY[0..MAXORD] OF CHAR;

(* CONSTANTS:
	RAM[..RAMMIN-W]=FUTURE CONSTANTS
	RAM[USR-W*21]=MININT
	RAM[USR-W*20]=MAXLINNO
	RAM[USR-W*19]=CHKLMT
	RAM[USR-W*18]=RAMMIN
	RAM[USR-W*17]=STRINGSMIN
	RAM[USR-W*16]=STRINGSMAX
	RAM[USR-W*15]=VBASE
	RAM[USR-W*14]=VSIZE
	RAM[USR-W*13]=CSIZE
	RAM[USR-W*12]=LSIZE
	RAM[USR-W*11]=RSIZE
	RAM[USR-W*10]=SSIZE
	RAM[USR-W*9]=LINEBUF
	RAM[USR-W*8]=COMPBUF
	RAM[USR-W*7]=RAMMAX
	RAM[USR-W*6]=MAXORD
	RAM[USR-W*5]=MAXINT
	RAM[USR-W*4]=VERSION TIMES TEN
	RAM[USR-W*3]=NEWLINE CHAR
	RAM[USR-W*2]=READ PROTECTION BOOLEAN
	RAM[USR-W*1]=WRITE PROTECTION BOOLEAN
   VARIABLES:
	RAM[USR+W*0]=RADIX
	RAM[USR+W*1]=.C
	RAM[USR+W*2]=.D
	RAM[USR+W*3]=CURRENT END OF STRINGS
	RAM[USR+W*4]=OLD END OF STRINGS
	RAM[USR+W*5]=CURRENT
	RAM[USR+W*6]=PREV(VFIND)
	RAM[USR+W*7]=INPUT FILE
	RAM[USR+W*8]=LIST OUT BOOLEAN
	RAM[USR+W*9]=ECHO OUT BOOLEAN
	RAM[USR+W*10]=CONSOLE OUT BOOLEAN
	RAM[USR+W*11]=NEXTCHAR POINTER
	RAM[USR+W*12]=LINELENGTH
	RAM[USR+W*13]=RAISE BOOLEAN LC->UC
	RAM[USR+W*14]=HEAD OF TOKEN IN LINE
	RAM[USR+W*15]=TRACE BOOLEAN AND LEVEL
	RAM[USR+W*16]=COMPILE_END PATCH
	RAM[USR+W*17]=TERMINAL PAGE LENGTH
	RAM[USR+W*18]=#LINE OUTPUT TO CONSOLE
	RAM[USR+W*19]=TERMINAL WIDTH
	RAM[USR+W*20]=COLUMN
	RAM[USR+W*21]=ENDCASE PATCH ADDRESS
	RAM[USR+W*22]=TRACE PATCH ADDRESS
	RAM[USR+W*23]=TABSIZE
	RAM[USR+W*24]=#GETLINE PATCH ADDRESS
	RAM[USR+W*25]=FILE STATUS FOR LDFIL
	RAM[USR+W*26]=FILE STATUS FOR EDIN
	RAM[USR+W*27]=FILE STATUS FOR EDOUT
	RAM[USR+W*28]=^ VSTACK
	RAM[USR+W*29]=^PISTOL<
	RAM[USR+W*30]=NIL,TERMINATES VLIST
	RAM[USR+W*31]=SESSION DONE BOOLEAN
	RAM[USR+W*32]=PROMPT PATCH ADDRESS
	RAM[USR+W*33]=CONVERSION PATCH
	RAM[USR+W*34]=ABORT PATCH
	RAM[USR+W*(35..VBASE-1)]=FUTURE VARIABLES EXPANSION
	RAM[VBASE..VBASE+W*VSIZE]=VSTACK
	RAM[...]=INFO SAVED DURING AN ABORT, SUCH AS
	OFFENDING INSTRUCTION,LOCATION,RETURN STACK
*)

MEMORY:IMAGE;
STKPTR:INTEGER;
RPTR:INTEGER;
LPTR:INTEGER;
CPTR:INTEGER;

(*	STRINGS[STRINGSMIN] RADIX INDICATOR
	STRINGS[SYNTAXBASE] DEPTH OF NESTING &
			CHECKSTACK POINTER	*)
RSTACK:ARRAY[RSTACKMIN..RSTACKMAX] OF INTEGER;
STACK:ARRAY[MSTACKMIN..PSTACKMAX] OF INTEGER;
LSTACK:ARRAY[LSTACKMIN..LSTACKMAX] OF INTEGER;
CSTACK:ARRAY[CSTACKMIN..CSTACKMAX] OF INTEGER;
(* VSTACK LOCATED IN LOW RAM *)

FUNCTION MAX(M,N:INTEGER):INTEGER;
	BEGIN
	IF M>N
	THEN MAX:=M
	ELSE MAX:=N
	END(*MAX*);

PROCEDURE ABORT;
FORWARD;(*RECURSION NEEDED HERE ONLY FOR CARRET,BELOW:*)

PROCEDURE TTYI;
	FORWARD;

FUNCTION POP:INTEGER;
	FORWARD;


PROCEDURE CARRET(*OUTPUTS A CR-LF SEQUENCE*);
BEGIN
WITH MEMORY DO BEGIN
	IF RAM[USR+W*10]<>FALS
	THEN	BEGIN
		RAM[USR+W*18]:=RAM[USR+W*18]+1;
		IF RAM[USR+W*18]=RAM[USR+W*17]
		THEN	BEGIN
			TTYI;
			RAM[USR+W*18]:=0;
			C:=CHR(POP);
			IF (C='Q') OR (C='q') THEN ABORT;
			END;
		RAM[USR+W*20]:=0;
		WRITELN(OUTPUT);
		END;
	IF RAM[USR+W*8]<>FALS THEN WRITELN(LIST);
END(*WITH MEMORY*);
END(*CARRET*);


PROCEDURE SPACES(NUM:INTEGER);
FORWARD; (* NEEDED BY TAB, BELOW: *)

PROCEDURE TAB;
	BEGIN
WITH MEMORY DO BEGIN
	IF RAM[USR+W*23]>0
	THEN SPACES(RAM[USR+W*23]-(RAM[USR+W*20] MOD RAM[USR+W*23]));
END(*WITH MEMORY*);
	END(*TAB*);

PROCEDURE CHOUT(CH:CHAR);
(* OUTPUTS A CHARACTER*)
BEGIN
WITH MEMORY DO BEGIN
	IF CH=CHR(NEWLINE) THEN CARRET
	ELSE IF CH=CHR(9) THEN TAB
	ELSE	BEGIN
		IF RAM[USR+W*20]=RAM[USR+W*19] THEN CARRET;
		RAM[USR+W*20]:=RAM[USR+W*20]+1;
		IF RAM[USR+W*10]<>FALS THEN WRITE(OUTPUT,CH);
		IF RAM[USR+W*8]<>FALS THEN WRITE(LIST,CH);
		END
END(*WITH MEMORY*);
END(*CHOUT*);

PROCEDURE SPACES;
	BEGIN
	WHILE NUM>0 DO
		BEGIN
		CHOUT(' ');
		NUM:=NUM-1;
		END(*WHILE*)
	END(*SPACES*);


PROCEDURE MESSAGE(ST:INTEGER);
	VAR LAST:INTEGER;
	BEGIN
WITH MEMORY DO BEGIN
	IF ORD(STRINGS[ST])>0 THEN
		BEGIN
		LAST:=ST+ORD(STRINGS[ST]);
		REPEAT
			ST:=ST+1;
			CHOUT(STRINGS[ST]);
		UNTIL ST=LAST;
		END(*IF*)
END(*WITH MEMORY*);
	END(*MESSAGE*);

PROCEDURE INTERPRET(I:INTEGER);
	FORWARD;(*NEEDED IN ABORT,PROMPT
		FOR USER SUPPLIED PATCHES*)

PROCEDURE ABORT;
(*	RESETS STACKS
	RETURNS I/O TO TTY:
	PRODUCES SIGNON MSG	*)
	BEGIN
WITH MEMORY DO BEGIN
	IP:=COMPBUF;(*SO RAM[IP] IS NOT OUT OF RANGE*)
	RAM[USR+W*31]:=FALS;(*SESSION NOT DONE*)
	RAM[USR+W*28]:=VBASE;
	RAM[VBASE]:=USR+W*29;
	RAM[USR+W*5]:=USR+W*29;
	STKPTR := STACKMIN;
	RPTR := RSTACKMIN-R;
	CPTR := CSTACKMIN;
	LPTR := LSTACKMIN;
	STRINGS[SYNTAXBASE] := CHR(0);
	RAM[USR+W*7]:=FALS;(*RETURN TO CONSOLE INPUT*)
	RAM[USR+W*10]:=TRU;(*TURN ON CONSOLE OUTPUT*)
	IF LISTNAME=NULLNAME THEN RAM[USR+W*8]:=FALS;
	(*TURN OFF LISTING IF NO LISTFILE IS OPEN*)
	MESSAGE(ID);
	(* IFCR *)
	IF RAM[USR+W*20]<>0 THEN CARRET;
	RAM[USR+W*15]:=FALS;(*TURN TRACE OFF, IF NECESSARY*)
	IF RAM[USR+W*34]<>FALS
	THEN INTERPRET(RAM[USR+W*34]);(*USER SUPPLIED SUPPLEMENT TO ABORT*)
	GOTO 99;
END(*WITH MEMORY*);
	END(*ABORT*);

PROCEDURE MERR(M:INTEGER);(*MESSAGE-ERROR*)
	BEGIN
	MEMORY.RAM[USR+W*10]:=TRU;(*TURN ON CONSOLE*)
	(* IFCR *)
	IF MEMORY.RAM[USR+W*20]>0 THEN CARRET;
	MESSAGE(M);
	ABORT;
	END(*MERR*);

PROCEDURE SYNTERR;
	BEGIN
WITH MEMORY DO BEGIN
	RAM[USR+W*10]:=TRU; (*TURN ON CONSOLE*)
	(* IFCR *)
	IF RAM[USR+W*20]>0 THEN CARRET;
	IF (RAM[USR+W*7]<>FALS) AND (RAM[USR+W*9]=FALS) THEN MESSAGE(LINEBUF);
	MERR(SYNT);
END(*WITH MEMORY*);
	END(*SYNTERR*);



PROCEDURE PUSH(ITEM:INTEGER);	(*PARAMETER STACK*)
	BEGIN
	STKPTR:=STKPTR+S;
	IF STKPTR>=STACKMAX THEN MERR(OVFLO);
	STACK[STKPTR]:=ITEM;
	END(*PUSH*);

(*RSTACK USED FOR RETURN ADDRESSES ONLY;
	NOT FOR CASE OR LOOP STRUCTURES*)
PROCEDURE RPUSH(ITEM:INTEGER); (*ON RETURN STACK*)
	BEGIN
	RPTR:=RPTR+R;
	IF RPTR>=RSTACKMAX THEN MERR(OVFLO);
	RSTACK[RPTR]:=ITEM;
	END(*RPUSH*);

PROCEDURE LPUSH(ITEM:INTEGER);
	BEGIN
	LPTR:=LPTR+L;
	IF LPTR>=LSTACKMAX THEN MERR(OVFLO);
	LSTACK[LPTR]:=ITEM;
	END(*LPUSH*);

PROCEDURE CPUSH(ITEM:INTEGER);(*FOR CASE STACK*)
	BEGIN
	CPTR:=CPTR+CSTEP;
	IF CPTR>=CSTACKMAX THEN MERR(OVFLO);
	CSTACK[CPTR]:=ITEM;
	END(*CPUSH*);


PROCEDURE PUSHCK(CHKCH:CHAR);	(*PLACE ON CHARACTER CHECK STACK*)
	BEGIN
WITH MEMORY DO BEGIN
	STRINGS[SYNTAXBASE]:= CHR(ORD(STRINGS[SYNTAXBASE])+1);
	IF ORD(STRINGS[SYNTAXBASE])<CHKLMT
	THEN STRINGS[ORD(STRINGS[SYNTAXBASE])+SYNTAXBASE] := CHKCH
	ELSE	BEGIN
		RAM[USR+W*10]:=TRU; (*TURN ON CONSOLE*)
		MESSAGE(OVFLO);
		SYNTERR;
		END
END(*WITH MEMORY*);
	END(*PUSHCK*);

PROCEDURE TTYI;	(* FOR TYI *)
	VAR C:CHAR;
	BEGIN
	IF KEYCURS>KEYLEN
	THEN	BEGIN
		READLN(INPUT);
		KEYLEN:=0;
		WHILE NOT EOLN(INPUT)
		DO 	BEGIN
			READ(INPUT,C);
			KEYSTRING[KEYLEN]:=C;
			KEYLEN:=KEYLEN+1;
			END;
		KEYSTRING[KEYLEN]:=CHR(NEWLINE);
		KEYCURS:=0;
		END(*IF*);
	PUSH(ORD(KEYSTRING[KEYCURS]));
	KEYCURS:=KEYCURS+1;
	END(*TTYI*);

PROCEDURE APPEND(ITEM:INTEGER); (*PUT ITEM AT END OF DICTIONARY*)
	BEGIN
WITH MEMORY DO BEGIN
	RAM[RAM[USR+W*2]] := ITEM;
	RAM[USR+W*2] := RAM[USR+W*2]+W;
	IF RAM[USR+W*2]>=COMPBUF THEN MERR(WRITV);
END(*WITH MEMORY*);
	END(*APPEND*);



PROCEDURE ALOOP;(*USED BY (LOOP) AND BY (+LOOP) *)
	BEGIN
	IF LSTACK[LPTR]<LSTACK[LPTR-L]
	THEN (*BRANCH*) IP:=IP+MEMORY.RAM[IP]
	ELSE	BEGIN
		LPTR:=LPTR-L*3;
		IF LPTR<LSTACKMIN THEN MERR(UNDFLO);
		(*SKIP*) IP:=IP+W
		END
	END(*ALOOP*);


FUNCTION POP; (*LARGELY REPLACES DROP*)
	BEGIN
	IF STKPTR<S+STACKMIN THEN MERR(UNDFLO)
	ELSE	BEGIN
		POP:=STACK[STKPTR];
		STKPTR:=STKPTR-S;
		END
	END(*POP*);

PROCEDURE PDO;(* (DO) *)
VAR STRT,ND:INTEGER;
	BEGIN
	STRT:=POP;
	ND:=POP;
	IF STRT<ND
	THEN	BEGIN
		LPUSH(STRT);
		LPUSH(ND);
		LPUSH(STRT);(*ITERATION VAR*)
		(*SKIP*) IP:=IP+W
		END
	ELSE (*BRANCH*) IP:=IP+MEMORY.RAM[IP]
	END(*PDO*);


PROCEDURE DROPCK;
	BEGIN
WITH MEMORY DO BEGIN
	IF ORD(STRINGS[SYNTAXBASE])>0
	THEN STRINGS[SYNTAXBASE] := CHR(ORD(STRINGS[SYNTAXBASE])-1)
	ELSE SYNTERR
END(*WITH MEMORY*);
	END(*DROPCK*);


PROCEDURE VFIND;
(*PTOKEN POINTS TO THE LOCATION IN STRINGS THAT
	THE START OF THE TOKEN IS;  THIS TOKEN
	IS LOOKED UP IN VOCABULARY POINTED TO BY THE TOS
	AND THE ADDRESS IS RETURNED BY  THE TOS  *)
VAR	LOC:INTEGER;
	PTOKEN:INTEGER;

(*RETURNS POINTER TO PF IF MATCHED OTHERWISE LOC:=0*)
        LEN,TEM:INTEGER;
        MATCH:BOOLEAN;
        PREV:INTEGER;

	BEGIN
WITH MEMORY DO BEGIN
	LOC:=RAM[POP];
        PREV:=LOC;
	PTOKEN:=POP;
	IF (PTOKEN<STRINGSMIN) OR (PTOKEN>LINEBUF)
	THEN MERR(READV);(*READ_PROTECT*)
	LEN:=ORD(STRINGS[PTOKEN]);
	IF LOC<>FALS THEN
	REPEAT
		MATCH:=TRUE;
		IF STRINGS[RAM[LOC-W*2]]=CHR(LEN)
		THEN	BEGIN
			TEM:=0;
			REPEAT
				TEM:=TEM+1;
			UNTIL (STRINGS[RAM[LOC-W*2]+TEM])
				<>(STRINGS[PTOKEN+TEM]);
			IF TEM<(LEN+1) THEN
				MATCH:=FALSE;
			END(*THEN*)
		ELSE MATCH:=FALSE;
	IF NOT MATCH THEN BEGIN PREV:=LOC;
				LOC:=RAM[LOC-W*3]
			  END;
	UNTIL (MATCH) OR (LOC=FALS);
	PUSH(LOC);
	RAM[USR+W*6]:=PREV;
END(*WITH MEMORY*);
	END(*VFIND*);


PROCEDURE FIND;
VAR V:INTEGER;
	PTOKEN:INTEGER;
	LOC:INTEGER;
BEGIN
	PTOKEN:=POP;
	V:=MEMORY.RAM[USR+W*28];
	REPEAT
	PUSH(PTOKEN);
	PUSH(MEMORY.RAM[V]);
	VFIND;
	LOC:=POP;
	V:=V-W;
	UNTIL (V<VBASE) OR (LOC<>FALS);
	PUSH(LOC);
END(*FIND*);

(* HEADER:     ENDA:CODE END,NORMALLY POINTS TO RET
	      LINK :PREVIOUS EXECA
		NFA:STRINGS
	      COMPA:CF
	      EXECA:PF		*)
PROCEDURE ENTER(*CREATES AN ENTRY FOR TOKEN POINTED TO 
		BY TOP OF PARAMETER STACK*);
VAR PTKN:INTEGER;
	BEGIN
WITH MEMORY DO BEGIN
	PTKN:=STACK[STKPTR];;
	FIND;
	IF POP<>FALS THEN
		BEGIN
		MESSAGE(REDEF);
		SPACES(3);
		MESSAGE(PTKN);
		CARRET
		END(*IF*);
	APPEND(0);(*FOR ENDA*)
	APPEND(RAM[RAM[USR+W*5]]);
	APPEND(PTKN);
	APPEND(COMPHERE);(* (:) *)
	RAM[RAM[USR+W*5]]:=RAM[USR+W*2];(*CURRENT:=EXECA*)
END(*WITH MEMORY*);
	END(*ENTER*);

PROCEDURE FENTER;(*FINISH MOST RECENT ENTRY
			FILLING IN ENDA WITH I *)
	BEGIN
	WITH MEMORY DO BEGIN
	RAM[RAM[RAM[USR+W*5]]-W*4] := POP
	END(*WITH MEMORY*)
	END(*FENTER*);

PROCEDURE GEOLN;
(* ADVANCES TO EOLN*)
	BEGIN
	WITH MEMORY DO
	RAM[USR+W*11]:=ORD(STRINGS[LINEBUF])+LINEBUF;
	END(*GEOLN*);

PROCEDURE GETLINE;
(*BUFFERS INPUT LINE INTO STRINGS[LINEBUF]*)
VAR CH:CHAR;
BEGIN(*GETLINE*)
WITH MEMORY DO BEGIN
	RAM[USR+W*12]:=0;(*LINELENGTH*)
	RAM[USR+W*11]:=LINEBUF;
	IF RAM[USR+W*7]=FALS
	THEN	BEGIN
		READLN(INPUT);
		KEYCURS:=1+KEYLEN;(*RESET FOR TTYI*)
		WHILE NOT EOLN(INPUT) DO
			BEGIN
			READ(INPUT,CH);
			IF RAM[USR+W*8]<>FALS
				THEN WRITE(LIST,CH);
			RAM[USR+W*12]:=RAM[USR+W*12]+1;
			RAM[USR+W*11]:=RAM[USR+W*11]+1;
			STRINGS[RAM[USR+W*11]]:=CH;
			END(*WHILE*);

		IF RAM[USR+W*8]<>FALS
			THEN WRITELN(LIST);
		END(*THEN*);
	IF RAM[USR+W*7]<>FALS	(* CANNOT BE USED TO LOAD FROM EDITBUF*)
	THEN	BEGIN
		IF EOF(LDFIL) THEN MERR(FEOF);
		WHILE NOT EOLN(LDFIL) DO
			BEGIN
			READ(LDFIL,CH);
			RAM[USR+W*12]:=RAM[USR+W*12]+1;
			RAM[USR+W*11]:=RAM[USR+W*11]+1;
			STRINGS[RAM[USR+W*11]]:=CH;
			END(*WHILE*);
		READLN(LDFIL);
		IF EOF(LDFIL)	THEN RAM[USR+W*25]:=-RAM[USR+W*25]
				ELSE RAM[USR+W*25]:=RAM[USR+W*25]+1;
		END(*THEN*);
	STRINGS[LINEBUF]:=CHR(RAM[USR+W*12]+1);
	STRINGS[RAM[USR+W*11]+1]:=CHR(NEWLINE);
	RAM[USR+W*11]:=LINEBUF+1;
	(**ECHO:**)
	IF (RAM[USR+W*9]<>FALS) AND (RAM[USR+W*7]<>FALS)
	THEN MESSAGE(LINEBUF);

END(*WITH MEMORY*);
END(*GETLINE*);






PROCEDURE MOVE;
(*	AS:ADDRESS OF SOURCE BLOCK
	AD:ADDRESS OF DESTINATION
      NOWD:NUMBER OF WORDS*W TO BE MOVED	*)

	VAR ENDADDR:INTEGER;
		AS,AD,NOWD:INTEGER;
	BEGIN(*MOVE*)
	NOWD:=POP;
	AD:=POP;
	AS:=POP;
	ENDADDR:=AS+NOWD;
	IF (AS<RAMMIN) OR (ENDADDR>RAMMAX) THEN MERR(READV);
	IF (AD<0) OR (AD+NOWD>RAMMAX) THEN MERR(WRITV);
	REPEAT
		MEMORY.RAM[AD]:=MEMORY.RAM[AS];
		AD:=AD+W;
		AS:=AS+W;
	UNTIL AS>ENDADDR
	END(*MOVE*);

FUNCTION SLIT:INTEGER;
(* EMPLACES THE TOKEN POINTED TO BY RAM[USR+W*3] INTO
	STRINGS AND POINTS TO ITS START*)

	VAR START,LENGTH, I:INTEGER;
	BEGIN
WITH MEMORY DO BEGIN
	START:=RAM[USR+W*3];
	LENGTH:=ORD(STRINGS[START])-1;
	FOR I:= 1 TO LENGTH
		DO STRINGS[START+I]:=STRINGS[START+I+1];
	STRINGS[START]:=CHR(LENGTH);
	RAM[USR+W*3]:=RAM[USR+W*3]+LENGTH+1
END(*WITH MEMORY*);
	SLIT:=START;
	END(*SLIT*);

PROCEDURE SWAP;(*TOP TWO ITEMS ON PARAMETER STACK*)
VAR HOLD:INTEGER;
	BEGIN
	HOLD:=STACK[STKPTR];
	STACK[STKPTR]:=STACK[STKPTR-S];
	STACK[STKPTR-S]:=HOLD
	END(*SWAP*);


PROCEDURE NEXTCH;
(*ADVANCES POINTER, RAM[USR+W*11] TO NEXT CHARACTER IN
	BUFFERED INPUT LINE; WILL NOT ADVANCE BEYOND
	A CARRIAGE RETURN *)

	BEGIN
WITH MEMORY DO BEGIN
	IF STRINGS[RAM[USR+W*11]] <> CHR(NEWLINE)
	THEN RAM[USR+W*11]:=RAM[USR+W*11]+1;

END(*WITH MEMORY*);
	END(*NEXTCH*);

PROCEDURE PROMPT;
	BEGIN
WITH MEMORY DO BEGIN
	IF RAM[USR+W*32]<>FALS THEN INTERPRET(RAM[USR+W*32])(*SPECIAL USER PROMPT*)
	ELSE
	BEGIN(*PRIMITIVE PROMPT*)
	(* IFCR *)
	IF RAM[USR+W*20]>0 THEN CARRET;
	CHOUT(STRINGS[STRINGSMIN]);
	MESSAGE(SYNTAXBASE);
	CHOUT('>');
	END(*STANDARD PROMPT*)
END(*WITH MEMORY*);
	END(*PROMPT*);

PROCEDURE IGNRBLNKS;
(*ADVANCES RAM[USR+W*11] TO POINT TO NEXT NON-BLANK, ETC.
	CHARACTER IN BUFFERED INPUT LINE; WILL NOT
	ADVANCE BEYOND A CARRIAGE RETURN*)
BEGIN WITH MEMORY DO
	WHILE ORD(STRINGS[RAM[USR+W*11]]) IN [9,32]
		DO NEXTCH
END(*IGNRBLNKS*);

PROCEDURE LONGSTRING(VAR START:INTEGER);
(*EMPLACES "STRING" POINTED TO BY RAM[USR+W*14] INTO STRINGS
	AND POINTS TO ITS START*)

	VAR LENGTH:INTEGER;
	BEGIN(*LONGSTRING*)
WITH MEMORY DO BEGIN
	IF STRINGS[RAM[USR+W*14]]<>'"' THEN ABORT;
	START:=RAM[USR+W*3];
	LENGTH:=0;
	RAM[USR+W*11]:=RAM[USR+W*14]+1; (*RESET NEXTCH POINTER*)
	WHILE NOT(ORD(STRINGS[RAM[USR+W*11]]) IN [NEWLINE,34])
	 DO	BEGIN
		LENGTH := LENGTH+1;
		STRINGS[START+LENGTH]:=STRINGS[RAM[USR+W*11]];
		NEXTCH;
		END(*WHILE NOT*);
	NEXTCH;
	STRINGS[START]:=CHR(LENGTH);
	RAM[USR+W*3]:=START+LENGTH+1;

END(*WITH MEMORY*);
	END(*LONGSTRING*);

PROCEDURE INTOKEN;
(* PLACES STRING AT END OF STRINGS SO THAT
	RAM[USR+W*3] POINTS TO IT *)
	VAR CHRCNT:INTEGER;

	BEGIN
WITH MEMORY DO BEGIN
	CHRCNT:=0;
	REPEAT
		CHRCNT:=CHRCNT+1;
		IF (STRINGS[RAM[USR+W*11]]>='a')
			AND (STRINGS[RAM[USR+W*11]]<='z')
			AND (RAM[USR+W*13]<>FALS)
		THEN(*RAISE TO UPPERCASE*)
			STRINGS[CHRCNT+RAM[USR+W*3]]:=
				CHR(ORD(STRINGS[RAM[USR+W*11]])-32)
		ELSE(*NO NEED TO RAISE*)
		STRINGS[CHRCNT+RAM[USR+W*3]]:=
			STRINGS[RAM[USR+W*11]];
		NEXTCH
	UNTIL ORD(STRINGS[RAM[USR+W*11]]) IN [0,9,10,13,32];
	STRINGS[RAM[USR+W*3]]:=CHR(CHRCNT);
END(*WITH MEMORY*);
	END(*INTOKEN*);

FUNCTION DIGIT(D:INTEGER):INTEGER;
(*CONVERTS ORD(ASCII) INTO NUMERICAL EQUIVALENT*)
(*ERROR CONDITION FOR ARGUMENT PRODUCES NEGATIVE RESULT*)
	BEGIN
	IF D<=ORD('9')
		THEN DIGIT:=D-ORD('0')
	ELSE IF D<ORD('A')
		THEN DIGIT:=-1
	ELSE IF D<=ORD('Z')
		THEN DIGIT:=10+D-ORD('A')
	ELSE DIGIT:=-1
	END(*DIGIT*);

PROCEDURE COMPILE(ADDRESS:INTEGER);
(*"PUSHES" ADDRESS ONTO COMPILE BUFFER "STACK"*)

	BEGIN
WITH MEMORY DO BEGIN
	RAM[RAM[USR+W*1]]:=ADDRESS;
	RAM[USR+W*1]:=RAM[USR+W*1]+W;
	IF RAM[USR+W*1]>=RAMMAX THEN MERR(WRITV) ;
END(*WITH MEMORY*);
	END(*COMPILE*);

PROCEDURE FWDREF;(*COMPILES 0 TO PROVIDE SPACE FOR TOUCHUP TO USE*)
	BEGIN
	PUSH(MEMORY.RAM[USR+W*1]);
	COMPILE(0);(*TO BE OVERWRITTEN*)
	END(*FWDREF*);



FUNCTION CONVERT(PTKN:INTEGER;BASE:INTEGER;
			VAR VALUE:INTEGER):BOOLEAN;
(*INPUT NUMBER CONVERSION ROUTINE*)

	VAR TEND:INTEGER(*TOKEN END*);
		SIGN:INTEGER;
		CURSOR:INTEGER;

	BEGIN
WITH MEMORY DO BEGIN
	VALUE:=0;
	SIGN:=+1;
	TEND:=ORD(STRINGS[PTKN])+PTKN+1;
	IF STRINGS[PTKN+1]='+'THEN CURSOR:=PTKN+2
	ELSE IF STRINGS[PTKN+1]='-' THEN
		BEGIN SIGN:=-1;
			CURSOR:=PTKN+2
		END
	ELSE CURSOR:=PTKN+1;
	WHILE(DIGIT(ORD(STRINGS[CURSOR]))<BASE) AND
		(DIGIT(ORD(STRINGS[CURSOR]))>-1) AND (CURSOR<TEND)
	  DO	BEGIN
		VALUE:=BASE*VALUE+DIGIT(ORD(STRINGS[CURSOR]));
		CURSOR:=CURSOR+1;
		END;
	VALUE:=VALUE*SIGN;
	IF CURSOR=TEND
	THEN CONVERT:=TRUE
	ELSE CONVERT:=FALSE;
END(*WITH MEMORY*);
	END(*CONVERT*);

PROCEDURE TOUCHUP;(*FOR FORWARD REFERENCES*)
(*OVERWRITES 0 LEFT BY FWDREF WITH RELATIVE DISPLACEMENT
	TO CURRENT LOCATION IN COMPILE BUFFER*)
VAR REF:INTEGER;
	BEGIN
	REF:=POP;
	MEMORY.RAM[REF]:=MEMORY.RAM[USR+W*1]-REF;
	END(*TOUCHUP*);

PROCEDURE PERMSTRINGS;
(* UPDATES RAM[USR+W*4] TO POINT TO NEW TOP OF PERMANENT
	STRING AREA*)
	BEGIN
	WITH MEMORY DO
	IF RAM[USR+W*4]<RAM[USR+W*3]
	THEN RAM[USR+W*4]:=RAM[USR+W*3]
	END(*PERMSTRINGS*);


PROCEDURE FNAME(VAR NAME:DALFA);
(* LOADS NAME FROM TOS FOR FILE I/O FUNCTIONS *)
VAR	I:INTEGER;
	TEND:INTEGER;
	TOS:INTEGER;
BEGIN
	TOS:=POP;
	IF (TOS<STRINGSMIN) OR (TOS>STRINGSMAX-20)THEN MERR(READV);
	FOR I:=1 TO 20 DO NAME[I]:=CHR(0);
	TEND:=ORD(MEMORY.STRINGS[TOS]);
	IF TEND > 20 THEN ABORT;
	FOR I:=1 TO TEND DO NAME[I]:=MEMORY.STRINGS[TOS+I];
END(*FNAME*);

PROCEDURE PINT(INST:INTEGER);
FORWARD;

PROCEDURE PINT0(INST:INTEGER);
(*PRIMITIVE INTERPRETATION OF [0..40]*)
VAR TOS:INTEGER;(*TOP OF STACK*)
    NTT:INTEGER;(*NEXT TO TOP*)
BEGIN
WITH MEMORY DO BEGIN
CASE INST OF
PSEMICOLON:	(* (;) *)BEGIN
			IP:=RSTACK[RPTR];
			RPTR:=RPTR-R;
			END(* (;) *);

WSTORE:	(* W! *)BEGIN
		TOS:=POP;
		IF (TOS<USR) OR (TOS>RAMMAX) THEN MERR(WRITV);
		RAM[TOS]:=POP;
		END;
TIMES:	(*  *  *)
	PUSH(POP*POP);

PLUS:	(* + *)
	PUSH(POP+POP);

SUBTRACT:	(* - *)
	BEGIN
	TOS:=POP;
	PUSH(POP-TOS)
	END;

DIVMOD:	(* /MOD *)
	BEGIN
	TOS:=POP;
	NTT:=POP;
	IF TOS=0 THEN MERR(DIVBY0);
	PUSH(NTT DIV TOS);
	PUSH(NTT MOD TOS);
	END(*DIVMOD*);

PIF:	(* 0BRANCH OR (IF) *)
	BEGIN
		IF 0=POP
		THEN (*BRANCH*) IP:=IP+RAM[IP]
		ELSE (*SKIP*) IP:=IP+W
	END;

WAT:	(* W@ *)
	BEGIN
	TOS:=POP;
	IF (TOS<RAMMIN) OR (TOS>RAMMAX) THEN MERR(READV);
	PUSH(RAM[TOS])
	END(*WAT:*);

ABRT:	ABORT;

SP:	(* SP *)
	PUSH(STKPTR);

LOAD:	(* LOAD *)
	BEGIN
	TOS:=POP;
	RAM[USR+W*7]:=TOS;
	IF TOS>MAXLINNO
	THEN	BEGIN
		PUSH(TOS);
		FNAME(INFIL);
		RESET(LDFIL,INFIL);
		RAM[USR+W*25]:=0;
		END(*IF*)

	END(*LOAD:*);

PELSE:	(* BRANCH OR (ELSE) *)
	IP:=IP+RAM[IP];

WRD:	(* W *)
	PUSH(W);

RP:	(* RP *)
	PUSH((RPTR-RSTACKMIN) DIV R);

DROPOP:	TOS:=POP;

PUSER:	(* USER *)
	PUSH(USR);

EXEC:	(* EXEC *)
	BEGIN
		TOS:=POP;
		IF(*PRIMITIVE?*)TOS<NUMINSTR
		THEN PINT(TOS)
		ELSE	BEGIN
			IF(TOS<RAMMIN)OR(TOS>RAMMAX) THEN MERR(READV);
			RPUSH(IP);
			IP:=TOS;
			END;
	END(*EXEC:*);

EXITOP:	(* EXIT *)
	IF LPTR<(LSTACKMIN+L*3) THEN ABORT
	ELSE LSTACK[LPTR]:=LSTACK[LPTR-L];


LIT,	(* LITERAL *)
STRLIT:	(* STRING-LITERAL *)
	(*USED TO PUSH FOLLOWING WORD ON PARAMETER STACK *)
	BEGIN
	PUSH(RAM[IP]);
	(*SKIP*) IP:=IP+W
	END(*LIT:,STRLIT:*);

RPOP:	(* R> *) (*POP THE TOP OF RSTACK ONTO STACK*)
	BEGIN
	PUSH(RSTACK[RPTR]);
	RPTR:=RPTR-R
	END(*RPOP:*);


SWP:	IF STKPTR>STACKMIN+S THEN SWAP
	ELSE MERR(UNDFLO);

TYI:	(* TYI *)
	TTYI;

TYO:	(* TYO *)
	CHOUT(CHR(POP));

RPSH:	(* <R *) (*OPPOSITE TO R> , ABOVE , RPOP: *)
	RPUSH(POP);


SEMICF:	(* ;F *)
	BEGIN
		(* IFCR *)
		IF RAM[USR+W*20]>0 THEN CARRET;
		IF(RAM[USR+W*7]<MAXLINNO)AND(RAM[USR+W*7]>0)
		THEN	BEGIN
			RAM[USR+W*7]:=RAM[USR+W*7]-1;
			WRITELN(OUTPUT);
			WRITELN(OUTPUT,' THROUGH LINE ',
				RAM[USR+W*7]:3,'(DECIMAL) LOADED');
			IF RAM[USR+W*8]<>FALS THEN
			BEGIN
			WRITELN(LIST);
			WRITELN(LIST,' THROUGH LINE ',
				RAM[USR+W*7]:3,'(DECIMAL) LOADED');
			END(*IF RAM[USR+W*8]<>FALS*)
			END(*<MAXLINNO*);
		IF (RAM[USR+W*7]>=MAXLINNO)
		THEN	BEGIN
			WRITELN(OUTPUT,INFIL,' LOADED');
			IF RAM[USR+W*8]<>FALS THEN WRITELN(LIST,INFIL,' LOADED');
			END(* >=MAXLINNO *);
		RAM[USR+W*7]:=0;
	END(*SEMICF:*);

RAT:	(* R@ *)
	BEGIN
	TOS:=RPTR-R*POP;
	IF(TOS<RSTACKMIN) THEN MERR(READV);
	PUSH(RSTACK[TOS]);
	END(*RAT:*);

COMPME:	(*COMPILEME: COMPILES FOLLOWING CODE UNTIL ENDA
	VALUE IS REACHED; USED FOR PRIMITIVE-NOTIMMED.
	AND FOR MACR0($:)	*)
	(* IF (ENDA)=(EXECA) THEN NOTHING IS COMPILED *)
	BEGIN
	I:=IP;
	WHILE (I<RAM[IP-W*4])
	DO	BEGIN
		COMPILE(RAM[I]);
		I:=I+W;
		END;
	IP:=RSTACK[RPTR];
	RPTR:=RPTR-R;
	END(*COMPME:*);

COMPHERE:	(*NOTIMMED -- USED BY COMPILER DURING COMPILETIME ONLY*)
	BEGIN	COMPILE(IP);
	IP:=RSTACK[RPTR];
	RPTR:=RPTR-R;
	END(*COMPHERE:*);

DOLLARC:	(* $: *)
	BEGIN
	PUSHCK('$');
	COMPILE(PDOLLAR);(* ($:) *)
	FWDREF
	END;

COLON:	(* : *)
	BEGIN
	PUSHCK(':');
	COMPILE(PCOLON); (* (:) *)
	FWDREF;
	END;

SEMICOLON:	(* ; *)
	IF STRINGS[ORD(STRINGS[SYNTAXBASE])+SYNTAXBASE]=':'
	THEN	BEGIN
		DROPCK;
		COMPILE(PSEMICOLON);(* (;) *)
		TOUCHUP;
		END
	ELSE SYNTERR;

IFOP:	(* IF *)
	BEGIN
	PUSHCK('F');
	COMPILE(PIF);(* (IF) *)
	FWDREF;
	END;

ELSEOP:	(* ELSE *)
	IF STRINGS[ORD(STRINGS[SYNTAXBASE])+SYNTAXBASE] = 'F'
	THEN	BEGIN
		STRINGS[ORD(STRINGS[SYNTAXBASE])+SYNTAXBASE]:='E';
		COMPILE(PELSE);(* (ELSE) *)
		FWDREF;
		SWAP;
		TOUCHUP;
		END
	ELSE	SYNTERR;

THENOP:	(* THEN *)
	IF	(STRINGS[ORD(STRINGS[SYNTAXBASE])+SYNTAXBASE] = 'F')
	OR	(STRINGS[ORD(STRINGS[SYNTAXBASE])+SYNTAXBASE] = 'E')
	THEN	BEGIN
		DROPCK;
		TOUCHUP;
		END
	ELSE SYNTERR;

DOOP:	(* DO *)
	BEGIN
	PUSHCK('D');
	COMPILE(PDOOP);(* (DO) *)
	FWDREF;
	END;

LOOPOP:	(* LOOP *)
	IF STRINGS[ORD(STRINGS[SYNTAXBASE])+SYNTAXBASE]='D'
	THEN	BEGIN
		DROPCK;
		COMPILE(PLOOP);(* (LOOP) *)
		COMPILE(STACK[STKPTR]-RAM[USR+W*1]+W);
		TOUCHUP;
		END
	ELSE SYNTERR;

BEGINOP:	(* BEGIN *)
	BEGIN
	PUSHCK('B');
	PUSH(RAM[USR+W*1])
	END;

ENDOP:	(* END *)
	IF STRINGS[ORD(STRINGS[SYNTAXBASE])+SYNTAXBASE] = 'B'
	THEN	BEGIN
		DROPCK;
		COMPILE(PIF);(* (IF) *)
		COMPILE(POP-RAM[USR+W*1]);
		END
	ELSE SYNTERR;

REPET:	(* REPEAT *)
	BEGIN
	DROPCK;
	DROPCK;
	IF (STRINGS[ORD(STRINGS[SYNTAXBASE])+SYNTAXBASE+1]='B')
	AND(STRINGS[ORD(STRINGS[SYNTAXBASE])+SYNTAXBASE+2]='F')
	THEN	BEGIN
		COMPILE(PELSE);(* (ELSE) *)
		COMPILE(STACK[STKPTR-S]-RAM[USR+W*1]);
		TOUCHUP;(*TOUCHUP MODIFIES STACK*)
		TOS:=POP;
		END
	ELSE SYNTERR
	END(*REPET:*);

PERCENT:	(* % *)	GEOLN;

END(*CASE*)
END(*WITH MEMORY*);
END(*PINT0*);


PROCEDURE PINT1(INST:INTEGER);
(*PRIMITIVE INTERPRETATION OF [41..NUMINSTR-1]*)
VAR TOS,NTT,PARAM:INTEGER;(*TOP OF STACK*)

	PROCEDURE CRDMP;
	VAR SAVEFILE:IMFILE;(*CLOSED ON EXIT*)
	BEGIN
		FNAME(IMAGENAME);
		REWRITE(SAVEFILE,IMAGENAME);
		WRITE(SAVEFILE,MEMORY);
	END(*CRDMP*);

	PROCEDURE RSTOR;
	VAR SAVEFILE:IMFILE;
	BEGIN
		FNAME(IMAGENAME);
		RESET(SAVEFILE,IMAGENAME);
		READ(SAVEFILE,MEMORY);
		ABORT;
	END(*RSTOR*);

BEGIN
WITH MEMORY DO BEGIN
	CASE INST OF


PDOLLAR:	(* ($:) *)
	BEGIN(* SIMILAR TO PCOLON:,BELOW *)
	ENTER;(*CREATE HEADER*)
	PUSH(IP+W);
	PUSH(RAM[USR+W*2]);
	PUSH(RAM[IP]-W);
	MOVE;(*COPY CODE*)
	RAM[USR+W*2]:=RAM[USR+W*2]+RAM[IP]-W;(*UPDATE .D *)
	PUSH(RAM[USR+W*2]-W);
	FENTER;(*FINISH HEADER*)
	RAM[RAM[RAM[USR+W*5]]-W]:=COMPME;(*COMPILEME*)
	PERMSTRINGS;
	(*BRANCH*) IP:=IP+RAM[IP];
	END(*PDOLLAR:*);

PCOLON:	(* (:) *)
	BEGIN
	ENTER;(*CREATE HEADER*)
	PUSH(IP+W);
	PUSH(RAM[USR+W*2]);
	PUSH(RAM[IP]-W);
	MOVE(*COPY CODE*);
	RAM[USR+W*2]:=RAM[USR+W*2]+RAM[IP]-W;(*UPDATE .D *)
	PUSH(RAM[USR+W*2]-W);
	FENTER;(*FINISH HEADER*)
	PERMSTRINGS;
	(*BRANCH*) IP:=IP+RAM[IP];
	END(*PCOLON:*);

CASAT:	(* CASE@ *)
	(* similar to L@ , S@ , and R@ *)
	BEGIN
	TOS:=CSTEP*POP;
	IF CPTR<TOS THEN ABORT;
	PUSH(CSTACK[CPTR-TOS]);
	END(*CASAT:*);

PDOOP:	(* (DO) *)	PDO;

PPLOOP:	(* (+LOOP) *)
	BEGIN
	LSTACK[LPTR]:=LSTACK[LPTR]+POP;
	ALOOP;
	END(*PPLOOP:*);

PLLOOP:	(* +LOOP *)
	IF STRINGS[ORD(STRINGS[SYNTAXBASE])+SYNTAXBASE]='D'
	THEN	BEGIN
		DROPCK;
		COMPILE(PPLOOP);(* (+LOOP) *)
		COMPILE(STACK[STKPTR]-RAM[USR+W*1]+W);
		TOUCHUP;
		END
	ELSE SYNTERR;

CAT:	(* C@ *)
	BEGIN
	TOS:=POP;
	IF (TOS<STRINGSMIN) OR (TOS>STRINGSMAX) THEN MERR(READV);
	PUSH(ORD(STRINGS[TOS]));
	END(*CAT:*);

CSTORE:	(* C! *)
	BEGIN
	TOS:=POP;
	IF(TOS<STRINGSMIN)OR(TOS>STRINGSMAX) THEN MERR(WRITV);
	STRINGS[TOS]:=CHR(POP);
	END(*CSTORE:*);

PLOOP:	(* (LOOP) *)
	BEGIN
	LSTACK[LPTR]:=LSTACK[LPTR]+1;
	ALOOP;
	END;

DOTDOT: (* .. *)
	BEGIN
	TOS:=POP;NTT:=POP;PARAM:=POP;
	IF NTT<=TOS
	THEN	BEGIN
		IF(NTT<=PARAM)AND(PARAM<=TOS)
		THEN PUSH(TRU)
		ELSE PUSH(FALS)
		END
	ELSE	IF(NTT<=PARAM)OR(PARAM<=TOS)
		THEN PUSH(TRU)
		ELSE PUSH(FALS)
	END(*DOTDOT:*);

SEMIDOL:	(* ;$ *) (*VERY SIMILAR TO SEMICOLON:*)
	IF STRINGS[ORD(STRINGS[SYNTAXBASE])+SYNTAXBASE]='$'
	THEN	BEGIN
		DROPCK;
		COMPILE(PSEMICOLON);
		TOUCHUP;
		END
	ELSE	SYNTERR;


PRMQ:   (* PRIMITIVE? *)
	BEGIN
	TOS:=POP;
	IF (TOS>NUMINSTR) OR (TOS<0)
	THEN PUSH(FALS)
	ELSE PUSH(TRU)
	END(*PRMQ:*);

CORDMP:	(* COREDUMP *)
	CRDMP;

RESTOR:	(* RESTORE *)
	RSTOR;

SAT:	(* S@ *)(*GETS ITEMS OUT OF THE STACK*)
		(* 'DUP : 0 S@ ; *)
	BEGIN
	TOS:=S*POP;
	TEMP:=STKPTR-TOS;
	IF(TOS<0) OR (TEMP<=STACKMIN)
	THEN MERR(READV)
	ELSE PUSH(STACK[TEMP])
	END(*SAT:*);

FINDOP:	(* FIND *)
	FIND;

LISTFIL:	(* LISTFILE *)
	BEGIN
	WITH MEMORY DO BEGIN
	IF LISTNAME<>NULLNAME THEN
		WRITELN(OUTPUT,' CHANGING LISTFILE NAME FROM:',
			LISTNAME);
	FNAME(LISTNAME);
	REWRITE(LIST,LISTNAME);
	END(*WITH MEMORY*)
	END(*LISTFIL:*);

VFINDOP: VFIND;


LAT:	(* L@ *)(*SIMILAR TO S@, BUT FOR LOOP STACK*)
		(* 'I : 0 L@ ; *)
	BEGIN
		TOS:=L*POP;
		IF(LPTR<TOS) OR (LPTR<0) THEN MERR(READV);
		PUSH(LSTACK[LPTR-TOS]);
	END(*LAT:*);
OFCAS:	(* OFCASE *)
	BEGIN
	PUSHCK('C');
	COMPILE(POFCAS);(* (OFCASE) *)
	FWDREF;
	END(*OFCAS:*);

CCOLON:	(* C: *)
	IF STRINGS[ORD(STRINGS[SYNTAXBASE])+SYNTAXBASE]='C'
	THEN	BEGIN
		PUSHCK('c');
		COMPILE(PCCOL);(* (C:) *)
		FWDREF;
		END
	ELSE	SYNTERR;

SEMICC:	(* ;C *)
	IF STRINGS[ORD(STRINGS[SYNTAXBASE])+SYNTAXBASE]='c'
	THEN	BEGIN
		DROPCK;
		COMPILE(PSEMICC);(* (;C) *)
		TOUCHUP
		END
	ELSE	SYNTERR;

NDCAS:	(* ENDCASE *)
	IF STRINGS[ORD(STRINGS[SYNTAXBASE])+SYNTAXBASE]='C'
	THEN	BEGIN
		DROPCK;
		COMPILE(RAM[USR+W*21]);
		TOUCHUP;
		END
	ELSE	SYNTERR;

POFCAS:	(* (OFCASE) *)
	BEGIN
	IF STKPTR<S THEN MERR(UNDFLO);
	CPUSH(IP+RAM[IP]);
	CPUSH(STACK[STKPTR]);
	(*SKIP*) IP:=IP+W;
	END(*POFCAS:*);

PCCOL:	(* (C:) *)
	IF POP=FALS
	THEN	BEGIN
		PUSH(CSTACK[CPTR]);
		(*BRANCH*) IP:=IP+RAM[IP];
		END
	ELSE (*SKIP*) IP:=IP+W;

PSEMICC:	(* (;C) *)
	BEGIN
	CPTR:=CPTR-CSTEP*2;
	IF CPTR<CSTACKMIN THEN ABORT;
	IP:=CSTACK[CPTR+CSTEP];
	END(*PSEMICC66:*);

GTLIN:	GETLINE;

WORD:	(* WORD *)
	INTOKEN;

OPENR:	(* OPENR *)
	BEGIN
	FNAME(NAMEIN);
	RESET(EDIN,NAMEIN);
	RAM[USR+W*26]:=0;
	END(*OPENR*);

OPENW:	(* OPENW *)
	BEGIN
	FNAME(NAMOUT);
	REWRITE(EDOUT,NAMOUT);
	RAM[USR+W*27]:=0;
	END(*OPENW:*);

READL:	(* READLINE *)
	BEGIN
	RAM[USR+W*12]:=0;
	RAM[USR+W*11]:=LINEBUF;
	IF RAM[USR+W*26]<0 THEN MERR(FEOF);
	WHILE NOT EOLN(EDIN)
	DO	BEGIN
		READ(EDIN,C);
		RAM[USR+W*12]:=RAM[USR+W*12]+1;
		RAM[USR+W*11]:=RAM[USR+W*11]+1;
		STRINGS[RAM[USR+W*11]]:=C;
		END(*WHILE*);
	READLN(EDIN);
	IF EOF(EDIN)	THEN RAM[USR+W*26]:=-RAM[USR+W*26]-1
			ELSE RAM[USR+W*26]:=RAM[USR+W*26]+1;
	STRINGS[LINEBUF]:=CHR(RAM[USR+W*12]+1);
	STRINGS[RAM[USR+W*11]+1]:=CHR(NEWLINE);
	RAM[USR+W*11]:=LINEBUF+1;
	IF RAM[USR+W*9]<>FALS THEN MESSAGE(LINEBUF);
	END(*READL:*);

WRITL:	(* WRITELINE *)
	BEGIN
	IF RAM[USR+W*27]>0 THEN MERR(NOPEN);
	TOS:=POP;
	TEMP:=TOS+ORD(STRINGS[TOS])-1;
	WHILE TOS < TEMP
	DO	BEGIN
		TOS:=TOS+1;
		WRITE(EDOUT,STRINGS[TOS]);
		END(*WHILE*);
	WRITELN(EDOUT);
	RAM[USR+W*27]:=RAM[USR+W*27]-1;(*INCREASE NEGATIVE*)
	END(*WRITL*);


END(*CASE*);
END(*WITH MEMORY*);
END(*PINT1*);

PROCEDURE PINT;
	BEGIN
	IF INST<0 THEN MERR(READV);
	IF INST>40
	THEN PINT1(INST)
	ELSE PINT0(INST)
	END(*PINT*);


PROCEDURE INTERPRET;(*ORIGINAL ENTRY PLACED BEFORE ABORT*)
	BEGIN
WITH MEMORY DO BEGIN
	INSTR:=I;
	REPEAT
		IP:=IP+W;
		IF (*PRIMITIVE?*) INSTR<NUMINSTR
		THEN PINT(INSTR)
		ELSE	BEGIN
			IF (INSTR<RAMMIN)OR(INSTR>RAMMAX)
			THEN MERR(READV);
			RPUSH(IP);
			IP:=INSTR;
			END;
		INSTR:=RAM[IP];
		(*TRACE PATCH*)
		IF RPTR=(RAM[USR+W*15]-R*2)
		THEN	BEGIN
			SAVINSTR:=INSTR;
			SAVLEVEL:=RPTR;
			INSTR:=RAM[USR+W*22];
			IP:=IP-W;
			REPEAT
				IP:=IP+W;
				IF (*PRIMITIVE?*)
					INSTR<NUMINSTR
				THEN PINT(INSTR)
				ELSE BEGIN
					IF(INSTR<RAMMIN)OR(INSTR>RAMMAX)
					THEN MERR(READV);
					RPUSH(IP);
					IP:=INSTR;
					END;
				INSTR:=RAM[IP];
			UNTIL RPTR<(SAVLEVEL+R);
			INSTR:=SAVINSTR;
			END(*TRACE PATCH*);
	UNTIL RPTR<RSTACKMIN;
	IP:=IP-W;(*RESTORE THE ORIGINAL IP TO ORIGINAL*)

	
END(*WITH MEMORY*);
	END(*PROCEDURE INTERPRET*);

PROCEDURE COMPLINE;
(* COMPILE AN INPUT LINE INTO THE COMPILE BUFFER*)
BEGIN
WITH MEMORY DO BEGIN
IF (RAM[USR+W*7]=FALS) OR (RAM[USR+W*9]<>FALS)
	THEN PROMPT;
IF (RAM[USR+W*7]>0) AND (RAM[USR+W*7]<MAXLINNO)
THEN	BEGIN
	PUSH(RAM[USR+W*7]);
	INTERPRET(RAM[USR+W*24]);
	RAM[USR+W*7]:=RAM[USR+W*7]+1;
	END(*THEN*)
ELSE
	GETLINE;
IGNRBLNKS;
WHILE STRINGS[RAM[USR+W*11]] <> CHR(NEWLINE) DO
	BEGIN
	RAM[USR+W*14] := RAM[USR+W*11]; (* NOTE TOKEN START*)
	INTOKEN;
	PUSH(RAM[USR+W*3]);
	FIND;
	ADDR:=POP;
	IF ADDR<>FALS
	THEN(*FOUND*) INTERPRET(ADDR-W) (* THE CPA *)
	ELSE
	BEGIN(*NOT DEFINED DURING EXECUTION*)
	IF(CONVERT(RAM[USR+W*3],RAM[USR+W*0],VAL))
	THEN	BEGIN
		COMPILE(LIT);
		COMPILE(VAL)
		END
	ELSE	IF STRINGS[RAM[USR+W*3]+1]='''' THEN
			BEGIN
			VAL:=SLIT;
			COMPILE(STRLIT);
			COMPILE(VAL);
			END(*IF SINGLE-QUOTED STRING*)
		ELSE IF STRINGS[RAM[USR+W*3]+1]='"' THEN
			BEGIN	LONGSTRING(VAL);
				COMPILE(STRLIT);
				COMPILE(VAL);
			END(*DOUBLE QUOTED STRING*)

		ELSE IF RAM[USR+W*33]<>FALS THEN INTERPRET(RAM[USR+W*33])
			(*USER SUPPLIED CONVERSION*)

		ELSE	BEGIN (*TOKEN NOT DECHIPHERABLE*)
			RAM[USR+W*10]:=TRU(*TURN ON CONSOLE*);
			(*SHOW BAD LINE IF NOT ON CONSOLE*)
			IF (RAM[USR+W*7]<>FALS) AND (RAM[USR+W*9]=FALS)
			THEN	BEGIN
				(* IFCR *)
				IF RAM[USR+W*20]>0
				THEN CARRET;
				MESSAGE(LINEBUF);
				END(*IF*);

			MESSAGE(RAM[USR+W*3]);
			WRITELN(OUTPUT,' ?');
			IF RAM[USR+W*8]<>FALS THEN WRITELN(LIST,' ?');
			ABORT;
			END
	END(*NOT DEFINED DURING EXECUTION*);
	IGNRBLNKS;
	END(*WHILE*);

END(*WITH MEMORY*);
END(*PROCEDURE COMPLINE*);

PROCEDURE ADDSTRING(LENGTH:INTEGER; STRING:DALFA;VAR START:INTEGER);
(*CONVENIENCE DURING INITIALIZATION OF PISTOL*)
VAR I:INTEGER;
BEGIN(*ADDSTRING*)
WITH MEMORY DO BEGIN
	START:=RAM[USR+W*3];
	RAM[USR+W*3]:=RAM[USR+W*3]+1;
	FOR I:= 1 TO LENGTH  DO
		BEGIN
		STRINGS[RAM[USR+W*3]]:=STRING[I];
		RAM[USR+W*3]:=RAM[USR+W*3]+1;
		END(*FOR*);

	STRINGS[START]:=CHR(I-1);
	(* STRING HAS NOW BEEN PLACED IN STRINGS,RAM[USR+W*3]
		HAS BEEN UPDATED*)
	PERMSTRINGS;
END(*WITH MEMORY*);
END(*ADDSTRING*);

PROCEDURE PENTER(LENGTH:INTEGER;NAME:DALFA;OPCODE:INTEGER);
(* THIS PROCEDURE IS USED ONLY TO SIMPLIFY BRINGING UP
	PISTOL; THE PRIMITIVE,"BUILT-IN" FUNCTIONS ARE
	ENTERED INTO THE DICTIONARY BY THIS PROCEDURE.
	IF OPCODE IS POSITIVE, IT IS 'NOTIMMEDIATE',
	HENCE THE COMPILE-TIME OPCODE SHOULD BE 27, ELSE
	IF OPCODE IS NEGATIVE, IT IS IMMEDIATE*)

VAR START:INTEGER;

BEGIN(*PENTER*)
WITH MEMORY DO BEGIN
	ADDSTRING(LENGTH,NAME,START);
	APPEND(0);(*SPACE FOR ENDA*)
	APPEND(RAM[RAM[USR+W*5]]);	(*LINK FIELD*)
	APPEND(START);		(*NAME FIELD*)

	(*COMPILE-TIME FIELD: *)
	IF OPCODE<0
	THEN	BEGIN
		APPEND(-OPCODE)	(*IMMEDIATE WORD*);
		APPEND(PSEMICOLON)	(*FOR SYMMETRY*)
		END

	ELSE	BEGIN
		APPEND(COMPME);	(*PRIMITIVE NOTIMMEDIATE*)
		APPEND(OPCODE);
		END(*ELSE*);

	RAM[RAM[USR+W*5]]:=RAM[USR+W*2]-W;	(*UPDATE CURRENT*)
	PUSH(RAM[USR+W*2]);
	FENTER;(* ENDA:=.D *)
END(*WITH MEMORY*);
END(*PENTER*);

PROCEDURE INIT;(*USED ONLY TO INITIALIZE CONSTANTS AND
		VARIABLES*)
BEGIN(*INIT*)
WITH MEMORY DO BEGIN
FOR TEMP:=RAMMIN TO RAMMAX DO RAM[TEMP]:=10000;
REWRITE(OUTPUT,'TTY:      ');
FOR I:=1 TO 20 DO NULLNAME[I]:=CHR(0);
LISTNAME:=NULLNAME;
STKPTR:=STACKMIN;
RAM[USR-W*21]:=-1-MAXINT;(*MININT,MACHINE DEPENDENT*)
RAM[USR-W*20]:=MAXLINNO;
RAM[USR-W*19]:=CHKLMT;(*SIZE OF SYNTAX CHECKSTACK*)
RAM[USR-W*18]:=RAMMIN;
RAM[USR-W*17]:=STRINGSMIN;

RAM[USR+W*34]:=FALS;(*ABORT PATCH*)
RAM[USR+W*33]:=FALS;(*CONVERSION PATCH*)
RAM[USR+W*32]:=FALS;(*STANDARD PROMPT*)
RAM[USR-W*16]:=STRINGSMAX;
RAM[USR-W*15]:=VBASE;
RAM[USR-W*14]:=VSIZE;
RAM[USR-W*13]:=CSIZE;
RAM[USR-W*12]:=LSIZE;
RAM[USR-W*11]:=RSIZE;
RAM[USR-W*10]:=SSIZE;
RAM[USR-W*9]:=LINEBUF;
RAM[USR-W*8]:=COMPBUF;
RAM[USR-W*7]:=RAMMAX;
RAM[USR-W*6]:=MAXORD;
RAM[USR-W*5]:=MAXINT;
RAM[USR-W*4]:=VERSION;
RAM[USR-W*3]:=NEWLINE;
RAM[USR-W*2]:=TRU;(*READ_PROTECT*)
RAM[USR-W*1]:=TRU;(*WRITE_PROTECT*)
RAM[USR+W*29]:=0;
RAM[USR+W*30]:=FALS;(* PISTOL< LINK IS NIL;
			IT'S AT THE END OF BRANCH LIST*)
	(*INITIALIZE FILE STATUS*)
RAM[USR+W*27]:=+1;(*EDOUT*)
RAM[USR+W*26]:=-1;(*EDIN*)
RAM[USR+W*25]:=-1;(*LDFIL*)
RAM[USR+W*23]:=8; (*INITIALIZE TABSIZE*)
RAM[USR+W*21]:=ABRT; (*INITIALIZE ENDCASE TO ABORT*)
RAM[USR+W*19]:=64 (* INITIALIZE TERMINAL WIDTH*);
RAM[USR+W*17]:=20 (* INITIALIZE TERMINAL PAGE LENGTH*);
RAM[USR+W*16]:=FALS;(*COMPILE-END-PATCH*)
RAM[USR+W*15]:=FALS;(*INITALIZE TRACE OFF*)
RAM[USR+W*13]:=TRU (*RAISE ON*);
RAM[USR+W*9]:=FALS (*ECHO OFF*);
RAM[USR+W*8]:=FALS;(*LIST OFF*)
RAM[USR+W*5]:=USR+W*29;
RAM[USR+W*2]:=MAX(NUMINSTR+1,USR+W*(45+VSIZE+RSIZE) );
(*SET BASE OF DICTIONARY*)
RAM[USR+W*4]:=SYNTAXBASE+CHKLMT+1;
RAM[USR+W*3]:=RAM[USR+W*4];
ADDSTRING(18,'**READ VIOLATION**  ',READV);
ADDSTRING(20,'**WRITE VIOLATION** ',WRITV);
ADDSTRING(20,'*** EOF ENCOUNTERED*',FEOF);
ADDSTRING(20,'*** FILE NOT OPENED*',NOPEN);
ADDSTRING(18,'*** PISTOL 2.0 ***  ',ID);
ADDSTRING(20,'*** SYNTAX ERROR ***',SYNT);
ADDSTRING(19,'** STACK OVERFLOW **',OVFLO);
ADDSTRING(19,'* STACK UNDERFLOW * ',UNDFLO);
ADDSTRING(16,'---REDEFINING---    ',REDEF);
ADDSTRING(16,'DIVISION BY ZERO    ',DIVBY0);
PENTER(2,'W!                  ',WSTORE);
PENTER(1,'*                   ',TIMES);
PENTER(1,'+                   ',PLUS);
PENTER(1,'-                   ',SUBTRACT);
PENTER(4,'/MOD                ',DIVMOD);
PENTER(2,'W@                  ',WAT);
PENTER(5,'ABORT               ',ABRT);
PENTER(2,'SP                  ',SP);
PENTER(4,'LOAD                ',LOAD);
PENTER(1,'W                   ',WRD);
PENTER(2,'RP                  ',RP);
PENTER(4,'DROP                ',DROPOP);
PENTER(4,'USER                ',PUSER);
PENTER(4,'EXEC                ',EXEC);
PENTER(4,'EXIT                ',EXITOP);
PENTER(2,'R>                  ',RPOP);
PENTER(4,'SWAP                ',SWP);
PENTER(3,'TYI                 ',TYI);
PENTER(3,'TYO                 ',TYO);
PENTER(2,'<R                  ',RPSH);
PENTER(2,';F                  ',SEMICF);
PENTER(2,'R@                  ',RAT);
PENTER(2,'$:                  ',-DOLLARC);
PENTER(1,':                   ',-COLON);
PENTER(1,';                   ',-SEMICOLON);
PENTER(2,'IF                  ',-IFOP);
PENTER(4,'ELSE                ',-ELSEOP);
PENTER(4,'THEN                ',-THENOP);
PENTER(2,'DO                  ',-DOOP);
PENTER(4,'LOOP                ',-LOOPOP);
PENTER(5,'BEGIN               ',-BEGINOP);
PENTER(3,'END                 ',-ENDOP);
PENTER(6,'REPEAT              ',-REPET);
PENTER(1,'%                   ',-PERCENT);
PENTER(5,'CASE@               ',CASAT);
PENTER(5,'+LOOP               ',-PLLOOP);
PENTER(2,'C@                  ',CAT);
PENTER(2,'C!                  ',CSTORE);
PENTER(2,'..                  ',DOTDOT);
PENTER(2,';$                  ',-SEMIDOL);
PENTER(10,'PRIMITIVE?          ',PRMQ);
PENTER(2,'S@                  ',SAT);
PENTER(4,'FIND                ',FINDOP);
PENTER(8,'LISTFILE            ',LISTFIL);
PENTER(5,'VFIND               ',VFINDOP);
PENTER(2,'L@                  ',LAT);
PENTER(6,'OFCASE              ',-OFCAS);
PENTER(2,'C:                  ',-CCOLON);
PENTER(2,';C                  ',-SEMICC);
PENTER(7,'ENDCASE             ',-NDCAS);
PENTER(4,'(;C)                ',PSEMICC);
PENTER(7,'GETLINE             ',GTLIN);
PENTER(4,'WORD                ',WORD);
PENTER(5,'OPENR               ',OPENR);
PENTER(5,'OPENW               ',OPENW);
PENTER(8,'READLINE            ',READL);
PENTER(9,'WRITELINE           ',WRITL);
PENTER(8,'COREDUMP            ',CORDMP);
PENTER(7,'RESTORE             ',RESTOR);



RAM[USR+W*0]:=10;	(*DECIMAL MODE*)
STRINGS[STRINGSMIN] := 'X';
STRINGS[SYNTAXBASE]:=CHR(0);
END(*WITH MEMORY*);
END(*INIT*);


(******************************************)
BEGIN(*PISTOL MAIN*)
WITH MEMORY DO BEGIN    INIT;
ABORT;
REPEAT
RAM[USR+W*1]:=COMPBUF;
REPEAT
COMPLINE;
UNTIL STRINGS[SYNTAXBASE]=CHR(0);
COMPILE(PSEMICOLON);

IF RAM[USR+W*16]<>FALS THEN INTERPRET(RAM[USR+W*16]);

IF (RAM[USR+W*10]<>FALS) AND ((RAM[USR+W*7]=FALS) OR (RAM[USR+W*9]<>FALS))
THEN	BEGIN
	RAM[USR+W*20]:=FALS (*RESET COLUMN POSTION VARIABLE*);
	RAM[USR+W*18]:= 0 (*RESET TERMINAL LINE COUNT*);
	END;
INTERPRET(COMPBUF);
99:

RAM[USR+W*3]:=RAM[USR+W*4];
UNTIL RAM[USR+W*31]<>FALS(*SESSION DONE*);

WRITELN(OUTPUT,'PISTOL NORMAL EXIT');
IF RAM[USR+W*8]<>FALS THEN WRITELN(LIST,'PISTOL NORMAL EXIT');
(*FLUSH AND CLOSE FILES IF OPERATING SYSTEM DOESN'T DO IT*)
END(*WITH MEMORY*);
END.

.