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 - TIME AND DATE GOTTEN
; 7 - LOCKED, HOARDED, AND SIZE OF FILE IN BLOCKS
; 8 - REWRITE NUMBER FOR THIS ENTRY
; 9 - POINTER TO NEXT ENTRY BLOCK , OR 0
;GET HAS BEEN MODIFIED AT NRC TO OPEN A FILE FOR READING ONLY, WHERE ORIGINALLY
;FILES WERE ALWAYS OPENED IN UPDATE MODE.  THIS MEANS THAT THE ACCESS TIME AND
;DATE FOR THE ENTRY WITHIN THE FILE IS NO LONGER UPDATED ON GET, BUT IT HAS
;THE ADVANTAGE OF ALLOWING THE USE OF A LIBRARY OF LOGO FILES STORED IN SOME
;SPECIAL DIRECTORY.  AT NRC THIS SPECIAL DIRECTORY IS ACCESSED BY USE
;OF THE /LIB: MODIFICATION TO THE USERS' FILE STRUCTURE SEARCH LIST.
;NOTE THAT THE CHANGES ARE ONLY "FOR TEN50"--THE TENEX VERSION REMAINS UNCHANGED

COPYGT:	SKIPA A,[GETCP0]
GET:	MOVEI A,GET4
	MOVEM A,GETDST		; CALLED BY GET OR BY COPY
	JSP	H,FILEGO	;GENERATE FILE NAME, SAVEUP, AND OPEN
	 ERROR	NOFILE		;MAYBE FILE IN USE?
	PUSHJ	P,SEARCH	;LOOK FOR ENTRY
	 ERROR	NOENTRY		;NO SUCH ENTRY
NOTFOR TEN50,<
	MOVE	A,TANDD		;TIME AND DATE OF PROGRAM STARTUP
	MOVEI	D,6(G)		;CURRENT ENTRY +6
	MOVEM	A,@E		;UPDATE D-G
>
	MOVEI	D,4(G)		;ENTRY+4, POINTER TO DATA BLOCK
	READ	@E,1		;READ THE FIRST DATA BLOCK INTO BUF1

	PUSHJ	P,READC		;SKIP OVER COPY OF THE ENTRY NAME
	CAIE	C,176
	JRST	.-2
NOTFOR TEN50,<
	FORCE	0		;WRITE THE MODIFIED DIRECTORY
>
	JRST @GETDST		; WHAT IS THE REST TO DO

GET4:	MOVE	A,[PUSHJ P,READC]	;MOST OF GET
	MOVEM	A,CHIN
	PUSHJ	P,TIS
	 ERROR	IOPERR		;CANNOT GET A RUBOUT FROM THE FILE
	MOVE	A,(S)
	HRLI	A,(POINT 7,(W),34)
	ILDB	C,A
	CAIE	C,";"		;IS THE FIRST LINE COMMENT?
	JRST	MAINL1		;NO, TREAT THE LINE NORMALLY
	POP	S,A
	PUSHJ	P,PTOSS		;TYPE THE COMMENT
	PUSHJ	P,CRLF
	JRST	MAINL		;PROCEED AS IF INPUT WERE FROM TERMINAL
ERASEN:	JSP	H,FILEGO
	 ERROR	NOFILE
	JSP	H,FILUPD
	 ERROR	UPDERR
	PUSHJ	P,SEARCH
	 ERROR	NOENTRY
	PUSHJ	P,ERENRO
	JSP	H,CLOSUP
	POP	P,A		;FLUSH	THE RETURN TO ERASXT
	JRST	COMEX

FOR TENEX,<
GETCP0:	SKIPA	1,COPJFN
	PUSHJ	P,READC1
GETCP1:	SOSGE	CCOUNT
	JRST	.-2
	ILDB	C,@FPTRL1
	BOUT
	JUMPN	C,GETCP1
	CLOSF
	 JFCL
	JRST	REDEOF		; AND CLOSE THE LOGO FILE
>

FOR TEN50,<
	PUSHJ	P,READC1
GETCP0:	SOSGE	CCOUNT
	JRST	.-2
	ILDB	C,@FPTRL1
	SOSLE	CCNT2
	JRST	GETCP3
	PUSHJ	P,GTSVUG
	OUT	2,DMPLST
	SKIPA
	ERROR
	LDB	C,@FPTRL1	; GET THE SAME CHARACTER AGAIN
GETCP3:	IDPB	C,FPTR2
	JUMPN	C,GETCP0
	HRLZI	C,440700
	HRR	C,BUFLC2
	CAMN	C,FPTR2
	JRST	GETCP2
	PUSHJ	P,GTSVUP	;LAST BUFFER IS NOT EMPTY
	OUT	2,DMPLST
	SKIPA
	 ERROR
GETCP2:	CLOSE	2,
	RELEAS	2,
	SETZM	BUFAD2
	JRST	REDEOF

GTSVUG:	SKIPE	CCNT2
	AOS	(P)		;FIRST TIME THRU SKIP THE OUT
GTSVUP:	MOVEI	C,200*5
	MOVEM	C,CCNT2
	HRRZ	C,BUFLC2
	HRLI	C,440700
	MOVEM	C,FPTR2
	SUBI	C,1
	HRLI	C,-200
	MOVEM	C,DMPLST
	POPJ	P,
>

SAVER:	PUSHJ	P,LISTAP
	PUSHJ	P,SAVAN
	PUSHJ	P,SAVAA

	SETZ	C,
	XCT	CHOUT		;INSERT AN END OF FILE
	POPJ	P,

FOR TENEX,<
SAVCOP:	MOVE 1,COPJFN
	BIN
	MOVE 3,2
	PUSHJ P,WRITEC
	JUMPN 3,.-3
	CLOSF
	 JFCL
	POPJ P,
>
FOR TEN50,<
SAVCOP:	SOSG CCNT2
	JRST [  PUSHJ P,GTSVUP
		IN 2,DMPLST
		SKIPA
		 ERROR
		JRST .+1 ]
	ILDB C,FPTR2
	PUSHJ P,WRITEC
	JUMPN C,SAVCOP
	CLOSE 2,
	RELEAS 2,
	SETZM BUFAD2
	POPJ P,
>
COPYSV:	SKIPA	A,[SAVCOP]
SAVE:	MOVEI	A,SAVER
	MOVEM	A,SAVSRC
	JSP	H,FILEGO
	 JRST	SAVNEW		;NO FILE, MAKE ONE
	JSP	H,FILUPD	;OPEN IN UPDATE MODE
	  ERROR	UPDERR		;FILE EXISTS BUT CAN'T UPDATE IT
	PUSHJ	P,SEARCH	;LOOK FOR AN ENTRY BY THE SAME NAME
	 JRST	SAVE0		;NO THIS WILL BE A NEW ENTRY
	TLZ	F,GETF		;TURN OFF THIS FLAG WHILE WE ASK QUESTION
SAVEQ:	MOVEI	B,[ASCIZ /OK TO REPLACE EARLIER VERSION OF THIS ENTRY?
(YES OR NO): /]
	PUSHJ	P,TIS		;ASK QUESTION AND GET RESPONSE
	 JRST	SAVEQ		;BAD INPUT OF SOME KIND.
	POP	S,B
	AOS	B		;ADVANCE POINTER TO FIRST WORD OF MESSAGE
	MOVE	A,@WSB		;WHAT DID HE SAY?
	CAMN	A,[ASCII /NO/]
	JRST	SAVEX
	CAME	A,[ASCII /YES/]
	JRST	SAVEQ		;WHAT WAS THAT AGAIN?
	TLO	F,GETF		;OK TO PROCEED, TURN THIS BACK ON
SAVE0:	READ	[0],0		;READ BK 0 OF FILE, DIRECTORY INTO BUF0
	MOVE	A,@FPTRL0
	MOVE	A,(A)
	MOVEM	A,LABS		;FREE LIST IS FIRST WORD OF DIR

SAVE1:	TLO	F,SAVEF		;DENOTE SAVE IN PROGRESS
	MOVE	A,[PUSHJ P,WRITEC]
	MOVEM	A,CHOUT		;WHAT TO XCT WHEN OUTPUTTING CHARS

	MOVEI	A,1
	MOVEM	A,FILECT
	PUSHJ	P,WRITC2	;GET A NEW BLOCK
	MOVE	A,LBLOCK+1	;FIRST BLOCK OF FILE
	MOVEM	A,FILEAD
	MOVE	H,(S)		;COPY ENTRY NAME INTO FILE
	HRLI	H,(POINT 7,(W),34)
	ILDB	C,H
	XCT	CHOUT		;WRITE A CHAR INTO FILE
	JUMPN	C,.-2

	MOVEI	C,176
	DPB	C,@FPTRL1	;OVERWRITE THE 0 EOM

	MOVE	A,CPP		;STORE COMMENT IN FILE IF ON SAVE LINE
	MOVEI	A,1(A)		;POINT AT NEXT ELEMENT
	SKIPE	A,@WSA		;IS IT NOT THERE?
	TLNN	A,COMMTF	;MAKE SURE IT IS A COMMENT
	JRST	SAVE2		;NOT A COMMENT
	MOVEI	C,";"
	PUSHJ	P,TYO
	PUSHJ	P,PTOSS
	PUSHJ	P,CRLF

SAVE2:	PUSHJ	P,@SAVSRC	;CALL APROPRIATE ROUTINE
	TLZ	F,SAVEF
	MOVE	A,TERMIO+1	;TERMINAL OUTPUT INSTRUCTION
	MOVEM	A,CHOUT
	ALTERD	1,C
;MAKE DIRECTORY ENTRY

	HRRZ	E,@FPTRL0	;WHERE DIRECTORY IS
	SKIPE	3(E)
	JRST	SAVE4		;LIST OF AVAIL DIR ENTRIES NOT EMPTY

	PUSHJ	P,WRITC2	;NEED ANOTHER DIRECTORY BLOCK

	HRRZ	E,@FPTRL0	;DESTROYED E AGAIN
	HRLZI	B,(E)		;THE OLD DIRECTORY 0
	HRRZ	C,@FPTRL1	;WHERE THE DATA IN IT WILL GO
	HRRI	B,(C)
	BLT	B,LBLKL-1(C)	;COPY THE FULL DIRECTORY 
	PUSHJ	P,CLRDIR
	HRRZ	E,@FPTRL0	;DESTROYED IT AGAIN!
	MOVE	B,LBLOCK+1
	MOVEM	B,4(E)		;CHAIN TO FULL DIRECTORY BLOCK
	ALTERD	1,D
	JRST	SAVE4

SAVNEW:	JSP	H,OPENW		;WRITING ONLY
	 ERROR	IOPERR			;DISASTER
	SETOM	LABS
	PUSHJ	P,WRITC2	;READ A NEW BLOCK INTO BUFFER 1
	MOVE	A,LBUF+1
	MOVEM	A,LBUF		;AND SWITCH IT INTO BUFFER 0
	MOVE	A,LBLOCK+1
	MOVEM	A,LBLOCK
	MOVE	A,FPTRL1
	MOVEM	A,FPTRL0
	PUSHJ	P,CLRDIR
FOR TEN50,<FORCE 0>
	JRST	SAVE1
SAVE4:	HRLI	E,D		;NOW FILL UP A DIRECTORY ENTRY
	MOVE	D,3(E)		;TOP OF LADES
	HRLI	D,-4		;NUMBER OF WORDS OF TEXT TO COPY MAX
	MOVEI	G,(D)		;EXTRA COPY OF PTR TO ENTRY

	MOVE	B,(S)
	MOVEI	B,1(B)		;FIRST TEXT WORD IN ENTRY NAME
	MOVE	C,@WSB
	MOVEM	C,@E
	TRNE	C,376		;END OF ENTRY NAME?
	AOBJN	D,.-4

	MOVEI	D,4(G)
	MOVE	C,FILEAD
	MOVEM	C,@E

	MOVEI	D,5(G)
	MOVE	C,TANDD
	MOVEM	C,@E

	MOVEI	D,6(G)
	SETOM	@E		;NEVER GOTTEN

	MOVEI	D,7(G)		;NO BLOCKS IN FILE
	MOVE	C,FILECT
	MOVEM	C,@E

	MOVEI	D,DRENL-1(G)
	EXCH	G,2(E)		;THIS BLOCK ONTO LUDES
	EXCH	G,@E		;OLD TOP OF LUDES INTO THIS BLOCK
	MOVEM	G,3(E)		;OLD LADES FP IN THIS BLOCK TO LADES

	AOS	1(E)		;A NEW ENTRY IS NOW COMPLETE
	ALTERD	0,C

	SETOM	LDIRNO		;SEARCH FOR ANOTHER ENTRY OF SAME NAME
	SETOM	LDIRL		;SET UP TO FALL INTO SEARCH
	MOVE	A,(S)
	ADDI	A,1(W)
	MOVE	G,2(E)		;LUDES
	PUSHJ	P,SERCH5	;ENTER AT CONTINUE WITH NEXT ENTRY
	 JRST	.+2		;NO OTHER ENTRY OF SAME NAME
	PUSHJ	P,ERENRO	;DELETE THAT OTHER ENTRY
	READ	[0],0
	MOVE	A,LBUF
	MOVE	B,LABS
	MOVEM	B,@BUFLOC(A)	;UPDATE LABS BEFORE CLOSING FILE
	ALTERD	0,C
SAVEX:	JSP	H,CLOSUP
	JRST	COMEX


COPY:	PUSHJ	P,GNE
	 ERROR ERMSSG
	MOVEI	G,COPYGT	;NEXT ELEMENT IS TO OR FROM
	CAMN	A,[XWD MPF!IMMEDI,FROML+1]
	JRST	COPY1
	CAME	A,[XWD MPF!IMMEDI,TOL+1]
	 ERROR
	MOVEI	G,COPYSV
