(*
*********************************************************
*							*
* 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.						*
*							*
*********************************************************
*)
PROGRAM PISTOL(INPUT:/);
(*DECEMBER 22, 1981 --FOR BEST PERFORMANCE IN PASCAL,
	THIS PROGRAM SHOULD BE EDITED TO MAKE FULL USE
	OF THE OPTIONS, USER=0,W=1,S=1,CSTEP=1,L=1,R=1
	AND STRINGSMIN=-1 *)

LABEL 99;
CONST
VERSION=13;(*10* THE VERSION NUMBER,READABLE BY USER*)
USER=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=75;
RAMMIN=-57(*USER-W*57,OR LOWER,READABLE*);
MAXORD=127;(*7 BIT FOR DEC-20,READABLE*)
RAMMAX=8000;(*=RAMMIN+W*4000 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=1;(*=USER +W,READABLE BY USER*)
STRINGSMIN=7000(*READABLE BY USER*);
SYNTAXBASE=7001(*STRINGSMIN+1*);
STRINGSMAX=12000;(*STRINGSMIN+ 3000..5000 INTENDED FOR EDIT AREA *)
MAXLINNO=300;(*MAX # OF LINES POSSIBLE IN EDIT BUFFER,
		READABLE BY USER*)
LINEBUF=9800;(*STRINGSMIN+2800,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 KERNQ, 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;
	GT=50;
	SEMIDOL=51;
	KRNQ=52;
	(* OPCODES 53,54 NOT USED AT MOMENT *)
	SAT=55;
	FINDOP=56;
	LISTFIL=57;
	(* OPCODE 58 MOMENTARILY UNUSED *)
	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;
	CORDMP=73;
	RESTOR=74;
(* 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,INFIL1,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,LDFIL1,LIST,OUTPUT:TEXT;
SAVEFILE:IMFILE;
NOPEN,FEOF,UNDFLO,OVFLO,SYNT,ID,REDEF,ADDR,VAL,I,DIVBY0:INTEGER;
CONVERTED:BOOLEAN;
C:CHAR;


(*	RAM[RAMMIN...]:
	RAM[USER-W*57]=MAXLINNO
	RAM[USER-W*56]=CHKLMT
	RAM[USER-W*55]=RAMMIN
	RAM[USER-W*54]=STRINGSMIN
	RAM[USER-W*53]=**TO BE RECYCLED**
	RAM[USER-W*52]=ABORT PATCH
	RAM[USER-W*51]=USER CONVERSION PATCH
	RAM[USER-W*50]=PROMPT PATCH
	RAM[USER-W*49]=STRINGSMAX
	RAM[USER-W*48]=VBASE
	RAM[USER-W*47]=VSIZE
	RAM[USER-W*46]=CSIZE
	RAM[USER-W*45]=LSIZE
	RAM[USER-W*44]=RSIZE
	RAM[USER-W*43]=SSIZE
	RAM[USER-W*42]=LINEBUF
	RAM[USER-W*41]=COMPBUF
	RAM[USER-W*40]=RAMMAX
	RAM[USER-W*39]=MAXORD  =127 FOR 7 BIT CHARACTER REP.
	RAM[USER-W*38]=MAXINT
	RAM[USER-W*37]=**TO BE RECYCLED**
	RAM[USER-W*36]=VERSION =11 (1.1)
	RAM[USER-W*35]=SESSION DONE BOOLEAN
	RAM[USER-W*34]=^PISTOL<
	RAM[USER-W*33]=0(FOR PISTOL)
	RAM[USER-W*32]=^VSTACK(CONTEXT)
	FILE STATUS: NEGATIVE VALUE MEANS EOF FOR INPUT
			OR FILE OPENED FOR WRITE;
			MAGNETUDE OF VALUE=LINES OF TEXT
			TRANSFERED SINCE FILE WAS OPENED.
	RAM[USER-W*31]=STATUS FOR EDOUT
	RAM[USER-W*30]=STATUS FOR EDIN
	RAM[USER-W*29]=STATUS FOR LDFIL1

	RAM[USER-W*28]=#GETLINE ADDRESS
	RAM[USER-W*27]=TAB SIZE, NORMALLY 8
	RAM[USER-W*26]=TRACE PATCH ADDRESS
	RAM[USER-W*25]=ENDCASE PATCH ADDRESS
	RAM[USER-W*24]=COLUMN
	RAM[USER-W*23]=TERMINAL WIDTH
	RAM[USER-W*22]=# OF LINES OUTPUT TO CONSOLE
	RAM[USER-W*21]=TERMINAL PAGE,MAX # OF LINES
	RAM[USER-W*20]=COMPILE-END-PATCH
			USED TO SHOW CONTENTS OF COMPILE BUFFER
	RAM[USER-W*19]=TRACE BOOLEAN AND LEVEL
	RAM[USER-W*18]=HEAD OF TOKEN IN LINE
	RAM[USER-W*17]=RAISE LC-->UC BOOLEAN
	RAM[USER-W*16]=LINELENGTH
	RAM[USER-W*15]=NEXTCH POINTER
	RAM[USER-W*14]=CONSOLE OUT BOOLEAN
	RAM[USER-W*13]=ECHO BOOLEAN
	RAM[USER-W*12]=LIST BOOLEAN
	RAM[USER-W*11]=INPUT FILE
	RAM[USER-W*10..-7]=SYS TEMPS
	RAM[USER-W*6]=CURRENT	(POINTER)
	RAM[USER-W*5]=OLD END OF STRINGS
	RAM[USER-W*4]=CURRENT END OF STRINGS
	RAM[USER-W*3]=.D
	RAM[USER-W*2]=.C
	RAM[USER-W*1]=RADIX
	RAM[VBASE..VBASE+VSIZE]=VOCABULARY STACK
	RAM[VBASE+VSIZE..NUMINSTR]=NOT USED HERE *)
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 *)

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


PROCEDURE CARRET(*OUTPUTS A CR-LF SEQUENCE*);
BEGIN
WITH MEMORY DO BEGIN
	IF RAM[USER-W*14]<>FALS
	THEN	BEGIN
		RAM[USER-W*22]:=RAM[USER-W*22]+1;
		IF RAM[USER-W*22]=RAM[USER-W*21]
		THEN	BEGIN
			READLN(INPUT);
			READ(INPUT,C);
			RAM[USER-W*22]:=0;
			IF (C='Q') OR (C='q') THEN ABORT;
			END;
		RAM[USER-W*24]:=0;
		WRITELN(OUTPUT);
		END;
	IF RAM[USER-W*12]<>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[USER-W*27]>0
	THEN SPACES(RAM[USER-W*27]-(RAM[USER-W*24] MOD RAM[USER-W*27]));
END(*WITH MEMORY*);
	END(*TAB*);

PROCEDURE CHOUT(CH:CHAR);
(* OUTPUTS A CHARACTER*)
BEGIN
WITH MEMORY DO BEGIN
	IF CH=CHR(13) THEN CARRET
	ELSE IF CH=CHR(9) THEN TAB
	ELSE	BEGIN
		IF RAM[USER-W*24]=RAM[USER-W*23] THEN CARRET;
		RAM[USER-W*24]:=RAM[USER-W*24]+1;
		IF RAM[USER-W*14]<>FALS THEN WRITE(OUTPUT,CH);
		IF RAM[USER-W*12]<>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);
	BEGIN
WITH MEMORY DO BEGIN
	IF ORD(STRINGS[ST])>0 THEN
		BEGIN
		RAM[USER-W*10]:=ST+ORD(STRINGS[ST]);(*LAST*)
		REPEAT
			ST:=ST+1;
			CHOUT(STRINGS[ST]);
		UNTIL ST=RAM[USER-W*10];
		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[USER-W*35]:=FALS;(*SESSION NOT DONE*)
	RAM[USER-W*32]:=VBASE;
	RAM[VBASE]:=USER-W*34;
	RAM[USER-W*6]:=USER-W*34;
	STKPTR := STACKMIN;
	RPTR := RSTACKMIN-R;
	CPTR := CSTACKMIN;
	LPTR := LSTACKMIN;
	STRINGS[SYNTAXBASE] := CHR(0);
	RAM[USER-W*11]:=FALS;(*RETURN TO CONSOLE INPUT*)
	RAM[USER-W*14]:=TRU;(*TURN ON CONSOLE OUTPUT*)
	IF LISTNAME=NULLNAME THEN RAM[USER-W*12]:=FALS;
	(*TURN OFF LISTING IF NO LISTFILE IS OPEN*)
	MESSAGE(ID);
	(* IFCR *)
	IF RAM[USER-W*24]>0 THEN CARRET;
	RAM[USER-W*19]:=FALS;(*TURN TRACE OFF, IF NECESSARY*)
	IF RAM[USER-W*52]<>FALS
	THEN INTERPRET(RAM[USER-W*52]);(*USER SUPPLIED SUPPLEMENT TO ABORT*)
	GOTO 99;
END(*WITH MEMORY*);
	END(*ABORT*);

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

PROCEDURE SYNTERR;
	BEGIN
WITH MEMORY DO BEGIN
	RAM[USER-W*14]:=TRU; (*TURN ON CONSOLE*)
	(* IFCR *)
	IF RAM[USER-W*24]>0 THEN CARRET;
	IF (RAM[USER-W*11]<>FALS) AND (RAM[USER-W*13]=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*);

PROCEDURE RPRAISE;(*RAISE RETURN STACK POINTER*)
	BEGIN
	RPTR:=RPTR+R;
	IF RPTR>=RSTACKMAX THEN MERR(OVFLO)
	END(*RPRAISE*);

(*RSTACK USED FOR RETURN ADDRESSES ONLY;
	NOT FOR CASE OR LOOP STRUCTURES*)
PROCEDURE RPUSH(ITEM:INTEGER); (*ON RETURN STACK*)
	BEGIN
	RPRAISE;
	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[USER-W*14]:=TRU; (*TURN ON CONSOLE*)
		MESSAGE(OVFLO);
		SYNTERR;
		END
END(*WITH MEMORY*);
	END(*PUSHCK*);

PROCEDURE APPEND(ITEM:INTEGER); (*PUT ITEM AT END OF DICTIONARY*)
	BEGIN
WITH MEMORY DO BEGIN
	RAM[RAM[USER-W*3]] := ITEM;
	RAM[USER-W*3] := RAM[USER-W*3]+W;
	IF RAM[USER-W*3]>=COMPBUF THEN MERR(OVFLO);
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*);


