TITLE LOGO
;         TM
;(C) COPYRIGHT,1970,BOLT BERANEK AND NEWMAN INC., CAMBRIDGE, MASS.
;MODIFIED AT NATIONAL RESEARCH COUNCIL (ISS/REED), OTTAWA, CANADA BY A.G.SMITH
;AND R.A. ORCHARD
;  NRC MODIFICATIONS INCLUDE NRCTUR AND MUSIC SYSTEM IMPLEMENTATION
;  FOR NRCTUR EITHER THE TEKTRONIX 4010 (TEKTUR) OR THE PLASMA
;  PANEL (PLSTUR) ARE AVAILABLE.

MLON
SALL
TWOSEG

;CONFIGURATION PARAMETERS 


IFNDEF CONFIG,<DEFINE CONFIG,<TEN50!SAVBRK!NRCTUR!PLSTUR!MUSIC>>

DEFINE OPTIONS,<
MAYBE TEN50
MAYBE TENEX
MAYBE BBN50
MAYBE TURTLE
MAYBE SAVBRK;	;IF ON, SAVEUP THE STATE OF LOGO SO THAT "GO" PROCEEDS
MAYBE LEVELC
MAYBE DRIBBLE
MAYBE MOCKTURTLE
MAYBE COMPTK
MAYBE MITREI
MAYBE NRCTUR
MAYBE PLSTUR
MAYBE TEKTUR
MAYBE MUSIC
MAYBE TENKI
>

DEFINE MAYBE (A),
<	A==%V
	%V==%V+%V>
%V==1

OPTIONS
DEFINE MAYBE (A),
<A==CONFIG&A>
OPTIONS

;TO MAKE CONFIGURATION DEPENDENT STUFF READ LIKE ENGLISH

SYN IFN,FOR
SYN IFE,NOTFOR

FOR TEN50,<
BBNVER==2		;BBN VERSION NUMBER
NRCVER==6		;NRC MODIFICATION LEVEL
OTHVER==0		;OTHER MODIFICATION LEVEL
EDITVR==44		;EDIT NUMBER, INCREMENTED AT EVERY EDITING SESSION

	.JBVER==137
	LOC .JBVER
	BYTE (3)OTHVER(9)BBNVER(6)NRCVER(18)EDITVR
>

ERPDLL==20	;LENGTH OF ERROR PDL, NEEDS TO BE LONG ENOUGH TO
		; AVOID PDL OVERFLOW TRAP
SUBTTL	STORAGE ALLOCATION AND FLAG ASSIGNMENT

;ACCUMULATOR ASSIGNMENTS
F=0	;FLAGS AND BITS 
A=1
B=2
C=3
D=4
E=5
G=7
H=10
R=11
L=12
M=13
N=14
W=15
S=16	;ARGUMENT PUSHDOWN STACK
P=17	;CONTROL PUSHDOWN STACK

;FLAGS FOR THE LH OF F

LDONF==1	;LINE DONE FLAG FOR EDIT MODE
EDITF==2
UPFF==4		;COMEXR CALLED FROM RETURN CODE, NOT FROM COMEX
TIF==10
BREAKF==20
TOF==40		;TYPE OR PRINT IN PROGRESS
GOF==100	;USER TYPED  DIRECT GO
RQF==200	;A REQUEST IN PROGRESS
COMF==400	;1 IF USER PROCEDURE BEING LEFT SHOULD BE TREATED LIKE COMMAND
GCF==1000	;1 IF THIS K HAS NOT BEEN GARBAGE COLLECTED YET
TITLEF==2000	;DOING TITLE DURING A TO
BROKE==4000	;ERROR WAS NON-TYI BREAK KEY
GETF==10000	;GET IN PROGRESS
SAVEF==20000	;SAVE IN PROGRESS, FOR ALTERNATE FORMS OF TYPEOUT
		;UNASSIGNED
NOBREAK==100000	;TO TEMPORARILY INHIBIT BREAK KEY
FCHARF==200000	;FOR COMPUTING THE TIME BETWEEN _ AND CHAR 1
GCCSF==400000	;PROGRAM EDIT DONE, CODE PTRS ON STACK MAY BE INVALID


;FLAGS FOR THE RIGHT HALF OF F

TF==1	;A TEMPORARY FLAG FOR MANY ROUTINES
PMF==2	;+- SIGN
NWF==4	;NOT WORD INPUT
CRF==10
FSYMF==20	;0 IF FIRST ELEMENT OF LINE BEING COMPILED,USED W NNUMF
NNUMF==40	;NON-NUMERIC INPUT
GRAPHF==100	;TERMINAL IS IN GRAPHICS MODE
PREFIX==200	;FOR PWORD
SUFFIX==400	;ALSO FOR PWORD
MAKEF==1000	;COMPIL CALLED WITH THIS=1 MEANS CALLED FROM MAKE
STORED==2000
FLUSHF==4000	;GETTING AN ALREADY DEFINED PROCEDURE
EABBRF==10000	;DOING LIST ENTRY ABBREVIATIONS
ECONTF==20000	;  "    "     "   CONTENTS
EENTRF==40000	;  "    "     "   ENTRY
ENAMEF==100000	;  "    "     "   NAMES
EELSEF==200000	; 1_ELSE IS OK LINE TERMINATOR
ESCHF==400000	;SEEN A NON-PRINTING CHAR IN PRODNM


;FLAG DEFINITIONS FOR LH OF STRING POINTER

IMMEDIATE==400000	;POINTER IS NOT A POINTER, BUT IS DATA
COMPOUND==200000	; ELEMENT POINTED TO IS A LIST OF POINTERS
WORDF==100	;STRING IS A WORD
SENTF==200	;SENTENCE
EMPTYF==400	;EMPTY
UNBOUN==40000	;FOUND  IN VP AND DP, 1_NOT EXPLICITLY SET
GLOBLF==100000	; "      " "   "  " , 1_TOPMOST BINDING, DONE BY MAKE

;FLAG DEFINITIONS FOR LH OF COMPILED ELEMENT

MPF==100000
UPRF==40000
VARF==20000
LITF==10000
INFOP==4000	;IS AN INFIX OPERATOR
MVARF==2000	; LIKE VARF, BUT TABLE APPEARS IN CODE
COMMTF==1000	;IS A COMMENT
ANDF==400	;USED IN TO LINES, IMPLIES THIS DUMMY PRECEDED BY AND
SCHF==20000	;USED IN USER PROCEDURE NAMES, 1_NOT PROPER FORM
MAKESC==40	;MEANS 2 LINE MAKE AND END OF NAME:
;ALSO IN THE LEFT HALF OF COMPILED ELEMENT CAN BE STRING BITS


;FLAG DEFINITIONS FOR LEFT HALF OF FIRST WORD OF RP PAIR

TRACEF==100000	;THIS PROCEDURE IS BEING TRACED

;FLAG DEFINITION FOR LH OF 2ND WORD OF MACHINE NAME PAIR

COMPUT==400000	;IF ONE, THIS NAME MUST BE COMPUTED, ADDR IN RH


;UUO DEFINITIONS

OPDEF ERROR [1B8]
OPDEF EXPAND [2B8]
OPDEF GARBAGE [3B8]
OPDEF SQUEZE [4B8]
OPDEF PJRST [254B8]
FOR PLSTUR,<
;CHARACTERS FOR SCREEN CONTROL FOR THE PLASMA PANEL TERMINAL

GRFON==16		;TURN ON GRAPHIC MODE

DEFINE NEWPAG,<BYTE(7) 17,14,0> ;SHIFT OUT OF GRAPHICS AND CLEAR SCREEN
GRFOFF==17		;TURN OFF GRAPHIC MODE

;PARAMETERS OF THE TERMINAL

CNTRLB==2		;OCTAL FOR CONTROL B
PCHAR==120		;OCTAL FOR CHARACTER "P"
HIXOFS==60		;OFFSET FOR HIGH ORDER X COORDINATE
LOXOFS==120		;OFFSET FOR LOW     "      "       "
HIYOFS==60		;ALSO FOR Y COORDINATE
LOYOFS==120		;
HILIMX==^D511		;UPPER AND LOWER SCREEN LIMITS FOR X
LOLIMX==0		;
HILIMY==^D511		;UPPER AND LOWER SCREEN LIMITS FOR Y
LOLIMY==0		;

; SOME PARAMETERS RELATING TO THIS IMPLEMENTATION

TURSSC==1.0		;FLOATING POINT SCREEN SCALE FACTOR
TURHMX==256.0		;FLOATING POINT HOME POSITION FOR X AND Y
TURHMY==256.0		;
;HOME POSITION IS CENTER OF SCREEN (256,256) FOR PLASMA TERMINAL
DEFINE TURHOM,<BYTE (7) 70,120,70,120,^D90>
;FIRST 4 BYTES OF TURHOM ARE THE HOME VALUES TURNYH,TURNYL,TURNXH,TURNXL
;LAST BYTE IS HOME VALUE OF ORIENT (90 DEGREES,I.E. STRAIGHT UP)
>

FOR TEKTUR,<
;CHARACTERS FOR SCREEN CONTROL FOR TEKTRONIX 4010 TERMINAL

GRFON==35		;TURN ON GRAPHIC OUTPUT MODE
GRFOFF==37		;TURN OFF GRAPHIC OUTPUT MODE
DEFINE NEWPAG,<BYTE (7)33,14,0>	;CLEAR SCREEN

;PARAMETERS OF THIS TERMINAL

HIXOFS==40		;CHARACTER CODE OFFSET FOR HIGH ORDER X COORDINATE
LOXOFS==100		;FOR LOW ORDER X COORDINATE
HIYOFS==40		;FOR HIGH ORDER Y COORDINATE
LOYOFS==140		;FOR LOW ORDER Y COORDINATE
HILIMX==^D1023		;UPPER LIMIT FOR X ON SCREEN
LOLIMX==0		;LOWER LIMIT FOR X ON SCREEN
HILIMY==^D780		;UPPER LIMIT FOR Y ON SCREEN
LOLIMY==0		;LOWER LIMIT FOR Y ON SCREEN

;PARAMETERS RELATING TO THIS IMPLEMENTATION

TURSSC==1.024		;FLOATING POINT SCREEN SCALE FACTOR
TURHMX==500.0		;FLOATING POINT HOME POSITION - X
TURHMY==381.3		;FLOATING POINT HOME POSITION - Y

;HOME POSITION IS CENTER OF SCREEN (512,390) FOR THIS TERMINAL
DEFINE TURHOM,<BYTE (7)54,146,60,100,^D90>
;FIRST FOUR BYTES OF TURHOM ARE THE HOME VALUES OF TURNYH,TURNYL,TURNXH,TURNXL
;LAST BYTE IS HOME VALUE OF ORIENT (90 DEGREES, I.E. STRAIGHT UP)
>
;STORAGE ALLOCATION TABLE DEFINITIONS

DEFINE TABLES
;ANY CHANGE TO THE ORDER OF THESE TABLES MUST BE REFLECTED AT CMPRSS:
<TT RP,40,<[EXP RPA,0]>	;THESE THREE MAY BE IN ANY ORDER
 TT VP,40,<[EXP VPA,0]>
 TT UA,40
 TT PS,200,<[EXP PSA,PSD,PSM,0]>	;THESE TWO MUST BE IN THIS ORDER
 TT DP,200,<[EXP DPC,0]>
 TT SP,40,<[EXP UUOACS+S,0]>	;THESE TWO MUST OCCUR IN THE SAME ORDER AS IN ACS
 TT PP,200,<[EXP UUOACS+P,0]>
FOR TENEX,< TT WS,2000,<[EXP W,WSA,WSM,WSB,WSD,UUOACS+W,0]>>
FOR TEN50,<TT WS,2000,<[EXP W,WSA,WSM,WSB,WSD,UUOACS+W,BUFLOC,BUFLOC+1,FPTR,FPTR+1,0]>>
;THIS ONE MUST ALWAYS BE LAST SO MEM TRAP CAN BE USED AS END TEST
>
DEFINE POINTR
<MM RP,A
 MM VP,A
 MM PS,A
 MM PS,D
 MM PS,M
 MM DP,C
 MM WS,A
 MM WS,M
 MM WS,D
 MM WS,B>

DEFINE U(A1)<UU(A1,1)>
DEFINE UU(A1,A2)<
A1:	BLOCK A2 >

DEFINE UNDEX (AC)
< ADD	AC,[XWD 070000,0]
  CAIG	AC,0
  SUB	AC,[XWD 430000,1]>

RELOC	0

;UNSHARED AREA, NON-ZERO STUFF FIRST

FOR MOCKTURTLE,<TURJFN=.
	BLOCK 1 >	; SET BY OTHER PROCESS AND NEVER CLEARED BY LOGO
FURST==.	;IN CASE DIFFERENT SYSTEMS PUT DATA IN DIFFERENT PLACES
UU UUOTRP,2;	;Z
		;JRST DOUUO
DEFINE MM (A1,A2)
<U A1'A2>
POINTR
U PTOP;	;ORDER OF THE NEXT TWO IS EXTREMELY IMPORTANT, MUST BE
U DTOP;
U WTOP;
U RANNO;	;STUFF TO COMPUTE PSEUDO-RANDOM DIGIT

FOR TENEX,<	UU JFNTAB,10;	;FOR OPENNING FILES
		UU CHNTAB,^D23>	;PSEUDO-INTERRUPT CHANNEL DISPATCHES

;OTHER GOOD FILE STUFF

U CHIN;		;INSTRUCTION TO EXECUTE TO READ A CHARACTER
U CHOUT;	;INSTRUCTION TO EXECUTE TO WRITE A CHARACTER
U INFILE;
U FPTRL0;	;ADDRESS OF BYTE POINTER FOR LOGICAL BUFFER 0
U FPTRL1;	;ADDRESS OF BYTE POINTER FOR LOGICAL BUFFER 1
U CCOUNT;	;COUNT OF CHARS REMAINING UNUSED IN LBUF+1
U TANDD;	;TIME AND DATE OF STARTUP
U FILEAD;	;FIRST BLOCK OF ENTRY BEING WRITTEN
U FILECT;	;COUNT OF BLOCKS USED IN WRITING THIS FILE
U LABS;		;WHERE PTR TO TOP OF FREE SPACE IS STORED DURING OPERATION
		;I.E. NUMBER OF FIRST FREE LOGICAL BLOCK OF A FILE
U LDIRNO;	;BLOCK NUMBER OF PREVIOUS DIRECTORY
U LDIRL;	;NUMBER OF ENTRIES IN LDIRNO
U FILSIZ;	;SIZE IN DISC BLOCKS OF FILE
UU DMPLST,2
;DATA FOR EACH PHYSICAL BUFFER

UU BUFLOC,2;	;LOCATION IN CORE
UU PBLOCK,2;	;LOGICAL BLOCK NUMBER IN THE BUFFER
UU CHANGE,2;	;0 IF NOT ALTERED
UU FPTR,2;	;BYTE PTR INTO A BUFFER

;DATA FOR EACH LOGICAL BUFFER

UU LBLOCK,2;	;LOGICAL BLOCK NUMBER IN THIS LOGICAL BUFFER
UU LBUF,2;	;PHYSICAL BUFFER USED BY LOG BUFFER (0 OR 1)

FOR TEN50,<
UU OPNPAR,3;	;THIS MUST PRECEDE LUKDAT FOR COPY TO CLEAR!
UU LUKDAT,4
UU BUFADR,2;	;STRING POINTER LOCATIONS OF FILE BUFFERS
>
FOR DRIBBLE,<
U DRIBFL;	;FILE NUMBER OF DRIBBLE FILE
U DRIBTM;	;TIME OF TYPING _ FOR THE TIME STAMP
>

;DATA FOR NRC SCREEN TURTLE

FOR NRCTUR,<

U TURNYH;	;CHARACTER CODE FOR CURRENT HIGH-ORDER Y
U TURNYL;	;	"	"	"   LOW-ORDER Y
U TURNXH;	;	"	"	"   HIGH-ORDER X
U TURNXL;	;	"	"	"   LOW-ORDER X
U TURNFX;	;CURRENT X POSITION IN FLOATING POINT
U TURNFY;	;	 Y	"	"	"

U TUROYH;	;CHARACTER CODE FOR PREVIOUS HIGH-ORDER Y
U TUROYL;	;	"	"	"    LOW-ORDER Y
U TUROXH;	;	"	"	"    HIGH-ORDER X
U TUROXL;	;	"	"	"    LOW-ORDER X
U TUROFX;	;PREVIOUS X POSITION IN FLOATING POINT
U TUROFY;	;	  Y	"	"	"


U ORIENT;	;TURTLE'S CURRENT ORIENTATION (FIXED POINT - IN DEGREES)

U PENST;		;STATE (RAISED OR LOWERED) OF PEN
U OFFSCR;		;ON-SCREEN/OFF-SCREEN STATUS OF PEN
>
FOR MUSIC,<	;DATA FOR LOGO MUSIC BOX

U BXTYPE;		;HOLDS TYPE OF MUSIC BOX IN USE
U MBUFP
U MBMAX
U MBPOS
U NVOICE
U STCATO
>


DEFINE TT(A1,A2,A3)
<.'A1==.-BASETB
U A1>
BASETB:
TABLES
U CHARNO;	;THESE FOR INPUT SECTION
U BCHAR
U TRACEM;	;LIKE BCHAR BUT ONLY FOR TRACE OUTPUT
U SCOUNT
U LINENO
U PRODNM;	;NAME OF PROCEDURE IN PROGRESS
U TRUTH
U CBOT;	;BASE OF LINE PTED TO BY CPP
U CSTOCT;	;COUNT OF ROOM LEFT IN LINE BEING COMPILED
U CPP;		;POINTER INTO COMPILED LINE
U SPP;		;CONTENTS OF S AND P AT START OF LINE
U LINBOT
U SRCBOT
U NEWBOT
U NXLINE;	;PTR TO NEXT LINE IN CURRENT PROCEDURE
U THISPR;	;MACHINE PROCEDURE LAST IN, PTR TO 2ND ENTRY IN CMPT
U TOPROD;	;NAME OF PROCEDURE BEING DEFINED
U BRKTEM;	;TEM STORAGE FOR BREAKY ROUTINE
FOR TENEX,<U BRKTEB>	;MORE TEM FOR BREAK KEY 
U GODEPT;	;THE NUMBER OF GO'S IN THE STACK
U TOFDAY;	;TIME OF STARTUP IN SECS SINCE MIDNIGHT OR RESET CLOCK
U BSP;		;SPP ASSOCIATED WITH GODEPTH, STACKS AT LAST SAVED BREAK
U GCTEM;	;TEM STORAGE FOR GC AND ALLOCATOR
U SAV.A
U SAV.B
U SAV.D
U SAVEIT
UU UUOACS,20
UU ERRPDL,ERPDLL;	;FIXED PUSHDOWN FOR ERROR HANDLER
FOR TENEX,<	UU LEVLTB,3>	;FOR PSI SYSTEM
U GETDST;	;STUFF FOR COPY
U SAVSRC
FOR TENEX,<U COPJFN>
FOR TEN50,<
U FPTR2
U CCNT2
U BUFLC2;	;ABS ADDR OF COPY BUFFER
U BUFAD2;>	;WS ADDR OF COPY BUFFER
FOR MOCKTURTLE,<
U CURX
U CURY
U CURA
U PENPOS;	;0_DOWN, -1_UP
U TURX
U TURY
U TURXO
U TURYO;	; OLD TURX AND TURY FOR CHECKING FOR LONG MOVES
>
BLAST==.-1

SUBTTL	INITIALIZATION

JOB41=.JB41##
JOBSA=.JBSA##
JOBREL=.JBREL##
JOBUUO=.JBUUO##

FOR TEN50,<
JOBREN=.JBREN##
JOBAPR=.JBAPR##
JOBOPC=.JBOPC##
JOBDDT=.JBDDT##
JOBFF=.JBFF##
JOBCNI=.JBCNI##
JOBTPC=.JBTPC##

	RELOC	400000
>
FOR TENEX,<
	SEARCH STENEX
	RELOC>	;PAGE 0 WILL BE WRITABLE,1-LOGEND NOT

LOGO:	MOVEI	F,0	;CLEAR FLAGS, MAY BE SKIPPED ON CERTAIN RESTARTS
FOR TEN50,<
	CALLI	0	;RESET
	MOVEI	A,BREAKY
	MOVEM	A,JOBREN	;FOR BREAK KEY
	MOVEI	A,ALLOC
	MOVEM	A,JOBAPR	;FOR ILLEGAL MEMORY REFS
	HLRZ	A,JOBSA		;INITIALIZE THE LOW SEG
	HRLI	A,(A)
	ADDI	A,1
	HRRZ	B,JOBREL	;TOP OF HIGHEST K ASSIGNED
	SETZM	-1(A)
	BLT	A,(B) >		;CLEAR FROM JOBFF TO TOP OF ASSIGNED CORE

FOR TENEX,<
	RESET
	MOVE	A,[SIXBIT /LOGO/]
	SETNM				;SET UP NAME FOR SYSTAT
	MOVE	A,[XWD 30000,30001]
	SETZM	30000
	BLT	A,31777 >
FOR TEN50,<
	MOVE	1,[SIXBIT /LOGO/]
	SETNAM	1, >

	MOVE	A,[JSR UUOTRP]
	MOVEM	A,JOB41		;FOR UUOS

	MOVE	A,[XWD FURST,FURST+1]
	SETZM	FURST
	BLT	A,BLAST	;CLEAR FROM START OF CORE TO EITHER DDT OR JOBFF

	MOVE	A,[XWD SPFRST,FURST]
	BLT	A,FURST+SPLLEN-1 ;SET UP NON-ZERO PART OF UNSHARED CORE

FOR TEN50,<	HLRZ	B,JOBSA>	;ALWAYS THE FIRST FREE LOCATION
FOR TENEX,<	MOVEI	B,30000>	;ENOUGH ROOM FOR CODE AND SYMBOLS
	HRLZI	A,-.WS-1
INILU:	HLRZ	C,ALOCTB(A)	;POINTER TO LIST OF CELLS TO BE SET UP
	HRRZM	B,BASETB(A)	;RP ETC.
	JUMPE	C,INILUR	;NO SUBSIDIARY LIST

INILU1:	SKIPN	E,(C)
	JRST	INILUR		;END OF SUBSIDIARY LIST
	HRRM	B,(E)		;NO, RPA ETC.
	AOJA	C,INILU1	;NEXT IN THIS LIST

INILUR:	ADD	B,ALOCTB(A)	;HOW MUCH TO GIVE TO THIS SPACE
	AOBJN	A,INILU		;MORE SPACES TO GO

	MOVEI	A,0
	JSP	C,SETPDL

FOR TEN50,<
	HRRZ	A,JOBREL
	CAIGE	A,@WTOP	;IS WTOP INSIDE CURRENT ALLOCATION?
	EXPAND	WS	;NO, GET A K SO WS WILL FIT
	PUSHJ	P,SETTTM	;SET TELETYPE MODE TO BBN'S TELCOMP MODE
	MOVEI	A,220000
	APRENB	A,			;REQUEST PDL AND ILL MEM REF TRAPS
>

FOR TENEX,<
	MOVEI	A,30000-1
	MOVEM	A,JOBREL
	JSP	G,NEWMEM
	 ERROR	. >

	HRRZI	A,(W)
	HRLI	A,.WBASE
	BLT	A,.WTOP-.WBASE-1(W)
	HRRZI	A,FLUSHM
	HRRM	A,JOBSA	;DON'T REDO THE INITIAL STORAGE ALLOCATION

	PUSHJ	P,TIMDAY	;IN SECONDS SINCE MIDNIGHT
	TRNN	F,TF
	MOVEM	C,TOFDAY	;TIME OF LAST RESET CLOCK
	MOVEI	B,[ASCIZ /
LOGO

/]
	TRNN	F,TF	;1 IF CALLED BY ERASE ALL
	PUSHJ	P,TOSS


RESET:	SETZM	TRACEM		;TRACE MARGIN 

FOR NRCTUR,<PUSHJ	P,TURRST>	;RESET SCREEN PARAMETERS

FOR TEN50,<	PUSHJ	P,SETTTM	;ENTER TELCOMP MODE
	MOVEI	A,220000
	CALLI	A,16>		;APR ENABLE

FOR TENEX,<
	CIS		;CLEAR PSI SYSTEM
	MOVEI	A,400000	;DENOTE THIS FORK
	MOVE	B,[XWD LEVTAB,CHNTAB]
	SIR			;SET UP PSI SYSTEM
	MOVEI	A,0		;BREAK TO CHANNEL 0
	ATI			;ASSIGN TERMINAL INTERRUPT
	MOVEI	A,400000	;THIS FORK
	MOVE	B,[1B0+1B9+1B10+1B11+1B22]	;
	AIC			;ACTIVATE THESE CHANNELS
	EIR			;ENABLE THE SYSTEM
	MOVEI	A,101
	MOVE	B,[EXP 525252525252]
	MOVE	C,B
	SFCOC		;SET ALL CONTROL CHAR TYPEOUTS TO BE THEMSELVES
	MOVEI	A,100
	RFMOD			;READ THE TERMINAL INPUT MODES
	ANDCMI	B,770000	;ZERO OUT THE WAKEUP SET
	IORI	B,140000	;SET THE WAKEUP SET TO ALL CONTROLS
	SFMOD >			;SET THEM


	SQUEZE			;TAKE OUT ANY EXTRA ALLOCATION

	TRZE	F,TF	;1 IF CALLED BY ERASE ALL
	JRST	MAINL
FOR DRIBBLE,<		;INITIALIZE THE DRIBBLE FILE
FOR TENEX,<
	TLO	F,NOBREAK	;DO NOT ALLOW BREAK KEY HERE
	MOVEI	B,[ASCIZ /INITIALS PLEASE: /]
	PUSHJ	P,TIS		;REQUEST INITIALS
	 JRST	.-2		;RUBOUT
	MOVEI	A,[ASCIZ /DRB/]
	MOVEM	A,JFNTAB+5
	MOVE	B,0(S)
	MOVEI	A,10
	CAMGE	A,@WSB
	 ERROR	FILER9
	ADDI	B,1(W)
	HRRZM	B,JFNTAB+4
	MOVE	A,[ASCIZ /NMI/]
	CAMN	A,(B)		;TO OVERRIDE DRIBBLE CAPABILITY?
	 JRST	DRIBEND		;YES
;FIX UP THE INPUT NAME
	MOVEI	A,1
	MOVEM	A,JFNTAB
	MOVEI	A,JFNTAB
	SETZ	B,
	GTJFN
	 ERROR	IOPERR
	MOVE	B,[XWD 070000,020000]	;FOR APPENDING
	OPENF
	 ERROR	IOPERR
	MOVEM	A,DRIBFL

	MOVEI	B,";"
	BOUT
	SETO	B,
	SETZ	C,
	ODTIM
	MOVEI	B," "
	BOUT
	MOVE	D,0(S)
	HRLI	D,(POINT 7,(W),34)
	ILDB	B,D
	BOUT		;MAYBE?
	JUMPN	B,.-2
	MOVEI	B,37
	BOUT
DRIBEND:	POP	S,A
	TLZ	F,NOBREAK
>>
SUBTTL	MAIN PROCESSOR LOOP

MAINL:	MOVEI	B,[ASCIZ /_/]
	SKIPE	TOPROD	;ARE WE DEFINING A PROCEDURE NOW?
	MOVEI	B,[ASCIZ />/]	;YES, READY CHAR IS >
	PUSHJ	P,TIS
	 JRST	MAINL
MAINL1:	PUSHJ	P,COMPIL
	 JRST	MAINL	;GOT A STORED LINE
	PUSHJ	P,EXECUT
	JRST	MAINL

;UUO TRAP HANDLER

DOUUO:	MOVEM	17,UUOACS+17
	HRRZI	17,UUOACS
	BLT	17,UUOACS+16
	MOVE	17,UUOACS+17
	HLRZ	A,JOBUUO
	ASH	A,-11	;FLUSH AC, IF ONE
	CAILE	A,4	;SQUEZE IS THE HIGHEST KNOWN UUO
	JRST	ILLUUO
	JRST	@.(A)	;ZERO CAUGHT BY MONITOR
	 ERRORR
	 ALLOCATOR
	 CALGAR
	 CMPRSS
CALGAR:	MOVE	B,WTOP
	EXCH	B,UUOACS+B
	MOVEM	B,SAV.B
	JSP	P,GARCOL	;NO PUSHES OR POPS IN GC
	MOVE	B,SAV.B
	MOVEM	B,UUOACS+B	; GARCOL NEEDS MAX REF FOR DE-ALLOC
	JRST	UUORET

FOR TEN50,<
CALDDT:
FOR BBN50,<MOVEI A,20000	;LEAVE TELCOMP MODE IF IN IT
	TTCALL	6,A
	TLZ	A,600000
	TTCALL	7,A >
	HRRZ	A,JOBDDT
	JUMPE	A,[ERROR .]
	PUSHJ	P,(A)	;SO DEBUGGER MAY POPJ P,$X TO RETURN
	PUSHJ	P,SETTTM
	JRST	COMEX

SETTTM:
FOR BBN50,<	MOVEI	A,20000
	TTCALL	6,A
	TLO	A,600000
	TTCALL	7,A >
	POPJ	P,

BREAKY:	TTCALL	11,
	TTCALL	12,
	TLNE	F,NOBREAK	;IGNORE BREAK KEY?
	JRST	.+3		;YES
	TLNE	F,TIF	;LEAVE IT SET FOR BRAKER ROUTINE
	ERROR	BREAK	;BREAK IMMEDIATELY IF TYPE IN HUNG
	TLO	F,BREAKF	;OTHERWISE, JUST FLAG IT FOR LATER
	JRST	2,@JOBOPC >

FOR TENEX,<
BREAKY:	MOVEM	A,BRKTEM
	MOVEM	B,BRKTEB
	HRLZI	A,400000	;DENOTE THIS FORK
	MOVE	B,A		;DENOTE INTERRUPT CHANNEL 0
	DIC			;DEACTIVATE BREAK KEY
	MOVE	B,BRKTEB
	MOVEI	A,100
	CFIBF		;CLEAR THE INPUT BUFFER
	MOVEI	A,101
	CFOBF		;OUTPUT BUFFER TOO
	MOVE	A,BRKTEM
	TLNE	F,NOBREAK	;IGNORE BREAK?
	JRST	.+3		;YES
	TLNE	F,TIF
	ERROR	BREAK
	TLO	F,BREAKF
	DEBRK			;RETURN TO STOPPED PROCESS

CALDDT:	PUSHJ	P,770000	;FOR NOW, ASSUME RESIDENT DDT
	JRST	COMEX >
SUBTTL	COMPILE A LINE OF INPUT

COMPIL:	TRZ	F,STORED
	MOVEI	A,10
	MOVEM	A,CSTOCT
	PUSHJ	P,MAKELM
	TLO	B,COMPOUND
	MOVEM	B,CBOT
	MOVEM	B,CPP		;MAKE AN ELEMENT TO PUT COMPILED LINE IN
CMCOMP:	TRZ	F,FSYMF		;ENTER HERE FROM CMAKE
	POP	S,L
	MOVE	M,UA		;IF THE DEPTH OF ABBREVIATION EXPANSION
	SUB	M,UA+1		;IS GREATER THAN THE NUMBER OF ABBS
	LSH	M,-1		;THEN THERE IS A LOOP IN ABB DEFINITION
	HRLZI	M,-2(M)		;-MAX NO OF ABBREVIATIONS,,0