COPY1:	POP	S,B	;STRING OF FILE DESIGNATOR
	HRLI	B,(POINT 7,(W),34)
FOR TENEX,<
	MOVSI	1,400001
	CAIE	G,COPYGT
	MOVSI	1,1
	GTJFN
	 ERROR TNXERR
	MOVEM	A,COPJFN
	MOVE	2,[XWD 70000,700000]
	OPENF
	 ERROR TNXERR
	JRST	(G)
>
FOR TEN50,<
	JRST COPY2

;CONVERT BEGINNING OF STRING POINTED TO BY B TO SIXBIT AND STORE
; RESULT IN E.  TERMINATORS ARE EOM : . [ AND MAYBE ]

R7TO6:	MOVEI	D,6
	MOVE	A,[POINT 6,E]
	SETZ	E,
R7TO6L:	ILDB	C,B
	CAIE	C,"."
	CAIN	C,":"
	POPJ	P,		;LEGAL TERMINATORS
	CAIE	C,"["
	CAIN	C,0
	POPJ	P,
FOR BBN50,<
	CAIN	C,"]"
	POPJ	P, >
	XORI	C,40
	SOJL	D,[ERROR]	;TOO MANY CHARS
	IDPB	C,A		;OK
	JRST	R7TO6L		; GET ANOTHER CHAR
>

FOR TEN50,<
COPY2:	MOVE H,[XWD OPNPAR,OPNPAR+1]
	SETZM OPNPAR
	BLT H,LUKDAT+3		; CLEAR FILE DESCRIPTOR BLOCKS
	MOVEI	H,LUKDAT
	PUSHJ	P,R7TO6		;GET DEVICE OR FILENAME
	JUMPE	C,FNDCD8	; FILENAME ONLY
	CAIN	C,"["		; FOO[PRJPRG]
	JRST FNDCD3
	CAIN	C,"."		; FILENAME
	JRST	FNDCD2
	CAIE	C,":"		; DEVICE DESIGNATOR
	 ERROR		;NOTA
	MOVEM	E,OPNPAR+1	; DEVICE NAME
	PUSHJ	P,R7TO6		; FILENAME OR NOTHING
	JUMPE	C,FNDCD8	; LAST FIELD IS FILE NAME
	CAIN	C,"["		; FOO:BAR[PRJPRG]
	JRST	FNDCD3
	CAIE	C,"."		; ONLY OTHER LEGAL TERMINATOR
	 ERROR
FNDCD2:	MOVEM	E,(H)		; FILE NAME OK
	MOVEI	H,LUKDAT+1
	MOVEI	D,3		; EXT CAN ONLY BE 3 CHARS LONG
	PUSHJ	P,R7TO6+1
	HLLM	E,(H)		;MAKE SURE THE DATE FIELD NOT CHANGED
				;ONLY CHANGE THE EXT FIELD--DATE75 FIX
	JUMPE	C,FNDCD8+1	; EXTENSION IS LAST--ALREADY STORED
	CAIE	C,"["		; EXT CAN ONLY BE FOLLOWED BY PRJ-PRG
	 ERROR
	SKIPA			;EXT ALREADY STORED
FNDCD3:	MOVEM	E,(H)		; STORE FIELD BEFORE [PRJPRG]
FOR BBN50,<
	PUSHJ	P,R7TO6		; UP TO SIX CHAR IDCODE
	CAIE	C,"]"
	 ERROR			; MUST BE FOLLOWED BY RT BRK
	CALL	5,[SIXBIT /SQUOZE/] >
NOTFOR BBN50,<
	MOVE	L,B
	PUSHJ	P,DNMO		;OCTAL DNM
	 ERROR			;NOT A NUMBER
	 ERROR			;NUMBER TOO BIG
	CAIE	C,","		;FIRST ONE MUST END IN ,
	 ERROR
	HRLZ	E,M		; FIRST IS PRJ NO
	PUSHJ	P,DNMO
	 ERROR
	 ERROR
	CAIE	C,"]"		; SECOND DELIMITED BY RT BRK
	 ERROR
	HRR	E,M		; AND IS PRG NUMBER
>
	MOVEM	E,LUKDAT+3
	ILDB	C,L
	JUMPE	C,FNDCD9	; ALL OK
	ERROR			; SOMETHING EXTRA IN FILE DESIGNATOR

FNDCD8:	MOVEM	E,(H)		; STORE THE LAST FIELD
FNDCD9:	HRLZI 2,(SIXBIT /DSK/)
	SKIPN OPNPAR+1
	MOVEM 2,OPNPAR+1	; DEFAULT VALUE IS DSK
	MOVEI 2,17
	MOVEM 2,OPNPAR		; MODE IS DUMP
	OPEN	2,OPNPAR	; INIT THE DEVICE
	 ERROR
	MOVE	1,[ENTER 2,LUKDAT]
	CAIE	G,COPYGT
	HRLI	1,(LOOKUP 2,)
	XCT	1
	 ERROR
	SETZM	CCNT2
	MOVEI	A,200
	PUSHJ	P,MAKELM
	MOVEM	B,BUFAD2
	ADDI	B,1(W)
	HRRZM	B,BUFLC2
	JRST	(G) >

	PUSHJ	P,READC1
READC:	SOSGE	CCOUNT		;READ ONE CHARACTER
	JRST	.-2
	ILDB	C,@FPTRL1	;FETCH ONE
	JUMPN	C,CPOPJ		;END OF FILE?

REDEOF:	JSP	H,CLOSUP
	TLNN	F,GETF
	JRST	COMEX
	JRST	READC

READC1:	MOVNI	C,LBLKL-1
	ADD	C,@FPTRL1
	SKIPN	C,@C		;FORWARD PTR IS IN FIRST WORD OF BLOCK
	JRST	REDEOF	;FILE BROKEN
	PUSH	P,A
	PUSH	P,B
	PUSH	P,D
	PUSH	P,E	;P, USEABLE ONLY BECAUSE NO GC POSSIBLE
	READ	C,1		;READ THE NEXT BLOCK
	POP	P,E
	POP	P,D
	POP	P,B
	POP	P,A
	POPJ	P,		;POINTER AND COUNT SET UP BY READ


WRITEC:	SOSGE	CCOUNT		;WRITE A CHARACTER INTO A FILE
	JRST	WRITC1		;BUFFER FULL
	IDPB	C,@FPTRL1	;PUT IT AWAY
	POPJ	P,

WRITC1:	PUSH	P,A
	PUSH	P,B
	PUSH	P,C		;SAVE THE CHARACTER
	PUSH	P,D
	PUSH	P,E
	AOS	FILECT		;ANOTHER BLOCK USED FOR FILE
	PUSHJ	P,WRITC2
WRTC1A:	POP	P,E
	POP	P,D
	POP	P,C
	POP	P,B
	POP	P,A
	JRST	WRITEC

WRITC2:	TRZ	F,ZLABS		;WHETHER LABS=0
	SKIPLE	C,LABS		;END OF LABS?
	JRST	WRITC3		;NO
	TRO	F,ZLABS		;GENERATING MORE SPACE

;NO MORE LABS,LABSND LENGTH OF FILE AND CALL THAT MORE LABS

	MOVE	C,FILSIZ	;SET UP AT OPEN
	AOS	FILSIZ
	IMULI	C,NLOGB		;# OF PAGES IN C, MULTIPLY BY FUDGE
	MOVEM	C,LABS		;REMEMBER FOR A WHILE
WRITC3:	MOVE	B,LBUF+1
	HRRZ	A,(P)	;WHO CALLED?
	CAIE	A,WRTC1A	;WAS IT FOR A NEW DATA BLOCK?
	JRST	WRITC4		;NO
	MOVE	C,LBLOCK+1	;YES, CHAIN NEW ONE TO LAST ONE
	IDIVI	C,NLOGB		;  WHICH ONE REL TO BEG OF PBLOCK
	IMULI	D,LBLKL		;BUT FIND BEGINNING OF BUFFER
	ADD	D,BUFLOC(B)
	MOVE	C,LABS
	MOVEM	C,(D)
WRITC4:	TRNN	F,ZLABS		;NEED TO LENGTHEN FILE?
	JRST	WRITC5		;NO
FOR TENEX,< READ C,1		;OLD ONE GETS WRITTEN IF CHANGED
	MOVE	A,LBUF+1 >	;AND THE NEW ONE GETS ASSOCIATED

FOR TEN50,< 	MOVE	B,LBUF
	XORI	B,BUFBIT
	MOVEM	B,LBUF+1
	PUSHJ	P,WRITF1	;WRITE CONTENTS OF LOGICAL BUF 1 IF NECESSARY

	MOVE	C,LABS
	MOVEM	C,LBLOCK+1	;NOW ASSOCIATE NEW BLOCK WITH BUFFER
	MOVE	A,LBUF+1
	MOVEM	C,PBLOCK(A)	;AND PHYSICAL BUFFER
	MOVEI	C,5*<LBLKL-1>
	MOVEM	C,CCOUNT
	MOVE	B,BUFLOC(A)
	HRLZI	C,(B)
	HRRI	C,1(B)
	SETZM	(B)
	BLT	C,LBLKL-1(B)
	HRLI	B,010700
	MOVEM	B,FPTR(A)
	MOVEI	B,FPTR(A)
	MOVEM	B,FPTRL1
>
	MOVE	B,@FPTRL1
	HRLZI	A,-NLOGB	;SET UP THE LABS CHAIN IN THE BUFFER
	HRR	A,LABS		;LOG ADDR OF THE FIRST BLOCK IN BUFFER
	AOBJP	A,.+4

	HRRZM	A,(B)		;THE FORWARD POINTER
	ADDI	B,LBLKL		;WHERE THE NEXT ONE SHOULD GO
	AOBJN	A,.-2		;THE REST

	SETZM	(B)		;THE LAST ONE TERMINATES THE CHAIN
	JRST	WRITC6

WRITC5:	READ	C,1		;READ THIS ONE FOR ITS FORWARD PTR
WRITC6:	MOVE	C,@FPTRL1
	MOVE	C,(C)		;GET FIRST WORD OF BLOCK
	MOVEM	C,LABS		;WHICH POINTS TO NEXT FREE BLOCK
	MOVE	C,@FPTRL1
	SETZM	(C)		;THIS ONE NOW THE END OF THE DATA CHAIN
	ALTERD	1,C	;NOTE THAT THIS BLOCK CHANGED (SOON)
	POPJ	P,
;SEARCH FOR AN ENTRY
;ENTRY NAME AT 0(S)

SEARCH:	SETOM	LDIRNO
	SETOM	LDIRL		;NO OF ENTRIES IN LAST DIRECTORY BLOCK
	READ	[0],0		;READ BLOCK 0 INTO BUFFER 0
SERCH1:	HRRZ	E,@FPTRL0	;PHYSICAL ADDR OF DIR BLOCK TO E
	MOVE	A,(S)		;FETCH PTR TO ENTRY NAME
	ADDI	A,1(W)
	SKIPN	1(E)		;POSSIBLE THAT THIS DIRECTORY BLOCK IS EMPTY
	JRST	SERCH6		;YES SEE IF ANY OTHER DIRECTORY BLOCKS
	MOVE	G,2(E)		;TOP OF ENTRY CHAIN, THIS DIRECTORY
	HRLI	E,D

SERCH2:	MOVEI	B,(A)		;ANOTHER POINTER TO FIRST WORD OF STRING
	HRLZI	D,-4		;FOUR WORDS OF TEXT IN DIRECTORY
	HRRI	D,(G)		;WHERE THE ENTRY BLOCK STARTS
SERCH3:	MOVE	C,(B)		;A WORD OF THE ENTRY NAME
	CAME	C,@E		;SAME AS IN THE ENTRY BLOCK?
	JRST	SERCH5		;NO, TRY THE NEXT ENTRY BLOCK
	TRNN	C,376		;IS IT THE END OF THE NAME STRING?
	JRST	CPOPJ1		;YES, FOUND
	MOVEI	B,1(B)		;NEXT WORD IN STRING
	AOBJN	D,SERCH3	;NEXT WORD IN ENTRY BLOCK

	PUSH	P,A		;IN CASE .READ IS CALLED
	PUSH	P,E
	READ	@E,1		;READ FIRST DATA BLOCK INTO BUF 1

	HRLZI	H,440700	;COMPARE FULL NAME
	HRR	H,-1(P)
	PUSHJ	P,READC
	ILDB	B,H
	JUMPE	B,SERCH4	;END OF INPUT STRING
	CAIN	B,(C)
	JRST	.-4		;STILL SAME, TRY ANOTHER
	SETZ	C,		;SO THE NEXT TEST WILL LOSE

SERCH4:	POP	P,E
	POP	P,A
	CAIN	C,176		;DID THE ENTRY NAME ALSO END?
	JRST	CPOPJ1		;YES, R2

SERCH5:	MOVEI	D,DRENL-1(G)	;POINT AT DIREXTORY ENTRY CHAIN
	SKIPE	G,@E		;IS IT IN THIS DIRECTORY BLOCK
	JRST	SERCH2		;YES
SERCH6:	SKIPN	A,4(E)		;IS THERE ANOTHER DIRECTORY BLOCK
	POPJ	P,		;NO, DIDN'T FIND THE ENTRY
	MOVE	B,LBLOCK
	MOVEM	B,LDIRNO
	MOVE	B,1(E)		;NUMBER OF ENTRIES TDB
	MOVEM	B,LDIRL
	READ	A,0		;READ THE NEXT DIRECTORY BLOCK
	JRST	SERCH1		;YES, PROCESS IT
;ERASE ENTRY ROUTINE - USED BY ERASE ENTRY AND SAVE
;AFTER SEARCH E CONTAINS D,,BLOCKAD
; AND G CONTAINS OFFSET OF ENTRY INTO BLOCK