PROCEDURE DROP;(*FROM PARAMETER STACK*)
	BEGIN
	IF STKPTR<S THEN MERR(UNDFLO)
	ELSE STKPTR := STKPTR-S
	END(*DROP*);


PROCEDURE PDO;(* (DO) *)
	BEGIN
	DROP;
	DROP;
	IF STACK[STKPTR+S*2]<STACK[STKPTR+S]
	THEN	BEGIN
		LPUSH(STACK[STKPTR+S*2]);(*START VALUE*)
		LPUSH(STACK[STKPTR+S]);(*END VALUE*)
		LPUSH(STACK[STKPTR+S*2]);(*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*);


FUNCTION VFIND(PTOKEN:INTEGER; LOC:INTEGER;V:INTEGER):INTEGER;
(*PTOKEN POINTS TO THE LOCATION IN STRINGS THAT
	THE START OF THE TOKEN IS;  THIS TOKEN
	IS LOOKED UP IN VOCABULARY INDIRECTLY POINTED
	BY V AND THE ADDRESS IS RETURNED BY VFIND *)
(*RETURNS POINTER TO PF IF MATCHED OTHERWISE LOC:=0*)
(*	RAM[USER-W*10]=STRING CURSOR
	RAM[USER-W*9]=LENGTH
	RAM[USER-W*8]=MATCH:BOOLEAN
	RAM[USER-W*7]=TEMPORARY	*)

	BEGIN