COMPAB:	HRLI	L,(POINT 7,(W),34)

	MOVEM	L,LINBOT
	IBP	L
GNS:	TRZ	F,NNUMF!ESCHF
	SETZB	N,SCOUNT	;CLEAR TYPE OF SYMBOL (N) AND CHAR COUNT
	PUSHJ	P,NEWSTR
GNS1:	JSP	E,LCH		;PICK UP PREV TERMINATR, MAY BE RELEVANT
	JRST	.+2
	ILDB	C,L		; NEXT CHAR FROM INPUT STRING
	CAIN	C," "
	JRST	.-2
	JRST	GNS2		; HAVE FIRST NON-SPACE CHAR OF SYMBOL

GNSLET:	CAIN	C,"_"		; IS IT ASSIGNMENT OPERATOR?
	JRST	GNSMAK		; YES
GNSABC:	TRO	F,NNUMF		; NON-NUMERIC CHAR SEEN
GNSB:	IDPB	C,B		;STORE CHAR IN SYMBOL
	AOS	SCOUNT		; UPDATE LENGTH OF SYMBOL
	ILDB	C,L		; NEXT CHAR OF INPUT
GNS2:	JUMPE	C,GNSEND	; POSSIBLE END OF INPUT STRING
	CAIL	C,77		; NOT, ? AND ABOVE ARE ALL PRINTING
	JRST	GNSLET		; CHARS AND LEGAL SYMBOL CONSTITUENTS
	CAIL	C,40		; BELOW 40 ARE ALL CONTROL CHARS
	JRST	GNSSCH		; NOT, THE REST TAKE SPECIAL CARE
	CAIN	C,24		; IS A CONTROL, IS IT CONTROL-T?
	JRST [	MOVEI D,GNSLIT	; YES, THEN IT IS THE QUOTE FOR FILES
		JRST GNSCH1 ]
GNODCH:	TRO	F,ESCHF		; THE REST THAT GOT THRU ARE SYMBOL
	JRST	GNSABC		; CONSTITUENTS BUT NOT FOR PROCEDURE NAM


GNSSCH:	MOVE	D,INFCTB-40(C)	; TABLE ENTRY FOR THE CHAR
	TLNN	D,TERM		; IS IT A TERMINATOR FOR PREVIOUS SYMBOL
	JRST	(D)		; NO, THEN DISPATCH ON ITS TYPE
GNSCH1:	SKIPE	SCOUNT		; IS THERE A PREVIOUS SYMBOL?
	JRST	GNSEND		; YES, THEN FIND OUT WHAT KIND IT IS
	TLNN	D,FOP		; IS IT AN INFIX OPERATOR?
	JRST	(D)		; NO, THEN IT HAS A SPECIAL HANDLER
	IBP	L		; YES, LETS NOT SEE THIS ONE AGAIN
	HRR	N,D		; YES, RH IS PTR INTO PRINTNAME TABLE
	HRLI	N,INFOP!IMMEDI	; LH OF COMPILED ELEMENT SAYS INFIX OP
	JRST	CMPLA		; AND WE STORE IT IN THE COMPILED CODE

GNSMAK:	IBP	L
	MOVE	N,[XWD INFOP!IMMEDI,IMAKEL+1]
	JRST	CMPLA

GNSEND:	SKIPN SCOUNT	;NEW SYMBOL EMPTY?
	JRST	CMPLA		; YES, AT END OF WHOLE INPUT STRING
	PUSHJ	P,ENDSTR	;GOT A SYMBOL, FINISH IT
	POP	S,A		;THIS IS IT
	TRNN	F,NNUMF	;MIGHT IT BE A NUMBER, IE A LITERAL
	JRST	GNSN	;IT IS A POSSIBLE LINE NUMBER


;CHECK ELEMENT TO SEEE IF IT IS AN ABBREVIATION

ABBA:
	HRRZ	B,UA	;USER DEFINED ABBREVIATIONS FIRST
	PUSHJ	P,LOOKY
	 JRST	NOABBS
	MOVE	C,1(N)
	JUMPE	C,GNSP3		;A DELETED SYSTEM ABBREV, MUST BE A UPROC
	AOJE	C,NOABBS	;A DELETED ABBREVIATION
	PUSH	S,LINBOT
	SUB	L,LINBOT
	PUSH	P,L	;SAVE RELATIVE POINTER INTO SOURCE STRING
	HRRZ	L,1(N)	;USE THE VALUE OF THE ABBREV AS THE NEW SOURCE
	AOBJN	M,COMPAB	;WE ARE NOW ONE LEVEL DEEPER IN ABBREVS
	ERROR	ABBER1		;LOOP IN ABBREVIATION DEFINITION


LCH:	LDB	C,L
	JUMPN	C,(E)
	TRNN	M,-1	;TOP LEVEL ABBREVIATION?
	JRST	(E)		; YES, DONE WITH WHOLE INPUT STRING
	POP	S,LINBOT	;NOT TOP LEVEL
	POP	P,L
	ADD	L,LINBOT
	SUB	M,[XWD 1,1]	;UP ONE LEVEL
	JRST	LCH

DEFINE XOP (RH,LH)
<XWD LH,RH>
TERM==1
FOP==2

INFCTB:
XOP GNSEND,TERM		;SPACE
XOP GNSABC		; !
XOP GNSLIT,TERM		; "
XOP GNODCH		; #  ,NOT LEGAL IN PNAME BECAUSE IT ECHOES AS SP
REPEAT 4,<XOP GNSABC>	; $%&'
XOP GNSLP,TERM		; (
XOP GNSRP,TERM		; )
XOP ITIMES+1,TERM+FOP	; *
XOP IPLUS+1,TERM+FOP	; +
XOP GNSABC		; ,
XOP IMINUS+1,TERM+FOP	; -
XOP GNSABC		; .
XOP IQUOT+1,TERM+FOP	; /
REPEAT 12,<GNSB>	; DIGITS 0-9
XOP GNSVAR,TERM		; :
XOP GNSCOM,TERM		; ;
XOP ILTHAN+1,TERM+FOP	; LEFT ANGLE BRACKET
XOP IEQUAL+1,TERM+FOP	; =
XOP IGRTR+1,TERM+FOP	; RIGHT ANGLE BRACKET

;TO RESTORE LOGO TO A PREFIX ONLY LANGUAGE, ALL "TERM+FOP"S 
; SHOULD BE CHANGED TO GNSABC, IE LEGAL SYMBOL CONSTITUENTS


GNSLP:	SKIPA	N,[LPREN]
GNSRP:	MOVEI	N,RPREN
	IBP	L
CMPLMP:	TLO	N,MPF!IMMEDIATE
	HRLZI	C,200000
	TDNE	C,1(N)	;IS THIS MACHINE PROCEURE "MAKE"?
	JRST	CMAKE	;YES
	ADDI	N,1	;NO, STORE MACHINE PROCEDURE CALL
CMPLA:	PUSHJ	P,CSTORE
	TRO	F,FSYMF	;NO LONGER FIRST ELEMENT
	JUMPN	N,GNS
CMPEND:	TRNE	F,MAKEF
	POPJ	P,
	AOS	A,CPP		;MAKE CPP POINT TO ONE BEYOND ELEMENT
	MOVE	B,CBOT
	SUBI	A,(B)		;GET LENGTH OF ELEMENT
	MOVEI	A,-1(A)		;STORED LENGTH IS ONE LESS THAN TOTAL LENGTH
	EXCH	A,@WSB		;SHORTEN THE ELEMENT
	SUB	A,@WSB		;SUBTRACT NEW LENGTH FROM OLD LENGTH
	SOSL	A		;FILL IN DUMMY ELEMENT FOR GARBAGE COLLECTOR
	MOVEM	A,@CPP
	MOVEM	B,CPP		;AND MAKE CPP POINT AT BEG OF LINE
	TRZE	F,STORED
	JRST	TOLINE
	JRST	CPOPJ1



GNSN:	HRLZI	N,LITF!WORDF
	HRR	N,NEWBOT
	TRNN	F,FSYMF!MAKEF	;IS IT FIRST ELEMENT AND NOT IN 2 LINE MAKE?
	TRO	F,STORED	;YES, NUMBER+FIRST_STORED LINE
	JRST	CMPLA

;NOT AN ABBREVIATION, CHECK FOR EXISTING PROCEDURE NAMES

NOABBS:	MOVE	A,NEWBOT
	PUSHJ	P,SYSLKP
	 JRST	GNSP3
	SKIPL	1(N)	;IS IT AN ABBREVIATION
	JRST	CMPLMP	;NO, A MACHINE PROCEDURE NAME
	PUSH	S,LINBOT
	SUB	L,LINBOT
	PUSH	P,L
	HRRZ	L,1(N)
	HRLI	L,350700
	SETZM	LINBOT
	AOBJN	M,GNS
	ERROR	IOPERR		;SYSTEM ABB MUST TERMINATE THE LOOP


GNSP3:	MOVE	A,NEWBOT
	HRRZ	B,RP
	PUSHJ	P,LOOKY
	 JRST	.+2
	JRST	GNSP1	;AND CALL THIS A USER PROCEDURE

	MOVEI	E,2(N)	;SPACE FOR THE NEW ENTRY IN TABLE
	CAML	E,RP+1	;IS IT THERE ALREADY?
	EXPAND	RP
	MOVE	A,NEWBOT
	MOVEM	A,(N)	;NAME OF NEW PROCEDURE
	SETOM	1(N)	;NOT YET TO'D
	SETZM	2(N)	;NEW END OF TABLE
GNSP1:	SUB	N,RP
	TLO	N,UPRF!IMMEDIATE
	TRZE	F,ESCHF
	TLO	N,SCHF
	AOJA	N,CMPLA

;COMMENTS, LITERALS, AND VARIABLE NAMES GET COPIED AND EXTRA SPACES FLUSHED

GNSLIT:	TLO N,LITF
	JRST WEFA
GNSCOM:	TLOA	N,COMMTF
GNSVAR:	TLO	N,VARF
WEFA:	MOVEI	D,(C)	;SAVE THE PROPER TERMINATOR
	PUSHJ	P,WEFS
	IBP	L
WEFAB:	TLNE	N,VARF		;STARTED BY : ?
	JRST	VAREND		; ENDING A VERIABLE IS SPECIAL
	POP	S,B
	IOR N,B
	JRST	CMPLA

WEFS:	TRZ	F,TF!NWF	;MAKE A WELL-FORMED STRING,
				; I.E. NO LEADING SPACES, NO TRAILING,
				; AND AT MOST ONE IN THE MIDDLE
	ILDB	C,L
	CAIN	C," "
	JRST	.-2
WEFC:	CAIN	C,(D)	;DONE YET?
	JRST	WEFB
	JUMPE	C,WEFD	;NO SECOND " / OR ;
	TRO	F,TF	;HAVE SEEN A REAL CHAR
	IDPB	C,B
	ILDB	C,L
	CAIE	C," "
	JRST	WEFC
	ILDB	C,L
	CAIN	C," "
	JRST	.-2	;SAD SPC
	CAIN	C,(D)
	JRST	WEFB
	JUMPE	C,WEFD
	MOVEI	C," "
	IDPB	C,B
	JSP	E,LCH	;GET FIRST CHAR OF NEXT WORD AGAIN
	TRO	F,NWF	;GOT MORE THAN ONE WORD
	JRST	WEFC

WEFD:	TLNN	N,COMMTF	;IF A COMMENT, EOL IS OK
	ERROR	INERR1	;BUT NOT LITS OR VARS
WEFB:	TRNE	F,TF	;IS THIS THING EMPTY?
	JRST	ENDSTR	;NO, FINISH THE STRING NORMALLY
	PUSH	S,[XWD WORDF!SENTF!EMPTYF,]	;EMPTY
	POPJ	P,

VAREND:	MOVE	A,(S)		; GOT A VARIABLE NAME
	TLNE	A,EMPTYF	; IS IT EMPTY?
	 ERROR	NMERR5		; YES, :: NOT PERMITTED
	MOVEI	B,MV
	PUSHJ	P,SYSLUK	; IS IT ONE OF THE BUILT IN NAMES?
	 JRST	VAREN2		; NO
	POP	S,A		; FLUSH THE GENERATED SYMBOL
	TLO	N,MVARF!IMMEDI	; CALL IT A MACHINE VARIABLE
	AOJA	N,CMPLA		; AND STORE ABS PTR TO VALUE WD IN MV

VAREN2:	MOVE	A,(S)
	MOVE	B,VP		; SEE IF IT EXISTS IN OBLIST
	PUSH	S,[XWD WORDF!SENTF!EMPTYF!UNBOUN!GLOBLF,0]
	PUSHJ	P,LOOKY
	 PUSHJ	P,MAKEN	; NOT ALREADY THERE, ADD IT, VALUE AS ABOVE
	POP	S,A
	POP	S,A
	SUB	N,VP		; COMPILED ELEM IS PTR REL TO VP
	TLO	N,VARF!IMMEDI	; AND IS FLAGGED AS A VARIABLE
	AOJA	N,CMPLA

CMAKE:	TRNE	F,MAKEF	;ALREADY IN A 2 LINE MAKE?
	AOJA	N,CMPLA	;YES
	JSP	E,LCH
	JUMPE	C,CMAKE2
	MOVE	A,L
	ILDB	C,L
	CAIN	C," "
	JRST	.-2	;SAD SPC
	CAIE	C,";"	;MAKE-COMMENT-CR
	AOJA	N,[MOVE L,A	;THIS IS ALSO A BUG, EVEN MORE OBSCURE!
		JRST CMPLA ]
	PUSHJ	P,NEWSTR
	PUSH	S,[XWD COMMTF,0]
	PUSHJ	P,BTFCP1
	ADD	N,[XWD MAKESC,1]
	PUSHJ	P,CSTORE
	POP	S,N
	JRST	CMAKE3
CMAKE2:	ADD	N,[XWD MAKESC,1]
CMAKE3:	TRO	F,MAKEF
	PUSHJ	P,CSTORE
	MOVEI	B,[ASCIZ /   NAME: /]
	PUSHJ	P,TIS		;ASK FOJ IT
	JRST	.-2
	PUSHJ	P,CMCOMP
	SOS	A,CPP
	AOS	CSTOCT
	MOVSI	B,MAKESC
	IORM	B,@WSA
	MOVEI	B,[ASCIZ /   THING: /]	;CONTINUE TO ASK
	PUSHJ	P,TIS
	JRST	.-2
	PUSHJ	P,CMCOMP
	TRZ	F,MAKEF
	JRST	CMPEND


CSTORE:	AOS	A,CPP
	MOVEM	N,@WSA
	SOSE	CSTOCT
	POPJ	P,
	MOVEI	A,10		;ADD THIS MUCH ROOM TO LINE ELEMENT
	MOVEM	A,CSTOCT
	MOVE	B,CBOT
	PUSHJ	P,COPYUP
	TLO	B,COMPOUND
	MOVEM	B,CBOT		;LOCATION OF NEW ELEMENT
	MOVEM	A,CPP		;NEW PTR TO OLD END
	POPJ	P,
SUBTTL	EXECUTE--SUPERVISOR

EXECUTE:TRZ	F,EELSEF	; 1_LEGAL TO END COMMAND LINE WITH ELSE
	TLZE F,BREAKF
	ERROR	BREAK
	PUSH	P,[EXP [EXP [ERROR NOCMD]]]
EXECU1:	AOS	A,CPP
	SKIPN	A,@WSA	;IS IT EOL?
	PUSHJ	P,SCOMEX	;YES, CALL THE EXIT
	TLNN	A,COMMTF	;IS IT A COMMENT?
	JRST	EXCTL1		;NO, GO TO IT
	JRST	EXECU1		;IGNORE COMMENT

EVAL:	PUSH	P,[EXP [EXP APOPJ]]
	SKIPA	A,CPP
EXCTLL:	AOS	A,CPP	;POINT TO NEXT ELEMENT
	MOVE	A,@WSA
EXCTL1:	TLZ	A,IMMEDIATE!COMPOUND	;IRRELEVANT BITS IN PTR
	JFFO	A,.+2
	ERROR	ERMSG1	;END OF LINE, SOMETHING MISSING
	JRST	@.-1(B)
	 EXCTMP
	 EXCTUP
	 EXCTV
	 EXCTL
	 EXCTIF	;INFIX OP IN PREFIX POSITION,MUST BE UNARY +-
	 EXCTMV	; MACHINE VARIABLE, ABS PTR TO VALUE WORD
	 EXCTLL	;COMMENT, TREATED JUST LIKE IT DOESN'T EXIST


EXCTP4:	POP	P,THISPR
	MOVE	B,(A)		;FETCH ADDRESS OF ROUTINE
	TLNN	B,STRINF	; DOES THE FUNCTION TAKE ONLY STRING ARG
	JRST EXCTP5		; NO
	HLRE	E,-1(A)		; HOW MANY DOES IT TAKE?
	JUMPL	E,EXCTP5	; NEEDS NO ARGS
	MOVE	G,S		; SO STACK PTR CAN BE CLOBBERED
EXCTP8:	MOVE	A,(G)
	TLNN	A,WORDF!SENTF!EMPTYF	; IS IT A STRING?
	JRST	[.]		; NO, CONVERT IT
	SUBI	G,1
	SOJGE	E,EXCTP8	; E STARTED WITH N-1
EXCTP5:	PUSHJ	P,(B)	;CALL PROCEDURE

OPEX:	AOS	A,CPP	;LETS LOOK AT THE NEXT ELEMENT
	MOVE	A,@WSA	;TO SEE IF IT IS AN INFIX OP
	TLNE	A,COMMTF
	JRST	OPEX	; IGNORING COMMENTS
	TLNE	A,INFOP	; IS IT INFIX
	JRST	INFNXT	; YES, CHECK PRECEDENCE TO SEE WHO GETS INPUT
	MOVE B,[XWD MPF!IMMEDI,ANDL+1] ;AND BETWEEN TWO PREFIX INPUTS IS OPTIONAL
OPEX1:	SOS	CPP	; NO, PRECEDING OPERATOR GETS FIRST CRACK
	HRLZI	A,-1
	ADDB	A,0(P)
	JRST	EXCTP2

EXCTMP:	HLL	A,-1(A)		;FETCH NUMBER OF ARGUMENTS
EXCTP1:	PUSH	P,A
	MOVE	B,[XWD MPF!IMMEDI,OFL+1]	;TEST FOR OPTIONAL OF
EXCTP2:	JUMPL	A,EXCTP4	;NEED NO ARGS
EXCTP3:	AOS	A,CPP
	MOVE	A,@WSA
	CAMN	B,A		;OF OR AND
	JRST	EXCTLL	;IS OF
	JRST	EXCTL1	;NOT OF

EXCTUP:	HLL	A,@RPA	;FETCH NO ARGS-1
	PUSH	P,A
	HRRI A,UPRODL+1	;ENTRY IN PRINTNAME TABLE FOR GENERIC PROCEDURE
	JRST	EXCTP1

EXCTMV:	SKIPGE	B,(A)		; FETCH VAL AND IS IT COMPUTATIONAL?
	JRST	EXCTP5		; YES, GO COMPUTE
	PUSH	S,B		; NO, HAVE A VALUE
	JRST	OPEX

EXCTV:	MOVE	A,@VPA		; FETCH THE VALUE
	TLZ	A,GLOBLF!UNBOUN	; UNBOUN SHOULD BE CHECKED, NOT FLUSHED
EXCTL:	PUSH	S,A
	JRST	OPEX

EXCTLP:	PUSHJ	P,GNE
	 ERROR	PRNER2
	MOVEI	B,[EXPARR]
	MOVEM	B,0(P)		;KEEPING A TRANSPARENT
	JRST	EXCTL1
EXCTRP:	POP	P,A
	POP	P,A
	CAIE	A,[EXP EXPARR]	; I.E. ONE INPUT,,EXPARR
	ERROR	PRNER1	;MATCHING (?
	PUSH	S,MV+1		; WAS (), AN EMPTY EXPRESSION
	JRST	OPEX

EXPARR:	PUSHJ	P,GNE
	 SKIPA
	CAME	A,[XWD MPF!IMMEDI,RPREN+1]
	ERROR	PRNER2	;MISSING )?
	POPJ	P,	;PRENS MATCH

SPECWD:	ERROR	EVER5
EXIT:	ERROR	XITERR	;USER DEFINED ERROR MESSAGE.
			;  USEFUL IN HOARDED PROCEDURES


EXCTIF:	MOVEI	A,(A)	;FLUSH BITS IN LH
	CAIN	A,IPLUS+1	; UNARY PLUS?
	JRST [	PUSH P,[INFUPL+1]
		JRST EXCTLL ]	;INFIX OP WITH HIGHER PRECEDENCE
	CAIE	A,IMINUS+1	; UNARY MINUS?
	 ERROR	INFERR	;A NONO
	PUSH	P,[INFUMN+1]	; INFIX OP WITH A HIGHER PRECEDENCE
	JRST	EXCTLL

INFNXT:	HLRZ	B,(A)		; GET PRECEDENCE OF NEW OPERATOR
	ANDI	B,17		; ONLY NEED 4 BITS
	MOVE	C,0(P)		; FETCH PREVIOUS OPERATOR
	HLRZ	C,(C)		; AND GET ITS PRECEDENCE
	ANDI	C,17

	CAIG	B,(C)		; NEW : OLD
	JRST	OPEX1		; NEW LE OLD, IE INPUT GOES WITH LH ONE
	HLL	A,-1(A)		; GOES WITH THIS ONE, GET # OF ARGS
	PUSH	P,A		; PUT OP ON STACK
	JRST	EXCTLL		; AND BACK FOR MORE

CALLDO:	JSP	D,COMEXR ;CHECK IF AT BEG OF LINE, IF NOT DON'T RETURN
	PUSHJ	P,COMPIL
	 POPJ	P,	;STORED THE LINE, NO NEED TO EXECUTE
	JRST	EXECUTE

SCOMEX:	SOS	CPP
COMEX:	JSP	D,COMEXR
	POPJ	P,

COMEXU:	TLOA	F,UPFF	;DENOTE CALLED BY USER COMMAND
COMEXR:	TLZ	F,UPFF	;DENOTE ROUTINE CALLED BY MACHINE COMMAND
	POP	P,A	;THE RETURN TO OPEX
	POP	P,A
	CAIE	A,[[ERROR NOCMD]]
	 ERROR	COMERR
	PUSHJ	P,GNE	;NEXT ELEMENT
	 JRST	COMXRD	;NO MORE
	TRZE	F,EELSEF
	CAME	A,[XWD MPF!IMMEDI,ELSEL+1]
	 ERROR	ERXTRA

COMXRD:	SETZM	CBOT	;DONE WITH THIS LINE
	JRST	(D)


;TABLE ADDRESS IN B
;SYMBOL POINTER IN A
;INDEX FOR ENTRIES IN TABLE B IN LH OF C IF NECESSARY



SYSLKP:	HRLZI	B,(POINT 7,(W),34)
	HRRI	B,(A)
	ILDB	C,B	;FIRST CHAR OF THIS ELEM
	CAIL	C,"A"
	CAILE	C,"Z"
	 POPJ	P,	;NOT IN RANGE FOR RESERVED NAME
	MOVE	B,MNPT-"A"(C)	;THE NAME TABLE FOR THAT LETTER
SYSLUK:	MOVEI	C,0
	JRST	LOOK0

LOOKY:	HRLZI	C,W
LOOK0:	MOVEI	E,2
	MOVEI	N,(B)	;USE N FOR STEPPING THRU TABLE

	ADDI	A,(W)	;MAKE A ABSOLUTE
	MOVN	B,(A)	;GET THE LENGTH OF THE WS ELEMENT
	HRLI	A,-1(B)	;PUT -L-1 OF WS ELEMENT IN LH OF A
	TLNN	C,W
	AOBJN	A,.+1

LOOKL:	MOVE	B,A	;USE B FOR CHANGING A
	HRR	C,(N)	;GET THE NAME OF THIS ENTRY IN THIS TABLE
	TRNN	C,-1	;0 AT END OF TABLE
	POPJ	P,

	MOVE	D,@C	;GET A WORD OF THIS ENTRY
	CAME	D,(B)	;IS IT THE SAME AS THIS WORD OF NEW ELEMENT
	JRST	LOOKN	;NO, NOT A MATCH FOR THIS SYMBOL
	ADDI	C,1	;POINT AT NEXT WORD OF THIS ENTRY
	AOBJN	B,.-4	;IF NOT DONE WITH THIS ELEMENT, GO BACK
	JRST	CPOPJ1	;DONE WITH THIS SYMBOL, COMPLETE MATCH

LOOKN:	ADD	N,E
	JRST	LOOKL	;NEXT ENTRY
SUBTTL	OPERATIONS

THING:	MOVE	A,(S)
THING1:	MOVE	B,VP
	PUSHJ	P,LOOKY
	 JRST	THING3	;NOT A GLOBAL VARIABLE
	JRST	THING4

THING3:	MOVE	A,(S)
	MOVEI	B,MV
	PUSHJ	P,SYSLUK
	 MOVEI	N,MV	;FIRST MACHINE VAR IS EMPTY
	MOVE	A,1(N)	;MACHINE VARIABLES MUST BE CHECKED
	JUMPGE	A,THING4
	POP	S,B	;THIS ONE MUST BE COMPUTED, (FLAG IS SIGN BIT)
	JRST	(A)
THING4:	MOVE	A,1(N)
	MOVEM	A,(S)
	POPJ	P,


CCONTE:	PUSHJ	P,NEWSTR
	TRZ	F,TF
	TRO	F,NWF		; :CONTENTS: ALWAYS A SENTENCE
	MOVEI	C,0
	MOVE	D,RP
	MOVNI	E,1
CCNTE1:	SKIPN	A,(D)		;ANY MORE PROCEDURE NAMES?
	JRST [	TRNE F,TF	;NO MORE PROCEDURES, WERE THERE ANY?
		JRST ENDST1	; YES
		PUSH S,MV+1	; NO, RETURN EMPTY
		POPJ P, ]
	MOVEI	D,1(D)
	CAMN	E,(D)		;IS THIS ONE DEFINED?
	AOJA	D,CCNTE1	;NO
	MOVEI	C," "
	TROE	F,TF		;FIRST ONE?
	DPB	C,B		;NO REPLACE EOM WITH SPACE
	PUSHJ	P,NEWSR0
	PUSHJ	P,COPYAB
	AOJA	D,CCNTE1

FIRST:
	PUSHJ	P,NEWOPS	;CHECK EMPTY,SET UP SRCBOT+NEWBOT
	JRST	FSTSNT	;NO, SENTENCE

	ILDB	C,A	;FIRST BYTE
	IDPB	C,B	;BOMBS HERE ON FULL WORKSPACE

	MOVEI	C,0	;FILL ZEROES AND RETURN NEW ARG
	JRST	BTFCLO

FSTSNT:	ILDB	C,A	;FIRST OF SENTENCE
	IDPB	C,B	;COPY CHARACTERS TO END OF FIRST WORD
	CAIE	C," "	;IS IT THE END OF A WORD
	JUMPN	C,FSTSNT	;JUMP IF NOT THE ONE WORD SENTENCE

	MOVEI	C,0	;CLEAR " " OR 177
	DPB	C,B	;CLOBBER OTHER TERMINATOR

	HRLZI	A,WORDF
	HLLM	A,0(S)
	JRST	BTFCL1


BUTFIRST:
	PUSHJ	P,NEWOPS
	JRST	BTFSNT	;NOT A WORD OR EMPTY, IE SENTENCE

	IBP	A		;BUTFIRST OF WORD, SKIP OVER FIRST CHAR
	ILDB	C,A		;THIS IS THE SECOND CHAR
	JUMPN	C,BTFCOP	;MORE THAN ONE CHAR, COPY TO END OF STRING

BTFEMP:	HRLZI	A,WORDF!SENTF!EMPTYF	;ONE OF THE MANY WAYS T
	MOVEM	A,(S)	;TO GET A POINTER TO EMPTY
	POPJ	P,

BTFSNT:	ILDB	C,A	;SKIP OVER FIRST WORD
	JUMPE	C,BTFEMP	;WAS ONLY WORD, RESULT IS EMPTY
	CAIE	C," "	;END OF WORD?
	JRST	BTFSNT	;CONTINUE SKIPPING OVER FIRST WORD

BTFCP1:	ILDB	C,A
BTFCOP:
BTFCLO:	IDPB	C,B
	JUMPN	C,.-2	;COPY THRU END OF ARG

BTFCL1:	PUSHJ	P,ENDST1
	POP	S,A
	HRRM	A,(S)	;NEW STRING, OLD TYPE
	POPJ	P,
;THE NEXT TWO PROCEDURES,  FSEG AND BUTFSEG  ACT SOMEWHAT LIKE
;FIRST AND BUTFIRST EXCEPT THAT THEY OUTPUT FROM A GIVEN STRING
;ALL OF THAT STRING ON EITHER SIDE OF A GIVEN BREAK WORD.  THEY HAVE
;2 INPUTS --- THE FIRST IS THE SENTENCE (OR WORD )  TO BE BROKEN UP
;AND THE SECOND INPUT IS THE WORD TO BE USED AS THE WORD TO BREAK ON
;
;   E.G.   BREAKD "SET"  "A TEST SET OF WORDS"
;
;          WILL OUTPUT THE SENTENCE  "A TEST"

FSEG:	MOVE	D,-1(S)		;GET PNTR TO WORD TO BREAK ON
	TLNE	D,EMPTYF	;EMPTY WORD?
	JRST	BTFEMP		;YES, OUTPUT THE EMPTY STRING
	HRLI	D,(POINT 7,(W),34) ;NO, FINISH MAKING THE PNTR AND
	MOVEM	D,SAV.D		;SAVE IT
	MOVE	A,0(S)		;GET PNTR TO SENTENCE TO BE BROKEN
	POP	S,-1(S)		;MAKE IT ALONE ON TOP OF STACK
	TLNE	A,EMPTYF	;EMPTY WORD?
	JRST	BTFEMP		;YES, OUTPUT EMPTY WORD
	HRLI	A,(POINT 7,(W),34) ;NO, FINISH POINTER
	MOVEM	A,SAV.A		;SAVE PNTR TO BEG OF SENTENCE
	MOVEM	A,SAVEIT		;SAVE PNTR TO END OF LAST NON-MATCH WORD
	PUSHJ	P,NEWSTR	;GET A NEW STRING FOR OUTPUT--ITS
				;PNTR IS IN B  AND NEWBOT