ERENRO:	MOVEI	D,4(G)		;POINTER TO ADDR OF FIRST DATA BLOCK
	MOVE	C,@E		;GET IT
	MOVEM	C,FILEAD	;AND SAVE IT FOR PUTTING ON LABS

	MOVEI	D,DRENL-1(G)	;POINT TO FORWARD CHAIN IN OBJECT
	MOVEI	C,(G)		;OFFSET OF OBJECT ENTRY
	EXCH	C,3(E)		;PUT IT ON TOP OF FREE CHAIN
	EXCH	C,@E		;AND TOP OF FREE CHAIN INTO IT
				;ENDING WITH REST OF USED LIST IN C
	SKIPA	D,[EXP 2]	;FIRST ENTRY IN THIS BLOCK
EREN1:	MOVEI	D,DRENL-1(A)	;POINT AT NEXT CHAIN ADDRESS
	MOVE	A,@E
	CAME	A,G		;DID THIS CELL POINT AT DELETED CELL
	JRST	EREN1		;NO
	MOVEM	C,@E		;RECHAIN LUDES
	ALTERD	0,D
	SOSG	A,1(E)		;DECREMENT NUMBER IN LUDES
	JRST	FLUSHTHISONE

	SKIPG	B,LDIRL		;PREVIOUS DIR BLOCK?
	 JRST	TRYAFTER	;NO 
	ADDI	B,(A)		;TOTAL NO,TDIRL+LDIRL
	CAILE	B,NENTRY	;WILL FIT IN ONE BLOCK?
	 JRST	TRYAFT		;NO, TRY TDIRL+'NDIRL'

;COMPACT LDIR WITH TDIR, PUTTING TDIR INTO LDIR
;THIS ORDER SO THAT IF LDIR IS NO 0 RECHAIN ALWAYS WINS

	MOVE	B,LBUF		;TAKE THIS DIRECTORY
	MOVEM	B,LBUF+1		;AND PUT IT IN BUF1
	MOVE	B,LBLOCK
	MOVEM	B,LBLOCK+1
	MOVE	B,FPTRL0
	MOVEM	B,FPTRL1
	READ	LDIRNO,0
COMPACT:
	MOVE	E,@FPTRL1
	HRLI	E,D
	MOVE	H,@FPTRL0
	HRLI	H,G		;AND OFFSET BY CONTENTS OF G
	MOVE	A,2(H)		;TOP OF LIST IN LDIR
	MOVEI	G,DRENL-1(A)
	SKIPE	A,@H
	JRST	.-2		;FIND END OF PREVIOUS LIST
	MOVE	A,3(H)
	MOVEM	A,@H	;END OF OLD LIST WILL NOW POINT TO LADES
	MOVE	D,2(E)		;POINT AT FIRST ENTRY TO BE COPIED
ERENLP:	MOVEI	G,(A)
	HRLZI	A,@E		;FROM
	HRRI	A,@H		;THE TO FREELIST
	MOVEI	G,DRENL-2(G)
	BLT	A,@H		;COPY AN ENTRY

	MOVEI	G,1(G)		;POINT TO POINTER TO NEXT FREE TO
	MOVE	A,@H		;NEXT TO BUFFER ADDRESS TO A
	MOVEI	D,DRENL-1(D)
	SKIPE	D,@E		;NEXT FREE FROM, IS IT END OF LIST
	JRST	ERENLP	;NO

	SETZM	@H		;END OF GOOD CHAIN
	MOVEM	A,3(H)
	ALTERD	0,D		;NOTE THAT BUF0 CHANGED

	MOVE	A,LBLOCK+1
	EXCH	A,LABS
	MOVEM	A,(E)		;PUT THE DIR BLOCK JUST FREED ON TOP OF BLOCK FREELIST
	MOVE	A,4(E)
	MOVEM	A,4(H)		;UPDATE DIRECTORY CHAIN
	MOVE	A,1(E)
	ADDM	A,1(H)		;AND COUNT OF USED ENTRIES IN DIRECTORY

	ALTERD	1,D		;NOTE THAT BUF1 CHANGED


ERENB:	MOVE	A,FILEAD	;PUT FILE BLOCKS ONTO FREELIST

ERENR:	READ	A,1
	MOVE	D,@FPTRL1
	SKIPE	A,(D)		;FIND THE END OF THE DATA CHAIN
	JRST	ERENR

	MOVE	B,LABS
	MOVEM	B,(D)		;LINK OLD BLOCK FREELIST TO END
	ALTERD	1,D

	READ	[0],0

	MOVE	A,@FPTRL0
	MOVE	B,FILEAD
	MOVEM	B,(A)
	MOVEM	B,LABS
	ALTERD	0,D
	POPJ	P,
TRYAFT:	SKIPN	A,4(E)		;IS THERE A NEXT DIRECTORY
	JRST	ERENB		;NO, JUST DELETE THE DATA BLOCKS
	READ	A,1		;READ IT
	MOVE	D,@FPTRL1
	MOVE	B,1(D)
	ADD	B,LDIRL
	CAILE	B,NENTRY
	JRST	ERENB		;TWO INTO ONE WON'T GO
	JRST	COMPACT

FLUSHTHISONE:
	SKIPN	A,LBLOCK	;IS THIS DIRECTORY 0
	JRST	FLUSH0		;YES
	EXCH	A,LABS		;PUT IT ON LABS
	MOVEM	A,(E)
	MOVE	H,4(E)		;CHAIN TO NEXT DIRECTORY
	READ	LDIRNO,0
	MOVE	A,@FPTRL0
	MOVEM	H,4(A)		;CHAIN THIS ONE
	ALTERD	0,D
	SKIPE	1(A)		;IS THIS ONE EMPTY TOO?
	JRST	ERENB
	MOVEI	E,(A)		;IT MUST BE DIR BLOCK 0, DELETE FILE

FLUSH0:	SKIPE	4(E)		;ARE THERE ANY OTHER DIRECTORIES?
	JRST	ERENB		;YES, LET THIS ONE BE
FOR TENEX,<MOVE A,INFILE	;DELETE THE FILE
	DELF
	 ERROR	IOPERR>
FOR TEN50,<
FOR LEVELC,<CLOSE	1,
	STATZ	1,740000
	 ERROR	IOPERR >
	SETZM	LUKDAT
	RENAME	1,LUKDAT
	 ERROR	IOPERR >
	POP	P,G		;RETURN LOC
	MOVEI	B,0		;SINCE THE FILE HAS BEEN DELETED MARK
	MOVE	B,LBUF(B)	;THAT THE FILE ENTRIES HAVE NOT BEEN
	SETZM	CHANGE(B)	;ALTERED SO THAT THERE WILL BE NO ATTEMPT
	MOVEI	B,1		;TO WRITE OUT THESE ALTERED BLOCKS--THIS
	MOVE	B,LBUF(B)	;HAS BEEN CAUSING BAD MESSAGES TO BE PRINTED
	SETZM	CHANGE(B)	;WHEN THE LAST ENTRY WAS ERASED
	JRST	(G)		;RETURN
CLRDIR:	MOVE	E,@FPTRL0	;ADDRESS OF FIRST WORD OF BUFFER
	SETZM	1(E)		;NUMBER OF DIRECTORY CELLS USED
	SETZM	2(E)		;LUDES - LIST USED DIRECTRY ENTRIES
	MOVEI	D,10		;REL PTR TO FIRST AVAILABLE DIR CELL
	MOVEM	D,3(E)		;LADES - LIST AVAIL DIR ENTRY CELLS
	SETZM	4(E)		;POINTER TO CONTINUATION BLOCK OF DIRECTORY
	MOVEI	E,10(E)		;POINT TO FIRST CELL
	MOVEI	D,DRENL(D)	;REL ADDR OF NEXT CELL
	MOVEM	D,DRENL-1(E)	;SET FORWARD PTR OF THIS CELL TO NEXT
	MOVEI	E,DRENL(E)	;POINT AT NEXT CELL
	CAIE	D,LBLKL-DRENL
	JRST	.-4
	SETZM	DRENL-1(E)
	POPJ	P,

WRITIF:	MOVE	B,LBUF(B)	;WHICH PHYSICAL BUFFER?
WRITF1:	SKIPE	CHANGE(B)	;IS THE DATA CHANGED?
	JRST	WRITIT		;NEEDS WRITING
	POPJ	P,

.FORCE:	MOVE	B,LBUF(E)	;PHYS BUF

WRITIT:	SETZM	CHANGE(B)	;WILL NO LONGER NEED REWRITING
FOR TEN50,< MOVE	A,PBLOCK(B)
	USETO	1,1(A)
	HRRZ	A,BUFLOC(B)
	SUB	A,[XWD PBLKL,1]	;REST OF IOWD
	MOVEM	A,DMPLST
	OUT	1,DMPLST		;DUMP MODE, CHANNEL 1,
	SKIPA
	 ERROR	IOPERR >
	POPJ	P,

FOR TEN50,<
.MARK:	MOVE	E,LBUF(E)
	SETOM	CHANGE(E)
	POPJ	P, >


OPENW:
FOR TENEX,<MOVE	A,[XWD 400000,1]
	MOVEM	A,JFNTAB
	MOVEI	A,JFNTAB
	GTJFN
	 JRST	(H)
	SIZEF
	 ERROR IOPERR
	JUMPN	3,[ PUSH P,1
		MOVEI 2,100000
		OPENF
		 ERROR IOPERR
		HRLZ 1,1
		FFUFP
		 ERROR IOPERR
		EXCH 2,1
		PMAP
		EXCH 2,1
		SOJG 3,.-5
		POP P,1
		TLO 1,-1
		CLOSF
		 ERROR IOPERR
		TLZ 1,-1
		JRST .+1 ]
	MOVE	G,[XWD 070000,700200]
	JRST	OPNRW1 >
FOR TEN50,<SETZM	FILSIZ
	JRST	OPNRW1>

CLOSIT:
FOR TEN50,<	MOVEI	B,0
	PUSHJ	P,WRITF1
	MOVEI	B,1
	PUSHJ	P,WRITF1
	CLOSE	1,
	RELEAS	1,
	SETZM	BUFLOC
	SETZM	BUFLOC+1	;DEALLOCATE THE BUFFERS
	SETZM	BUFADR
	SETZM	BUFADR+1
>
FOR TENEX,<
	HRLZI	E,-2		;REMOVE THE PAGES OF BUFFER
	MOVE	B,BUFLOC(E)	;FROM THE MAP OF FORK
	ASH	B,-11
	HRLI	B,400000
	SETO	A,
	PMAP
	AOBJN	E,.-5
	HRRZ	A,INFILE
	CLOSF
	 ERROR	IOPERR >
	POPJ	P,

;READ A BLOCK INTO A BUFFER
;CALLED WITH LOGICAL BUFFER NUMBER IN E
; AND WITH LOGICAL BLOCK NUMBER IN C

.READ:	MOVEM	C,LBLOCK(E)	;THIS LOGICAL BUFFER WILL CONTAIN THIS BLOCK
	HRLZI	A,-2		;# OF PHYSICAL BUFFERS

	MOVEI	D,(C)		;FIRST CHECK IF LOGICAL BLOCK IS
	XOR	D,PBLOCK(A)	; IN ONE OF THE PHYSICAL BUFFERS
	TRNN	D,-NLOGB	;# OF LOGICAL BUFFERS IN ONE PHYS ONE
	JRST	.READ7		;ALREADY IN A BUFFER
	AOBJN	A,.-4		;TRY THE OTHER ONE

;THE LOGICAL BLOCK IS NOT IN EITHER PHYSICAL BUFFER
;THEREFORE THE PHYSICAL BUFFER USED BY THE REQUESTED LOGICAL ONE
; IS PREFERABLE UNLESS IT IS ALSO USED BY THE OTHER LOGICAL ONE TOO

	MOVE	A,LBUF		;THE PHYS BUFFER USED BY LOGICAL BUFFER 0
	XOR	A,LBUF+1
	TRON	A,BUFBIT	;ARE BOTH USING THE SAME PHYSICAL BUFFER?
	XORM	A,LBUF(E)	;YES, SWITCH THE BUF THIS ONE USES

	MOVEI	B,(E)
	PUSHJ	P,WRITIF

	MOVE	B,LBUF(E)	;NOW READ THE REQUESTED BLOCK
	MOVE	A,LBLOCK(E)	;WHAT PART OF FILE TO READ

FOR TENEX,<	MOVE	B,BUFLOC(B)	;PHYSICAL BUFFER LOCATION
	ASH	A,-2	;MUST PARAMETERIZE LOG BASE 2 OF NLOGB
	ASH	B,-11		;2^9 WORDS PER PAGE
	HRLI	B,400000
	HRL	A,INFILE
	HRLZI	C,140000	;READ AND WRITE ACCESS PERMITTED
	PMAP		>
FOR TEN50,<USETI 1,1(A)
	HRRZ	A,BUFLOC(B)
	SUB	A,[XWD PBLKL,1]	;REST OF IOWD
	MOVEM	A,DMPLST
	IN	1,DMPLST
	SKIPA
	 ERROR	IOPERR >

.READ3:	MOVE	C,LBUF(E)	;GET PHYSICAL BUFFER NUMBER
	MOVEI	B,FPTR(C)	;GET PHYSICAL POINTER LOCATION
	MOVEM	B,FPTRL0(E)	;STORE ITS ADDRESS IN LOGICAL PTR
	MOVEI	A,NLOGB-1	;SET UP POINTER TO THE BLOCK
	AND	A,LBLOCK(E)
	IMULI	A,LBLKL		;NUMBER OF WORDS IN A LOGICAL BLOCK
	ADD	A,BUFLOC(C)
	HRLI	A,010700
	MOVEM	A,FPTR(C)
	MOVEI	B,5*<LBLKL-1>
	MOVEM	B,CCOUNT
	MOVE	B,LBLOCK(E)
	MOVEM	B,PBLOCK(C)
	POPJ	P,