WITH MEMORY DO BEGIN
	RAM[USER-W*9]:=ORD(STRINGS[PTOKEN]);
	LOC:=RAM[RAM[V]];
	IF LOC<>FALS THEN
	REPEAT
		RAM[USER-W*8]:=TRU;
		IF STRINGS[RAM[LOC-W*2]]=CHR(RAM[USER-W*9])
		THEN	BEGIN
			RAM[USER-W*7]:=0;
			REPEAT
				RAM[USER-W*7]:=RAM[USER-W*7]+1;
			UNTIL (STRINGS[RAM[LOC-W*2]+RAM[USER-W*7]])
				<>(STRINGS[PTOKEN+RAM[USER-W*7]]);
			IF RAM[USER-W*7]<(RAM[USER-W*9]+1) THEN
				RAM[USER-W*8]:=FALS;
			END(*THEN*)
		ELSE RAM[USER-W*8]:=FALS;
	IF RAM[USER-W*8]=FALS THEN LOC:=RAM[LOC-W*3]
	UNTIL (RAM[USER-W*8]<>FALS) OR (LOC=FALS);
	VFIND:=LOC;
END(*WITH MEMORY*);
	END(*VFIND*);


FUNCTION FIND(PTOKEN:INTEGER; LOC:INTEGER):INTEGER;
VAR V:INTEGER;
BEGIN
	V:=MEMORY.RAM[USER-W*32];
	REPEAT
		LOC:=VFIND(PTOKEN,LOC,V);
		V:=V-W;
	UNTIL (V<VBASE) OR (LOC<>FALS);
	FIND:=LOC;
END(*FIND*);

(* HEADER:     ENDA:CODE END,NORMALLY POINTS TO RET
		NFA:STRINGS
	      COMPA:CF
	      EXECA:PF		*)
PROCEDURE ENTER(*CREATES AN ENTRY FOR TOKEN POINTED TO 
		BY TOP OF PARAMETER STACK*);
	BEGIN
WITH MEMORY DO BEGIN
	DROP;
	TEMP:=FIND(STACK[STKPTR+S],TEMP);
	IF TEMP<>FALS THEN
		BEGIN
		MESSAGE(REDEF);
		SPACES(3);
		MESSAGE(STACK[STKPTR+S]);
		CARRET
		END(*IF*);
	APPEND(0);(*FOR ENDA*)
	APPEND(RAM[RAM[USER-W*6]]);
	APPEND(STACK[STKPTR+S]);
	APPEND(COMPHERE);(* (:) *)
	RAM[RAM[USER-W*6]]:=RAM[USER-W*3];(*CURRENT:=EXECA*)
END(*WITH MEMORY*);
	END(*ENTER*);

PROCEDURE FENTER(I:INTEGER);(*FINISH MOST RECENT ENTRY
			FILLING IN ENDA WITH I *)
	BEGIN
	WITH MEMORY DO BEGIN
	RAM[RAM[RAM[USER-W*6]]-W*4] := I
	END(*WITH MEMORY*)
	END(*FENTER*);

PROCEDURE GEOLN;
(* ADVANCES TO EOLN*)
	BEGIN
	WITH MEMORY DO
	WHILE STRINGS[RAM[USER-W*15]]<>CHR(13) DO RAM[USER-W*15]:=RAM[USER-W*15]+1;
	END(*GEOLN*);

PROCEDURE GETLINE;
(*BUFFERS INPUT LINE INTO STRINGS[LINEBUF]*)
VAR CH:CHAR;
BEGIN(*GETLINE*)
WITH MEMORY DO BEGIN
	RAM[USER-W*16]:=0;(*LINELENGTH*)
	RAM[USER-W*15]:=LINEBUF;
	IF RAM[USER-W*11]=FALS
	THEN	BEGIN
		READLN(INPUT);
		WHILE NOT EOLN(INPUT) DO
			BEGIN
			READ(INPUT,CH);
			IF RAM[USER-W*12]<>FALS
				THEN WRITE(LIST,CH);
			RAM[USER-W*16]:=RAM[USER-W*16]+1;
			RAM[USER-W*15]:=RAM[USER-W*15]+1;
			STRINGS[RAM[USER-W*15]]:=CH;
			END(*WHILE*);

		IF RAM[USER-W*12]<>FALS
			THEN WRITELN(LIST);
		END(*THEN*);
	IF RAM[USER-W*11]<>FALS	(* CANNOT BE USED TO LOAD FROM EDITBUF*)
	THEN	BEGIN
		IF EOF(LDFIL1) THEN MERR(FEOF);
		WHILE NOT EOLN(LDFIL1) DO
			BEGIN
			READ(LDFIL1,CH);
			RAM[USER-W*16]:=RAM[USER-W*16]+1;
			RAM[USER-W*15]:=RAM[USER-W*15]+1;
			STRINGS[RAM[USER-W*15]]:=CH;
			END(*WHILE*);
		READLN(LDFIL1);
		IF EOF(LDFIL1)	THEN RAM[USER-W*29]:=-RAM[USER-W*29]
				ELSE RAM[USER-W*29]:=RAM[USER-W*29]+1;
		END(*THEN*);
	STRINGS[LINEBUF]:=CHR(RAM[USER-W*16]+1);
	STRINGS[RAM[USER-W*15]+1]:=CHR(13);
	RAM[USER-W*15]:=LINEBUF+1;
	(**ECHO:**)
	IF (RAM[USER-W*13]<>FALS) AND (RAM[USER-W*11]<>FALS)
	THEN MESSAGE(LINEBUF);

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






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

	VAR ENDADDR:INTEGER;
	BEGIN(*MOVE*)
	ENDADDR:=AS+NOWD;
	REPEAT
		MEMORY.RAM[AD]:=MEMORY.RAM[AS];
		AD:=AD+W;
		AS:=AS+W;
	UNTIL AS>ENDADDR
	END(*MOVE*);