BRK2:	ILDB	C,A		;GET CHAR OF SENTENCE
	ILDB	E,D		;GET CHAR OF BREAK WORD
	JUMPE	C,BRKCP2	;IF OUT OF SENTENCE COPY ALL OF THE SENTENCE
				;(PROVIDED WE HAVEN'T JUST COMPLETED A MATCH)

	CAIE	C," "		;AT END OF A WORD IN THE SENTENCE?
	JRST	BRK1		;NO
	CAIE	E," "		;YES, ALSO AT END OF BREAK WORD?
	JUMPN	E,BRK3		;NO, NO MATCH POSSIBLE FOR THIS WORD

BRKCP1:	MOVE	A,SAV.A		;YES, FOUND A MATCH WORD--COPY ALL TO THIS POINT
	CAMN	A,SAVEIT	;IF = THEN THE BREAK WORD WAS THE
	JRST	BTFEMP		;FIRST WORD OF THE SENTENCE--OUTPUT EMPTY

	ILDB	C,A		;COPY TILL FINISHED
	CAMN	A,SAVEIT	;FINISHED?
	JRST	.+3		;YES
	IDPB	C,B		;NO
	JRST	.-4		;GET NEXT CHAR
	MOVEI	C,0		;WRAP IT UP
	JRST	BTFCLO

BRK1:	JUMPE	E,BRK3		;IF AT END OF BREAK WORD -- NO MATCH
	CAIN	E," "		;
	JRST	BRK3
	CAIN	E,(C)		;ARE THE CHARS EQUAL?
	JRST	BRK2		;YES, STILL HOPE FOR A MATCH

BRK3:	ILDB	C,A		;SKIP REST OF THIS WORD
	JUMPE	C,BRKCPY	;IF HIT END OF SENTENCE COPY IT ALL
	CAIE	C," "		;AT END OF WORD YET?
	JRST	BRK3		;NO, KEEP LOOKING
	MOVEM	A,SAVEIT	;YES, SAVE LAST NON-MATCH WORD PNTR
	MOVE	D,SAV.D		;RESTORE PNTR TO BREAK WORD
	JRST	BRK2		;TRY NEXT WORD FOR A MATCH

BRKCP2:	CAIE	E," "		;HAVE WE JUST COMPLETED A MATCH?
	SKIPN	E
	JRST	BRKCP1		;YES WE HAVE--OUTPUT UP TO HERE
BRKCPY:	MOVE	A,SAV.A		;COPY THE ENTIRE SENTENCE
	JRST	BTFCP1


BUTFSEG:
	MOVE	D,-1(S)		;GET BREAK WORD
	MOVE	A,0(S)		;GET PNTR TO SENTENCE TO BE SCANNED
	POP	S,-1(S)
	TLNE	A,EMPTYF	;EMPTY?
	JRST	BTFEMP		;YES -- OUTPUT IS EMPTY
	HRLI	A,(POINT 7,(W),34) ;NO, FINISH MAKING PNTR
	PUSHJ	P,NEWSTR	;GET A NEW STRING ALLOC'N FOR OUTPUT
				;PNTR TO AREA IS IN AC B
	TLNE	D,EMPTYF	;EMPTY BREAK WORD?
	JRST	BTFCP1		;YES --ALWAYS A MATCH SO OUTPUT ENTIRE SENT.
	HRLI	D,(POINT 7,(W),34) ;FINISH MAKING PNTR TO WORD
	MOVEM	D,SAV.D		;SAVE IT

BBRK2:	ILDB	C,A		;GET CHAR FROM SENTENCE
	ILDB	E,D		;AND CHAR FROM BREAK WORD
	JUMPE	C,BTFEMP	;IF AT END OF SENTENCE NOTHING LEFT
				;TO OUTPUT

	CAIE	C," "		;AT END OF A WORD OF THE SENTENCE?
	JRST	BBRK1		;NO, MAYBE AT END OF BREAK WORD
	CAIE	E," "		;YES, AT END OF BREAK WORD ALSO?
	JUMPN	E,BBRK3		;NO
	ILDB	C,A		;YES, THEN FOUND A MATCH FOR BREAK WORD
	CAIN	C," "		;COPY THE REST OF THE SENTENCE FOR OUTPUT
	JRST	.-2		;AFTER GETTING RID OF ANY BLANKS
	JUMPE	C,BTFEMP	;IF AT END OF SENTENCE OUTPUT EMPTY WORD
	JRST	BTFCLO		;GO OUTPUT REST OF SENTENCE

BBRK1:	JUMPE	E,BBRK3		;IF AT END OF BREAK WORD THERE CANNOT
	CAIN	E," "		;BE A MATCH AT THIS POINT
	JRST	BBRK3
	CAIN	E,(C)		;OTHERWISE A MATCH IS STILL POSSIBLE
	JRST	BBRK2		;IF CHARS ARE EQUAL

BBRK3:	ILDB	C,A		;SKIP TO NEXT WORD IN SENTENCE
	JUMPE	C,BTFEMP
	CAIE	C," "
	JRST	.-3
	MOVE	D,SAV.D
	JRST	BBRK2


LAST:
	PUSHJ	P,NEWOPS
	JRST	LSTSNT

	ILDB	C,A
	IDPB	C,B	;COPY FIRST CHAR, BUMPING THE CHAR PTR IN B ONCE

	ILDB	C,A
	JUMPE	C,BTFCLO	;DONE WITH THE WORD
	DPB	C,B	;PUT THIS CHAR ON TOP OF PREVIOUS ONE
	JRST	.-3

LSTSNT:	MOVE	E,A	;SAVE POINTER TO BEGINNING OF WORD
LSTSN2:	ILDB	C,A	;CONTINUE WITH THE CURRENT WORD
	CAIN	C," "
	JRST	LSTSNT	;END OF CURRENT WORD, NOT LAST ONE
	JUMPN	C,LSTSN2	;NULL_END OF SENT, ELSE NOT END OF ANY WORD

	MOVE	A,E
	JRST	FSTSNT

BUTLAST:
	PUSHJ	P,NEWOPS
	JRST	BTLSNT

	ILDB	C,A	;BUTLAST OF WORD, COPY WORD AND CLOBBER LAST CHAR
	IDPB	C,B
	ILDB	C,A
	JUMPE	C,BTFEMP	;WAS A ONE CHAR WORD, MAKE AN EMPTY
	IDPB	C,B
	ILDB	C,A
	JUMPN	C,.-2	;COPY REST OF WORD
BTLCLO:	DPB	C,B	;CLOBBER LAST CHAR
	JRST	BTFCL1	;FILL TO END OF WORD

BTLSNT:	MOVE	E,A	;SAVE POINTER TO BEGINNING
BTLSN1:	ILDB	C,A	;STEP THRU FIRST WORD
	JUMPE	C,BTFEMP	;ALSO LAST, MAKE AN EMPTY
	CAIE	C," "
	JRST	BTLSN1	;CONTINUE WITH FIRST WORD

BTLSN2:	MOVE	A,E
BTLSN9:	ILDB	C,A		;COPY STEPPED OVER WORD
	IDPB	C,B
	CAIE	C," "
	JRST	BTLSN9

	MOVE	E,A	;SAVE POINTER TO NEXT WORD
BTLSN4:	ILDB	C,A
	JUMPE	C,BTLCLO	;THIS IS END OF LAST WORD
	CAIN	C," "
	JRST	BTLSN2	;END OF WORD, NOT LAST ONE, COPY IT
	JRST	BTLSN4	;NOT END OF WORD, FIND IT

WORD:
	HRLZI	A,WORDF
	TDNE	A,0(S)
	TDNN	A,-1(S)
	ERROR	WRDERR	;YOU CAN'T MAKE A WORD OUT OF A SENTENCE

	HRLZI	C,EMPTYF
	TDNN	C,-1(S)	;IS FIRST ARG EMPTY?
	JRST	WORD0	;NO
	POP	S,-1(S)	;YES, THEN SECOND ARG IS THE RESULT
	POPJ	P,

WORD0:	TDNE	C,(S)
	JRST	SPOPJ
	PUSHJ	P,NEWSTR	;SET UP B AND NEWBOT
	PUSHJ	P,NEWSR1	;SET UP A TO -1(S) AND SRCBOT

	ILDB	C,A
	JUMPE	C,WORD2	;DON'T COPY EOM FROM FIRST ARG
	IDPB	C,B
	JRST	.-3	;COPY WHOLE FIRST ARG

WORD2:	PUSHJ	P,NEWSRC	;SET UP A TO 0(S) AND SRCBOT
	ILDB	C,A
	IDPB	C,B	;COPY SECOND ARG, INCLUDING EOM
	JUMPN	C,.-2
	POP	S,A	;FLUSH SECOND ARG
	JRST	BTFCL1	;FILL ZEROES AND RETURN ONE ARG

SENTENCE:
	HRLZI	E,EMPTYF
	TDNE	E,0(S)
	TDNN	E,-1(S)
	JRST	SENT1

SPOPJ:	POP	S,A	;BOTH EMPTY
	POPJ	P,	;RETURN EMPTY

SENT1:	PUSHJ	P,NEWSTR
	PUSHJ	P,NEWSR1

SENT2:	ILDB	C,A
	JUMPE	C,SENT3
	IDPB	C,B
	JRST	SENT2

SENT3:	MOVEI	C," "
	PUSHJ	P,NEWSRC
	TDNN	E,-1(S)		;IF FIRST ARG IS EMPTY, DON'T SPACE
	TDNE	E,0(S)		;OR IF SECOND IS
	SKIPA			;IN EITHER CASE, DON'T SPACE

SENT4:	IDPB	C,B
	ILDB	C,A
	JUMPN	C,SENT4

	POP	S,A	;FLUSH SECOND ARG
	HRLZI	A,SENTF		;CALL NEW THING A SENTENCE
	HLLM	A,0(S)
	JRST	BTFCLO

SENTCS:	SKIPA	A,[SENTCL+1]
WORDS:	MOVEI	A,WORDL+1
	PUSH	P,A		; ROUTINE TO CALL GOES ON STACK
	PUSH	S,MV+1
WORDS1:	PUSHJ	P,GNE		; NEXT INPUT TO SS OR WS
	 JRST	WORDS2		; END OF LINE
	CAME	A,[XWD MPF!IMMEDI,ELSEL+1]	; IN THEN, ELSE TERMINA
	CAMN	A,[XWD MPF!IMMEDI,RPREN+1]
	 JRST	WORDS2		; OR ) TERMINATE INPUTS TO SS
	PUSHJ	P,EVAL		; NEXT INPUT
	MOVE	A,(P)
	MOVEM	A,THISPR
	MOVE	A,(A)
	PUSHJ	P,(A)		; CALL WORD OR S, PR NAME SET UP FOR ERR
	JRST	WORDS1		; GO BACK FOR MORE

WORDS2:	SOS	CPP		; DON'T WANT TO EAT UP THE TERMINATOR
	JRST	APOPJ		; GET RID OF ROUTINE NAME AND EXIT


COUNT:	MOVE	A,(S)	;THING TO COUNT
	MOVEI	B,0	;COUNT INITIALLY ZERO
	TLNE	A,EMPTYF	;IS IT EMPTY?
	JRST	COUNT2	;COUNT=0
	TLNN	A,WORDF	;IS IT A WORD?
	AOJA	B,COUNT1	;NO, IT IS A NON-EMPTY SENTENCE

	PUSHJ	P,COUNTW
	JRST	COUNT2

COUNT1:	HRLI	A,(POINT 7,(W),34)
COUNTL:	ILDB	C,A
	JUMPE	C,COUNT2
	CAIN	C," "
	AOJA	B,COUNTL	;COUNT WORDS OF SENT AT BEG OF WORD
	JRST	COUNTL		;MORE OF THE SAME WORD

COUNT2:
	MOVE	M,B	;ARG TO SNM IN M
	PUSHJ	P,SNM
	MOVSI	C,WORDF
	HLLM	C,(S)
	JRST	BTFCL1

COUNTW:	HRLI	A,440700+W
	MOVNI	B,1
	ADD	B,@A	;NOW NUMBER OF WORDS -1
	IMULI	B,5	;NUMBER OF CHARS IN ALL BUT LAST WORD
	ADD	A,@A	;NOW A POINTS AT LAST WORD
	ILDB	C,A	;WORD
	JUMPE	C,CPOPJ
	AOJA	B,.-2


RANDOM:	MOVE	C,[EXP 1000003]
	IMULB	C,RANNO
	TLZ	C,400000	;MAKE IT POSITIVE
	MULI	C,12
	ADDI	C,"0"
	PUSHJ	P,NEWSTR
	IDPB	C,B
	JRST	ENDSTR


EITHER:	PUSHJ	P,GNE	;GOT 1 INPUT SO FAR, NOW DO NOISE WORD CHECK
	 ERROR	ERMSSG
	CAME	A,[XWD MPF!IMMEDI,ANDL+1]
	CAMN	A,[XWD MPF!IMMEDI,ORL+1]
	AOS	CPP	;SKIP THE NOISE WORD
	PUSHJ	P,EVAL	;AND GET THE SECOND INPUT
	TROA	F,TF
BOTH:	TRZ	F,TF
	MOVE	A,(S)
	PUSHJ	P,PREDIQ
	 ERROR	PREDR2
	MOVE	A,-1(S)
	PUSHJ	P,PREDIQ
	 ERROR	PREDR2
	POP	S,B	;SECOND ARG
	MOVEI	A,1	;LENGTH OF "TRUE"
	TRZN	F,TF	;SKIP IF DOING EITHER
	MOVEI	A,2	;LENGTH OF "FALSE"
	CAMN	A,@WSB	;COMPARE AGAINST LENGTH OF SECOND ARG
	MOVEM	B,(S)	;JAM IF EITHER AND TRUE OR BOTH AND FALSE
	POPJ	P,

;THE FOLLOWING IS A PREDICATE USED TO TEST AND DETERMINE IF A WORD
;IS A MEMBER OF A LIST OF WORDS OR NOT

MEMBRP:	POP	S,B		;GET PNTR TO LIST OF WORDS
	POP	S,A	;GET PNTR TO WORD WERE LOOKING FOR
	TLNE	A,EMPTYF	;IS IT THE EMPTY WORD?
	JRST	ISTRUE		;YES, ALWAYS TRUE
	TLNE	B,EMPTYF	;IS IT EMPTY?
	JRST	ISFALSE		;YES, ALWAYS FALSE
	HRLI	A,(POINT 7,(W),34) ;CHAR PNTR TO WORD
	MOVEM	A,SAV.A		;SAVE IT
	HRLI	B,(POINT 7,(W),34) ;CHAR PNTR TO LIST
WRDOF1: MOVE	A,SAV.A		;REFRESH PNTR TO WORD
WRDOF2: ILDB	C,A		;GET A CHAR FROM BOTH STRINGS
	ILDB	D,B
	CAIE	C," "		;AT END OF WORD WE'RE LOOKING FOR?
	JUMPN	C,WRDOF3	;
	CAIE	D," "		;YES, ALSO AT END OF A WORD IN LIST?
	JUMPN	D,NXTWRD
	JRST	ISTRUE		;YES, WE'VE GOT A MATCH!!
WRDOF3: CAIN	D," "		;AT END OF WORD IN LIST (AND MORE LEFT)?
	JRST	WRDOF1		;YES, CAN'T BE A MATCH--TRY NEXT WORD OF LIST
	JUMPE	D,ISFALSE	;IF OFF END OF LIST NO MATCH
	CAMN	C,D		;CHARACTERS EQUAL?
	JRST	WRDOF2		;YES, STILL HOPE FOR A MATCH
NXTWRD: ILDB	D,B		;NO, TRY NEXT WORD IN LIST
	JUMPE	D,ISFALSE	;THERE IS NO NEXT WORD IN LIST
	CAIN	D," "	;FIND END OF WORD?
	JRST	WRDOF1		;YES, SO TRY NEXT WORD IN LIST
	JRST	NXTWRD		;KEEP LOOKING FOR END OF WORD

EMPTYP:	HRLZI	A,EMPTYF
PREDS1:	POP	S,B
	TDNN	A,B
	JRST	ISFALSE
	JRST	ISTRUE
SENTP:	HRLZI	A,SENTF
	JRST	PREDS1
WORDP:	HRLZI	A,WORDF
	JRST	PREDS1

ISPROC:	MOVE 	M,UA	;GET COUNT OF NO. OF ABBREVIATIONS IN
	SUB	M,UA+1	;CASE DEPTH OF ABBR. EXPANSION GETS > THAN
	LSH	M,-1	;NO. OF ABBREVIATIONS -- THIS IMPLIES AN
	HRLZI	M,-2(M)	;LOOP IN ABBR. DEFINITIONS IS DETECTED
	POP	S,A	;GET POINTER TO INPUT STRING
ISPR1:	MOVEM	A,SAV.A
	HRRZ	B,UA		;CHECK FOR A USER DEFINED ABBR.
	PUSHJ	P,LOOKY		;FIRST
	JRST	NOTUAB		;NOT A USER ABBR.
	MOVE	C,1(N)		;GET 2ND DESCRIPTOR WRD FOR ABBR
	JUMPE	C,TRYUPR	;A DELETED SYSTEM ABBR, MUST BE A USER PROC
	AOJE	C,NOTUAB	;A DELETED ABBR
	HRRZ	A,1(N)	;GET POINTER TO STRING THAT THIS IS ABBR FOR
	AOBJN	M,ISPR1		;AND TRY AGAIN--TILL GET A NON-ABBR
	ERROR	ABBER1		;LOOP IN ABBR. DEFINITION

NOTUAB:	MOVE	A,SAV.A	;RESTORE PNTR TO STRING
	PUSHJ	P,SYSLKP	;AN EXISTING BUILT-IN PROC OR ABBR?
	JRST	TRYUPR		;NO, TRY USER PROCEDURE
	HRRZ	C,1(N)		;GET 2ND WORD OF DESCRIPTOR
	CAIE	C,SPECWD	;A SPECIAL WORD?
	JRST	ISTRUE		;NO, A PROC OR BUILT-IN ABBR
	JRST	ISFALSE		;YES, SO NOT A PROCEDURE

TRYUPR:	MOVE	A,SAV.A 	;RESTORE POINTER TO STRING
	HRRZ	B,RP		;
	PUSHJ	P,LOOKY		;A USER PROCEDURE?
	JRST 	ISFALSE		;NO
	MOVE	C,1(N)		;MAYBE---GET 2ND WORD OF DESCRIPTOR
	AOJE	C,ISFALSE	;IF -1 THEN NOT YET TO'D OR ERASED
	JRST	ISTRUE		;YES, GIVE TRUE RETURN

IS:	POP	S,A
	POP	S,B
IS1:	MOVE	C,@WSA
	CAME	C,@WSB
	JRST	ISFALSE
	ADDI	A,1
	TRNE	C,377
	AOJA	B,IS1

ISTRUE:	PUSH	S,[XWD WORDF,TRUEV]	;POINTER TO "TRUE"
	POPJ	P,
ISFALSE:PUSH	S,[XWD WORDF,FALSEV]	;WS PTR TO "FALSE"
	POPJ	P,

NUMBRP:	POP	S,A
	PUSHJ	P,NUMBRQ
	JRST	ISFALSE
	JRST	ISTRUE

NOT:	MOVE	A,(S)	;GET BOOL, LEAVING IT ON STACK FOR ERROR
	PUSHJ P,PREDIQ	;MAKE SURE IT IS A BOOL
	 ERROR PREDR1
	POP	S,B	;FLUSH IT NOW
	SKIPE	@WSA	;A IS THE REL PTR TO THE WORD CONTAINING THE EOM
	 JRST	ISFALSE	; THE SECOND WORD OF THE STRING
	 JRST	ISTRUE

FINDN:	TRZ	F,PMF
	HRLI	A,(POINT 7,(W),34)
FINDNA:	ILDB	C,A
	CAIN	C,"0"
	SOJA	B,FINDNA
	CAIN	C,"+"
	SOJA	B,FINDNA
	CAIE	C,"-"
	POPJ	P,
	TRO	F,PMF		;NUMBER IS NEG
	SOJA	B,FINDNA
;
;
;
; SPECIAL ASCII FUNCTION
;		BY HAL LAMSTER WITH INSTRUCTION FROM ALAN BELL
;
ASCIIX:		POP	S,L
	PUSHJ	P,NUMARG
	OUTCHR	D
	JRST	COMEX
;
NUMARG:	TLNE	L,EMPTYF
	JRST	CPOPJ
	HRLI	L,010700+W
	TRO	F,PMF
	PUSHJ	P,DNM
	ERROR	ZERERR
	ERROR	ZERERR
	MOVE	D,M
	POPJ	P,
;
;
;
;
;

;THIS GRATRP DOES NOT GENERATE ANY NEW STRINGS, DOES NOT PERFORM AN
;ADDITION, AND SHOULD END QUICKLY ON NUMBERS WHICH HAVE
;DIFFERENT ORDERS OF MAGNITUDE OR ARE OF DIFFERENT SIGN

LESSP:	PUSHJ	P,NUMRQS	;TEST INPUTS BEFORE REVERSING THEM
	PUSHJ	P,SWITCH	; EXCH 0(S) AND -1(S)
	JRST	.+2
GRATRP:	PUSHJ	P,NUMRQS	;ARE THE INPUTS NUMBERS?
	MOVE	A,(S)
	PUSHJ	P,COUNTW
	POP	S,A
	PUSHJ	P,FINDN		;SUBTRACT OFF SIGNS AND LEADING ZEROES
	MOVE	E,A		;PTR TO FIRST SIGNIFICANT DIGIT
	MOVEI	D,(B)		;COUNT OF SIGNIFICANT DIGITS
	MOVE	H,F		;STATE OF PMF

	MOVE	A,(S)
	PUSHJ	P,COUNTW
	POP	S,A
	PUSHJ	P,FINDN
	XOR	H,F
	TRNE	H,PMF		;SIGNS THE SAME?
	JRST	GRATRA		;NO, CAN QUIT NOW

	SUB	B,D		;SAME NUMBER OF SIGNIF DIGITS?
	JUMPN	B,GRATRD	;NO, QUIT NOW
	LDB	B,A		; 
	LDB	C,E
GRATRC:	JUMPE	B,GRATRB	;END OF ONE NUMBER
	SUB	B,C
	JUMPN	B,GRATRD	;SIGN IS MEANINGFUL
	ILDB	B,A
	ILDB	C,E
	JRST	GRATRC

GRATRD:	CAIGE	B,0
	TRC	F,PMF
GRATRF:	TRZE	F,PMF
	JRST	ISFALSE
	JRST	ISTRUE	;
GRATRA:	LDB	C,A
	JUMPN	C,GRATRF
	LDB	C,E
GRATRB:	JUMPE	C,ISFALSE
	JRST	GRATRF

EQUALP:	PUSHJ	P,DIFF	;EQUALP IS ZEROP OF DIFF OF
ZEROP:	MOVE	A,(S)
	PUSHJ	P,NUMBRQ
	 ERROR	ZERERR
	POP	S,A
	HRLI	A,(POINT 7,(W),34)
	ILDB	C,A		;GET THE FIRST CHAR
	CAIE	C,"+"	;IF A SIGN, GET ANOTHER CHAR
	CAIN	C,"-"
ZEROP1:	ILDB	C,A
	JUMPE	C,ISTRUE	;NUMBRQ WOULD FAIL ON SIGN ONLY OR EMPTY
	CAIN	C,"0"
	JRST	ZEROP1
	JRST	ISFALSE


MINIM:	SKIPA	A,[LESSP]
MAXIM:	MOVEI	A,GRATRP
	PUSH	P,A		; WHICH WAY THE TEST GOES
	PUSH	S,-1(S)
	PUSH	S,-1(S)		; EXTRA COPY FOR THE ONES THAT PRED EATS
	PUSHJ	P,@0(P)		; CALL THE APPROPRIATE PREDICATE
	POP	P,A		; FLUSH THE PARAM
	POP	S,B		; THE OUTPUT FROM PRED
	MOVEI	A,1		; LENGTH OF "TRUE"
	POP	S,C		; SECOND INPUT TO MAX OR MIN
	CAME	A,@WSB		; MAX AND FIRST .GTR. SECOND?
	MOVEM	C,0(S)		; NO, THEN SECOND IS THE ANSWER
	POPJ	P,

COMPLM:	MOVE	A,(S)
	PUSHJ	P,NUMBRQ
	 ERROR	ZERERR
	POP	S,A
	PUSHJ	P,NEWSR0
	PUSHJ	P,NEWSTR
	MOVEI	D,"-"
	ILDB	C,A
	CAIE	C,"-"		;IS THE OLD STRING NEG?
	IDPB	D,B		;NO, MAKE NEW ONE NEG
	CAIE	C,"+"		;SKIP EXPLICIT +
	CAIN	C,"-"		; OR -
	SKIPA
	IDPB	C,B		;OTHERWISE STORE FIRST CHAR OF NUM
	PUSHJ	P,COPYAB	;COPY REST OF STRING
	PJRST	ENDST1		;AND FINISH IT OFF

UNPLUS:	MOVE	A,(S)
	PUSHJ	P,NUMBRQ
	 ERROR	ZERERR
	POPJ	P,

DIFF:	TROA	F,PMF
SUM:	TRZ	F,PMF
	PUSHJ	P,NUMRQS
	PUSHJ	P,REVERS
	CAIE	D,"-"
	TRON	F,PMF	;SKIP IF SECOND ARG + AND IS SUBTRACTION
	TRON	F,PMF	;SKIP IF ARG2 - & DIFF OR ARG2 + & SUM
	PUSHJ	P,TENCOM	;CALLED WITH PMF=1_FILL 9'S

	PUSHJ	P,SWITCH

	PUSHJ	P,REVERS
	CAIN	D,"-"
	PUSHJ	P,TENCOM

	PUSHJ	P,SUMMER
	TRZ	F,PMF
	CAIE	G,"8"	;WHEN 9+9 AND NO CARRY INTO
	CAIN	G,"9"	;RESULT NEG IFF HIGH ORDER DIG =9
	PUSHJ	P,TENCOM	;CALLED WITH PMF=0_PUT A "-" AT THE END

	POP	S,A	;FLUSH EXTRA LEADING ZEROES
SUM7:	HRLI	A,350700+W	;SKIPPING OVER FIRST CHAR
	AOJA	A,.+2
SUM8:	CAIE	C,"0"	;CONSECUTIVE 0?
	MOVE	B,A	;NO, SAVE POINTER TO HIGHEST SIGNIFICANT DIG SO FAR
	ILDB	C,A
	JUMPE	C,.+4	;END OF STRING
	CAIE	C,"-"	;MINUS SIGN LIKE A TERMINATOR FOR NEG STRING
	JRST	SUM8
	IDPB	C,B	;PUT TERMINATOR (IN C) ABOVE MOST SIGNIFICANT DIGIT
	PUSHJ	P,ENDSTR

;FALL INTO REVERB - REVERSE BACK - AND EXIT FROM SUM FROM REVERB


REVERB:	TROA	F,TF	;REVERSING BACK, NO MODIFICATION TO STRING
REVERS:	TRZ	F,TF	;FIRST REVERSE OF NUMBER, FIDDLE WITH SIGNS
	PUSHJ	P,NEWSTR
REVERA:	PUSHJ	P,NEWSRC
	MOVE	D,@A
	ADDI	A,(D)	;A POINTS AT LAST WORD
	MOVEI	G,0
REVERY:	MOVE	C,@A
	JUMPE	C,REVERZ
	ROT	C,6
	ROT	C,-7
	TRNN	C,177
	AOJA	G,.-2
	ROT	G,1	;TIMES TWO
	JRST	.+4(G)
REVERL:	SUBI	A,1
	MOVE	C,@A
	ROT	C,-1	;FLUSH BIT 35
	IDPB	C,B
	ROT	C,-7
	IDPB	C,B	;D
	ROT	C,-7
	IDPB	C,B	;C
	ROT	C,-7
	IDPB	C,B	;B
	ROT	C,-7
	IDPB	C,B	;A
REVERE:	SOJG	D,REVERL	;MORE WORDS TO REVERSE
	TRNE	F,TF
	JRST	REVERO
	MOVEI	D,177
	ANDI	D,(C)	;SAVE STATE OF SIGN IN D
	MOVEI	C,"0"
	CAIE	D,"+"
	CAIN	D,"-"
	SKIPA			;SIGNED, OVERWRITE THE SIGN
	IBP	B		;UNSIGNED, ADD A LEADING 0 DIGIT
	DPB	C,B	;REPLACE THE SIGN WITH A "0"

REVERO:	MOVEI	C,0
	JRST	BTFCLO

REVERZ:	SUBI	A,1
	SOJG	D,REVERY
	ERROR	IOPERR	;INPUT WAS NOT A NUMBER


TENCOM:
	PUSHJ	P,NEWSRC
	TRO	F,TF	;SET CARRY INTO LOW ORDER DIGIT
	ILDB	C,A
	JUMPE	C,[ERROR]
NINECM:	MOVNS	C
	ADDI	C,"9"+"0"
	TRZE	F,TF	;WAS THERE A CARRY INTO THIS POSITION?
	ADDI	C,1	;YES
	CAIG	C,"9"	;IS THERE A CARRY OUT OF THIS POS?
	JRST	.+3	;NO
	SUBI	C,12
	TRO	F,TF
	DPB	C,A
	ILDB	C,A
	JUMPN	C,NINECM

	TRNE	F,PMF		;NEGATIVE RESULT?
	POPJ	P,		;NO
	MOVEI	D,"-"
	DPB	D,A
	MOVE	B,A
	PJRST	ENDSTP		;LENGTH OF THE STRING MAY HAVE CHANGED

SUMMER:	MOVE	L,-1(S)
	TRZ	F,TF!PMF
	HRLI	L,(POINT 7,(W),34)
	MOVEM	L,LINBOT
	PUSHJ	P,NEWSRC
	PUSHJ	P,NEWSTR

SUMMRL:	ILDB	C,A
	JUMPE	C,SUMMR2
	SUBI	C,"0"
	ILDB	E,L
	JUMPE	E,SUMMR3
	ADDI	C,(E)
	TRZE	F,TF	;CARRY?
	ADDI	C,1	;YES
	CAIG	C,"9"	;CARRY OUT OF THIS POSITION?
	JRST	.+3	;NO
	SUBI	C,12
	TRO	F,TF
	IDPB	C,B
	MOVEI	G,(C)
	JRST	SUMMRL

SUMMR2:	MOVE	C,SRCBOT
	EXCH	C,LINBOT
	MOVEM	C,SRCBOT
	EXCH	A,L
	IBP	A
SUMMR3:	UNDEX	L
	LDB	C,L	;GET PREVIOUS CHAR, (WAS 0 OR 9)
	CAIN	C,"9"
	TRO	F,PMF	;NO, IT WAS TEN'S COMPLEMENT
	LDB	C,A
	JUMPE	C,SUMMR5

SUMMR4:	TRZE	F,TF
	ADDI	C,1
	TRNE	F,PMF	;WAS IT NEGATIVE?
	ADDI	C,11	;YES, LEADING NINES
	CAIG	C,"9"
	JRST	.+3
	SUBI	C,12
	TRO	F,TF
	IDPB	C,B
	MOVEI	G,(C)
	ILDB	C,A
	JUMPN	C,SUMMR4

SUMMR5:	POP	S,A
	SETZM	LINBOT
	JRST	BTFCLO