.READ7:	HRRZM	A,LBUF(E)	;MAKE THE LOGICAL BUFFER USE THAT PBUF
	JRST	.READ3		;SET UP POINTERS AND EXIT

FOR TENEX,<
FILEGO:	PUSH	S,CBOT
	PUSHJ	P,GETFLN
	PUSHJ	P,GETFLN
FILEGA:	MOVE	B,-1(S)
	MOVEI	A,10		;NUMBER OF WORDS FOR TENEX
	CAMGE	A,@WSB		;WILL THE NAME FIT?
	 ERROR	FILER9		;NOT IMPLEMENTED
	MOVEI	B,@WSB		;COMPUTE ABS ADDR OF STRING
	MOVEI	B,1(B)		;FIRST WORD OF TEXT
	MOVEM	B,JFNTAB+4	;FILE NAME SLOT

	MOVEI	B,[ASCIZ /LGO/]
	MOVEM	B,JFNTAB+5	;EXT

	MOVE	A,[XWD 100000,1]
	MOVEM	A,JFNTAB
	MOVEI	A,JFNTAB
	MOVEI	B,0
	GTJFN
	 JRST	(H)		;NO FILE
	MOVE	G,[XWD 070000,701000]
OPNRW1:	JSP	D,SAVEUP	;SAVE CURRENT STATE OF LOGO
	PUSH	P,INFILE	;SAVE NAME OF CURRENT OPEN FILE
	MOVEM	A,INFILE
	HRLZ	A,LBLOCK+1	;LOGICAL BLOCK NUMBER OF DATA BLOCK
	HRR	A,CCOUNT	;NUMBER OF CHARS REMAINING IN THAT BLOCK
	PUSH	P,A		;A POINTER INTO THE ENTRY
	PUSH	P,BSP
	MOVE	B,SPP
	MOVEM	B,BSP
	TLO	F,GETF
	MOVE	A,INFILE
	MOVE	B,G
	OPENF
	 JRST	(H)
	SIZEF
	 JRST	(H)
	MOVEM	C,FILSIZ
	MOVEI	A,400000
	MOVEM	A,BUFLOC
	MOVEI	A,401000
	MOVEM	A,BUFLOC+1
	SETOM	PBLOCK
	SETOM	PBLOCK+1	;NO PAGES IN THE BUFFERS
FILUPD:	JRST	1(H)		;LABEL ADDED BY A.G.SMITH--MEANS MODIFICATIONS
				;AT SAVE: AND ERASEN: HAVE NO EFFECT IN TENEX
>

FOR TEN50,<
FILEGO:	PUSH	S,CBOT
	PUSHJ	P,GETFLN
	PUSHJ	P,GETFLN
FILEGA:	MOVE	B,-1(S)
	HRLI	B,(POINT 7,(W),34)
	MOVE	A,[POINT 6,LUKDAT]
	SETZM	LUKDAT
	MOVEI	D,6
FILGO1:	ILDB	C,B
	JUMPE	C,FILGO2
	XORI	C,40		;7 TO 6 BIT CODE
	IDPB	C,A		;STORE IN LUKDAT
	SOJG	D,FILGO1
	ILDB	C,B
	JUMPN	C,[ERROR FILER9] ;FILE NAME TOO LONG, TEMP ERR

FILGO2:	INIT	1,17		;INIT IN DUMP MODE
	 SIXBIT	/DSK/
	 Z
	 ERROR	IOPERR

	HRLZI	C,(SIXBIT /LGO/)
	MOVEM	C,LUKDAT+1	;EXT
	SETZM	LUKDAT+2
	SETZM	LUKDAT+3

	LOOKUP	1,LUKDAT
	 JRST	(H)		;FILE BUSY OR SOMETHING
	HLRE	A,LUKDAT+3	;LENGTH OF FILE
	JUMPG	A,.+3		;ALREADY IN BLOCKS
	ASH	A,-7
	MOVNI	A,(A)		;MAKE -WORDS +BLOCKS
	HRRZM	A,FILSIZ
	SETZM	LUKDAT+3	;THIS PRJ PROG AGAIN
	JRST	FILGO3		;DON'T OPEN FILE FOR WRITING IF JUST READING

OPNRW1:	ENTER	1,LUKDAT
	 JRST	(H)

FILGO3:	JSP	D,SAVEUP
	PUSH	P,INFILE
	MOVEM	A,INFILE
	HRLZ	A,LBLOCK+1
	HRR	A,CCOUNT

	PUSH	P,A
	PUSH	P,BSP
	MOVE	B,SPP
	MOVEM	B,BSP
	TLO	F,GETF

	HRLZI	C,-2		; ASSIGN 2 BUFFERS IN WS
OPNRW2:	MOVEI	A,LBLKL
	PUSHJ	P,MAKELM
	MOVEM	B,BUFADR(C)
	MOVEI	B,@WSB
	MOVEI	B,1(B)
	MOVEM	B,BUFLOC(C)
	AOBJN	C,OPNRW2

	SETOM	PBLOCK
	SETOM	PBLOCK+1
	JRST	1(H)

;CALL HERE AFTER OPENING FILE FOR READING IF WANT TO UPDATE IT
FILUPD:	ENTER	1,LUKDAT
	 JRST	(H)
	JRST	1(H)
>

CLOSUP:	PUSHJ	P,CLOSIT
	MOVE	A,BSP
	ADD	A,[XWD -2,3]	;TWO OFF THE S, 3 XTRA LEFT ON P
	JSP	C,SETPDL

	POP	P,BSP
	POP	P,A
	HRRZM	A,CCOUNT
	HLRZM	A,LBLOCK+1
	POP	P,INFILE
	JSP	D,RESTOR
	SKIPE	INFILE	;IS THE POPPED FILE THE TERMINAL?
	JRST	(H)
	TLZ	F,GETF
	MOVE	A,TERMIO
	MOVEM	A,CHIN
	JRST	(H)
LFILE:	POP	P,A
	PUSH	S,CBOT
	PUSHJ	P,GETFLN	;ONLY ONE INPUT
	PUSH	S,(S)		;DUMMY UP ANOTHER
	JSP	H,FILEGA
	 ERROR	NOFILE
	SETZ	A,
LFILE1:	READ	A,0
	HRRZ	E,@FPTRL0
	SKIPN	1(E)		;IS THIS DIRECTORY BLOCK EMPTY?
	JRST	LFIL10		;YES TRY NEXT
	HRLI	E,D
	MOVE	D,2(E)		;TOP OF LIST OF USED ENTRY SLOTS

LFILE2:	HRLZI	G,440700
	HRRI	G,@E		;FOR THE FIRST 20 CHARS OF ENTRY NAME
	MOVNI	H,^D20
	ILDB	C,G
	JUMPE	C,LFILE9	;EOM IS 0 IN DIRECTORY
	XCT	CHOUT
	AOJN	H,.-3
	PUSH	P,E
	PUSH	P,D		;READ FILE FOR THE REST OF THE GOODIES
	READ	1(G),1
	MOVEI	A,4
	ADDM	A,@FPTRL1	;SKIP TYPING FIRST TWENTY CHARS AGAIN
	MOVNI	A,4*5
	ADDM	A,CCOUNT
	PUSHJ	P,READC
	CAIN	C,176
	JRST	.+3
	XCT	CHOUT
	JRST	.-4
	POP	P,D
	POP	P,E

LFILE9:	PUSHJ	P,CRLF
	MOVEI	D,DRENL-1(D)
	SKIPE	D,@E
	JRST	LFILE2	;NEXT ENTRY IN THIS DIRECTORY
LFIL10:	SKIPE	A,4(E)
	JRST	LFILE1	;NEXT DIRECTORY BLOCK
	JRST	REDEOF
SAVANR:	PUSH	P,A
	PUSHJ	P,FINDAG
	SKIPA			;R1_FOUND ONE, R2_NO GLOBAL VAL
	JRST	APOPJ		; DON'T SAVE IF NO GLOBAL BINDING
	MOVSI	A,UNBOUN
	TDNE	A,1(C)		; OR IF UNBOUND
	JRST	APOPJ
	PUSH	P,C
	MOVEI	A,[ASCIZ /MAKE /]
	PUSHJ	P,PTOSSM
	MOVE	A,-1(P)	;WHAT NAME
	MOVE	A,(A)	;NAME OF THING
	MOVEI	E,024	;PSEUDO-QUOTE
	TRO	F,PREFIX!SUFFIX
	PUSHJ	P,PTOSS
	POP	P,-1(P)
	PUSHJ	P,PSPACE
	JRST	LSTNR1

SAVAAR:	MOVEI	A,[ASCIZ /ABBREVIATE /]
	PUSHJ	P,PTOSSM
	MOVEI	E,024
	TRO	F,PREFIX!SUFFIX
	MOVE	A,1(G)
	PUSHJ	P,PTOSS
	MOVEI	A,[ASCIZ / AS /]
	PUSHJ	P,PTOSSM
	MOVE	A,(G)
	TRO	F,PREFIX!SUFFIX		;QUOTE THIS ONE TOO
	PUSHJ	P,PTOSS
	JRST	CRLF



GETFLN:	PUSHJ	P,GNE	
	 ERROR	ERMSSG
	TLNN	A,UPRF	
	 ERROR	FILER1
	MOVEI	A,-1(A)
	PUSH	S,@RPA
	POPJ	P,


SUBTTL	TURTLES OF VARIOUS KINDS

FOR TURTLE,<
BACK:	SKIPA	B,[[BYTE (7) 16,177,177,177,177,177,177,0]]
FRONT:	MOVEI	B,[BYTE (7) 1,177,177,177,177,177,177,0]
	JRST	TURTEL

RIGHT:	SKIPA	B,[[BYTE (7) 10,177,177,177,177,0]]
LEFT:	MOVEI	B,[BYTE (7) 26,177,177,177,177,0]
	JRST	TURTEL

HORN:	MOVEI	B,[BYTE (7) 35,177,177,0]
TURTEL:	PUSHJ	P,TOSS		;DO IT
	JRST	COMEX

TOUCHE:	MOVEI	A,101	;TERMINAL OUTPUT
	DOBE		;WAIT FOR EMPTY BUFFER

	MOVEI	A,100	;TERMINAL INPUT
	SIBE		;INPUT BUFFER EMPTY
	JRST	TOUCH1	;NO
	MOVEI	A,200	;8*16MS GTR 1 CHAR TIME
	DISMS		;WAIT FOR A POSSIBLE CHAR

	MOVEI	A,100
	SIBE		;DID A CHAR COME IN?
	JRST	.+2	;YES
	JRST	ISFALSE	;DIDN'T TOUCH ANYTHING

TOUCH1:	BIN
	JRST (D)

TOUCHLEFT:
	JSP D,TOUCHE	;GET A TOUCH CHAR
	CAIE	B,20	;CONTROL P
	JRST	ISFALSE
	JRST	ISTRUE

TOUCHRIGHT:
	JSP D,TOUCHE
	CAIE	B,22	;CONTROL-R
	JRST	ISFALSE
	JRST	ISTRUE >
FOR MOCKTURTLE,<
HOME:	SETZM	CURX		;REAL
	SETZM	CURY		;REAL
	SETZM	CURA		; INTEGER DEGREES
	SETZM	PENPOS		; 0=DOWN
	PUSHJ	P,SENDUP	; SEND POSITION TO DISPLAY
	JRST	COMEX

PENUP:	SETOM	PENPOS
	JRST	COMEX
PENDN:	SETZM	PENPOS
	JRST	COMEX

SETXY:	PUSHJ	P,SETXYR
SETXYO:	PUSHJ	P,SENDUP
SETXYP:	POP	S,A
	JRST	COMEX

SETX:	PUSH	P,[SETXYO]
SETXR:	PUSHJ	P,FLOTA1	; GET FIRST ARG
	MOVE	E,M		; X POS IN E
	MOVE	M,CURY		; Y POS IN M (SAME)
	JRST	SETXY1		;SET BOTH X AND Y

SETY:	PUSH	P,[SETXYO]
SETYR:	PUSHJ	P,FLOTA1
	MOVE	E,CURX
	JRST	SETXY1

SETXYR:	PUSHJ	P,FLOTA1
	MOVE	E,M		; GET X FIRST
	PUSHJ	P,FLOTARG	; THEN GET Y
SETXY1:	CAMN	E,CURX
	CAME	M,CURY
	SKIPA			; AT LEAST ONE IS DIFFERENT
	JRST	CPOPJ1		; R2, SKIP OVER THE PUSHJ P,SEND
	MOVEM	E,CURX
	MOVEM	M,CURY
	POPJ	P,		; R1, DO THE SEND

SETTURTLE:	PUSH	P,[SETXYO+1]
	PUSHJ	P,SETXYR
	SOS 0(P)	; NOT SKIP RETURN, REFLECT THIS
	PUSHJ	P,INTARG	; GET THIRD ARG
	PUSHJ	P,MOD360
	MOVEM	N,CURA
	POPJ P,
SETHEADING:	PUSHJ	P,INTAR1
SETHE1:	PUSHJ	P,MOD360
	MOVEM	N,CURA	; WHEN SENDING WEDGES, CHECK FOR A .NE. CURA
	JRST	SETXYP	; CHANGING ONLY ANGLE, NO NEED TO SEND X OR Y

LEFT:	PUSHJ	P,INTAR1
	MOVNS	M
	SKIPA
RIGHT:	PUSHJ	P,INTAR1
	ADD	M,CURA
	JRST	SETHE1
HERE:	PUSHJ	P,NEWSTR
	MOVE	M,CURX
	PUSHJ	P,FIXSNM
	MOVE	M,CURY
	PUSHJ	P,FIXSNM
	MOVE	M,CURA
	PUSHJ	P,SNM0
	TRO	F,NWF		; THIS IS A SENTENCE
	PJRST	ENDSTR


BACK:	PUSHJ	P,INTAR1
	MOVNS	M
	PUSHJ	P,FLOAT
	SKIPA