PROCEDURE SLIT(VAR START:INTEGER);
(* EMPLACES THE TOKEN POINTED TO BY RAM[USER-W*4] INTO
	STRINGS AND POINTS TO ITS START*)

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

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


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

	BEGIN
WITH MEMORY DO BEGIN
	IF STRINGS[RAM[USER-W*15]] <> CHR(13)
	THEN RAM[USER-W*15]:=RAM[USER-W*15]+1;

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

PROCEDURE PROMPT;
	BEGIN
WITH MEMORY DO BEGIN
	IF RAM[USER-W*50]<>FALS THEN INTERPRET(RAM[USER-W*50])(*SPECIAL USER PROMPT*)
	ELSE
	BEGIN(*PRIMITIVE PROMPT*)
	(* IFCR *)
	IF RAM[USER-W*24]>0 THEN CARRET;
	IF RAM[USER-W*14]<>FALS THEN WRITE(OUTPUT,STRINGS[STRINGSMIN]);
	IF RAM[USER-W*12]<>FALS THEN WRITE(LIST,STRINGS[STRINGSMIN]);
	MESSAGE(SYNTAXBASE);
	IF RAM[USER-W*14]<>FALS THEN WRITE(OUTPUT,'> ');
	IF RAM[USER-W*12]<>FALS THEN WRITE(LIST,'> ');
	END(*STANDARD PROMPT*)
END(*WITH MEMORY*);
	END(*PROMPT*);

PROCEDURE IGNRBLNKS;
(*ADVANCES RAM[USER-W*15] 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[USER-W*15]]) IN [0,9,10,32]
		DO NEXTCH
END(*IGNRBLNKS*);

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

	VAR LENGTH:INTEGER;
	BEGIN(*LONGSTRING*)
WITH MEMORY DO BEGIN
	IF STRINGS[RAM[USER-W*18]]<>'"' THEN ABORT;
	START:=RAM[USER-W*4];
	LENGTH:=0;
	RAM[USER-W*15]:=RAM[USER-W*18]+1; (*RESET NEXTCH POINTER*)
	WHILE NOT(ORD(STRINGS[RAM[USER-W*15]]) IN [13,34])
	 DO	BEGIN
		LENGTH := LENGTH+1;
		STRINGS[START+LENGTH]:=STRINGS[RAM[USER-W*15]];
		NEXTCH;
		END(*WHILE NOT*);
	NEXTCH;
	STRINGS[START]:=CHR(LENGTH);
	RAM[USER-W*4]:=START+LENGTH+1;

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

PROCEDURE INTOKEN;
(* PLACES STRING AT END OF STRINGS SO THAT
	RAM[USER-W*4] POINTS TO IT *)

	BEGIN
WITH MEMORY DO BEGIN
	RAM[USER-W*9]:=0;
	REPEAT
		RAM[USER-W*9]:=RAM[USER-W*9]+1;
		IF (STRINGS[RAM[USER-W*15]]>='a')
			AND (STRINGS[RAM[USER-W*15]]<='z')
			AND (RAM[USER-W*17]<>FALS)
		THEN(*RAISE TO UPPERCASE*)
			STRINGS[RAM[USER-W*9]+RAM[USER-W*4]]:=
				CHR(ORD(STRINGS[RAM[USER-W*15]])-32)
		ELSE(*NO NEED TO RAISE*)
		STRINGS[RAM[USER-W*9]+RAM[USER-W*4]]:=
			STRINGS[RAM[USER-W*15]];
		NEXTCH
	UNTIL ORD(STRINGS[RAM[USER-W*15]]) IN [0,9,10,13,32];
	STRINGS[RAM[USER-W*4]]:=CHR(RAM[USER-W*9]);
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[USER-W*2]]:=ADDRESS;
	RAM[USER-W*2]:=RAM[USER-W*2]+W;
	IF RAM[USER-W*2]>=RAMMAX THEN MERR(OVFLO) ;
END(*WITH MEMORY*);
	END(*COMPILE*);

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



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

	VAR TEND:INTEGER(*TOKEN END*);

	(*	RAM[USER-W*10]=SIGN
		RAM[USER-W*9]=STRING CURSOR	*)
	BEGIN