PRODUCT:
	PUSHJ	P,NUMRQS
	MOVE	A,(S)		;LENGTH OF ONE INPUT
	MOVE	A,@WSA
	MOVE	B,-1(S)
	CAMLE	A,@WSB		;.GTR. THAN OTHER INPUT?
	PUSHJ	P,SWITCH	; NOW FIRST ARG (-1(S)), .GE. SECOND
	PUSHJ	P,REVERS	;REVERSE SHORTER STRING
	CAIE	D,"-"		;SIGN OF IT
	TRZA	F,PMF		;IS +
	TRO	F,PMF		;IS -
	PUSHJ	P,PRDCVI	; CONVERT STRING TO NUMBER BASE 100000
	PUSHJ	P,SWITCH
	PUSHJ	P,REVERS	;REVERSE THE LONGER INPUT
	CAIN	D,"-"		;SIGN OF OTHER
	TRC	F,PMF		;IF - COMPLEMENT SIGN OF RESULT
	PUSHJ	P,PRDCVI	; CONVERT THIS ONE TOO
	MOVE	B,-1(S)		;THE SHORTER ONE
	MOVE	A,(S)		; LONGER ONE BECOMES MULTIPLICAND

	MOVE	A,@WSA		; LENGTH OF MULTIPLICAND
	ADD	A,@WSB		; + LENGTH OF MULTIPLIER 
	PUSHJ	P,MAKELM	; IS THE MAXIMUM LENGTH OF RESULT
	MOVE	G,A
	MOVEI	B,@WSB		; ADDR OF  RESULT
	MOVE	A,-1(S)
	MOVEI	L,@WSA		; ADDR OF MULTIPLIER
	MOVN	C,(L)		; -LENGTH OF MULTIPLIER
	HRLI	L,(C)
	MOVEI	B,1(B)		; POINT AT LOW ORDER DIGIT
	ADDI	L,1		; POINT AT NEXT GIGIT

MULTND:	SKIPN	E,(L)		; IS THE CURRENT GIGIT 0?
	JRST	MULR
	SETZ	D,		; INITIALLY, NO CARRY
	MOVE	A,(S)
	MOVEI	A,@WSA
	MOVN	C,(A)
	HRLI	A,(C)
	ADDI	A,1
	HRRZI	B,(L)
	ADD	B,NEWBOT
	SUB	B,-1(S)
MULTL:	MOVE	C,E
	IMUL	C,(A)
	ADD	C,D		; OVERFLOW FROM PREVIOUS GIGIT
MULTC:	ADD	C,(B)		; PREVIOUS PARTIAL RESULT
	IDIVI	C,^D100000	; MODULO 100000.
	MOVEM	D,(B)		; IS NEW PARTIAL RESULT FOR THIS PLACE
	MOVE	D,C		; CARRY TO NEXT PLACE
	ADDI	B,1		; NEXT PLACE IN RESULT
	AOBJN	A,MULTL		; NEXT GIGIT  IN MULTIPLICAND
	JUMPN	D,MULTC		; PROPAGATE CARRY
MULR:	AOBJN	L,MULTND	; NEXT GIGIT OF MULTIPLIER

; CONVERT THE RESULT FROM GIGITS TO DIGITS, REVERSE IT AND OUTPUT

	SETZ	B,
	MOVE	A,NEWBOT	; 010700+W,,HEADER WORD
PRDCVB:	ADD	A,[XWD 430000,1]	; MAKE IT   POINT 7,HEADER+1,0
	MOVE	C,@A
	MOVNI	E,5
	SETZM	@A
PRDCVC:	IDIVI	C,^D10
	ADDI	D,"0"
	IDPB	D,A
	CAIE	D,"0"
	MOVE	B,A		; MOST SIGNIFICANT NON-ZERO DIGIT
	AOJL	E,PRDCVC
	SOJG	G,PRDCVB

	JUMPN	B,NOTZR
	MOVE	B,NEWBOT
	IBP	B		; SKIP OVER ONE "0"
	JRST	PDZERO
NOTZR:	MOVEI	C,"-"	; INSERT "-" IF RESULT IS NEGATIVE
	TRZE	F,PMF
	IDPB	C,B		; JUST ABOVE MOST SIGNIF DIG
PDZERO:	POP	S,A
	MOVEI	A,@WSB
	MOVEI	C,@WTOP
	HRLI	A,1(A)
	ADDI	A,2
	CAIL	C,-2(A)
	JRST [	SETZM -1(A)
		CAIL C,(A)
		BLT A,(C)
		JRST .+1 ]
	PUSHJ	P,ENDSTP
	JRST	REVERB

PRDCVI:	MOVE	A,(S)		; CONVERT TO BASE 100000. (5 DIGITS PER GIGIT)
	HRLI	A,10700+W
PRDCVJ:	MOVNI	E,5
	SETZ	N,
PRDCVK:	ILDB	C,A
	JUMPE	C,PRDCVR
	SUBI	C,"0"
	IMUL	C,PRDCVT+5(E)
	ADDI	N,(C)
	AOJL	E,PRDCVK
	MOVEM	N,@A
	JRST	PRDCVJ
PRDCVR:	MOVEM	N,@A
	POPJ	P,

PRDCVT:	^D1
	^D10
	^D100
	^D1000
	^D10000

QUOTIENT:
	PUSHJ	P,QUOT
	POP	S,-1(S)		;FLUSH REMAINDER
	POPJ	P,

REMAINDER:
	PUSHJ	P,DIVREM		;GET QUOTIENT, REMAINDER
	POP	S,-1(S)		;AND FLUSH THE QUOTIENT
	POPJ	P,

DIVISION:
	PUSHJ	P,DIVREM	;GET QUOTIENT, REMAINDER
	PJRST	SENTENCE	;AND MAKE A SENTENCE OUT OF THEM

DIVREM:	PUSHJ	P,QUOT
	PUSHJ	P,SWITCH

	HRLZI	L,(POINT 7,(W),34)
	HRRI	L,(A)		;SWITCH USES A
	JSP	D,NUMDIG
	 SKIPA
	JRST	.+4
	MOVE	B,(S)
	MOVEI	B,1(B)
	HRLI	B,350700+W
	IDPB	C,B
	TLNE	B,760000
	JRST	.-2
	TRO	F,TF		;FOR REVERSING BACK
	PUSHJ	P,NEWSTR
	PJRST	REVERA		;REVERSE BACK


NUMDIG:	MOVE	A,L		; COUNT SIGNIF DIGS IN L STRING
	MOVE	B,L		; SPARE COPIES OF PTR TO A AND B
	ILDB	C,A		; FIND MOST SIGNIFICANT DIGIT
	JUMPE	C,.+4		; B NOW HAS PTR TO MOST SIGNIF DIGIT
	CAIE	C,"0"
	MOVE	B,A		; THIS ONE IS MORE SIGNIFICANT
	JRST	.-4

	SKIPA	A,[0]		; NOW COUNT IN A HOW MANY
	IBP	L
	CAME	B,L		; REACHED THE END?
	AOJA	A,.-2		; NO, IS SIGNIF
	JUMPE	A,(D)
	JRST	1(D)

QUOT:	PUSHJ	P,NUMRQS
	PUSHJ	P,SWITCH

	PUSHJ	P,REVERS	;DIVIDEND
	CAIE	D,"-"
	TRZA	H,PMF		;+
	TRO	H,PMF		;-

	PUSHJ	P,SWITCH
	PUSHJ	P,REVERS	;DIVISOR
	CAIN	D,"-"
	TRC	H,PMF		;-

	PUSHJ	P,NEWSRC
	PUSHJ	P,NEWSTR
	PUSHJ	P,COPYAB
	PUSHJ	P,ENDST1
	TRO	F,PMF
	PUSHJ	P,TENCOM	;+DIVD,+DIVSR,-DIVSR ON PDL

	PUSHJ	P,NEWSR1
	MOVE	L,A
	JSP	D,NUMDIG
	 ERROR	DIVERR
	MOVE	E,A		;NUMBER OF NON-ZERO DIGITS IN DIVISOR
	MOVE	L,-2(S)
	HRLI	L,(POINT 7,(W),34)
	MOVEM	L,LINBOT
	JSP	D,NUMDIG
	 JRST	QUOTZR
	SUB	A,E		;DIGS IN DIVD- DIGS IN DIVSR
	JUMPL	A,QUOTZR	;DIVISOR .GTR. DIVIDEND
	IDIVI	A,5
	ADD	A,LINBOT
	JUMPE	B,.+3
	IBP	A
	SOJG	B,.-1		;WHERE TO START SUBTRACTION PTR IN A

	TRZ	F,NWF!PMF	;NO SUCCESSFUL SUBTRACTIONS DONE YET
	PUSHJ	P,NEWSTR	;QUOTIENT APPEARS HIGH DIG TO LOW
	MOVEI	C,"-"
	TRNE	H,PMF		;IS RESULT NEG?
	IDPB	C,B		;YES, STORE A -

	MOVE	L,A
QUOTLP:	MOVEI	C,"0"
	IDPB	C,B		;START OF NEXT DIGIT
ADDR:	MOVE	E,(S)
ADDR0:	MOVE	A,L
	HRLI	E,(POINT 7,(W),34)
	TRZ	F,TF		;CARRY
ADDR1:	ILDB	C,A
	JUMPE	C,ADDR2	;END OF LONGER ONE GETS PROPER CARRY
	SUBI	C,"0"
	ILDB	D,E
	ADDI	C,(D)
	TRZE	F,TF
	ADDI	C,1
	CAIG	C,"9"
	JRST	.+3
	SUBI	C,12
	TRO	F,TF
	DPB	C,A
	JRST	ADDR1

ADDR2:	TRNE	F,PMF
	TRC	F,TF		;INVERT SENSE OF CARRY
	TRZN	F,TF		;IF NO CARRY
	JRST	ADDR3		;THEN WE'RE DONE WITH THIS SIGNIF DIGIT
	LDB	C,B
	MOVEI	C,1(C)
	DPB	C,B		;BUMP THIS DIGIT
	TRO	F,NWF		;NON-ZERO RESULT
	JRST	ADDR		;REPEAT THE SUBTRACTION

ADDR3:	MOVE	E,-1(S)
	TRCN	F,PMF		;ARE THE DIVISORS + - ?
	JRST	ADDR0		;NO, ADD BACK IN
	CAMN	L,LINBOT
	JRST	QUDONE
	UNDEX	A
	DPB	C,A		;C IS 0, SHORTEN THE DIVIDEND
	UNDEX	L
	TRNE	F,NWF		;JUST DONE A LEADING 0?
	JRST	QUOTLP		;NO, NEXT DIGIT OF QUOTIENT
	JRST	ADDR		;YES, DO THIS ONE OVER

QUDONE:	TRZE	F,NWF		;ANY SUCCESSFUL SUBTRACTION?
	JRST	.+4		;YES
QUOTZR:	MOVE	B,NEWBOT
	MOVEI	C,"0"
	IDPB	C,B
	POP	S,C		;FLUSH THE TWO DIVISORS
	PJRST	ENDSTP	;EXIT WITH REV(REM) AND QUOT ON S STACK

TODATE:
FOR TENEX,<SETO	B,
	SETZ	D,
	ODCNV
	HLRZ	H,C		;DAY TO H
	HRRZI	E,(B)		;MON TO E
	HLRZ	D,B		;YR  TO D
>
FOR TEN50,<	DATE	G,
	IDIVI	G,^D31		;DAY TO H
	MOVEI	D,(G)
	IDIVI	D,^D12	;MON TO E
	ADDI	D,^D1964	;YR  TO D
>
	MOVEI	M,1(E)		;IT WAS MON-1
	PUSHJ	P,SNM
	MOVEI	E,"/"
	IDPB	E,B
	MOVEI	M,1(H)		;IT WAS DAY-1
	PUSHJ	P,SNM0		;DON'T MAKE A NEW STRING
	IDPB	E,B
	MOVEI	M,(D)		;YEAR
	PUSHJ	P,SNM0
	PJRST	ENDSTR


TIME:	PUSHJ	P,TIMDAY
	IDIVI	C,^D3600	;SECONDS PER HOUR
	MOVE	M,C		;HOUR TO M
	TRZ	F,PMF		;AM OR PM
	CAIGE	M,^D12
	JRST	.+3
	SUBI	M,^D12
	TRO	F,PMF		;PM
	SKIPN	M
	MOVEI	M,^D12		;MIDNIGHT AND NOON ARE 12
	PUSHJ	P,SNM
	MOVEI	C,":"
	IDPB	C,B

	IDIVI	D,^D60		;CONVERT SECONDS TO MINUTES
	MOVE	M,D
	PUSHJ	P,SNM0
	MOVEI	A,[ASCIZ / AM/]
	TRZE	F,PMF
	MOVEI	A,[ASCIZ / PM/]
	HRLI	A,440700
	PUSHJ	P,COPYAB
	PJRST	ENDSTR

TIMDAY:
FOR TENEX,<SETO	B,
	SETZ	D,
	ODCNV
	HRRZI	C,(D) >		;D HAD HIGH BITS SET
FOR TEN50,<	MSTIME	C,
	IDIVI	C,^D1000 >	;INDEPENDENT OF LINE FREQUENCY
	POPJ	P,


CLOCK:	PUSHJ	P,TIMDAY
	SUB	C,TOFDAY
	CAIGE	C,0
	ADDI	C,^D24*^D3600	;WENT PAST MIDNIGHT
	MOVE	M,C
	PUSHJ	P,SNM
	PJRST	ENDSTR

RESETC:	PUSHJ	P,TIMDAY
	MOVEM	C,TOFDAY
	JRST	COMEX

;TEXT - AN OPERATION ON TWO INPUTS
; 1) NAME OF A PROCEDURE
; 2) A LINE NUMBER IN THAT PROCEDURE
;IF EITHER INPUT LIES, THE OUTPUT IS EMPTY

TEXT:	POP	S,L		;SECOND INPUT, A LINE NUMBER
	PUSHJ	P,DNM
	 JRST	BTFEMP		;NOT A NUMBER, RETURN EMPTY
	 JRST	BTFEMP		; NUMBER TOO BIG, ALSO RETURN EMPTY
	MOVE	A,(S)
	MOVE	B,RP
	PUSHJ	P,LOOKY	;FIRST INPUT, A PROCEDURE NAME
	 JRST	BTFEMP		;NOT A PROCEDURE
	HRRZ	A,1(N)
	CAIN	A,-1		;IS IT DEFINED?
	 JRST	BTFEMP		;NO
	JUMPE	M,TEXT1		;IS IT LINE 0, IE TITLE
	JSP	C,SRCHLL	;FIND THE LINE
	 CAIE	B,(M)
	 JRST	BTFEMP		;NOT FOUND, RETURN EMPTY
	POP	S,B
	PJRST	LINGEN		;RETURN THE TEXT OF THE LINE

TEXT1:	POP	S,B
	MOVEI	D,1(A)
	MOVE	M,@PSD
	PUSHJ	P,NEWSTR
	MOVEI	D,TITLEL+1
	PUSHJ	P,LNGMP		;COPY IN BUILT-IN COMMAND NAME
	PJRST	LINGE0		;REST OF THE LINE

;LINES - A PROCEDURE OF ONE INPUT, A PROCEDURE NAME
;IF DEFINED, RETURNS THE SENTENCE OF ALL LINE NUMBERS, ELSE EMPTY

LINES:	MOVE	A,(S)
	MOVE	B,RP
	PUSHJ	P,LOOKY
	 JRST	BTFEMP		;PROCEDURE NOT EXTANT
	HRRZ	A,1(N)
	CAIN	A,-1
	 JRST	BTFEMP		;NOT DEFINED
	MOVEI	A,2(A)		;SKIP OVER TITLE
	SKIPN	M,@PSA		;ANY LINES?
	 JRST	BTFEMP		;NONE
	POP	S,B
	PUSHJ	P,SNM		;FIRST LINE NUMBER
	TRO	F,NWF		;SP OF LINES OF "X" IS ALWAYS "TRUE"
LINES1:	MOVEI	A,2(A)
	SKIPN	M,@PSA		;ANY MORE LINES?
	 PJRST	ENDSTR		;NO
	PUSHJ	P,DSPACE
	PUSHJ	P,SNM0		;ADDITIONAL LINE NUMBERS
	JRST	LINES1
SUBTTL	COMMANDS

;HERE FOLLOW THE COMMANDS

TYPE:	TRZA	F,CRF	;DON'T DO CRLF AFTER TOS
PRINT:	TRO	F,CRF
	TLO	F,TOF	;DENOTE TYPEOUT FOR BREAKY ERROR
	SETZM	BCHAR
	POP	S,A	;GET THE THING TO TYPE OR PRINT
	PUSHJ	P,PTOSS
	TRZE	F,CRF	;CALLED BY TYPE OR PRINT?
LISTXT:	PUSHJ	P,CRLF	;PRINT
	TLZ	F,TOF	;NO LONGER TYPING OUT
	JRST	COMEX

ENND:	SKIPN	A,TOPROD
	ERROR	NOPERR		;END WHAT? YOU ARE NOT DEFINING ANYTHING
	SKIPN	PRODNM		;IF THE "END" WAS STORED, OR
	TLNE	F,GETF		;IN ANY CASE, IF GETTING
	JRST	ENND1		;DO NOT TYPE "DEFINED"
	JSP	H,ETUP
	MOVEI	A,[ASCIZ / DEFINED/]
	PUSHJ	P,PTOSSM
	PUSHJ	P,CRLF
ENND1:	SETZB	A,TOPROD
	TRZN	F,FLUSHF	;IF FLUSHING IT,  NOT REALLY OPEN
	PUSHJ	P,MOVEMP
	JRST	COMEX


ABBREVIATE:
	AOS	CPP
	PUSHJ	P,EVAL		;EVAL FIRST ARG
	PUSHJ	P,GNE
	 ERROR	ERMSSG		;SOMETHING MISSING, IE SECOND ARG
	CAMN	A,[XWD MPF!IMMEDI,ASL+1]	;IS IT "AS"?
	AOS	CPP		;YES, SKIP IT
	PUSHJ	P,EVAL		;GET SECOND ARG

ABBRV0:	MOVE	A,0(S)		;SECOND ARG, ABBREVIATION
	TLNE	A,EMPTYF	;IS IT EMPTY
	 ERROR	ABBER2		;DON'T USE THE EMPTY THING AS AN ABB
	MOVE	B,UA		;USER ABBREVIATION TABLE
	PUSHJ	P,LOOKY
	 JRST	ABBRV1
	POP	S,A		;FOUND IT, FLUSH ABBREVIATION
	POP	S,1(N)		;SAVE ITS NEW VALUE
	JRST	COMEX

ABBRV1:	MOVEI	A,2(N)		;NOT FOUND, INSERT AT END OF TABLE
	CAML	A,UA+1		;ROOM FOR TWO MORE WORDS AT END?
	EXPAND	UA		;NO, MAKE ROOM
	POP	S,0(N)		;ABBREVIATION FIRST
	POP	S,1(N)		;VALUE SECOND
	SETZM	2(N)		;REPLACE END CONDITION
	JRST	COMEX

TEST:	MOVE	A,(S)		;LEAVE ARG ON STACK FOR ERROR
	PUSHJ	P,PREDIQ	;IS THE INPUT A PREDICATE?
	 ERROR	PREDR1		;NO
	POP	S,B		; OK TO FLUSH NOW
	MOVEI	B,0
	SKIPN	@WSA		;0 FOR "FALSE"; "TRUE" FOR "TRUE"
	MOVNI	B,1
	MOVEM	B,TRUTH
	JRST	COMEX

IF:	MOVE	A,(S)
	PUSHJ	P,PREDIQ	;IS INPUT TO IF A PREDICATE?
	 ERROR	PREDR1		;NO, INPUT MUST BE A PREDICATE
	POP	S,B		;FLUSH IT
	TRO	F,EELSEF	;DENOTE THAT AN ELSE MAY APPEAR
	SKIPE	@WSA		;IS IT FALSE
	 JRST	IF2		;NO, TRUE
	AOS	A,CPP
	SKIPN	B,@WSA		;HOOK FOR A TRAILING ELSE
	JRST	IFXFS2		;DIDN'T FIND ONE
	CAME	B,[XWD MPF!IMMEDI,ELSEL+1]
	JRST	.-4		; NOT ELSE, GO BACK FOR NEXT ELEM
	JRST	IFX2		;FOUND ELSE, USE THE REST
IF2:	POP	P,0(P)		;FLUSH PTR TO OPEX
	MOVE	B,[XWD MPF!IMMEDI,THENL+1] ; OPTIONAL THEN
	AOS	A,CPP
	CAME	B,@WSA
	SOS	CPP
	JRST	EXECU1

IFFALSE:	SKIPE TRUTH
	JRST IFX2	; IF FALSE, AND IN FACT TRUTH IS FALSE
IFXFLS:	MOVE	A,CBOT
	ADD	A,@WSA
IFXFS2:	SUBI	A,1
	MOVEM	A,CPP
	JRST	COMEX

IFTRUE:	SKIPE TRUTH
	JRST IFXFLS	; IF TRUE, AND TRUTH=FALSE
IFX2:	TLZ	F,COMF
	POP	P,0(P)
	MOVEI	A,[[ERROR NOCMD]]
	CAME	A,(P)
	ERROR	COMERR
	JRST	EXECU1


GOODBYE:	JSP	D,COMEXR	;MAKE SURE LINE IS OK FIRST, THEN
FOR TENEX,<	MOVEI	A,100	;PRIMARY INPUT FILE
	CFIBF		;FLUSH ANY OTHER JUNK
	MOVE	C,[ASCII /LOGO
/]
	MOVNI	D,5
	SETZ	B,
	ROTC	B,7
	STI		;SIMULATE TERMINAL INPUT TO EXEC
	AOJL	D,.-3
	HALTF >		;AND RETURN TO EXEC
FOR TEN50,<	CALL	[SIXBIT /EXIT/]>

TYPEIN:	PUSHJ P,REQUEST	;PUSH SECOND ARG TO MAKE
MAKE:	MOVE	A,-1(S)
	TLNE	A,EMPTYF
	ERROR	NMERR5	;NAME NOT ALLOWED TO BE EMPTY
	HRRZI	B,MV	
	PUSHJ	P,SYSLUK
	 JRST	.+2
	ERROR	NMERR3	;X IS USED BY LOGO
	MOVE	A,-1(S)
	HRRZ	B,VP
	PUSHJ	P,LOOKY
	 PUSHJ	P,MAKEN	;NOTA, MAKE A NEW GLOBAL
MAKE1:	POP	S,A	; GET THE VALUE
	DPB A,[XWD 004100,1(N)]	;PUT IT AWAY, NOT CHANGING STATE OF GLOB
IGNORE:	POP	S,A	;FLUSH ONE INPUT, THE NAME IF MAKE
	JRST COMEX

MAKEN:	MOVEI	B,2(N)
	CAML	B,VP+1
	EXPAND	VP
	MOVE	A,-1(S)
	MOVEM	A,(N)
	MOVE	A,[XWD WORDF!SENTF!EMPTYF!GLOBLF!UNBOUN,0]
	MOVEM	A,1(N)
	SETZM	2(N)
	POPJ	P,



LOCAL:	SKIPN	PRODNM
	 ERROR	STOERR	;LOCAL CAN ONLY BE STORED
	MOVSI	A,EMPTYF
	TDNE	A,0(S)		;IS THE LOCAL NAME EMPTY
	 ERROR	NMERR5		; NAMES CANNOT BE EMPTY
	MOVE	A,(S)
	MOVEI	B,MV
	PUSHJ	P,SYSLUK	; IS IT A BUILT IN
	 JRST	.+2
	ERROR	LCLERR		; CAN'T USE MV AS LOCAL NAME
	MOVE	A,(S)
	PUSH	S,A		; SO MAKEN CAN USE "-1(S)" FOR NAME
	MOVE	B,VP
	PUSHJ	P,LOOKY	; DOES THE NAME ALREADY EXIST?
	 PUSHJ	P,MAKEN		; NO, GO DO IT
	POP	S,A
	POP	S,A		; GET RID OF JUNK

	MOVE	E,DTOP
	MOVE	D,DP+1
	SUB	D,DP	;END RELATIVE TO BEGINNING
	CAIG	D,2(E)	;WILL ANOTHER ENTRY FIT
	EXPAND	DP	;NO
	ADD	E,DP	;MAKE ABSOLUTE
	MOVE	B,[XWD WORDF!EMPTYF!SENTF!UNBOUN,0]
	EXCH	B,1(N)		; TOP LEVEL BINDING NOT SET, ONLY DECLARED
	SUB	N,VP
	ADDI	N,1
	MOVEM	N,(E)		; NAME PTR IN DP IS REL PTR TO VP
	MOVEM	B,1(E)		; AND VALUE IS THE ONE IN VP PREVIOSLY
	MOVEI	A,2
	ADDM	A,DTOP	;TOP OF LIST IS HIGHER
	JRST COMEX	;ONLY ALLOW ONE INPUT
SUBTTL	COMMANDS--USER DEFINED PROCEDURES

;HERE FOLLOWS ALL THERE IS TO USER DEFINED PROCEDURES
;DEFINING THEM, EXECUTING THEM, CHANGING TITLES AND TRACING

TITLE:	SKIPN	TOPROD	;IS THERE A PROCEDURE OPEN?
	ERROR	NOPERR	;NO, CANNOT RETITLE NO PROCEDURE
	PUSHJ	P,GNE
	 ERROR	ERMSSG
	CAME	A,[XWD MPF!IMMEDI,TOL+1]	;IS THE NEXT THING "TO"
	ERROR	TITER2	;WORD AFTER TITLE MUST BE TO
	TLO	F,TITLEF
	JRST	TO0
TO:	TLZ	F,TITLEF
	SKIPE	TOPROD	;IS THERE A PROCEDURE ALREADY OPEN
	ERROR	TOERR4	;YES
TO0:	MOVE	H,CPP	;WHERE TO START SAVING THE CODE OF TITLE LINE
	SUB	H,CBOT	;ALWAYS RELATIVE TO BEG OF LINE!!
	PUSHJ	P,GNE	;NEXT NON-COMMENT ELEMENT
	 ERROR	ERMSSG	;MUST HAVE A PROCEDURE NAME
	TLNN	A,UPRF
	 ERROR	TOERR5	;CANNOT BE USED AS A PROCEDURE NAME
	TLNE	A,SCHF		; DOES IT HAVE NON-PRINTING CHARS
	 ERROR	TOERR7	; YES, NOT A LEGAL NAME
	MOVEI	E,(A)
	MOVE	G,@RPA
	CAMN	G,[EXP -1]	;IS THE PROCEDURE ALREADY DEFINED?
	JRST	TO1		;NO, ALWAYS OK
	TLNE	F,GETF	;DOING A GET?
	JRST	TOGET		;YES
	HRRZ	B,TOPROD
	TLNE	F,TITLEF	;ARE WE DOING "TITLE"?
	CAIE	B,(A)		;YES, IS IT THIS PROCEDURE?
	 ERROR	TOERR6	;NO TO EITHER, THE PROCEDURE IS ALREADY DEFINED
TO1:	SETZ	M,	;COUNT OF DUMMIES ENCOUNTERED
	PUSHJ	P,GNE	;NEXT NON-COMMENT ELEMENT
	 JRST	TOA	;NO DUMMIES
TO2:	TLNE	A,MVARF	; IS THE FORMAL NAME RESERVED?
	 ERROR	TOERR3	; NOT PERMITTED
	TLNN	A,VARF		;IS IT A DUMMY?
	ERROR	TOERR2	;NO
	MOVEI	M,1(M)	;YES, COUNT IT
TO3:	PUSHJ	P,GNE	;CHECK FOR "AND"
	 JRST	TOA	;NOTHING, SO NO AND
	CAME	A,[XWD MPF!IMMEDI,ANDL+1]	;IS IT "AND"?
	JRST	TO2		;NOT AND, TRY DUMMY
	PUSHJ	P,GNE
	 ERROR	ERMSSG		;"AND" LAST, NOT WELL FORMED
	JRST	TO2		;IT MUST EXIST AND BE A VARIABLE


TOGET:	TRO	F,FLUSHF	;LOADING AN ALREADY DEFINED PROCEDURE
	MOVEM	A,TOPROD	;SO LET IT BE OPEN
	MOVEI	A,-1(A)
	MOVE	A,@RPA		;PROCEDURE NAME
	PUSHJ	P,PTOSS
	MOVEI	A,[ASCIZ / IS ALREADY DEFINED./]
	PUSHJ	P,PTOSSM
	PUSHJ	P,CRLF
	JRST	IFXFLS

TOA:	TLNN	F,TITLEF	;TITLE LINE NOW VALID
	JRST	TOB		;TO, NOT TITLE
	MOVE	A,TOPROD
	MOVNI	G,1
	EXCH	G,@RPA		;OLD PROCEDURE OPEN NOW UNDEFINED
	HRLI	G,-1(M)		;NO OF DUMMIES-1,LOC OF DIRECTORY
	MOVEI	A,(E)
	MOVEM	A,TOPROD	;NEW PROCEDURE NAME NOW OPEN
	MOVEM	G,@RPA		;AND DEFINED


	MOVEI	A,(G)
	MOVEM	M,@PSA		;NUMBER OF DUMMIES
	MOVEI	A,1(A)
	PUSHJ	P,TOLINJ
	JRST	SCOMEX

TOB:	MOVEM	E,TOPROD	;PROCEDURE NOW OPEN
	HRLZI	G,-1(M)
	HRR	G,PTOP		;NEW DIRECTORY GOES HERE
	MOVEI	A,(E)
	MOVEM	G,@RPA		;PROCEDURE DEFINED
	MOVEI	A,(M)
	PUSHJ	P,MOVEMP
	MOVEI	G,(A)		;SAVE PSA PTR TO COMPILE CODE PTR
	PUSHJ	P,MOVEMP	;MAKE A HOLE
	MOVEI	A,(G)		;GET PSA PTR BACK
	PUSHJ	P,TOLINJ
	JRST	SCOMEX

MOVEMP:	MOVE	D,PTOP
	MOVEM	A,@PSD
	AOS	A,PTOP
	MOVEI	B,@PSA
	CAML	B,PS+1
	EXPAND	PS
	SETZM	@PSA
	POPJ	P,


TOFLUS:	SETZM	CBOT
	POPJ	P,

TOLINE:	SKIPN	TOPROD	;IS THERE A PROCEDURE OPEN
	ERROR	INERR3	;LINE X OF WHAT PROCEDURE?
	TRNE	F,FLUSHF
	JRST	TOFLUS
	MOVEI	H,2	;SAVE THE LINE BUT NOT THE LINE NUMBER
	MOVE	A,CBOT
	MOVEI	A,1(A)		; POINT PAST OVERHEAD WORD
	MOVE	L,@WSA
	PUSHJ	P,DNM
	ERROR	IOPERR	;I AM IN TROOUBLE
	 ERROR INERR2		; OVERFLOW, LINE NO TOO LARGE
	CAIL	M,^D100000
	ERROR	INERR2	;LINE NO TOO LARGE
	JUMPE	M,[ERROR INERR4]	;LINE NO =0

	HRRZ	A,TOPROD
	JSP	C,SRCHL1
	 CAIGE	B,(M)
	 JRST	TOLING

	CAIN	B,(M)		;LINE NO ALREADY EXISTS?
	AOJA	A,TOLINJ	;YES

TOLING:	SETOM	NXLINE	;CANNOT SAFELY ASSUME THAT THE PROCEDURE WE'RE IN
	MOVEI	B,2	; HAS NOT MOVED
	ADD	B,PTOP
	ADD	B,PS
	CAML	B,PS+1	;ROOM IN PS FOR ANOTHER 2 WORD ENTRY?
	EXPAND	PS	;NO

	MOVE	B,PTOP
	ADD	B,PS
	MOVEI	C,@PSA

	MOVE	D,(B)	;COPY EVERYTHING DOWN 2, UP TO PLACE TO INSERT
	MOVEM	D,2(B)
	CAIE	B,(C)
	SOJA	B,.-3

	MOVEI	B,2
	ADDM	B,PTOP

	MOVEM	M,(C)	;LINE NUMBER
	AOJA	A,TOLINJ