FRONT:	PUSHJ	P,FLOTA1
	PUSH	P,M
	MOVE	M,CURA
	PUSHJ	P,FLOAT
	MOVE	A,M		;SAVE ANGLE IN M
	PUSHJ	P,SIND		;SIN WHERE ONE WOULD EXPECT COS
	FMPR	A,(P)		; DISTANCE ON STACK
	FADR	A,CURX
	PUSH	P,A		; NEW X ON STACK
	MOVE	A,M
	PUSHJ	P,COSD	; BECAUSE COORD SYSTEM IS MIRRORED ON X=1,Y=1
	POP	P,E		; NEW X LOC
	POP	P,M		; FLUSH DISTANCE
	FMPR	M,A
	FADR	M,CURY
	PUSH	P,[MOVXYO]
	JRST	SETXY1


MOVE:	PUSHJ	P,SETXYR
MOVXYO:	PUSHJ	P,SENDIT	; SENSITIVE TO PENPOS
	POP	S,A
	JRST	COMEX


FIXSNM:	PUSHJ	P,FIX
	JUMPGE	M,.+4		; POSITIVE NUMBER
	MOVNS	M
	MOVEI	C,"-"
	IDPB	C,B		; SIGN AND MAGNITUDE
	PUSHJ	P,SNM0
	PJRST	DSPACE		; SPACE AFTER FIRST TWO OF HERE

FIX:	PUSH	P,M
	MOVMS	M
	FADR	M,[0.5]		; ROUND
	MULI	M,400
	EXCH	M,N
	ASH	M,-243(N)
	SKIPGE	0(P)
	MOVNS	M
	POP	P,N
	POPJ	P,
>
FOR MOCKTURTLE!NRCTUR,<

FLOTA1:	MOVSI	M,10700+W
	HLLM	M,0(S)		; INITIALIZATION FOR FIRST CALL
FLOTAR:	PUSHJ	P,INTARG
FLOAT:	IDIVI	M,400
	SKIPE	M
	TLC	M,243000
	TLC	N,233000
	FADL	M,N
	POPJ	P,

INTAR1:	MOVSI	M,10700+W
	HLLM	M,0(S)
INTARG:	MOVE	L,(S)
	TRO	F,PMF		; + AND - PERMITTED IN THIS STRING
	PUSHJ	P,DNM+1		; BEWARE!!!
	 ERROR	ZERERR
	 ERROR	MAGNER		; NUMBER MUCH TOO BIG

	MOVEM	L,(S)
	POPJ	P,
MOD360:	IDIVI	M,^D360
	CAIGE	N,0
	ADDI	N,^D360
	POPJ	P,
;WINNING SIN, COS ROUTINES, LIFTED, MINUS COMMENTS, FROM LIB
;ARG AND VALUE IN A, DESTROYS B AND C
;AND STRIPPED OF ALL WASTE MOTION SAVING AC'S

COSD:	FADR	A, [90.0]
SIND:	FDVR	A, [57.295779]
	MOVM	B,A
	CAMG	B, [XWD 170000,0]
	POPJ	P,
	FDV	B, [1.5707963]
	CAMG	B, [1.0]
	JRST	S2
	MULI	B, 400
	LSH	C, -202(B)
	TLZ	C, 400000
	MOVEI	B, 200
	ROT	C, 3
	LSHC	B, 33
	FAD	B, [0]
	JUMPE	C, S2
	TLCE	C, 1000
	FSB	B, [1.0]
	TLCE	C, 3000
	TLNN	C, 3000
	MOVNS	B
S2:	SKIPGE	A
	MOVNS	B
	MOVEM	B, A
	FMPR	B, B
	MOVE	C, [0.00015148419]
	FMP	C, B
	FAD	C, [-0.00467376557]
	FMP	C, B
	FAD	C, [0.07968967928]
	FMP	C, B
	FAD	C, [-0.64596371106]
	FMP	C, B
	FAD	C, [1.5707963]
S2B:	FMPR	A, C
	POPJ P,
>		;END OF ROUTINES OF INTEREST FOR NRC SCREEN TURTLE
FOR MOCKTURTLE,<

WIPE:	PUSHJ	P,WIPIT
	JRST	COMEX

SENDUP:	PUSH	P,PENPOS
	SETOM	PENPOS
	PUSHJ	P,SENDIT
	POP	P,PENPOS
	POPJ	P,

SENDIT:	MOVSI	E,-2
SENDT1:	MOVE	M,CURX(E)
	PUSHJ	P,FIX
	ADDI	M,SCRNSZ/2
	CAIL	M,0
	CAILE	M,SCRNSZ
	ERROR	OFSCRN
	MOVEM	M,TURX(E)
	AOBJN	E,SENDT1
	PJRST	SENDXY

OPNTUR:	HRROI	1,[ASCIZ /
TURTLE PORT?  /]
	PSOUT
	MOVSI	1,460003
	MOVE	2,[XWD 100,101]
	GTJFN
	 ERROR	TNXERR
	MOVE	2,[10B5+1B20]	;BINARY, OUTPUT USE
	OPENF
	 ERROR	TNXERR
	MOVEM	1,TURJFN
	PUSHJ	P,WIPIT
	PUSH	P,TURX
	PUSH	P,TURY
	SETZM	TURX
	SETZM	TURY
	PUSHJ	P,SENDUP	; QUICK AND DIRTY HOME
	POP	P,TURY
	POP	P,TURX
	POPJ	P,

FOR COMPTK,<
SCRNSZ==^D800
SENDXY:	SKIPN	1,TURJFN	; BEWARE THAT ER ALL DOES NOT KILL IT
	PUSHJ	P,OPNTUR
	MOVE	2,TURY
	PUSHJ	P,SPLIT
	SKIPE	PENPOS
	TRZ	2,1
	PUSHJ	P,SENDON
	MOVE	2,3
	PUSHJ	P,SENDON
	MOVE	2,TURX
	PUSHJ	P,SPLIT
	PUSHJ	P,SENDON
	MOVE	2,3
SENDON:	TRNN	2,40
	TRO	2,100
	BOUT
	POPJ	P,

SPLIT:	IDIVI	2,20
	EXCH	2,3
	ROT	2,2
	IORI	2,3
	POPJ	P,

WIPIT:	SKIPN	1,TURJFN
	PUSHJ	P,OPNTUR
	MOVE	2,[POINT 8,WIPSTR]
	SETZ	3,
	SOUT
	DOBE			; WAIT FOR ^L TO GET OUT
	MOVEI	1,^D500
	DISMS
	MOVE	1,TURJFN
	POPJ	P,
WIPSTR:	BYTE (8) 100,100,100,100,27,6,34,137,100,100,100,100,6,14,34,0
>

FOR MITREI,<
SCRNSZ==^D1023
SENDXY:	SKIPN	1,TURJFN
	PUSHJ	P,OPNTUR
	MOVEI	2,3		; MOVE OP CODE
	SKIPE	PENPOS
	MOVEI	2,2		; SET PTR OP CODE
	BOUT
	MOVSI	4,-2
SNDXY1:	MOVE	2,TURX(4)
	IDIVI	2,200		; LOW ORDER 7 BITS IN SECOND BYTE
	BOUT
	MOVE	2,3
	BOUT
	AOBJN	4,SNDXY1

	SKIPE	PENPOS	; YES, BUT WAS IT A MOVE?
	POPJ	P,		;NO
	DOBE			; WAIT FOR ALL TURTLE CHARS TO GET OUT
	MOVEI	1,^D350
	DISMS			; AND WAIT ONE SECOND MORE
	POPJ	P,

WIPIT:	SKIPN	1,TURJFN
	PUSHJ	P,OPNTUR
	MOVEI	2,1
	BOUT
	POPJ	P,
>
>
FOR NRCTUR,<
BACK:	PUSHJ	P,FLOTA1	;GET ONE INTEGER ARGUMENT AND FLOAT IT
	MOVNS	M		;BACK IS INVERSE OF FORWARD
	SKIPA
FORWARD:PUSHJ	P,FLOTA1
	MOVE	B,[XWD TURNYH,TUROYH]
	BLT	B,TUROFY	;SAVE CURRENT COORDINATES AS OLD
	MOVE	A,ORIENT	;NOW GET TURTLE'S ORIENTATION
	FSC	A,233		;FLOAT IT
	PUSHJ	P,COSD		;CALCULATE COSINE(ORIENTATION ANGLE)
	FMPR	A,M		;MULTIPLY BY COMMAND ARGUMENT (RANGE)
	FADRM	A,TURNFX	;ADD TO PREVIOUS X
	MOVE	A,ORIENT
	FSC	A,233
	PUSHJ	P,SIND		;CALCULATE SINE(ORIENTATION ANGLE)
	FMPR	A,M		;MULTIPLY BY RANGE
	FADRM	A,TURNFY	;ADD TO PREVIOUS Y
	POP	S,A		;FLUSH ARGUMENT OF COMMAND

;POSITION IS NOW UPDATED IN VIRTUAL SPACE.  CALCULATE HOW MUCH,
;IF ANY, OF THE VECTOR IS VISIBLE ON THE PHYSICAL SCREEN AND DISPLAY AS MUCH.

	PUSHJ	P,CALCVS	;CALCULATE VISIBLE PORTION OF VECTOR
	 JRST	COMEX		;RETURN 1 -- POSITION WAS AND IS OFF-SCREEN
	PUSHJ	P,TURBYT	;CONVERT TO TERMINAL BYTES
	TROE	F,GRAPHF	;IS GRAPH MODE ALREADY ON?
	JRST	TURCON		;YES, CURSOR POSITION IS AS EXPECTED
	MOVEI	C,GRFON		;NO, SET GRAPHIC MODE AGAIN.
	PUSHJ	P,TYO0
FOR PLSTUR,<
	MOVEI	C,CNTRLB	;SET FOR CURSOR POSITIONING
	PUSHJ	P,TYO0		;
	MOVEI	C,PCHAR		;
	PUSHJ	P,TYO0		;
	MOVE 	C,TUROXH
	PUSHJ	P,TYO0
	MOVE	C,TUROXL
	PUSHJ	P,TYO0
	MOVE	C,TUROYH
	PUSHJ	P,TYO0
	MOVE	C,TUROYL
	PUSHJ	P,TYO0
>
FOR TEKTUR,<
	HRLZI	M,-4		;SET AN INDEX FOR A LOOP OF 4 CHARACTERS
TURPP:	MOVE	C,TUROYH(M)	;GET BYTES FOR POSITION SPECIFICATION
	PUSHJ	P,TYO0		;SEND THEM ONE AT A TIME
	AOBJN	M,TURPP
TURCON:	MOVEI	C,GRFON		;PREPARE TO SEND A "DARK" VECTOR
	SKIPE	PENST		;IN CASE PEN IS RAISED
	PUSHJ	P,TYO0		;IT IS--MUST PRECEDE VECTOR WITH "GRFON" CH.
	PUSHJ	P,TURBYT	;GENERATE TERMINAL CONTROL BYTES
	MOVE	C,TURNYH	;NOW SEND THE NECESSARY BYTES
	CAME	C,TUROYH	;THERE ARE FOUR RULES:
	PUSHJ	P,TYO0		;(1) BYTES MUST BE SENT IN ORDER YH,YL,XH,XL
	MOVE	C,TURNXH	;(2) BYTE XL MUST ALWAYS BE SENT
	CAME	C,TUROXH	;(3) IF XH IS SENT, YL MUST BE SENT
	JRST	TURXHN		;(4) SUBJECT TO ABOVE CONSTRAINTS, BYTES
	MOVE	C,TURNYL	;    WHICH HAVE NOT CHANGED NEED NOT BE SENT
	CAME	C,TUROYL
	PUSHJ	P,TYO0
	JRST	TURLAS
TURXHN:	MOVE	C,TURNYL
	PUSHJ	P,TYO0
	MOVE	C,TURNXH
	PUSHJ	P,TYO0
TURLAS:	MOVE	C,TURNXL
	PUSHJ	P,TYO0
	JRST	COMEX		;THAT'S ALL
>

FOR PLSTUR<
TURCON:	MOVE 	C,PENST		;IS PEN UP?
	JUMPE	C,PNDOWN	;NO
	MOVEI	C,CNTRLB	;YES,NEXT POSITION JUST POSITIONS CURSOR
	PUSHJ	P,TYO0		;SO SEND CONTROL-B + P TO INDICATE THIS
	MOVEI	C,PCHAR		;
	PUSHJ	P,TYO0		;
PNDOWN:	MOVE	C,TURNXH	;SEND THE NECESSARY BYTES TO DRAW THE VECTOR
	CAME	C,TUROXH	;EACH (X,Y) POSITION IS TRANSMITTED AS A STRING OF
	PUSHJ	P,TYO0		;2,3, OR 4 CHARACTERS IN THE SEQUENCE XH,XL,YH,YL
	MOVE	C,TURNXL	;SUCH THAT XL AND YL ARE SENT FOR EVERY POSITION AND
	PUSHJ	P,TYO0		;XH AND/OR YH ARE SENT ONLY IF THEY HAVE CHANGED 
	MOVE	C,TURNYH	;FROM THE PREVIOUS POSITION.
	CAME	C,TUROYH
	PUSHJ	P,TYO0
	MOVE 	C,TURNYL
	PUSHJ	P,TYO0
	JRST	COMEX
>
;SUBROUTINE TO CALCULATE THE POINTS OF INTERSECTION OF THE EDGES OF THE VISIBLE
;SCREEN WITH THE LINE FROM OLD POSITION TO NEW POSITION IN VIRTUAL SPACE.

NXHF==1
NXLF==2
NYHF==4
NYLF==10
OXHF==20
OXLF==40
OYHF==100
OYLF==200
ALLXYF==377	;ALL THE ABOVE FLAGS
ALLOF==360	;THE "OLD" FLAGS