WITH MEMORY DO BEGIN
	VALUE:=0;
	RAM[USER-W*10]:=+1;
	TEND:=ORD(STRINGS[PTKN])+PTKN+1;
	IF STRINGS[PTKN+1]='+'THEN RAM[USER-W*9]:=PTKN+2
	ELSE IF STRINGS[PTKN+1]='-' THEN
		BEGIN RAM[USER-W*10]:=-1;
			RAM[USER-W*9]:=PTKN+2
		END
	ELSE RAM[USER-W*9]:=PTKN+1;
	WHILE(DIGIT(ORD(STRINGS[RAM[USER-W*9]]))<BASE) AND
		(DIGIT(ORD(STRINGS[RAM[USER-W*9]]))>-1) AND (RAM[USER-W*9]<TEND)
	  DO	BEGIN
		VALUE:=BASE*VALUE+DIGIT(ORD(STRINGS[RAM[USER-W*9]]));
		RAM[USER-W*9]:=RAM[USER-W*9]+1;
		END;
	VALUE:=VALUE*RAM[USER-W*10];
	IF RAM[USER-W*9]=TEND
	THEN OK:=TRUE
	ELSE OK:=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*)

	BEGIN
	MEMORY.RAM[STACK[STKPTR]]:=MEMORY.RAM[USER-W*2]-STACK[STKPTR];
	DROP;
	END(*TOUCHUP*);

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

PROCEDURE PINT(INST:INTEGER);
FORWARD;

PROCEDURE PINT0(INST:INTEGER);
(*PRIMITIVE INTERPRETATION OF [0..40]*)

BEGIN
WITH MEMORY DO BEGIN
CASE INST OF
PSEMICOLON:	(* (;) *)BEGIN
			IP:=RSTACK[RPTR];
			RPTR:=RPTR-R;
			END(* (;) *);

WSTORE:	(* W! *)BEGIN	DROP; DROP;
		RAM[STACK[STKPTR+S*2]]:=STACK[STKPTR+S];
		END;
TIMES:	(*  *  *)
	BEGIN
		STACK[STKPTR-S]:=STACK[STKPTR-S]*STACK[STKPTR];
		DROP
	END;

PLUS:	(* + *)
	BEGIN	STACK[STKPTR-S]:=STACK[STKPTR-S]+STACK[STKPTR];
		DROP
	END;

SUBTRACT:	(* - *)
	BEGIN	STACK[STKPTR-S]:=STACK[STKPTR-S]-STACK[STKPTR];
		DROP
	END;

DIVMOD:	(* /MOD *)
	IF STACK[STKPTR]<>0 THEN
	BEGIN	STACK[STKPTR+S]:=STACK[STKPTR-S] DIV STACK[STKPTR];
		STACK[STKPTR]:=STACK[STKPTR-S] MOD STACK[STKPTR];
		STACK[STKPTR-S]:=STACK[STKPTR+S];
	END
	ELSE	MERR(DIVBY0);


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

WAT:	(* W@ *)
	STACK[STKPTR]:=RAM[STACK[STKPTR]];

ABRT:	ABORT;

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

LOAD:	(* LOAD *)
	BEGIN
	DROP;
	RAM[USER-W*11]:=STACK[STKPTR+S];
	IF RAM[USER-W*11]>MAXLINNO
	THEN	BEGIN
		FOR I:= 1 TO 20 DO INFIL1[I]:=CHR(0);
		RAM[USER-W*10]:=ORD(STRINGS[RAM[USER-W*11]]);
		FOR I := 1 TO RAM[USER-W*10]
			DO INFIL1[I]:=STRINGS[RAM[USER-W*11]+I];
		RESET(LDFIL1,INFIL1);
		RAM[USER-W*29]:=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:	DROP;

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

EXEC:	(* EXEC *)
	BEGIN	DROP;
		IF (*KERNEL?*) (STACK[STKPTR+S])<NUMINSTR
		THEN PINT(STACK[STKPTR+S])
		ELSE	BEGIN
			RPUSH(IP);
			IP:=STACK[STKPTR+S];
			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:	SWAP;

TYI:	(* TYI *)
	BEGIN
		IF EOLN(INPUT) THEN READLN(INPUT);
		READ(INPUT,C);
		PUSH(ORD(C))
	END;

TYO:	(* TYO *)
	BEGIN
		DROP;
		CHOUT(CHR(STACK[STKPTR+S]));
	END(* TYO *);

RPSH:	(* <R *) (*OPPOSITE TO R> , ABOVE , RPOP: *)
	BEGIN
	RPUSH(STACK[STKPTR]);
	DROP;
	END(*RPSH:*);


SEMICF:	(* ;F *)
	BEGIN
		(* IFCR *)
		IF RAM[USER-W*24]>0 THEN CARRET;
		IF(RAM[USER-W*11]<MAXLINNO)AND(RAM[USER-W*11]>0)
		THEN	BEGIN
			RAM[USER-W*11]:=RAM[USER-W*11]-1;
			WRITELN(OUTPUT);
			WRITELN(OUTPUT,' THROUGH LINE ',
				RAM[USER-W*11]:3,'(DECIMAL) LOADED');
			IF RAM[USER-W*12]<>FALS THEN
			BEGIN
			WRITELN(LIST);
			WRITELN(LIST,' THROUGH LINE ',
				RAM[USER-W*11]:3,'(DECIMAL) LOADED');
			END(*IF RAM[USER-W*12]<>FALS*)
			END(*<MAXLINNO*);
		IF (RAM[USER-W*11]>=MAXLINNO)
		THEN	BEGIN
			WRITELN(OUTPUT,INFIL1,' LOADED');
			IF RAM[USER-W*12]<>FALS THEN WRITELN(LIST,INFIL1,' LOADED');
			END(* >=MAXLINNO *);
		RAM[USER-W*11]:=0;
	END(*SEMICF:*);

RAT:	(* R@ *)
	BEGIN
	DROP;
	IF((RPTR-R*STACK[STKPTR+S])<RSTACKMIN) THEN MERR(UNDFLO);
	PUSH(RSTACK[RPTR-R*STACK[STKPTR+S]]);
	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[USER-W*2]+W);
		TOUCHUP;
		END
	ELSE SYNTERR;