TOLINJ:	TLO	F,GCCSF	; WRONG PLACE FOR THIS FLAG
	MOVE	B,CBOT		; PTR TO OLD LENGTH
	CAIN	H,1	; ALL OF THE LINE BEING SAVED?
	JRST	TOLINQ	; YES
	PUSH	P,A	; PTR INTO PROCEDURE DIRECTORY
	MOVE	A,@WSB		; GET THE OLD LENGTH
	SUBI	A,-1(H)		; NEW LENGTH
	PUSHJ	P,MAKELM
	MOVE	A,CBOT
	ADDI	A,-1(H)
	HRLZI	C,@WSA
	HRRI	C,@WSB
	MOVEI	A,(C)
	AOBJN	C,.+1
	ADD	A,(A)
	BLT	C,(A)
	POP	P,A
	TLO	B,COMPOUND	; NEW ELEMENT IS COMPOUND
TOLINQ:	MOVEM	B,@PSA
	POPJ	P,	;R1 FROM COMPIL


TRACE:	PUSHJ	P,GNE	;TRACE WHAT?
	 ERROR	ERMSSG	;NOTHING
	TLNN	A,UPRF	;TRACE A USER PROCEDURE?
	 ERROR	WHATER	;CANNOT TRACE THAT
	MOVEI	A,-1(A)	;POINT AT FIRST WORD OF RP PAIR
	HRLZI	B,TRACEF
	IORM	B,@RPA	;MARK THIS PROCEDURE AS TRACED
	JRST	COMEX

UPROD:	MOVE	A,-1(P)
	POP	P,-1(P)
	MOVNI	B,1
	CAMN	B,@RPA	;IS THE PROCEDURE DEFINED?
	 ERROR	EVER3	;NO, X NEEDS A MEANING
	MOVEI	B,(A)
	CAMN	B,TOPROD	;IS THIS THE ONE BEING DEFINED?
	 ERROR	EVER4	;YES, X HAS NOT BEEN COMPLETELY DEFINED

	JSP	D,SAVEUP	;PUSH ALL THE GOOD STUFF
	HRRZM	A,PRODNM

	MOVE	B,DP	;LOC OF DUMMY ARG TABLE
	HLRE	C,A	; + NO OF ARGS AT SCAN TIME -1
	ADDI	C,1
	MOVEI	E,(C)
	ADDI	E,1(C)
	ADD	B,DTOP	;PART OF TABLE ALREADY USED
	ADDI	B,(E)	;AMT FOR DUMMY NAMES
	CAML	B,DP+1	;ALL FIT IN DP?
	EXPAND	E,DP	;EXPAND THE TABLE AT LEAST THIS MUCH

	ADDM	C,DTOP
	ADDM	C,DTOP	;UPDATE AMT USED



	TLO	F,NOBREAK	;INHIBIT BREAK FOR DURATION OF TRACE
	HRRZ	D,@RPA
	PUSH	P,BCHAR	;SAVE CURRENT STATE OF MARGIN
	MOVE	E,TRACEM	;MARGIN FOR TRACE
	ANDI	E,17		;INDENT AT MOST 14 SPACES
	MOVEM	E,BCHAR
	TRZ	F,TF	;IF SET WILL DENOTE THAT THIS PROC IS TRACED
	MOVEI	A,-1(A)
	MOVE	A,@RPA	;FETCH NAME OF PROCEDURE
	TLNE	A,TRACEF	; AND SKIP IF NOT TRACED
	TRO	F,TF
	PUSH	P,C
	TRNE	F,TF
	SKIPN	CHARNO
	SKIPA		;NOT TRACING OR AT MARGIN
	PUSHJ	P,CRLF	;NOT AT MARGIN, GET THERE
	TRNE	F,TF
	PUSHJ	P,INDENT
	POP	P,C
	TRNE	F,TF
	PUSHJ	P,CALPTS	;TRACED, TYPE OUT THE NAME

	MOVEI	D,1(D)	;POINT TO PTR TO TO LINE 
	MOVE	D,@PSD	;FETCH PTR TO TO LINE
	MOVN	E,C	;-N
	MOVEI	C,1(S)	;STACK LOCATION
	ADD	C,E	;LOCATION IN STACK OF FIRST DUMMY
	HRL	C,E	;-COUNT OF DUMMIES
	HRRZ	G,DP
	ADD	G,-3(P)	;OLD VALUE OF DTOP
			;BEWARE OF THIS INSTRUCTION WHEN CHANGING SAVEUP
	JUMPGE	C,UPDVCR	;NO DUMMIES, GET FIRST LINE

	MOVE	A,[POINT 7,[ASCIZ / OF /]]
UPDVCL:	TRNE	F,TF
	PUSHJ	P,CLPTS1	;IF TRACED, TYPE "OF" OR " AND "
	MOVEI	E,042		;TO QUOTE INPUTS IF TRACING
	MOVE	A,@WSD	;LOOP TO COPY INTO DP, GET DUMMY NAME
	TLNN	A,VARF	;IS IT A DUMMY NAME
	AOJA	D,.-2	;NO, TRY NEXT ELEMENT
	MOVEM	A,(G)	;INTO DUMMY VAR TABLE
	MOVE	B,(C)	; NEW BINDING
	EXCH	B,@VPA	; GOES INTO VP, OLD BINDING
	MOVEM	B,1(G)	; GOES INTO DP
	MOVE	A,(C)	; NEW BINDING AGAIN, FOR TRACING
	TRNE	F,TF		;TRACING?
	PUSHJ	P,CLPTS0	;YES, TYPE INPUT QUOTED
	MOVEI	G,2(G)
	POP	S,0(S)	;POP 1 THING OFF S STACK WITHOUT CLOBBERING
	MOVEI	D,1(D)
	MOVE	A,[POINT 7,[ASCIZ / AND /]]
	AOBJN	C,UPDVCL	;UPROD DUMMY VAR COPY LOOP
UPDVCR:	TRNE	F,TF		;BUT BEFORE EXECUTING
	PUSHJ	P,CRLF		;NEATEN UP
	MOVEI	A,2 
	TRZE	F,TF	;TRACING? ALSO, FLAG NO LONGER NEEDED
	ADDM	A,TRACEM	;NEXT TRACE CALL INDENTED TWO MORE SPACES


UPFRST:	PUSH	S,CBOT
	POP	P,BCHAR		;RESTORE OLD MARGIN
UPNEXT:	JSP	C,SRCHLN
	 CAMG	B,LINENO
	 JRST	OUTPTA
	MOVEM	A,NXLINE
UPNXT1:	MOVEM	B,LINENO	;FOUND A LINE NO .GTR. PREVIOUS LINE
	TLZ	F,NOBREAK	;SAFE TO ALLOW BREAK AGAIN
	AOS	A,NXLINE
	MOVE	A,@PSA		;GET COMPILE PTR & CHANGE NO
	MOVEM	A,CBOT
	MOVEM	A,CPP

	PUSHJ	P,EXECUTE

	AOS	A,NXLINE	;DONE WITH THE LINE, GET NEXT ONE
	JUMPE	A,UPNEXT	;DO IT THE LONG WAY IF ANY PROCEDURES CHANGED
	MOVE	B,@PSA		;FETCH THE LINE NO
	JUMPN	B,UPNXT1	;LINE NO .NE. 0_MORE TO DO
	JRST	OUTPTA		;NO MORE LINES, DONE WITH PROCEDURE

CLPTS0:	TRO	F,PREFIX!SUFFIX
CALPTS:	HRLI	A,(POINT 7,(W),34)	;WORKSPACE ELEMENT
CLPTS1:	PUSH	P,B
	PUSH	P,C
	PUSH	P,D
	PUSHJ	P,PTOS		;FINALLY!
	POP	P,D
	POP	P,C
	POP	P,B
	POPJ	P,

OUTPTA:	TLZ	F,NOBREAK	;REMEMBER TO PERMIT BREAK
	TLO	F,COMF	;DENOTE THAT THERE IS NO OUTPUT
	JRST	RETA

FOR SAVBRK,<
GO:	SKIPE	PRODNM
	ERROR	DIRERR	;"GO" ALONE CAN ONLY BE DIRECT
	SKIPG	GODEPTH
	ERROR	GOERR9	;NOPLACE TO GO
	JSP	H,GORE
	POPJ	P,

CANCEL:	SKIPE	PRODNM
	 ERROR	DIRERR	;DIRECT ONLY ERROR BEFORE NOTHING TO CANCEL
	SKIPG	GODEPTH
	 ERROR	CANER1	;NOTHING TO CANCEL
	JSP	H,GORE
	JRST	FLUSHM	;FLUSH TO BSP

GORE:	SOS	GODEPTH	;TEST ABOVE SO IT DOESN'T GO NEGATIVE
	MOVE	A,BSP
	JSP	C,SETPDL
	JSP	D,RESTOR
	POP	P,BSP
	JRST	(H) >

ESTOP:	TLOA	F,COMF
OUTPUT:	POP	S,GCTEM		;SAVE OUTPUT VALUE FOR A MOMENT (GC IMPOSSIBLE)
	SKIPN	PRODNM
	ERROR	STOERR		;OUTPUT AND STOP MUST BOTH BE STORED
	JSP	D,COMEXR	;DO THE END OF LINE CHECKS
	POP	P,0(P)
RETA:	JSP	E,RESTOA	;RESTORE ALL BUT PRODNM
	TLNN	F,COMF		;IS THIS OUTPUT?
	PUSH	S,GCTEM		;YES RESTORE VALUE TO S STACK
	TLNE	F,GOF		;IS THIS RETURN UNTRACEABLE?
	JRST	RETD		;YES IT IS, SKIP TRACE STUFF



	MOVE	A,PRODNM
	MOVEI	A,-1(A)	;DON'T CHANGE PRODNM, COMERU MAY NEED IT
	MOVE	A,@RPA	;ENDING A TRACED PROCEDURE?
	TLNN	A,TRACEF
	JRST	RETD	;NO
	MOVNI	B,2
	ADDB	B,TRACEM
	PUSH	P,BCHAR
	ANDI	B,17
	MOVEM	B,BCHAR
	PUSHJ	P,INDENT
	PUSHJ	P,PTOSS	;TYPE PROCEDURE NAME
	MOVEI	A,[ASCIZ / OUTPUTS /]
	TLNE	F,COMF	;DID IT OUTPUT?
	MOVEI	A,[ASCIZ / STOPS/]	;NO, IT STOPPED
	PUSHJ	P,PTOSSM

RETB:	TLNE	F,COMF
	JRST	RETC	;NO NEED TO TYPE WHAT IT OUTPUTTED, IT STOPPED
	TRO	F,PREFIX!SUFFIX
	MOVEI	E,042
	MOVE	A,(S)
	PUSHJ	P,PTOSS
RETC:	POP	P,BCHAR
	PUSHJ	P,CRLF


RETD:	POP	P,E	;OLD PRODNM INTO E
	ANDI	E,377777	;TRUTH BIT IS PACKED IN THIS HALFWORD
	EXCH	E,PRODNM	;SAVE NAME OF PR BEING EXITED IN E
	TLZE	F,COMF	;DID THE PROCEDURE OUTPUT?
	JSP	D,COMEXU	;NO, TREAT IT LIKE A COMMAND
	POPJ	P,

SRCHLN:	HRRZ	A,PRODNM	;THIS IS THE PROCEDURE TO SEARCH
SRCHL1:	HRRZ	A,@RPA	;GET RELATIVE PTR INTO PS SPACE
	CAIN	A,-1	;ERASED?
	ERROR	NOPROD	;THERE IS NO PROCEDURE X

SRCHLL:	MOVEI	A,2(A)	;POINT TO NEXT LINE NO
	HRRZ	B,@PSA	;GET THE LINE NO
	JUMPE	B,1(C)	;R1, FOUND END BEFORE THE LINE
	XCT	(C)	;ARG TO ROUTINE IS THE COMPARE
	JRST	SRCHLL	;CONTINUE ON NO COMPARE
	JRST	2,2(C)	;GOOD COMPARE, R2


GOTOLINE:
	SKIPN PRODNM	;IS THE COMMAND STORED?
	 ERROR STOERR	; NO, IS AN ERROR

	PUSHJ	P,GTL1

	JSP	C,SRCHLN	;IS THERE THAT LINE IN THIS PROCEDURE
	 CAIE	B,(M)
	 ERROR	GOERR3	;THERE IS NO LINE X
	MOVEI	A,-1(A)
	MOVEM	A,NXLINE	;SO STEP TO NEXT LINE WILL FIND THIS ONE WITHOUT SEARCHING
	JRST	COMEX

NUMEVL:	AOS	A,CPP
	MOVE	L,@WSA	;FETCH LINE NUMBER
	TLNE	L,LITF	;IF THIS, DOES NOT NEED TO BE EVALED
	JRST	GOTO1	;IS A LITERAL, COULD BE A NUMBER
	PUSHJ	P,EVAL	;NOT A LITERAL, MUST EVALUATE
GTL1:	POP	S,L	;VALUE RETURNED
GOTO1:	MOVEI	D,(L)	;SAVE POINTER FOR ERROR COMMENT
	TLNN	L,SENTF	; CANNOT BE A NUMBER IF IT IS A SENTENCE
	PUSHJ	P,DNM
	 ERROR	GOERR2	;IS NOT A LINE NUMBER
	 ERROR	GOERR2	; TOO BIG
	POPJ	P,

SAVEUP:	HRLZ	B,LINENO	;A MUST BE LEFT ALONE
	HRR	B,PRODNM
	MOVE	C,TRUTH
	ANDI	C,400000
	ORI	B,(C)		;PRODNM .LT. 2^17 BECAUSE THERE MUST BE A
				; NAME FOR EACH ONE 
	PUSH	P,B		;LINENO,,TRUTH+PRODNM
	PUSH	P,DTOP
	MOVE	B,CPP
	SUB	B,CBOT
	TLZE	F,GCCSF		;CODE PTRS PUSHED FROM HERE ON ARE VALID
	TLO	B,200000	;BUT IF SET, THOSE ABOVE ARE NOT
	TRNE	F,EELSEF	;ON A LINE STARTING WITH IF?
	TLO	B,100000	; YES, PUSH THAT FACT
	PUSH	P,B
	PUSH	P,SPP

	SETZM	TRUTH
	SETZM	LINENO
	SETZM	PRODNM
	HRRZI	B,(S)		;WHEN SAVEUP IS CALLED IS THE ONLY TIME
	SUB	B,SP		;THE DEPTH OF THE PUSHDOWN LISTS CHANGE
	HRLZM	B,SPP
	HRRZI	B,1(P)
	SUB	B,PP
	HRRM	B,SPP
	JRST	(D)

RESTOR:	JSP	E,RESTOA	;RESTORE ALL BUT PRODNM
	HRRZM	A,PRODNM
	POP	P,A	;FIX UP PDL
	JRST	(D)

RESTOA:	POP	S,CBOT
	POP	P,SPP
	TLNN	F,GCCSF		; HAS THERE BEEN A POSSIBLE LINE EDIT?
	JRST	RESTOC		; NO, NO NEED TO CHECK FOR ALTERATIONS
	HRRZ	A,-2(P)		;PRODNM BEING RETURNED TO
	ANDI	A,377777	;REMOVE TRUTH FLAG
	JUMPE	A,RESTOC	; SKIP TEST IF DIRECT LINE
	HLRZ	M,-2(P)		;LINE NO
	JSP	C,SRCHL1	;FIND THE LINE AGAIN
	 CAIE	B,(M)
	 ERROR	LNDERR		;LINE DELETED WHILE IN IT
	MOVEI	A,1(A)
	MOVE	A,@PSA		;SEQNO,,CODEPTR
RESTOC:	POP	P,A		; BITS,,CPP REL CBOT
	TLZE	A,200000	;WAS GCCSF SET AT THIS LEVEL GOING DOWN
	TLO	F,GCCSF		;THEN IT MUST BE SET ON WAY UP
	TLZE	A,100000	; LINE BEING POPPED STARTED WITH IF?
	TRO	F,EELSEF	; YES, THEN IT CAN END WITH ELSE
	ADD	A,CBOT
	MOVEM	A,CPP
	MOVE	C,DTOP		;FLUSH LOCAL BINDINGS THIS LEVEL
	POP	P,DTOP		; HAVING REMEMBERED OLD VALUE
RESTB1:	CAMN	C,DTOP		; ARE THERE ANY MORE BINDINGS?
	JRST	RESTB2		; NO
	MOVEI	C,-1(C)		; REL PTR TO VALUE
	MOVE	B,@DPC		; PICK UP VALUE
	MOVEI	C,-1(C)		; REL PTR TO REL PTR TO VP
	MOVE	A,@DPC
	MOVEM	B,@VPA		; STORE VALUE IN OBLIST
	JRST	RESTB1
RESTB2:	MOVE	A,(P)	;LINENO,,TRUTH+PRODNM
	MOVEI	B,0
	TRZE	A,400000
	HRROI	B,-1	;TRUTH=FALSE
	MOVEM	B,TRUTH
	HLRZM	A,LINENO
	SETOM	NXLINE
	JRST	(E)

WAIT:	MOVE	L,(S)
	HRLI	L,(POINT 7,(W),34)
	PUSHJ	P,DNM
	 ERROR	ZERERR
	 ERROR	.		; TOO LONG A TIME TO WAIT
	POP	S,L
FOR TENEX,<	MOVEI	1,^D1000
	IMUL	1,M
	DISMS >
FOR TEN50,<	MOVEI	A,^D3600
	IMULI	M,^D60
	CAIG	M,(A)
	JRST	.+4
	SLEEP	A,
	SUBI	M,(A)
	JRST	.-4
	IDIVI	M,^D60
	SLEEP	M, >
	JRST	COMEX

LINEFEED:
	SKIPA C,[012]
BELL:	MOVEI C,007
	JRST  COMCHR

FORMFEED:
	SKIPA C,[014]
CRETUN:	MOVEI C,015
COMCHR:	PUSHJ P,TYO
	JRST COMEX

SKIP:	PUSHJ P,CRLF
	JRST COMEX
SUBTTL	SUBROUTINES

;TYPE IN STRING
;CHECK FOR CONTROL CHARACTERS,EDIT CHARS, ILLEGAL CHARS
;EDITF=1_EDIT MODE, THEN A CONTAINS BYTE POINTER TO BEGINNING OF STRING
;BYTE POINTER TO OUTPUT STRING IN B
;RETURN STRING POINTER TO INPUT ON S-LIST
;R1_FAILURE, TRY AGAIN, R2_SUCCESS.

TIS:	MOVEI	C,2	;SET CONTINUATION TO SPACE TWO CHARACTERS
	MOVEM	C,BCHAR
	TLZ	F,LDONF!FCHARF	;CLEAR LINE DONE FLAG FOR EDIT MODE
	TLNN	F,EDITF!GETF	;DON'T TYPE WEDGE OR _ IF EDITING
	PUSHJ	P,TOSS	;PRINT OUT COMMENT FROM B
FOR DRIBBLE,<
FOR TENEX,<
	PUSH	P,A
	SKIPN	A,DRIBFL		;IS THERE A DRIBBLE OPEN?
	JRST	TISAZ		;NO
	SETO	B,
	SETZ	D,
	ODCNV
	HRRZM	D,DRIBTM
TISAZ:	POP	P,A  >>
	PUSHJ	P,NEWSTR
	TLNN	F,EDITF	;ARE WE IN EDIT MODE?
	JRST	TISB	;NO
	PUSHJ	P,NEWSRC
	MOVEM	A,LINBOT	;FOR PURPOSES OF GARBAGE COLLECTION
	PUSHJ	P,TEDIT	;AND COPY IT TO THE INPUT STRING
TISB:	PUSHJ	P,TYI	;GET NEXT CHARACTER INTO C
FOR DRIBBLE,<
FOR TENEX,<
	PUSH	P,A
	SKIPN	A,DRIBFL
	JRST	TISB01
	TLOE	F,FCHARF	;FIRST CHAR ON LINE?
	JRST	TISB0		;NO
	MOVE	H,B		;TIME STAMP THE LINE
	MOVE	G,C
	SETO	B,
	SETZ	D,
	ODCNV
	HRRZI	D,(D)
	SUB	D,DRIBTM
	CAIGE	D,0
	ADDI	D,^D24*^D3600
	HRLZI	E,400001
	ODTNC
	MOVEI	B," "
	BOUT
	MOVE	B,H
	MOVE	C,G
TISB0:	EXCH	C,B
	BOUT
	EXCH	C,B
TISB01:	POP	P,A >>

TISB1:	CAIGE	C,40	;CONTROL CHAR?
	JRST	TISC	;YES
	CAIN	C,177	;RUBOUT?
	JRST	TISO	;YES
	AOS	CHARNO	;PRINT CHARACTER SO COUNT
	CAIN	C,134	;BACKSLASH
	JRST	TISN	;YES
TISF:	TLNE	F,EDITF
	PUSHJ	P,TYO	;IN EDIT MODE THERE IS NO OTHER ECHOING
	IDPB	C,B
	JRST	TISB

TISC:	MOVEI	E,(C)	;SAVE CHAR IN C
	ROT	E,-1
	HRRZ	D,ITAB(E)
	JUMPL	E,.+2
	HLRZ	D,ITAB(E)
	JUMPN	D,(D)	;DISPATCH IF IT IS A LEGAL CONTROL CHAR
	JRST	TISF	;NOT A SPECIAL CONTROL CHAR


DEFINE CC (A,B,C,D)
<XWD A,B
 XWD C,D>

ITAB:
CC 0,0,0,0	;NUL ABC
CC 0,0,0,TISF	;DEFG
CC 0,0,TISI,0	;H TAB LF K
CC 0,TISJ,TISK,0	;L CR NO
NOTFOR TURTLE,<CC 0,0,TISL,TISDC3>	;TEN50 USES DC3 AS TERMINATOR IN FILES
FOR TURTLE,<CC TISB,0,TISL,TISDC3>
CC TISLIT,0,0,TISM	;TUVW
NOTFOR TURTLE,<CC 0,0,0,TISZ>	;XYZ ALTMODE
FOR TURTLE,<CC TISB,0,0,TISZ>
FOR TEN50,<CC 0,0,0,0>
FOR TENEX,<CC 0,0,0,TISEOL>	;END OF LINE IS 37, LF ALREADY FLUSHED


TISDC3:	TLNE	F,GETF	;COMING FROM A FILE?
	JRST	TISEOL	;YES, OK
	JRST	TISF