CALCVS:	TRZ	C,ALLXYF	;USE REGISTER C FOR LOCAL FLAGS
	MOVE	M,TURNFX	;GET END-POINT OF VECTOR, X
	PUSHJ	P,SFIXM		;SCALE AND FIX (CONVERT TO INTEGER)
	MOVE	A,M		;SAVE X IN A
	CAILE	M,HILIMX	;TEST HIGH
	TRO	C,NXHF		;RIGHT OF SCREEN
	CAIGE	M,LOLIMX	;TEST LOW
	TRO	C,NXLF		;LEFT OF SCREEN
	MOVE	M,TURNFY	;PICK UP Y
	PUSHJ	P,SFIXM		;SCALE AND FIX
	MOVE	B,M		;SAVE Y IN B
	CAILE	M,HILIMY	;TEST HIGH
	TRO	C,NYHF		;ABOVE SCREEN
	CAIGE	M,LOLIMY
	TRO	C,NYLF		;BELOW SCREEN
	MOVE	M,TUROFX	;FIGURE OUT WHERE WE CAME FROM
	PUSHJ	P,SFIXM		;COMPARE VECTOR ORIGIN WITH SCREEN LIMITS
	CAILE	M,HILIMX
	TRO	C,OXHF
	CAIGE	M,LOLIMX
	TRO	C,OXLF
	MOVE	M,TUROFY
	PUSHJ	P,SFIXM
	CAILE	M,HILIMY
	TRO	C,OYHF
	CAIGE	M,LOLIMY
	TRO	C,OYLF
	TRCN	C,ALLXYF	;WERE ANY FLAGS SET?
	AOSA	(P)		;NO, RETURN TO RETURN 2
	TRNN	C,NXHF+OXHF	;ARE NEW AND OLD X RIGHT OF SCREEN?
	POPJ	P,		;YES, RETURN 1 -- STILL OFFSCREEN
	TRNN	C,NXLF+OXLF	;ARE NEW AND OLD X LEFT OF SCREEN?
	POPJ	P,		;YES, AGAIN ENTIRE VECTOR IS OFF-SCREEN
	TRNN	C,NYHF+OYHF	;AND SO ON...
	POPJ	P,
	TRNN	C,NYLF+OYLF
	POPJ	P,
	TRC	C,ALLXYF	;RESTORE FLAGS TO THEIR SET STATE
	TRNN	C,ALLOF		;NOW, WAS THE PREVIOUS POINT ON-SCREEN?
	JRST	OXYOK		;YES, SO WE DON'T NEED TO WORRY ABOUT IT.
	TRNN	C,OXHF+OXLF	;NO
	JRST	OLDXOK		;OLD X IS WITHIN LIMITS
	MOVEI	A,HILIMX	;SET A TO PROPER LIMIT FOR X
	TRNE	C,OXLF
	MOVEI	A,LOLIMX
	PUSHJ	P,VEDGEX	;RECALCULATE CORRESPONDING Y
OLDXOK:	TRNN	C,OYHF+OYLF
	JRST	OXYSET		;OLD X AND Y ARE NOW PROPERLY SET IN A AND B
	TRNN	C,OXHF+OXLF	;HAS Y JUST BEEN RECALCULATED?
	JRST	OLDY2		;NO, Y IS STILL TOO HIGH
	CAIG	B,HILIMY	;YES, MAYBE OLD Y IS OK NOW.
	CAIGE	B,LOLIMY
	JRST	OLDY2		;NO SUCH LUCK
	JRST	OXYSET		;YES, OLD X AND Y ARE OK
OLDY2:	MOVEI	B,HILIMY	;ASSUME OLD Y WAS TOO HIGH
	TRNE	C,OYLF		;OR WAS IT TOO LOW?
	MOVEI	B,LOLIMY
	PUSHJ	P,VEDGEY	;RECALCULATE X ON THIS BASIS
	CAIG	A,HILIMX	;NOW SEE IF RECALCULATED X IS OK
	CAIGE	A,LOLIMX
	POPJ	P,		;NO, THE NEW VECTOR IS COMPLETELY OFF-SCREEN
OXYSET:	PUSHJ	P,TURBYT	;TIME TO CONVERT TO TERMINAL BYTES
	MOVE	M,[XWD TURNYH,TUROYH]
	BLT	M,TUROXL	;MUST MOVE BYTES TO WHERE THEY SHOULD BE
	TRZ	F,GRAPHF	;ALSO RESET GRAPH MODE SO CURSOR WILL
				; GET REPOSITIONED
OXYOK:	SETCMM	OFFSCR		;COMPLEMENT OFF-SCREEN STATE
	MOVE	M,TURNFX	;RE-CONVERT X AND Y
	PUSHJ	P,SFIXM
	MOVE	A,M
	MOVE	M,TURNFY
	PUSHJ	P,SFIXM
	MOVE	B,M
	TRNN	C,NXHF+NXLF	;IS NEW X WITHIN LIMITS?
	JRST	NEWXOK		;YES
	MOVEI	A,HILIMX	;NO, ASSUME IT IS TOO HIGH
	TRNE	C,NXLF		;UNTIL FLAG IS CHECKED
	MOVEI	A,LOLIMX
	PUSHJ	P,VEDGEX	;RECALCULATE Y
NEWXOK:	TRNN	C,NYHF+NYLF	;ANYTHING ELSE NEED ATTENTION?
	JRST	CPOPJ1		;NO, WE'RE DONE, RETURN TO RETURN 2
	TRNN	C,NXHF+NXLF	;HAS NEW Y JUST BEEN RECALCULATED?
	JRST	NEWY2		;NO
	CAIG	B,HILIMY	;YES, IS Y OK YET?
	CAIGE	B,LOLIMY
	JRST	NEWY2		;NO, IT IS STILL TOO FAR OUT
	JRST	CPOPJ1		;YES, WE'RE DONE AFTER ALL
NEWY2:	MOVEI	B,HILIMY	;HIGH?
	TRNE	C,NYLF
	MOVEI	B,LOLIMY	;LOW
	PUSHJ	P,VEDGEY	;RECALCULATE X
	JRST	CPOPJ1		;IF IT ISN'T WITHIN LIMITS, SOMETHING IS WRONG
VEDGEX:	MOVE	M,TURNFX
	FSBR	M,TUROFX	;(XN-XO)
	MOVE	N,A		;GET XEDGE
	FSC	N,233		;FLOAT IT
	FDVR	N,[TURSSC]	;NORMALIZE IT
	FSBR	N,TUROFX	;(XEDGE-XO)
	FDVR	N,M		;(XEDGE-XO)/(XN-XO) TO N
	MOVE	M,TURNFY
	FSBR	M,TUROFY	;(YN-YO) TO M
	FMPR	M,N		;(YN-YO)*((XEDGE-XO)/(XN-XO))
	FADR	M,TUROFY	;(YN-YO)*((XEDGE-XO)/(XN-XO))+YO
	PUSHJ	P,SFIXM		;SCALE AND FIX M
	MOVE	B,M		;STORE IN B
	POPJ	P,

VEDGEY:	MOVE	M,TURNFY	;COMPUTE (XN-XO)*((YEDGE-YO)/(YN-YO))+XO
	FSBR	M,TUROFY
	MOVE	N,B		;GET YEDGE
	FSC	N,233
	FDVR	N,[TURSSC]
	FSBR	N,TUROFY
	FDVR	N,M
	MOVE	M,TURNFX
	FSBR	M,TUROFX
	FMPR	M,N
	FADR	M,TUROFX
	PUSHJ	P,SFIXM
	MOVE	A,M
	POPJ	P,

TURBYT:	MOVE	M,A		;GET X CO-ORDINATE (KNOWN TO BE ON-SCREEN)
	IDIVI	M,^D32		;SEPARATE INTO HIGH AND LOW ORDER
	ADDI	M,HIXOFS	;ADD CHARACTER OFFSET
	MOVEM	M,TURNXH	;AND STORE
	ADDI	N,LOXOFS	;ADD OFFSET FOR LOW-ORDER
	MOVEM	N,TURNXL	;AND STORE LOW
	MOVE	M,B		;DO THE SAME FOR Y
	IDIVI	M,^D32
	ADDI	M,HIYOFS
	MOVEM	M,TURNYH
	ADDI	N,LOYOFS
	MOVEM	N,TURNYL
	POPJ	P,
	POPJ	P,
;COMMANDS FOR LEFT, RIGHT, HOME, PAGE, PENUP, PENDOWN, AND (TEST) OFFSCREEN

RIGHT:	PUSHJ	P,INTAR1	;GET AN INTEGER ARGUMENT
	MOVNS	M		;RIGHT IS INVERSE OF LEFT
	SKIPA
LEFT:	PUSHJ	P,INTAR1
	ADD	M,ORIENT	;ADD TO CURRENT ORIENTATION
	PUSHJ	P,MOD360	;CORRECT IT MOD 360
	MOVEM	N,ORIENT
	POP	S,A		;FLUSH ARGUMENT
	JRST	COMEX

PENUP:	SETOM	PENST		;RAISE PEN
	JRST	COMEX
PENDN:	SETZM	PENST		;LOWER PEN
	JRST	COMEX

HOME:	PUSHJ	P,TURRST
	JRST	COMEX

TURRST:	MOVE	A,[POINT 7,[TURHOM]]
	HRLZI	B,-4		;SET UP A LOOP INDEX
	ILDB	C,A		;PICK UP THE CHARACTERS DEFINING HOME
	MOVEM	C,TURNYH(B)	;STORE THE FOUR POSITION BYTES
	AOBJN	B,.-2
	ILDB	C,A		;THEN GET THE HOME ORIENTATION
	MOVEM	C,ORIENT	;AND SET IT BACK
	MOVE	C,[TURHMX]	;SET ALSO THE BASIC POSITION LOCATIONS
	MOVEM	C,TURNFX
	MOVE	C,[TURHMY]
	MOVEM	C,TURNFY
	SETZM	PENST		;LOWER PEN
	SETZM	OFFSCR		;AND NOTE THAT WE ARE NOW ON-SCREEN
	TRZ	F,GRAPHF	;CLEAR THE GRAPHICS MODE FLAG, SO THAT
	POPJ	P,		;TERMINAL WILL BE SET PROPERLY.

TOFFSC:	SKIPE	OFFSCR		;THIS IS A BOOLEAN FUNCTION
	JRST	ISTRUE		;WHICH IS TRUE IF PEN IS OFF-SCREEN
	JRST	ISFALSE		;AND FALSE IF PEN IS ON-SCREEN

PAGE:	MOVEI	B,[NEWPAG]	;GET ADDRESS OF NEW PAGE STRING.
	PUSHJ	P,TOSS	;AND SEND IT OUT
	JRST	COMEX
SFIXM:	PUSH	P,M		;SAVE ARGUMENT FOR SIGN
	FMPR	M,[TURSSC]	;MULTIPLY BY SCREEN SCALE FACTOR
	MOVM	M,M		;WORK WITH ABSOLUTE VALUE
	MULI	M,400		;SEPARATE FRACTION & EXPONENT
	EXCH	M,N		;GET MANTISSA BACK IN M
	CAIL	N,243		;IS ABSOLUTE VALUE TOO HIGH?
	SKIPA	M,[377777777777]	;YES, SET TO MAXIMUM INTEGER
	ASHC	M,-243(N)	;NO, USE EXPONENT TO CALCULATE SHIFT
	TLNE	N,200000	;ROUND IF NECESSARY
	ADDI	M,1		;
	POP	P,N		;GET BACK ORIGINAL ARGUMENT
	SKIPGE	N		;TO CORRECT THE SIGN
	MOVN	M,M
	POPJ	P,		;AND EXIT
>
SUBTTL	MUSIC SYSTEM

FOR MUSIC,<
MBLGTH==^D300		;ROOM FOR 1800 CHARACTERS--1 MINUTE AT 300 BAUD
MBINCR==^D300		;SIZE OF ADDITIONAL REQUESTS

;VOICES
VOICES:	PUSHJ	P,INTAR1	;GET AN INTEGER ARGUMENT
	CAIL	M,1		;MUST BE IN RANGE 1-4
	CAILE	M,4
	ERROR	MBVOC		;OTHERWISE ERROR MESSAGE
	MOVEM	M,NVOICE
	JRST	COMXS1

;MBUFCOUNT
MBCNT:	HLRZ	B,MBPOS		;OUTPUT THE CURRENT BUFFER COUNT
	ANDI	B,(77B5)	;GET JUST THE BYTE POSITION PART OF POINTER
	IDIVI	B,(6B5)		;CHARACTERS ARE 6 BITS LONG
	HRRZI	M,@MBPOS	;NOW ADD FULL-WORDS
	SUBI	M,@MBUFP
	IMULI	M,6		;6 BYTES TO THE WORD
	SUB	M,B		;WORKS SINCE THERE ARE NO BYTES IN WORD 0
NUMRET:	PUSHJ	P,SNM		;OUTPUT NUMERIC RESULT AS A STRING
	PJRST	ENDSTR

;MBUFNEXT
;MOVE AHEAD ARG NUMBER OF PLACES IN MUSIC BUFFER
MBNXT:	PUSH	P,[COMXS1]	;SO THAT RETURN CAN BE VIA POPJ
	PUSHJ	P,INTAR1	;NUMERIC ARGUMENT INTO M
	JUMPL	M,[ERROR MBFOR]	;CANNOT MOVE BACKWARD
	MOVE	A,M
	IDIVI	A,6		;CALCULATE NUMBER OF WORD TO MOVE MBPOS
	ADDM	A,MBPOS		;MBPOS IS BYTE POINTER TO PLACE IN MUSIC BUFFER
	AOJA	B,MBNXT1	;B IS REMAINDER FROM DIVIDE ABOVE