BEGINOP:	(* BEGIN *)
	BEGIN
	PUSHCK('B');
	PUSH(RAM[USER-W*2])
	END;

ENDOP:	(* END *)
	IF STRINGS[ORD(STRINGS[SYNTAXBASE])+SYNTAXBASE] = 'B'
	THEN	BEGIN
		DROPCK;
		COMPILE(PIF);(* (IF) *)
		COMPILE(STACK[STKPTR]-RAM[USER-W*2]);
		DROP;
		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[USER-W*2]);
		TOUCHUP;
		DROP;
		END
	ELSE SYNTERR
	END(*REPET:*);

PERCENT:	(* % *)	GEOLN;

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


PROCEDURE PINT1(INST:INTEGER);
(*PRIMITIVE INTERPRETATION OF [41..NUMINSTR-1]*)
BEGIN
WITH MEMORY DO BEGIN
	CASE INST OF


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

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

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

PDOOP:	(* (DO) *)	PDO;

PPLOOP:	(* (+LOOP) *)
	BEGIN
	DROP;
	LSTACK[LPTR]:=LSTACK[LPTR]+STACK[STKPTR+S];
	ALOOP;
	END(*PPLOOP:*);

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

CAT:	(* C@ *)
	STACK[STKPTR]:=ORD(STRINGS[STACK[STKPTR]]);

CSTORE:	(* C! *)
	BEGIN
	DROP;
	DROP;
	STRINGS[STACK[STKPTR+S*2]]:=CHR(STACK[STKPTR+S]);
	END(*CSTORE:*);

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

GT:	(* GT *)
	BEGIN
	DROP;
	DROP;
	IF STACK[STKPTR+S]>STACK[STKPTR+S*2]
		THEN PUSH(TRU)
		ELSE PUSH(FALS);
	END(*GT:*);

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


KRNQ:	(* KERNEL? *)
	BEGIN
	DROP;
	IF (*KERNEL?*) (STACK[STKPTR+S])<NUMINSTR
	THEN PUSH(TRU)
	ELSE PUSH(FALS)
	END(*KRNQ:*);


53:	(*CAN BE RECYCLED*)
	WRITELN(OUTPUT,'OPCODE 53 USED ILLEGALLY');


54:	(*CAN BE RECYCLED*)
	WRITELN(OUTPUT,'OPCODE 54 USED ILLEGALLY');