TISD:
FOR TEN50,<	TTCALL 11,>	;FLUSH ALL INPUT
FOR TENEX,<	MOVEI	A,100
	CFIBF>
	MOVEI	B,[ASCIZ "
MEANINGLESS CHARACTER"]
TISA:	PUSHJ	P,TOSS
	PUSHJ	P,CRLF
TISR1:
	TLZE	F,EDITF
	POP	S,A	;CLEAN UP THE PUSH-DOWN LISTS
	POPJ	P,	;GIVE R1

TISG:	MOVEI	C," "	;CONTROL B
	TLNN	F,GETF	;NO ECHO IF FROM FILE
	PUSHJ	P,TYO	;TYPE BACK A SPACE
	MOVEI	C,002	;AND PUT CONTROL B IN BUFFER
	JRST	TISF

TISH:	TLNN	F,GETF
	PUSHJ	P,PTAB		;IF NOT IN A FILE, ECHO SPACES
	MOVEI	C,011
	JRST	TISF


TISLIT:	TLNN	F,GETF	;DOING A GET?
	JRST	TISF	;NO, ^T NOT LEGAL FROM TERMINAL
TISLT1:	IDPB	C,B	;COPY TEXT BETWEEN ^T'S LITERALLY, NO INTERP
	PUSHJ	P,TYI
FOR DRIBBLE,<PUSH	P,A
	EXCH	C,B
	SKIPE	A,DRIBFL
	BOUT
	EXCH	C,B
	POP	P,A >
	CAIE	C,024	;LOOKING FOR MATCHING ^T
	JRST	TISLT1	;NOT FOUND
	JRST	TISF	;BACK TO NORMAL READING
TISI:	TLNE	F,GETF
	JRST	TISF		;COMING FROM FILE, LET IT THRU
	TLNE	F,EDITF
	PUSHJ	P,TYO
	PUSH	P,B
	MOVEI	B,[BYTE (7) 15,40,40,0]
	PUSHJ	P,TOSS
	POP	P,B
	MOVEI	C," "	;AND TREAT LIKE A SPACE
	JRST	TISF

TISZ:	PUSHJ	P,CRLF
	JRST	TISEOL
TISJ:	SETZM	CHARNO
	TLNE	F,EDITF		;WE MUST ECHO THE CR IF EDITING
	PUSHJ	P,TYO
	PUSHJ	P,TYI
	CAIE	C,12		;LINEFEED FOLLOWING CR?
	JRST	TISCR		;NO
	TLNE	F,EDITF		;EDITING?
	PUSHJ	P,TYO		;YES, ECHO IT TOO
TISEOL:	SETZB	C,CHARNO
	IDPB	C,B		;FINISH THIS STRING
	HRLZI	L,(POINT 7,(W),34)
	HRR	L,NEWBOT
	MOVEM	L,LINBOT
	MOVE	B,L		;SAME SRC AND DEST FOR WELL-FORMING

TISEL2:	ILDB	C,B
	JUMPE	C,TISEL3
	CAIL	C,40
	JRST	.-3
	CAIE	C,15
	CAIN	C,12
	JRST	TISEL2		; CR AND LF CAN OCCUR IN LITERALS
	CAIE	C,"G"-100
	CAIN	C,"I"-100
	JRST	TISEL2
	CAIN	C,"L"-100
	JRST	TISEL2
	CAIN	C,"T"-100
	TLNN	F,GETF
	JRST	TISD
	JRST	TISEL2

TISEL3:	MOVE	B,L
	SETZB	D,M		; TERMINATE ON EOL, ABBREVIATION LEVEL 0
	PUSHJ	P,WEFS		;REMOVE EXTRA SPACES
	TLZN	F,EDITF	;CLEAR PDL+EDIT FLAG
	JRST	CPOPJ1
	POP	S,-1(S)
	MOVNI	A,1
	GETLCH	A
	TLZ	A,(1B15)	;TURN ECHOING BACK ON UNLESS LOCAL COPY
	SETLCH	A
	MOVE	A,TERMIO
	EXCH	A,CHIN		;RESTORE LINE-AT-A-TIME INPUT
	CAME	A,[INCHRW C]	;IF IT HAS BEEN CHANGED TO THIS
	MOVEM	A,CHIN		;OTHERWISE QUIT
CPOPJ1:	AOS	0(P)
CPOPJ:	POPJ	P,


TISCR:	MOVEI	A,15	;CR
	IDPB	A,B		;PUT IT INTO THE TEXT
	JRST	TISB1		;TREAT THE CHAR AFTER CR FOR WHAT IT IS

TISK:	TLNN	F,EDITF	;TYPE NEXT WORD IN EDIT MODE
	JRST	TISF	;NOT IN EDIT MODE
	PUSHJ	P,TEDIT	;COPY NEXT WORD TO TT AND BUFFER
	JRST	TISB

TISL:	TLNN	F,EDITF	;TYPE REST OF LINE IN EDIT MODE
	JRST	TISF	;NOT IN EDIT MODE
	PUSHJ	P,TEDIT
	TLNN	F,LDONF
	JRST	.-2
	JRST	TISB

TEDIT:	TLNE	F,LDONF	;IF LINE DONE JUST EXIT
	POPJ	P,
	PUSH	P,A	;SAVE POINTERS
	PUSH	P,B	;NO GARBAGE COLLECTION POSSIBLE
	PUSHJ	P,PWORD	;PRINT WORD
	POP	P,B
	POP	P,L
TEDITA:	CAMN	A,L	;HAVE WE CAUGHT UP?
	POPJ	P,
	ILDB	C,L	;COPY THE NEXT CHAR INTO THE INPUT STRING
	JUMPE	C,TEDITB	;IS IT A NULL
	IDPB	C,B
	JRST	TEDITA

TEDITB:	TLO	F,LDONF	;SET LINE DONE FLAG
	POPJ	P,	;AND EXIT
TBACK:	CAMN	B,NEWBOT	;ARE WE AT BEGINNING
	JRST	TISB	;OFF BEGINNING OF STRING
	UNDEX	B
	JRST	2,@D

TISO:	MOVEI	C,134
	PUSHJ	P,TYO

TISN:	JSP	D,TBACK	;BACK UP ONE CHARACTER
	JRST	TISB

TISMA:	JSP	D,TBACK	;REMOVE ONE MORE CHARACTER
	MOVEI	C,134	;TYPE BACKSLASH
	PUSHJ	P,TYO
TISM:	CAMN	B,NEWBOT	;IS THERE A PREVIOUS CHAR
	JRST	TISB	;NO-SO QUIT
	LDB	C,B	;YES-REMOVE LEADINGS SPACES
	CAIN	C," "
	JRST	TISMA
TISMB:	CAMN	B,NEWBOT	;REMOVE NON-SPACES TIL A SPACE
	JRST	TISB	;OFF BEGINNING OF LINE SO QUIT
	LDB	C,B
	CAIN	C," "
	JRST	TISB
	JSP	D,TBACK
	MOVEI	C,134	;TYPE A BACKSLASH WHEN CHARACTERS REMOVED
	PUSHJ	P,TYO
	JRST	TISMB

;PRINT WORD
;ENTER WITH BYTE POINTER TO WORK-SPACE IN A
;PRINT WORD AND FOLLOWING SPACE IF EXISTS
;TYO UPDATES CHARNO AND TAKES INPUT IN C

PWORDH:	PUSHJ	P,TYO	;JUST THE CR, NO LF
PWORD:	MOVEI	D,0	;INITIALIZE COUNT OF PRINTING CHARACTERS
	MOVE	B,A	;COPY POINTER
	TRNE	F,PREFIX	;MUST WE PREFIX " OR / TO THIS WORD?
	MOVEI	D,1	;YES, COUNT THE EXTRA CHAR
PWORDB:	ILDB	C,B	;COUNT PRINTING CHARACTERS
	CAIE	C,002	;CONTROL-B IS A SPACING CHARACTER
	CAILE	C," "
	AOJA	D,PWORDB
	CAIE	C,015	;STOP IF CR
	CAIN	C," "	;OR END OF WORD
	JRST	PWORDA
	JUMPN	C,PWORDB	;CONTINUE ON NOT NULL
	TRNE	F,SUFFIX	;MUST WE SUFFIX " OR / TO END OF THIS STRING?
	MOVEI	D,1(D)	;YES, COUNT THE EXTRA CHAR AT END
PWORDA:	TLNE	F,SAVEF	;WHEN SAVING
	JRST	PWORDS		;THE WORD ALWAYS FITS ON A LINE
	MOVEI	C,^D72
	SUBI	C,(D)
	CAMGE	C,BCHAR
	JRST	PWORDC	;YES
	CAMGE	C,CHARNO	;COUNT+CHARNO .GTR. 72.?
	PUSHJ	P,LINE	;YES-CRLF AND SPACE TO BCHAR
PWORDS:	MOVEI	C,(E)	;PUT PREFIX IN C
	TRZE	F,PREFIX	;SHOULD WE TYPE A PREFIX?
PWORDE:	PUSHJ	P,TYO	;YES
	ILDB	C,A	;OTHERWISE PRINT WORD
	CAME	A,B	;HAVE WE CAUGHT UP
	JRST	PWORDE	;NO

PWORDF:	LDB	C,A	;WHAT WAS THE TERMINATING CHARACTER
	JUMPE	C,PWORDX
	CAIN	C,015
	JRST	PWORDH	;CR- HANDLE REST OF WORD JUST LIKE WORD
	CAIN	C," "
	JRST	PWORDD	;SPACE
	PUSHJ	P,LINE	;OTHER-MEANS WE ARE AT END OF LINE BUT NOT OWRD
	JRST	PWORD	;AND GO PROCESS REST AS WORD

PWORDX:	MOVEI	C,(E)	;AT EOM
	TRZE	F,SUFFIX	;MUST WE AFFIX A SUFFIX?
	PUSHJ	P,TYO	;YES, TYPE IT
	POPJ	P,

PWORDC:	MOVE	D,BCHAR	;IF BCHAR .NE. CHARNO CRLF AND SPACE
	CAMLE	D,CHARNO
	PUSHJ	P,LINE
	MOVEI	C,(E)
	TRZE	F,PREFIX
	PUSHJ	P,TYO
PWORDG:	MOVEI	C,110	;PRINT TILL CHARNO=72.
	CAMN	C,CHARNO
	JRST	PWORDF
	ILDB	C,A
	PUSHJ	P,TYO
	JRST	PWORDG

PWORDD:	MOVEI	C,110	;TYPE SPACE IF CHARNO .NE. 72.
	CAMN	C,CHARNO	;TYPE CRLF AND SPACES IF CHARNO=72.
	JRST	LINE
	MOVEI	C," "
	JRST	TYO


PTYO:	MOVEI	C,^D72
	CAMN	C,CHARNO
	PUSHJ	P,LINE
	MOVEI	C,(B)
	JRST	TYO

PSPACE:	PUSH	P,B
	MOVEI	B," "
	PUSHJ	P,PTYO
	POP	P,B
	POPJ	P,

PTAB:	HRRZ	B,CHARNO
	IDIVI	B,11		;TAB STOPS ARE NINE APART
	SUBI	C,11
	MOVE	B,C
	PUSHJ	P,PSPACE
	AOJL	B,.-1
	POPJ	P,

LINE:
	SETZM	CHARNO
	TLNE	F,SAVEF
	PJRST	PSPACE
	PUSHJ	P,CRLF	;TYPE CRLF AND SPACES USING C
INDENT:	MOVE	C,BCHAR
	CAMN	C,CHARNO
	POPJ	P,
	CAMG	C,CHARNO
	JRST	INDENT-1	;BCHAR .LT. CHARNO
	MOVEI	C," "
	PUSHJ	P,TYO
	JRST	INDENT

CRLF:	TLNN	F,SAVEF
	SETZM CHARNO
	MOVEI	C,015
	PUSHJ	P,TYO
	MOVEI	C,012
	JRST	TYO

REQUEST:	TLO	F,RQF
	MOVEI	B,[ASCIZ /*/]
	SKIPE	CHARNO	;AT LEFT MARGIN?
	MOVEI	B,[EXP 0]	;NO, DON'T TYPE ANYTHING
	PUSHJ	P,TIS
	JRST	REQUEST
	TLZ	F,RQF
	POPJ	P,

FOR TENEX,<
XBOUT:	PUSH	P,A
	EXCH	B,C
	MOVEI	A,101
	BOUT
	EXCH	B,C
	POP	P,A
	POPJ	P,

XBIN:	PUSH	P,A
	MOVE	C,B
	MOVEI	A,100 
	BIN
	EXCH	C,B
	POP	P,A
	POPJ	P,  >

FOR TENEX,<
ASK:	POP	S,L
	PUSHJ	P,DNM
	 ERROR	ZERERR
	 ERROR	.		; TOO LONG A TIME TO WAIT
	MOVEI	C,"*"
	SKIPN	CHARNO		;AT LEFT MARGIN?
	PUSHJ	P,TYO		;YES

	MOVE	A,[XWD 15,1]
	ATI			;CR TO CH1 FOR ASK
	MOVE	A,[XWD 33,2]
	ATI			;ALT MODE TO CH 2 FOR ASK
	MOVE	A,[XWD 34,3]
	ATI			;RUBOUT TO CH 3 FOR ASK
	MOVEI	A,100
	RFMOD
	ANDCMI	B,6000
	IORI	B,2000		;CHANGE ECHO MODE TO IMMEDIATE
	SFMOD
	HRLZI	A,400000
	HRLZI	B,340000
	AIC	;ACTIVATE INTERRUPT CHANNELS FOR CR,ALTMODE, AND RUBOUT
	MOVEI	A,^D1000
	IMULI	A,(M)
	DISMS			;IN MILLISECONDS
	MOVEI	A,100
	CFIBF			;INCOMPLETE, FLUSH ALL OF IT

ASK1:	MOVEI	A,15		;CR
	DTI			;DEASSIGN TERMINAL INTERRUPT
	MOVEI	A,33		;EOM
	DTI
	MOVEI	A,34		;RUBOUT
	DTI
	HRLZI	A,400000
	HRLZI	B,340000
	DIC			;DEACTIVATE ASK CHANNELS
	MOVEI	A,100		;TERMINAL JFN
	RFMOD
	XORI	B,6000
	SFMOD
	MOVEI	B,37
	STI			;EOM FOR TIS
	MOVEI	B,[EXP 0]
	PUSHJ	P,TIS
	 ERROR	IOPERR
	POPJ	P,

ASKEOL:	MOVEI	A,ASK1
	MOVEM	A,LEVLTB+2
	DEBRK

ASKRUB:	MOVEI	A,100
	CFIBF
	MOVEI	B,[BYTE (7) 15,177,43,0]
	PUSHJ	P,TOSS
	PUSHJ	P,CRLF
	MOVEI	C,"*"
	PUSHJ	P,TYO
	DEBRK		>	;CONTINUE WAITING

TYO:
FOR NRCTUR,<
NOTFOR PLSTUR,<
	TRZN	F,GRAPHF	;IS TERMINAL IN GRAPHICS MODE?
>
FOR PLSTUR,<
	TRNN	F,GRAPHF	;is terminal in GRAPHICS MODE?
>
	JRST	TYO0		;NO - PROCEED TO TYPE OUT CHARACTER
	PUSH	P,C		;YES, SAVE CHARACTER
FOR PLSTUR,<

	MOVEI	C,CNTRLB	;RESET CURSOR TO LOWER LEFT
	PUSHJ	P,TYO0		;OF THE PLASMA SCREEN
	MOVEI	C,PCHAR		;
	PUSHJ	P,TYO0
	MOVEI	C,HIXOFS
	PUSHJ	P,TYO0
	MOVEI	C,LOXOFS
	PUSHJ	P,TYO0
	MOVEI	C,HIYOFS
	PUSHJ	P,TYO0
	MOVEI	C,LOYOFS
	PUSHJ	P,TYO0
	TRZ	F,GRAPHF	;TURN OFF GRAPHICS FLAG
>
	MOVEI	C,GRFOFF	;AND TURN OFF GRAPHICS MODE
	PUSHJ	P,TYO0
	POP	P,C		;RESTORE ORIGINAL CHARACTER
	SETZM	CHARNO		;RESET HORIZONTAL POSITION (SAFEST THING TO DO)
>
TYO0:	TLNE	F,NOBREAK
	JRST	.+3
	TLZE F,BREAKF
	 ERROR	BREAK
	TLNE	F,SAVEF	;GOING TO A FILE?
	JRST	TYO2	;YES, LET TAB AND ^B THROUGH UNTRANSLATED
	CAIE	C,11	;IS IT TAB
	JRST	TYO1	;NO
	PUSH	P,B
	PUSHJ	P,PTAB
	POP	P,B
	POPJ	P,

NOTFOR PLSTUR,<
TYO1:	TLNE	F,TOF	; # GET CONVERTED ONLY ON PRINT OR TYPE
	CAIE C,"#"	;MULTIPLE SPACE CHAR
	CAIN	C,002
TYOSPC:	MOVEI	C,40		;SUBSTITUTE SPACE FOR CONTROL-B
>
FOR PLSTUR,<
TYO1:	TLNN	F,TOF		; # GETS CONVERTED ONLY ON PRINT OR TYPE
	JRST	TYO1A		;
	CAIN	C,"#"		;A # ?
	JRST	TYOSPC		;YES, INSERT A BLANK
TYO1A:	CAIE	C,CNTRLB	;A CONTROL-B??
	JRST	TYO2		;NO
	TRNN	F,GRAPHF	;YES, IS THE GRAPHICS MODE ON?
TYOSPC:	MOVEI	C,40		;NO, SUBSTITUTE BLANK FOR ^B OR #
>
TYO2:	TLNN	F,TOF
	JRST	.+3
	CAIN	C,015	;IS THE CHAR CR
	XCT	CHOUT	;YES, TYPE TWICE, NOT THE BEST WAY TO GET TIMING ON CR ALONE
	XCT	CHOUT
	CAIN	C,177
	JRST	.+3	;RUBOUTS DON'T COUNT
	CAIL	C," "	;IS IT A PRINTING CHARACTER
	AOS	CHARNO
	CAIN	C,015	;CR-CLEAR CHARNO
	SETZM	CHARNO
	POPJ	P,

TYI:	TLO	F,TIF	;SET TYPEIN FLAG
	TLNE	F,NOBREAK
	JRST	.+3
	TLZE F,BREAKF
	 ERROR	BREAK
	XCT	CHIN		;GET A CHARACTER
	TLZ	F,TIF
	POPJ	P,

PTOSSM:	HRLI	A,440700	;FOR MACHINE STRINGS
	JRST	PTOS
PTOSS:	HRLI	A,(POINT 7,(W),34)	;FOR GENERATED STRINGS
PTOS:	PUSHJ	P,PWORD
	LDB	C,A
	JUMPN	C,.-2
	POPJ	P,

TOSW:	HRLI	B,(POINT 7,(W),34)
	JRST	TOS
TOSS:	HRLI	B,440700
TOS:	ILDB	C,B	;BYTE POINTER IN B USE C
	JUMPE	C,CPOPJ
	PUSHJ	P,TYO
	JRST	TOS

NUMBRQ:	TLNE	A,EMPTYF	;IS IT EMPTY?
	JRST	CPOPJ	;YES
	TRZ	F,TF
	HRLI	A,(POINT 7,(W),34)

	ILDB	C,A
	JUMPE	C,CPOPJ	;EMPTY
	CAIE	C,"+"
	CAIN	C,"-"
NMBRQ1:	ILDB	C,A
	JUMPE	C,NMBRQ2
	TRO	F,TF	;HAVE SEEN A CHARACTER
	CAIL	C,"0"
	CAILE	C,"9"
	POPJ	P,	;NOT A DIGIT, FAIL
	JRST	NMBRQ1

NMBRQ2:	TRZE	F,TF	;ALL THE CHARS WE SAW WERE DIGITS, BUT WERE THERE ANY
	AOS	0(P)	;SAW SOME DIGITS
	POPJ	P,	;SAW NO CHARACTERS


PREDIQ:	MOVE	B,@WSA
	ADDI	A,1
	CAIE	B,1	;IS LENGTH OF TEXT 1?
	JRST	PREDQ1	;NO, CANNOT BE "TRUE"
	MOVE	B,@WSA	;GET TEXT OF ONE WORD ELEMENT
	CAME	B,[ASCIZ /TRUE/]
	POPJ	P,	;NOT "TRUE"
	JRST	CPOPJ1	;IS "TRUE"
PREDQ1:	CAIE	B,2	;FALSE MUST BE TWO WORDS LONG
	POPJ	P,	;NOT "FALSE"
	MOVE	B,@WSA
	ADDI	A,1
	CAMN	B,[ASCII /FALSE/]
	SKIPE	@WSA	;NEXT WORD MUST BE 0 TERMINATOR FOR "FALSE"
	POPJ	P,	;R1, IS NOT "FALSE"
	JRST	CPOPJ1	;R2


NUMRQS:	MOVE	A,(S)	;NUMBERS?
	PUSHJ	P,NUMBRQ
	 ERROR	SUMERR
	MOVE	A,-1(S)
	PUSHJ	P,NUMBRQ
	 ERROR	SUMERR
	POPJ	P,


DNMO:	MOVEI R,10
	JRST DNM0
DNM:	HRLI	L,(POINT 7,(W),34)	;ALL CALLS USE A COMPLETE STRING
	MOVEI	R,12
DNM0:	MOVEI	M,0
	TRZ	F,NNUMF
	JFCL	17,.+1
	TRNN	F,PMF		;ARE + AND - PERMITTED IN THE STRING?
	JRST 	DNM1		; NO
	ILDB	C,L
	CAIN	C,"-"
	JRST	DNM1
	TRZ	F,PMF
	CAIN	C,"+"
DNM1:	ILDB	C,L
	CAIL	C,"0"
	CAILE	C,"0"-1(R)
	JRST	DNM2
	TRO	F,NNUMF
	IMULI	M,(R)
	ADDI	M,-60(C)
	JRST	DNM1
DNM2:	TRNN	F,NNUMF
	POPJ	P,
	TRZE	F,PMF
	MOVNS	M
	AOS	(P)
	JOV	CPOPJ
	JRST	CPOPJ1

DECPRT:	SKIPA	R,[EXP 12]
OCTPRT:	MOVEI	R,10
ANYPRT:	IDIV	A,R
	HRLM	B,(P)
	SKIPE	A
	PUSHJ	P,ANYPRT
	HLRZ	C,(P)
	ADDI	C,"0"
	JRST	TYO

SNM:	PUSHJ	P,NEWSTR
SNM0:	SETZM	SRCBOT
SNMA:	IDIVI	M,12
	HRLM	N,(P)
	SKIPE	M
	PUSHJ	P,SNMA
	HLRZ	C,(P)
	ADDI	C,"0"
	IDPB	C,B
	POPJ	P,

COPYAB:	ILDB	C,A
	IDPB	C,B
	JUMPN	C,.-2
	POPJ	P,

SWITCH:	MOVE	A,(S)
	EXCH	A,-1(S)
	MOVEM	A,(S)
	POPJ	P,


;MAKE AN ARBITRARY SIZED WORKSPACE ELEMENT
; ENTER WITH LENGTH IN A
; RETURN WITH PTR TO LENGTH WORD IN B

MAKELM:	PUSHJ	P,NEWSTR	; GENERATING A STRING
	SETZM	SRCBOT		; WITH NO SOURCE
TRPAD1:	MOVEM	A,@B		; SET UP LENGTH WORD
	ADD	B,A		; POINT B AT LAST DATA WORD
TRPAD2:	MOVEM	@B		; REFERENCE IT TO CAUSE ILL MEM REF
	SETZM	@B		; NOW MAKE IT ZERO
	MOVEM	B,WTOP		; GET HERE AFTER GC AND EXPAND WS
	SUB	B,A		; PROMISED THAT B POINT AT FIRST
	POPJ	P,


;COPY CONTENTS OF AN ELEMENT TO A NEW AND LARGER ONE
; ENTER WITH LENGTH INCREMENT IN A
; AND PTR TO OLD ELEMENT IN B
;RETURN PTR TO NEW ELEMENT IN B
; AND PTR TO OLD END IN NEW ELEMENT IN A

COPYUP:	PUSH	S,B		; SAVE OLD GUY
	ADD	A,@WSB		; NEW LENGTH
	PUSHJ	P,MAKELM	; MAKE IT
	POP	S,A
	HRLZI	C,@WSA		; FROM
	HRRI	C,@WSB		; TO
	AOBJN	C,.+1		; BUT SKIP THE WORD COUNT
	MOVE	A,@WSA		; OLD LENGTH
	ADD	A,B		; NEW BASE
	BLT	C,@WSA		; ENDING AT END OF OLD DATA
	POPJ	P,

;NEWOPS IS CALLED BY FIRST,LAST,BUTFIRST, AND BUTLAST
;ALL HAPPEN TO DO THE SAME THING

;NEWSTR IS USED BY ANYONE WHO GENERATES A NEW STRING

NEWOPS:	MOVE	A,0(S)	;GET ARG OFF S STACK WITHOUT DESTROYING IT
	TLNE	A,EMPTYF	;IS IT AN EMPTY STRING
	JRST	APOPJ		;YES EXIT FROM CALLING ROUTINE
	TLNE	A,WORDF
	AOS	0(P)	;SKIP JUMP TO SENT IF A WORD
	HRLI	A,(POINT 7,(W),34)	;IN ANY CASE, MAKE A STRING PTR
	MOVEM	A,SRCBOT
NEWSTR:	HRRZ	B,WTOP
	ADD	B,[POINT 7,1(W),34]	;MUST BE EXACTLY THIS FOR TEST IN TBACK TO WORK
	MOVEM	B,NEWBOT
	POPJ	P,



;NEWSRC SETS UP A NEW SOURCE STRING FROM THE FIRST ARG ON THE PDL
;NEWSR1 DOES THE SAME FOR THE SECOND ARG BACK

NEWSR1:	SKIPA	A,-1(S)
NEWSRC:	MOVE	A,0(S)
NEWSR0:	HRLI	A,(POINT 7,(W),34)
	MOVEM	A,SRCBOT
	POPJ	P,


GNE:	AOS	A,CPP		;GET NEXT NON-COMMENT ELEMENT
	MOVE	A,@WSA
	JUMPE	A,CPOPJ		;END OF LINE, R1
	TLNE	A,COMMTF	;IS IT COMMENT
	JRST	GNE		;YES, SKIP IT
	JRST	CPOPJ1

ENDSTP:	POP	S,C	;FLUSH OLD INPUT FIRST BEFORE
ENDSTR:	MOVEI	C,0	;FINISH UP THE NEW STRING
	IDPB	C,B
ENDST1:	TLNE	B,760000
	JRST	.-2
	MOVEM	B,WTOP
	SUB	B,NEWBOT
	HRRZM	B,@NEWBOT
	HRLZI	B,WORDF
	HRR	B,NEWBOT
	TRZE	F,NWF
	TLC	B,WORDF!SENTF
	PUSH	S,B
	POPJ	P, 
SUBTTL	GARBAGE COLLECTOR AND STORAGE ALLOCATION ROUTINES

;THE NEXT SECTION (10-11 PAGES) CONTAINS STORAGE ALLOCATION
;AND GARBAGE COLLECTION ROUTINES FOR THE VARIOUS SPACES

;MOVE A PROCEDURE TO THE END OF THE PROCEDURE SPACE

MOVEPR:	SETOM	NXLINE	;POINTER INTO PS NO LONGER VALID
	HRRZ	D,@RPA	; A CONTAINS A PRODNM
	MOVEI	B,(D)	;B AND D HAVE REL PTR TO BEGINNING OF DIRECTORY

	MOVEI	D,2(D)	;TWO WORDS PER LINE IN PROCEDURE DIRECTORY
	SKIPE	@PSD	;LINE NO=0?
	JRST	.-2	;NO, NEXT LINE

	MOVEI	D,1(D)
	HRRZ	C,PTOP
	CAIL	D,(C)
	POPJ	P,	;ALREADY THE LAST ONE IN THE SPACE

	SUBI	D,(B)	;D IS NOW THE LENGTH OF THE PROCEDURE
	ADDI	C,@PSD
	CAML	C,PS+1
	EXPAND	D,PS

	HRRZ	E,PTOP
	HRRM	E,@RPA
	HRLI	E,(B)
	MOVE	C,PS
	HRLI	C,(C)
	ADDB	E,C
	MOVE	G,E
	HRLI	D,(D)
	ADD	G,D
	BLT	C,-1(G)
	HLR	G,E
	BLT	G,-1(E)

	MOVEI	A,0	;SEARCH RP FOR ALL THAT POINT AFTER MOVED DIR.
	MOVNI	D,(D)
MPRL:	SKIPN	@RPA
	POPJ	P,	;DONE
	MOVEI	A,1(A)
	HRRZ	C,@RPA
	CAIN	C,-1	;IS THIS ONE DEFINED?
	AOJA	A,MPRL	;NO, DON'T OFFSET IT
	CAIL	C,(B)	;B CONTAINS PTR TO OLD BEG OF MOVED PROC
	ADDM	D,@RPA	;OFFSET IT BY AMOUNT MOVED DOWN
	AOJA	A,MPRL
;GARBAGE COLLECTOR PASS ONE
;SEARCH ALL LISTS AND THINGS, REPLACING START OF ALL GOOD STRINGS

GARCOL:	MOVE	S,UUOACS+S
	SETZM	1(S)	;ALWAYS ROOM FOR ONE ZERO AFTER S LIST, BECAUSE
			; CS ALWAYS STARTS AT ONE
	TLZ	F,GCF	;INDICATE THAT GC WAS DONE FOR THIS K
	MOVEI	N,.WTOP-.WBASE	;BOTTOM OF FLUSHABLE STRINGS

	MOVE	B,VP
	JSP	S,GCMARK
	MOVN	B,DTOP
	HRLZI	B,(B)
	HRR	B,DP
	ADDI	B,1
	ADD	B,[XWD 2,2]
	JUMPGE	B,.+3
	JSP	L,MARKNEW
	JRST	.-3

	MOVE	B,SP
	MOVEI	B,1(B)	;STACKS SKIP THE FIRST CELL
	JSP	S,GCMARK
	MOVE	B,UA
	JSP	S,GCMARK	;USER ABBREVIATIONS ALSO

	HRLZI	A,GCSTAB-GCSTOP	;A TABLE OF PAIRS, LIKE LINBOT,UUOACS+L
GARC01:	MOVE	C,GCSTAB(A)
	HLRZ	B,C
	SKIPE	B		;IF ZERO, SAME AS PREVIOUS
	MOVN	E,(B)		;LIKE MOVN E,LINBOT
	ADDM	E,(C)		;LIKE ADDM E,UUOACS+L , TO OFFSET AC
	AOBJN	A,GARC01		;BACK FOR THE REST OF THE FUNNIES

	HRLZI	A,GCSTAB-GCSTOP
GARC02:	HLRZ	B,GCSTAB(A)
	JUMPE	B,GARC03	;SOMETHING ELSE TO MARK?
	SKIPE	(B)		;MAYBE, SEE IF NON-ZERO
	JSP	L,MARKNEW	;YES, MARK IT
GARC03:	AOBJN	A,GARC02

	MOVE	A,RP	;MARK PROCEDURES
GCMKP1:	MOVE	B,(A)	;PTR TO PROCEDURE NAME
	JUMPE	B,GCPSS2
	MOVEI	B,(A)
	JSP	L,MARKNEW	;MARK THE NAME

	MOVEI	A,1(A)		; POINT AT PTR TO DIRECTORY
	MOVE	M,(A)		; POSITION IN PS
	CAMN	M,[-1]		; IS THE PROCEDURE DEFINED?
	AOJA	A,GCMKP1	; NO, NOTHING TO COLLECT
	ADD	M,PS		; MAKE PTR ABSOLUTE
GCMKP2:	MOVEI	B,1(M)		; B NOW POINTS TO HEAD OF COMPOUND 
	JSP	L,MARKNEW
	MOVEI	M,2(M)		; NEXT LINE
	SKIPE	(M)		; IS IT END OF PROCEDURE?
	JRST	GCMKP2
	AOJA	A,GCMKP1	; YES, TRY NEXT PROCEDURE


GCMARK:	SKIPN	(B)
	JRST	(S)
	JSP	L,MARKNEW
	AOJA	B,GCMARK


;MARK MIXED LISTS
;B CONTAINS PTR TO HEAD
;C=0 IS THE END CONDITION

MARKNEW:
	SETZ	C,
MARKN0:	MOVE	D,(B)		; GET POINTER TO BE CHASED
	TLNN	D,IMMEDIATE	; IF TRUE, IT IS NOT A POINTER
	CAILE	N,(D)		; OR ONE OF THE PERMANENT STRINGS
	JRST	MARKN1		; DO PREVIOUS ONE IN THIS LIST

	ADDI	D,(W)		; MAKE RELATIVE PTR ABSOLUTE
	HLRZ	E,(D)		; GET HEAD OF BACKCHAIN
	HRLM	B,(D)		; AND MAKE BACKCHAIN POINT AT THIS PTR
	TLNE	D,COMPOUND	; IS IT ALSO A MIXED LIST?
	JUMPE	E,MARKN2	; AND NOT PREVIOUSLY CHASED
	HRRM	E,(B)		; NO TO EITHER, JUST FINISH BACKCHAIN

MARKN1:	JUMPE	C,(L)		; END OF TOP LEVEL?
	SUBI	B,1		; NO, DO PREVIOUS ONE ON THIS LEVEL
	SOJG	C,MARKN0	; IF NOT DONE WITH THIS LEVEL

	HLRZ	C,(B)		; GET HEAD OF BACKCHAIN,TAIL AT PREV LEV
	MOVE	B,C
	MOVE	C,(B)		; FETCH POSSIBLE COUNT
	TLZN	C,IMMEDIATE	; IS IT END OF BACKCHAIN?
	JRST	.-3		; NO, TRACE CHAIN SOME MORE

	HLLZM	C,(B)		; COMPLETE BACKCHAIN FOR PASS TWO
	MOVEI	C,(C)		; MAKE IT 0,,COUNT
	JRST	MARKN1		; AND GO BACK FOR MORE ON POPPED LEVEL

MARKN2:	HLL	C,D		; PUSH DOWN A LEVEL AND CHASE IT
	TLO	C,IMMEDIATE	; SO THE POP CAN BE UNAMBIGUOUS
	MOVEM	C,(B)		; THAT'S WHERE THE COUNT IS STORED
	MOVE	B,D		; POINT TO HEADER WORD NEXT LEVEL DOWN
	HRRZ	C,(B)		; GET THE COUNT FOR THIS LEV
	ADD	B,C		; START CHASING AT BACK END OF OBJ
	JRST	MARKN0		; AND START OVER

;GARBAGE COLLECTOR PASS TWO

GCPSS2:	MOVEI	R,GCPS2R	; PASS TWO SUBR TO CHASE BACKCHAINS
	JSP	L,GCPS2S
	MOVEI	R,GCPS3R	; PASS THREE SUBR TO COMPRESS
	JSP	L,GCPS2S
GCPS2C:	SUBI	E,@WSB	;MAKE E THE AMOUNT COLLECTED
	MOVNI	G,(E)		;USE G TO OFFSET WTOP,ETC
	HRRM	B,NEWBOT	;B IS THE RELATIVE DEST FOR THE STRING
	ADDM	G,UUOACS+B
	ADDM	G,WTOP

	HRRZ	D,JOBREL
	SUBI	D,(E)
	HRLI	B,(A)
	ADDI	B,(W)
	CAMG	A,JOBREL	;DON'T GET CAUGHT WITH ILL MEM REF
	BLT	B,(D)

GCPS2D:	MOVE	A,JOBREL
	SUBI	A,@UUOACS+B
FOR TENEX,< CAMG A,INCREMENT >
FOR TEN50,< CAIG A,2000 >
	JRST	GCPSS3
	MOVEI	A,@UUOACS+B
FOR TEN50,<	CORE	A,
	 HALT>
FOR TENEX,<	JSP	E,SETMEM>

GCPSS3:	MOVEI	D,2(D)
	CAMLE	D,JOBREL
	JRST	GCPS3B		;AVOID DOING BLT ON FULL ALLOCATION
	SETZM	-1(D)
	HRLI	D,-1(D)
	BLT	D,@JOBREL

GCPS3B:	HRLZI	A,GCSTAB-GCSTOP	;UNDO THE CRAZIES
GCPS3C:	MOVE	C,GCSTAB(A)
	HLRZ	B,C
	SKIPE	B
	MOVE	G,(B)
	ADDM	G,(C)
	AOBJN	A,GCPS3C
	JRST	(P)


GCPS2S:	HRRZ	E,NEWBOT
	HRRZ	B,WTOP
	CAIG	E,(B)
	MOVEI	E,1(B)	;WTOP .GTR. NEWBOT, I.E. NO STRING IN PROGRESS
	ADDI	E,(W)	;FOR END TEST, QUIT BEFORE NEW STRING
	MOVEI	A,.WTOP-.WBASE(W)	;SOURCE IS ABSOLUTE
	MOVEI	B,.WTOP-.WBASE	;DESTINATION IS RELATIVE
GCPS2A:	CAIL	A,(E)	;IS THE NEXT STRING THE UNFINISHED ONE?
	JRST	GCPS2E	;YES, ALMOST DONE WITH THIS PASS
GCPS2F:	MOVE	C,(A)	;GET THE LENGTH WORD
	TLNE	C,-1	;DOES IT HAVE A BACK CHAIN POINTER, IE MARKED?
	JSP	S,(R)	; YES, CHASE OR COMPRESS
GCPS2B:	ADDI	A,1(C)	;NEXT SOURCE
	JRST	GCPS2A

GCPS2E:	CAIN	A,(E)		;IS THIS THE UNFINISHED STRING?
	CAMLE	A,JOBREL	;IF SO ARE WE STILL WITHIN THE BOUNDS OF CORE?
	JRST	(L)		;NO WE'RE ALREADY DONE
	CAIE	R,GCPS3R	;SKIP IF THIRD PASS
	JRST	GCPS2F		;SECOND PASS DO BACKCHAIN STUFF IF RELEVANT
	HRRZS	(A)		;ON THIRD PASS CLEAR BACKCHAIN POINTER
	JRST	(L)

GCPS2R:	HLRZ	D,C	;TRACE THE BACK CHAIN
	HRRZ	G,(D)
	HRRM	B,(D)	;REPLACE BACK CHAIN POINTER WITH NEW RELATIVE POINTER
	MOVEI	D,(G)	;PUT THE NEW BACK PTR IN D
	JUMPN	D,.-3	;THE CHAIN CONTINUES
	ADDI	B,1(C)	; AND POINT TO NEXT OBJ
	JRST	(S)

GCPS3R:	HRRZM	C,(A)	;CLEAR THE BACK CHAIN POINTER IN LENGTH WORD
	HRLZI	G,(A)	;BLT SOURCE
	HRRI	G,@WSB	;BLT DEST, MAKING IT ABSOLUTE
	ADDI	B,(C)	;DEST+LENGTH=END OF BLT
	BLT	G,@WSB	;MOVE IT
	ADDI	B,1	;MAKE B POINT BEYOND END OF THIS STR, AT BEG OF NEXT
	JRST	(S)

GCSTAB:	XWD LINBOT,UUOACS+L
	XWD SRCBOT,UUOACS+A
	XWD CBOT,CPP
FOR TEN50,<
	XWD BUFADR,BUFLOC
	XWD 0,FPTR
	XWD BUFADR+1,BUFLOC+1
	XWD 0,FPTR+1
	XWD BUFAD2,BUFLC2
	XWD 0,FPTR2
FOR MUSIC,<
	XWD MBUFP,MBMAX
	XWD 0,MBPOS >
GCSTOP==.

FOR TEN50,<
TRPPC==JOBTPC
ALLOC:	MOVEM	A,SAV.A
	MOVE	A,JOBCNI	; GET REASON FOR TRAP
	TRNE	A,20000	;WAS IT AN ILL MEM REF?
	JRST	ALOCWS	;YES, WORKSPACE SPACE NEEDED
	MOVE	A,SAV.A >

ALLOCP:	JUMPG	S,ALOCSP	;PDL TRAP, WAS IT ARG STACK?
	JUMPL	P,[ERROR .]
	EXPAND	PP	;NO, CONTRO STACK
	HRL	P,ALOCTB+.PP
	TLC	P,-1
	ADD	P,[XWD 1,0]	;MAKE IT TWO'S COMPLEMENT
	JRST	ALOCAL

ALOCSP:	EXPAND	SP
	HRL	S,ALOCTB+.SP
	TLC	S,-1
	ADD	S,[XWD 1,0]
	JRST	ALOCAL

ALOCWS:
FOR TENEX,<TRPPC==LEVLTB+1
	MOVEM	A,SAV.A
	MOVEM	B,SAV.B
	MOVEI	1,400000
	GTRPW			;PAGER TRAP WORD
	MOVEI	2,(1)		; EFFECTIVE ADDR OF LOSING INSTRUCTION
	CAIG	2,(W)	; MAKE SURE IT'S A DATA PAGE
	 ERROR	ILLTRP
	ASH	2,-11
	SETO	1,
	HRLI	2,400000	; FROM THIS FORK
	PMAP			; AND FLUSH IT FOR GOOD MEASURE
	MOVE	B,SAV.B >

	MOVE	A,TRPPC
	TLNE	A,20000		; IS BYTE INTERRUPT ON?
	 JRST [ HRRZM A,SAVEIT	;SAVE ADDRESS OF BYTE INSTRUCTION
		HLLZ A,(A)	;MAKE SURE IT'S A DPB OR IDPB INSTRUCTION
		TLZ  A,1777	;
		CAME A,[IDPB 0,0] ;
		ERROR ILLTRP	;IF NOT ERROR, "IMAT"
		HRRZI A,@NEWBOT	;MUST BE IN PROCESS OF CREATING
		CAIG A,@WTOP	;NEW STRING (I.E. NEWBOT .GT. WTOP)
		ERROR ILLTRP	;IF NOT ERROR, "IMAT"
		MOVE A,@SAVEIT	;ALSO MUST HAVE BEEN ACCESSING THE
		MOVE A,@A	;
		MOVEI A,@A	;
		SOS  A		;WORD ABOVE JOBREL OR TW0 ABOVE JOBREL
		SUB  A,JOBREL	;
		TDNE A,[-2]
		ERROR ILLTRP	;IF NOT THEN ERROR, "IMAT"
		JRST ALCWS1 ]		; A GOOD TRAP
FOR TENKI,<
	MOVE	A,TRPPC
>
NOTFOR TENKI,<
	SOS	A,TRPPC		; PROPER CODE HAS ONLY WRITE TRAPS
>	MOVEI	A,(A)
	CAIE	A,TRPAD1
	CAIN	A,TRPAD2
	JRST	ALCWS1		; THE ONLY LEGAL PLACES FOR TRAPS
	 ERROR	ILLTRP
ALCWS1:	MOVE	A,SAV.A
	EXPAND	WS

FOR TEN50,<
ALOCAL:	MOVEM	A,JOBCNI
	HRRZI	A,220000
	CALLI	A,16	;REENTER TRAPPING MODE
	MOVE	A,JOBCNI
	JRST	2,@JOBTPC >

FOR TENEX,<
ALOCAL:	DEBRK
LEVTAB:	EXP LEVLTB,LEVLTB+1,LEVLTB+2 

EOFEX:	SETZ	B,		; EOF, RETURN 0 BYTE
	DEBRK
DATAEX:	ERROR	. >

ALLOCATOR:
	LDB	C,[POINT 4,JOBUUO,12]	;GET THE AC NUMBER
	HRRZ	A,JOBUUO	;WHICH SPACE IS IT?
	SUBI	A,BASETB	;SUBTRACT OFFSET
	HRRZ	B,ALOCTB(A)	;HOW MUCH SPACE MUST WE ADD NOW?
	JUMPE	C,.+3	;SKIP NEXT TWO IF NO AC SPECIFIED
	CAMGE	B,UUOACS(C)	;IS THE SPECIFIED AMOUNT GREATER THAN THE NORMAK AMOUNT
	MOVE	B,UUOACS(C)	;REQUESTED AMOUNT GREATER THAN NORMAL
	MOVEM	B,GCTEM
	ADDI	B,@WTOP
	CAIN	A,.WS	;IS THE REQUEST FOR MORE WORK SPACE?
	JRST	ALLOC0	;YES
	CAMG	B,JOBREL	;DOES THE REQUESTED AMOUNT FIT
	JRST	ALLOC1	;YES, DON'T ASK FOR MORE

	JSP	G,NEWMEM
	 ERROR	PUNT	;NO MORE CORE AVAILABLE,
	JRST	ALLOC1	;GOT ONE

ALLOC0:	TLOE	F,GCF	;YES, HAVE WE GC'ED THIS 2^N K YET?
	JRST	ALLC01	;NO, GO DO IT
	JSP	G,NEWMEM
	 ERROR	PUNT	;CAN'T GET MORE CORE AND CAN'T SAVE BY GC
	JRST	UUORET	;RETURN

ALLC01:	JSP	P,GARCOL
	HRRZ	A,JOBUUO
	CAIN	A,WS	;WAS IT WORKSPACE CALL?
	JRST	UUORET	;YES, NOW DONE
	MOVE	C,GCTEM
	ADDI	C,@WTOP
	CAMLE	C,JOBREL	;DID THE GC GIVE US ENOUGH ROOM?
	 ERROR	PUNT	;NO

ALLOC1:	HRRZ	A,JOBUUO
	SUBI	A,BASETB	;MAKE A A AN INDEX TO SPACE POINTERS
	MOVE	B,GCTEM
	MOVEI	G,(B)
	HRLI	G,(G)
	MOVE	H,BASETB+1(A)
	HRRZ	C,JOBREL
	HRRZI	D,1(C)
	SUBI	D,(B)
	HRLZI	D,(D)
	HRRI	D,1(C)
	JRST	ALLOC3

ALLOC2:	MOVE	E,D
	BLT	E,(C)
	SUBI	C,(B)
ALLOC3:	SUB	D,G
	CAIGE	H,(D)
	JRST	ALLOC2

	HRLZI	D,(H)
	HRRI	D,1(H)
	SETZM	(H)
	ADDI	H,(B)
	BLT	D,-1(H)

	MOVEI	A,1(A)
	JSP	D,RPOINT

UUORET:	MOVE	17,[XWD UUOACS+1,1]	;DON'T RESTORE 0
	BLT	17,17
	JRST	2,@UUOTRP


RPOINT:	HLRZ	C,ALOCTB(A)	;POINTER TO LIST OF WORDS TO UPDATE
	ADDM	B,BASETB(A)	;UPDATE THE BASE IN THE BASE TABLE
	JUMPE	C,ALLOC5	;NO SECONDARY BASE POINTERS
	MOVE	E,(C)		;GET AN ADDRESS OF A SECONDARY BASE PTR
	JUMPE	E,ALLOC5	;NO MORE IN THIS LIST
	ADDM	B,(E)		;UPDATE IT
	AOJA	C,.-3
ALLOC5:	CAIE	A,.WS
	AOJA	A,RPOINT	;MORE TO DO IN ALOCTB
	JRST	(D)

FOR TENEX,<

INCREMENT:	10000
BOUND:	200000

SETMEM:	MOVE	3,INCREMENT
	SUBI	3,1
	IOR	3,A
	EXCH	3,JOBREL
	MOVE	2,3
	ASH	2,-11		; PAGE NO
	HRLI	2,400000	; THIS FORK
	SETO	1,		; TO FLUSH IT
	AOJA	2,.+3
	PMAP
	SUBI	3,1000
	CAMLE	3,JOBREL
	SOJA	2,.-3
	JRST	(E)

NEWMEM:	MOVE	C,JOBREL
	ADDI	C,1
	ADD	C,INCREMEMT
	CAML	C,BOUND
	JRST	(G)		; TOO MUCH
	MOVEI	1,400000	; THIS FORK
	MOVEI	2,1B22		; NON- EX PAGE REF
	DIC			; SO WE CAN ADD WITH IMPUNITY
	SUBI	C,1
	MOVEM	C,JOBREL
	SUB	C,INCREM
	SKIP	1(C)
	ADDI	C,1000
	CAME	C,JOBREL
	JRST	.-3
	AIC			; TURN CHANNEL BACK ON
	HRRZ	A,JOBUUO
	JRST	1(G) >

FOR TEN50,<

NEWMEM:	MOVE	A,JOBREL
	ADDI	A,1
	MOVEI	B,(A)		;FIRST ADDR OF NEW K IN A AND B
	CORE	A,
	 JRST	(G)		;NONE AVAILABLE, IMMEDIATE R1
	ASH	B,-12		;DECIMAL K
	CAIGE	B,100		; GOT TOO MUCH?
	 JRST	1(G)		;NO, OK
	HRRZ	A,THISPR
	CAIN	A,SAVEL+1	;ARE WE DOING A SAVE?
	JRST	1(G)		;YES, OK TO USE LAST K
	MOVE	A,JOBREL
	SUBI	A,2000
	CORE	A,
	 ERROR	IOPERR
	JRST	(G) >		;MUST RESERVE LAST K FOR PANIC SAVE

SHORTN:	HRRZ	B,ALOCTB(G)	;SHORTEN THIS SPACE IF IT NEEDS IT
	ADDI	A,(B)
	CAML	A,BASETB+1(G)	;MORE THAN MINIMUM ALLOC LEFT OVER?
	JRST	(L)		;NO
	HRL	A,BASETB+1(G)
	HLRZ	B,A		;EVEN IF A CHANGES
	SUBI	B,(A)		;THE TWO HALVES REMAIN RELATIVELY CONSTANT
	MOVNI	B,(B)		;B MUST BE NEGATIVE FOR RPOINT
	ADD	W,B
	BLT	A,@WTOP
	MOVEI	A,1(G)
	JSP	D,RPOINT
	MOVE	W,UUOACS+W
	JRST	(L)
;COMPRESS ALL AREAS TO BE AT MOST CURRENTLY USED PLUS INITIAL ALLOCATION

CMPRSS:	HRLZI	G,-3		;THREE PAIR TABLES
CMPRS1:	SKIPA	A,BASETB(G)	;FETCH THE BASE OF THE TABLE
	ADDI	A,2		;ADVANCE TO PAIR IF ANY
	SKIPE	(A)		;ANY MORE PAIRS?
	JRST	.-2		;YES
	JSP	L,SHORTN
	AOBJN	G,CMPRS1	;OTHER PAIR TABLES

	HRLI	G,-2		;TWO TABLES WITH TOP POINTERS
				;RH OF G NOW POINTS TO PS
CMPRS2:	HRRZ	A,PTOP-.PS(G)	;PTOP FIRST IN ORDER
	ADD	A,PS-.PS(G)	;TOPS ARE RELATIVE, MAKE ABSOLUTE
	JSP	L,SHORTN
	AOBJN	G,CMPRS2	;OTHER TOP TABLE

	HRLI	G,-2		;TWO PDP'S
				;RH OF G NOW POINTS TO SP
CMPRS3:	HRRZ	A,UUOACS+S-.SP(G)	;GET CURRENT TOP OF STACK
	ADDI	A,1			;CORRECT TO FIRST FREE WORD
	JSP	L,SHORTN		;PDP'S ARE ALREADY ABSOLUTE
	HRRZ	A,UUOACS+S-.SP(G)
	ADDI	A,1
	SUB	A,SP+1-.SP(G)
	HRLM	A,UUOACS+S-.SP(G)	;FIX PDL END TEST
	AOBJN	G,CMPRS3	;OTHER PDP

	HRRZ	A,JOBREL
	SUBI	A,@WTOP	;DIFFERENCE BETWEEN LAST STRING AND TOP OF CORE
FOR TENEX,< CAMG A,INCREMENT >	; IS IT MORE THAN ALLOC AMT
FOR TEN50,< CAIG A,2000 >
	JRST	CMPRS4	;NO, DON'T CONTRACT
	MOVEI	A,@WTOP
FOR TEN50,<
	CORE	A,		;GIVE UP WHAT WE DON'T NEED ANYMORE
	JRST	ILLUUO >	;BIG TROUBLE
FOR TENEX,<	JSP	E,SETMEM>

CMPRS4:	MOVEI	A,@WTOP
	HRLI	A,(A)
	SETZM	(A)
	ADDI	A,1
	MOVE	B,JOBREL
	CAILE	B,(A)
	BLT	A,(B)
	JRST	UUORET	;HAVE NOW TO FIT IN CORE
;STUFF TO BE COPIED TO UNSHARED CORE AT START OF RUN

DEFINE TT (A1,A2,A3)
<IFB <A3>,<EXP A2>
IFNB <A3>,<XWD A3,A2>>
ALOCTB:	TABLES

DEFINE MM (A1,A2)
<XWD A2,0>

SPFRST:	Z
	JRST	DOUUO
	POINTR	;ALL THE LH'S OF THE INDEXED POINTERS
	EXP 0,2	;PTOP,DTOP, IN THAT ORDER!
	XWD W,.WTOP-.WBASE-1
	XWD 525252,123457	;AN INITIAL RANDOM BITS, FIX LATER
				;SO THE STARTING POINT IS ALSO RANDOM
FOR TENEX,<	Z	;BITS FOR JFNTAB
	XWD 377777,377777	;NO INPUT OR OUTPUT FILE FOR STRING
	Z		;DEFAULT DEVICE IS DSK
	Z
	Z
	[ASCIZ /LGO/]		;EXTENSION
	Z
	Z
	XWD 1,BREAKY	;CH 0, PRIORITY  ABOVE ALL OTHERS
	XWD 3,ASKEOL	;CH 1 CR FOR ASK
	XWD 3,ASKEOL	;CH 2 ALT-MODE FOR ASK
	XWD 3,ASKRUB	;CH 3 RUBOUT FOR ASK
	REPEAT 5,<Z>	;CH 4-8 UNUSED
	XWD 2,ALLOCP	;CH 9, PDL TRAP
	XWD 2,EOFEX	;CH 10
	XWD 2,DATAEX	;CH 11
	REPEAT ^D10,<Z>	;CH 12-21 UNUSED
	XWD 2,ALOCWS	;CH 22 REF TO NON-EXISTANT PAGE
>
TERMIO:
FOR TENEX,<PUSHJ P,XBIN
	PUSHJ P,XBOUT>
FOR TEN50,<TTCALL	4,C
	TTCALL	1,C >
SPLLEN==.-SPFRST



DEFINE ELM1 (NAME,VAL)
<
NAME==.-.WBASE
EXP 1,VAL
>

.WBASE=.
ELM1 EMPTYV,0
ELM1 TRUEV,ASCIZ /TRUE/
FALSEV==.-.WBASE
EXP 2
ASCIZ /FALSE/
ELM1 LINEFV,012B6
ELM1 CARETV,015B6
ELM1 FORMFV,014B6
ELM1 BLANKV,002B6
ELM1 BELLV,007B6
ELM1 QUOTEV,042B6
ELM1 SKIPV,<BYTE (7) 15,12>
.WTOP==.
SUBTTL	TABLES OF MACHINE-DEFINED VARIABLES AND PROCEDURES

DEFINE MVM (A,B,C)
<EXP [ASCIZ "A"]
IFNB <C>,<XWD C,B>
 IFB <C>,<XWD WORDF,B>>


;MACHINE DEFINED VARIABLE NAMES

MV:
MVM EMPTY,EMPTYV,WORDF!SENTF!EMPTYF
MVM LINE FEED,LINEFV
MVM CARRIAGE RETURN,CARETV
MVM FORM FEED,FORMFV
MVM BLANK,BLANKV
MVM BELL,BELLV
MVM QUOTE,QUOTEV
MVM SKIP,SKIPV
MVM CONTENTS,CCONTE,COMPUT
0

PREPRC==2	;PREFIX PRECEDENCE
STRINF==40000


;MACHINE DEFINED PROCEDURES

DEFINE MPM (NAME,GOTO,NARG,BITS)
< XWD NARG-1,[ASCIZ \NAME\]
  IFB <BITS>,<XWD STRINF!WORDF+PREPRC,GOTO>
 IFNB <BITS>,<XWD BITS+WORDF,GOTO>>

;DEFAULT PRECEDENCE IN LH OF FIRST WORD IS 2
;INTERPRETATION OF ALLOWED FORM FOR INPUTS IS AS FOLLOWS:
; STRINF=1 => STRING ONLY



DEFINE PAIR (A,B)
<MPM A,[ASCIZ "B"],1,400000>

DEFINE LETTAB (LET)
<IRPC LET
<MNT'LET>>

MNPT:
LETTAB ABCDEFGHIJKLMNOPQRSTUVWXYZ

;THE ENTRIES IN THIS TABLE NEED NOT BE IN ORDER OF DECREASING
;PROBABILITY OF OCCURANCE BECAUSE IT IS SEARCHED ONLY AT COMPILE
;TIME.  AT EXECUTE TIME THE ENTRIES ARE REFERENCED ONLY BY NUMBER.
;THE ABOVE STATEMENT IS FALSE

CMPT:
MNTA:	MPM ABBREVIATE,ABBREVIATE,0
ABREVL:	MPM ABBREVIATION,SPECWD,0
ABRVSL:	MPM ABBREVIATIONS,SPECWD,0
ALLL:	MPM ALL,SPECWD,0
ANDL:	MPM AND,SPECWD,0
ASL:	MPM AS,SPECWD,0
	MPM	ASCII,ASCIIX,1
FOR TENEX,<	MPM ASK,ASK,1 >   ;DEMAND IN TIME
	PAIR ABB,ABBREVIATION
	PAIR ABBS,ABBREVIATIONS
	PAIR ABT,ABBREVIATE
	0
;
; SPECIAL ASCII FUNCTION CALL
;
MNTB:
FOR TURTLE,<	MPM BACK,BACK,0	>
FOR MOCKTURTLE!NRCTUR,<MPM BACK,BACK,1>
	MPM BELL,BELL,0
	MPM BOTH,BOTH,2
	MPM BUTFIRST,BUTFIRST,1
	MPM BUTFSEG,BUTFSEG,2	;ADDED AT NRC (RAO -- 21 MAR 75)
	MPM BUTLAST,BUTLAST,1
	PAIR B,BOTH
	PAIR BF,BUTFIRST
	PAIR BL,BUTLAST
	0
MNTC:
FOR SAVBRK,<	MPM CANCEL,CANCEL,0 >
	MPM CLOCK,CLOCK,0
CONTNL:	MPM CONTENTS,SPECWD,0
	MPM COPY,COPY,1;	;OTHER INPUTS ARE NOEVAL
	MPM COUNT,COUNT,1
	PAIR C,COUNT
	0
MNTD:	MPM DATE,TODATE,0
	MPM DDT,CALDDT,0
	MPM DIFFERENCE,DIFF,2
	MPM DIVISION,DIVISION,2
	MPM DO,CALLDO,1
	PAIR DIFF,DIFFERENCE
	PAIR DIV,DIVISION
	0

MNTE:	MPM EDIT,EDIT,0
	MPM EITHER,EITHER,1
ELSEL:	MPM ELSE,SCOMEX
	MPM EMPTYP,EMPTYP,1
	MPM END,ENND,0
ENTRYL:	MPM ENTRY,SPECWD,0
	MPM EQUALP,EQUALP,2
	MPM ERASE,ERASE,0
	MPM EXIT,EXIT,1	;THIS COMMAND IS USEFUL INSIDE HOARDED PROCEDURES
	PAIR EDL,EDIT LINE
	PAIR EDT,EDIT TITLE
	EXP [ASCIZ /EE/]
	XWD 400000,[ASCIZ /ERASE ENTRY/] ;CAN'T USE  PAIR
	PAIR EI,EITHER
	PAIR EP,EMPTYP
	PAIR ER,ERASE
	PAIR ERL,ERASE LINE
	0
MNTF:
FILEL:	MPM FILE,SPECWD,0
	MPM FIRST,FIRST,1
	MPM FORMFEED,FORMFEED,0
FOR NRCTUR,< MPM FORWARD,FORWARD,1 >
FROML:	MPM FROM,SPECWD
FOR TURTLE,<	MPM FRONT,FRONT,0 >
FOR MOCKTURTLE,< MPM FRONT,FRONT,1 >
	MPM FSEG,FSEG,2		;ADDED AT NRC (RAO -- 21 MAR 75)
FOR NRCTUR,< PAIR FD,FORWARD>
	PAIR F,FIRST
	0
MNTG:	MPM GET,GET,0
FOR SAVBRK,< MPM GO,GO,0 >
	MPM GOTOLINE,GOTOLINE,1
	MPM GOODBYE,GOODBYE,0
	MPM GREATERP,GRATRP,2
	PAIR GB,GOODBYE
	PAIR GP,GREATERP
	PAIR GTL,GOTOLINE
	0
MNTH:
FOR MOCKTURTLE,< MPM HERE,HERE,0 >
FOR MOCKTURTLE!NRCTUR,<
	MPM HOME,HOME,0 >
FOR TURTLE,<	MPM HORN,HORN,0 >
	0
MNTI:	MPM IF,IF,1		;FOR IF THEN ELSE
	MPM IFFALSE,IFFALSE,0
	MPM IFTRUE,IFTRUE,0
	MPM IGNORE,IGNORE,1	;A COMMAND WHICH IGNORES ITS INPUT
	MPM IS,IS,2
	MPM ISPROC,ISPROC,1	;CHECKS TRUTH OF ARG BEING A PROCEDURE
	PAIR IFF,IFFALSE
	PAIR IFT,IFTRUE
MNTJ:
MNTK:	0

MNTL:	MPM LAST,LAST,1
FOR TURTLE,< MPM LEFT,LEFT,0 >
FOR MOCKTURTLE!NRCTUR,< MPM LEFT,LEFT,1 >
	MPM LESSP,LESSP,2
LINELL:	MPM LINE,SPECWD,0
	MPM LINEFEED,LINEFEED,0
	MPM LINES,LINES,1
	MPM LIST,LIST,0
	MPM LOCAL,LOCAL,1
	PAIR L,LAST
	PAIR LC,LIST CONTENTS
	PAIR LE,LIST ENTRY
	PAIR LL,LIST LINE
	0


MNTM:	MPM MAKE,MAKE,2,200000	;SPECIAL TO COMPIL
	MPM MAXIMUM,MAXIM,2
FOR MUSIC,<
	MPM MBUFCLEAR,MBCLR,0
	MPM MBUFCOUNT,MBCNT,0
	MPM MBUFINIT,MBINIT,0
	MPM MBUFNEXT,MBNXT,1
	MPM MBUFOUT,MBOUT,0
	MPM MBUFPUT,MBPUT,1
	MPM MBUFSTART,MBSTRT,0
>
	MPM MEMBERP,MEMBRP,2 ;ADDED AT NRC----R.A.O.
	MPM MINIMUM,MINIM,2
FOR MOCKTURTLE,< MPM MOVE,MOVE,1 >
	PAIR MAX,MAXIMUM
	PAIR MIN,MINIMUM
	PAIR MP,MEMBERP
	0
MNTN:
NAMESL:	MPM NAMES,SPECWD,0
	MPM NEWMUSIC,NEWMUSIC,0	;NEW MUSIC BOX
	MPM NOT,NOT,1
	MPM NUMBERP,NUMBRP,1
	PAIR NP,NUMBERP
	0
MNTO:
FOR NRCTUR,< MPM OFFSCREEN,TOFFSC,0 >
OFL:	MPM OF,SPECWD,0
	MPM OLDMUSIC,OLDMUSIC,0	;OLD MUSIC BOX
ORL:	MPM OR,SPECWD
	MPM OUTPUT,OUTPUT,1
	PAIR OP,OUTPUT
	0
MNTP:
FOR MOCKTURTLE!NRCTUR,<
	MPM PAGE,PAGE,0
	MPM PENUP,PENUP,0
	MPM PENDOWN,PENDN,0 >
	MPM PRINT,PRINT,1
PROCDL:	MPM PROCEDURES,SPECWD,0
	MPM PRODUCT,PRODUCT,2
	PAIR P,PRINT
	PAIR PC,PRINT :CONTENTS:
	PAIR PCC,PRINT COUNT :CONTENTS:
	PAIR PROD,PRODUCT
	PAIR PRS,PROCEDURES
	0
MNTQ:	MPM QUOTIENT,QUOTIENT,2
	PAIR QUO,QUOTIENT
	0
MNTR:	MPM RANDOM,RANDOM,0
	MPM REMAINDER,REMAINDER,2
	MPM REQUEST,REQUEST,0
	MPM RESETCLOCK,RESETC,0
	MPM RETURN,CRETUN,0
FOR TURTLE,< RIGHT,RIGHT,0 >
FOR MOCKTURTLE!NRCTUR,< MPM RIGHT,RIGHT,1 >
	PAIR REM,REMAINDER
	PAIR RQ,REQUEST
	0

MNTS:
SAVEL:	MPM SAVE,SAVE,0
SENTCL:	MPM SENTENCE,SENTENCE,2
	MPM SENTENCES,SENTCS,0
	MPM SENTENCEP,SENTP,1
FOR MOCKTURTLE,<
	MPM SETHEADING,SETHEADING,1
>
FOR MUSIC,<
>
FOR MOCKTURTLE,<
	MPM SETTURTLE,SETTURTLE,1 
	MPM SETX,SETX,1
	MPM SETXY,SETXY,1
	MPM SETY,SETY,1
>
FOR MUSIC,< MPM SING,SING,2 >
	MPM SKIP,SKIP,0
	MPM STOP,ESTOP,0
	MPM SUM,SUM,2
	PAIR S,SENTENCE
	PAIR SP,SENTENCEP
	PAIR SS,SENTENCES
	0


MNTT:	MPM TEST,TEST,1
	MPM TEXT,TEXT,2
THENL:	MPM THEN,SPECWD
	MPM THING,THING,1
	MPM TIME,TIME,0
TITLEL:	MPM TITLE,TITLE,0
TOL:	MPM TO,TO,0
FOR TURTLE,<	MPM TOUCHLEFT,TOUCHLEFT,0
	MPM TOUCHRIGHT,TOUCHRIGHT,0 >
TRACEL:	MPM TRACE,TRACE,0
TRACSL:	MPM TRACES,SPECWD,0
	MPM TYPE,TYPE,1
	MPM TYPEIN,TYPEIN,1
	PAIR T,TEST
MNTU:	0

FOR MUSIC,<MNTV:	MPM VOICES,VOICES,1 >
NOTFOR MUSIC,<MNTV=MVTU>
MNTW:	MPM WAIT,WAIT,1
FOR MOCKTURTLE,< MPM WIPE,WIPE,0 >
WORDL:	MPM WORD,WORD,2
	MPM WORDP,WORDP,1
	MPM WORDS,WORDS,0
	PAIR W,WORD
	PAIR WP,WORDP
	PAIR WS,WORDS
MNTX:
MNTY:	0
MNTZ:	MPM ZEROP,ZEROP,1
	PAIR ZP,ZEROP
	0		;ALL TABLE SEARCHES TERMINATE ON A 0


;PREFIX OPERATORS FOLLOW IN ORDER OF INCREASING PRECEDENCE,
;OPERATOR WITH HIGHEST PRECEDENCE GETS FIRST CRACK AT OPERAND
;NOTE WELL!! THERE IS A TEST IN THE TWOARG ERROR CODE
;WHICH RELIES ON THE FACT THAT THIS ENTIRE TABLE RESIDES ABOVE
;THE PREFIX OPERATOR TABLES TO DISTINGUISH INFIX FROM PREFIX OPS

RPREN:	MPM ),EXCTRP,0,1	;PARENTHESES ARE NOT INFIX OPERATORS BUT
LPREN:	MPM <(>,EXCTLP,0,1	;ARE INCLUDED HERE FOR CONVENIENCE
IMAKEL:	MPM _,MAKE,1,2
UPRODL:	MPM ,UPROD,1,2	;NO OF ARGS NEEDED IS A LIE
ILTHAN:	XWD 1-1,[ASCIZ \<\]
	XWD 4,LESSP
IEQUAL:	MPM =,EQUALP,1,4
IGRTR:	XWD 1-1,[ASCIZ \>\]
	XWD 4,GRATRP
IPLUS:	MPM +,SUM,1,6
IMINUS:	MPM -,DIFF,1,6
ITIMES:	MPM *,PRODUCT,1,10
IQUOT:	MPM /,QUOTIENT,1,10
INFUMN:	MPM -,COMPLM,1,12
INFUPL:	MPM +,UNPLUS,1,12
;	MPM ^,POWER,1,14	;FOR LATER EXPANSION

;BINARY OPERATORS IN TH TABLE ABOVE ARE INDICATED AS NEEDING ONE FEWER
;ARGUMENTS THAN THEY ACTUALLY DO.  THAT IS BECAUSE BY THE TIME
;THAT NUMBER OF ARGS NEEDED IS FETCHED FROM THE TABLE, ONE OF
;THE PROCEDURE'S INPUTS IS ALREADY ACCOUNTED FOR.
SUBTTL	LOGO SYSTEM STUFF - LISTING, EDITING, AND ERASING

LIST:	TRZ	F,EABBRF!ECONTF!EENTRF!ENAMEF

	PUSH	P,[EXP LISTXT]	;SO ALL SUBRS CALLED MAY EXIT WITH POPJ
	PUSHJ	P,GNE
	 ERROR	WHATER
	TLNE	A,UPRF	;IS IT A USER PROCEDURE NAME?
	JRST	LISTPR	;YES, GO LIST IT
	TLZN	A,MPF
	ERROR	WHATER
	MOVEI	A,(A)
	CAIN	A,ALLL+1
	JRST	LALL
	CAIN	A,CONTNL+1	;IS IT "CONTENTS"?
	JRST	LISTCT	;GO LIST CONTENTS
	CAIN	A,TITLEL+1	;IS IT "TITLE"?
	JRST 	LISTTL
	CAIN	A,LINELL+1	;IS IT "LINE"?
	JRST	LISTLN
	CAIN	A,ENTRYL+1
	JRST	LISTEN
	CAIN	A,NAMESL+1
	JRST	LSTFNM
	CAIN	A,ABRVSL+1
	JRST	LSTFAB
	CAIN A,FILEL+1
	JRST	LFILE
	ERROR	WHATER		;YOU CAN'T LIST THAT.

LALL:	PUSHJ	P,GNE
	JRST	LALLJ
	TLZN	A,MPF		;IS ARG A MACHINE NAME?
	ERROR	LSTER2		;NO, ALL THE REST MUST BE WELL KNOWN NAMES
	MOVEI	A,(A)
	CAIN	A,PROCDL+1	;ALL PROCEDURES?
	JRST	LISTAP	;YUP
	CAIN	A,NAMESL+1	;ALL NAMES?
	JRST	LISTAN	;YUP
	CAIN	A,ABRVSL+1	;ALL ABBREVIATIONS?
	JRST	LISTAA
	ERROR	LSTER2	;LIST ALL WHAT?

LALLJ:	PUSHJ	P,LISTAP
	PUSHJ	P,LISTAN
	PUSHJ	P,LISTAA
	SOS	CPP
	POPJ	P,


;LIST CONTENTS AND LIST ALL PROCEDURES

LISTCT:	PUSHJ	P,GNE	;IS IT LC FROM AN ENTRY?
	 JRST	LSTCT0
	SOS	CPP
	TRO	F,ECONTF
	JRST	LISTFL
LSTCT0:	MOVEI	A,LISTTO
	SOSA	CPP
LISTAP:	MOVEI	A,LISTPR
	PUSH	P,A
	PUSHJ	P,CRLF
	MOVEI	A,0	;FOR LOOP OVER ALL PROCEDURES
LSTCT1:	SKIPN	@RPA	;END OF PROCEDURE NAME LIST?
	JRST	APOPJ
	MOVEI	A,1(A)	;MAKE A LOOK LIKE UPROD COMPILE PTR
	MOVNI	B,1
	CAMN	B,@RPA
	AOJA	A,LSTCT1
	PUSH	P,A	;SAVE IT
	PUSHJ	P,@-1(P)	;CALL THE RIGHT ROUTINE
	JFCL		;DON'T CARE IF IT WASN'T DEFINED
	POP	P,A	;REMEMBER WHERE WE WERE IN LIST
	AOJA	A,LSTCT1	;GO GET NEXT PROD NAME


LISTTO:	MOVE	M,@RPA	;GET POINTER TO PROCEDURE DIRECTORY
	CAMN	M,[EXP -1]	;IS THIS PROCED DEFINED?
	POPJ	P,	;NO, R1 EXIT IMMEDIATELY
	MOVEI	A,-1(A)
	AOS	0(P)
	MOVE	A,@RPA		;IS THS PR TRACED?
	TLNN	A,TRACEF
	JRST	LSTLN1		;NO
	TLNE	F,SAVEF		;DOING A SAVE?
	JRST	.+4

	MOVEI	B,[ASCIZ /(TRACED)/]
	PUSHJ	P,TOSS		;TYPE "(TRACED) " IF IT IS
	JRST	LSTLN1

	MOVEI	B,[ASCIZ /TRACE /]
	PUSHJ	P,TOSS		;FOR A SAVE, TYPE "TRACE PRNAME"
	MOVEI	B,(A)
	PUSHJ	P,TOSW
	PUSHJ	P,CRLF
	JRST	LSTLN1



LISTTL:	MOVE	A,TOPROD	;LIST TITLE
	JUMPE	A,[ERROR NOPERR]	;MUST HAVE A PROCEDURE OPEN
	PUSHJ	P,LISTTO	;LIST IT
	ERROR	IOPERR	;BIG TROUBLE
	POPJ	P,

;LIST A PROCEDURE

LISTPR:	PUSHJ	P,CRLF	;ONE EXTRA IN FRONT
	PUSH	P,A	;SAVE WHICH PROCEDURE
	PUSHJ	P,LISTTO	;DO THE "TO" LINE
	 ERROR	EVER3	;X NEEDS A MEANING
	MOVEI	M,1(M)
	PUSHJ	P,LSTPLN	;DO CURRENT LINE
	AOJA	M,.-1	;DO NEXT LINE
	POP	P,A
	HRRZI	A,(A)
	CAMN	A,TOPROD	;SHOULD WE TYPE "END"? TESTING RH ONLY
	TLNE	F,SAVEF
	SKIPA
	POPJ	P,		;NO, PROCEDURE IS STILL OPEN
	MOVEI	B,[ASCIZ /END/]
	PUSHJ	P,TOSS
	JRST	CRLF


LISTLN:	PUSHJ	P,SNMEVL
	MOVEI	M,(A)	;SRCHLN USES A, LSTPLN USES M
	PUSHJ	P,LSTPLN
	POPJ	P,
	ERROR	IOPERR


SNMEVL:	SKIPN	TOPROD
	ERROR	NOPERR		;MUST HAVE A PROCEDURE OPEN
	PUSHJ	P,NUMEVL
	MOVE	A,TOPROD
	JSP	C,SRCHL1	;IS IT A LINE NO OF THE CURRENT PROCEDURE?
	 CAIE	B,(M)
	 ERROR	GOERR3
	POPJ	P,

SAVAA:	SKIPA	A,[EXP SAVAAR]
LISTAA:	MOVEI	A,LSTAAR
	PUSH	P,A	;SAVE NAME OF ROUTINE TO CALL
	MOVEI	A,2
	MOVEM	A,BCHAR
	PUSHJ	P,CRLF
	MOVE	G,UA	;POINT AT FIRST ABBREV NAME
LSTAAL:	SKIPN	A,(G)	;ANY MORE ABBREVIATIONS?
	JRST	APOPJ	;NO
	MOVNI	C,1
	CAME	C,1(G)	;IS THIS ONE DEFINED?
	PUSHJ	P,@(P)	;YES, OUTPUT IT
	ADDI	G,2
	JRST	LSTAAL

LSTAAR:	PUSHJ	P,PTOSS		;TYPE NAME
	MOVEI	B,[ASCIZ /=>/]
	PUSHJ	P,TOSS
	PUSHJ	P,PTAB
	MOVE	A,1(G)
	PUSHJ	P,PTOSS	;TYPE VALUE
	PUSHJ	P,CRLF	;LINE
	POPJ	P,

;LIST ONE LINE OF A PROCEDURE

LSTPLN:	HRRZ	A,@PSM	;GET LINE NO, M SET UP BY LISTTO
	JUMPE	A,CPOPJ1	;NO MORE LINES, GIVE R2
	PUSHJ	P,DECPRT	;TYPE LINE NO., MAX OF 5 CHARS
LSTLN1:	MOVEI	A,1	;ENTER HERE FOR LIST TITLE, DON'T TYPE LINE NO
	ADD	A,CHARNO
	MOVEM	A,BCHAR
	MOVEI	M,1(M)	;POINT AT PTR TO COMPILED CODE
	HRRZ	D,@PSM	;GET PTR TO COMPILED LINE
	MOVEI	D,1(D)
LSTPLL:	MOVE	A,@WSD	;GET NEXT ELEMENT OF THE LINE
	TLZ	A,COMPOUND!IMMEDIATE
	JFFO	A,.+2	;WHAT KIND OF ELEMENT?
	PJRST	CRLF	;EOL, TYPE CR
	PUSH	P,D	;REMEMBER WHERE WE ARE IN THE LINE
	TLNE	A,INFOP
	JRST	LSTIOP	;INFIX OP, MAY WANT TO SUPRESS SURROUNDING SPCS
LSTLL1:	SKIPE	CHARNO		;SO "TO" WON'T BE " TO"
	PUSHJ	P,PSPACE	;SPACE BEFORE EACH ELEMENT
LSTLL2:	JRST	@.-1(B)	;DISPATCH ON TYPE
	EXP LSTPMP,LSTPUP,LSTPV,LSTPL,LSTPMP,LSTPMV,LSTPCM

LSTPMP:	MOVE	A,-1(A)	;MACHINE PROCEDURE, GET PTR TO NAME
	HRLI	A,440700	;MAKE TEXT PTR
LSTPM1:	PUSHJ	P,PWORD	;TYPE ELEMENT
LSTPM2:	POP	P,D
	AOJA	D,LSTPLL	;GO BACK FOR NEXT ELEMENT ON THE LINE

LSTPUP:	MOVEI	A,-1(A)	;USER PROCEDURE, POINT AT NAME PTR
	MOVE	A,@RPA	;GET PTR TO NAME
	HRLI	A,(POINT 7,(W),34)	;MAKE TEXT PTR
	JRST	LSTPM1

LSTPMV:	MOVE	A,-1(A)
	MOVEI	E,":"
	TRO	F,PREFIX!SUFFIX
	PUSHJ	P,PTOSSM
	JRST	LSTPM2

LSTPV:	MOVEI	A,-1(A)		; POINT TO NAME WD, NOT VALUE WD
	MOVE	A,@VPA		; FETCH THE NAME PTR
	SKIPA	E,[":"]	;VARIABLE, AFFIX ":" MARKS
LSTPCM:	MOVEI	E,";"	;COMMENT
	TRO	F,PREFIX!SUFFIX
LSTPL1:	PUSHJ	P,PTOSS
	JRST	LSTPM2

LSTPL:	PUSH	S,A	;LITERAL
	PUSHJ	P,NUMBRQ	;SEE IF IT IS A NUMBER
	 TRO	F,PREFIX!SUFFIX	;IF NOT, QUOTE IT
	POP	S,A
	MOVEI	E,042
	JRST	LSTPL1

LSTIOP:	MOVEI	D,1(D)	;CHECK FOLLOWING ELEM FOR LIT OR VAR
	JSP	E,LSTIOT
	MOVEI	D,-2(D)	;PRECEDING ONE TOO
	JSP	E,LSTIOT
	JSP	H,ETMP	;BOTH PASS, SUPPRESS SPACE BEFORE AND AFTER
	AOS	D,0(P)
	MOVE	A,@WSD
	TLZ	A,COMPOUND!IMMEDIATE
	JFFO	A,LSTLL2	;NEVER FALLS THROUGH!
LSTIOT:	MOVE	C,@WSD
	TLNN	C,LITF
	TLNE	C,VARF
	JRST	(E)	;CANDIDATE FOR SPACE ELIMINATION
	JRST	LSTLL1

;LIST ALL NAMES

LISTAN:	MOVEI	A,2
	MOVEM	A,BCHAR
	PUSHJ	P,CRLF

	MOVE	A,VP+1		;DUMMIES FIRST, MAKE COPY OF VP
	SUB	A,VP		; SO IT CAN BE CLOBBERED WITH BINDINGS
	PUSHJ	P,MAKELM	; RETURNS IN B WS PTR TO LENGTH WORD
	HRLZ	A,VP		; SET UP TO BLT, FROM VP
	HRRI	A,@WSB		; TO NEW ELEMENT
	MOVE	G,A		; REMEMBER WHERE
	ADDI	A,1		; POINT BEYOND LEN WD
	BLT	A,@WTOP		; WHICH POINTS TO END OF ELEMENT

	HRLI	G,B		; ELEM(B)
	MOVE	H,DP
	ADD	H,DTOP		; AFTER LAST ENTRY IN DP
LSTAN3:	SUBI	H,2		; AT LAST ENTRY
	CAMG	H,DP		; NO MORE ENTRIES?
	AOJA	G,LSTANG		; DONE WITH DUMMIES, DO GLOBALS

	MOVE	B,(H)		; PTR TO PTR TO VALUE WD IN VP
	MOVEI	A,@G		; ABS PTR TO NAME WD IN VP COPY
	PUSHJ	P,LSTANR	; LIST TOPMOST BINDING

	MOVE	C,1(H)		; FETCH NEXT LEVEL BINDING
	MOVEM	C,1(A)		; AND MAKE IT TOP ONE IN COPY
	JRST	LSTAN3		; GO BACK FOR MORE


SAVAN:	MOVEI	A,SAVANR	; SAVE LISTING ROUTINE
	SKIPA	G,VP		;SAVE USES REAL VP

LSTANG:	MOVEI	A,LSTANR	;LISTING ROUTINE
	PUSH	P,A	;SAV ROUTINE TO CALL
	PUSHJ	P,CRLF
	MOVE	A,G
LSTANH:	SKIPN	(A)	;ANY MORE?
	JRST	APOPJ	;NO, DONE
	PUSHJ	P,@(P)	;NO, LIST THIS ONE
	ADDI	A,2
	JRST	LSTANH	;TRY NEXT ONE

LSTANR:	MOVSI	C,UNBOUN
	TDNE	C,1(A)		; IS THIS VALUE UNBOUND?
	POPJ	P,		; YES, DON'T TYPE IT
	PUSH	P,A	;TYPE ANY KIND OF VALUE
	MOVEI	E,":"	;SLASH THE NAME
	TRO	F,PREFIX!SUFFIX
	MOVE	A,(A)	;FETCH THE NAME
	PUSHJ	P,PTOSS
	MOVEI	A,[ASCIZ / IS /]
	PUSHJ	P,PTOSSM
	MOVEI	E,042	;QUOTE THE VALUE

LSTNR1:	MOVE	A,(P)
	TRO	F,PREFIX!SUFFIX
	MOVE	A,1(A)	;GET THE VALUE
	PUSHJ	P,PTOSS
	PUSHJ	P,CRLF
APOPJ:	POP	P,A
	POPJ	P,

;LIST X ENTRY NAME WHERE X CAN BE CONTENTS,NAMES,ABBREVIATIONS,ENTRY

LISTEN:	TRO	F,EENTRF
	JRST	LISTFL
LSTFNM:	TROA	F,ENAMEF
LSTFAB:	TRO	F,EABBRF

LISTFL:	TRZ	F,TF
	POP	P,A	;THE RETURN TO LISTXT
	JSP	H,FILEGO
	 ERROR	NOFILE
	PUSHJ	P,SEARCH
	 ERROR	NOENTRY
	MOVEI	D,4(G)
	MOVE	C,@E	;==	READ	@E,1
	MOVEI	E,1
	PUSHJ	P,.READ
	PUSHJ	P,READC
	CAIE	C,176	;SKIP OVER COPY OF NAME
	JRST	.-2
	MOVE	A,[PUSHJ P,READC]
	MOVEM	A,CHIN

;FALLS THRU

LNLINE:	PUSHJ	P,TIS	;READ A LINE
	 ERROR		;SHOULD HAVE GOTTEN AN EOF INTERRUPT
	POP	S,A
	TRNE	F,EENTRF
	 JRST	LISTIT	;IF LIST ENTRY, LIST EVERY LINE
	PUSHJ	P,NEWSTR
	PUSHJ	P,NEWSR0
	PUSHJ	P,COPYWD
	 JRST	MBLIST	;NOTHING ON LINE, MAYBE TYPE CRLF
	POP	S,B
	MOVE	A,SRCBOT
	TRZE	F,STORED
	 JRST	LNLINE	;STORED LINES ONLY GET LISTED ON LIST ENTRY
	ADDI	B,1
	MOVE	C,@WSB	;FIRST WORD OF FIRST SYMBOL
	CAMN	C,[ASCIZ /TO/]
	TRNN	F,ECONTF
	SKIPA
	JRST	LISTIT	;TO LINE AND LIST CONTENETS
	CAMN	C,[ASCIZ /MAKE/]
	TRNN	F,ENAMEF
	SKIPA
	JRST	LISTIT	;NAME AND LIST NAMES
	CAME	C,[ASCII /ABBRE/]
	JRST	LNLINE	;NOT ABBREVIATE, SO NOTA
	ADDI	B,1
	MOVE	C,@WSB
	CAME	C,[ASCII /VIATE/]
	JRST	LNLINE	;AGAIN NOT ABBREVIATE
	ADDI	B,1
	SKIPN	@WSB
	TRNN	F,EABBRF
	JRST	LNLINE	;AND AGAIN
LISTIT:	PUSHJ	P,PTOSS	;LIST THE CURRENT LINE
	TROA	F,TF	;DENOTE THAT A LINE WAS TYPED SINCE LAST MBLIST

MBLIST:	TRZE	F,TF
	PUSHJ	P,CRLF
	JRST	LNLINE

COPYWD:	ILDB	C,A
	JUMPE	C,CPOPJ
	CAIE	C,024		;^T IS ALSO A TERMINATOR
	CAIN	C," "
	JRST	COPYW1
	IDPB	C,B
	JRST	COPYWD
COPYW1:	AOS	(P)
	JRST	ENDSTR



EDIT:	PUSHJ	P,GNE
	 ERROR	EDTER1
	TLNE	A,UPRF	;IS THAT WHAT A USER PROCEDURE?
	JRST	EDITPR	;YES
	CAMN	A,[XWD MPF!IMMEDIATE,LINELL+1]	;IS THAT WHAT "LINE"?
	JRST	EDITLN	;YES
	CAMN	A,[XWD MPF!IMMEDIATE,TITLEL+1]	;IS IT "TITLE"?
	JRST	EDITTL	;YES
	ERROR	EDTER1	;YOU CANNOT EDIT THAT

EDITPR:	SKIPE	TOPROD	;IS THERE A PROCEDURE OPEN?
	ERROR	EDTER2	;YES, YOU ARE ALREADY EDITING X
	MOVNI	B,1
	CAMN	B,@RPA		;IS THE PROCEDURE DEFINED?
	ERROR	EVER3		;CAN EDIT DEFINED PROCEDURES ONLY
	HRRZM	A,TOPROD	;THE PROCEDURE IS NOW OPEN
	PUSHJ	P,MOVEPR	;MAKE IT LAST
	SOS	PTOP		;PROCEDURE NO LONGER CLOSED
	JRST	COMEX

EDITLN:	PUSHJ	P,SNMEVL
	PUSHJ	P,LINGEN	;GENERATE THE TEXT OF THAT LINE FOR TIS

EDTLN1:	JSP	D,COMEXR	;DO END OF LINE CHECKING
	MOVNI	B,1		;FIRST READ LINE CHARACTERISTICS FOR THIS LINE
	GETLCH	B
	TLO	B,(1B15)	;THEN TURN OFF NORMAL ECHOING OF INPUT
	SETLCH	B
	MOVE	B,[INCHRW C]	;SET TO INPUT A CHARACTER AT A TIME
	EXCH	B,CHIN
	CAME	B,TERMIO	;ONLY IF, THAT IS, WE ARE READING FROM TTY
	MOVEM	B,CHIN		;IF NOT, THEN UNDO WHAT WE JUST DID
	TLO	F,EDITF		;WE ARE NOW EDITING
	POPJ	P,


EDITTL:	SKIPN	M,TOPROD	;CURRENTLY IN A PROCEDURE?
	 ERROR	NOPERR
	PUSHJ	P,NEWSTR

	MOVEI	D,TITLEL+1	;"TITLE"
	PUSHJ	P,LNGMP		;COPY MACHINE PROCEDURE NAME
	MOVEI	A,(M)
	MOVE	D,@RPA
	MOVEI	D,1(D)
	MOVE	M,@PSD
	PUSHJ	P,LINGE0
	JRST	EDTLN1

DSPACE:	MOVEI	C," "
	IDPB	C,B
	POPJ	P,


LINGEN:	MOVEI	D,1(A)	;POINTER TO POINTER TO COMPILED CODE FOR LINE
	PUSHJ	P,SNM	;IS THE FIRST WORD OF THE GENERATED LINE
	MOVE	M,@PSD
LINGE0:	MOVEI	M,1(M)
LINGEA:	MOVE	D,@WSM		;GET NEXT ELEMENT
	TLZ	D,IMMEDIATE!COMPOUND
	JFFO	D,LINGE1	;DIPATCH ON TYPE
	JRST	ENDSTR		;WHICH WILL EXIT FROM LINGEN WITH POPJ

LINGE1:	TLNE	D,INFOP
	JRST	LNGFOP
LINGE2:	MOVEI	C," "
	IDPB	C,B	;BEFORE ALL BUT FIRST ELEMENT PUT A SPACE
	TRO	F,NWF	; AND CALL IT A SENTENCE
LINGE3:	PUSHJ	P,@.(E)
	AOJA	M,LINGEA	;BACK FOR NEXT ELEMENT
	EXP	LNGMP,LNGUP,LNGV,LNGL,LNGMP,LNGMV,LNGCMT

LNGMV:	MOVEI	E,":"
	TRO	F,PREFIX!SUFFIX
LNGMP:	MOVE	A,-1(D)		;FETCH POINTER TO TEXT NAME OF PROCEDURE
	HRLI	A,440700
LNGALL:	MOVEM	A,SRCBOT
	TRZE	F,PREFIX
	IDPB	E,B		;AFFIX PREFIX IF THERE IS ONE
	ILDB	C,A		;COPY THE WHOLE ELEMENT
	JUMPE	C,LNGALE	;DONE IF EOM
	IDPB	C,B
	JRST	.-3		;NEXT CHAR
LNGALE:	TRZE	F,SUFFIX
	IDPB	E,B		;AFFIX SUFFIX IF ONE TOO
	POPJ	P,		;DONE WITH THIS ELEMENT

LNGUP:	MOVEI	A,-1(D)
	MOVE	A,@RPA	;GET NAME OUT OF TABLE
LNGUP1:	HRLI	A,(POINT 7,(W),34)	;IT IS A WORKSPACE ELEMENT
	JRST	LNGALL

LNGV:	MOVEI	A,-1(D)
	MOVE	D,@VPA
	SKIPA	E,[":"]
LNGCMT:	MOVEI	E,";"
	TRO	F,PREFIX!SUFFIX
LNGL1:	MOVEI	A,(D)
	JRST	LNGUP1

LNGL:	MOVEI	A,(D)	;NUMBRQ USES A FOR ARG
	PUSHJ	P,NUMBRQ
	TRO	F,PREFIX!SUFFIX
	MOVEI	E,042
	JRST	LNGL1

LNGFOP:	MOVEI	A,1(M)
	JSP	G,LNGIOT
	MOVEI	A,-1(M)
	JSP	G,LNGIOT
	XCT	LINGE3
	MOVEI	M,1(M)
	MOVE	D,@WSM
	TLZ	D,COMPOUND!IMMEDIATE
	JFFO	D,LINGE3
LNGIOT:	MOVE	C,@WSA
	TLNN	C,LITF
	TLNE	C,VARF
	JRST	(G)
	JRST	LINGE2

ERASE:	PUSH	P,[EXP ERASXT]
	PUSHJ	P,GNE
	 ERROR	WHATER
	TLNE	A,UPRF	;IS IT A UPROD
	JRST	ERASPR	;YES, ERASE ONE PROCEDURE
	TLZN	A,MPF	;ALL OTHER PARAMETERS MUST BE MACHINE NAMES
	 ERROR	WHATER
	MOVEI	A,(A)
	CAIN	A,LINELL+1	;IS IT "LINE"
	JRST	ERASLN	;YES, ERASE LINE
	CAIN	A,ALLL+1	;IS IT ALL?
	JRST	ERSALL
	CAIN	A,ABREVL+1
	JRST	ERSABB
	CAIN	A,TRACEL+1
	JRST	ERASTR	;ERASE TRACE
	CAIN A,ENTRYL+1
	JRST	ERASEN
	ERROR	WHATER	;NONE OF THE ABOVE

ERASXT:	SQUEZE	;SEE IF WE CAN REDUCE THE STORAGE ALLOCATION
	JRST	COMEX


ERSALL:	PUSHJ	P,GNE	;ALL WHAT?
	 JRST	ERASAL	;ALL PERIOD
	TLZN	A,MPF	;MUST BE A MACHINE NAME
	 ERROR	WHATER
	MOVEI	A,(A)
	CAIN	A,NAMESL+1	;IS IT "NAMES"
	JRST	ERSALN
	CAIN	A,PROCDL+1	;IS IT "PROCEDURES"
	JRST	ERSALP
	CAIN	A,ABRVSL+1
	JRST	ERSALA	;ALL ABBREVIATIONS
	CAIN	A,TRACSL+1	;"TRACES"?
	JRST	ERSALT
	ERROR	WHATER

ERASAL:
FOR TEN50,<
	HLRZ	A,JOBSA	;GET FIRST FREE LOC
	ADDI	A,1777	;ONE MORE K
	CORE	A,
	ERROR	IOPERR	>
FOR TENEX,<
	MOVEI	A,30000
	JSP	E,SETMEM	>
	MOVEI	F,TF	;DON'T TYPE STARTUP MESSAGE AGAIN
	JRST	LOGO+2	;OR DO THE RESET (WHICH CLOSES DRIBBLE FILE)

ERSALA:	SETZM	@UA
	POPJ	P,

ERSALP:	SETZM	@RP	;FLUSH ALL PROCEDURE NAMES
	SETZM	PTOP	;FLUSH ALL PROCEDURE DIRECTORIES
	SETZM	BSP	;CLEAR ALL SAVED BREAKS
	SETZM	GODEPT
	JRST	FLUSHM	;FLUSH PDLS AND ALL BOUND VARS

ERSALN:	MOVE	A,VP
	MOVE	H,[XWD WORDF!SENTF!EMPTYF!GLOBLF!UNBOUN,0]
ERSAN1:	SKIPN	(A)
	POPJ	P,
	PUSHJ	P,FINDAG	;FIND A GLOBAL VALUE
	MOVEM	H,1(C)		; AND RESET IT TO UNSET
	ADDI	A,2
	JRST ERSAN1

FINDAG:	MOVSI	D,GLOBLF
	MOVE	C,A
	TDNE	D,1(C)	;IS GLOBAL VALUE IN VP?
	POPJ	P,	;YES
	MOVEI	B,1(C)		;ABS PTR TO VALUE WD
	SUB	B,VP
	MOVN	C,DTOP
	HRLZI	C,(C)
	HRR	C,DP
FNDAG1:	ADD	C,[XWD 2,2]
	JUMPGE	C,CPOPJ1	;NO GLOBAL BINDING ANYWHERE
	CAME	B,(C)
	JRST FNDAG1
	POPJ	P,


ERSABB:	AOS	A,CPP
	PUSHJ	P,EVAL
	MOVE	A,(S)
	MOVE	B,UA
	PUSHJ	P,LOOKY
	 JRST	ERSAB1		;NOT A USER ABBREVIATION
	SKIPE	1(N)	;NO CHANGE IF AN ALREADY ERASED SYSTEM ABB
	SETOM	1(N)
	POP	S,A
NOSQZE:	POP	P,A
	JRST	COMEX

ERSAB1:	MOVE	A,(S)
	PUSHJ	P,SYSLKP	;LOOKUP BUILTIN FN OR ABBREVIATION
	 ERROR	WHATER
	SKIPL	(N)		;IS IT AN ABBREV. RATHER THAN PR NAME
	 ERROR	WHATER		;PR NAME
	PUSH	S,(S)
	SETZM	-1(S)
	POP	P,A
	JRST	ABBRV0		;SKIP OVER FETCHING INPUTS TO ABT


ERASTR:	PUSHJ	P,GNE	;ERASE TRACE ON WHAT PROCEDURE?
	 ERROR	WHATER
	TLNN	A,UPRF	;ONLY USER DEFINED PROCEDURES ARE TRACED
	 ERROR	WHATER
	MOVEI	A,-1(A)
	HRLZI	B,TRACEF
	ANDCAM	B,@RPA	;CLEAR THE APPROPRIATE BIT
	JRST	NOSQZE

ERSALT:	MOVE	A,RP	;ERASE ALL TRACES
ERSLT1:	HRLZI	B,TRACEF
	ANDCAB	B,(A)	;CLEAR THE BIT
	MOVEI	A,2(A)	;POINT AT NEXT ENTRY
	JUMPN	B,ERSLT1	;NAME NON-ZERO IF NOT AT END OF TABLE
	JRST	NOSQZE

ERASLN:	PUSHJ	P,SNMEVL	;ERASE LINE, WHAT LINE?
ERSLN1:	MOVEI	C,@PSA
	MOVE	B,2(C)	;COPY ALL THE REST OF THE LINES BACK TWO
	MOVEM	B,(C)
	MOVEI	C,1(C)
	JUMPN	B,.-3	;TERMINATE ON ZERO LINE NUMBER

	MOVNI	B,2
	ADDM	B,PTOP
	POPJ	P,

ERASPR:	MOVEI	A,-1(A)	;CLEAR LH OF A
	HRLZI	B,TRACEF
	ANDCAM	B,@RPA	;ERASE THE TRACE ON IT IF ANY
	MOVEI	A,1(A)

	MOVNI	B,1	;ERASE PROCEDURE
	CAMN	B,@RPA	;IS THE PROCEDURE DEFINED?
	 JRST ERPR1	;QUIT EARLY, NOT DEFINED
	SKIPE	TOPROD	;IS THERE A PROCEDURE OPEN?
	AOS	PTOP	;"CLOSE" IT TEMPORARILY
	CAMN	A,TOPROD	;IS IT THE PROCEDURE CURRENTLY BEING DEFINED
	SETZM	TOPROD	;YES, WHEN WE'RE DONE, NO PROCEDURE OPEN
	PUSH	P,TOPROD
	MOVEM	A,TOPROD
	PUSHJ	P,MOVEPR	;MAKE THIS ONE LAST TEMPORARILY
	MOVE	A,TOPROD
	MOVE	A,@RPA

	PUSHJ	P,ERSLN1	;ERASE ONE LINE
	SKIPE	@PSA		;ANY LEFT?
	JRST	.-2		;YES, ERASE ONE MORE

	MOVE	A,TOPROD
	MOVNI	B,1
	EXCH	B,@RPA	;MARK AS UNDEFINED AND FETCH PTR TO BEGINNING
	HRRM	B,PTOP	; OF THE STORAGE WE JUST FREED UP
	HRRZ B,-1(P)
	SKIPN PRODNM	;DON'T SAY IF STORED
	CAIE B,ERASXT	;OR NOT JUST ERASE PR
	JRST .+5
	JSP H,ETUP	;X
	MOVEI A,[ASCIZ / ERASED/]
	PUSHJ P,PTOSSM
	PUSHJ P,CRLF
	POP	P,TOPROD	;RESUME EDITING THE PROCEDURE THAT HAD BEEN
	SKIPE	TOPROD
	SOS	PTOP
	POPJ	P,

ERPR1:	HRRZ B,(P)
	SKIPN PRODNM
	CAIE B,ERASXT
	 POPJ P,
	ERROR NOPROD
SUBTTL	SYSTEM INDEPENDENT FILE CODE


DEFINE READ (BLOCK,BUFFER)
<	MOVE	C,BLOCK
	MOVEI	E,BUFFER
	PUSHJ	P,.READ >

DEFINE FORCE (BUFFER)
<	MOVEI	E,BUFFER
	PUSHJ	P,.FORCE >

FOR TENEX,<
DEFINE ALTERD (BUFFER,AC)
<>> ;THE SYSTEM TAKES CARE OF IT
FOR TEN50,<
DEFINE ALTERD (BUFFER,AC)
<	MOVE	AC,LBUF+BUFFER
	SETOM	CHANGE(AC) >>


;FILE PARAMETERS

FOR TENEX,<NLOGB==4
PBLKL==1000
PBKLP2==11>
FOR TEN50,<NLOGB==1
PBLKL==200
PBKLP2==7>
LBLKL==200
DRENL==12
NENTRY==<LBLKL-10>/DRENL
BUFBIT==1

ZLABS==TF		;THIS FLAG USED TO INDICATE LABS=0 WHEN SET
PURGE TF


;DIRECTORY FORMAT
;OVERHEAD BLOCK - 8 WORDS
;WORD  CONTENTS
; 0 - TOP OF BLOCK FREE LIST
; 1 - NUMBER OF ENTRIES IN THIS DIRECTORY BLOCK
; 2 - TOP OF ENTRY BLOCK LIST IN THIS DIRECTORY
; 3 - TOP OF ENTRY BLOCK FREE LIST
; 4 - LINK TO NEXT DIRECTORY BLOCK, OR 0
; 5 - PASSWORD NUMBER FOR THIS FILE
; 6 - NUMBER OF BLOCKS ON THE FREELIST
; 7 - LAST REWRITE NUMBER USED IN FILE
;ENTRY BLOCK - DRENL WORDS LONG
; 0 TO 3 - FIRST 20 CHARACTERS OF THE ENTRY NAME
; 4 - LINK TO FIRST TEXT BLOCK OF ENTRY
; 5 - TIME AND DATE SAVED
; 6 -