MBNXTX:	MOVE	B,NVOICE	;NUMBER OF VOICES (SING ENTERS HERE)
MBNXT2:	IBP	MBPOS
MBNXT1:	SOJG	B,MBNXT2
MBNXT3:	HRRZI	A,@MBPOS
	SUBI	A,@MBUFP
	HRRZ	B,@MBUFP	;GET CURRENT BUFFER LENGTH
	CAIG	A,(B)		;IS THIS BUFFER FULL?
	POPJ	P,		;NO EXIT
	MOVEI	A,MBINCR	;YES THROW IT OUT AND GET A BIGGER ONE
	MOVE	B,MBUFP
	PUSHJ	P,COPYUP
	SUB	B,MBUFP		;RETURNS WITH POINTER TO NEW BUFFER IN B
	ADDM	B,MBUFP		;SET NEW POINTER
	ADDM	B,MBPOS		;CORRECT MBPOS AND MBMAX TOO
	ADDM	B,MBMAX
	ADDI	A,1		;AND A POINTS TO (COPY) OF LAST WORD OF OLD
	SETZM	@A		;CLEAR NEW SECTION OF BUFFER
	MOVEI	A,@A		;CHANGE FROM INDEXED TO ABSOLUTE ADDRESS
	HRLI	A,(A)
	MOVEI	B,MBINCR-1(A)	;END OF NEW BUFFER
	ADDI	A,1
	BLT	A,(B)		;PROPAGATE THE ZERO
	JRST	MBNXT3		;AND TEST AGAIN

;MBUFPUT
;PUT A NOTE INTO THE MUSIC BUFFER
MBPUT:	PUSH	P,[COMXS1]	;SO THAT EXIT CAN BE VIA POPJ
	PUSHJ	P,INTAR1
MBPUTX:	SKIPL	M		;(SING ENTERS HERE THE FIRST TIME)
	CAILE	E,^D63		;ALLOWABLE RANGE FOR NOTES
	ERROR	MBNOTE		;OUT OF RANGE
MBPUTY:	DPB	M,MBPOS
	POPJ	P,

;MBUFOUT
;OUTPUT THE BUFFER TO THE MUSIC BOX
MBOUT:
	SKIPN	BXTYPE		;OLD OR NEW BOX?
	JRST	MBNEW		;NEW
	MOVE	B,[POINT 7,[BYTE (7) 01,60,60,60,66]]	;SEND HEADER
				;^Q,J FOR NEW BOX--DEC 1974
	MOVEI	A,5		;TO SELECT AUXILIARY DEVICE #6 (MUSIC BOX)
	ILDB	C,B
	PUSHJ	P,TYO0
	SOJG	A,.-2
	JRST	MBCONT
MBNEW:	MOVEI	C,021		;GET ^Q
	TTCALL	15,C		;OUTPUT IN IMAGE MODE TO OMIT FILLER RUBOUT
	MOVEI	C,"J"		;NOW J TO SWITCH NEW BOX TO MUSIC
	PUSHJ	P,TYO0
MBCONT:	MOVEI	C,"#"		;NOW SET CONTROL STATE REGISTER
	PUSHJ	P,TYO0
	MOVE	C,STCATO	;GET NUMBER OF VOICES TO PLAY STACCATO
	LSH	C,2		;GOES INTO BITS 4 AND 3
	MOVE	A,NVOICE	;GET NO. OF VOICES
	ADD	C,SILENT-1(A)	;CHOOSE WHICH VOICES TO BE SILENT
	SUB	C,NVOICE	;AND SET NUMBER OF VOICES IN BITS 2 AND 1
	PUSHJ	P,TYO0		;BITS 3 AND 4 ZERO SILENCES ALL VOICES
	PUSHJ	P,UPDMAX	;UPDATE MBMAX
	HRLZI	B,(POINT 6,(W),35)
	HRR	B,MBUFP		;ADD BASE OF BUFFER RELATIVE TO W
	JRST	MBOUT3

SILENT:	124			;VOICES 0,1,2 SILENT
	44			;VOICES 0,1  SILENT
	64			;NONE SILENT
	64			;NONE SILENT
MBOUT2:	TLZE	F,BREAKF	;IS THERE A BREAK PENDING?
	ERROR	BREAK		;YES, TAKE IT NOW
	ILDB	C,B
	ADDI	C,40		;CHANGE TO ASCII
	PUSHJ	P,TYO0
MBOUT3:	CAME	B,MBMAX		;DONE YET?
	JRST	MBOUT2		;NO, CONTINUE
	SKIPE	BXTYPE		;OLD OR NEW BOX??
	JRST	MBOLD		;OLD
	MOVEI	B,[BYTE (7) 43,100,0]	;SHUT UP THE NEW TYPE OF
	PUSHJ	P,TOSS		;MUSIC BOX, AND TERMINATE MESSAGE PER PROTOCOL
	MOVEI	C,021		;GET ^Q
	TTCALL	15,C		;OUTPUT IN IMAGE MODE TO AVOID FILLER CHAR
	MOVEI	C,040		;GET AND SEND SPACE
	PUSHJ	P,TYO0
				;^Q,SPACE FOR NEW BOX -- DEC 1974
	JRST	COMEX
MBOLD:	MOVEI	B,[BYTE (7) 43,100,15,36,0] ;SHUT UP OLD MUSIC BOX
	PUSHJ	P,TOSS		;AND TERMINATE MESS PER PROTOCAL
	JRST	COMEX

; NEXT TWO PROCEDURES JUST SET THE TYPE OF MUSIC BOX THAT IS TO BE
; USED.   

NEWMUSIC:
	SETZM	BXTYPE		;NEW BOX
	JRST	COMEX
OLDMUSIC:
	SETOM	BXTYPE		;OLD BOX
	JRST	COMEX

;MBUFINIT &
;MBUFCLEAR
MBCLR:	HRRZ	A,@MBUFP	;WHAT'S THE CURRENT BUFFER LENGTH
	CAIG	A,^D1024+MBLGTH	;COULD WE SAVE 1K OR MORE BY STARTING AFRESH?
	JRST	MBCLRX		;NO PROCEED WITH WHAT WE HAVE
MBINIT:	MOVEI	A,MBLGTH	;YES REQUEST A NEW BUFFER
	PUSHJ	P,MAKELM	;(OLD ONE, IF ANY, WILL BE GARBAGE COLLECTED)
	MOVEM	B,MBUFP
MBCLRX:	HRRZ	A,MBUFP
	HRLI	A,(POINT 6,(W),35)	;FORM A POINTER INDEXED BY W
	IBP	A
	MOVEM	A,MBPOS
	MOVEM	A,MBMAX
	MOVEI	A,@MBUFP	;GET POINTER TO ZEROTH WORD OF BUFFER
	ADDI	A,1
	SETZM	(A)		;CLEAR FIRST WORD
	HRLI	A,(A)
	HRRZ	B,@MBUFP	;GET LENGTH INTO B
	ADDI	B,-1(A)		;FORM ADDRESS OF LAST DATA WORD
	ADDI	A,1
	BLT	A,(B)		;PROPAGATE ZEROS THROUGH THE BUFFER
	JRST	COMEX
;MBUFSTART
MBSTRT:	PUSHJ	P,UPDMAX	;UPDATE MBMAX
	HRRZ	A,MBUFP
	HRLI	A,(POINT 6,(W),35)
	IBP	A
	MOVEM	A,MBPOS
	JRST	COMEX

;SING
;SING A SINGLE NOTE WITH DURATION

SING:	SKIPN	MBUFP	;CHECK TO SEE THAT STARTMUSIC HAS BEEN RUN
	ERROR	MBNOTI	;ERROR IF NOT
	PUSHJ	P,INTAR1	;GET THE DURATION INTO M
	POP	S,A		;FLUSH THE ARGUMENT
	JUMPE	M,COMXS1	;IF 0 DURATION, DO NOTHING
	SKIPG	D,M		;SAVE DURATION IN D
	ERROR	MBDUR		;NEGATIVE DURATIONS AREN'T ALLOWED
	PUSHJ	P,INTAR1	;PICK UP PITCH
	ADDI	M,^D28		;0 CORRESPONDS TO ABS 28 (MIDDLE C)
	PUSHJ	P,MBPUTX	;PUT INTO THE MUSIC BUFFER
	PUSHJ	P,MBNXTX	;INCREMENT POSITION BY # OF VOICES
	SOJLE	D,COMXS1		;DECREMENT DURATION.  DONE IF 0 NOW.
	SOJLE	D,SING3		;DECREMENT AGAIN. BRANCH IF DUR WAS 2
	CAIG	M,2		;IS THE NOTE BOOM, GRITCH OR REST?
	SETZ	M,		;IF SO, ONLY PLAY ONE PER NOTE
SING2:	PUSHJ	P,MBPUTY
	PUSHJ	P,MBNXTX	;STORE BYTE AND INCREMENT POSITION
	SOJG	D,SING2		;LOOP BACK AS MANY TIMES AS NECESSARY
SING3:	SETZ	M,		;END WITH ONE TIME PERIOD OF SILENCE
	PUSHJ	P,MBPUTY
	PUSHJ	P,MBNXTX
COMXS1:	POP	S,A
	JRST	COMEX

UPDMAX:	MOVE	A,MBPOS		;SEE IF MBPOS IS AHEAD OF MBMAX
	HRRZ	B,MBMAX
	CAILE	B,(A)		;FIRST COMPARE WORD ADDRESSES
	POPJ	P,
	CAIN	B,(A)		;IF NOT THE SAME, THEN MBPOS WINS
	CAMG	A,MBMAX		;WORD ADDRESSES MATCH, COMPARE BYTE POSITIONS
	MOVEM	A,MBMAX		;(BYTE POSITION COMPARES IN OPPOSITE SENSE)
	POPJ	P,
	SUBTTL	ERROR ROUTINES

ERRORR:	MOVE	P,[IOWD ERPDLL,ERRPDL]
	TRZ	F,PREFIX!SUFFIX
	MOVE	A,TERMIO+1
	TLZE	F,SAVEF
	MOVEM	A,CHOUT
	SKIPE	CHARNO
	PUSHJ	P,CRLF
	HRRZ	C,JOBUUO
	CAIL	C,MAXERR
	SETZ	C,
	HLRZ	A,ERRORS(C)	;GET TEXT MESSAGE
	HRLI	A,440700
	HRRZ	B,ERRORS(C)	;GET DISPATCH FOR COMPUTATIONAL ERRORS
	JUMPN	B,(B)	;DISPATCH IF A COMPUTATIONAL ERROR
ALLERP:	PUSHJ	P,PTOS	;TYPE GENERAL MESSAGE
ALLERR:	PUSHJ	P,CRLF
	SKIPN	PRODNM	;WERE WE INSIDE A USER PROCEDURE?
	JRST	ERROUT
	MOVEI	A,[ASCIZ /I WAS AT LINE /]
	PUSHJ	P,PTOSSM
	MOVE	A,LINENO
	PUSHJ	P,DECPRT
	MOVEI	A,[ASCIZ / IN /]
	PUSHJ	P,PTOSSM
	JSP	N,PUNAME	;PRINT PROCEDURE NAME
	PUSHJ	P,CRLF
	JRST	ERROUT


NONAME:	PUSHJ	P,PTOS
	HRRZ	A,UUOTRP
	SUBI	A,1
	PUSHJ	P,OCTPRT
	JRST	ALLERR

ERROUT:	TDZ	F,[XWD TIF!NOBREAK,MAKEF]
	MOVE	P,UUOACS+P	;SAFE TO USE REGULAR PDL NOW
	TLZE	F,BROKE		;WAS ERROR THE BREAK KEY
	SKIPN	PRODNM		;AND WAS A STORED LINE INTERRUPTED?
	JRST	FLUSHM



FOR SAVBRK,<
ERROT2:	TLZ	F,RQF		;WHICH WAY DO WE CALL MAINL
	TLZE	F,TOF		;IN A PRINT OR TYPE?
	JRST	ERROT4		;YES, GO PROCEEDS WITH THE NEXT LINE
	TLZN	F,GETF		;IN A GET?
	JRST	ERROT3	;NO, BREAK AT EXECUTE RESTARTS CURRENT LINE

	JSP H,CLOSUP
	MOVE	A,BSP		;GETTING, CLOSE THE FILE AND
	JSP	C,SETPDL	;SET UP TO REDO THE GET ON A GO
	MOVE	A,TERMIO
	MOVEM	A,CHIN
	JSP	D,RESTOR	;RESTORE THE LINE THAT HAD THE GET

ERROT3:	SOS	LINENO	;SO UPNEXT WILL FIND THIS ONE AGAIN
ERROT4:	MOVE	A,SPP
	ADDI	A,1
	JSP	C,SETPDL	;GET TO BEGINNING OF THE LINE
	PUSH	P,BSP
	JSP	D,SAVEUP	;SAVEUP FOR GO
	AOS	GODEPTH		;ONE MORE GO ON THE STACK
	MOVE	A,SPP
	MOVEM	A,BSP		;NEW "TOP LEVEL"
FOR TENEX,<	MOVEI	A,101		;TERMINAL OUTPUT
	DOBE >			;DISMISS UNTIL ERROR MESSAGE IS
				;COMPLETELY OUT
FOR DRIBBLE,<TRO F,TF >		;BUT DON'T ASK FOR INITIALS
	JRST	RESET >		;CLEAR WATING BREAKS AND RESTART PSI


FLUSHM:	TLZN	F,GETF		;NO, BUT WERE WE GETTING FROM A FILE?
	JRST	ERROT1		;NO
	JSP	H,CLOSUP

ERROT1:	HRRZ	G,BSP
	ADD	G,PP
FLUSHL:	MOVE	A,SPP
	ADDI	A,1
	JSP C,SETPDL
	CAIL	G,(P)		;SET BACK TO BSP?
	JRST	FLUSHE		;YES
	POP	P,A		;RETURN FROM EXECUTE
	JSP	D,RESTOR	;ONE MORE PDL LEVEL
	JRST	FLUSHL