SAT:	(* S@ *)(*GETS ITEMS OUT OF THE STACK*)
		(* 'DUP : 0 S@ ; *)
	IF STACK[STKPTR]<(STKPTR-STACKMIN-S)
	THEN STACK[STKPTR]:=STACK[STKPTR-S*STACK[STKPTR]-S]
	ELSE MERR(UNDFLO);

FINDOP:	(* FIND *)
	BEGIN
	DROP;
	PUSH(FIND(STACK[STKPTR+S],STACK[STKPTR+S*2]));
	END(*FINDOP:*);

LISTFIL:	(* LISTFILE *)
	BEGIN
	WITH MEMORY DO BEGIN
	DROP;
	IF LISTNAME<>NULLNAME THEN
		WRITELN(OUTPUT,' CHANGING LISTFILE NAME FROM:',
			LISTNAME);
	LISTNAME:=NULLNAME;
	FOR I:=1 TO ORD(STRINGS[STACK[STKPTR+1]])
	DO LISTNAME[I]:=STRINGS[STACK[STKPTR+1]+I];
	REWRITE(LIST,LISTNAME);
	END(*WITH MEMORY*)
	END(*LISTFIL:*);

(* 58: MAY BE RECYCLED *)


LAT:	(* L@ *)(*SIMILAR TO S@, BUT FOR LOOP STACK*)
		(* 'I : 0 L@ ; *)
	BEGIN
		DROP;
		IF LPTR<STACK[STKPTR+S] THEN ABORT;
		PUSH(LSTACK[LPTR-L*STACK[STKPTR+S]]);
	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[USER-W*25]);
		TOUCHUP;
		END
	ELSE	SYNTERR;

POFCAS:	(* (OFCASE) *)
	BEGIN
	DROP;
	STKPTR:=STKPTR+S;
	CPUSH(IP+RAM[IP]);
	CPUSH(STACK[STKPTR]);
	(*SKIP*) IP:=IP+W;
	END(*POFCAS:*);

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

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
	DROP;
	FOR I:=1 TO 20 DO NAMEIN[I]:=CHR(0);
	FOR I:=1 TO ORD(STRINGS[STACK[STKPTR+1]])
		DO NAMEIN[I]:=STRINGS[STACK[STKPTR+1]+I];
	RESET(EDIN,NAMEIN);
	RAM[USER-W*30]:=0;
	END(*OPENR*);

OPENW:	(* OPENW *)
	BEGIN
	DROP;
	FOR I:=1 TO 20 DO NAMOUT[I]:=CHR(0);
	FOR I:=1 TO ORD(STRINGS[STACK[STKPTR+1]])
		DO NAMOUT[I]:=STRINGS[STACK[STKPTR+1]+I];
	REWRITE(EDOUT,NAMOUT);
	RAM[USER-W*31]:=0;
	END(*OPENW:*);

READL:	(* READLINE *)
	BEGIN
	RAM[USER-W*16]:=0;
	RAM[USER-W*15]:=LINEBUF;
	IF RAM[USER-W*30]<0 THEN MERR(FEOF);
	WHILE NOT EOLN(EDIN)
	DO	BEGIN
		READ(EDIN,C);
		RAM[USER-W*16]:=RAM[USER-W*16]+1;
		RAM[USER-W*15]:=RAM[USER-W*15]+1;
		STRINGS[RAM[USER-W*15]]:=C;
		END(*WHILE*);
	READLN(EDIN);
	IF EOF(EDIN)	THEN RAM[USER-W*30]:=-RAM[USER-W*30]-1
			ELSE RAM[USER-W*30]:=RAM[USER-W*30]+1;
	STRINGS[LINEBUF]:=CHR(RAM[USER-W*16]+1);
	STRINGS[RAM[USER-W*15]+1]:=CHR(13);
	RAM[USER-W*15]:=LINEBUF+1;
	IF RAM[USER-W*13]<>FALS THEN MESSAGE(LINEBUF);
	END(*READL:*);

WRITL:	(* WRITELINE *)
	BEGIN
	DROP;
	IF RAM[USER-W*31]>0 THEN MERR(NOPEN);
	RAM[USER-W*9]:=STACK[STKPTR+S];
	RAM[USER-W*10]:=RAM[USER-W*9]+ORD(STRINGS[RAM[USER-W*9]])-1;
	WHILE RAM[USER-W*9] < RAM[USER-W*10]
	DO	BEGIN
		RAM[USER-W*9]:=RAM[USER-W*9]+1;
		WRITE(EDOUT,STRINGS[RAM[USER-W*9]]);
		END(*WHILE*);
	WRITELN(EDOUT);
	RAM[USER-W*31]:=RAM[USER-W*31]-1;(*INCREASE NEGATIVE*)
	END(*WRITL*);

CORDMP:	(* COREDUMP *)
	BEGIN
	WITH MEMORY DO BEGIN
	DROP;
	FOR I:=1 TO 20 DO IMAGENAME[I]:=CHR(0);
	FOR I:=1 TO ORD(STRINGS[STACK[STKPTR+S]])
		DO IMAGENAME[I]:=STRINGS[STACK[STKPTR+S]+I];
	REWRITE(SAVEFILE,IMAGENAME);
	WRITE(SAVEFILE,MEMORY);
	END(*WITH MEMORY*);
	END(*CORDMP*);

RESTOR:	(* RESTORE *)
	BEGIN
	WITH MEMORY DO BEGIN
	DROP;
	FOR I:=1 TO 20 DO IMAGENAME[I]:=CHR(0);
	FOR I:=1 TO ORD(STRINGS[STACK[STKPTR+S]])
		DO IMAGENAME[I]:=STRINGS[STACK[STKPTR+S]+I];
	RESET(SAVEFILE,IMAGENAME);
	READ(SAVEFILE,MEMORY);
	ABORT;
	END(*WITH MEMORY*);
	END(*RESTOR:*);



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

PROCEDURE PINT;
	BEGIN
	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 (*KERNEL?*) INSTR<NUMINSTR
		THEN PINT(INSTR)
		ELSE	BEGIN
			RPUSH(IP);
			IP:=INSTR;
			END;
		INSTR:=RAM[IP];
		(*TRACE PATCH*)
		IF RPTR=(RAM[USER-W*19]-R*2)
		THEN	BEGIN
			SAVINSTR:=INSTR;
			SAVLEVEL:=RPTR;
			INSTR:=RAM[USER-W*26];
			IP:=IP-W;
			REPEAT
				IP:=IP+W;
				IF (*KERNEL?*)
					INSTR<NUMINSTR
				THEN PINT(INSTR)
				ELSE BEGIN
					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[USER-W*11]=FALS) OR (RAM[USER-W*13]<>FALS)
	THEN PROMPT;
IF (RAM[USER-W*11]>0) AND (RAM[USER-W*11]<MAXLINNO)
THEN	BEGIN
	PUSH(RAM[USER-W*11]);
	INTERPRET(RAM[USER-W*28]);
	RAM[USER-W*11]:=RAM[USER-W*11]+1;
	END(*THEN*)
ELSE
	GETLINE;