FLUSHE:	GARBAG
FOR DRIBBLE,<TRO F,TF >		;DO NOT REOPEN DRIBBLE FILE
	JRST	RESET

MATCHG:	PUSHJ	P,PTOS
	MOVE	C,UUOACS+D	;THE OFFENDING TERMINATOR
	PUSHJ	P,TYO
MATCG1:	MOVEI	C,"?"
	PUSHJ	P,TYO
	JRST	ALLERR

ILLUUO:	MOVEI	B,[ASCIZ /HELP!!/]
	PUSHJ	P,TOSS
	JRST	ALLERR

.INER3:	PUSHJ	P,PTOS
	MOVE	A,CBOT
	ADDI	A,1
	MOVE	A,@WSA
	PUSHJ	P,PTOSS
	MOVE	A,[POINT 7,[ASCIZ / OF WHAT PROCEDURE?/],]
	JRST	ALLERP

.NMER3:	SKIPA	E,-1(S)
.TOER3:	MOVE	E,1(S)
	EXCH	E,A
	HRLI	A,(POINT 7,(W),34)
TYPAFT:	PUSHJ	P,PTOS
	MOVE	A,E
	JRST	ALLERP

CANTBS:	MOVE	E,A
	MOVE	A,(S)
	JSP	H,ETLIT
	JRST	CANTB0
CANTBA:	SKIPA	E,UUOACS+A
CANTBT:	MOVE	E,THISPR
	EXCH	A,E
	JSP	H,ETYPIT
CANTB0:	MOVEI	A,[ASCIZ / CAN'T BE A /]
CANTB1:	HRLI	A,440700
	JRST	TYPAFT

.GOER2:	MOVE	E,A
	MOVE	A,UUOACS+D
	JRST	TYPAFT-1

.GOER3:	PUSHJ	P,PTOS
	SKIPA	A,UUOACS+D
.XITER:	POP	S,A
.GOER4:	HRLI	A,(POINT 7,(W),34)
	JRST	ALLERP

.NOPRO:	PUSHJ	P,PTOS
	SOS	A,UUOACS+A
	HRRZ	A,@RPA
	JRST	.GOER4

.TNAME:	PUSHJ	P,PTOS
	JSP	N,TUNAME
	JRST	ALLERR
.PMNAM:	JSP	N,PMNAME
	JRST	ALLERP

.COMER:	TLZN	F,UPFF
	JRST	.PMNAM		;A SYSTEM COMMAND
	SKIPA	E,UUOACS+E	;A USER DEFINED COMMAND
UNDFND:	MOVE	E,UUOACS+A
	JSP	N,PUNAM1
	JRST	ALLERP

TWOARG:	PUSH	P,A
	HRRZ	B,THISPR
	CAIL	B,RPREN		;INFIX OPS ABOVE )
	JRST	.ITWOA		;TYPE "A" + "B"
	JSP	N,PMNAME
	MOVEI	B,[ASCIZ / OF /]
	PUSHJ	P,TOSS
	MOVE	A,-1(S)
	JSP	H,ETLIT	;ARG ONE OF TWO
	MOVEI	A,[ASCIZ / AND /]
TWARG9:	PUSHJ	P,PTOSSM
TWARG8:	MOVE	A,(S)	;GET SECOND ARG OF TWO OR ONLY ARG IF ONE
	JSP	H,ETLIT
	PUSHJ	P,CRLF
	POP	P,E
	JRST	TYPAFT+1

ONEARG:	PUSH	P,A
	HRRZ	B,THISPR
	CAIL	B,RPREN
	JRST	.IONEA
	JSP	N,PMNAME
	MOVEI	A,[ASCIZ / OF /]
	JRST TWARG9

.ITWOA:	MOVE	A,-1(S)
	JSP	H,ETLIT
	PUSHJ	P,PSPACE
.IONEA:	JSP	N,PMNAME
	PUSHJ	P,PSPACE
	JRST	TWARG8

.NOCMD:	PUSHJ	P,PTOS
	POP	S,A
	JSP	H,ETLIT
	JRST	MATCG1


TUNAME:	SKIPA	E,TOPROD
PUNAME:	MOVE	E,PRODNM
PUNAM1:	EXCH	A,E
	JSP	H,ETUP
	MOVE	A,E
	JRST	(N)

PMNAME:	MOVE	B,THISPR
	MOVE	B,-1(B)
	PUSHJ	P,TOSS
	JRST	(N)

FOR TENEX,<
.TNXER:	MOVEI	1,101
	MOVE	2,[XWD 400000,-1]
	SETZ	3,
	ERSTR
	JRST	ALLERR+1 >


HARIKIRI:
	PUSHJ	P,PTOS
FOR TENEX,< HALTF >
FOR TEN50,< CALL 1,[SIXBIT /EXIT/] >
	JRST ERROUT		;TRY TO CONTINUE

.XTRER:	MOVE	E,A
	SKIPA	A,CPP		;START WITH THIS ELEMENT
.XTRR1:	AOS	A,CPP
	MOVE	A,@WSA		;NEXT ELEMENT
	JSP	H,ETYPIT
	JUMPE	A,TYPAFT+1
	PUSHJ	P,PSPACE	;SEPARATE ELEMENTS WITH SPACES
	JRST	.XTRR1		;BACK FOR NEXT ELEMENT

.MISSG:	PUSHJ	P,PTOS		;"THERE ARE "
	HRRZ	H,UUOACS+P
	HLRE	A,(H)
	ADDI	A,1
	PUSHJ	P,DECPRT	;N
	MOVEI	A,[ASCIZ / INPUTS MISSING FOR /]
	PUSHJ	P,PTOSSM
	HRRZ	A,(H)
	CAIE	A,UPRODL+1
	JRST	.MISG2
	MOVE	A,-1(H)
	JSP	H,ETUP
	JRST	.MISG9

.MISG1:	PUSHJ	P,PTOS
	MOVE	A,THISPR
.MISG2:	JSP	H,ETMP

.MISG9:	MOVEI	C,"."
	PUSHJ	P,TYO
	JRST	ALLERR



LNALND:	MOVE	E,A
	MOVEI	A,[ASCIZ /LINE /]
	PUSHJ	P,PTOSSM
	MOVE	A,UUOACS+M
	PUSHJ	P,DECPRT
	MOVEI	A,[ASCIZ / OF /]
	PUSHJ	P,PTOSSM
	MOVE	A,UUOACS+P
	MOVE	A,-2(A)
	JSP	H,ETUP		;TYPE USER PROCEDURE NAME
	MOVEI	A,[ASCIZ / WAS /]
	PUSHJ	P,PTOSSM
	MOVE	A,E
	PUSHJ	P,PTOS
	MOVEI	A,[ASCIZ / DURING EXECUTION./]
	PUSHJ	P,PTOSSM
	JRST	ALLERP

ETYPA:	MOVE	E,UUOACS+A
	EXCH	A,E
	JSP	H,ETYPIT
	JRST	TYPAFT+1

BRAKER:	PUSHJ	P,PTOS
	TLO	F,BROKE
	JRST	ALLERR


SETPDL:	HLRZ	B,A
	ADD	B,SP
	HRRZI	S,(B)
	SUB	B,SP+1
	HRLI	S,1(B)

	ADD	A,PP
	HRRZI	P,-1(A)
	SUB	A,PP+1
	HRLI	P,(A)
	JRST	(C)


ETYPIT:	TLZ	A,COMPOUND!IMMEDIATE
	JFFO	A,.+2
	JRST	(H)
	JRST	@.+1-2(B)
	 EXP	ETMP,ETUP,ETVAR,ETLIT,ETMP,ETMV,ETCOM

ETMV:	MOVEI	E,":"
	TRO	F,PREFIX!SUFFIX
ETMP:	HRLI	A,440700
	JRST	ETUP1
ETUP:	HRLI	A,(POINT 7,(W),34)
	ADD	A,RP
ETUP1:	HRR	A,-1(A)
	PUSHJ	P,PTOS
	JRST	(H)

ETCOM:	MOVEI	G,";"
	JRST	ETLIT1
ETVAR:	MOVEI	A,-1(A)
	MOVE	A,@VPA
	SKIPA	G,[EXP ":"]
ETLIT:	MOVEI	G,042
ETLIT1:	EXCH	G,E
	TRO	F,PREFIX!SUFFIX
	PUSHJ	P,PTOSS
	MOVE	E,G
	JRST	(H)

DEFINE EE (NAME,TEXT,CODE)
<NAME==.-ERRORS
XWD [ASCIZ *TEXT*],CODE>

ERRORS:
EE .BARF,ERROR ,NONAME
EE ABBER1,LOOP IN ABBREVIATION EXPANSION.
EE ABBER2,DON'T USE THE EMPTY THING AS AN ABBREVIATION.
EE CANER1,NOTHING TO CANCEL.
EE COMERR, CAN'T BE USED AS AN INPUT. IT DOES NOT OUTPUT.,.COMER
EE DIRERR, CAN ONLY BE DIRECT.,.PMNAM
EE DIVERR,DIVISION BY ZERO.
EE EDTER1,YOU CANNOT EDIT THAT.
EE EDTER2,YOU ARE ALREADY EDITING ,.TNAME
EE ERXTRA,IS EXTRA.,.XTRER
EE ERMSG1,THERE ARE ,.MISSG
EE ERMSSG,SOMETHING MISSING FOR ,.MISG1
EE EVER3, NEEDS A MEANING.,UNDFND
EE EVER4, HAS NOT BEEN COMPLETELY DEFINED.,UNDFND
EE EVER5,PROCEDURE NAME.,CANTBT
EE FILER1,FILE NAME.,CANTBA
EE FILER9,FILE NAME TOO LONG.
EE GOERR1,GO WHERE?
EE GOERR2, IS NOT A LINE NUMBER.,.GOER2
EE GOERR3,THERE IS NO LINE ,.GOER3
EE GOERR9,NO PLACE TO GO.
EE ILLTRP,ILLEGAL MEMORY ALLOCATION TRAP- ALL IS LOST.,HARIKIRI
EE INERR1,MATCHING ,MATCHG
EE INERR2,LINE NUMBER IS TOO LARGE.,
EE INERR3,LINE ,.INER3
EE INERR4,YOU CAN'T HAVE A LINE 0.,
EE INFERR,INFIX OPERATOR MUST BE PRECEDED BY AN INPUT
EE IOPERR,I AM IN TROUBLE. TELL YOUR TEACHER.
EE LCLERR,LOCAL NAME.,CANTBS
EE LNDERR,DELETED,LNALND
EE LSTER2,LIST ALL WHAT?
EE MAGNER,NOT SUCH A BIG NUMBER.,ONEARG
FOR MUSIC,<
EE MBDUR,A NOTE CANNOT HAVE A NEGATIVE DURATION.
EE MBFOR,MBUFNEXT CAN ONLY MOVE FORWARD.
EE MBNOTI,YOU HAVEN'T RUN STARTMUSIC YET.
EE MBNOTE,THAT NOTE IS OUTSIDE MY RANGE.
EE MBVOC,YOU MUST SPECIFY 1 TO 4 VOICES ONLY.
>
EE NMERR3, IS USED BY LOGO.,.NMER3
EE NMERR5,DON'T USE THE EMPTY WORD FOR A NAME.,
EE NOCMD,THERE IS NO COMMAND FOR ,.NOCMD
EE NOENTRY,NO SUCH ENTRY.
EE NOFILE,NO SUCH FILE.
EE NOPERR, WHAT? YOU ARE NOT DEFINING ANYTHING.,.PMNAM
EE NOPROD,THERE IS NO PROCEDURE ,.NOPRO
EE NOTWRD,FIRST INPUT TO MEMBERP MUST BE A WORD,
FOR MOCKTURTLE,<
EE OFSCRN,THAT PUTS YOU OFF THE SCREEN.>
EE PREDR1,INPUT MUST BE A PREDICATE.,ONEARG
EE PREDR2,INPUTS MUST BE PREDICATES.,TWOARG
EE PRNER1,MATCHING (?
EE PRNER2,MISSING )?
EE STOERR, CAN ONLY BE USED IN A PROCEDURE.,.PMNAM
EE SUMERR,INPUTS MUST BE NUMBERS.,TWOARG
FOR TENEX,<
EE TNXERR,,.TNXER>
EE TITER2,TITLE MUST BE FOLLOWED BY "TO".
EE TOERR1,USE "DO" WHEN "TO" IS STORED.
EE TOERR2,YOU NEED : MARKS AROUND EACH INPUT.,
EE TOERR3, IS USED BY LOGO.,.TOER3
EE TOERR4,DON'T TRY TO DEFINE ANOTHER PROCEDURE INSIDE THIS ONE.,
EE TOERR5,PROCEDURE NAME.,CANTBA
EE TOERR6, IS ALREADY DEFINED.,ETYPA
EE TOERR7,ONLY PRINTING CHARACTERS IN A PROCEDURE NAME.
EE TOOFUL,NO ROOM FOR ANOTHER GET; SAVE AND ERASE FIRST.
EE UPDERR,THAT FILE CAN'T BE UPDATED BY YOU.
EE WHATER, WHAT?,.PMNAM
EE WRDERR,INPUTS TO WORD CANNOT BE SENTENCES.,TWOARG
EE XITERR,,.XITER  ;NO SYSTEM ERROR MESSAGE, ONLY THAT SUPPLIED BY USER
EE ZERERR,INPUT MUST BE A NUMBER.,ONEARG
EE BREAK,BREAK,BRAKER
EE PUNT,STORAGE FULL
BLOCK 5	;FOR PATCHING THIS LIST
MAXERR==.-ERRORS
	XLIST	;WOULD ANYONE LIKE TO SEE 14 PAGES OF LITERALS?
	LIT
	LIST
FOO:
LOGEND:	END	LOGO