IGNRBLNKS;
WHILE STRINGS[RAM[USER-W*15]] <> CHR(13) DO
	BEGIN
	RAM[USER-W*18] := RAM[USER-W*15]; (* NOTE TOKEN START*)
	INTOKEN;
	ADDR:=FIND(RAM[USER-W*4],ADDR);
	IF ADDR<>FALS
	THEN(*FOUND*) INTERPRET(ADDR-W) (* THE CPA *)
	ELSE
	BEGIN(*NOT DEFINED DURING EXECUTION*)
		CONVERT(RAM[USER-W*4],RAM[USER-W*1],CONVERTED,VAL);
		IF CONVERTED THEN BEGIN
					COMPILE(LIT);
					COMPILE(VAL)
				END
		ELSE
		IF STRINGS[RAM[USER-W*4]+1]='''' THEN
			BEGIN
			SLIT(VAL);
			COMPILE(STRLIT);
			COMPILE(VAL);
			END(*IF SINGLE-QUOTED STRING*)
		ELSE IF STRINGS[RAM[USER-W*4]+1]='"' THEN
			BEGIN	LONGSTRING(VAL);
				COMPILE(STRLIT);
				COMPILE(VAL);
			END(*DOUBLE QUOTED STRING*)

		ELSE IF RAM[USER-W*51]<>FALS THEN INTERPRET(RAM[USER-W*51])
			(*USER SUPPLIED CONVERSION*)

		ELSE	BEGIN (*TOKEN NOT DECHIPHERABLE*)
			RAM[USER-W*14]:=TRU(*TURN ON CONSOLE*);
			(*SHOW BAD LINE IF NOT ON CONSOLE*)
			IF (RAM[USER-W*11]<>FALS) AND (RAM[USER-W*13]=FALS)
			THEN	BEGIN
				(* IFCR *)
				IF RAM[USER-W*24]>0
				THEN CARRET;
				MESSAGE(LINEBUF);
				END(*IF*);

			MESSAGE(RAM[USER-W*4]);
			WRITELN(OUTPUT,' ?');
			IF RAM[USER-W*12]<>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[USER-W*4];
	RAM[USER-W*4]:=RAM[USER-W*4]+1;
	FOR I:= 1 TO LENGTH  DO
		BEGIN
		STRINGS[RAM[USER-W*4]]:=STRING[I];
		RAM[USER-W*4]:=RAM[USER-W*4]+1;
		END(*FOR*);

	STRINGS[START]:=CHR(I-1);
	(* STRING HAS NOW BEEN PLACED IN STRINGS,RAM[USER-W*4]
		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[USER-W*6]]);	(*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[USER-W*6]]:=RAM[USER-W*3]-W;	(*UPDATE CURRENT*)
	FENTER(RAM[USER-W*3]);(* ENDA:=.D *)
END(*WITH MEMORY*);
END(*PENTER*);


(******************************************)
BEGIN(*PISTOL MAIN*)
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;
RAM[USER-W*57]:=MAXLINNO;
RAM[USER-W*56]:=CHKLMT;(*SIZE OF SYNTAX CHECKSTACK*)
RAM[USER-W*55]:=RAMMIN;
RAM[USER-W*54]:=STRINGSMIN;

RAM[USER-W*52]:=FALS;(*ABORT PATCH*)
RAM[USER-W*51]:=FALS;(*CONVERSION PATCH*)
RAM[USER-W*50]:=FALS;(*STANDARD PROMPT*)
RAM[USER-W*49]:=STRINGSMAX;
RAM[USER-W*48]:=VBASE;
RAM[USER-W*47]:=VSIZE;
RAM[USER-W*46]:=CSIZE;
RAM[USER-W*45]:=LSIZE;
RAM[USER-W*44]:=RSIZE;
RAM[USER-W*43]:=SSIZE;
RAM[USER-W*42]:=LINEBUF;
RAM[USER-W*41]:=COMPBUF;
RAM[USER-W*40]:=RAMMAX;
RAM[USER-W*39]:=MAXORD;
RAM[USER-W*38]:=MAXINT;

RAM[USER-W*36]:=VERSION;
RAM[USER-W*34]:=0;
RAM[USER-W*33]:=FALS;(* PISTOL< LINK IS NIL;
			IT'S AT THE END OF BRANCH LIST*)
	(*INITIALIZE FILE STATUS*)
RAM[USER-W*31]:=+1;(*EDOUT*)
RAM[USER-W*30]:=-1;(*EDIN*)
RAM[USER-W*29]:=-1;(*LDFIL1*)
RAM[USER-W*27]:=8; (*INITIALIZE TABSIZE*)
RAM[USER-W*25]:=67; (*INITIALIZE ENDCASE TO ABORT*)
RAM[USER-W*23]:=64 (* INITIALIZE TERMINAL WIDTH*);
RAM[USER-W*21]:=20 (* INITIALIZE TERMINAL PAGE LENGTH*);
RAM[USER-W*20]:=FALS;(*COMPILE-END-PATCH*)
RAM[USER-W*19]:=FALS;(*INITALIZE TRACE OFF*)
RAM[USER-W*17]:=TRU (*RAISE ON*);
RAM[USER-W*13]:=FALS (*ECHO OFF*);
RAM[USER-W*12]:=FALS;(*LIST OFF*)
RAM[USER-W*6]:=USER-W*34;
IF USER>NUMINSTR THEN	RAM[USER-W*3]:=USER+W*VSIZE+W
		ELSE	RAM[USER-W*3]:=NUMINSTR+1;(* SET BASE OF DICTIONARY*)
RAM[USER-W*5]:=SYNTAXBASE+CHKLMT+1;
RAM[USER-W*4]:=RAM[USER-W*5];
ADDSTRING(20,'*** EOF ENCOUNTERED*',FEOF);
ADDSTRING(20,'*** FILE NOT OPENED*',NOPEN);
ADDSTRING(18,'*** PISTOL 1.3 ***  ',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,'GT                  ',GT);
PENTER(2,';$                  ',-SEMIDOL);
PENTER(7,'KERNEL?             ',KRNQ);
PENTER(2,'S@                  ',SAT);
PENTER(4,'FIND                ',FINDOP);
PENTER(8,'LISTFILE            ',LISTFIL);
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[USER-W*1]:=10;	(*DECIMAL MODE*)
STRINGS[STRINGSMIN] := 'X';

ABORT;
REPEAT
RAM[USER-W*2]:=COMPBUF;
REPEAT
COMPLINE;
UNTIL STRINGS[SYNTAXBASE]=CHR(0);
COMPILE(PSEMICOLON);

IF RAM[USER-W*20]<>FALS THEN INTERPRET(RAM[USER-W*20]);

IF (RAM[USER-W*14]<>FALS) AND ((RAM[USER-W*11]=FALS) OR (RAM[USER-W*13]<>FALS))
THEN	BEGIN
	RAM[USER-W*24]:=FALS (*RESET COLUMN POSTION VARIABLE*);
	RAM[USER-W*22]:=FALS (*RESET TERMINAL LINE COUNT*);
	END;
INTERPRET(COMPBUF);
99:

RAM[USER-W*4]:=RAM[USER-W*5];
UNTIL RAM[USER-W*35]<>FALS(*SESSION DONE*);

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