Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0002/raid.fai
There is 1 other file named raid.fai in the archive. Click here to see a list.
COMMENT    VALID 00084 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00008 00002	SWITCHES  DEFINE VERSIONS,  TITLE STATEMENT
C00012 00003	Accumulators, Bits, Macros
C00018 00004	Descriptions, Global Structures
C00027 00005	Cache Structures, Explanations -- other DCS additions
C00032 00006	Break Tables, for Special Activation Mode Scanning
C00034 00007	Gchr1, Gchr, Chtb1, Chtb2
C00038 00008	 Non-Stanford Get a character, activate on activation routine
C00040 00009	GCHRS
C00043 00010	Main Dispatch, <ctrl>., Numbers -- SCAN
C00048 00011	Letters, Decimal, Text -- SLET, DECMAL, TEXT
C00053 00012	TMPMOD, EXTTXT, AMPER, ENSYM
C00058 00013	Byte Input
C00062 00014	PNTIN	POINT MODE INPUT
C00064 00015	Escan -- Scan and Check Reasonable
C00065 00016	Eval
C00070 00017	ATCHK:	0
C00074 00018	Racgt, Jacgt, Once, Svacs
C00089 00019	Parameters, Headers, Buffers, Variables for Data Display
C00096 00020	Spwget, Dset, Mksel
C00101 00021	Redraw, Redisp, Fredsp -- Display Program
C00103 00022	     Loop1, Rdo -- Main Line Control, Each Line Code
C00105 00023	RET2, ARND1
C00107 00024	Godis -- Actual Displaying Code
C00108 00025	RDTRKE, WRTRK
C00114 00026	Bclr, Mooror (Display Driver), Crlfot, Offok
C00120 00027	Getpoi -- Handle Multi-Level Display
C00123 00028	Conv -- Output Conversion Routine Dispatch
C00125 00029	  Fndptr, Fndtbl, Conflg, Rhflg, Lhflg -- J, L, R Commands
C00129 00030	  Hlfwrd, Instr, Opdret, Noacq
C00135 00031	INPTBL		INSTRUCTION PRINTING TABLE
C00140 00032	  Rhtext, Adtyp, R5typ, ADSEL, TRYSYM
C00145 00033	  Conoct, Consix, Sixout, Opdf
C00148 00034	  Conasc -- Ascii Printer
C00151 00035	CONR50, CONXWD, CONBP
C00153 00036	  Conflt -- Floating Point Output Routine
C00158 00037	  Condec, Conbyt -- Decimal, Byte Printer
C00161 00038	Stsprt, Prgprt, Blkprt -- special top lines conversions
C00164 00039	Spblt, Iotbl, Iofndi -- These Belong Elsewhere
C00167 00040	Search Routines -- Oplook -- Opcode (Built-in) Finder
C00174 00041	TABIO, TAB, TABOR
C00179 00042	TAB1LO:
C00183 00043	SRCH1, SRCH, FNDOP
C00189 00044	SUUO
C00192 00045	IFE SORTED,<	STANDARD SYMBOL TABLE (UNSORTED) ROUTINES (ENDS ON PAGE 46)
C00197 00046	BLKCHK:	MOVE E,1(PV)	GET VLOCK LEVEL
C00199 00047	Symlok -- SymbolValue Searcher -- Wrap, Csflush, Cpopj
C00204 00048	Prgfnd, Prgset, Blkfnd, Blkfn
C00209 00049	IFN SORTED,< (ENDS ON PAGE 55)	SETSYM
C00213 00050	 Fndsym -- The VALSYM Symbol Table Searcher.
C00218 00051	FSYM
C00221 00052	BINGO, WCHBLK, GETRNG
C00227 00053	TABLES FOR LOG SEARCH OF SYMBOL TABLE  SUBRNG
C00229 00054	 Symlok -- SymbolValue Searcher -- Csflush
C00236 00055	Prgfnd, Prgset, Blkfnd, Blkfn
C00242 00056	Raid, Eret, Main, Inerr, Cerr, Pu, Unpur -- Main Loop, Dispatcher
C00247 00057	  Ctab -- Dispatch Table
C00254 00058	 Modset, Tmdst, Amodst, Nmdst, Umodst, Bytmod, Flgmod, Lftt, Rftt
C00257 00059	Depo1, Echk
C00260 00060	IFE SORTED,<
C00262 00061	IFN SORTED,<
C00264 00062	 Depo, Opens, Openu, Fndscr, Openp -- Open a Cell (see if it's there)
C00268 00063	 Macdef, Macexp, Macimm -- Define and Expand Macros
C00270 00064	 Edit -- Edit Previous Value Using System Line Editor
C00275 00065	Upar,Lnfd,Lefsq2,Tab,<,>,Routs,<tab>,MVTST,MOVDN,MOVUP,REMPER,SCLR
C00281 00066	 Sclrsv, Incr, Leffnd, Eqiv, Wdsrch, Etc., Inc
C00287 00067	   Wdsrch Subroutines
C00289 00068	 Symdef, Symdf1, Symkil, Symfnd, Symfn1 -- Create and Delete Symbols
C00292 00069	IFN SORTED,<	 Symdef, Symdf1, Symkil -- Create and Delete Symbols
C00301 00070	REVIVE, SYMKIL, SYMNIL, ZAPSYM, SYMFND, SYMFN1
C00305 00071	$nB, 1nBrknum -- Brkins, Brkjsr, Dobrk, Brkpln
C00312 00072	 Brkrem, Brkpul, Tbproc
C00315 00073	 Proced, Gpelop, Elop, Pstbrk, Prmbrk, $SBP
C00322 00074	 Steppe, Stepp, Xeq1, Xeq2
C00326 00075	 Xeq3, Yxeq, Mstep, LEAVE
C00332 00076	Some Random Variables
C00333 00077	SORTED SYMBOL TABLE FORMAT
C00338 00078	SORT
C00341 00079	NOW, HOW BIG IS SYMBOL TABLE GOING TO BE?
C00345 00080	PASS 2 - COPY SYMBOL NAMES TO NEW SYMBOL TABLE.  BUILD BN/BS AREAS
C00349 00081	WE SORT THINGS HERE
C00353 00082	CALL WITH B=FIRST ADDRESS IN RANGE, C=ADDRESS OF LAST ITEM IN RANGE
C00356 00083	SYLPOP, CLASS
C00360 00084	VAR
C00361 ENDMK
C;

;SWITCHES;  DEFINE VERSIONS,  TITLE STATEMENT

DEFINE SETSYS (SWITCH,VAR) <
IFDEF VAR,<SWITCH__1>
IFNDEF VAR,<SWITCH__0>
>

SETSYS (STANFO,SPCWAR)
SETSYS (TENEX,GETJFN)
IFE STANFO!TENEX,<DECSW__1;>DECSW__0

SORTED__1		;SORTED SYMBOL TABLE

REALSW__1		;ASSEMBLE VERSION WITH ALL INTERNALS
			;(REALSW_0 FOR DEBUGGING SO NO GLOBAL CONFILICTS)

DMOVSW__REALSW		;IF ONE, THE DISPLAY IS IN THE NORMAL RAID AREA

PADSYM__1-STANFO	;PAD THE SYMBOL TALBE WITH ....XX GLOBALS

FILESW__0		;ASSEMBLE FRAID FOR GROVELLING OVER FILES

UESW__0			;ASSEMBLE UERAID FOR LOOKING AT SYSTEM

EXDSW__1		;LEAVE THIS WAY UNTIL RAID IS FIXED TO LOOK
			;AT $IO INDEPENDENT OF THIS SWITCH, AND ALSO
			;LOOK FIRST IN THE SYMBOL TABLE FOR DEVICE CODES

DEFINE PRNTOP <PRINTS>

DEFINE VALPNT (VAL) <
PRNTOP /VAL/
>

IFN STANFO,<PRNTOP /ASSEMBLING FOR STANFORD
/>
IFN TENEX,<PRNTOP /ASSEMBLING FOR TENEX
/>
IFN DECSW,<PRNTOP /ASSEMBLING FOR DEC SYSTEM
/>

PRNTOP /SWITCHES ARE:
/

FOR SWITCH IN (STANFO,TENEX,DECSW,REALSW,UESW,FILESW,DMOVSW,EXDSW,SORTED,PADSYM) <
PRNTOP /SWITCH(/
VALPNT (\SWITCH)
PRNTOP /) /
>

PRNTOP /
TYPE NEW VALUES FOR THESE SYMBOLS, IF ANY, FOLLOWED BY /
IFN STANFO,<PRNTOP /CONTROL-META-LF
/>
IFE STANFO,<PRNTOP /CONTROL Z
/>
.INSERT TTY:

FOR SWITCH IN (STANFO,TENEX,DECSW,REALSW,UESW,FILESW,DMOVSW,EXDSW,SORTED,PADSYM) <
IFN SWITCH,<SWITCH__1>
IFE SWITCH,<SWITCH__0>
>

IFN UESW,<
TITLE UERAID
PRNTOP /ASSEMBLING UERAID
/
REALSW__0
FILESW__0
>

IFN FILESW,<
TITLE FRAID
PRNTOP /ASSEMBLING FRAID
/
REALSW__0
SORTED__1
PADSYM__0
>

IFE FILESW!UESW,<
IFE REALSW,<
TITLE DRAID
PRNTOP /ASSEMBLING DRAID
/>
IFN REALSW,<
TITLE RAID
PRNTOP /ASSEMBLING RAID
/>
>

IFE REALSW,<IFNDEF DEBSYM,DEBSYM__0>	;DEBSYM USES JOBSYM LOCAL INSTEAD OF EXTERN
IFN REALSW,<DEBSYM__0>
DEBSYM__DEBSYM

IFN FILESW,<.INSERT RAID.SUB[CSP,SYS]>

IFE UESW!TENEX,<SEGSW__1;>SEGSW__0
		;SEGSW MEANS BE ABLE TO LOOK AT SECOND SEGMENT CORE

;Accumulators, Bits, Macros

A_1
B_2
C_3
D1_4
D2_5
D3_6
E_7
F_10
M_11
T_12
F1_13
PNT_14
PV_15
V_16
P_17

EXTERNAL JOBHRL,JOBFF,JOBOPC,JOBDDT

;FLAGS -- FLAG REGISTER, LEFT HALF

NUMF__200000	;SCAN RETURNED A NUMBER (VALUE)
SYMF__100000	;SCAN RETURNED A SYMBOL
UNDF__40000	;SCAN RETURNED AN UNDEF SYM.
FLTF__20000	;SCAN RETURNED A FLOATING POINT NUM.
SCFL__10000	;SCAN IS AHEAD ONE CHR.
R5FL__4000	;INTERNAL SCAN FLAG -- RADIX50 INPUT
VALF__2000	;EVAL RETURNED A VALUE
LOCOPF__1000	;LOCATION OPEN (STORE LEGAL)
SINGF__400	;EVAL SAW A SINGLE SYMBOL
EHDF__200	;EVAL IS AHEAD ONE THING
ESPCF__100	;EVAL SAW A SPACE (TRUNCATE TO 18 BITS)
FIRF__40	;SCAN -- DO NOT LOOK FOR OPCODES
USINGF__20	;EVAL SAW UNDEFINED SINGLE SYMBOL
PMULFL__10	;MULTIPLY DEFINED SYMBOL
PUFL__4	;UNDEFINED SYMBOL, DISPLAY "U"
EVMF__2	;EVAL MINUS FLAG
STARSW__1	;PUT BIG * ON SCREEN NEXT REDISP

;FLAG REGISTER, RIGHT HALF

SRCHSW__400000	;SEARCH IN PROGRESS
BYTSW__200000	;SWITCH FOR EVAL::: TERMINATE ON COMMA
CONOF__100000	;I/O OPCODE FOUND -- EVAL HANDLE COMMA DIFFERENT
CONOFF__40000	;I/O OPCODE FOUND ON OUTPUT
CNVABS__20000	;USE ABS VALUES IN CONVERTING
DOSETL__10000	;WE HAVE SEEN AN ALT-MODE, AND HAVE TO SET REGULAR
		;ACITIVATION MODE.
DRWALL__2000	;REDRAW ALL DISPLAY LINES NEXT REDISP
DPYALL__1000	;REGENERATE ALL DISPLAY LINES NEXT REDISP
ISOPC__400	;JOBOPC USED FOR BP ADDR


;SYMBOLIC REPRESENTATIONS OF DATA MODE CODES, FOUND IN DPNT AND DCON ARRAYS

CYM__1		;"C"YMBOLIC
OCL__2		;OCTAL
OCL1__3	;SIGNED OCTAL
HLF__4		;HALFWORD
TXT__5		;TEXT, 5 IS RADIX50, 6 IS SIXBIT, 7 IS ASCII
FLG__10	;FLOATING
BYT__11	;BYTE MODE OUTPUT
DCM__12	;DECIMAL
UTX__13	;RH BYTE TEXT, 13 IS RADIX50, 14 IS SIXBIT, 15 IS ASCII
BTP__16	;CTRLQ, BYTE POINTER DISPLAY
BTS__17	;BIT BY BIT DISPLAY, USING TABLE
LBT__20	;LEFT HALF BIT DISPLAY
RBT__21	;RIGHT HALF BIT DISPLAY
STS__22	;STATUS LINE CONVERSION (U, OK, PURE, ?, ETC.)
PRG__23	;PROGRAM NAME CONVERSION
BLK__24	;BLOCK NAME CONVERSION
;...
ABS__40	;ABSOLUTE MODE (OR'ED WITH OTHERS)

;INDICES FOR STATUS LINE ENTRIES

.OK__0		;"OK"
.HUH__1	;"?"
.MUL__2	;"M -- sym"
.UND__3	;"U -- sym"
.SKIP__4	;"SKIPn"
.STAR__5	;"*"
.MEM__6	;"MEM?"  NONEXISTENT ADDR (TENEX)
.PURE__7	;"PURE?"
.PROT__10	;"PROT?"	;MEMORY PROTECTION VIOLATION
.ILL__11	;"INST?"	;ILLEGAL INSTR (TENEX)

;SEE DPNT ARRAY DESCRIPTION FOR POSITION OF THESE BITS


OPDEF FLOAT [FSC 233]
OPDEF TNOFFS [043000,,'SSW']
IFE STANFO,<
DEFINE SETLIN (A,B) <>
DEFINE GETLIN (A,B) <>
DEFINE SETACT (A,B) <>
DEFINE UNPURE (A,B) <>
>;NOT STANFO
IFN TENEX,<
OPDEF JSYS [104000,,]
OPDEF PBIN [JSYS 73]
OPDEF PBOUT [JSYS 74]
OPDEF PSOUT [JSYS 76]
OPDEF CBIBF [JSYS 100]
OPDEF RFMOD [JSYS 107]
OPDEF SFMOD [JSYS 110]

DEFINE INCHRS <
	MOVEI A,100
	SIBE
	JRST [	PBIN
		JRST .+2]
>
>;TENEX

DEFINE RDF ! (SYM,VAL) <
SYM__VAL
SYM!V__1
>

DEFINE LDF ! (SYM,VAL) <
SYM__VAL
SYM!V__0
>

DEFINE TB $ (E,A,B) <
IFE B$V,<TL$E A,B>
IFN B$V,<TR$E A,B>
>

IFN UESW,<
DEFINE MO(A,B) <
	MOVEI A,(B)
	PEEK A,
>
>

DEFINE CMOVE (A,B) <
IFE UESW,<
	CAIGE B,20
	ADDI B,JAC
	MOVE A,(B)
>
IFN UESW,<
	MO (A,B)
>
>

IFN STANFO,<ALTMOD__175>		;CODE FOR ALT MODE
IFE STANFO,<ALTMOD__33>
ESC__176				;CODE FOR VTS ESCAPE CHAR
HILOC__135

;Descriptions, Global Structures

COMMENT 
 Here (and below, in display routines) are some of the crucial
 variables and arrays in RAID.

IFE SORTED,<
SYMPRG
   contains [2*#syms left,,prog name] for currently `open'
   program.  #syms left is # symbols between this point and the 
   base of the symbol table.  Routines which search for things
   start here and are forced to `WRAP' when the count runs out

SYMPNT
   is [#syms left,,block name] (or prog name) for currently
   `open' block.  It is normally used as the starting point in
   symbol searches.  It is located directly before the DPNT array,
   which contains one entry per line, because some routines treat
   SYMPNT nonspecifically as an integral part of the state
   description for the screen.
>;NOT SORTED

IFN SORTED,<
PID
   is index within BLKNAM/BLKVAL tables (see storage structure)
   of currently open program, -1 if none.

BID
   is the index of the currently open block, -1 if none. It is located
   directly before the DPNT array, which contains one entry per line,
   because some routines treat BID nonspecifically as an integral
   part of the state description for the screen.
>;SORTED

DPNT
   is long enough to contain one entry per line, for the maximum
   (MAXDLN) number of lines allowed.  Each entry contains 0 (not used)
   or a word locating the thing displayed on that line, and identifying
   its current display mode.  Each word has the following format:

  Left half:
   Bit 0:	If on, this line is protected
   Bits 1-6:	any numeric value needed to completely specify the mode
		(e.g. the number of bits per byte, the number of the
		`bit descriptor table' for J,L, and R modes).
   Bit 7:	On if  ABS mode active -- don't display addresses or ACs as
		symbols.
   Bits 8-12:	The data mode code -- one of the values described symbolically
		above.
   Bit 13:	Not only is the value whose adr is RH(this) displayed, but some
		part of that value is used as an address of another thing to
		display.  (CTRL1-CRTL2@ was used on this guy, for example).
		There exists elsewhere in DPNT another entry requesting display
		of that further value (see directly below).
   Bit 16:	LH of value word used as address of another word to display,
		unless bit 17 is also on.
   Bit 17:	If bit 16=0, RH of value word used as address of another, else
		effective address represented by value word is used.

  Right half:
    The address of the thing being displayed (or a pointer to it, see above).

SPNT
   Left half:  DPNT, first word
   Right half:
      Minus the number of lines currently displayed (changed by the
      I command).  This pointer is used to control systematic searches
      of DPNT and related tables.  Why it is stored swapped is
      probably a function of some clever trick in the code below. (SEE INCR)

DCON
   This array has one entry for each one in DPNT, and one extra for
   SYMPNT.  In it is stored the current DPNT values, after each time the
   screen is updated.  The screen updater next time through compares these
   saved values to the current ones to detect changed lines.

DDCON
   In this array is stored the current values of the things pointed
   to by DPNT entries.  If a DPNT entry  matches its DCON entry, then
   the current core location value is checked against the saved value in
   the REDISP (screen update) routine, to determine whether changes must
   be made.

These latter two arrays are to be found down around REDISP

CURMOD
   Left half -- `permanent' mode, set by CTRL2<mode>.
   Right half -- `current' mode, set by CTRL1<mode>, reset to permanent by
      [CR] with no argument.
   These modes are in the format described above

LOCOP:	address of currently open location
STPOP:	address of next instruction to be executed 
	(Set by breakpoint or CTRL-X, or CTRL-S)
JAC:	job's ACs are stored here while RAID is running
RAC:	RAID's ACs are stored here while job is running

IFN SORTED,<
BLKVAL, BLKVL1, BLKNAM, BLKNM1, BLKSIZ, SYMBAS, RNGBAS, RNGBS1, etc.,
   are @ pointers to the various areas of the symbol table, see description
   of table structure. The different versions of the same thing differ
   only by what AC they have in their index field.
>;SORTED


IFN REALSW,<
LOC 74
RAIDVER__4			;PROGRAMS CAN DETECT VERSION
	<RAIDVER5>,,DDT	;SET JOBDDT
RELOC
INTERNAL $BGDDT
$BGDDT:				;IDENTIFY BEGINNING OF RAID
>
BEGDDT:
DPLOC:	777400

IFN SORTED,<
SYMBAS:0
SYMRNG:0
SAVJSM:-1		;SAVED JOBSYM, USED FOR SEEING IF JOBSYM HAS CHANGED
RNGBAS:0
RNGBS1:0
BLKVAL:0
BLKVL1:0
BLKNAM:0
BLKNM2:0
BLKSIZ:0
UNIQ:	0		;USED DURING SYMBOL SEARCH
UNIQP:	0
GLOBB:	0
BESTB:	0

PID:	-1		;PROGRAM INDEX
BID:	-1		;BLOCK INDEX, MUST IMMEDIATELY PRECEDE DPNT
>;SORTED

IFE SORTED,<
SYMPRG:	0		;MUST IMMEDIATELY PRECEDE SYMPNT
SYMPNT:	0		;MUST IMMEDIATELY PRECEDE DPNT
>;NOT SORTED

MAXDLN__27
DPNT:	STS5,,NBIGWD	;STATUS LINE
IFN SORTED,<PRG5,,BID>
IFE SORTED,<PRG5,,SYMPNT>
	BLOCK MAXDLN

SPNT:	DPNT+2,,-=20	;RH INITIALIZED AT DSET
CURMOD:	CYM5,,CYM5	;START SYMBOLICALLY
SCRMAX:	MAXDLN-2-1	;MAXIMUM NUMBER OF LOCATIONS DISPLAYED - 1
RAC:	BLOCK 20	;RAID'S ACS
LOCOP:	0
STPOP:	0
SAVPNT: 0
DDSW: -1		;DEVICE SPECIFIER, SEE DPY CODE
ACSW: 0		;RACGT'S SWITCH
PDLEN__200
PDL:	BLOCK PDLEN
JAC:	BLOCK 20	;JOB'S ACS

;Cache Structures, Explanations -- other DCS additions
COMMENT 
	The following data was added by DCS -- 10/15/70
SAVMOD -- approp. mode codeRH(SAVMOD) from first EVAL call on SCAN
  (via TMPMOD rout.)  If EVALs value is deposited (via CR, >,<, etc.)
  this mode is used for this line only.  Cleared in MAIN loop and elsewhere.
EXBUF -- stores text string during collection of multi-word ASCII input.
  Text string takes form of several single-word ASCII deposit specifications,
  separated by ">" commands.  Feature incited by use of CTRL1"...
STSAV -- BP to EXBUF put here after multi-word string collected.  This
  word 0 tells DEPO routine that STSAV should be transferred to STRING, 
  causing successive deposits of the words in the string.
BRKREF -- up to NUMREF copies of different SYMPNTs (BIDs) are stored here
  when CLTR1& is executed.  No duplicate entries allowed.
PRGREF -- corresponding program names
REFPNT -- contains index to most recent entry into BLKREF, PRGREF
REFGET -- ditto of most recently opened block. CTRL1-Z can be used to open
  blocks remembered by these arrays and pointers. CTRL1-Z effects REFGET,
  not REFPNT.  See REFBLK and following routines for details.
SYMCSH -- contains the NUMCSH most recently-seen symbol names.
SYMVAL -- contains the corresponding symbol table pointers. These
  are placed here by SYMLOK; SYMLOK also searches this small list
  before referring to the complete symbol table.
SCSHPT -- (wraparound) index of most recent entry in above arrays
VALCSH,VALSYM,VALBLK,NCSHPT serve similar functions to SYMCSH et. al.
  in the inverse FNDSYM routine.


SAVMOD: 0
EXTLN__=32
EXBUF:	BLOCK EXTLN		;FOR EXTENDED TEXT STRING INPUT
EXEND_.-1
STSAV: 0			;SAVE BP FOR EXTENDED TEXT OPERATIONS

;PREVIOUS PROG/BLOCK REFERENCE TABLES
NUMREF__8			;MAX NUMBER OF SAVED PROG/BLOCK REF'S
REFPNT: IFE SORTED,<0;>-1	;MOST RECENTLY ENTERED PROG/BLOCK
REFGET: 0			;MOST RECENTLY OPENED PROG/BLOCK
PRGREF: BLOCK NUMREF		;SAVED SYMPRG'S
BLKREF: BLOCK NUMREF		;SAVED SYMPNT'S

;SYMBOL "CACHES" FOR SPEEDING UP SYMBOL TABLE SEARCHES
NUMCSH__8			;MAX NUMBER OF SAVED SYMBOLS, ETC.
SCSHPT: 0			; 
NCSHPT: 0			;MOST RECENTLY ENTERED VALUE RANGE
SYMCSH: BLOCK NUMCSH		;SYMBOL NAMES, USED IN SEARCH
SYMVAL: BLOCK NUMCSH		;VALUES OF ABOVE SYMBOLS
IFE SORTED,<
VALCSH: BLOCK NUMCSH		;EXACT MATCHES OF PREVIOUS SYMBOL SEARCHES
VALSYM: BLOCK NUMCSH		;SYMBOLS CORRESPONDING TO ABOVE VALUES
VALBLK: BLOCK NUMCSH		;BLOCK NAMES FOR ABOVE SYMBOLS
>;NOT SORTED
CSHEND__.-1

IFE STANFO,<
INBP:	0			;INPUT BUFFER BYTE POINTER
INBF:	BLOCK =40		;INPUT BUFFER
>;NOT STANFO
SKPVAL: 0

;Break Tables, for Special Activation Mode Scanning

COMMENT  BREAK TABLE FOR SPECIAL ACTIVATION MODE -- DCS
 IN THIS MODE, ONLY THE CHARACTERS ; < > CR LF ALTMODE TAB 
 WILL CAUSE ACTIVATION, ALLOWING EDITING BACK OVER MOST ANY 
 MISTAKE
Simulated for Non-Stanford systems


WD1__WD2__WD3__WD4__0	;WILL COLLECT BREAK BITS

DEFINE STBT (CHLIST) <
FOR II3 IN (CHLIST) <
II1__II3-(II3/=36*=36)		;MOD
IFN STANFO,<II2__1(=35-II1)>	;THE NEW BIT
IFE STANFO,<II2__1II1>		;THE NEW BIT
IFLE II3-=35,<WD1__WD1!II2>
IFG II3-=35,<IFLE II3-=71,<WD2__WD2!II2>>
IFG II3-=71,<IFLE II3-=107,<WD3__WD3!II2>>
IFG II3-=107,<IFLE II3-=143,<WD4__WD4!II2>>
>
>

;SET UP WD1 THRU WD4
IFN STANFO,<STBT (<11,12,15,74,76,"\",";","",ALTMOD>)>
IFE STANFO,<STBT (<11,12,15,74,76,"\",";",ALTMOD>)>
STBT (<"","">)
IFN STANFO,<
SUPCT__40000			;SUPPRESS CONTROL T,B,L LINED CMDS (BACKWARD STUFF)
WD4__WD4!SUPCT
>;IFN STANFO

BRKTAB:	WD1WD2WD3WD4		;THE BREAK TABLE

IFN STANFO,<
BRKTI:	BLOCK 4			;ROOM FOR USER'S BREAK TABLE
>;STANFO
IFE STANFO,<
NBSSW: 0
>

;Gchr1, Gchr, Chtb1, Chtb2
BEGIN SCAN

;CHARACTER IDENTIFICATION FLAGS

ILLG__1
NUM__2
LET__4
AROP__20
SSPC__40
BOK__100
BIL__200
BIG__400
SLT__1000
STRID__2000	;START AN ID GODDAMMIT (FOR FORTRAN KLUDGE)
UOK__4000	;IT'S OK FOR A SYMBOL PRECEDING THIS CHAR
		;TO BE UNDEFINED (OTHERWISE COMPLAIN)

COMMENT 
GET A CHARACTER ROUTINES
GCHR1:		GET A SINGLE CHARACTER. IF STRIN CONTAINS NON-ZERO,
		IT IS ASSUMED TO CONTAIN A BYTE POINTER WHICH IT
		THEN USES FOR GETTING CHRS.  IF STRIN CONTAINS A ZERO,
		IT GETS INPUT FROM THE KEYBOARD.
GCHR:		GETS A CHARACTER AND WORRIES ABOUT ALT-MODE (1 ALT = CTRL,
		2 ALTS = META, 3 ALTS = CTRL-META) AND BUCKY BITS
GCHRS:		GETS A CHARACTER ALONG WITH ITS BITS FROM THE TABLE


LOP1:	SETZM STRIN	;CLEAR BUF POINTER
	PUSHJ P,SVACS	;SAVE ACS FOR RESTARTING
	XCT TYII	;GET 1 CHR. -- THIS WAITS UNTIL AN ACTIVATION CHAR.
IFE STANFO,<
	POPJ P,
>
IFN STANFO,<
	SKIPN DETFLG
	POPJ P,
	PUSH P,V
	MOVNI V,1
	GETLIN V
	CAMN V,[-1]
	JRST [	POP P,V		;STILL DETACHED
		POPJ P,	]
	SETZM DETFLG
	MOVEM V,USERLIN	;SAVE FOR USER
	TLO V,100	;SPECIAL ACTIVATION MODE
	MOVEM V,RADLIN	;FOR NORMAL RAID OPERATIONS
	TLZ V,100	;FOR ASCII INPUT OPERATIONS
	MOVEM V,ASCLIN
	TLO V,20	;FULL CHARACTER SET MODE, FOR EDITING
	MOVEM V,EDTLIN
	POP P,V
	POPJ P,
>;STANFO

^GCHR1:	ILDB C,STRIN	;GET CHR. (1 CHR.)
	JUMPE C,LOP1	;NONE?
	POPJ P,

IFN STANFO,<
^TYII:	INCHWL C
>;STANFO
			

;RETURN 7 BIT CHARACTER IN C, BUCKY BITS IN B.  EACH ALTMODE GIVES ANOTHER
;BUCKY BIT.
^GCHR:	MOVEI B,0
GCHRB:	PUSHJ P,GCHRA
	CAIN C,ALTMOD	;ALT-MODE?
IFN STANFO,<
	AOJA B,[TRO F,DOSETL	;YES -- FLAG WE HAVE CHANGED MODES.
		PUSH P,[INCHRW C]
		POP P,TYII	;THIS IS THE INSTRUCTION.
		JRST GCHRB]
>;STANFO
IFE STANFO,<AOJA B,GCHRB>
	TRNE C,600		;BUCKY BITS?
	LDB B,[POINT 2,C,28]	;YES, GET THEM IN B
IFN STANFO,<
	TRZN F,DOSETL		;IF WE WERE IN SPECIAL MODE,
	JRST .+3
	PUSH P,[INCHWL C]	;PUT TYII BACK
	POP P,TYII
>;STANFO
	ANDI C,177
	POPJ P,			;NO

^GCHRA:	PUSHJ P,GCHR1	;GET 1 CHR.
IFN STANFO,<
	CAIN C,15
	JRST EATLF
>;STANFO
	POPJ P,

IFN STANFO,<
EATLF:	SKIPN STRIN
	INCHRW C	;GET LF WHICH FOLLOWS CR (ALONG WITH BUCKY BITS)
	SKIPE STRIN
	ILDB C,STRIN
	XORI C,1512	;CHANGE IT BACK TO CR, PRESERVING BITS
	POPJ P,
>

; Non-Stanford Get a character, activate on activation routine

IFE STANFO,<
^TYII:	PUSHJ P,.+1
GETCHR:	ILDB C,INBP
	JUMPN C,CPOPJ
	PUSH P,A
	JRST GLSET
GLRESET:
IFN TENEX,<
	HRROI A,[XS: ASCIZ /XXX
/]
	PSOUT
>;TENEX
IFE TENEX,<
	OUTSTR [ASCIZ /XXX
/]>;NOT TENEX
GLSET:	MOVEI B,0
	MOVE C,[POINT 7,INBF-1,34]
	MOVEM C,INBP
GLP:
IFE TENEX,<
	INCHRW	C
>
IFN TENEX,<
	PBIN
	MOVE C,1
>
	SKIPE NBSSW
	JRST NOBS
	CAIN C,25
	JRST GLRESET
	CAIN C,177
	JRST ADJ
NOBS:	CAIN C,177
	JRST GLRESET
	CAIN C,1		;CTRL A
	JRST ADJ
	CAIE C,10
	JRST VANILLA
ADJ:	MOVSI C,70000
	ADD C,INBP
	JUMPGE C,.+2
	SUB C,[430000,,1]
	CAMN C,[POINT 7,INBF-1,27]
	JRST GLRESET
	MOVEM C,INBP
	ILDB C,C
	CAIN C,ALTMOD
	SUBI B,1
	SKIPN NBSSW
	MOVEI C,10
IFN TENEX,<
	MOVE A,C
	MOVE C,[PBOUT]
	EXCH C,VTINST
	PUSHJ P,VTSOUT
	EXCH C,VTINST		;RESET
>;TENEX
IFE TENEX,<
	OUTCHR	C
>
	JRST GLP

VANILLA:CAIN C,15
IFE TENEX,<INCHRW;>PBIN		;SUCK IT
	CAIN C,37		;EOT
	MOVEI C,15
	IDPB C,INBP
	CAIN C,ALTMOD
	AOJA B,GLP
	JUMPN B,ACT
	MOVE A,C
	IDIVI A,=36
	MOVE A,BRKTAB(A)
	MOVEI C,1
	LSH C,(B)
	MOVEI B,0
	TDNN A,C
	JRST GLP
ACT:	MOVEI B,0
	IDPB B,INBP
	MOVE A,[POINT 7,INBF-1,34]
	MOVEM A,INBP
	POP P,A
	JRST GETCHR
>;NOT STANFO

;GCHRS
;GET WORD OF CHARACTER IDENTIFICATION FLAGS IN D1 CORRESPONDING TO THE
;CHARCTER READ IN.  RETURN THE CHARACTER IN C AND ITS BUCKY BITS IN B
^GCHRS:	PUSHJ P,GCHR		;GET 1 CHR IN C, BUCKY BITS IN B
	CAIG C,140		;LOWER CASE?
	JRST GCHRSA		;NO
	SUBI C,40		;YES, CONVERT TO UPPER
	CAIL C,133		;LOWER CASE SPECIAL?
	ADDI C,5		;YES
GCHRSA:	MOVE D1,C		;GET CHR.
	IDIVI D1,=9		;SEPARATE FOR TABLE FETCH
	LDB D1,CHTB1(D2)	;GET TABLE ENTRY
	MOVE D1,CHTB3(D1)	;GET BITS
	TRNE D1,ILLG		;ILLEGAL CHR?
	JRST GCHRS1		;YES
	TRNE D1,BIG		;IGNORE BUCKY?
	MOVEI B,0		;YES, SET BUCKY BITS TO ZERO
	TRNN D1,BIL		;BUCKY ILLEGAL?
	POPJ P,			;NO
	JUMPE B,.-1		;YES, ANY BUCKY?
GCHRS1:	JRST INERR		;YES, ILLEGAL

RADIX =10
CHTB1:	FOR I_3,35,4
<	POINT 4,CHTB2(D1),I
>
RADIX 8

DEFINE TBM1 (A1,A2,A3,A4,A5,A6,A7,A8,A9,Q)
<IFDIF <>,<Q>,<.FATAL TOO MANY AT CHTB2>
IFIDN <>,<A9>,<.FATAL TOO FEW AT CHTB2>
	BYTE (4)A1,A2,A3,A4,A5,A6,A7,A8,A9 >

CHTB2:	TBM1 0,0,0,10,10,0,0,0,0	;0-10
	TBM1 10,6,0,0,10,0,0,0,0	;11-21
	TBM1 6,6,0,0,12,0,6,6,6		;22-32
	TBM1 6,0,0,6,10,3,3,5,10	;33-43
	TBM1 11,11,13,5,10,10,3,3,10	;44-54
	TBM1 3,4,3,2,2,2,2,2,2		;55-65
	TBM1 2,2,2,2,13,6,6,5,6		;66-76
	TBM1 10,6,1,1,1,1,1,1,1		;77-107
	TBM1 1,1,1,14,1,1,1,1,1		;110-120
	TBM1 1,1,1,1,1,1,1,1,1		;121-131
	TBM1 1,6,6,6,6,13,0,6,0		;132-142
	TBM1 6,6,0,0,0,0,0,0,0		;143-153

CHTB3:	ILLG			; 0  ILLEGAL CHR.
	LET!BOK			; 1  LETTER- BUCKY O.K.
	NUM!BOK			; 2  NUMBER - BUCKY O.K.
	AROP!BIG		; 3  ARITH OP-IGNORE BUCKY
	SSPC!LET!BOK!SLT	; 4  SPCL CHR-LETTR (.)
	SSPC!BOK 		; 5    "  "  "  BUCKY OK (" ')
	BOK			; 6  BUCKY O.K.
	BIL			; 7    "  ILLEGAL
	BIG			;10    "  IGNORE
	LET!SLT!BOK		;11  SPECIAL LTR ($ %)
	STRID!LET 		;12  START AN ID GODDAMMIT
	BOK!UOK			;13  OK FOR PREV TO BE UNDF (& : _)
	BOK!UOK!LET		;14  SAME, LETTER (K)

;Main Dispatch, <ctrl>., Numbers -- SCAN
^SCAN:	TLZ F,NUMF!SYMF!UNDF!FLTF!R5FL  ;CLEAR FLAGS
	TLZN F,SCFL	;GOT A CHR?
	PUSHJ P,GCHRS	;NO, GET ONE
	TRNE D1,LET	;LETTER?
	JRST SLET	;YES
	TRNE D1,NUM	;DIGIT?
	JRST SNUM	;YES
	TRNN D1,SSPC	;SPECIAL SCANNER CHR?
	POPJ P,		;NO
	CAIN C,"="	;=?
	JRST DECMAL	;YES
	CAIN C,42	; "
	JRST TEXT	;YES, TEXT FOLLOWS
	CAIN C,"'"	;'
	JRST STEXT	;YES, SIXBIT TEXT FOLLOWS
	JRST 4,.

LETSPC:	CAIN C,"."	;.?
	JRST ITDOT	;YES
	CAIN C,"%"	;IS IT %?
	JRST BYTIN	;YES
	POPJ P,		;NO

;WANT VALUE OF CURRENTLY OPEN LOCATION

ITDOT:	CAIE B,1	;1 BUCKY?
	JRST DOTBKY	;NO
	HRRZ E,LOCOP	;GET VALUE OF .
^ITD1:
IFE UESW,<
	JSR ECHK
IFE FILESW,<
	MOVE E,(E)	;GET VALUE THERE
>
IFN FILESW,<
	PUSHJ P,RDTRKE
	MOVE E,@TRKOFF
ITD1A:
>
>;NOT UESW
				IFN UESW,<MO (E,E)>
	MOVEM E,NM	;STORE VALUE
	TLO F,NUMF!SYMF	;SET FLAGS
	POPJ P,


DOTBKY:	CAIE B,2	;IS IT META
	POPJ P,		;NO
	JRST PNTIN	;YES, GET BYTE MODE INPUT

;OCTAL OR FLOATING NUMBER INPUT

SNUM:	JUMPN B,CPOPJ	;BUCKY BITS?
	MOVE V,[LSH V,3];SET RADIX TO OCTAL
	MOVEM V,RAD
DNUM:	SETZM FNM	;CLEAR FLOATING NUMBER
	SETZM NM	;CLEAR NUMBER
	TLOA F,NUMF	;NUMBER, SET FLAG
LOP2:	PUSHJ P,GCHRS	;GET CHR.
	TRNN D1,NUM	;NUM?
	JRST NODIG	;NO
	JUMPN B,NODIG	;BUCKY BITS?
	MOVEI V,-60(C)
	EXCH V,NM	;GET CURRENT NUMBER
RAD:	LSH V,3		;MULT
	ADDM V,NM	;ADD IN DIGIT
	MOVEI V,-60(C)	;GET DIGIT VALUE
	FLOAT V,	;FLOAT DIGIT
	EXCH V,FNM	;GET CURRENT FLOATING
	FMPR V,[10.0]	;MULT
	FADRM V,FNM	;ADD IN DIGIT
	JRST LOP2

NODIG:	CAIN C,"."	;.?
	JRST FLT	;YES
	TRNE D1,LET	;LETTER?
	JRST SINER	;YES
SINRET:	TLO F,NUMF!SCFL	;SET FLAGS
	HRRZ E,NM	;IN CASE WANT CONTENTS
	JRST ITCHK	;CHECK FOR <ctrl1>`.'

SINER:	JUMPN B,SINRET	;BUCKY BITS?
SCINR:	JRST INERR	;NO, ERROR

; FLOATING NUMBER INPUT

FLT:	JUMPN B,SINRET	;BUCKY BITS?
	MOVE C,[0.1]
	MOVEM C,NM
	MOVEI V,FLG	;SET FLOATING IF ONLY THING SO FAR
	PUSHJ P,TMPMOD
FLOP:	PUSHJ P,GCHRS	;GET CHR.
	TRNN D1,NUM	;NUM?
	JRST NODIGF	;NO
	JUMPN B,NODIGF	;BUCKY BITS?
	ANDI C,17	;GET DIGIT
	FLOAT C,	;FLOAT IT
	FMPR C,NM	;SCALE IT
	FADRM C,FNM	;ADD IN
	MOVE V,NM	;GET SCALE FACTOR
	FDVR V,[10.0]	;ADJUST IT
	MOVEM V,NM
	JRST FLOP

NODIGF:	TRNN D1,LET	;LETTER?
	JRST FLTRET	;NO
	JUMPN B,FLTRET	;NO BUCKY BITS?
	CAIE C,"E"
	JRST INERR	;LETTER WITHOUT B BITS, ERROR
	PUSHJ P,GCHRS	;GET NEXT CHAR
	JUMPN B,INERR	;MUST BE + OR - OR NUMBER ALL WITHOUT BUCKY
	SETZM NEGPWR#
	SETZM NM	;ACCUMULATE EXPONENT HERE
	TRNE D1,NUM
	JRST FLTEL
	CAIN C,"+"
	JRST FLTEL1
	CAIE C,"-"
	JRST INERR
	SETOM NEGPWR	;INDICATE NEGATIVE POWER
FLTEL1:	PUSHJ P,GCHRS
	TRNN D1,NUM
	JRST FLTELD
	JUMPN B,INERR
FLTEL:	MOVE B,NM
	IMULI B,=10
	ADDI B,-"0"(C)
	MOVEM B,NM
	JRST FLTEL1

FLTELD:	MOVE V,NM
	CAILE V,=38
	JRST INERR
	SKIPE NEGPWR
	MOVN V,V
	MOVE V,PTENTB(V)
	FMPRM V,FNM
	TRNN D1,LET
	JRST FLTRET
	JUMPE B,INERR
FLTRET:	TLO F,NUMF!FLTF!SCFL;SET FLAGS
	MOVE V,FNM
	MOVEM V,NM
	POPJ P,

RADIX =10
FOR @! I_=38,1,-1 <
	1.0E-!I
>
PTENTB:	1.0
FOR @! I_1,38,1 <
	1.0E!I
>
RADIX 8

;Letters, Decimal, Text -- SLET, DECMAL, TEXT

;SYMBOLIC INPUT

SLET:	JUMPN B,LETSPC		;BUCKY BITS
	TRNE D1,STRID		;START AN ID?
	PUSHJ P,GCHRS		;YES -- GET FIRST CHAR.
	SETZM SIXSYM
	MOVE D2,[POINT 6,SIXSYM]
	MOVEM D2,BYTSAV		;SET UP BYTE POINTER FOR SIXBIT
	SUBI C,40		;CONV TO SIXBIT
	IDPB C,BYTSAV
	TRNE D1,SLT		;SPECIAL LETTER?
	PUSHJ P,SLTCN		;YES
	SUBI C,'A'-13		;CONVERT TO RADIX 50
	TRNE D1,NUM
	ADDI C,'A'-13-17	;IN CASE FIRST CHAR IS NUMBER.
	MOVEM C,SYM		;SAVE
	MOVEI V,6		;COUNT
LOP3:	PUSHJ P,GCHRS		;GET CHR.
	TRNN D1,LET!NUM		;LETTER OR DIGIT?
	JRST ENSYM		;NO
	JUMPN B,ENSYM		;BUCKY BITS?
	SOJLE V,LOP3		;STOP AT 6 CHRS.
	SUBI C,40		;CONV TO SIXBIT
	TLNN F,R5FL
	IDPB C,BYTSAV		;DEPOSIT
	TRNE D1,SLT		;SPECIAL LETTER?
	PUSHJ P,SLTCN		;YES
	SUBI C,'A'-13		;CONVERT TO RADIX 50
	TRNE D1,NUM
	ADDI C,'A'-13-17	;CONVER NUM TO RADIX 50
	EXCH C,SYM		;GET SYMBOL
	IMULI C,50		;SHIFT
	ADDB C,SYM
	MOVEM C,NM
	JRST LOP3

SLTCN:	CAIN C,5		;% ?
	MOVEI C,47+'A'-13
	CAIN C,4		;$ ?
	MOVEI C,46+'A'-13
	CAIN C,'.'
	MOVEI C,45+'A'-13
	POPJ P,
BYTSAV:	0

;DECIMAL NUMBER INPUT

DECMAL:	JUMPN B,CPOPJ
	MOVEI V,DCM		;PERHAPS SET TEMPORARILY TO
	PUSHJ P,TMPMOD		;DECIMAL
	MOVE C,[IMULI V,12]
	MOVEM C,RAD		;SET RADIX TO DECIMAL
	PUSHJ P,GCHRS		;GET CHR.
	TRNE D1,NUM		;DIGIT?
	JRST DNUM		;YES, GO PROCESS
	JRST SCINR		;NO, ERROR

;ASCII WORD (OR EXTENDED TEXT) INPUT "/string/

TEXT:	JUMPN B,EXTTXT		;BUCKY BITS MEANS MULTI-WORD DEPOSIT
	MOVEI T,5		;ASCII CHR COUNT
	MOVEI V,TXT+2		;SET FOR ASCII OUTPUT MAYBE
TEX:	PUSHJ P,TMPMOD 
	MOVEI V,0		;INIT VALUE
	MOVNI M,-14(T)		;FORM SHIFT COUNT
	PUSHJ P,GCHR1		;GET TERM CHR.
	MOVE E,C		;HOLD
LOP8:	PUSHJ P,GCHR1		;GET CHR.
	CAMN C,E		;TERMINATOR?
	JRST TEXDON		;YES
	DPB C,[POINT 5,C-6(M),34];CONVERT TO SIXBIT IF M=6
	LSH C,-7(M)		;BUT NOT IF M=7
	LSH V,(M)		;SHIFT VALUE
	OR V,C			;OR IN CHR.
	SOJG T,LOP8		;CHR. COUNT DONE?
	PUSHJ P,GCHR1		;GET CHR
	CAME C,E		;TERM?
	JRST .-2		;NO
TEXRET:	LSH V,-6(M)		;ADJUST IF ASCII
	MOVEM V,NM		;STORE VALUE
	TLO F,NUMF		;SET NUMBER FLAG
	POPJ P,

	LSH V,(M)		;NO, ADJUST
TEXDON:	SOJGE T,.-1		;ENOUGH CHRS.?
	JRST TEXRET		;YES

;SIXBIT or RADIX50 INPUT  '/string/

STEXT:	MOVEI T,6		;SIXBIT CHR. COUNT
	MOVEI V,TXT+1		;SET MAYBE FOR SIXBIT OUTPUT
	JUMPE B,TEX		;GO DO IF NO BUCKY BITS

;RADIX50 INPUT CTRL1'string

R5TEXT:	TLO F,NUMF!SCFL!R5FL	;SET FLAGS
	MOVEI V,TXT		;SET MAYBE FOR RADIX50 OUTPUT
	PUSHJ P,TMPMOD
	SETZM SYM		;CLEAR LOCATION
	MOVEI V,7		;CHR. COUNT
	JRST LOP3		;GO CONVERT

;TMPMOD, EXTTXT, AMPER, ENSYM

;IF THE FIRST THING TYPED IN IS RECOGNIZABLE AS BEING OF A GIVEN
;DATA TYPE, WE WILL DISPLAY IT IN THAT MODE, AREN'T WE NICE?  --DCS

TMPMOD:	TLNN F,FIRF		;FIRST THING?
	MOVEM V,SAVMOD		;YES, SET UP FOR SPECIAL MODE SET
	POPJ P,

;MULTI-WORD ASCII INPUT CTRL1"/stringggggggggggggg.../

^EXTTXT:MOVE M,[EXBUF,,EXBUF+1] 	;CLEAR BUFFER
	SETZM EXBUF
	BLT M,EXEND
	MOVE M,[POINT 7,EXBUF]		;DEPOSIT POINTER
	SETLIN ASCLIN			;TURN OFF SPECIAL ACTIVATION MODE
	MOVEI V,5*EXTLN-10		;#CHARS ALLOWED
	PUSHJ P,GCHR1			;GET CHAR
	MOVE E,C			;DELIM CHARACTER
	MOVEI T,42
	IDPB T,M			;PUT IN "/ OR SOMETHING
	IDPB E,M
	MOVEI T,5			;#CHARS BETWEEN INTERVENTIONS

EXL1:	PUSHJ P,GCHRA			;GET A CHARACTER (DON'T DO ALT MODE THING)
	CAMN C,E			;ALL DONE?
	JRST EXTDN			;YES
EXL3:	JUMPN T,EXPTH			;MORE TO GO BEFORE INTERVENTION?
	IDPB E,M			;PUT IN DELIM,BROCK,",DELIM
	MOVEI T,">"
	IDPB T,M
	MOVEI T,42			; " CHAR
	IDPB T,M
	IDPB E,M
	MOVEI T,5			;RESET COUNT
	SUBI V,4
EXPTH:	IDPB C,M			;PUT CHAR AWAY
	SOJL V,[EXL2:	PUSHJ P,GCHR1 	;TOSS OUT REMAINING CHARS
			CAME C,E	;UNTIL DELIMITER SEEN
			JRST EXL2
			JRST EXTDN]	;THEN QUIT
IFN STANFO,<
	CAIN C,15
	JRST [	MOVEI C,12
		SOJA T,EXL3	]
>;STANFO
	SOJA T,EXL1			;LOOP

EXTDN:	IDPB E,M			;ONE MORE DELIMITER
	MOVEI T,15			;END THE STRING
	IDPB T,M			;WITH A CRLF
IFN STANFO,<
	MOVEI T,12
	IDPB T,M
>;STANFO
	MOVE T,[POINT 7,EXBUF]		;LET RAID READ THIS!
	MOVEM T,STSAV			;SAVE BP FOR DEPO ROUTINE (IF CALLED)
	SETLIN RADLIN
	TLZ F,SCFL			;NOT AHEAD ONE
	JRST SCAN			;RESTART (GET CRLF OR WHATEVER)

;SYMBOL WITH BLOCK NAME MODIFIER

AMPER:
IFE SORTED,<
	PUSH P,SYMPNT	;SAVE CURRENT SYMBOL TABLE POINTER
>
IFN SORTED,<
	PUSH P,BID
>
	PUSH P,V	;SAVE ACS
	PUSH P,E
	PUSH P,T
	PUSH P,F1
	MOVSI F1,SINGF	;SET UP DUMMY BIT ("YOU STUPID BIT!")
	PUSHJ P,CSFLUSH	;FLUSH CACHES
	PUSHJ P,BLKFND	;FIND THE INDICATED BLOCK
	PUSHJ P,SCAN	;SCAN NEXT THING
	POP P,F1	;RESTORE ACS
	POP P,T
	POP P,E
	POP P,V
IFE SORTED,<
	POP P,SYMPNT	;RESTORE SYMBOL TABLE POINTER
>
IFN SORTED,<
	POP P,BID
>
	JRST CSFLUSH	;CLEAR CACHES AND RETURN

ENSYM:	MOVEI V,CYM	;ALWAYS SET TEMP MODE TO CYMBOLIC IF SYM IS SEEN
	TLNN F,R5FL	;DON'T CHANGE MODE IF RADIX50 INPUT
	PUSHJ P,TMPMOD
	CAIN C,"&"	;IS IT & ?
	JUMPE B,AMPER	;YES, TREAT AS BLOCK NAME, SYMBOL TO FOLLOW
	TLNE F,R5FL	;RADIX 50 CONVERT?
	POPJ P,		;YES
	HRRZ E,LOCOP	;GET VALUE OF .
	MOVEI V,45	;RADIX 50 "."
	CAMN V,SYM	;IS THAT IT?
	JRST SYMDOT	;YES
	TLNN F,FIRF	;FIRST THING?
	PUSHJ P,FNDOP	;YES
	JRST SYMLOK	;GO LOOK UP SYMBOL

;Byte Input

BYTIN:	PUSH P,D3	;SAVE ACS
	PUSH P,PV
	PUSH P,F
	TRO F,BYTSW	;MAKE EVAL STOP ON COMMAS
	PUSHJ P,EVAL	;GET NEXT NUMBER
	TLNN F,USINGF	;UNDEF?
	TLNN F,VALF	;VALUE?
	JRST CERR	;NO
	ANDI V,77	;TRUNCATE
	SETZM BVAL	;CLEAR VALUE
	SETZM SHFT	;CLEAR BYTE SIZE
	JUMPE V,ZERSZ	;ZERO?
	MOVNM V,SHFT	;NO, STORE COUNT
	TLNN F,FIRF	;IF FIRST THING, STORE
	DPB V,[POINT 6,SAVMOD,29] ;BYTE SIZE
	MOVEI D2,44	;GET MAX (INITIAL SHIFT COUNT)
	MOVEM D2,SHFTA	;STORE
	MOVEI D2,1
	LSH D2,(V)	;FORM MASK.....
	SUBI D2,1	;...
	MOVEM D2,BMSK	;STORE
BLOP:	PUSHJ P,EVAL	;GET NEXT
	TLNE F,VALF	;VALUE?
	JRST CERR	;YES, BUT THIS ISNT POSSIBLE
	CAIE C,","	;,?
	JRST BYDON	;NO, DONE
	PUSHJ P,EVAL	;GET NEXT
	TLNN F,VALF	;VALUE?
	JRST BYDON	;NO, LEAVE
	TLNE F,USINGF	;DEFINED?
	JRST CERR	;NO
	MOVE D2,SHFT
	ADDB D2,SHFTA	;CALCULATE NEW SHIFT COUNT
	AND V,BMSK	;AND VALUE WITH MASK
	LSH V,(D2)	;SHIFT
	IORM V,BVAL	;OR WITH VALUE
	JRST BLOP	;LOOP

BYDON:	POP P,PV	;GET OLD FLAGS
	AND PV,FLGMSK
	ANDCM F,FLGMSK	;PUT BACK...
	IOR F,PV	;CERTAIN FLAGS
	MOVE PV,BVAL	;GET VALUE
	MOVEM PV,NM	;STORE
	POP P,PV	;RESTORE ACS
	POP P,D3
	TLO F,SCFL!NUMF	;SET FLAGS
	MOVN V,SHFT	;BYTE SIZE, IF GIVEN
	LSH V,6		;INTO POSITION
	TRO V,BYT
	MOVEM V,SAVMOD	;ALWAYS SWITCH MODE HERE
	POPJ P,		;LEAVE

FLGMSK:	EHDF!VALF!SINGF!ESPCF!FIRF!EVMF!USINGF,,BYTSW!CONOF
SHFT:	0
SHFTA:	0
BMSK:	0
BVAL:	0

ZERSZ:	SKIPL D2,SMASK+1	;GET MASK
	SETCA D2,		;NORMALIZE
	MOVEM D2,BMSK		;STORE
ZLOP:	PUSHJ P,EVAL		;GET NEXT THING
	TLNE F,VALF		;VALUE?
	JRST CERR		;NOT POSIBLE
	CAIE C,","		;,?
	JRST BYDON		;NO, DONE
	PUSHJ P,EVAL		;GET NEXT
	TLNN F,VALF		;VALUE?
	JRST BYDON		;NO, DONE
	TLNE F,USINGF		;DEFINED?
	JRST CERR		;NO
	MOVEI D2,44		;INITL POSITION
	MOVEI D3,		;INITL SIZE
	SKIPN PV,BMSK		;GET MASK
	JRST ZLOP		;ZERO, NO MORE ROOM
	JUMPL PV,ZERARN		;ALREADY GOT A 1 BIT?
	SUBI D2,1		;NO, COUNT
	LSH PV,1		;SHIFT
	JUMPGE PV,.-2
ZERARN:	ADDI D3,1		;COUNT SIZE
	LSH PV,1
	JUMPL PV,.-2
	MOVE PV,D2		;SAVE POSITION
	ROT D3,-6		;GET SIZE
	LSHC D2,-6		;GET POSITION
	ADDI D3,BVAL		;AND ADDRS
	IDPB V,D3		;DEPOSIT VALUE
	ROT PV,-6		;GET POSITION
	MOVEI V,
	IOR PV,[4400,,BMSK]
	SETCMM BMSK		;SET THIS FIELD TO 0, NEXT TO 1
	DPB V,PV		;CLEAR HIGH ORDER BITS
	JRST ZLOP

;PNTIN	POINT MODE INPUT

PNTIN:	PUSH P,D3	;SAVE ACS
	PUSH P,PV
	PUSH P,F
	TRO F,BYTSW	;MAKE EVAL STOP ON COMMAS
	PUSHJ P,EVAL	;GET NEXT NUMBER
	TLNN F,USINGF	;UNDEF?
	TLNN F,VALF	;VALUE?
	JRST CERR	;NO
	ANDI V,77
	LSH V,=24
	MOVEM V,BVAL	;SAVE BYTE SIZE
	PUSHJ P,EVAL	;GET NEXT
	TLNN F,VALF	;VALUE?
	CAIE C,","	;,?
	JRST CERR	;YES, BUT THIS ISNT POSSIBLE
	PUSHJ P,EVAL	;GET NEXT
	TLNN F,USINGF	;UNDEFINED?
	TLNN F,VALF	;VALUE?
	JRST CERR	;NO, LOSE
	TLZ V,777740	;KEEP @ AND XR FIELD
	IORM V,BVAL
	PUSHJ P,EVAL
	TLNE F,VALF
	JRST CERR
	CAIE C,","
	JRST PNT44
	PUSHJ P,EVAL
	TLNN F,USINGF	;UNDEFINED
	TLNN F,VALF	;VALUE
	JRST CERR
	MOVN V,V
	ADDI V,=35
	JUMPL V,CERR
	CAILE V,=35
	JRST CERR
PNTDON:	DPB V,[POINT 6,BVAL,5]
	POP P,PV	;GET OLD FLAGS
	AND PV,FLGMSK
	ANDCM F,FLGMSK	;PUT BACK...
	IOR F,PV	;CERTAIN FLAGS
	MOVE PV,BVAL	;GET VALUE
	MOVEM PV,NM	;STORE
	POP P,PV	;RESTORE ACS
	POP P,D3
	TLO F,SCFL!NUMF	;SET FLAGS
	MOVEI V,BTP
	MOVEM V,SAVMOD	;ALWAYS SWITCH MODE HERE
	POPJ P,		;LEAVE

PNT44:	MOVEI V,44
	JRST PNTDON

;Escan -- Scan and Check Reasonable
COMMENT  CALL THIS TO SCAN, AND CHECK FOR UNDEFINED
 SYMBOLS -- IF UNDEFINED, ABORT UNLESS IT'S OK FOR
 AN UNDEFINED SYMBOL TO BE HERE


^ESCAN:	PUSHJ P,SCAN		;NEED TO SCAN
	TLNE F,SYMF		;SYMBOL
	TLNN F,UNDF		; AND UNDEFINED?
	POPJ P,			;NO, OK
	PUSH P,F		;SAVE (PU WILL CLEAR IF ABORT)
	PUSHJ P,SCAN		;GET NEXT THING
	TLNN F,SYMF!NUMF	;SYMBOL, NUMBER, OR
	TRNN D1,UOK		; NOT OK TO BE UNDEF?
	JRST PU			;RIGHT, UNDEF ERROR
	POP P,F			;GET UNDF, SCFL (LOOKAHEAD) BACK
	POPJ P,			;RETURN NORMALLY

;Eval

BEGIN EVAL

^EVAL:	TLZ F,VALF!SINGF!ESPCF!FIRF!EVMF
	TRZ F,CONOF
	TLZE F,EHDF		;ALREADY GOT ONE?
	JRST [	MOVE B,SAVB	;YES
		MOVE C,SAVC
		POPJ P,]
	PUSHJ P,ESCAN		;NO
	TLNN F,NUMF!SYMF	;NUMBER OR SYMBOL?
	JRST NONUM3
	TLNE F,SYMF		;SYMBOL?
	TLO F,SINGF!USINGF!VALF	;YES
	TLNE F,UNDF		;DEFINED?
	POPJ P,			; NO
	TLZ F,USINGF
	TLO F,FIRF		;DO NOT LOOK FOR OPCODES
LOOP1.:	MOVE D3,NM		;GET VALUE
LOOP1:	PUSHJ P,ESCAN		;GET NEXT THING
	TLNE F,SYMF!NUMF	;SYMBOL OR NUMBER?
	JRST PNT1		;YES
	TRNE D1,AROP		;ARITH OP?
	JRST ARP		;YES
	CAIN C,","		;,?
	JRST COM1		;YES, HANDLE
	JSR ATCHK		;CHECK FOR @... HANDLE
	JRST LOOP1		;YES, IT WAS A @
	TLO F,ESPCF
	PUSHJ P,LPRNC		;CHECK FOR AND HANDLE (
	JRST PNT1		;YES
LEVE:	TLO F,EHDF!VALF		;WE'RE AHEAD AND WE HAVE A VALUE
	MOVE V,D3		;GET VALUE
	MOVEM B,SAVB
	MOVEM C,SAVC		;SALIENT VALUES
	POPJ P,

ARP:	TLZ F,SINGF
	CAIE C,"/"		;/?
	CAIN C,"*"		;*?
	JRST MULDIV		;ONE OR THE OTHER
LOP1:	CAIN C,"-"		;-?
	JRST SUBT		;YES
	CAIN C,"!"
	JRST EXCL
	CAIN C,40		;SPACE?
	TLO F,ESPCF		;YES, SET FLAG
LOOP3:	SKIPA PV,[ADD D3,(P)]	;GET OPERATOR
SUBT:	MOVE PV,[SUB D3,(P)]	;  LIKEWISE
LOP4:	PUSHJ P,ESCAN		;GET NEXT THING
LOOP2:	TLNN F,NUMF		;NUMBER?
	JRST NONUM2		;NO
LOOP7:	TLZE F,EVMF		;NEGATE?
	MOVNS NM		;YES
	TLNE F,ESPCF		;SPACE SEEN?
	HRRZS NM		;YES, CLEAR LEFT HALF
	PUSH P,NM		;SAVE NUMBER
LOP2:	PUSHJ P,ESCAN		;GET NEXT THING
	TLNE F,NUMF		;NUMBER?
	JRST PNT1		;YES
	TRNN D1,AROP		;ARITH OP?
	JRST NOOP1		;NO
LOP5:	CAIN C,"*"		;*?
	JRST MULP		;YES
	CAIN C,"/"		;/?
	JRST DIVP		;YES
	XCT PV			;DO OP
	SUB P,[1,,1]		;POP
	JRST LOP1

MULP:	SKIPA M,[IMULM D2,(P)]	;GET OPERATOR
DIVP:	MOVE M,[IDIVM D2,(P)]	;  LIKEWISE
LOOP5:	PUSH P,M		;SAVE
	PUSHJ P,ESCAN		;GET NEXT THING
	POP P,M			;GET BACK
	TLNN F,NUMF		;NUMBER?
	JRST NONUM1		;NO
LOOP6:	MOVE D2,NM		;GET OPERAND
LOP3:	EXCH D2,(P)		;SWITCH AROUND
	XCT M			;DO OP
	JRST LOP2

NONUM1:	PUSHJ P,LPRNC		;CHECK FOR ( AND HANDLE
	JRST LOOP6		;YES IT WAS
	JSR ATCHK		;CHECK FOR @ AND HANDLE
	JRST LOOP5		;YES IT WAS
	CAIE C,40		;SPACE?
	CAIN C,"+"		;+?
	JRST LOOP5		;YES, IGNORE
	CAIE C,"-"		;-?
	JRST INERR		;NO
	PUSHJ P,ESCAN		;GET NEXT
	TLNN F,NUMF		;NUMBER?
	JRST INERR		;HOW LONG CAN THIS GO ON?
	MOVN D2,NM		;YES
	JRST LOP3
NOOP1:	CAIN C,","		;,?
	JRST COM2		;YES, HANDLE
	JSR ATCHK		;CHECK FOR @ AND HANDLE
	JRST LOP2		;YES, IT WAS
NOOP.1:	XCT PV			;DO OP
	SUB P,[1,,1]		;POP
	TLO F,ESPCF
	PUSHJ P,LPRNC		;TEST FOR AND HANDLE (
	JRST PNT1		;YES, IT WAS A (
	JRST LEVE
NONUM2:	PUSHJ P,LPRNC		;CHECK FOR ( AND HANDLE
	JRST LOOP7		;YES, IT WAS A (
	JSR ATCHK		;CHECK FOR @ AND HANDLE
	JRST LOP4		;YES, IT WAS A @
	CAIE C,40		;SPACE?
	CAIN C,"+"		;+?
	JRST LOP4		;YES, IGNORE
	CAIE C,"-"		;-?
	JRST LEVE		;NO
	TLC F,EVMF		;COMPLIMENT SWITCH ("YOU ARE A WONDERFULL SWITCH!")
	JRST LOP4

MULDIV:	MOVE PV,[ADD D3,(P)]	;GET DUMMY OP
	MOVEI D3,		;GET DUMMY OPERAND
	PUSH P,NM		;SAVE NUMBER
	JRST LOP5

EXCL:	MOVE PV,[IOR D3,(P)]
	JRST LOP4

ATCHK:	0
	JUMPN B,ATCHKX
	CAIN C,"@"	;@?
	TLOA D3,20	;YES, SET @ BIT
ATCHKX:	AOS ATCHK	;NO, SKIP
	JRST @ATCHK	;LEAVE

NONUM3:	PUSHJ P,LPRNC	;CHECK FOR ( AND HANDLE
	JRST LOOP1.	;YES, IT WAS (
	CAIN C,40	;SPACE?
	JRST EVAL	;YES, IGNORE
	CAIN C,"-"
	JRST [	MOVEI D3,0	;YES , SET UP DUMMY ZERO
		TLO F,FIRF	;SET FLAG
		JRST SUBT]	;GO SUBTRACT
	CAIN C,","
	JRST [	MOVEI D3,0	;YES, SET UP DUMMY ZERO
		TLO F,FIRF
		JRST COM1]
	CAIE C,"@"	;IS IT @?
	POPJ P,		;NO, LEAVE
	JUMPN B,CPOPJ	;LEAVE IF BUCKY BITS
	MOVSI D3,20	;YES, GET @ BIT
	TLO F,FIRF
	JRST LOOP1

COM1:	TRNE F,BYTSW	;STOP ON ,?
	JRST LEVE	;YES
	HRLZS D3	;SHIFT RIGHT HALF TO LEFT HALF
	TLO F,ESPCF	;TRUNCATE FURTHER NUMBERS TO 18 BITS
	PUSHJ P,ESCAN	;GET NEXT THING
	TLNN F,NUMF	;NUMBER?
	JRST CM1	;NO
LOOP4:	TRNE F,CONOF	;I/O OPCODE?
	JRST [	LSH D3,6  ;YES
		TLZ D3,700377
		JRST PNT1]
	LSH D3,5	;MAKE AC FIELD
	TLZ D3,777000	;...
PNT1:	MOVE PV,[ADD D3,(P)];GET DUMMY ADD (+)
	JRST LOOP2
CM1:	CAIN C,","	;ANOTHER ,?
	JRST LOOP3	;YES
	JRST LOOP4	;NO
COM2:	TRNE F,BYTSW	;STOP ON ,?
	JRST NOOP.1	;YES
	PUSHJ P,ESCAN	;GET NEXT THING
	TLNN F,NUMF	;NUMBER?
	JRST CM2	;NO
LLP4:	MOVE M,(P)	;GET THING
	TRNE F,CONOF	;I/O OPCODE?
	JRST [	ANDI M,774	;YES
		LSH M,22+6
		JRST LLQ4]
	ANDI M,17	;MAKE AC FIELD
	LSH M,22+5
LLQ4:	MOVEM M,(P)
	XCT PV		;DO OP
	SUB P,[1,,1]	;POP
	TLO F,ESPCF
	JRST PNT1
CM2:	CAIE C,","	;ANOTHER ,?
	JRST LLP4	;NO
	XCT PV		;DO OP
	SUB P,[1,,1]	;POP
	HRLZS D3	;SWAP
	JRST LOOP3-1
LPRNC:	CAIE C,"("	;(?
	JRST LL1	;NO
	PUSH P,D3	;YES, SAVE D3
	PUSH P,M
	PUSH P,PV
	PUSHJ P,EVAL	;EVALUATE THING IN ()
	TLNN F,VALF	;GET BACK A VALUE?
	JRST CERR	;NO
	PUSH P,V	;YES, SAVE IT
	PUSHJ P,EVAL	;GET NEXT THING
	CAIN C,")"	;IS IT A )?
	TLNE F,VALF!SYMF!SINGF;...
	JRST CERR	;NO, ERROR
	POP P,NM	;PUT VALUE IN NM
	MOVSS NM	;SWAP IT
	POP P,PV	;RESTORE
	POP P,M
	POP P,D3
	TLOA F,FIRF!VALF!NUMF
LL1:	AOS (P)
	POPJ P,
BEND EVAL
^EVAL_EVAL
BEND SCAN

;Racgt, Jacgt, Once, Svacs

BEGIN SUBS

^RACGT:	0		;GET RAID ACS
	SKIPE ACSW	;SEE IF USER'S ACS ALREADY SAVED
	JRST RACGT2	;YES, DON'T CLOBBER, BUT GET OURS AGAIN FOR SAFETY
	MOVEM 17,JAC+17
	MOVEI 17,JAC
	BLT 17,JAC+16
	SETOB V,ACSW
IFN STANFO,<
	GETLIN V	;GET LINE BITS
	CAME V,[-1]
	JRST RACNDT	;NOT DETACHED
	SETOM DETFLG
	MOVEI V,0
RACNDT:	MOVEM V,USERLIN	;SAVE FOR USER
	TLO V,100	;SPECIAL ACTIVATION MODE
	MOVEM V,RADLIN	;FOR NORMAL RAID OPERATIONS
	TLZ V,100	;FOR ASCII INPUT OPERATIONS
	MOVEM V,ASCLIN
	TLO V,20	;FULL CHARACTER SET MODE, FOR EDITING
	MOVEM V,EDTLIN
	SETACT [BRKTI,,0];SAVE HIS BREAK TABLE
>
RACGT2:	MOVSI 17,RAC
	BLT 17,17
IFE FILESW,<	;AVOID DOING SETSYM HERE IF FILE VERSION (DONE IN ONCE)
IFN SORTED,<
	MOVE V,JOBSYM
	CAME V,SAVJSM
	PUSHJ P,SETSYM	;RESET SYMBOL TABLE IF MOVED (OR FIRST TIME)
>;SORTED
>;NOT FILESW
	HRRZS RACGT	;BLAST FLAGS
	JRST 2,@RACGT	;SO WE CAN CLEAR THEM HERE (ESP IOT-USER)

IFE UESW!FILESW,<
^JACGT:	0		;GET JOB AC'S
	SKIPN ACSW
	JRST @JACGT
	SETZM ACSW
	MOVEM 17,RAC+17
	MOVEI 17,RAC
	BLT 17,RAC+16
IFN STANFO,<
	SETLIN USERLIN		;RESTORE USER'S LINE CHARACTERISTICS.
	MOVE BRKJSR
	TLNE 4000
	EIOTM		;RESTORE IOT-USER
>;STANFORD
	MOVSI 17,JAC
	BLT 17,17
IFN STANFO,<
	SETACT [BRKTI]	;PUT BACK USER'S BREAK TABLE
>
	JRST @JACGT
>;UESW!FILESW=0

^DETFLG:	0		;-1 IF WE ARE DETACHED WHEN STARTING UP
^USERLIN:	0
^EDTLIN:	0
^ASCLIN:	0
^RADLIN:	0

^SVACS:	MOVEM 17,RAC+17	;CALL THIS ROUTINE TO STASH AWAY RAID'S ACS
	MOVEI 17,RAC	;WHEN WAITING FOR TTY INPUT
	BLT 17,RAC+16	;SO <CALL>, <SAVE>, <DDT> WILL WORK
	MOVE 17,RAC+17
	POPJ P,

^ONCE:	0
	JFCL CHKSYM		;JFCL CLOBBERED TO A JRST WHEN ONCE IS DONE
	MOVE P,[-PDLEN,,PDL-1]
IFN FILESW,<
RAIDXX:	OUTSTR [ASCIZ /
DMP FILE? (Y or N) /]
	INCHRW A
	CAIE A,"Y"
	CAIN A,"y"
	JRST RDDMPF
	SETZM DMPFSW
	GETFIL (<
TYPE FILE NAME - >,'')
	JRST RDDMP1

RDDMP4:	SETOM MODFSW
	ENTER SVLUP
	JRST 4,.
	JRST RDDMP3

RDDMPF:	SETOM DMPFSW
	GETFIL (<
TYPE DMP FILE NAME - >,'DMP')
RDDMP1:	OUTSTR [ASCIZ /DO YOU WANT TO MODIFY THE FILE? /]
	SETZM MODFSW
	INCHRW A
	CAIE A,"Y"
	CAIN A,"y"
	JRST RDDMP4
RDDMP3:	MOVS A,FILLUP+3		;- WORD COUNT
	SETCA A,		;WORD COUNT-1
	SKIPE DMPFSW
	ADDI A,74
	MOVEM A,FILLST
	SKIPN DMPFSW
	JRST RDDMP2		;MAKE A PHONEY SYMBOL TABLE
	IN [	-<140-74>,,TRKBUF-1
		0	]
	JRST FONCA0
	OUTSTR [ASCIZ /LOST TRYING TO READ LOW CORE
/]
	JRST 4,.

FONCA0:	SKIPE E,TRKBUF-74+HILOC	;CORE ADDRESS OF START OF UPPER
	JRST FONC3C		;JUMP IF THERE IS AN UPPER SEGMENT
	MOVE E,FILLST
	HRRZM E,FLOWND
	IORI E,1777
	MOVEM E,FJBREL
	MOVEM E,FJBHRL
	SETZM UPPRST		;NO UPPER
	JRST FONC3B

FONC3C:	HRRZM E,HILOCF		;SAVE CORE ADDRESS OF BEGINNING OF UPPER
	HRRZM E,FLOWND
	IORI E,1777
	HRRZM E,FJBREL
	HRRZ E,TRKBUF-74+HILOC	;CORE ADDRESS OF START OF UPPER
	CAIGE E,400000
	MOVEI E,400000
	MOVEM E,UPPRST		;START OF UPPER
	HRRZ E,TRKBUF-74+HILOC	;CORE ADDRESS OF START OF UPPER
	MOVN E,E
	ADD E,FILLST		;SIZE OF THE UPPER - 1
	ADD E,UPPRST
	MOVEM E,FJBHRL		;LAST ADDRESS OF UPPER
FONC3B:	SKIPN A,TRKBUF-74+JOBSYM;SYMBOL TABLE POINTER
	JRST RDDMP2		;NO SYMBOL TABLE
	HLRE C,A		;-SIZE OF SYMBOL TABLE
	MOVN C,C		;SIZE OF SYMBOL TABLE
	ADDI C,-1(A)		;CORE ADDRESS OF LAST WORD OF SYMBOL TABLE
	HRRZ A,A		;CORE ADDRESS OF FIRST WORD OF SYMBOL TABLE
	CAMLE A,FLOWND		;SKIP IF SYMBOL TABLE BEGINS IN LOWER
	JRST FONC4A		;SYMBOL TABLE BEGINS IN UPPER
	CAMLE C,FLOWND		;SKIP IF SYMBOL TABLE ENTIRELY IN LOWER
	JRST RDDMP2		;GOES PAST END OF LOWER
	JRST FONC4B

FONC4A:	SKIPN UPPRST
	JRST RDDMP2		;NO UPPER, NO SYMBOLS
	CAML A,UPPRST		;SKIP (LOSE) IF SYMBOL TABLE STARTS BEFORE UPPER
	CAMLE C,FJBHRL		;SKIP (WIN) IF SYM TABLE FINISHES BEFORE UPPER ENDS
	JRST RDDMP2		;LOSE.  SYMBOL TABLE DOESN'T FIT ENTIRELY IN UPPER
	SUB A,UPPRST		;DISTANCE FROM START OF UPPER TO START OF SYM TAB
	ADD A,HILOCF		;(PSEUDO) CORE ADDRESS OF START OF UPPER
FONC4B:	MOVEI B,-74(A)		;DISK ADDRESS OF SYMBOL TABLE
	IDIVI B,200		;C GETS OFFSET OF SYM TAB FROM RECORD BOUNDARY
	USETI 1(B)		;ACCESS TO RECORD CONTAINING SYM TAB
	MOVE B,TRKBUF-74+JOBSYM	;-LENGTH OF SYM TAB,,
	HRR B,JOBFF
	ADD B,C
	MOVEM B,JOBSYM
	HRL C,C
	SUB B,C			;AOBJN POINTER FOR TRANSFER
	HLRE C,B		;- NUMBER OF WORDS IN TRANSFER
	MOVN C,C
	ADD C,JOBFF
	MOVEM C,JOBFF
FONCA1:	MOVE C,JOBFF
	IORI C,1777
	CORE C,
	JRST FONCA1
	SUBI B,1		;MAKE INTO IOWD
	MOVEI C,0
	IN B			;READ IN THE SYMBOL TABLE
	JRST FONCE3
	OUTSTR [ASCIZ /LOST TRYING TO READ IN SYMBOL TABLE
/]
	JRST 4,.

RDDMP2:	PUSHJ P,MKSYTB
FONCE3:	MOVE E,FILLST
	ADDI E,1
FONC3A:	MOVEM E,TUBOUN
	MOVEM E,PUBOUN
	MOVEI E,20
	MOVEM E,TLBOUN
	MOVEM E,PLBOUN
IFN SORTED,<
	PUSHJ P,SETSYM
>;SORTED
>;END FILESW
IFE FILESW,<
	MOVEI E,BEGDDT
	CAIN E,140		;START AT 140 UNLESS RAID IS FIRST
	MOVEI E,ENDDT		;SET LOWER BOUND AT DDTEND TO START WITH
	MOVEM E,TLBOUN
	MOVEM E,PLBOUN
>;NOT FILESW
IFE SORTED&FILESW,<
	MOVE E,JOBSYM		;SET UPPER BOUND AT LOWER OF JOBSYM AND
>
IFE SORTED,<
	MOVEM E,SAVSYM#
>;NOT SORTED
IFE FILESW,<
	MOVEI E,-20(E)		;REMOVE DEFAULT OFFSET
	CAML E,JOBFF		; JOBFF CONTENTS TO START WITH
	HRRZ E,JOBFF
	CAIN E,ENDDT		;IF RAID IS AT END
	MOVEI E,BEGDDT		;THEN SET UPPER BOUND BELOW IT
	MOVEM E,TUBOUN
	MOVEM E,PUBOUN
>;NOT FILESW
	MOVEI E,CTABCN		;NO MACROS YET
	MOVEM E,TABLEN
	SETOM DDSW		;DON'T KNOW WHAT KIND OF DISPLAY YET
	MOVS PNT,SPNT
	MOVE E,PNT
	SUB PNT,[1,,1]
	HRLI E,-MAXDLN
	SETZM (E)
	AOBJN E,.-1
	SETZB F,DCON
	SETOM STPOP
	SETOM LOCOP
	SETZM SAVMOD		;SPECIAL CURMOD SAVE VARIABLE (SEE TMPMOD ROUTINE)
	SETZB C,NBIGWD		;CLEAR C FOR PRGSET
	MOVSI F1,SINGF
	PUSHJ P,PRGSET		;FIND A REASONABLE FIRST PROG
				IFN UESW,<MOVE T,[400001,,SPBLT]
					SETZM SPSWT1#
					SETZM SPSWT2#
					CALL T,[SIXBIT/SPCWGO/]
					SKIPN SPSWT1
					JRST .-1
					HRRZ T,SPSWT1
					CALL T,[SIXBIT /CORE/]
					JRST 4,.
					SETOM SPSWT2
					SKIPE SPSWT2
					JRST .-1
					PUSHJ P,WRAP
					MOVEM V,SYMPRG
					MOVEM V,SYMPNT
					TNOFFS>
	MOVSI E,(<JRST>)	;DESTROY THIS ROUTINE
	HLLM E,ONCE+1
	JRST @ONCE

IFN FILESW!DEBSYM,<
^^MKSYTB:MOVE A,JOBFF
	ADDI A,216
	CORE A,
	JRST 4,.
	MOVE A,JOBFF
	HRRZ B,A
	ADDI B,216
	MOVEM B,JOBFF
	HRLI A,-216
	MOVEM A,JOBSYM
	SETOM (A)
	MOVEI B,12
	MOVEM B,1(A)
	MOVEI B,13
	MOVEM B,2(A)
	MOVEI B,14
	MOVEM B,3(A)
	MOVEM B,4(A)
	MOVEI B,214
	MOVEM B,5(A)
	MOVEI B,216
	MOVEM B,6(A)
	MOVEM B,7(A)
	MOVEM B,10(A)
	MOVEM B,11(A)
IFN FILESW,<
	MOVE B,[RADIX50 0,FRAID]
>
IFN DEBSYM,<
	MOVE B,[RADIX50 0,DRAID]
>
	MOVEM B,12(A)
	SETZM 13(A)
	MOVE B,[RADIX50 50,AFRAID]
	MOVEM B,214(A)
	SETZM 215(A)
	POPJ P,
>;FILESW!DEBSYM

IFE SORTED,<
CHKSYM:	MOVE T,JOBSYM
	SUB T,SAVSYM
	JUMPE T,@ONCE
	PUSH P,ONCE
	ADDM T,SAVSYM
	HRRE V,T
	CAME V,T
	JRST SYMRST		;SYMTAB REALLY GRONKED
	ADDM T,SYMPNT
	ADDM T,SYMPRG
	MOVEI V,NUMREF
CHKSY2:	SKIPE PRGREF(V)
	ADDM T,PRGREF(V)
	SKIPE BLKREF(V)
	ADDM T,BLKREF(V)
	SOJGE V,CHKSY2
	POPJ P,
>;NOT SORTED
IFN SORTED,<
CHKSYM:	JRST @ONCE
>;SORTED

IFN FILESW,<
;^XTRASW:0		;-1 IF READING FROM EXTRA CYLINDERS, 0 IF FROM DMP FILE
;			;1 IF FROM XCOP FILE
^DMPFSW:0		;-1 IF DUMP FILE
^MODFSW:0		;+1 IF WANTS TO MODIFY THE FILE
^FILLST:0		;LAST ADDRESS IN FILE
^NOTFIL:0		;FLAG TO GETPOI TO FORGET ABOUT LOOKING IN THE FILE
^FLOWND:0		;LAST USEFUL ADDRESS IN LOWER
^FJBREL:0		;JOBREL OF LOWER
^FJBHRL:0		;JOBREL OF UPPER
^UPPRST:0		;STARTING ADDRESS OF UPPER
^HILOCF:0		;BEGINNING CORE ADDRESS OF UPPER

>;FILESW

; END OF ONCE ONLY CODE

;Parameters, Headers, Buffers, Variables for Data Display

IFN REALSW,<RAIDPG__17;>RAIDPG__16

DEFINE HJUMDS <35>
HJUMSZ__5
^LINLEN__=24

; Device bits, Stanford status word
IFN STANFO,<
DDBIT__20000
IIIBIT__400000
DMBIT__40000
>;STANFORD

; Space count for status line, one for large chars, one for small
LITSPS	__ 16	;small chars, needs more spaces
BIGSPS __ 5	;large chars, need fewer spaces

; Device indices

^^.TTY__0	;Best efforts on TTY
^^.VTS__1	;Xerox-PARC VTS protocol
^^.NGP__2	;Sproull's proposed Net. graph. protocol
^^.DD__3	;Data-Disk
^^.III__4	;III displays
^^.DM__5	;Data Media display

; Bits controlling display of lines, arrows
; Bit 400000	Display this line -- tested with sign test
DOEX__40000		;IF ON, DISPLAY `x' -- EXECUTION POINT
DODOT__20000		;IF ON, DISPLAY `.' -- DOT
DOPT__10000		;IF ON, DISPLAY `' -- POINTING HERE
; IF ALL ON, USE <=> INSTEAD OF x, ., OR  

; RAID text page image buffer

;  See end of prog for actual def, SORT shares DISB
;IQJ__MAXDLN+2	IQJ__IQJ*LINLEN
;DISB:	BLOCK	IQJ			;ROOM FOR ALL THE DATA

; Display pointer tables:
; DSAV: One word per line, currently displayed info:
;  LH: 400000, DOEX, DODOT, DOPT bits controlling display
;  RH: Address of first word for this line in page image buffer
; DCON: Saved DPNT pointers, to see what changed
; DDCON: Saved displayed address values, to see what changed

DEFINE $SETBLK,<
IQI__0
^^DSAV:	REPEAT MAXDLN+2,
<DISB+IQI
IQI__IQI+LINLEN
>
0

>;END OF $SETBLK
	XLIST
	XCREF
	$SETBLK
	LIST ;AVOID INFINITE EXPANSION
	CREF

DCON:	BLOCK MAXDLN+2
DDCON:	BLOCK MAXDLN+2

IFN STANFO,<
; Display and line information UUO buffer -- Stanford only
PPIBUF:	BLOCK	=20
>;STANFO

; Status control word -- routines set to control status line display
; LH: Index into STSTXT -- a table of ASCII Status indicators
; RH: Number of spaces to precede status --
;     Low-order bit complemented in main loop to draw attention

^NBIGWD:	0

; STATUS TEXT TABLE
STSTXT:	ASCII	/OK/
	ASCII	/?/
	ASCII	/M/
	ASCII	/U/
	ASCII	/SKIP /
	ASCII	/*/
	ASCII	/MEM?/
	ASCII	/PURE?/
	ASCII	/PROT?/
	ASCII	/INST?/

; Arrow tables -- one table for each collection of arrow
;  characters for "dot", "execpt", "arrow", and "universal" combinations

GDAROW:	ASCID	/     /	;NO ARROWS -- GOOD KIND
	ASCID /    /	; GOT HERE VIA `;' OR SOMETHING
	ASCID /   . /	; `.' ONLY
	ASCID /   ./  ; `.' AND POINTING, NO EXECUTE
	ASCID /  x  /	; EXECUTION POINT ONLY
	ASCID /  x /  ; ALL BUT `.'?
	ASCID /  x. /  ; DID `;' TO TAKE  ELSEWHERE
	ASCID /    /; SPECIAL CHARACTER FOR ALL

BDAROW:	ASCID	/     /	;NO ARROWS -- BAD KIND
	ASCID /    >/	; GOT HERE VIA `;' OR SOMETHING
	ASCID /   . /	; `.' ONLY
	ASCID /   .>/	; `.' AND POINTING, NO EXECUTE
	ASCID /  x  /	; EXECUTION POINT ONLY
	ASCID /  x >/	; ALL BUT `.'?
	ASCID /  x. /	  ; DID `;' TO TAKE  ELSEWHERE
	ASCID	/  <=>/	;SPECIAL CHARACTER FOR ALL

; Index pointer, selecting arrow table (see DSET)

^ARRTAB: V,,GDAROW

; Special device-select word, set by user to select undetectable devices
; (NGP, VTS)

IFN REALSW,<INTERNAL $DEV>
$DEV:
SPECDEV: -1,,0	;ASSUME TTY, NO PHYSICAL BACKSPACE

IFN STANFO,<
; Data-Disk Definitions (Control words, sizes, etc.)

VJUMSZ__=12
IFN DMOVSW,<VSTT__=48;>VSTT__=240


; COMMAND WORD -- ALTERNATING COMMANDS AND PARAMETERS
DEFINE CW(C1,B1,C2,B2,C3,B3) <
	<BYTE (8)<B1>,<B2>,<B3> (3)<C1>,<C2>,<C3>>!4
>

; COMMAND NAMES FOR DD COMMAND BYTES
EXCT__0				;EXECUTE
FNCN__1  ALPHBG__6  ALPHA__46	;FUNCTION, USUAL VALUE BYTES
CHNL__2				;CHANNEL SELECT
COLM__3				;COLUMN SELECT
HILIN__4			;HIGH 5 BITS OF LINE
LOLIN__5			;LOW 5 BITS OF LINE

; III Definitions

; ABSOLUTE INVISIBLE VECTOR (III DISPLAY)
DEFINE AIVECT (X,Y,B) <	146+((X)=25)+((Y)=14)+(B10)>

IIIHST__3000
IIIVSZ__30
IFN DMOVSW,<IIIVST__640;>IIIVST__0

; DD and III display control block, Display buffer
; DPYOUT CONTROL WORDS
	400000,,DTEM	;USE OVERLAPPED MODE ON DD
TWC:	0		;WILL BE DPYOUT COUNT
DDACT:	0		;DD XFER ACTIVE FLAG FROM SYS

^DTEM:	BLOCK 1000
>;STANFO

; VTS initializing string, outstr'd from DSET

VINIT:	BYTE (7) ESC,"D",1,ESC,"D",2,ESC,"C",1,MAXDLN+2
	BYTE (7) ESC,"B",1,1,2,1,76,7,150,5
	BYTE (7) 60,ESC,"T",1,177,1,ESC,"C",2,2,ESC,"B",2,1,2
	BYTE (7) 1,2,5,170,1,122,ESC,"F",2,1,6,6,ESC,"T",2,177,1,0

;Spwget, Dset, Mksel

			IFN UESW,<	SPWGET:	SKIPN SPGG3
					0
					HRLI 2,-1
					DATAO 2
					MOVN 4,2
					ADD 4,SPGG2
					MOVE 5,(4)
					MOVEM 5,SPGG1#
					SETZM SPGG3
					0>

^DSET:	MOVEI M,.TTY		; HERE WE USE IT TO SEE WHAT
IFN STANFO,<
	MOVNI T,1
	GETLIN T			;GET LINE CHARACTERISTICS
	TLNN T,DDBIT!IIIBIT!DMBIT	;SKIP IF III, DATA DISK OR DATAMEDIA
	JRST ISTTY
	PPINFO PPIBUF
	MOVEI M,.III		; ASSUME III
	TLNE T,DDBIT
	MOVEI M,.DD
	TLNE T,DMBIT
	MOVEI M,.DM
ISTTY:
>;STANFO
	SKIPLE T,SPECDEV	;ALSO, IF REMOTE PROTOCOL WAS ASKED
	HRRZ M,T		; (VTS, NGP), USE THAT DEVICE.
IFE STANFO,<
	HLRM T,NBSSW
>
	CAMN M,DDSW		;NEED TO RE-INITIALIZE IF DEVICE HAS
	POPJ P,			; CHANGED.
	MOVEM M,DDSW
	TRO F,DPYALL		;FORCE COMPLETE SCREEN REGENERATION
	MOVE D2,[.OK,,LITSPS]	;ASSUME LITTLE STATUS LINE
	MOVEM D2,NBIGWD
	MOVEI D2,GDAROW		;ASSUME THIS SET OF ARROWS
	HRRM D2,ARRTAB
	MOVE T,[-MAXDLN-1,,DSAV]
	JRST @[	TTYST		;DEVICE-DEPENDENT
		VTSSET		; INITIALIZATION
		NGPSET
	IFN STANFO,<
		DDSET
		IIISET
		DMSET
	>;STANFORD
			](M)

TTYST:	TDZA D2,D2
NGPSET:	HRRI D2,LITSPS
	HRRM D2,NBIGWD
	MOVEI D2,BDAROW
	HRRM D2,ARRTAB
	POPJ P,

VTSSET:	MOVEI D2,BDAROW		;HAVE TO USE BAD SET
	HRRM D2,ARRTAB
	MOVEI D2,BIGSPS
	HRRM D2,NBIGWD
IFE TENEX,<
	OUTSTR VINIT		;INITIALIZE DISPLAY AREA
>
IFN TENEX,<
	MOVE A,[PSOUT]
	MOVEM A,VTINST
	HRROI A,VINIT
	PUSHJ P,VTSOUT		;WRITE THE STRING, TRANSPARENT MODE
>
	MOVE M,[BYTE (7) ESC,"R",2,1,1]
	JSP D2,CNTRL		;First (OK) line special
	MOVE M,[BYTE (7) ESC,"R",1,1,1]
ALVDS:	JSP D2,CNTRL		;Store VTS replace command in
	ADDI M,110		; first word for each line
	JRST ALVDS		; BCLR will complete command in wd 2


IFN STANFO,<
IIISET:	MOVEI M,777300		;PP POSITION
	MOVEM M,DPLOC
	MOVEI D2,BIGSPS
	HRRM D2,NBIGWD
	SETZM DTEM
	MOVE M,[AIVECT(IIIHST,IIIVST-6,7)] ;Status LINE
	JSP D2,CNTRL
	MOVE M,[AIVECT(IIIHST,IIIVST-IIIVSZ,2)] ;PROG/BLOCK NAME LINE
ALLDS:	JSP D2,CNTRL		;STORE WORD, CYCLE UNTIL DONE
	SUB M,[IIIVSZ=14]	;NEXT LINE
	JRST ALLDS

DDSET:	MOVEI M,777400
	MOVEM M,DPLOC
	MOVEI E,VSTT-=12
	PUSHJ P,MKSEL
	MOVEI E,VSTT		;FIRST LINE
ALDDS:	JSP D2,CNTRL
	ADDI E,VJUMSZ
ALDDSL: PUSHJ P,MKSEL
	JRST ALDDS		;AROUND

MKSEL:	MOVE M,[CW (\COLM,2,\HILIN,0,\LOLIN,0)]
	DPB E,[POINT 4,M,23]	;LOW FOUR
	ROT E,-4
	DPB E,[POINT 5,M,15]	;HIGH FIVE
	ROT E,4			;RESTORE IT
	POPJ P,

DMSET:	MOVEI M,777340		;FOR A DM WITH 24 LINES ...
	MOVEM M,DPLOC		; ... PUT THE PAGE PRINTER HERE
	MOVEI D2,BDAROW
	HRRM D2,ARRTAB
	HRROI M,[015000,,D2]	;GET DISPLAY HEIGHT IN D2
	TTYSET M,
	HRREI M,-=24(D2)
	IMUL M,[-2000/=24]	;GET VALUE TO DIDDLE DPYPOS LOCATION BY
	ADDM M,DPLOC
	SUBI D2,6+4+1		;SUBTRACT PP NBIGWD PID AND WHO LINE AND FUDGE
	SKIPGE D2
	JRST DMSET1
	MOVEM D2,SCRMAX		;STORE SCREEN MAXIMUM - 1
	MOVN D2,D2
	HRRE M,SPNT
	SUBM D2,M		;M _ POSITIVE AMOUNT BY WHICH SPNT DECREASES
	HRLZ M,M
	ADD PNT,M		;KEEP PNT HONEST
	HRRM D2,SPNT
DMSET1:	MOVE M,[BYTE(7)177,14,140,142]
ALMDS:	JSP D2,CNTRL
	ADDI M,18
	JRST ALMDS

>;STANFORD

CNTRL:	MOVEM M,@(T)		;STORE A WORD
	AOBJN T,(D2)		;CONTINUE UNLESS DONE
	POPJ P,			;DONE

;Redraw, Redisp, Fredsp -- Display Program

^REDISP:MOVE M,DDCON+1
IFE SORTED,<
	CAME M,SYMPNT
>
IFN SORTED,<
	CAME M,BID
>
^FREDSP:TRO F,DPYALL
	PUSHJ P,DSET
	TRZE F,DPYALL
	JRST [	SETZM DCON
		MOVE V,[DCON,,DCON+1]
		BLT V,DCON+MAXDLN+1
		TRZ F,DRWALL
		JRST NUFSED]
IFN STANFO,<
	MOVE M,PPIBUF+2
	TRZN F,DRWALL
	TLNE M,200000
;STANFO>
IFE STANFO,<
	TRZE F,DRWALL
>;NOT STANFO
	JRST [	MOVSI V,400000
		MOVS T,SPNT
		SUB T,[2,,2]
	ALLP:	IORM V,DSAV-DPNT(T)	;TURN ON DOIT BIT
		AOBJN T,ALLP		;CONTINUE UNTIL
		TLNN T,7
		JRST ALLP		; REALLY DONE
		JRST NUFSED]
NUFSED:
IFN STANFO,<
	HRLZ M,DPLOC		;IF POSITION AND SIZE ARE DIFFERENT THAN WE
	HRRI M,3002		;WANT THEM TO BE, WE SHOULD MOVE THEM
	MOVE T,DDSW
	CAIL T,.DD		;SKIP IF NOT A STANFORD DISPLAY (DD,III,DM)
	CAMN M,PPIBUF+3		;PP 0'S CURRENT SETTINGS
	JRST NEXTT
	DPYSIZ 3002
	DPYPOS @DPLOC		;NOW THEY'RE RIGHT
>;STANFO
NEXTT:
LOP1B:	MOVS T,SPNT		;GET POINTER
	SUB T,[2,,2]
	MOVEM PNT,SAVPNT	;SAVE  VALUE

;FALLS THROUGH

;     Loop1, Rdo -- Main Line Control, Each Line Code

;FALLS THROUGH FROM PREVIOUS PAGE

;LOOK AT NEXT LINE, SET UP TO EXAMINE IT
LOOP1:	SKIPN V,(T)		;DONE?
	JRST GODIS		;YES
	MOVE M,DSAV-DPNT(T)
	HRRZ E,M		;SET UP BP TO 2D HALF OF LINE
	ADD E,[POINT 7,HJUMSZ,HJUMDS] ; (FOR ARROW INSERTION)
	MOVEM E,STRTHR#		;SAVE HERE
	HLRZ D3,V
IFN FILESW,<
	SETZM NOTFIL
	HRRZ E,T
	CAIGE E,DPNT+2
	SETOM NOTFIL
>;FILESW
	PUSHJ P,GETPOI
	JRST [	MOVE E,[ASCII /???/]
		MOVEI D3,<TXT+2>5
		JRST LOOP1A]
IFE FILESW,<MOVE E,(E)	>
IFN FILESW,<
	SKIPE NOTFIL
	JRST [	MOVE E,(E)
		JRST LOOP1A	]
	PUSHJ P,RDTRKE		;READ IN TRACK WITH ADDRESS THAT'S IN E
	MOVE E,@TRKOFF
>
LOOP1A:	MOVE D2,(T)
	TLNE D2,3
	JRST RDO		;ALWAYS REDO DYNAMIC CELLS
	CAMN D2,DCON-DPNT(T)
	CAME E,DDCON-DPNT(T)
	JRST RDO
	JRST ARND1

RDO:	MOVEM E,DDCON-DPNT(T)
	PUSHJ P,BCLR		;CLEAR LINE AND SET UP BYTE POINTER IN E
	MOVEI M,40
	TRNE D3,400000
	MOVEI M,"*"
	IDPB M,E
	MOVEI M,CYM5
	CAIE D3,STS5
	CAIN D3,PRG5
	HRRZ M,D3
	PUSH P,T
	PUSH P,D3
	PUSHJ P,CONV
	POP P,M
	CAIN M,STS5
	JRST RET2
	CAIN M,PRG5
	MOVEI M,BLK5
	TRZ M,400037
	MOVE E,STRTHR
	MOVE T,(P)
	MOVE V,DDCON-DPNT(T)
	PUSHJ P,CONV

;FALLS THROUGH

;RET2, ARND1

;FALLS THROUGH FROM PREVIOUS PAGE

RET2:	POP P,T			;RESTORE IT
	PUSHJ P,CRLFOT		;FINISH LINE, COMPUTE SIZE IF NECESSARY
	MOVSI V,400000 		;DO SOMETHING BIT
	IORM V,DSAV-DPNT(T)

;WHETHER OR NOT DATA CHANGED, HANDLE VARIOUS ARROW INDICATIONS

ARND1:	HLRZ V,(T)
	TRZ V,776037		;RETAIN ONLY TYPE
	CAIL V,STS5
	JRST ARND2
	MOVEI V,0
	CAMN T,PNT		;IS THIS WHAT WE'RE POINTING AT?
	TRO V,DOPT		; YES,  OR DBL THIS LINE
	HRRZ M,(T)		;GET LOCATION DISPLAYED
	CAMN M,LOCOP		;IS THIS LINE `DOT'?
	TRO V,DODOT		; YES, . OR DBL THIS LINE
	CAMN M,STPOP		;IS THIS LINE THE EX. POINT?
	TRO V,DOEX		; YES, x OR DBL THIS LINE
	HLRZ M,DSAV-DPNT(T) 	;GET OLD ARROW BITS
	SKIPN DDSW
	JRST [	TDC M,V
		TRNN M,400000
		TDNE M,V
		TRO V,400000
		JRST TR1  ]
	CAME M,V		;SAME AS LAST TIME?
	TRO V,400000
TR1:	HRLM V,DSAV-DPNT(T)	;STORE NEW, WITH DISPL DIRECTIVE
	TRZ V,400000
	LSH V,-=12		;GET 3 ARROW BITS AS INDEX
	MOVE V,@ARRTAB		;INDEXED BY V, GET APPROP. ARROWSPEC
	MOVEM V,@STRTHR		;PLACE INTO LINE

; AROUND THE LINE LOOP

ARND2:	AOBJN T,LOOP1		;DONE?
	TLNN T,7		;REALLY DONE?
	JRST LOOP1

;Godis -- Actual Displaying Code

GODIS:	MOVE M,T		;SAVE PTR TO LAST
	HRRZ V,DSAV-DPNT(M) 	;SAVE END OF LINE LIST
	PUSH P,V
	SETZM DSAV-DPNT(M)	;MARK END OF LINE LIST
	PUSHJ P,DISPLAY		;DISPLAY CHANGED LINES
	POP P,DSAV-DPNT(M)	;RESTORE
	MOVE V,[DPNT,,DCON]
	BLT V,DCON+MAXDLN+1
	POPJ P,

;RDTRKE, WRTRK
IFN FILESW,<
NFILPG__20		;NUMBER OF 200 WORD BLOCKS
;READ INTO TRACK BUFFER THE TRACK WITH LOC E IN IT
^RDTRKE:PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D1
	MOVEI A,(E)
	JRST RDTREA
RDTREX:	POP P,D1
	POP P,C
	POP P,B
	POP P,A
	POPJ P,

RDTRE3:	AOS FILCNT(C)
	MOVEM C,LSTTRK
	IMULI C,200
	ADDI C,TRKBUF(B)
	MOVEM C,TRKOFF
	JRST RDTREX

RDTREV:	MOVSI C,-NFILPG
	HRLOI D1,377777		;BIG NUMBER
RDTRE5:	CAMG D1,FILCNT(C)	;SKIP IF FILCNT SMALLER THAN CURRENT MINIMUM
RDTRE6:	AOBJN C,RDTRE5
	JUMPGE C,RDTRE7		;JUMP IF SCAN THROUGH
	MOVE D1,FILCNT(C)	;NEW MINIMUM
	HRLM C,(P)		;SAVE INDEX
	JRST RDTRE6		;LOOP

RDTRE7:	HLRZ D1,(P)		;GET BACK INDEX OF SLOT TO USE
	POPJ P,

;NORMAL FILE SYSTEM READ
RDTREA:	SKIPN DMPFSW
	JRST RDTRA1
	CAMG A,FJBREL
	JRST RDTRA2
	CAMLE A,FJBHRL
	JRST RDTREX
	SUB A,UPPRST		;DISTANCE FROM START OF UPPER TO ADDRESS WE WANT
	ADD A,HILOCF		;ADD IN STARTING FILE ADDRESS OF UPPER
RDTRA2:	SUBI A,74
	JUMPL A,RDTREX
RDTRA1:	IDIVI A,200		;A_REC # IN FILE (INDEX FROM 0), B_OFFSET IN REC
	MOVSI C,-NFILPG
	MOVNI D1,1		;INDEX OF LAST FREE SLOT
RDTREB:	CAMN A,FILTAB(C)
	JRST RDTRE3
	SKIPGE FILTAB(C)	;SKIP IF SLOT IN USE
	HRRZ D1,C		;NOT IN USE, REMEMBER ITS INDEX
	AOBJN C,RDTREB
	JUMPL D1,RDTREC		;NO FREE SLOTS.  EVICT SOMEONE
RDTRED:	MOVEM A,FILTAB(D1)
	SETZM FILCNT(D1)
	AOS FILCNT(D1)
	USETI 1(A)
	IMULI A,200
	MOVN A,A
	ADD A,FILLST
	ADDI A,1		;DISTANCE FROM BEGINNING OF OUR REC TO EOF
	CAILE A,200
	MOVEI A,200
	MOVN A,A		;SIZE OF XFER
	IMULI D1,200
	ADDI B,TRKBUF(D1)
	MOVEM B,TRKOFF
	ADDI D1,TRKBUF-1	;IOWD FOR TRANSFER
	MOVEM D1,FILEWD
	HRLM A,FILEWD
	INPUT FILEWD
	JRST RDTREX

RDTREC:	PUSHJ P,RDTREV
	JRST RDTRED

^WRTRK:	SKIPN MODFSW
	POPJ P,
	PUSH P,A
	PUSH P,B
	MOVE A,LSTTRK
	MOVE B,FILTAB(A)
	USETO 1(B)
	IMULI A,200
	ADDI A,TRKBUF-1
	HRLI A,-200
	MOVEI B,0
	OUTPUT A
	POP P,B
	POP P,A
	POPJ P,

^TRKOFF:0
LSTTRK:	0
FILEWD:	0		;IOWD STORED HERE
	0

TRKBUF:	BLOCK NFILPG*200
FILTAB:	REPEAT NFILPG,<-1	;DISK ADDRESS OF BEGINNING OF THIS PAGE
>
FILCNT:	REPEAT NFILPG,<0	;NUMBER OF TIMES REFERENCED
>

^LEAVE:	EXIT

^CLRIO:	TDZA V,V
^SETIO:	MOVNI V,1
	MOVEM V,$IO
	TRO F,DPYALL
	POPJ P,
>;FILESW

;Bclr, Mooror (Display Driver), Crlfot, Offok

BCLR:	MOVE E,[ASCID /     /]
	MOVEM E,1(M)		;CLEAR TO ASCID BLANKS
	MOVEI E,2(M)		;GET BLT WORD
	HRLI E,1(M)
	BLT E,LINLEN-1(M)
	MOVEI E,1(M)		;SET UP BYTE POINTER
	HRLI E,(<POINT 7,0>)
	PUSH P,V		;DEVICE-DEPENDENT BUFFER INIT
	MOVE V,DDSW
	JRST @[	BCRET
		VTBRET
		BCRET
	IFN STANFO,<
		BCRET
		BCRET
		BCRET
	>;STANFO
			](V)

VTBRET:	MOVE V,[BYTE (7) =63,0,40,40,40] ;END OF REPLACE, SPACES
	MOVEM V,1(M)		; 0 WILL BE REPLACED BY LENGTH IN BYTES
	HRLI E,(<POINT 7,0,13>)	;FIRST SPACE
BCRET:	POP P,V			;FOR NOW, CLD JUST TEST VTS, BUT...
	POPJ P,

; Write crlf into line data buffer, finish it up

CRLFOT:	MOVEI V,15		;WRITE CR
	IDPB V,E
	MOVEI V,12		;WRITE LF
	IDPB V,E
ZEROSS:	MOVE V,DDSW
	CAIE V,.VTS
	JRST ZEROS1
; Compute char count, deposit for Replace command (VTS)
	PUSH P,E
	LDB V,[POINT 3,E,5]
	TRC V,4
	SUB E,DSAV-DPNT(T)
	HRRES E
	IMULI E,5
	ADDI E,-7(V)
	MOVE V,DSAV-DPNT(T)
	DPB E,[POINT 7,1(V),13]
	POP P,E
ZEROS1:	TDZA V,V
	IDPB V,E		;DEPOSIT A 0
	TLNE E,760000		;IS BP AT END OF WORD?
	JRST .-2		; NO, DEPOSIT 0'S UNTIL TRUE
	SETZM 1(E)		;CLEAR NEXT WORD TO FLAG COPLUP
	POPJ P,

DISPLAY:MOVSI V,400000
	MOVE E,DDSW
	JRST @[	TTDPY
		VTDPY
		NGDPY
	IFN STANFO,<
		DDDPY
		IIDPY
		DMDPY
	>;STANFO
			](E)

IFN STANFO,<
DDDPY:	SETZB V,T
	SKIPE DDACT
	DPYOUT RAIDPG,[0  0]	;DON'T CLOBBER DATA UNTIL WRITING STOPS
	PUSHJ P,DDTXT		;COPY IN ONCET
	MOVSI V,400000		;PREPARE TO COPY AGAIN, AND CLEAR DOLINE
	PUSHJ P,DDTXT		;DO IT
 	JRST DPYDUN

DMDPY:	MOVSI V,400000		;CLEAR DOIT BITS
	TDZA T,T
IIDPY:	MOVEI T,1		;LEAVE ROOM FOR III TO STORE RETURN
	PUSHJ P,DPYTXT		;COPY TWICET (WILL SET ODD FIELDS)
DPYDUN:	SETZM DTEM(T)		;HALT
	SETZM DTEM+1(T)		;HALT!
	MOVEM T,TWC		;COUNT WORD
	AOS TWC			;THIS MANY
	DPYOUT RAIDPG,TWC-1	;SHOW ME
	POPJ P,

DDTXT:	MOVE D2,[CW(\FNCN,\ALPHA,\CHNL,0,\CHNL,0)]
	MOVEM D2,DTEM(T)
	ADDI T,1
>;STANFO
TTDPY:
VTDPY:
NGDPY:
DPYTXT:	SKIPA D2,[DSAV]		;CONSTANT STUFF
LINLUP:	JUMPE D3,CPOPJ		;COME HERE AT END OF EACH LINE
	MOVE D3,(D2)		;DO THIS LINE?
	JUMPL D3,DOLIN		;YES, MARKED
	CAIN E,.III		;Also, always for III
	JUMPG D3,DOLIN		;UNLESS DONE
	AOJA D2,LINLUP		; NO OR DONE

DOLIN:	ANDCAM V,(D2)		;CLEAR DOIT BIT
	MOVE F1,(D3)		;FIRST WORD IS ROW SELECT FOR DD
	JRST @[	OUTTTY
		OUTVTS
		OUTNGP
	IFN STANFO,<
		DDCOPY
		IICOPY
		IICOPY		;FOR DM TOO
	>;STANFO
			](E)

IFN STANFO,<
DDCOPY:	JUMPE V,IICOPY		;Odd rows?
	TRO F1,10000		;YES, THIS SHOULD DO IT
	JRST IICOPY		;USE END OF LOOP TO STORE

COPLUP:	SKIPN F1,(D3)		;DONE WITH LINE?
	 AOJA D2,LINLUP		;YES, TEST END OF SCREEN
IICOPY:	MOVEM F1,DTEM(T)	;STORE A WORD
	ADDI T,1		;COUNT WORDS
	AOJA D3,COPLUP		;INCR SOURCE PTR AND LOOP
>;STANFORD

OUTNGP: OUTTTY:
IFE TENEX,<
	OUTSTR	1(D3)
>
IFN TENEX,<
	HRROI	A,1(D3)
	PSOUT
>
	AOJA	D2,LINLUP	;JUST THE STRING

OUTVTS:
IFE TENEX,<
	OUTSTR	(D3)
>
IFN TENEX,<
	HRROI	A,(D3)
	PUSHJ	P,VTSOUT
>
	AOJA	D2,LINLUP		;STRING AND REPLACE CMD

IFN TENEX,<
^VTSOUT: PUSH	P,B
	PUSH	P,A
	MOVEI	A,100
	RFMOD
	PUSH	P,B
	TRZ	B,300
	SFMOD
	EXCH	A,-1(P)
	XCT	VTINST
	POP	P,B
	POP	P,A
	SFMOD
	POP	P,B
	POPJ	P,

^VTINST: PSOUT
>;TENEX VTS OUT

;Getpoi -- Handle Multi-Level Display

^^GETPOI:PUSH P,M
	TLNN V,3
	JRST NOPNT
	MOVS M,V	;GET MODE
IFE FILESW,<MOVE V,(V)>	;GET THING POINTED TO
IFN FILESW,<
	SKIPGE NOTFIL
	JRST [	MOVE V,(V)
		JRST GPTNTF	]
	HRRZ E,V
	PUSHJ P,RDTRKE
	MOVE V,@TRKOFF
>
GPTNTF:	PUSHJ P,GETPOI	;GET REAL POINTER
	JRST POPMJ
GTPNO:	ANDI M,3	;GET RID OF RANDOM BITS
IFN FILESW,<
	SKIPGE NOTFIL
>;FILESW
	XCT (M)[MOVE V,(E)
		MOVS V,(E)
		JRST [	MOVE M,(E)
			PUSH P,T
			PUSHJ P,GPELOP 	;CALC EFF. ADDRS.
			POP P,T
			MOVE V,E
			JRST NOPNT]
		]-1
IFN FILESW,<
	PUSHJ P,RDTRKE
	XCT (M)[MOVE V,@TRKOFF
		MOVS V,@TRKOFF
		JRST [	MOVE M,@TRKOFF
			PUSH P,T
			PUSHJ P,GPELOP	;CALC EFF. ADDRS.
			POP P,T
			MOVE V,E
			JRST NOPNT]
		]-1
>
NOPNT:	HRRZS V
IFE FILESW,<
IFE TENEX,<
	CAMLE V,JOBREL
IFE SEGSW,<JRST POPMJ>
IFN SEGSW,<JRST [	CAIL V,400000	;IN UPPER SEGMENT?
			CAILE V,@JOBHRL
			JRST POPMJ
			JRST .+1]>
>;NOT TENEX
>;NOT FILESW
	HRRZ E,V
IFE FILESW,<
	CAIGE V,20
	ADDI E,JAC
>
IFN FILESW,<
;	SKIPN XTRASW
	JRST GETPOX
;	CAIGE V,20
;	JRST POPMJ
>;FILESW
POPMJ1:	AOS -1(P)
POPMJ:	POP P,M
	POPJ P,

IFN FILESW,<
GETPOX:	SKIPE NOTFIL
	JRST POPMJ1
	SKIPE DMPFSW
	JRST GETPX1		;DUMP FILE
	CAMLE V,FILLST
	JRST POPMJ
	JRST POPMJ1

GETPX1:	CAIL V,74
	CAMLE V,FJBHRL
	JRST POPMJ
	CAMLE V,FJBREL
	CAML V,UPPRST
	JRST POPMJ1
	JRST POPMJ
>;FILESW

;Conv -- Output Conversion Routine Dispatch
; THESE ARE THE OUTPUT ROUTINES -- THEY ALL WRITE INTO THE
; STRING CONTROLLED BY THE BYTE POINTER IN `E'.  THIS IS
; THE MAIN DISPATCH

^CONV:	LDB T,[POINT 6,M,24]	;GET POSSIBLE ARGUMENT TO CONVERT ROUTINE
	LSH M,-5		;GET CONVERT ROUTINE NUMBER
	TRZ F,CNVABS
	TRZE M,40		;ABS MODE?
	TRO F,CNVABS		;YES
	ANDI M,77		;GET RID OF EXTRANEOUS GARBAGE
	CAIGE M,PRG
	JUMPE V,IT0		;USUALLY, 0 IS JUST 0
	JRST @TABC-1(M)		;GO TO APPROPRIATE ROUTINE
	POPJ P,

TABC:	INSTR		; 1
	HLFWRD		; 2
	CONOCT		; 3
	CONXWD		; 4
	CONR50		; 5
	CONSIX		; 6
	CONASC		; 7
	CONFLT		;10
	CONBYT		;11
	CONDEC		;12
	RHTEXT		;13
	RHTEXT		;14
	RHTEXT		;15
	CONBP		;16
	CONFLG		;17
	LHFLG		;20
	RHFLG		;21
	STSPRT		;22
	PRGPRT		;23
	BLKPRT		;24

;  Fndptr, Fndtbl, Conflg, Rhflg, Lhflg -- J, L, R Commands

BEGIN CONFLG
FNDPTR:	SKIPN M,FLGPTR	;GET POINTER WORD
	POPJ P,		;NO POINTER
FNDTBL:	SOJL T,CPOPJ1	;THE NUMBER OF TABLE IS IN T
	HLRZS M	;GET POINTER
	JUMPE M,CPOPJ	;NO LINK
	SKIPE M,(M)	;CHECK ADRESS
	JRST FNDTBL	;GO ON
	POPJ P,
PRNTIT:	HRLI M,-=18	;ONE HALF OF THE WORD
	SETZM FULLFL#
	MOVEI D3,0	;FLAG TO SAY IF WE SHOULD PRINT !
	SETZM FLGNUM#	;SAVE EXTRA BITS HERE
LP1:	TDNN V,T	;IS THE NEXT BIT ON?
	JRST NOBIT	;NO
	SKIPN D2,(M)	;IS THERE A NAME FOR IT?
	JRST [FLGFOO:	IORM T,FLGNUM	;NO SAVE UP BITS
			JRST NOBIT]
	PUSH P,D2
	MOVEI D2,-13(E)	;GET POINTER
	CAML D2,SAVEE	;TOO MANY CHRS. SO FAR?
	SETOM FULLFL	;YES
	POP P,D2
	SKIPE FULLFL	;TOO FULL?
	JRST FLGFOO
	SKIPE D3
	IDPB D3,E	;PUT IN ! IF NEEDED
	PUSHJ P,R5TYP
	MOVEI D3,"!"	;SET FLAG
NOBIT:	LSH T,-1	;SHIFT TO NEXT BIT
	AOBJN M,LP1	;TRY FOR MORE
	SKIPE FLGNUM	;ANYTHING EXTRA?
	JRST	[PUSH P,V	;SAVE VALUE
		SKIPE D3
		IDPB D3,E
		MOVE V,FLGNUM
		TRNN V,-1	;CHECK HALF
		MOVSS V
		PUSHJ P,CONOCT	;PRINT IT
		MOVEI D3,"!"	;SET FLAG
		POP P,V
		POPJ P,]
	POPJ P,


; J PRINTER -- VALUE IN V, TABLE# IN T

^CONFLG:PUSHJ P,FNDPTR	;GET POINTER NUMBER
	JRST HLFWRD	;NO POINTERS, PRINT OCTAL
	HRRZM E,SAVEE#	;SAVE STARTING POINTER
	MOVSI T,400000	;START UP
LP2:	PUSHJ P,PRNTIT	;GO PRINT
	JUMPE T,[TRON D3,"0"	;IF WE PRINTED NOTHING
		IDPB D3,E	;THIS WILL NOT SKIP AND GET "0" IN D3
		POPJ P,]		;EXIT
	TRCN D3,",""!"	;CHENGE ! TO , AND SKIP IF ANY WERE ON (! WAS THERE)
	JRST LP2	;NO GO DO NEXT HALF
	IDPB D3,E
	IDPB D3,E	;PUT IN ,,
	JRST LP2

; L PRINTER

^LHFLG:	PUSHJ P,FNDPTR	;SET UP POINTER
	JRST INSTR	;PRINT AN INSTRUCTION
COMTPN:	PUSH P,M
	HRRZM E,SAVEE	;SAVE STARTING POINTER
	PUSH P,V
	HLLZS V		;NO ADR FIELD
	PUSHJ P,INSTR	;PRINT INSTR
	POP P,V
	POP P,M	;RESTORE VALUE AND POINTER
	MOVEI T,400000	;CHECK RH
	PUSHJ P,PRNTIT
	TRON D3,"0"
	IDPB D3,E
	POPJ P,

; R PRINTER

^RHFLG:	PUSHJ P,FNDPTR
	JRST INSTR
	ADDI M,=18	;USE RH BITS
	JRST COMTPN
BEND CONFLG

;  Hlfwrd, Instr, Opdret, Noacq

IT0:	MOVEI V,"0"
	IDPB V,E
	POPJ P,
CSW1:	0


BEGIN HLFWRD

; (UNSIGNED HALFWORD),,(UNSIGNED HALFWORD) PRINTER

^HLFWRD:SETZM CSW1	;CLEAR FLAG
LOOP5:	MOVEI M,6	;GET COUNT
	MOVEI PV,0	;CLEAR AC
LOOP4:	LSHC PV,3	;GET DIGIT
	JUMPN PV,PNT1	;NON-ZERO?
	SOJG M,LOOP4	;NO, ZERO
	SETOM CSW1
	JRST LOOP5

PNT1:	IORI PV,60	;OR IN ASCII
	IDPB PV,E	;DEPOSIT
	SOJLE M,PNT2	;COUNT
PNT3:	MOVEI PV,0	;CLEAR
	LSHC PV,3	;GET NEXT DIGIT
	JRST PNT1

PNT2:	SKIPE CSW1	;FIRST OR SECOND HALF?
	POPJ P,		;SECOND
	SETOM CSW1	;SET SWITCH
	MOVEI PV,","	;PUT OUT TWO
	IDPB PV,E	;COMMAS
	IDPB PV,E
	MOVEI M,6
	SOJA F1,PNT3
BEND HLFWRD

BEGIN INSTR
^INSTR:
	TLCN V,-1		;LEFT HALF ZERO?
	JRST [	TLC V,-1	;YES
		JRST CONXWD]
	TLCN V,-1		;LEFT HALF =-1?
	JRST CONOCT		;YES
	TLCN V,777000		;NO OP-CODE?
	JRST [	TLC V,777000
		PUSHJ P,TRYSYM	;TRY TO TYPE AS SYM +OR- SMALL OFFSET
		POPJ P,
		JRST CONXWD]	;CAN'T PRINT AS SYM
	TLCN V,777000
	JRST CONXWD
	MOVE T,V		;SAVE VALUE
	PUSHJ P,OPLOOK		;LOOK UP OPCODE
	JUMPE D2,OPDF		;NO OP-CODE?
	MOVE D3,D2		;YES, OPCODE
	PUSHJ P,SIXOUT		;TYPE IT OUT
^OPDRET:MOVEI D3,40
	IDPB D3,E
IFN EXDSW,<
	TRZE F,CONOFF		;I/O OPCODE?
	JRST OPIOPT		;YES
>
	LDB D2,[POINT 9,T,8]	;GET OP CODE
	MOVEI PV,-67(D2)
	IDIVI PV,9
	LDB D3,INPPTB(V)	;GET TABLE ENTRY
	CAIL D2,600
	JRST OPTEST
	LDB V,[POINT 4,T,12]	;GET AC FIELD
	JUMPN V,ACNZ
	TRNE D3,2		;NO SKIP IF DON'T PRINT ZERO AC FIELD
	JRST NOAC
ACTYP:	PUSH P,D3
	PUSHJ P,EXACTY		;TYPE OUT AC FIELD AS SYMBOL IF POSSIBLE
	POP P,D3
	JRST ACTYPD

ACNZ:	TRNN D3,1		;SKIP IF PRINT NON-ZERO AC AS NUMBER
	JRST ACTYP
	PUSHJ P,CONOCT
ACTYPD:	MOVEI V,","
	IDPB V,E		;OUTPUT A ,
NOAC:	MOVEI V,"@"
	TLNE T,20		;@ BIT?
	IDPB V,E		;YES
	HRRZ V,T		;GET ADDRESS FIELD
	TRNE D3,20
	JRST ACTYIO		;I/O INSTRUCTION
	JUMPN V,ENZ
	TLNN T,17		;SKIP IF XR FIELD IS NON-ZERO
	TRNE D3,4
	JRST ETYPD		;NOT SUPPOSED TO TYPE 0 E FIELD
	TLNN T,20		;IF @ WE WANT SYMBOLIC
	TRNN D3,10
	JRST ETYP
	JRST EOCT		;WANT TO TYPE LESS THAN 20 AS OCTAL
ETYP:	PUSHJ P,ADTYP		;TYPE IT OUT
	JRST ETYPD

ENZ:	CAIL V,20
	JRST ETYP
	TLNE T,17
	JRST EOCT
	TLNN T,20		;IF @ WE WANT SYMBOLIC
	TRNN D3,10
	JRST ETYP
EOCT:	PUSHJ P,CONOCT
ETYPD:	LDB V,[POINT 4,T,17]	;GET INDEX FILED
	JUMPE V,NOIX		;NO INDEX FIELD?
	MOVEI PV,"("
	IDPB PV,E		;PUT OUT A (
	PUSHJ P,EXACTY		;TYPE IX
	MOVEI V,")"
	IDPB V,E		;PUT OUT A )
NOIX:	POPJ P,

ACTYIO:	LDB D3,[POINT 3,T,12]	;GET I/O INSTRUCTION TYPE
	CAIN D3,4		;CONO?
	JRST EOCT		;YES
	CAIE D3,6		;CONSZ?
	CAIN D3,7		;OR CONSO?
	JRST EOCT		;YES
	JRST ETYP

OPTEST:	LDB V,[POINT 4,T,12]	;GET AC FIELD
	JUMPN V,TSTANZ
	TRNE D3,2
	JRST TSTACD
TSTANZ:	PUSH P,D3
	PUSHJ P,EXACTY
	POP P,D3
	MOVEI V,","
	IDPB V,E
TSTACD:	MOVEI V,"@"
	TLNE T,20		;@ BIT?
	IDPB V,E		;YES
	HRRZ V,T		;GET ADDRESS FIELD
	JUMPN V,TSTENZ
	TLNN T,17
	TRNE D3,4
	JRST ETYPD
	JRST ETYP

;SOME DAY THIS SHOULD DO THE RIGHT THING W.R.T FLAG MODE
TSTENZ:	TRNN D3,10
	JRST ENZ
	CAIL V,20
	JRST ETYP
	JRST EOCT

^NOACQ:	MOVEI D3,0		;GET HERE FROM BYTE POINTER PRINTER
	JRST ACTYPD

IFN EXDSW,<
OPIOPT:	MOVE D3,V		;GET DEVICE NAME
	LDB V,[320700,,T]
	LSH V,2
	JUMPE D3,OPIOP1		;PRINT NUMERIC DEV
	PUSHJ P,SIXOUT
	MOVEI D3,20		;INDICATE OPCODE IS I/O INSTRUCTION
	JRST ACTYPD

OPIOP1:	MOVEI D3,20		;INDICATE OPCODE IS I/O INSTRUCTION
	JRST ACTYP		;TYPE V (DEVICE CODE) AS A NUMBER
>;EXDSW

;INPTBL		INSTRUCTION PRINTING TABLE

;THIS TABLE CONTAINS 4 BITS OF INFORMATION FOR EACH OPCODE BETWEEN
;100 AND 677.  THE BITS CONTROL HOW THE REST OF THE INSTRUCTION IS
;PRINTED

;1:	PRINT AC FIELD AS A NUMBER IF NON-ZERO
;2:	DON'T PRINT AC FIELD IF ZERO
;4:	DON'T PRINT E FIELD IF ZERO
;8:	PRINT E FIELD AS A NUMBER IF LESS THAN 20 UNLESS @

;IN THE CASE OF THE TEST (6XX) INSTRUCTIONS BITS 2 AND 4 WILL HAVE THE SAME
;VALUE: ON IN THE CASE OF THE NEVER SKIP OR ALWAYS SKIP N-TYPE INSTRUCTIONS.
;THE 8 BIT MEANS THAT THE E FIELD REPRESENTS BITS, USE FLAG NAMES OR NUMBERS

INPTBL:	BYTE (4)0,1,2,4,6,0,0,0,0		;67-77	(PHONEY FOR UUOS)
	BYTE (4)0,0,0,0,0,10,0,0,0		;100-110
	BYTE (4)0,0,0,0,0,0,0,0,0		;111-121
	BYTE (4)0,0,0,0,0,0,0,0,10		;122-132
	BYTE (4)2,0,0,0,0,0,0,0,0		;133-143
	BYTE (4)0,10,0,0,0,0,0,0,0		;144-154
	BYTE (4)10,0,0,0,0,0,0,0,10		;155-165
	BYTE (4)0,0,0,0,0,0,0,10,0		;166-176
	BYTE (4)0,0,10,0,2,0,10,0,2		;177-207
	BYTE (4)0,10,0,2,0,10,0,2,0		;210-220
	BYTE (4)10,0,0,0,10,0,0,0,10		;221-231
	BYTE (4)0,0,0,10,0,0,10,10,10		;232-242
	BYTE (4)0,10,10,10,10,0,0,0		;243-253
	BYTE (4)3,7,3,0,0,0,0,4,3		;254-264
	BYTE (4)0,0,0,0,10,0,0,0,10		;265-275
	BYTE (4)0,0,16,10,10,10,16,10,10	;276-306
	BYTE (4)10,6,0,0,0,6,0,0,0		;307-317
	BYTE (4)6,0,0,0,6,0,0,0,6		;320-330
	BYTE (4)2,2,2,6,2,2,2,4,0		;331-341
	BYTE (4)0,0,4,0,0,0,2,2,2		;342-352
	BYTE (4)2,2,2,2,2,4,0,0,0		;353-363
	BYTE (4)4,0,0,0,2,2,2,2,2		;364-374
	BYTE (4)2,2,2,4,4,2,0,0,10		;375-405
	BYTE (4)0,0,0,10,0,0,0,10,2		;406-416
	BYTE (4)0,0,10,0,0,4,4,0,0		;417-427
	BYTE (4)0,10,0,0,0,10,0,0,0		;430-440
	BYTE (4)10,0,0,0,10,0,0,4,4		;441-451
	BYTE (4)0,0,0,10,0,0,0,10,2		;452-462
	BYTE (4)0,0,10,0,0,0,10,0,0		;463-473
	BYTE (4)4,4,2,0,0,10,0,2,0		;474-504
	BYTE (4)10,0,2,0,10,0,2,0,10		;505-515
	BYTE (4)0,2,0,10,0,2,0,10,0		;516-526
	BYTE (4)2,0,10,0,2,0,10,0,2		;527-537
	BYTE (4)0,10,0,2,0,10,0,2,0		;540-550
	BYTE (4)10,0,2,0,10,0,2,0,10		;551-561
	BYTE (4)0,2,0,10,0,2,0,10,0		;562-572
	BYTE (4)2,0,10,0,2,16,16,10,10		;573-603
	BYTE (4)16,16,10,10,6,6,0,0,6		;604-614
	BYTE (4)6,0,0,10,10,10,10,10,10		;615-625
	BYTE (4)10,10,0,0,0,0,0,0,0		;626-636
	BYTE (4)0,0,0,0,0,0,0,0,0		;637-647
	BYTE (4)0,0,0,0,0,0,0,0,10		;650-660
	BYTE (4)10,10,10,10,10,10,10,0,0	;661-671
	BYTE (4)0,0,0,0,0,0			;672-677

INPPTB:	POINT 4,INPTBL(PV),3
	POINT 4,INPTBL(PV),7
	POINT 4,INPTBL(PV),11
	POINT 4,INPTBL(PV),15
	POINT 4,INPTBL(PV),19
	POINT 4,INPTBL(PV),23
	POINT 4,INPTBL(PV),27
	POINT 4,INPTBL(PV),31
	POINT 4,INPTBL(PV),35

;  Rhtext, Adtyp, R5typ, ADSEL, TRYSYM
; INSTRUCTION PRINTER, R50, SIXBIT, ASCII IN RH

^RHTEXT:PUSH P,M
	PUSH P,V
	HLLZ V,V
	PUSHJ P,INSTR
	LDB T,E		;GET LAST CHARACTER OUTPUT
	CAIN T,"0"
	ADD E,[070000,,]
	POP P,V
	MOVE M,(P)
	MOVE T,(M)0-13+['"'+40
			"'"
			'"'+40]
	IDPB T,E
	XCT (M)0-13+[	HRRZ D2,V 	;R5TYP TAKES INPUT IN D2
			HRLZS V
			HRRZS V]
	PUSHJ P,@(M)0-13+[R5TYP
			  CONSIX
			  RJASC]
	POP P,M
	MOVE T,(M)0-13+["'"
			"'"
			'"'+40]
	IDPB T,E
	POPJ P,


; ADDRESS (SYMBOLIC+/-DISPLACEMENT) PRINTER

IFN REALSW,<
$ADTYP:
INTERNAL $ADTYP
>
^ADTYP:	CAIGE V,140
	JRST EXACTY
	MOVE F1,E	;SAVE BYTE POINTER
	MOVEM V,VSV	;SAVE VALUE
	PUSHJ P,FNDSYM	;LOOK UP IN SYMBOL TABLE
	MOVE E,F1	;RESTORE BYTE POINTER
ADTYP1:	PUSHJ P,ADSEL
	 JRST CON3Q	;NEITHER ONE IS CLOSE ENOUGH
	 JRST DNWIN	;DNSYM IS THE CLOSER ONE
	MOVEI PV,"-"	;HOLD A -
	MOVE M,D2
	MOVE V,UPSYM	;GET SYMBOL NAME
	MOVE D2,UPCUR	;GET BLOCK NAME
DNRET:	PUSHJ P,SYMTYP	;TYPE OUT SYMBOL
	JUMPE M,CPOPJ	;DONE?
	MOVE V,M
	IDPB PV,E
	JRST CONOCT

DNWIN:	MOVEI PV,"+"	;HOLD A +
	MOVE V,DNSYM	;GET SYMBOL NAME
	MOVE D2,DNCUR	;GET BLOCK NAME
	JRST DNRET

;CALL ADSEL AFTER FNDSYM.  RETURNS DIRECT IF BOTH ARE TOO FAR AWAY.  SKIPS
;  ONCE IF DNSYM IS THE WINNER AND SKIPS TWICE IF UPSYM IS THE WINNER
^^ADSEL:MOVM D2,UPDIF	;GET DIFFERENCES
	JUMPE D2,ADJ2	;EXACT MATCH?
	MOVM M,DNDIF
	MOVEI PV,777
	ANDM PV,WCNT
	ANDM PV,WCNT+1
	CAMLE M,WCNT	;IS DNDIF TOO BIG?
	JRST DNBIG	;YES
	CAMLE D2,WCNT+1	;IS UPDIF TOO BIG?
	JRST ADJ1	;YES
	MOVE V,WCNT+3
	IMUL V,M
	ASH V,-6
	SUB V,D2
	SUB V,WCNT+2
	JUMPLE V,ADJ1
ADJ2:	AOS (P)
ADJ1:	AOS (P)
	POPJ P,

DNBIG:	CAMLE D2,WCNT+1
	POPJ P,
	JRST ADJ2

^TRYSYM:MOVEM V,VSV
	MOVE F1,E
	PUSHJ P,FNDSYM	;LOOKUP IN SYM TABLE
	MOVE E,F1
	MOVE V,VSV
	MOVEI D2,777
	ANDM D2,WCNT
	ANDM D2,WCNT+1
	MOVM D2,DNDIF
	MOVM D3,UPDIF
	CAMLE D2,WCNT
	CAMG D3,WCNT+1
	JRST ADTYP1	;TYPE AS SYMBOL + OR - OFFSET
	AOS (P)
	POPJ P,		;CAN'T PRINT AS A SYMBOL

IFN REALSW,<INTERN $C
>
$C:
^WCNT:	77
	77
	10
	40

BEND INSTR
VSV:	0
EXACTY:	MOVEM E,D2	;SAVE BYTE POINTER
	PUSHJ P,FNDSYM	;LOOK UP IN TABLE
	MOVE E,D2	;RESTORE BYTE POINTER
	SKIPE UPDIF	;EXACT MATCH?
	JRST CONOCT	;NO, TYPE AS NUMBER
	MOVE V,UPSYM	;GET SYMBOL
	MOVE D2,UPCUR	;GET BLOCK NAME
SYMTYP:	JUMPE D2,NOBLK	;NO BLOCK NAME?
	PUSHJ P,R5TYP	;TYPE BLOCK NAME
	MOVEI D2,"&"	;TYPE A &
	IDPB D2,E
NOBLK:	MOVE D2,V	;GET SYMBOL NAME

;  R5typ -- Radix50 Printer
; VALUE IN D2
; OUTPUT TO E'S BP, AS USUAL

^R5TYP:	TLZ D2,740000	;CLEAR HIGH ORDER BITS
	IDIVI D2,50	;GET CHR
	ADDI D3,60-1	;CONVERT
	CAIGE D3,13+(60-1);LETTER?
	JRST GOTYP	;NO
	ADDI D3,101-13-(60-1);CONVERT
	CAIG D3,132	;FUNNY LETTER?
	JRST GOTYP	;NO
	CAIN D3,133
	MOVEI D3,"."
	CAIN D3,134
	MOVEI D3,"$"
	CAIN D3,135
	MOVEI D3,"%"
GOTYP:	JUMPE D2,GOAT1
	HRLM D3,(P)	;SAVE CHR
	PUSHJ P,R5TYP	;TYPE FIRST PART
	HLRZ D3,(P)	;GET CHR.
GOAT1:	IDPB D3,E	;TYPE THE LETTER
	POPJ P,

;  Conoct, Consix, Sixout, Opdf

; VALUE IN V

TYPNEG__774000
CON3Q:	SETCM PV,VSV	;GET IT
	TRNE PV,TYPNEG	;SMALL NEGATIVE NUMBER?
	TLC PV,-1	;NO
	TRCA PV,-1
CONOCT:	MOVE PV,V
	JUMPL PV,CON3B
CON3A:	IDIVI PV,10	;THIS HERE IS THE FAMOUS ...
	JUMPE PV,CON3C	;.. ANY-RADIX-NUMBER-PRINTER
	HRLM V,(P)
	PUSHJ P,CON3A
	HLRZ V,(P)
CON3C:	ORI V,60
	IDPB V,E
	POPJ P,
CON3B:	MOVEI V,"-"
	IDPB V,E
	MOVMS PV
	JRST CON3A

; SIXBIT PRINTER -- VALUE IN V

CONSIX:	MOVSI D2,40000
	SKIPA D3,V
SIXOUT:	MOVEI D2,	;CLEAR
SIXOT:	LSH D2,-7
	LSHC D2,6	;GET CHR.
	JUMPE D2,SIXOUQ	;NULL?
	ADDI D2,40	;CONV. TO ASCII
	IDPB D2,E	;OUTPUT
SIXOUQ:	JUMPN D3,SIXOT	;LOOP IF MORE TO GO
	POPJ P,

; USER-DEFINED OPCODE FINDER AND PRINTER
; USED BY INSTR ABOVE (I DON'T KNOW EITHER)

OPDF:	MOVE V,T	;GET VALUE
	MOVE F1,E
	PUSHJ P,FNDSYM	;LOOKUP IN SYM TABLE
	MOVE E,F1
	SKIPE D3,UPDIF	;EXACT?
	SKIPA D3,DNDIF	;NO
	SKIPA D2,UPSYM	;YES, GET NAME
	MOVE D2,DNSYM	;NO, GET NAME
	MOVE V,T	;RESTORE VALUE
	TLNE D3,777000	;CLOSE ENOUGH?
	JRST OPDF1	;NO
	MOVE T,D3	;YES, GET DIFF.
	TLO T,067000	;PHONEY OPCODE FOR CLEVER CYMBOLIC PRINTOUT
	PUSHJ P,R5TYP
	JRST OPDRET

OPDF1:	PUSHJ P,TRYSYM	;TRY TO TYPE AS SYM + OR - N
	POPJ P,		;DID IT
	JRST CONXWD	;CAN'T DO IT

;  Conasc -- Ascii Printer
; VALUE IN V
; IF ALL BUT RH 7 BITS=0, ASSUMES RIGHT-JUSTIFIED, ELSE LEFT

CONASC:	TDNN V,[-1,,777600]	;ASSUME RJ ONLY IF RH 7 BITS ONLY
RJASC:	LSH V,1
	PUSH P,T	;SAVE ANOTHER
	MOVEI D3,5	;CONVT.
CONALP:	MOVEI PV,0
	LSHC PV,7	;GET CHR.
	JUMPE PV,PLOPP
	CAIN PV,12
	JRST ITLF
	CAIN PV,15
	JRST ITCR
	CAIN PV,11	;TAB?
	JRST ITAB	;YES
IFN STANFO,<
	CAIN PV,177	;BACKSPACE?
>;STANFORD
IFE STANFO,<
	CAIN PV,177	;DEL?
	JRST ITDEL
	CAIN PV,10	;BACKSPACE??
>;NOT STANFORD
	JRST ITBS	;YES, USE "\" CHARACTER
	CAIN PV,ALTMOD	;ALTMODE?
	JRST ITALT	;YES
PLOP2:	IDPB PV,E	;DEPOSIT
PLOPP:	SOJG D3,CONALP	;LOOP
	JUMPGE V,PPPOPJ	;LOW ORDER BIT ON?
	MOVEI PV,"@"	;YES, DENOTE IT
	IDPB PV,E	;AND WRITE IT
PPPOPJ:	POP P,T		;RESTORE
	POPJ P,

PTEM:	0
IFE STANFO,<
ITDEL:	SKIPA T,[ASCII /DEL/]
>;NOT STANFO
ITBS:	MOVE T,[ASCII /BS/]
	JRST IT
ITALT:	SKIPA T,[ASCII /ALT/]
ITAB:	MOVE T,[ASCII /TAB/]
	JRST IT
ITCR:	SKIPA T,[ASCII /CR/]
ITLF:	MOVE T,[ASCII /LF/]
IT:	PUSH P,D3
	MOVE D3,DDSW
	JRST @[	ITTTY
		ITVTS
		ITNGP
	IFN STANFO,<
		ITDD
		ITIII
		ITDM
	>;STANFO
			](D3)

IFN STANFO,<
ITIII:	TDZA PV,PV	;CLEAR REST OF WORD
	IDPB PV,E
	TLNE E,760000	;EOW(ORD)?
	JRST .-2
	TRO T,1
	MOVEM T,2(E)
	MOVEI T,110+46
	MOVEM T,1(E)
	MOVEI T,210+46
	MOVEM T,3(E)
	ADDI E,3
	HRLI E,700
	JRST POPD

ITDD:	MOVEI T,177
	IDPB T,E		;PUT OUT 177 TO SIGNAL SPECIAL
	POP P,D3
	JRST PLOP2		; (EENSY WORDS DESCRIBING CHARS)
>;STANFO

ITTTY: ITNGP: ITVTS: ITDM:
	MOVEI PV,"<"
	IDPB PV,E
	IDPB PV,E
	PUSH P,V
	MOVE V,T
	PUSHJ P,CONASC
	POP P,V
	MOVEI PV,">"
	IDPB PV,E
	IDPB PV,E
POPD:	POP P,D3
	JRST PLOPP

;CONR50, CONXWD, CONBP

;  Conr50 -- For Printing Radix50 on Request -- 5T -- Conbp
; VALUE IN V

CONR50:	MOVE D2,V
	LDB V,[POINT 4,D2,3];GET HIGH ORDER BITS
	LSH V,2
	PUSHJ P,CONOCT	;TYPE OUT
	MOVEI V,40	;SPACE
	IDPB V,E
	JRST R5TYP

; L,,R PRINTER (EACH HALF SYMBOLIC)

CONXWD:	MOVE T,V		;HOLD VALUE
	HLRZS V			;GET LEFT HALF
	JUMPE V,[SETCM PV,T
		 TRNE PV,TYPNEG	;SMALL NEG NUM IN RIGHT HALF?
		 JRST C4R1	;NO
		 PUSHJ P,IT0	;YES
		 JRST C4R2]
	PUSHJ P,ADTYP		;TYPE IT
C4R2:	MOVEI V,","
	IDPB V,E
	IDPB V,E
C4R1:	HRRZ V,T	;GET RIGHT HALF
	JUMPE V,IT0	;ZERO?
	JRST ADTYP	;TYPE IT


; BYTE POINTER PRINTER

CONBP:	PUSH P,V
	MOVE D3,['POINT']
	PUSHJ P,SIXOUT		;TYPE 'POINT'
	MOVEI V,40
	IDPB V,E		;TYPE A SPACE
	LDB V,[POINT 6,(P),11]	;GET SIZE
	PUSHJ P,PDECCN		;TYPE IT
	MOVE T,(P)		;GET WORD AGAIN
	TLZ T,777740		;CLEAR HIGH PART
	PUSHJ P,NOACQ		;TYPE ADDRESS ETC.
	LDB V,[POINT 6,(P),5]	;GET POSITION
	SUB P,[1,,1]
	CAIN V,44		;IS POSITION 44?
	JRST CPOPJ 		;YES, DON'T TYPE IT
	MOVEI M,","
	IDPB M,E		;TYPE A COMMA
	SUBI V,43
	JRST PDECCN		;TYPE POSITION

;  Conflt -- Floating Point Output Routine

CONFLT:	JUMPL V,CF1
	TLNN V,400	;NORMALIZED?
	JRST CONDEC	;NO
	JRST CF2

CF1:	MOVM T,V
	TLNN T,400	;NORMALIZED?
	JRST CONDEC	;NO
	MOVMS V
	MOVEI T,"-"	;GET -
	IDPB T,E	;DEPOSIT
CF2:	MOVEM D1,D1SV	;SAVE D1
	MOVE D1,V	;GET WORD
	SETZB D2,D3
	CAMGE D1,FT01	;TOO SMALL?(LESS THAN .1?)
	JRST FP4	;YES
	CAML D1,FT8	;TOO BIG?(GREATER THAN 10**8?)
	AOJA D2,FP4	;YES
FP3:
;TYPE SCALED FLOATING POINT NUMBER IN D1.  WE USE THE ALGORITHM DEVISED BY
;STEELE AND WHITE IN THE PAPER "A CRITERION FOR TERMINATION OF RADIX CONVERSION."
	SETZB D2,D3
	ASHC D1,-=27		;D1_EXPONENT, D2_FRACTION
	ASHC D2,-243(D1)	;INTEGER PART IN D2, FRACTION IN D3
	MOVSI V,200000		;GENERATE MASK, = 1/2 LEAST SIGNIFICANT ...
	ASH V,-233(D1)		;...DIGIT (I.E. ONE PAST LAST FRACT BIT)
	MOVE D1,V		;KEEP MASK IN D1
	MOVE V,D2		;GET WHOLE (INTEGER) PART
	PUSHJ P,PDECCN		;PRINT WHOLE PART
	MOVEI V,"."		;GET A .
	IDPB V,E		;PRINT IT
CF3:	MOVE D2,D3		;GET THE REMAINING FRACTION
	MULI D2,=10		;NEXT DEC DIGIT IN D2, NEW FRACTION IN D3
	MOVE V,D2
	JOV .+1			;CLEAR OV FLAG
	IMULI D1,=10		;MULTIPLY MASK TOO. 1 IF OVERFLOW
	JOV CF31		;1 SO REMAINDER CAN'T BE IN [M,1-M]
	CAMGE D3,D1		;SKIP IF REMAINDER  M
	JRST CF31		;AGAIN REMAINDER NOT IN [M,1-M]
	MOVN M,D1		;COMPUTE 1-M BY NEGATING M IN 35 BITS
	TLZ M,400000
	CAMLE D3,M		;SKIP IF REMAINDER  1-M
	AOJA V,CF3D		;REMAINDER .GT. 1-M, SO ALSO .GT. 1/2
	PUSHJ P,CON10B		;REMAINDER IN [M,1-M], PRINT DIGIT AND LOOP
	JRST CF3

;GET HERE WHEN EITHER THE RANGE [M,1-M] IS EMPTY DUE TO M1 OR WHEN
;THE REMAINDER .LT. M.  EITHER WAY, THE REMAINDER COULD BE ON EITHER SIDE
;OF 1/2.  DETERMINE WHICH SIDE AND INCREMENT THE LAST DIGIT APPROPRIATELY.
CF31:	TLNE D3,200000		;SKIP IF REMAINDER .LT. 1/2
	ADDI V,1		;BUMP LAST DIGIT
CF3D:	PUSHJ P,CON10B		;PRINT LAST DIGIT
	MOVE D1,D1SV
	POPJ P,

D1SV:	0
FP4:	MOVNI D3,6
	MOVEI T,0
FP4A:	ASH T,1		;SHIFT COUNT
	XCT FCP(D2)	;COMPARE
	JRST FP4B	;NO YET
	FMPR D1,@FCP+1(D2);YES, MULTIPLY
	IORI T,1	;INSERT A BIT IN COUNT
FP4B:	AOJN D3,FP4A	;LOOP
	PUSH P,FSGN(D2)
	PUSHJ P,FP3	;PRINT ADJUSTED #
	POP P,M		;GET SIGN
	MOVEI D2,"E"	;GET AN E
	IDPB D2,E
	IDPB M,E	;DEPOSIT SIGN
	MOVE V,T	;GET COUNT
	JRST DECCON

	353473426555	;1.0E32
	266434157116	;1.0E16
FT8:	233575360400	;1.0E8
	216470400000	;1.0E4
	207620000000	;1.0E2
	204500000000	;1.0E1
FT:	201400000000	;1.0
	026637304366	;1.0E-32
	113715126246	;1.0E-16
	146527461671	;1.0E-8
	163643334273	;1.0E-4
	172507534122	;1.0E-2
FT01:	175631463146	;1.0E-1
FT0__FT01+1
FCP:	CAMLE D1,FT0(D3)
	CAMGE D1,FT(D3)
	 FT0(D3)
FSGN:	"-"
	"+"

;  Condec, Conbyt -- Decimal, Byte Printer

CONDEC:	MOVE PV,V
	JUMPGE PV,CONDE1	;POSITIVE?
	MOVEI V,"-"		;NO, PRINT A -
	IDPB V,E
	MOVMS PV
CONDE1:	MOVEI V,"="
	JUMPE PV,CON10A
	IDPB V,E
	JRST CON10A

DECCON:	SKIPL PV,V
	JRST CON10A
	MOVEI V,"-"
	IDPB V,E
PDECCN:	MOVM PV,V
CON10A:	JUMPGE PV,CON10C
	SUBI PV,1		;MUST BE 400000,,  PRINT 377777,,777777
	PUSHJ P,CON10C
	ADDI V,1		;THEN BUMP LOW DIGIT BY 1
	DPB V,E
	POPJ P,

CON10C:	IDIVI PV,12		;GET DIGIT
	ADDI M,1
	JUMPE PV,CON10B		;THAT ALL?
	HRLM V,(P)		;NO, SAVE REMAINDER
	PUSHJ P,CON10C		;PRINT REST
	HLRZ V,(P)		;GET REMAINDER BACK
CON10B:	ADDI V,"0"
	IDPB V,E		;DEPOSIT CHR
	POPJ P,

;CONBYT:  BYTE MODE OUTPUT

CONBYT:	MOVE M,T	;GET BYTE SIZE
	MOVE D3,V	;GET #
	MOVEI T,1
	JUMPE M,CONB0	;ZERO SIZE?
CONB1:	MOVEI D2,
	LSHC D2,(M)	;GET BYTE
	LSH T,(M)	;COUNT BYTES
	MOVE V,D2
	PUSHJ P,CONOCT	;TYPE OUT BYTE
	JUMPE T,CPOPJ	;DONE?
	MOVEI V,","	;NO
	IDPB V,E	;TYPE A ,
	JRST CONB1	;LOP
CONB0:	SKIPL M,SMASK+1	;GET MASK
CONB2:	SETCA M,	;COMPLEMENT
	MOVEI D2,
CONB4:	LSHC D2,1	;SHIFT VALUE
	LSH T,1	;SHIFT COUNT
	LSH M,1	;SHIFT MASK
	JUMPE T,.+2
	JUMPL M,CONB4	;LOOP
	MOVE V,D2	
	PUSHJ P,CONOCT	;PRINT RESULT
	JUMPE T,CPOPJ	;DONE?
	MOVEI V,","	;TYPE A ,
	IDPB V,E
	JRST CONB2

;Stsprt, Prgprt, Blkprt -- special top lines conversions

; Status:
;  Go out rh(NBIGWD) spaces
;  Print text indicated by index in LH(NBIGWD)
;  If undefined, or multiply defined, (check F), 
;   print "--  symbol name"
;  Do special size select things for DD
;  Set LH(NBIGWD) to .OK, for next time

STSPRT:
IFN STANFO,<
	MOVE T,DDSW
	CAIE T,.DD
	 JRST STSPR1
	MOVE M,[CW(\FNCN,\ALPHBG,\CHNL,0,\CHNL,0)]
	MOVEM M,(E)
	ADDI E,1
>;STANFO
STSPR1:	HRRZ M,NBIGWD
	SKIPA V,[" "]
	IDPB V,E
	SOJGE M,.-1
	HLRZ V,NBIGWD
	CAIE V,.OK		;MAKE SURE NEXT STATUS PRINTS IF
	 SETOM DDCON		; THIS ONE IS NOT "OK"
	MOVE V,STSTXT(V)
	PUSHJ P,CONASC
	HRRI V,.OK
	HRLM V,NBIGWD
	TLCN F,PUFL!PMULFL	;BOTH ON MEANS "SKIP"
	 JRST SMLSET		; WERE BOTH OFF
	TLNN F,PUFL!PMULFL	;BOTH ON?
	 JRST [	MOVE V,SKPVAL
		PUSHJ P,CONOCT
		JRST SMLSET	]
	SKIPN D2,SYM
	 JRST SMLSET
	MOVE V,[ASCII / -- /]
	PUSHJ P,CONASC
	PUSHJ P,R5TYP
SMLSET:	TLZ F,PUFL!PMULFL	;ALL TOOK CARE OF
IFN STANFO,<
	CAIE T,.DD
	 POPJ P,
	PUSHJ P,CRLFOT		;NEED CR BEFORE SELECT SMALL
	MOVE M,[CW(\FNCN,\ALPHA,\CHNL,0,\CHNL,0)]
	MOVEM M,1(E)
	ADDI E,1		;ANOTHER CRLFOT WILL BE OK
>;STANFO
	POPJ P,


; PRGNAM, BLKNAM -- just print (r50) the approp. names

IFE SORTED, <
PRGPRT:	SKIPA D2,SYMPRG
BLKPRT:	MOVE D2,SYMPNT
	MOVE D2,(D2)
	JRST R5TYP
>;NOT SORTED

IFN SORTED,<
PRGPRT:	SKIPA D2,PID
BLKPRT:	MOVE D2,BID
	MOVE D2,@BLKNM2
	JRST R5TYP
>;SORTED

;Spblt, Iotbl, Iofndi -- These Belong Elsewhere
; CODE TO SET UP SPACEWAR STUFF
			IFN UESW,<	SPBLT:	HRLI 2,-1
					DATAO 2
					EXTERN JOBFF
					MOVN 3,2
					MOVE 4,36(3)
					MOVEM 4,SPB1 ;SYS SYMBOL TABLE PTR
					MOVS 5,4
					ADD 4,3
					MOVSS 4
					HRR 4,JOBFF
					MOVEM 4,JOBSYM
					MOVEM 4,SPB2	;BLT WORD
					HRLM 5,JOBSYM
					MOVNS 5
					ADD 5,JOBFF
					MOVEM 5,SPSWT1
					SKIPN SPSWT2
					0
					BLT 4,-1(5)
					SETZM SPBLT
					SETZM SPSWT2
					0
				SPB1:	0
				SPB2:	0>

IFN EXDSW,<

;I/O DEVICE TABLE

DEFINE IOMACR ()<
FOR A IN (<APR,0>,<PI,4>,<KLPAG,1010>,<CCA,1014>,<TIM,1020>,<PAG,2024>
	,<MTR,1024>,<PTP,2100>,<PTR,2104>,<IOP,110>,<CTY,2120>,<LPT,1124>
	,<C1A,1140>,<C1B,1144>,<DTE0,1200>,<DC,1204>,<DCB,2204>,<DTC,1210>
	,<DTS,1214>,<MTC,1220>,<MTS,1224>,<MTM,1230>,<ADC,2240>,<DAC,2244>
	,<DCSA,1300>,<DCSB,1304>,<DKB,1310>,<DCA,1320>
	,<VDS,1340>,<FRM,3340>,<SIX,1344>,<PLT,2344>
	,<HOT,1350>,<CAR,1354>,<KIM,1360>,<VMI,1364>,<PK,1370>,<DIL,1374>
	,<IMP,1400>,<TV,1404>,<AD,2424>,<DPY,1430>,<KBD,1434>,<XGP,2440>
	,<DSK,1444>,<ELF,1470>,<PMP,1500>,<IBM,1504>,<DDD,1510>,<MPX,1530>
	,<SAMA,3540>,<SAMB,3544>,<SAMC,3550>,<SAMD,3554>
	,<PCLK,2730>,<AS,1774>)>

DEFINE IOTB (NAME,NUM)<'NAME'>
$IOTAB:
IOTBL:	REPEAT 4,<-1>		;DEV CODE PATCH AREA
	IOMACR <IOTB (A)
>
IOTBLN__.-IOTBL

DEFINE IOTB (NAME,NUM)<NUM>
$IOTBN:
IOTBN:	REPEAT 4,<-1>
	IOMACR <IOTB (A)
>

IFN REALSW,<
INTERNAL $IOTAB,$IOTBN
>

^IOFNDI:SKIPA E,SIXSYM		;GET SYM
	LSH E,-6		;RIGHT ADJUST
	TRNN E,77		;DONE?
	JRST .-2		;NO
	MOVEI T,IOTBLN		;GET TABLE LENGTH
ILOPO:	CAME E,IOTBL-1(T)	;SAME?
	SOJG T,ILOPO		;NO, LOOP
	JUMPE T,CPOPJ		;NONE?
	LDB M,[POINT 7,IOTBN-1(T),33];GET NUM
	LSH M,2
	MOVEM M,NM		;STORE VALUE
	JRST CPOPJ1
>;END EXDSW

^CPOPJ1:AOS (P)
	POPJ P,		;LEAVE

;Search Routines -- Oplook -- Opcode (Built-in) Finder

BEGIN OPLOOK

IFN REALSW,<
$OPLOOK:
INTERNAL $OPLOOK
>
;ON ENTRY T HAS A COPY OF THE INSTRUCTION (V)
^OPLOOK:SETZB PV,D2	;CLEAR
	MOVEM V,VSAV	;SAVE VALUE
	LSHC PV,3	;GET HIGH-ORDER BITS
	JRST @OTB1(PV)	;GO TO APPROPRIATE ROUTINE

OTB1:	OPUUO
	OP1
	OP2
	OP3
	OP4
	OP5
	OP6
	OPIO

OP3:	MOVEI PV,0		;CLEAR
	LSHC PV,3		;GET NEXT 3 BITS
	ADDI PV,TAB		;GO TO TABLE
LOP1:	MOVE D3,(PV)		;GET ENTRY
	LDB PV,[POINT 3,D3,35]	;GET SHIFT COUNT
	IMULI PV,6
	LSHC D2,(PV)		;GET CORRECT # OF LETTERS
	MOVNS PV
	LSH D3,-3(PV)		;SHIFT BACK
	DPB D3,[POINT 2,PNT1,35];DEPOSIT # OF BITS FOR NEXT TEST
	AOS PNT1		;ADJUST
	MOVEI PV,0		;CLEAR
PNT1:	LSHC PV,0		;GET BITS (INSTRUCTION GETS CLOBBERED)
	ANDI D3,774		;GET NEXT TABLE #
	JUMPE D3,DONE		;DONE?
	ADDI PV,TAB(D3)		;GET NEXT ENTRY
	JRST LOP1

OP4:	MOVEI PV,0		;CLEAR
	LSHC PV,4		;GET 4 BITS
	MOVE D3,TAB4(PV)	;GET TABLE ENTRY
	LDB PV,[POINT 3,D3,35]	;GET # OF CHRS.
	IMULI PV,6
	LSHC D2,(PV)		;SHIFT IN CHRS.
	MOVEI PV,0		;CLEAR
	LSHC PV,2		;GET NEXT BITS
	ADDI PV,TAB+40		;GO TO IMB TABLE
	JRST LOP1

OP5:	TLCE V,240000		;SWAP BITS
	TLCE V,240000
	TLC V,240000
	MOVEI PV,0
	LSHC PV,2		;GET 2 BITS
	ADDI PV,TAB12
	JRST LOP1

OP6:	FOR @$ I IN (50,21,5)
<REPEAT 3,<TLCE V,I$0000>
>
	MOVEI PV,0
	LSHC PV,2		;GET 2 BITS
	ADDI PV,TAB14
	JRST LOP1

OP2:	MOVEI PV,0
	LSHC PV,1		;GET NEXT BIT (OPCODE 40 BIT)
	JUMPN PV,OP2HI		;JUMP IF OPCODES 240-247
	LSHC PV,3		;GET 3 MORE BITS
	ADDI PV,TAB17		;GO TO TABLE 17
	JRST LOP1

OP1:	MOVEI PV,0
	LSHC PV,1		;GET NEXT BIT (OPCODE 40 BIT)
	JUMPE PV,OP1LOW		;JUMP IF OP CODES 100-137
	LSHC PV,3		;GET 3 MORE BITS
	ADDI PV,TAB21-10
	JRST LOP1

OP1LOW:	LSHC PV,5		;GET REMAINING OPCODE BITS
	MOVE D2,TAB1LO(PV)	;GET TEXT OF OPCODE
	CAIE PV,33		;SKIP IF IT'S IBP
	JRST DONE
	LSHC PV,4
	TRNE PV,17		;SKIP IF AC FIELD IS ZERO
	MOVE D2,[SIXBIT /ADJBP/]	;IBP AC,N IS REALLY ADJBP AC,N
DONE:	MOVE V,VSAV
	POPJ P,

OP2HI:	LSHC PV,5		;GET REMAINING OPCODE BITS
	MOVE D2,TAB2HI-40(PV)	;GET TEXT OF OPCODE
	JRST DONE

OPUUO:	LSHC PV,6	;GET REST OF OP-CODE
IFN STANFO,<
	CAIGE PV,40
	POPJ P,		;NOT SYS UUO
	CAIN PV,<CALLI>-33
	JRST OPCLI	;SPECIAL TREATMENT FOR CALLIS
IONOT:	MOVE V,VSAV
	HLLZ D2,V
	TLZ D2,37
	CALLIT D2,	;TRY IT WITH AC FIELD
	JUMPN D2,OPUU2	;GOT IT - NOW AVOID PRINTING AC
OPUU1:	HLLZ D2,V
	TLZ D2,777
	TLO D2,1	;FORCE MAJOR OPCODE LOOKUP
	CALLIT D2,	;NOW TRY OP ALONE
	JUMPE D2,OPLUZ
>;STANFO
OPWIN:	MOVEI V,73
	DPB V,[POINT 9,T,8]	;STORE DUMMY OPCODE FOR CLEVER CYMBOLIC MODE PRINTER
OPLUZ:	POPJ P,		;RETURN WHATEVER

IFN STANFO,<
OPCLI:	MOVE V,VSAV
	TLNE V,37	;DON'T DECODE WITH ADR IF ANY @() BITS
	JRST OPUU1
	MOVE D2,V
	TLZ D2,777
	CALLIT D2,	;LOOK UP WITH ADR
	JUMPE D2,OPUU1	;LOSE - RETURN "CALLI" ANYWAY
	TRZA T,-1	;WIN - AVOID PRINTING ADR
OPUU2:	TLZ T,740	;FLUSH AC FIELD (ZERO OR PART OF OPCODE)
>;STANFO
IFE STANFO,<
	TRZE PV,40
	MOVE D2,TABUUO(PV)
IONOT:
>;NOT STANFO
	JRST OPWIN

^^$IO:	IFN UESW!FILESW,<-1;>0		;IF ON, SHOULD PRINT IOTS (SEE BELOW)
IFN REALSW,<
	INTERNAL $IO
>

IFN EXDSW,<
OPIO:	MOVE V,VSAV		;GET VALUE
	SKIPN $IO		;ARE WE TO PRINT MACHINE IOTS
IFN STANFO,<JRST IONOT>		;NO, TRY UUO IOTS
IFE STANFO,<POPJ P,>
	LDB PV,[POINT 3,V,12]	;GET REST OF I/O CODE
	MOVE D2,TABIO(PV)	;GET OPCODE
	LDB PV,[POINT 7,V,9]	;GET DEVICE #
	MOVEI D3,IOTBLN		;GET TABLE LENGTH
IOLOP:	LDB V,[POINT 7,IOTBN-1(D3),33];GET #
	CAIE V,(PV)		;SAME?
IOLOP2:	SOJG D3,IOLOP		;NO, LOOP
	JUMPE D3,OPIO2		;NOT FOUND?
	HRLI PV,(D3)		;SAVE POTENTIAL CANDIDATE
	LDB V,[POINT 3,IOTBN-1(D3),26]	;SEE WHICH PROCESSOR
	CAME V,$IO
	JUMPN V,IOLOP2		;WRONG ONE
OPIO1:	SKIPE V,D3
	MOVE V,IOTBL-1(D3)	;GET NAME
	TRO F,CONOFF
	POPJ P,

OPIO2:	SKIPL $IO		;NEG MEANS ALWAYS PRINT AS I/O
	JRST IONOT		;TRY AS SYS CALL
	HLRZ D3,PV
	JRST OPIO1
>;END EXDSW
IFE EXDSW,<OPIO_IONOT>

;TABIO, TAB, TABOR

;D IS NUMBER OF CHARACTERS (3 BIT FIELD).  MUST BE 4 OR LESS.(5 IF AT END OF LIST)
;C IS THE NUMBER OF BITS - 1 TO LOOK AT FOR THE NEXT TABLE
;B IS A 7 BIT FIELD WHICH IS MULTIPLIED BY 4 TO GIVE THE DISTANCE
;  FROM TAB OF THE NEXT TABLE TO LOOK AT.  THE NUMBER OF BITS FROM
;  THE INSTRUCTION SPECIFIED BY THE C FIELD (+1) IS ADDED IN TO GIVE
;  THE OFFSET WITHIN THE NEW TABLE.
DEFINE TT (A,B,C,D)
<<SIXBIT /A/>+D+B5+C3>

TABOR:
TT(OR,0,0,2)

TABIO:	FOR S IN (BLKI,DATAI,BLKO,DATAO,CONO,<CONI>
	,CONSZ,CONSO)
<'S'
>

TAB:			;0 (TAB)
TT(CAI,2,2,3)
TT(CAM,2,2,3)
TT(JUMP,2,2,4)
TT(SKIP,2,2,4)
TT(AOJ,2,2,3)		;1 (TAB+4)
TT(AOS,2,2,3)
TT(SOJ,2,2,3)
TT(SOS,2,2,3)

TT(A,0,0,0)		;2 (TAB+10)
TT(L,0,0,1)
TT(E,0,0,1)
TT(LE,0,0,2)
TT(A,0,0,1)		;3 (TAB+14)
TT(GE,0,0,2)
TT(N,0,0,1)
TT(G,0,0,1)

TAB4: 		;(AUTOMATICALLY USES TABLE 10 FOR I,M,B)
TT(SETZ,0,0,4)		;4 (TAB+20)
TT(AND,0,0,3)
TT(ANDCA,0,0,5)
TT(SETM,0,0,4)
TT(ANDCM,0,0,5)		;5 (TAB+24)
TT(SETA,0,0,4)
TT(XOR,0,0,3)
TT(IOR,0,0,3)
TT(ANDCB,0,0,5)		;6 (TAB+30)
TT(EQV,0,0,3)
TT(SETCA,0,0,5)
TT(ORCA,0,0,4)
TT(SETCM,0,0,5)		;7 (TAB+34)
TT(ORCM,0,0,4)
TT(ORCB,0,0,4)
TT(SETO,0,0,4)

TT(A,0,0,0)		;10 (TAB+40)
TT(I,0,0,1)
TT(M,0,0,1)
TT(B,0,0,1)

TT(A,0,0,0)		;11 (TAB+44)
TT(I,0,0,1)
TT(M,0,0,1)
TT(S,0,0,1)

TAB12:			;12 (TAB+50)
TT(HLL,13,1,3)
TT(HRL,13,1,3)
TT(HRR,13,1,3)
TT(HLR,13,1,3)

TT(A,11,1,0)		;13 (TAB+54)
TT(O,11,1,1)
TT(Z,11,1,1)
TT(E,11,1,1)

TAB14:			;14 (TAB+60)
TT(TR,15,1,2)
TT(TL,15,1,2)
TT(TD,15,1,2)
TT(TS,15,1,2)

TT(N,16,1,1)		;15 (TAB+64)
TT(Z,16,1,1)
TT(C,16,1,1)
TT(O,16,1,1)

TT(A,0,0,0)		;16 (TAB+70)
TT(A,0,0,1)
TT(E,0,0,1)
TT(N,0,0,1)

TAB17:			;17 (TAB+74)
TT(MOVE,11,1,4)
TT(MOVS,11,1,4)
TT(MOVN,11,1,4)
TT(MOVM,11,1,4)
TT(IMUL,10,1,4)		;20 (TAB+100)
TT(MUL,10,1,3)
TT(IDIV,10,1,4)
TT(DIV,10,1,3)

TAB21:
TT(FAD,23,1,3)		;21 (TAB+104)
TT(FADR,10,1,4)
TT(FSB,23,1,3)
TT(FSBR,10,1,4)
TT(FMP,23,1,3)		;22
TT(FMPR,10,1,4)
TT(FDV,23,1,3)
TT(FDVR,10,1,4)

TT(0,0,0,0)		;23 (TAB+114)
TT(L,0,0,1)
TT(M,0,0,1)
TT(B,0,0,1)

TAB1LO:
0			;100
0			;101
0			;102
0			;103
0			;104  JSYS
SIXBIT /ADJSP/		;105
0			;106  SXCT
0			;107
SIXBIT /DFAD/		;110
SIXBIT /DFSB/		;111
SIXBIT /DFMP/		;112
SIXBIT /DFDV/		;113
SIXBIT /DADD/		;114
SIXBIT /DSUB/		;115
SIXBIT /DMUL/		;116
SIXBIT /DDIV/		;117
SIXBIT /DMOVE/		;120
SIXBIT /DMOVN/		;121
SIXBIT /KIFIX/		;122  FIX
SIXBIT /EXTEND/		;123
SIXBIT /DMOVEM/		;124
SIXBIT /DMOVNM/		;125
SIXBIT /FIXR/		;126
SIXBIT /FLTR/		;127
SIXBIT /UFA/		;130
SIXBIT /DFN/		;131
SIXBIT /FSC/		;132
SIXBIT /IBP/		;133 (ALSO ADJBP)
SIXBIT /ILDB/		;134
SIXBIT /LDB/		;135
SIXBIT /IDPB/		;136
SIXBIT /DPB/		;137

TAB2HI:
SIXBIT /ASH/		;240
SIXBIT /ROT/		;241
SIXBIT /LSH/		;242
SIXBIT /JFFO/		;243
SIXBIT /ASHC/		;244
SIXBIT /ROTC/		;245
SIXBIT /LSHC/		;246
SIXBIT /KAFIX/		;247
SIXBIT /EXCH/		;250
SIXBIT /BLT/		;251
SIXBIT /AOBJP/		;252
SIXBIT /AOBJN/		;253
SIXBIT /JRST/		;254
SIXBIT /JFCL/		;255
SIXBIT /XCT/		;256
SIXBIT /MAP/		;257
SIXBIT /PUSHJ/		;260
SIXBIT /PUSH/		;261
SIXBIT /POP/		;262
SIXBIT /POPJ/		;263
SIXBIT /JSR/		;264
SIXBIT /JSP/		;265
SIXBIT /JSA/		;266
SIXBIT /JRA/		;267
SIXBIT /ADD/		;270
SIXBIT /ADDI/		;271
SIXBIT /ADDM/		;272
SIXBIT /ADDB/		;273
SIXBIT /SUB/		;274
SIXBIT /SUBI/		;275
SIXBIT /SUBM/		;276
SIXBIT /SUBB/		;277


IFE STANFO,<
TABUUO:	FOR QQ IN ('CALL','INIT',0,'SPCWAR',0,0,0,'CALLI','OPEN','TTYUUO')
<QQ
>

FOR I_52,54
<0
>

FOR QQ IN (RENAME,IN,OUT,SETSTS,STATO,<GETSTS>
  ,STATZ,INBUF,OUTBUF,INPUT,OUTPUT,CLOSE,<RELEAS>
  ,MTAPE,UGETF,USETI,USETO,LOOKUP,ENTER)
<'QQ'
>
>;NOT STANFO

;SRCH1, SRCH, FNDOP

;CALL WITH TABLE POINTER IN RIGHT HALF OF E, COUNT IN LEFT HALF.
;SEARCHES THE TABLE FOR AN OCCURENCE OF THE FIRST N CHARS OF V.
;LH(T) HAS INITIAL VALUE, RH(T) HAS VALUE TO SHIFT IT BY.
;SKIP RETURNS IF NOT FOUND
SRCH1:	HRRZM T,LCNT
	HLRZM T,VAL
	HLRZM E,CNT1
BEGIN SRCH
^SRCH:	MOVSI M,E
LOOP1:	MOVE D3,@M		;GET ENTRY
	LDB T,[POINT 3,D3,35]	;GET # OF CHARACTERS
	IMULI T,6
	LSHC D2,(T)
	LSHC PV,(T)		;GET CHRS
	MOVNS T
	CAMN D2,PV		;SAME?
	JRST SAM2		;YES
LOOP2:	LSHC D2,(T)
	LSHC PV,(T)		;PUT BACK, NOT SAME
	SOSLE CNT1		;NOT SAME, TRY NEXT. DONE WITH THIS TABLE?
	AOJA M,LOOP1		;NO, TRY NEXT
	AOS (P)			;SKIP RETURN, NOT FOUND
	POPJ P,

SAM2:	PUSH P,M		;SAVE...
	PUSH P,E
	PUSH P,T
	LSH D3,-3(T)		;READJUST
	MOVE T,VAL		;GET VALUE SO FAR
	LSH T,@LCNT		;SHIFT
	IORI T,(M)		;OR IN ADDITIONAL VALUE
	PUSH P,VAL		;SAVE...
	PUSH P,LCNT
	PUSH P,CNT1
	MOVEM T,VAL		;STORE VALUE
	LDB T,[POINT 2,D3,35]	;GET # OF BITS
	ADDI T,1
	ANDI D3,774		;GET TABLE NUMBER
	SKIPN E,D3		;TABLE # ZERO?
	JRST ADON		;YES, ALL DONE
	ADDI E,TAB
	MOVEM T,LCNT		;SAVE # OF BITS (SHIFT COUNT)
	MOVEI D3,1
	LSH D3,(T)		;FORM TABLE LENGTH
	MOVEM D3,CNT1		;STORE
	PUSHJ P,SRCH		;TRY NEXT TABLE
	JRST ADON		;DONE?
ARET:	POP P,CNT1		;NOT DONE, RESTORE EVERYTHING
	POP P,LCNT
	POP P,VAL
	POP P,T
	POP P,E
	POP P,M
	JRST LOOP2		;TRY SOME MORE

ADON:	JUMPN V,ARET		;ANY LEFT?
	SUB P,[6,,6]		;THROW AWAY SAVED STUFF
	POPJ P,			;LEAVE
BEND SRCH

CNT1:	0
LCNT:	0
VAL:	0

^FNDOP: PUSH P,D3
	PUSH P,PV
	MOVEI D2,0
	MOVE V,SIXSYM		;GET SYMBOL
BEGIN FNDOP
	MOVEI PV,0
	LSHC PV,6		;GET FIRST CHR.
	CAIN PV,'H'		;IS IT H?
	JRST ITH		;YES
	CAIN PV,'T'		;IS IT T?
	JRST ITT		;YES
	LSHC PV,-6
	PUSHJ P,SOTH
SUUOQ:	PUSHJ P,SUUO
	POP P,PV
	POP P,D3
	POPJ P,

ITH:	LSHC PV,-6		;READJUST
	PUSHJ P,SHCH		;RETURNS ONLY IF NOT SUCCESSFUL
	JRST SUUOQ

ITT:	LSHC PV,-6
	PUSHJ P,STTZ		;RETURNS ONLY IF NOT SUCCESSFUL
	JRST SUUOQ

SOTH:	MOVEI T,TAB4		;FIRST TRY BOOLEAN INSTRUCTIONS
	MOVEI M,20
LOOP3:	MOVE D3,(T)		;GET TABLE ENTRY
LOOP3A:	LDB E,[POINT 3,D3,35]	;GET # OF CHRS
	IMULI E,6
	LSHC D2,(E)
	LSHC PV,(E)
	MOVNS E
	CAMN PV,D2 		;SAME?
	JRST SAM3		;YES, FIND MODE (COME BACK IF TWO OR MORE LEFT)
NOSM3:	LSHC PV,(E)
	LSHC D2,(E)
	ADDI T,1		;NO, TRY AGAIN
	SOJG M,LOOP3
	JUMPL M,PNTQ
	MOVE D3,TABOR
	MOVEI T,TAB4+7		;ENTRY FOR "IOR"
	JRST LOOP3A

SAM3:	TLNE V,7700		;IF MORE THAN ONE
	JRST NOSM3		; LETTER LEFT TO SATISFY, LOOK SOME MORE
	SUBI T,TAB4-100		;ADJUST VALUE
	MOVSS T
	HRRI T,2		;2 BITS NEXT
	PUSH P,E
	MOVE E,[4,,TAB+40]
	PUSHJ P,SRCH1
	JRST ADONE2		;MATCH
	POP P,E
	LSHC PV,(E)		;READJUST
	MOVEI D2,0
	JRST PNTQ

ADONE2:	POP P,E
	JRST ADONE

PNTQ:	MOVE T,[2,,4]		;NOT HERE, TRY THE 2 GROUP
	MOVE E,[10,,TAB17]
	PUSHJ P,SRCH1		;SEARCH THE TABLE
	JRST ADONE		;SAME
	MOVE T,[3,,3]		;NO MATCH, TRY THE 3 GROUP
	MOVE E,[10,,TAB]
	PUSHJ P,SRCH1
	JRST ADONE		;MATCH
	MOVE T,[3,,3]		;NO MATCH, TRY THE 1 GROUP
	MOVE E,[10,,TAB21]
	PUSHJ P,SRCH1
	JRST ADONE		;MATCH
	MOVSI T,-40
PNTQ1:	CAME V,TAB2HI(T)
	AOBJN T,PNTQ1
	JUMPGE T,PNTQ2		;JUMP IF NO MATCH
	MOVEI E,240(T)
	JRST ADONE9

PNTQ2:	MOVSI T,-40
PNTQ3:	CAME V,TAB1LO(T)
	AOBJN T,PNTQ3
	JUMPGE T,PNTQ4		;JUMP IF NO MATCH
	MOVEI E,100(T)
	JRST ADONE9

PNTQ4:	MOVEI E,133
	CAMN V,[SIXBIT /ADJBP/]
	JRST ADONE9
	MOVEI E,0		;NO, TRY I/O
	MOVEI T,10
	JSR [	RTJS:	0
			MOVE PV,V
		LPL:	TRNE PV,77
			JRST @RTJS
			LSH PV,-6
			JRST LPL	]
;FALLS THROUGH

;SUUO
;FALLS THROUGH FROM PREVIOUS PAGE
LOOP4:	CAMN PV,TABIO(E)	;MATCH?
	JRST IMAT		;YES
	ADDI E,1
	SOJG T,LOOP4		;NO
	POPJ P,			;NO MATCH ANYWHERE

IMAT:	ADDI E,16000		;FORM OPCODE
	LSH E,27		;ADJUST
	TRO F,CONOF		;SET FLAG
RET:	MOVEM E,NM		;DEPOSIT
	POP P,E			;THROW AWAY RETURN
	POP P,PV		;RESTORE
	POP P,D3
	POP P,E			;THROW AWAY RETURN
	TLO F,NUMF!SYMF!SCFL	;SET FLAGS
	POPJ P,			;RETURN TO FNDOP'S CALLER'S CALLER

ADONE:	MOVE E,VAL		;GET VALUE
ADONE9:	LSH E,33		;ADJUST
	JRST RET

STTZ:	MOVE D2,PV
	MOVE T,[6,,2]		;TRY THE 6 GROUP (T)
	MOVE E,[4,,TAB14]
	PUSHJ P,SRCH1
	JRST .+2		;MATCH
	POPJ P,			;NO MATCH
	MOVE E,VAL
FOR @$ I IN  (5,21,50)
<REPEAT 3,<TRCE E,I>
>
	JRST ADONE9

SHCH:	MOVE D2,PV
	MOVE T,[5,,2]		;TRY THE 5 GROUP
	MOVE E,[4,,TAB12]
	PUSHJ P,SRCH1
	JRST .+2
	POPJ P,
	MOVE E,VAL
	TRCE E,24
	TRCE E,24
	TRCE E,24
	JRST ADONE9

IFN STANFO,<
SUUO:	MOVE E,V
	TLNN E,77
	JRST SUUOSM		;ONE OR TWO CHARACTERS
SUUOS1:	CALLIT E,		;SEE IF SYSTEM KNOWS ABOUT IT
	JUMPN E,RET		;AHA! GOT VALUE FROM SYSTEM
	POPJ P,			;NO LUCK NOHOW

SUUOSM:	CAME E,[SIXBIT /IN/]
	POPJ P,
	JRST SUUOS1
>;STANFO
IFE STANFO,<
SUUO:	MOVEI E,
	MOVEI T,40
	JSR RTJS
SLOP1:	CAMN PV,TABUUO(E)	;SAME
	JRST SDONN		;YES
	ADDI E,1
	SOJG T,SLOP1		;DONE?
	POPJ P,			;YUP, NO LUCK
SDONN:	ADDI E,40
	JRST ADONE9
>;NOT STANFO
BEND FNDOP
^FNDOP__FNDOP

BEND OPLOOK
^FNDOP__FNDOP

IFE SORTED,<	;STANDARD SYMBOL TABLE (UNSORTED) ROUTINES (ENDS ON PAGE 46)
BEGIN FNDSYM

RDF(MNBLK,1)
RDF(CNTF,2)

;  Fndsym -- The VALSYM Symbol Table Searcher.
;
; VALUE IN V

; RETURNS IN
;  DNSYM, DNDIF, DNCUR THE SYMBOL NAME, VALUE, AND BLOCK NAME
;    (-1 IF SHOULD NOT BE TYPED) OF THE SYMBOL WHOSE VALUE IS
;    EQUAL TO OR LEAST LESS THAN THE VALUE IN V.
;  UPSYM, UPDIF, UPCOR THE CORRESPODING THINGS FOR THE SYMBOL
;    WHOSE VALUE IS LEAST GREATER THAN THE VALUE IN V.

^FNDSYM:
	MOVEI	PV,NUMCSH-1	;FIRST SEARCH FOR RECENT FINDS
FNDL1:	CAME	V,VALCSH(PV)	;IS VALUE EQ THIS VALUE?
	SOJGE	PV,FNDL1	;NO, CONTINUE
	JUMPL	PV,FNDS1	;WE FAILED
QUICFD:	SETZM	DNDIF		;EXACT MATCHES ONLY
	MOVEI	E,DNSYM-1	;NOW SAVE SYMBOL NAMES AND BLOCK NAMES
	PUSH	E,VALSYM(PV)	;LOWER SYMBOL NAME
	PUSH	E,VALBLK(PV)	;LOWER BLOCK NAME
	JRST	BDON		;ALL DONE

FNDS1:	MOVEI E,SYMPRG	;INITIALIZE
	HRRM E,PNT1
	MOVE E,[400000,,1]
	MOVEM E,UPDIF	;INITIALIZE DIFERENCES
	HRLOI E,377777
	MOVEM E,DNDIF
	SETZM UPSYM
	SETZM DNSYM
	SETOM WRPSW
	SETOM UPCUR
	SETOM DNCUR
	TRNN F,CNVABS		;USE ABS VAL?
	SKIPGE PV,SYMPNT	;GET SYMBOL POINTER
	POPJ P,	;NONE
	MOVE E,1(PV)	;GET BLOCK LEVEL
	MOVEM E,BLKLV	;SAVE
	TB O,F,MNBLK
	TB Z,F,CNTF
LOP2:	MOVSI M,400000	;INITIAL CODE BIT MASK
LOP1:	SUB PV,[2,,2]	;GO TO NEXT
	JUMPL PV,ATTOP	;AT TOP (BOTTOM?) OF TABLE?
PNT1:	;CAMN PV,SYMPRG	;BACK TO START?
	CAMN PV,SYMPNT	;BACK TO REAL START?
	JRST DON	;YES
	TDNE M,(PV)	;MASK BIT ON?
	JRST LOP1	;YES
	LDB E,[POINT 4,(PV),3];GET CODE BITS
	CAIN E,3	;BLOCK NAME?
	JRST BLKCHK	;YES
	JUMPE E,PRGCHK	;PROGRAM NAME?
	MOVE E,V	;GET VALUE
	SUB E,1(PV)	;GET DIFFERENCE
	JUMPGE E,PNT2	;FOUND ONE SMALLER?
	CAMGE E,UPDIF	;NO, COMPARE FOR BETTER MATCH
	JRST LOP1	;NOT BETTER
	CAME E,UPDIF	;EQUAL MATCH?
	JRST .+4
	TB NE,F,MNBLK,	;IN MAIN BLOCK?
	SKIPN UPCUR	;OTHER IN MAIN BLOCK?
	JRST LOP1	;NO, YES
	MOVEM E,UPDIF	;DEPOSIT NEW DIF.
	MOVE E,1(PV)	;ACTUAL VALUE
	MOVEM E,UPADR	;SAVE FOR QUICK-FIND CACHE STORAGE
	MOVE E,(PV)	;GET SYMBOL NAME
	MOVEM E,UPSYM	;SAVE
	SETZM UPCUR
	TB NE,F,MNBLK,	;IN THE MAIN BLOCK?
	JRST LOP1	;YES
LOP3:	MOVE E,CURBL	;NO, GET BLOCK NAME
	MOVEM E,UPCUR	;SAVE
	JRST LOP1
PNT2:	JUMPE E,PNT3	;EXACT MATCH
	CAMLE E,DNDIF	;COMPARE FOR BETTER MATCH
	JRST LOP1	;NO
	CAME E,DNDIF	;EQUAL MATCH?
	JRST .+4
	TB NE,F,MNBLK,	;IN MAIN BLOCK?
	SKIPN DNCUR	;OTHER IN MAIN BLOCK?
	JRST LOP1	;NO, YES
	MOVEM E,DNDIF	;DEPOSIT NEW DIF
	MOVE E,1(PV)	;SAVE ACTUAL VALUE FOR
	MOVEM E,DNADR	; QUICK-FIND CACHE STORAGE
	MOVE E,(PV)	;GET SYMBOL NAME
	MOVEM E,DNSYM	;SAVE
	SETZM DNCUR
	TB NE,F,MNBLK,	;IN THE MAIN BLOCK?
	JRST LOP1	;YES
	MOVE E,CURBL	;NO, GET BLOCK NAME
	MOVEM E,DNCUR	;SAVE
	JRST LOP1
PNT3:	SETZM UPDIF
	MOVE E,(PV)	;GET NAME
	MOVEM E,UPSYM	;SAVE
	SETZM UPCUR
	TB NE,F,MNBLK,	;IN THE MAIN BLOCK?
	JRST ADON	;YES
	JRST LOP3	;YES

BLKCHK:	MOVE E,1(PV)	;GET VLOCK LEVEL
	TB O,F,MNBLK
	CAMGE E,BLKLV	;COMPARE WITH CURRENT
	JRST [MOVEM E,BLKLV  ;THESE O.K.
		JRST LOP1]
	TB Z,F,MNBLK,	;CLEAR FLAG
	MOVE E,(PV)	;GET BLOCK NAME
	MOVEM E,CURBL	;SAVE
	JRST LOP1
PRGCHK:	TLO M,100000	;LOOK ONLY FOR GLOBALS
	JRST LOP1
ATTOP:	
	SKIPLE	WRPSW
	JRST ADON
	EXCH PV,V	;HOLD VALUE
			;NOW V HAS THE SYMBOL TABLE POINTER FOR WRAPQ.
	PUSHJ P,WRAPQ	;GO TO BOTTOM (TOP?) OF TABLE
	EXCH PV,V	;RESTORE VALUE
	JRST PNT1
DON:	TB OE,F,CNTF,	;ALL DONE?
	JRST ADON	;YES
	CAMN PV,SYMPNT	;NO BLOCKS?
	JRST ADON	;YES
	MOVEI E,SYMPNT	;LOOK FOR SSTARTING POINT
	HRRM E,PNT1
	SETZM BLKLV
	SETZM	WRPSW	;HO HO......
	JRST LOP2
ADON:	SKIPN	DNSYM		;EXACT MATCH?
	SKIPE	DNDIF		;EXACT MATCH?
	 JRST	 BDON		; NO, DON'T STORE IN CACHE
	SOSGE	PV,NCSHPT	;UPDATE MOST RECENT POINTER
	MOVEI	PV,NUMCSH-1	;WRAPAROUND
	MOVEM	PV,NCSHPT
	HRROI	E,DNADR		;NOW STORE NEWLY FOUND VALUES IN CACHE
	POP	E,VALCSH(PV)	;LOWER VALUE
	POP	E,VALBLK(PV)	;LOWER BLOCK NAME
	POP	E,VALSYM(PV)	;LOWER DITTO
BDON:	TB Z,F,CNTF
	TB Z,F,MNBLK
	POPJ P,
BEND FNDSYM
WRPSW:	0
^WRPSW_WRPSW
DNSYM: 0
DNCUR: 0
DNADR: 0
UPSYM: 0
UPCUR: 0
UPADR: 0
UPDIF: 0
DNDIF:0
CURBL:0
VSAV:0
BEND SUBS

;Symlok -- SymbolValue Searcher -- Wrap, Csflush, Cpopj

; HERE IS THE SYMVALUE SYMBOL TABLE SEARCHER
; RADIX50 FOR SYMBOL IN `SYM', SKIPS AND CONTAINS SYMBOL ENTRY IN SPNT
;   AND V IF FINDS IT, ELSE NO SKIP

^SYMLOK: MOVEI	V,NUMCSH-1	;FIRST SEARCH THE RECENT CACHE
	MOVE	E,SYM
	CAME	E,SYMCSH(V)	;HAVE WE SEEN IT RECENTLY?
	 SOJGE	 V,.-1		; NOT YET
	JUMPL	V,SYMLK1	;QUICK SEARCH FAILED
	MOVE	V,SYMVAL(V)	;GET POINTER TO SYMTAB FOR THIS SYM
	JRST	LOP77		;RETURN FAST FAST FAST

SYMLK1:
	SKIPGE V,SYMPNT	;GET SYMBOL TABLE POINTER
	JRST NONE	;NO SYMBOLS
	MOVE E,1(V)	;GET BLOCK LEVEL
	MOVEM E,BLKLV	;SAVE BLOCK LEVEL
	MOVSI M,200000	;INITIAL CODE BIT MASK
	HLRE T,JOBSYM	;GET COUNT
	ASH T,-1	;ADJUST
LOP4:	SUB V,[2(2)]	;GO TO NEXT
	AOJGE T,NONE	;DONE?
	JUMPGE V,.+2	;AT TOP (BOTTOM?) OF TABLE?
	PUSHJ P,WRAPQ	;YES
LOP5:	TDNE M,(V)	;MASK BITS ON?
	JRST LOP4	;YES, IGNORE SYMBOL
	LDB E,[POINT 4,(V),3];GET CODE BITS
	CAIN E,3	;BLOCK NAME?
	JRST BLKCHK	;YES
	JUMPE E,PRGCHK	;PROGRAM NAME?
	LDB E,[POINT 32,(V),35];GET SYMBOL
	CAME E,SYM	;SAME?
	JRST LOP4	;NO
LOP7:	SOSGE E,SCSHPT		;GET NEXT FREE MOD SIZE OF CACHE
	MOVEI E,NUMCSH-1	;WRAP-AROUND
	MOVEM E,SCSHPT
	MOVE M,SYM		;SYMBOL NAME (NO BITS)
	MOVEM M,SYMCSH(E)	;SAVE NAME FOR QUICK SEARCH
	MOVEM V,SYMVAL(E)	;SAVE SYMBOL POINTER

LOP77:	MOVE E,1(V)		;GET VALUE
SYMDOT:	MOVEM E,NM		;STORE
	MOVEM V,SYMP		;SAVE POINTER
	TLO F,NUMF!SYMF!SCFL	;SET FLAGS
ITCHK:	CAIN C,"."		;IS AHEAD CHAR <ctrl1>.	?
	CAIE B,1
	POPJ P,			; NO
	TLZ F,SCFL		;NOT AHEAD ANY MORE
	SETZM SAVMOD		;DON'T USE ANY INPUT-DRIVEN MODE
	JSR FNDSCR		;ON SCREEN?
	JRST [	HLRZ M,(M)
		TLZ M,400037 	;CLEAR NON-MODE BITS
		LSH M,-5	;IN SAVMOD FORMAT
		TLNN F1,FIRF 	;FIRST THING?
		HRRM M,SAVMOD 	;YES, USE THIS MODE
		JRST .+1  ]
	JRST ITD1		;USE CONTENTS OF THAT CELL
	POPJ P,

; FLUSH ALL CACHES, SOMETHING DRASTIC HAS CHANGED

^CSFLUSH:
	SETOM	SYMCSH		;SET TO RIDICULOUS VALUE
	MOVE	E,[XWD SYMCSH,SYMCSH+1]
	BLT	E,CSHEND	;CLEAR ALL TO -1
	POPJ	P,

^WRAPQ:   ^WRAP:
ORDWRP:	HLRE E,JOBSYM	;GET SYMBOL TABLE LENGTH
	MOVNS E	;PUT IN POSITIVE FORM
	MOVEI V,-2(E)	;REDUCE BY 2
	ADD V,JOBSYM	;FIND END OF TABLE
WRPDON:	HRL V,E	;PUT POSITIVE COUNT IN LEFT
	AOS	WRPSW
	POPJ P,


PRGCHK:	TLO M,100000	;LOOK ONLY FOR GLOBALS
	JRST LOP4
BLKCHK:	MOVE E,1(V)	;GET BLOCK LEVEL
	CAMGE E,BLKLV	;COMPARE WITH CURRENT LEVEL
	JRST  [MOVEM E,BLKLV	;THESE SYMBOLS O.K.
		JRST LOP4 ]
LOP6A:	MOVSI E,40000	;MASK BIT
LOP6:	SUB V,[2(2)]	;GO TO NEXT
	AOJGE T,NONE	;DONE?
	JUMPGE V,.+2	;AT TOP?
	PUSHJ P,WRAPQ	;YES
	TDNN E,(V)	;GLOBAL OR BLOCK?
	JRST LOP6	;NO
	LDB E,[POINT 4,(V),3];GET CODE BITS
	CAIN E,3	;BLOCK NAME?
	JRST BLKCHK	;YES
	LDB E,[POINT 32,(V),35]	;GET SYMBOL NAME
	CAME E,SYM	;SAME?
	JRST LOP6A	;NO
	JRST LOP7	;YES
NONE:
IFN EXDSW,<PUSHJ P,IOFNDI>	;FIND AS I/O DEV. NAME
	TLOA F,SYMF!SCFL!UNDF	;NOT FOUND
	TLO F,NUMF!SYMF!SCFL	;FOUND
^CPOPJ:	POPJ P,

;Prgfnd, Prgset, Blkfnd, Blkfn

^PRGFND: PUSHJ	P,CSFLUSH	;FLUSH ALL CACHES
	TLNN	F1,SINGF	;SINGLE SYMBOL?
	JRST CERR	;NO
	MOVEI T,0	;HUNT FOR PROGRAM NAME
	SETZM WRPSW
	PUSHJ P,WRAP	;GET START
	PUSHJ P,PGFND	;FIND
	JRST PU		;COULDN'T
	MOVEM V,SYMPNT	;SAVE POINTER
	MOVEM V,SYMPRG	;  "    "
	MOVE T,(V)
	MOVEM T,PRGSAV#
	MOVEI T,3	;LOOK FOR BLOCK
	PUSHJ P,PBCON
	JRST INSBLK	;INSERT IN REF LIST
	MOVEM V,SYMPNT
	JRST INSBLK

; PROGRAM NAMES ARE LINKED TOGETHER (USUALLY) VIA NEGATIVE DISTANCES
; IN LEFT HALF OF VALUE WORD -- FIND RIGHT PROGRAM REAL FAST

PGFND:	MOVE	E,(V)	;GET SYMBOL NAME AT THIS LOC (GUARANTEED PROG NAME)
	MOVEI	T,0		;IN CASE HAVE TO CALL PBCON FOR PROG NAME
	CAMN	E,SYM	; (TYPE BITS 0, CAM OK)		;ALL DCS
	 JRST	 OKPOPJ	; THIS IS IT
	HLRE	E,1(V)	;GET NEG DISTANCE TO NEXT
	JUMPE	E,PBCON ;END OF LINKS, MAYBE NOT LINKED
	MOVNS	E	;GET POS VALUE
	HRLS	E	;USE ON BOTH HALVES
	SUB	V,E	;NEXT
	JRST	PGFND

PBFND:	LDB E,[POINT 4,(V),3];GET CODE BITS
	CAMN E,T	;SAME?
	JRST SAM1	;YES
	JUMPE E,CPOPJ	;PRG NAME?
PBCON:	SUB V,[2,,2]	;GO TO NEXT
	JUMPGE V,PBFND	;LOOP IF MORE TO GO
	POPJ P,	;NOT FOUND
SAM1:	LDB E,[POINT 32,(V),35];GET SYMBOL
	CAME E,SYM	;SAME?
	JRST PBCON	;NO, PROCEED
OKPOPJ:	AOS (P)		;FOUND WHAT WERE LOOKING FOR
	POPJ P,
^PRGSET:
IFE UESW,<
	HLRO V,JOBSYM
	MOVN V,V
	ADD V,JOBSYM		;PROG CHAIN STARTS AT SYMTAB END
ONCE1:	MOVE E,-2(V)
	CAME E,[RADIX50 0,RAID]	;THESE ARE USUALLY BAD CHOICES
	CAMN E,[RADIX50 0,JOBDAT]
	JRST ONCE2
	HLRZ B,-1(V)
	JUMPE B,ONCE4
	CAIL B,-6
	JRST ONCE4		;NOT MANY SYMS - TRY DIFFFERENT PROG
ONCE3:	MOVEM E,SYM
	JRST PRGFND		;FIND AND DISPLAY THIS ONE
ONCE4:	JUMPN C,ONCE2
	MOVE C,E		;REMEMBER IT THE FIRST TIME
ONCE2:	HLRE E,-1(V)
	ADD V,E
	JUMPL E,ONCE1	;KEEP LOOKING
	SKIPN E,C
IFN REALSW,<	MOVE E,[RADIX50 0,RAID]	;NO MORE - HAVE TO SETTLE FOR RAID>
IFE REALSW,<	MOVE E,[RADIX50 0,TRAID]>
	JRST ONCE3
;>	POPJ	P,

^BLKFN: PUSHJ P,CSFLUSH		;FLUSH ALL CACHES
	PUSHJ P,BLKFND

; INSERT PROG/BLOCK PAIR IN BUFFER FOR QUICK REFERENCE (CTRL-Z)

INSBLK:	MOVEI	T,NUMREF	;SEARCH FIRST, MAKE SURE IT'S NOT THERE ALREADY
	MOVE	E,SYMPNT	;CURRENT BLOCK POINTER
	CAME	E,BLKREF(T)	;IS IT?
	 SOJGE	 T,.-1		; NOT YET
	JUMPGE	T,SETGET	;WAS THERE, GO REFRESH
	SOSGE	T,REFPNT	;GET NEXT FREE POINTER
	MOVEI	T,NUMREF-1	;WRAPAROUND
	MOVEM	T,REFPNT
	HRROI	E,SYMPNT	;SAVE PROG POINTER, BLOCK POINTER
	POP	E,BLKREF(T)
	POP	E,PRGREF(T)
SETGET:	MOVEM	T,REFGET	;TAKER POINTER
	POPJ	P,		;GO REFRESH, RETURN


^BLKFND:TLNN F1,SINGF	;SINGLE SYMBOL?
	JRST CERR	;NO
	MOVEI T,3	;HUNT FOR BLOCK NAME
	MOVE V,SYMPRG	;GET POINTER
	PUSHJ P,PBCON	;FIND
	JRST PU
	MOVEM V,SYMPNT	;SAVE POINTER
	MOVE T,(V)
	MOVEM T,BLKSAV#
	POPJ P,
>;NOT SORTED (BEGAN ON PAGE 43 NEAR THE BEGINNING OF THE BLOCK FNDSYM)

IFN SORTED,< ;(ENDS ON PAGE 55)	SETSYM
; Setsym -- Initialize (reset) Symbol Table Variables (SORTED BEGINS HERE)

BEGIN SETSYM
^SETSYM:SETOM DDSW			;FORCE COMPLETE DEVICE RE-EVALUATION
IFN STANFO,<
	MOVE A,JOBSYM
	HLRE A,(A)
	AOJE A,SETSY1			;IF LH OF FIRST WORD OF SYMTAB IS -1
>;STANFO
IFE STANFO,<
	MOVS A,JOBSYM
	CAIE A,-1
>;NOT STANFO
	PUSHJ P,SORT			;WE HAVE DONE THE SORT ALREADY
SETSY1:	MOVE E,JOBSYM			;-SIZE,,LOC
	MOVEM E,SAVJSM			;IF DIFFERENT NEXT TIME, CALL AGAIN
	HRRZM E,SYMBAS			;FOR RELOCATING OTHER POINTERS
	HRRE A,(E)
	AOJN A,.+2
	HLLZS (E)			;SET RH OF FIRST WORD TO ZERO IF WAS -1
	HRRZ V,5(E)			;RELATIVE ADDRESS OF FIRST BLOCK OF SYMBOLS
	HRRZ A,11(E)			;RELATIVE ADDRESS OF WORD AFTER LAST SYMBOL
	SUBM V,A			;A GETS -NUMBER OF WORDS OF SYMBOLS
	ADD V,E				;ABSOLUTE ADDRESS OF FIRST WORD OF SYMBOLS
	HRL V,A
	MOVEM V,SYMRNG			;-SIZE,,FIRST FOR ACTUAL SYMBOLS
	MOVEI V,5(E)
	HRLI V,A			;ABSOLUTE ADDRESS OF RELATIVE POINTERS
	MOVEM V,RNGBAS			; TO THE SYMBOLS
	ADDI V,1
	MOVEM V,RNGBS1			; RANGE TABLE+1(A)
	HRRZ V,2(E)			;BLKVAL
	ADD V,E				;   TABLE
	HRLI V,E			; BLKVAL(E)
	MOVEM V,BLKVAL
	HRLI V,M
	MOVEM V,BLKVL1			; BLKVAL(M)
	HRRZ V,1(E)			; REPEAT FOR NAMES
	ADD V,E
	HRLI V,D2
	MOVEM V,BLKNM2
	HRLI V,E
	MOVEM V,BLKNAM
	SUB V,BLKVAL
	MOVMM V,BLKSIZ			; SIZE OF BLOCK STRUCTURE TABLES
^FREPOPJ:TRO F,DPYALL
NOPROG:	POPJ P,
BEND SETSYM
^SETSYM_SETSYM
^FREPOPJ_FREPOPJ

; Fndsym -- The VALSYM Symbol Table Searcher.
;
; VALUE IN V

; RETURNS IN
;  DNSYM, DNDIF, DNCUR THE SYMBOL NAME, VALUE, AND BLOCK NAME
;    (-1 IF SHOULD NOT BE TYPED) OF THE SYMBOL WHOSE VALUE IS
;    EQUAL TO OR LEAST LESS THAN THE VALUE IN V.
;  UPSYM, UPDIF, UPCUR THE CORRESPODING THINGS FOR THE SYMBOL
;    WHOSE VALUE IS LEAST GREATER THAN THE VALUE IN V.

BEGIN FNDSYM
;initialize the search
^^FNDSYM:SKIPGE PID			;Don't bother if there are no symbols
	POPJ P,
	PUSHJ P,GETRNG			;Assign range to A.  Swap V if class 3
	JRST @[	FSYM			;Class 1 -- search low-seg addrs only
		FSYM			;      2 -- high-seg addrs only
		QOPCOD			;      3 -- better of "op code", "full srch"
		BIGNUM](A)		;      4 -- better of "full", "op" srch

QOPCOD:	PUSHJ P,FSYM			;Classes 3 and 4 cover the same range,
	MOVMS UPDIF
	TRNN F,CNVABS			; really, tho class 3 only has those
	SKIPN UPDIF			; symbols whose values have 18 low-order 0's
	POPJ P,				;Don't bother 2d try if Abs mode, just 
	PUSHJ P,[SVVAL:	MOVE E,[DNSYM,,ODNSYM]
			BLT E,ODNDIF	; called FSYM to set up UPDIF, DNDIF, etc.
			POPJ P,]	;This symbol has 18 low-order zeroes, so
	HLRZS V	;undo what getrng did	; first try class 3, then if no exact
	MOVEI A,3			; match, try class 4. Choose the best
	PUSHJ P,FSYM			; difference, using some reasonable
	MOVMS UPDIF
	MOVEI E,1000
	CAMLE E,ODNDIF			;SKIP IF DIFFERENCE IS RIDICULOUSLY BIG
	MOVSS ODNDIF
	CAMLE E,OUPDIF
	MOVSS OUPDIF
	JRST DCIDE			; algorithm.

BIGNUM:	PUSHJ P,FSYM			;Here the value has some low order 1's
	MOVMS UPDIF
	SKIPN UPDIF			; in the low 18 bits.   So first
	POPJ P,				; try the class 4 symbols, then if there's
	PUSHJ P,SVVAL			; no exact match, zap the low 18,
	PUSH P,V			; search class 3 for that, then create the
	HLRZ V,V			; actual differences by re-including the
	MOVEI A,2			; low-order 1's.  Finally, again, decide
	PUSHJ P,FSYM			; which set of results gives the best
	MOVMS UPDIF
	POP P,V				; answer.
	HRRZ V,V
	MOVEI E,1000
	CAMLE E,DNDIF			;SKIP IF DIFFERENCE IS RIDICULOUSLY BIG
	JRST [	MOVSS DNDIF
		HRRM V,DNDIF
		JRST .+1]
	CAMLE E,UPDIF
	JRST [	SKIPN UPDIF
		JRST BIGNU1
		MOVSS UPDIF
		SUB V,UPDIF
		MOVNM V,UPDIF
		JRST .+1]
DCIDE:	MOVE E,ODNDIF			;Here, just choose the set of results
	CAME E,DNDIF			; which seem to give the best results.
	JRST DCIDE1			;ONE OF THEM IS BETTER
	MOVE E,OUPDIF
	CAML E,UPDIF
	POPJ P,				;NEW IS AS GOOD OR BETTER
FRST:	MOVE E,[ODNSYM,,DNSYM]		;OLD ONE IS BETTER
	BLT E,DNDIF
	POPJ P,

DCIDE1:	MOVE V,OUPDIF
	CAME V,UPDIF
	JRST DCIDE2			;ONE OF THESE IS BETTER TOO
	MOVE V,ODNDIF
	CAML V,DNDIF
	POPJ P,				;NEW ONE IS AS GOOD OR BETTER
	JRST FRST			;OLD ONE IS BETTER

DCIDE2:	CAML E,DNDIF
	CAMG V,UPDIF
	JRST .+2
	POPJ P,				;NEW ONE IS BETTER ON BOTH COUNTS
	CAMG E,DNDIF
	CAML V,UPDIF
	JRST .+2
	JRST FRST
	MOVEI A,0
	CAML E,DNDIF
	AOJA A,[MOVE E,DNDIF
		JRST .+1]
	CAML E,@[UPDIFOUPDIF](A)
	JRST DCIDE3
	JUMPE A,FRST
	POPJ P,
DCIDE3:	JUMPN A,FRST
	POPJ P,

BIGNU1:	HRLOI E,377777
	MOVEM E,UPDIF
	JRST DCIDE

;FSYM
FSYM:	MOVEM A,RANGE			; only concerned with 3's and 3's 
	HRLOI E,377777			;The differences start out very large,
	MOVEM E,DNDIF			; to be diminished if symbols
	MOVE E,[400000,,1]
	MOVEM E,UPDIF			; bracketing the value are found
	SETZM UPSYM
	SETZM DNSYM
	SETOM UPCUR
	SETOM DNCUR
	SETZM UPSYMP
	SETZM DNSYMP
	TRNE F,CNVABS			;Forget it if abs mode (wants numerical
	POPJ P,				; value), just wanted to set up result vals.
	PUSH P,PNT
	HRRZ PNT,SYMBAS
	MOVE B,@RNGBAS			; because the compare is more @ with 3's.
	ADD B,PNT			;Blowest symbol entry in range
	MOVE C,@RNGBS1
	ADDI C,-2(PNT)			;Chighest symbol entry in range
	MOVE A,SUBRNG(A)		;A is 0 if RANGE 3, 1 if 3.

;check boundary conditions

	CAMLE B,C			;If the range doesn't exist, just
	JRST PNPOPJ			; use the number (may change).
	MOVE PV,B			;If the symbol falls outside the
	MOVE E,V			; actual range within this range
	XCT SUB1(A)			; for this program, just accept 
	JUMPLE E,BINGO			; the closest in the range
TRYHI:	MOVE PV,C			;Again, this time on high side
	MOVE E,V
	XCT SUB1(A)
	JUMPGE E,BINGO

;search out best match

GOLOOK:	MOVE E,C
	SUBI E,-2(B)			;NUMBER OF WORDS LEFT TO SEARCH OVER
	LSH E,-1			;NUMBER OF SYMBOLS LEFT TO LOOK AT
	TRZ E,1				;LIKE (E/2)*2  # WORDS TILL MIDDLE SYM
	MOVE PV,B			;BEGINNING ADDRESS OF RANGE
	JRST ADDCOM

LESS:	SUBI PV,(E)
	CAIGE PV,(B)
	MOVEI PV,(B)
BINSRC:	LSH E,-1
	TRZ E,1				;COMPUTE HALF AGAIN
	TRNN E,777776
	MOVEI E,2			;MINIMUM OF 2
	XCT CAMGE1(A)			;CA I OR M GE V,@1(PV)
	JRST LESS
	XCT CAMG3(A)			;CA I OR M G V,@3(PV)
	JRST BINGO
ADDCOM:	ADD PV,E			;ADDRESS MIDWAY FROM BEGINNING TO END
	CAILE PV,(C)
	MOVEI PV,(C)			;MAKE SURE IT'S IN THE RANGE
	JRST BINSRC

;BINGO, WCHBLK, GETRNG
;found it, find nearest symbols in same program

BINGO:	PUSH P,T
	PUSH P,PV
	MOVE T,PV
	SETZM EX
	MOVNI M,1
L3:	CAMGE PV,B			;If just prev matches, back
	JRST L1				; up to exact match
	XCT CAMLE1(A)			; of exact matches for beginning
	JRST L1
	SUBI PV,2
	JRST L3

L1:	ADDI PV,2			; symbol in same program,
	CAMLE PV,C			; give up if none
	JRST NV
	XCT MOVE3(A)			;Quit, reject if diff gets out
	SUB M,V				; of WCNT range
	MOVE E,RANGE
	XCT CAMW1(E)			;There may have been an
	JRST [	NV:	MOVNI M,1
			PUSHJ P,VALDAT	; exact match, and if there
			JRST NOUPR	; was, use it
			JRST ACCEPUP]
	PUSHJ P,VALIDATE		;Accept if possible
	JRST L1				;Not possible
	PUSHJ P,VALDAT			;Ok, but check for exact match
	JFCL				;Exact match same block
ACCEPUP:MOVEM M,UPDIF			;Store the Difference, Symbol
	MOVEM T,UPSYM			; value, block value results
	MOVEM E,UPCUR
	MOVEM PV,UPSYMP
NOUPR:	POP P,PV
	JUMPE M,ACCEPDN
	JRST .+2
L2:	SUBI PV,2			;Same sort of thing for lower.
	CAMGE PV,B
	JRST NOLWR
	XCT MOVE3(A)
	SUBM V,M
	JUMPL M,L2			;make sure that the thing we use is lower
	MOVE E,RANGE
	XCT CAMW(E)
	JRST NOLWR
	PUSHJ P,VALIDATE
	JRST L2
	JFCL				;There won't be an exact match
ACCEPDN:MOVEM M,DNDIF
	MOVEM T,DNSYM
	MOVEM E,DNCUR
	MOVEM PV,DNSYMP
NOLWR:	POP P,T
PNPOPJ:	POP P,PNT
	POPJ P,

VALIDATE:
	PUSH P,M			;PV  a symbol which is within
	MOVE T,(PV)			; printing range of V.  Accept it
	TLNE T,400000			; (skip-return with block name, etc.
	JRST MPOPJ			; if it is not half-killed, and if
	MOVEI E,0			; it is INTERNAL or in the same
	TLNN T,100000			; program.  A 0 return for block-name
	JRST ACCEP			; means no block name should be
	LDB E,[POINT 13,1(PV),12]	; printed, since symbol is in
	HLRZ M,@BLKVAL			; current nest.
	CAME E,PID
	CAMN M,PID
	JRST .+2
	JRST MPOPJ
	PUSHJ P,WCHBLK
ACCEP:	POP P,M
	JUMPN M,APOPJ			;If an exact match, and no block name
	JUMPE E,APOPJ1			; to print, use it; else if exact,
	MOVEM E,EXB			; save values for later, will use
	MOVEM PV,EX			; if no better (exact) found
	POPJ P,				; Fail for now

; Now T has the symbol, E the block name or 0, M the difference
APOPJ1:	AOS (P)
APOPJ:	AOS (P)
	POPJ P,

MPOPJ:	POP P,M
	POPJ P,

;RETURN RANGE IN A FOR VALUE IN V.  SWAP THE VALUE TO THE RIGHT HALF FOR
;CLASS 3 VALUES.
^GETRNG:MOVEI A,0			;Symbols fall into four ranges:
	TDNN V,[-1,,400000]		; 0 -- 0x<400000  >
	JRST GOTRNG			; 1 -- 400000x<1000000  >
	TLNN V,-1			; 2 -- (0 or 1), rh 18 bits=0
	AOJA A,GOTRNG			; 3 -- (0 or 1 or 2)
	TRNE V,-1			;For range 2 symbols, the value is
	AOJA A,MORRNG			; swapped in the table, so we also
	HLRZS V				; swap our input value here.
MORRNG:	ADDI A,2			;CLASSES 1-4 ARE RANGES 0-3
GOTRNG:	POPJ P,

VALDAT:	SKIPN EX
	POPJ P,
	MOVE PV,EX
	MOVE E,EXB
	MOVEI M,0
	MOVE T,(PV)
	SETZM EX
	JRST APOPJ

;WCHBLK:  CALL WITH E AS AN INDEX INTO BLOCK STRUCTURE SPACE FOR A SYMBOL
;	RETURNS E 0 IF SYMBOL IS IN CURRENT NEST, BLOCK NAME OTHERWISE

^WCHBLK:MOVE M,BID
WCH:	CAMN M,E
	JRST THISONE
	JUMPE M,NOONE		;IF GOT TO TOP THEN IT'S NOT IN THIS NEST
	HRRZ M,@BLKVL1		;GET NEXT CONTAINING BLOCK STARTING FROM BID
	JRST WCH

NOONE:	SKIPA E,@BLKNAM		;FETCH BLOCKNAME OF BLOCK THAT THE SYMBOL IS IN
THISONE:MOVEI E,0
	POPJ P,

;TABLES FOR LOG SEARCH OF SYMBOL TABLE  SUBRNG

EX:	0
EXB:	0

^SUBRNG:0
	0
	0
	1

SUB1:	SUBI E,@1(PV)
	SUB E,@1(PV)

SUB2:	SUBI M,@1(B)
	SUB M,@1(B)

MOVE1:	MOVEI M,@1(B)
	MOVE M,@1(B)

MOVE2:	MOVEI M,@1(C)
	MOVE M,@1(C)

MOVE3:	MOVEI M,@1(PV)
	MOVE M,@1(PV)

CAMG3:	CAIG V,@3(PV)
	CAMG V,@3(PV)

^^CAMG1:CAIG V,@1(PV)
	CAMG V,@1(PV)

CAML1:	CAIL V,@1(PV)
	CAML V,@1(PV)

CAME1:	CAIE V,@1(PV)
	CAME V,@1(PV)

^CAMGE1:CAIGE V,@1(PV)
	CAMGE V,@1(PV)

^CAMLE1:CAILE V,@1(PV)
	CAMLE V,@1(PV)

CAMW:	CAMLE M,WCNT
	CAMLE M,WCNT
	CAIL M,1000
	CAML M,[1000,,0]

CAMW1:	CAMLE M,WCNT+1
	CAMLE M,WCNT+1
	CAIL M,1000
	CAML M,[1000,,0]

BEND FNDSYM
^GETRNG_GETRNG
^SUBRNG_SUBRNG
^WCHBLK_WCHBLK
^CAMLE1_CAMLE1
^CAMGE1_CAMGE1

WRPSW:	0
^WRPSW_WRPSW
DNSYM: 0		;THESE MUST STAY IN ORDER
DNCUR: 0
^DNSYMP:0
UPSYM: 0
UPCUR: 0
^UPSYMP:0
UPDIF: 0
DNDIF:0
ODNSYM: 0
ODNCUR: 0
ODNSYP: 0
OUPSYM: 0
OUPCUR: 0
OUPSYP: 0
OUPDIF: 0
ODNDIF:0		;ALL THE WAY TO HERE
CURBL:0
^RANGE:0
VSAV:0
BEND SUBS

; Symlok -- SymbolValue Searcher -- Csflush

; HERE IS THE SYMVALUE SYMBOL TABLE SEARCHER
; RADIX50 FOR SYMBOL IN `SYM', SKIPS AND CONTAINS SYMBOL ENTRY IN SPNT
;   AND V IF FINDS IT, ELSE NO SKIP

^SYMLOK:PUSH P,PV
	MOVEI PV,NUMCSH-1	;FIRST, SEARCH THE CACHE OF RECENTLY SEEN
	MOVE E,SYM		; SYMBOLS, AND IF THE SYM IS FOUND, 
	CAME E,SYMCSH(PV)	; RETURN IMMEDIATELY -- GUARANTEED OK
	SOJGE PV,.-1		; BECAUSE CACHE IS FLUSHED WHENEVER IT
	JUMPL PV,SYMLK1		; MIGHT BE INVALID
	MOVE PV,SYMVAL(PV)
	JRST GOTHIM

SYMLK1:	SETZM UNIQP
	SETZM UNIQ
	SETZM GLOBB
	SETZM BESTB
	MOVE PV,SYMRNG
SYMLP:	LDB E,[POINT 32,(PV),35];GET SYMBOL WITHOUT TYPE BITS IN E
	CAME E,SYM		;SKIP IF IT MATCHES
	JRST SYML		;NO MATCH, LOOK AT MORE SYMBOLS
	MOVE E,(PV)
	TLNN E,100000		;SKIP IF NOT GLOBAL
	JRST [	HRROM PV,GLOBB
		JRST SYML]
	LDB E,[POINT 13,1(PV),12];GET BLOCK STRUCTURE POINTER FOR THIS SYMBOL
	CAMN E,PID
	JRST MAYBE		;SYMBOL IS IN THE RIGHT PROGRAM
	MOVE M,@BLKNAM		;GET BLOCK NAME OF BLOCK SYMBOL IS IN
	HLRZ V,@BLKVAL		;GET POINTER TO PROGRAM CONTAINING BLOCK SYM IS IN
	TLNE M,140000		;THE ID IS A PROG-ID IF THESE BITS ARE OFF.
	CAME V,PID
	JRST [	SKIPE UNIQP	;NOT IN RIGHT PROGRAM, SKIP IF DON'T HAVE SUCH YET
		JRST SYMLK2	;WE DO, NOT UNIQUE OUTSIDE OF CURRENT PROGRAM
		HRRZM PV,UNIQP
		JRST SYML]
MAYBE:	PUSHJ P,WCHBLK		;RETURN 0 IN E IF BLOCK IS IN CURRENT BLOCK NEST
	JUMPE E,SYMLK3		;JUMP IF THIS SYMBOL IS IN THE BLOCK NEST
	SKIPE UNIQ		;SKIP IF NO OTHER IN THIS PROG BUT NOT IN BLOCK NEST
	JRST SYMLK4		;NOT UNIQUE
	HRRZM PV,UNIQ		;ONLY ONE SO FAR IN PROG BUT NOT IN BLOCK NEST
	JRST SYML

SYMLK3:	LDB E,[POINT 13,1(PV),12];GET BLOCK STRUCTURE POINTER FOR THIS SYMBOL
	SKIPN M,BESTB		;SKIP IF THERE IS A SYM IN THE BLOCK NEST ALREADY
	JRST SYMLK6
	CAIL E,(M)		;SKIP IF NEW ONE IS BETTER THAN PREVIOUS ONE
	JRST SYML
SYMLK6:	HRLI E,(PV)
	MOVSM E,BESTB
	JRST SYML

SYMLK2:	HRROS UNIQP
	JRST SYML

SYMLK4:	HRROS UNIQ
SYML:	ADD PV,[2,,2]
SYML1:	JUMPL PV,SYMLP
	SKIPN PV,BESTB		;SKIP IF THERE WAS ONE IN THE CURRENT BLOCK NEST
	SKIPE PV,GLOBB		;SKIP IF THERE WAS NONE AND NO GLOBAL EITHER
	JRST GOTSYM		;USE IT
	SKIPN PV,UNIQ		;SKIP IF THERE IS ONE IN THIS PROG NOT IN BLOCK NEST
	SKIPE PV,UNIQP		;SKIP IF NON IN THIS PROG OR ANY PROG
	JRST SYMLK5		;FOUND IN SOME PROG NOT IN CURRENT BLOCK NEST
PNONE:	POP P,PV
NONE:
IFN EXDSW,<PUSHJ P,IOFNDI>	;FIND AS I/O DEV. NAME
	TLOA F,SYMF!SCFL!UNDF	;NOT FOUND
	TLO F,NUMF!SYMF!SCFL	;FOUND
^CPOPJ:	POPJ P,

SYMLK5:	JUMPGE PV,GOTSYM
	TLO F,PMULFL		;MULTIPLY DEFINED, MARK AS SUCH.
	MOVEI E,.MUL
	HRLM E,NBIGWD
GOTSYM:	SOSGE E,SCSHPT		;STORE THE NEW-FOUND SYMBOL NAME AND POINTER
	MOVEI E,NUMCSH-1	; IN THE CACHE (CIRCULAR)
	MOVEM E,SCSHPT
	MOVE M,SYM
	MOVEM M,SYMCSH(E)
	HRRZM PV,SYMVAL(E)
GOTHIM:	HRRZS PV		;ADDR IN SYM TABLE OF SYMBOL (MAYBE FOUND IN CACHE)
	PUSH P,PNT		;PNT IS IN THE INDEX FIELD OF CLASS 4 VALUES
	HRRZ PNT,SYMBAS		;ADDRESS OF BEGINNING OF SYMBOL TABLE
	MOVE V,PV		;ADDRESS OF SYMBOL
	SUB V,PNT		;RELATIVE ADDRESS OF SYMBOL
	MOVEI E,@1(PV)		;GET VALUE (OR ADDRESS OF VALUE FOR CLASS 4)
	MOVE M,RNGBAS		;GET ADDRESS OF RELATIVE POINTERS TO SYM CLASSES
	CAML V,2(M)		;SKIP IF CLASS1 OR CLASS2 (RH VALUES)
	MOVSS E			;CLASS 3 VALUES ARE LEFT HALF ONLY VALUES
	CAML V,3(M)		;SKIP IF CLASS 1, 2 OR 3 (NOT 36 BIT VALUES)
	MOVE E,@1(PV)		;GET 36 BIT VALUE
	POP P,PNT
	MOVE V,PV		;ADDRESS OF SYMBOL
	POP P,PV
SYMDOT:	MOVEM E,NM		;SAVE VALUE FOR LATER USE.
	MOVEM V,SYMP		;SAVE POINTER TOO.
	TLO F,NUMF!SYMF!SCFL	;SET FLAGS
ITCHK:	CAIN C,"."		;IS AHEAD CHAR <CTRL1>`.'?
	CAIE B,1
	POPJ P,			; NO
	TLZ F,SCFL		;NOT AHEAD ANY MORE
	SETZM SAVMOD		;DON'T USE ANY INPUT-DRIVEN MODE
	JSR FNDSCR		;ON SCREEN?
	JRST [	HLRZ M,(M)
		TLZ M,400037 	;CLEAR NON-MODE BITS
		LSH M,-5	;IN SAVMOD FORMAT
		TLNN F1,FIRF 	;FIRST THING?
		HRRM M,SAVMOD 	;YES, USE THIS MODE
		JRST .+1]
	JRST ITD1		;USE CONTENTS OF THAT CELL
	POPJ P,

; FLUSH ALL CACHES, SOMETHING DRASTIC HAS CHANGED

^CSFLUSH:
	SETOM SYMCSH		;SET TO RIDICULOUS VALUE
	MOVE E,[SYMCSH,,SYMCSH+1]
	BLT E,CSHEND		;CLEAR ALL TO -1
	POPJ P,

;Prgfnd, Prgset, Blkfnd, Blkfn

^PRGFND:PUSHJ P,CSFLUSH		;FLUSH ALL CACHES
	TLNN F1,SINGF		;SINGLE SYMBOL?
	JRST CERR		;NO
	MOVEI E,0
	MOVE M,SYM
CPRG:	CAMN M,@BLKNAM
	JRST HERE
	HLRZ E,@BLKVAL
	JUMPN E,CPRG
	JRST PU

HERE:	MOVEM E,PID
	MOVEM E,BID
	PUSHJ P,BLFND		;SEARCH FOR BLOCK WHOSE NAME IS IN SYM
	JFCL
	MOVE E,BID
	JRST INSBLK

^PRGSET:
IFE UESW,<
	MOVEI E,0
	JRST CPRG2

CPRG1:	HLRZ E,@BLKVAL
	JUMPE E,CPRG3
CPRG2:	MOVE M,@BLKNAM
	CAME M,[RADIX50 0,RAID]
	CAMN M,[RADIX50 0,JOBDDT]
	JRST CPRG1		;DON'T USE EITHER OF THESE PROGS
CPRG3:	MOVE M,@BLKNAM		;GET PROG NAME AND STORE IN SYM FOR
	MOVEM M,SYM		;BLFND TO FIND
	JRST HERE
>;NOT UESW
IFN UESW,<POPJ	P,>

^BLKFN:	PUSHJ P,CSFLUSH		;FLUSH ALL CACHES
	PUSHJ P,BLKFND

; INSERT PROG/BLOCK PAIR IN BUFFER FOR QUICK REFERENCE (CTRL-Z)

INSBLK:	SKIPGE T,REFPNT		;FIRST, IF THERE IS A LIST YET,
	JRST INSIT		; LOOK IN IT FOR A MATCH
	CAIE T,NUMREF-1		;FULL?
	JRST CAMIT
	MOVE M,[BLKREF+3,,BLKREF]	;REMOVE THE OLDEST 3
	BLT M,BLKREF+NUMREF-4
	SUBI T,3
	MOVEM T,REFPNT
CAMIT:	CAME E,BLKREF(T)	;WHEREVER IT IS, AND REPLACE
	SOJGE T,.-1		; IT AT THE TOP OF THE "STACK"
	JUMPL T,INSIT

; E is block ID to be inserted in list.
; T  block ID index to be removed.

^ZAPIT:	CAMN T,REFPNT
	JRST INSIT1
	MOVE M,BLKREF+1(T)
	MOVEM M,BLKREF(T)
	AOJA T,ZAPIT
INSIT:	AOS T,REFPNT
INSIT1:	HRRZM E,BLKREF(T)
	POPJ P,


^BLKFND:TLNN F1,SINGF	;SINGLE SYMBOL?
	JRST BLKTHS	;NO
	PUSHJ P,BLFND	;FIND
	JRST PU
	POPJ P,

BLKTHS:	HRRZ V,LOCOP
	PUSHJ P,FNDSYM
	PUSHJ P,ADSEL
	 JRST CERR		;NO SYMBOL BEING SHOWN FOR . ANYWAY
	 SKIPA E,DNSYMP		;DNSYM IS THE WINNER
	 MOVE E,UPSYMP		;UPSYM IS THE WINNER
	JUMPE E,CERR
	LDB E,[POINT 13,1(E),12];GET BLOCK STRUCTURE INDEX OF THIS SYMBOL
	JRST SETBL

; Open the block containing the last symbol typed.
;BLKTHS:TLNN F1,VALF		;If there is a value, it's a bug
;	SKIPN E,SYMP		;If no symbols yet, a bug
;	JRST CERR
;	LDB E,[POINT 13,1(E),12]
;	JRST SETBL	

;SEARCH THE BLOCK STRUCTURE TABLE FOR THE BLOCK WHOSE NAME IS IN SYM.
;IF IT IS FOUND IN THE CURRENT PROGRAM, THEN PUT ITS INDEX IN BID AND
;SKIP RETURN.  IF NOT, THEN SEARCH THE ENTIRE TABLE, AND IF A UNIQUE
;BLOCK NAME IS FOUND, SET PID AND BID TO THE PROGRAM AND BLOCK INDICES
;RESPECTIVELY AND SKIP RETURN.  IF IT IS NOT FOUND ANYWHERE, THEN TAKE
;THE DIRECT RETURN.
BLFND:	MOVE E,PID		;FIRST SEARCH THE BLOCKS IN
	MOVEI V,0		;THE CURRENTLY OPEN PROGRAM (V=0 IS FLAG)
	SETOM UNIQ
	HLRZ M,@BLKVAL		;GET THE INDEX OF THE NEXT PROGRAM (OR ZERO)
	JUMPN M,BLF1
BLF:	MOVE M,BLKSIZ	
BLF1:	SUBM E,M
	HRL E,M			;E IS -COUNT-1,,BID CANDIDATE-1
	MOVE M,SYM		;M IS RADIX50 14,BLOCKNAME
	TLOA M,140000
BFLUP:	CAME M,@BLKNAM		;SEARCH THE ENTIRE RANGE UNTIL
BFL1:	AOBJN E,BFLUP		; A MATCH IS FOUND OR THE RANGE IS EXHAUSTED
	JUMPGE E,BLNOP1		;IF THE RANGE IS EXHAUSTED, CHECK FOR MORE.
	JUMPE V,GOTIT1		;IF V IS STILL 0, FOUND IN OWN PROG, ACCEPT.
	SKIPL UNIQ		;OTHERWISE, WE'RE SEARCHING THE REST, AND
	JRST BLNOPE		; IT IS REQUIRED THAT THERE BE A UNIQUE
	HRRZM E,UNIQ		; BLOCK OF THAT NAME SOMEWHERE, OR GIVE UP.
	JRST BFL1

GOTIT1:	HRRZM E,BID		;ACCEPT THE BLOCK, OPEN IT, REPORT SUCCESS.
	AOS (P)
BLNOPE:	POPJ P,			;COME HERE TO RETURN UNSUCCESSFUL.

BLNOP1:	JUMPN V,CKNOPE		;WHEN THE RANGE IS EXHAUSTED, IF ONLY THE
	MOVEI E,0		; CURRENT PROGRAM HAS BEEN SEARCHED, DO ALL OF THEM
	AOJA V,BLF

CKNOPE:	SKIPGE E,UNIQ		;OTHERWISE, IF A UNIQUE BLOCK NAME WAS FOUND
	JRST BLNOPE		; SOMEWHERE, USE IT, AND MAKE SURE THAT ITS
^SETBL:	MOVE M,@BLKNAM		; PROGRAM IS ALSO OPEN.
	TLNN M,140000		;THE CANONICAL PROGRAM NOT BLOCK TEST
	SKIPA M,E
	HLRZ M,@BLKVAL
	HRRZM M,PID		;RESET PROG ID.
	JRST GOTIT1		; AND ACCEPT
>;SORTED (BEGAN ON PAGE 49)

;Raid, Eret, Main, Inerr, Cerr, Pu, Unpur -- Main Loop, Dispatcher
BEGIN MAIN -- THIS HERE IS RAID
IFN REALSW,<
	RPTCNT
	BEGDDT
	DDTEND
	$C
	$I
	$1B
>;REALSW
IFE REALSW,<000000>
	$IO
	$M
IFN REALSW,<
	$RBP
	$SBP			;GIVE USER ACCESS TO THINGS
>;REALSW
IFE REALSW,<00>
IFN REALSW,<
INTERNAL DDT
DDT:
>;REALSW

^RAID:	SETZM OACSW#
	SKIPE ACSW
	SETOM OACSW		;SAVE OLD STATE OF ACSW
	MOVEM P,RAC+P
	MOVE P,[-PDLEN,,PDL-1]
	EXCH P,RAC+P
	JSR RACGT		;GET RAID ACS
	JSR ONCE		;FIRST TIME STUFF, IF NECESSARY
	AND F,[LOCOPF,,0]	;CLEAR MOST BITS
IFE FILESW,<
IFE UESW,<
IFE TENEX,<
	SKIPE OACSW		;DON'T DO THIS IF WE ALREADY WERE IN RAID
	JRST IGNOPC
	MOVE V,JOBOPC		;SIMULATE BREAKPOINT
	MOVEI M,(V)
	CAIGE M,ENDDT		;BUT AVOID USING PC FROM INSIDE RAID
	CAIGE M,BEGDDT
	MOVEM V,BRKJSR
>;NOT TENEX
IGNOPC:	TRO F,ISOPC		;INDICATE SPECIAL NATURE OF BREAK
	JRST DOBRK		;GO HAVE A BREAKPOINT
>>
^E1RET:	TRO F,DRWALL		;REFRESH DISPLAY, SOMETHING GLITCHED.
^ERET:	MOVE P,[-PDLEN,,PDL-1]
	TLZ F,SCFL!EHDF
	TRZ F,BYTSW!ISOPC
IFE FILESW,<
IFE UESW,<
	SETZM MSTSW1
	SETZM MSTSW2	>>

^MAIN:	SETZM SAVMOD	        ;IF THERE WAS A SUPER-TEMPORARY MODE...
^MAIN1:	SETZM STSAV		;CLEAR EXTENDED ASCII BP
	SETACT [BRKTAB]		;SET RAID'S SPECIAL BREAK TABLE
	MOVEI M,1		;SHIFT STATUS BACK AND FORTH TO INDICATE DONE
	SKIPE DDSW		; EXCEPT ON TTY,
	XORM M,NBIGWD
	PUSHJ P,REDISP
	SETLIN RADLIN		;SET TO SPECIAL ACTIVATION MODE
IFE STANFO,<
	SETZM INBP		;CLEAR STANFORD SIMULATION BUFFER
>;STANFO
	PUSHJ P,EVAL		;GET SOMETHING
	TLNE F,VALF		;VALUE?
	JRST VALFIR		;YES
	MOVEI F1,0
LOP3:	MOVEI V,1
	LSH V,(B)		;GET UNIQUE SET OF BITS FOR BUCKY BITS
	MOVE T,TABLEN		;GET CURRENT LENGTH
LOP1:	LDB M,[POINT 7,CTAB(T),13];GET CHR.
	CAMN C,M		;IS THE CHARACTER THE SAME?
	JRST FOUND		;YES
^CDCONT:
LOP2:	SOJGE T,LOP1		;NO, LOOP
	JRST CERR		;NOT FOUND, ERROR

FOUND:	HLRZ M,CTAB(T)		;GET BUCKY MASK
	AND M,V			;AND WITH BUCKY BITS
	JUMPE M,LOP2		;NOT ALLOWED, TRY AGAIN
	MOVE M,CTAB(T)		;GET DISPATCH
	PUSHJ P,(M)
	JRST MAIN

VALFIR:	MOVEM V,VALUE		;SAVE VALUE
	MOVE F1,F		;SAVE FLAGS
	PUSHJ P,EVAL		;GET NEXT THING
	TLNE F,VALF		;VALUE?
	JRST CERR		;YES, ERROR
	JRST LOP3

^ZPU:	SETZM SYM		;NO NAME KNOWN
^PU:
IFN TENEX,<
	MOVEI A,100		;PRIMARY INPUT
	CBIBF			;CLEAR
>;TENEX
IFE TENEX,<CLRBFI>		;DEC CLEAR
	SETZM STRIN
	MOVEI V,.UND
	TLOA F,PUFL		;SET BADDDDD FLAG
^INERR:
^CERR:	MOVEI V,.HUH
	HRLM V,NBIGWD
	JRST ERET

^UNPUR:	UNPURE
	JRST UNPUR1
	POPJ P,

UNPUR1:
;	MOVEI T,0
;	SETUWP T,
	SKIPA T,[.PURE]
	POPJ P,
	HRLM T,NBIGWD
	JRST ERET

;  Ctab -- Dispatch Table
; COMMENT COMMAND DISPATCH TABLE

DEFINE CT (CHR,MASK,ADDRS)
<"CHR"*20+MASK,,ADDRS>

DEFINE CTT (V,CHR)
<V14+"CHR"*20+16,,MODSET>


^TABLEN:0			;CTABLEN+<NUMBER OF MACROS>
^CTAB:
CT(M,2,MACDEF)			;M -- DEFINE MACRO
CT(M,4,MACIMM)			;M -- IMMEDIATE MACRO
IFE FILESW,<
IFE UESW,<CT(Y,10,YXEQ)>	;Y -- EXECUTE DIRECT
>
CTT(BTP,Q)			;Q -- BYTE POINTER MODE
CT(L,16,LFTT)			;L -- E AS LEFT-HALF BITS MODE
CT(R,16,RFTT)			;R -- E AS RIGHT-HALF BITS MODE
CT(J,16,FLGMOD)			;J -- W AS BITS MODE
CT(V,16,BYTMOD)			;V -- BYTE MODE
CT(U,16,UMODST)			;U -- E AS CHARACTER MODE
IFE FILESW,<
IFE UESW,<CT(S,10,MSTEP)>	;S -- MULTIPLE-STEP
>
CT(I,2,INCR)			;I -- INCREASE # SCREEN ENTRIES
CT(I,4,SCLR)			;I -- ZERO ALL SCREEN ENTRIES
CT(I,10,SCLRSV)			;I -- ZERO ALL UNPROTECTED ENTRIES
IFE FILESW,<
IFE UESW,<CT(X,10,XEQ3)>	;X -- EXECUTE SIMULATING
>
IFN STANFO,<
IFE UESW,<CT(E,10,LEAVE)>	;E -- EXIT (LIKE EXITY)
CT(,1,EQIV)			;  -- VALUE OF EXPRESSION REQUEST
CT(,1,LB1)			;  -- SET TEMP LOWER SEARCH BOUND
CT(,2,LB2)			; -- PERMANENT LOWER SEARCH BOUND
CT(,1,RB1)			;  -- TEMP UPPER SEARCH BOUND
CT(,2,RB2)			; -- PERMANENT UPPER SEARCH BOUND
CT(,1,SRCON)			;  -- CONTINUE SEARCH
CT(,1,SRCON)			;  -- CONTINUE SEARCH
>;STANFO
IFE STANFO,<
CT(,173*20+1,LB1		;   -- SET TEMP LOWER SEARCH BOUND
CT(,173*20+2,LB2)		;  -- PERMANENT LOWER
CT(,175*20+1,RB1)
CT(,175*20+1,RB2)		;SIMILARLY, UPPER BOUND
CT($,1,SRCON)			;  $, CONTINUE SEARCH
>;NOT STANFORD
CT(K,2,SYMKIL)			;K -- KILL SYMBOL
IFN SORTED,<
CT(:,10,REVIVE)			;: -- REVIVE KILLED SYMBOL
>;SORTED
CT(K,4,SYMNIL)			;K -- ANNIHILATE SYMBOL
CT(Z,4,REFCLR)			;Z -- ZERO ALL BLOCK RECORDS
CT(Z,2,REFBLK)			;Z -- OPEN SOME RECORDED BLOCK
IFE FILESW,<
IFE UESW,<CT(S,4,STEPP)>	;S -- SINGLE-STEP, STARTING HERE
>
CT(W,2,WDSRCH)			;W -- SEARCH FOR WORD
CT(E,2,ESRCH)			;E -- SEARCH FOR EFFECTIVE ADDRESS
CT(N,2,NWDSR)			;N -- SEARCH FOR WORD
CT(_,1,SYMDEF)			; _ -- DEFINE SYMBOL=VALUE
CT(:,1,SYMDF1)			; : -- DEFINE SYMBOL=.
CT(D,16,NMDST)			;D -- DECIMAL MODE
CT(A,16,AMODST)			;A -- ABSOLUTE MODE
IFE FILESW,<
IFE UESW,<CT(B,2,BRKPLN)	;B -- PLANT BREAKPOINT
	CT(B,4,BRKREM)		;B -- REMOVE BREAKPOINT
	CT(P,4,TBPROC)		;P -- PROCEED TO TEMP BREAKPOINT AT .
	CT(P,2,PROCED)		;P -- PROCEED TO NEXT BREAKPOINT
>>
CT(:,2,PRGFND)			;: -- NEW PROGRAM NAME
CT(&,2,BLKFN)			;& -- NEW BLOCK NAME
CT(=,2,EQIV)			;= -- VALUE OF EXPRESSION REQUEST
CT(@,2,ATSIN2)			;@ --  TO @EFFECTIVE ADDRESS OF 
CT(@,4,ATSIN4)			;@ -- . TO @EFFECTIVE ADDRESS OF 
CT(@,10,ATSIN1)			;@ -- FREEZE , EFFECTIVE ADDRESS OF 
CT(<[>,4,TAB)			;[ -- . TO  @RH ADDRESS OF 
CT(<[>,2,LEFSQ2)		;[ --  TO @RH ADDRESS OF 
CT(<[>,10,LEFSQ1)		;[ -- FREEZE , @RH ADDRESS OF 
CT(<]>,2,RITSQ2)		;] --  TO @LH ADDRESS OF 
CT(<]>,4,RITSQ4)		;] -- . TO @LH ADDRESS OF 
CT(<]>,10,RITSQ1)		;] -- FREEZE , @LH ADDRESS OF 
IFN STANFO,<
CT(E,4,EDIT)			;E -- EDIT ., REPLACE IT
>;STANFORD
CT(	,1,TAB)			;TAB-- . TO @RH ADDRESS OF 
CT(;,4,REMPER)			;; -- UNFREEZE . OR SPECIFIED ADDR
CT(;,2,OPENP)			;; -- FREEZE . OR SPECIFIED ADDR
CTT(HLF,H)			;H -- HALF-WORD MODE
CT(T,16,TMDST)			;T -- CHARACTER MODE (ASC, SIXB, RAD50)
CTT(CYM,C)			;C -- CYMBOLIC MODE
CTT(OCL,O)			;O -- OCTAL MODE
CTT(FLG,F)			;F -- FLOATING POINT MODE
IFE FILESW,<
IFE UESW,<CT(G,16,GOGOGO)>	;G -- RELEASE CONTROL AT @JOBSA OR SPECIFIED ADDR
IFE UESW,< CT(X,4,XEQ2)		;X -- START SINGLE-EXECUTION HERE
	CT(_,2,LEFFND)		;_ -- . TO x
>>
CT(,15*20+17,DEPO)		;CR -- DEPOSIT VALUE
IFE FILESW,<
IFE UESW,<CT(X,2,XEQ1)		;X -- SINGLE-EXECUTE ONCE FROM .
	CT(S,2,STEPPE)		;S -- SINGLE-STEP ONCE FROM .
>>
IFN FILESW,<
CT(S,2,SETIO)			;S -- IN FRAID SET $IO TO -1
CT(S,4,CLRIO)			;S -- IN FRAID SET $IO TO 0
>;FILESW
XWD "<"*20+5,UPAR		; < -- MOVE UP ONE, FROM .
XWD ">"*20+5,LNFD		; > -- MOVE DOWN ONE, FROM .
XWD "<"*20+12,MOVUP		;< -- MOVE UP ONE, ON SCREEN
XWD ">"*20+12,MOVDN		;> -- MOVE DOWN ONE, ON SCREEN
CT(,"\"*20+17,BSSET)		;\  -- EQUIV TO <
CT(,12*20+17,LFSET)		;LF -- EQUIV TO >
CT(;,1,OPENS)			; ; --  TO @RH , OR . TO SPECIFIED ADDR
^CTABCN__.-CTAB-1
^CTAB1: BLOCK	20		;MACRO SPECS
^MACLOC:BLOCK	20

BEND MAIN

; Modset, Tmdst, Amodst, Nmdst, Umodst, Bytmod, Flgmod, Lftt, Rftt
BEGIN ROUTS -- THESE ARE THE ROUTINES DISPATCHED TO

^MODSET:LDB V,[POINT 6,M,5]	;GET MODE
MODSE1:	LSH V,5			;ADJUST
MDGO:	HRLS V
	SETZM SAVMOD		;DON'T USE TEMP MODE IF CHANGING MODE
	LDB M,[POINT 12,V,30]
	XCT MODTB-1(B)		;PUT IN CORRECT PLACE (B HAS BUCKY COUNT)
	POPJ P,			;LEAVE

MODTB:	DPB M,[POINT 12,(PNT),12];SET MODE FOR THIS ONE
	HRRM V,CURMOD		;SET CURRENT MODE
	MOVEM V,CURMOD		;SET PERMANENT MODE

^TMDST:	TLNE F1,VALF		;VALUE TYPED?
	SKIPA V,VALUE		;YES, GET IT
	MOVEI V,7		;NO   (TXT=5)
	CAIG V,7
	CAIG V,4
	JRST CERR
	JRST MODSE1

^AMODST:MOVE M,CURMOD
	HRLI M,405
	TRO M,405
	MOVEI V,1
	XCT AMODTB-1(B)		;B HAS BUCKY COUNT
	POPJ P,

AMODTB:	DPB V,[POINT 1,(PNT),7]
	HRRM M,CURMOD
	IORM M,CURMOD

^NMDST:	MOVEI V,DCM5		;DECIMAL MODE
	TLNE F1,VALF		;VALUE TYPED?
	MOVEI V,OCL15		;YES, OCATL
	JRST MDGO

^UMODST:TLNE F1,VALF		;VALUE?
	SKIPA V,VALUE		;YES,GET IT
	MOVEI V,7		;NO
	CAIG V,7
	CAIG V,4
	JRST CERR
	ADDI V,6		;UTX=13 
	JRST MODSE1

^BYTMOD:TLNN F1,VALF
	JRST CERR
	MOVE V,VALUE
	ANDI V,77
	LSH V,13
	ADDI V,BYT5
	JRST MDGO

^FLGMOD:MOVEI M,BTS5	;THE MODE BITS
COMFLG:	TLNN F1,VALF	;VALUE TYPED?
	TDZA V,V	;NO SET ZERO
	MOVE V,VALUE	;ELSE USE TYPE VALUE
	ANDI V,77
	LSH V,13	;PACK AWAY
	ADD V,M		;AND PUT IN MODE BITS
	JRST MDGO	;GO GO

^RFTT:	MOVEI M,RBT5
	JRST COMFLG

^LFTT:	MOVEI M,LBT5
	JRST COMFLG

;Depo1, Echk

DEPO1:	TLNE F,LOCOPF		;LOCATION OPEN?
	TLNN F1,VALF		;VALUE?
	POPJ P,			;JUST QUIT
	SKIPE E,SAVMOD		;SPECIAL MODE FOR THIS THING?
	DPB E,[POINT 7,(PNT),12];YES, CHANGE MODE FOR THIS LINE
	LSH E,-6		;IF V, THIS  IS BYTE SIZE
	JUMPE E,.+2
	DPB E,[POINT 6,(PNT),6]	;PUT THERE
	SETZM SAVMOD		;FOR GRINS
	HRRZ E,LOCOP
	JSR ECHK
	MOVE V,VALUE	;GET VALUE
IFE UESW,<
IFE FILESW,<
	CAIG E,@JOBREL
IFN SEGSW,<
	JRST .+3
	SKIPGE JOBHRL
	PUSHJ P,UNPUR
>
IFE SEGSW,<
	JRST .+2
	JRST CERR
>
	MOVEM V,(E)	;DEPOSIT
>;NOT FILESW
IFN FILESW,<
	PUSHJ P,RDTRKE		;READ IN TRACK THAT CONTAINS E
	MOVEM V,@TRKOFF
	PUSHJ P,WRTRK		;WRITE IT BACK OUT
>
>;END NOT UESW
			IFN UESW,<	MOVEM V,SSS1#
					MOVEM E,SSS2#
					SETZM SSS3#
					MOVE V,[XWD 400001,SSSDO]
					CALL V,[SIXBIT /SPCWGO/]
					SKIPN SSS3
					JRST .-1
					TNOFFS
					MOVE V,SSS1>
	POPJ P,
			IFN UESW,<	SSSDO:	SKIPE SSS3
					0
					HRLI 2,-1
					DATAO 2
					MOVN 3,2
					ADD 3,SSS2
					MOVE 4,SSS1
					MOVEM 4,(3)
					SETOM SSS3
					0>

^ECHK:	0
IFE FILESW,<
IFE UESW,<
	CAIG E,17	;AC?
	ADDI E,JAC	;YES
	CAMLE E,JOBREL	;TOO BIG?
IFE SEGSW,<
	JRST CERR 	;YES
>
IFN SEGSW,<
	JRST [	CAIL E,400000
		CAILE E,@JOBHRL
		JRST CERR
		JRST @ECHK]
>
	JRST @ECHK
>;END NOT UESW
>;END NOT FILESW

IFN FILESW,<
	SKIPE DMPFSW
	JRST ECHKD1		;DUMP FILE
	CAMLE E,FILLST
	JRST CERR
	JRST @ECHK

ECHKD1:	CAIL E,74
	CAMLE E,FJBHRL
	JRST CERR
	CAMLE E,FJBREL
	CAML E,UPPRST
	JRST @ECHK
	JRST CERR
>;FILESW

IFE SORTED,<
; Refblk, Refclr, Refrst, Frepopj

; GET BACK A PREVIOUS PROG/BLOCK PAIR (nCTRL1-Z, n=1 DEFAULT)

^REFBLK: TLNE	F1,VALF		;WAS A VALUE TYPED?
	SKIPA	D1,VALUE	;YES, USE IT
	 MOVEI	D1,1		;NO, USE LAST PROG/BLOCK USED
	ADD	D1,REFGET	;OFFSET FROM LAST ENTERED
	MOVMS	D1
	IDIVI	D1,NUMREF	;GET MOD
REFDSP:	SKIPN	E,PRGREF(D2)	;GET PROGRAM POINTER
	JRST	CERR		;NONE THERE
	MOVEM	D2,REFGET	;CURRENT GETTER
	MOVEM	E,SYMPRG	;UPDATE THIS
	MOVE	E,BLKREF(D2)	;GET BLOCK POINTER
	MOVEM	E,SYMPNT
^FREPOPJ:TRO	F,DPYALL	;START FROM SCRATCH
	POPJ	P,		;REFRESH THE SCREEN, USE NEW BLOCK

;GET HERE WHEN SOMETHING GROSS BEFALLS THE SYMBOL TABLE
^SYMRST:MOVSI F1,SINGF
	MOVE T,PRGSAV
	MOVEM T,SYM
	PUSHJ P,PRGFND
	MOVE T,BLKSAV
	TLZ T,740000
	PUSHJ P,BLKFND
;CTRL2-Z -- clears block reference history, enters current block

^REFCLR:SETZM PRGREF
	MOVE E,[PRGREF,,PRGREF+1]
	BLT E,BLKREF+NUMREF-1
	SETZM REFGET
	SETZM REFPNT
	JRST INSBLK		;GO INSERT CURRENT IN BUFFER

>;NOT SORTED

IFN SORTED,<
; Refblk, Refclr

;GET BACK A PREVIOUS PROG/BLOCK PAIR (nCTRL1-Z, n=1 default)

^REFBLK:SKIPGE REFPNT		;THERE MUST BE SOMETHING OPEN
	JRST CERR
	TLNN F1,VALF		;WAS A VALUE TYPED?
	SKIPA T,[-1]		;NO
	MOVN T,VALUE		;YES, USE IT
	ADD T,REFPNT		;OFFSET FROM LAST ENTERED
	JUMPGE T,.+2
	MOVEI T,0		;TOO LARGE YIELDS BOTTOM OF STACK
	HRRZ E,BLKREF(T)	;USE THIS BLOCK ID
	PUSHJ P,SETBL		;MAKE SURE ITS PROGRAM IS OPEN
	JFCL			; (SKIP-RETURNS)
	PUSHJ P,ZAPIT		;REMOVE AND RE-INSERT AT TOP
	JRST FREPOPJ		;MARK COMPLETE REDISPLAY AND QUIT

;CTRL2-Z -- CLEARS BLOCK REFERENCE HISTORY, ENTERS CURRENT BLOCK

^REFCLR:SETZM BLKREF
	MOVE E,[BLKREF,,BLKREF+1]
	BLT E,BLKREF+NUMREF-1
	SETOM REFPNT
	MOVE E,BID
	JRST INSBLK		;GO INSERT CURRENT IN BUFFER
>;SORTED

; Depo, Opens, Openu, Fndscr, Openp -- Open a Cell (see if it's there)

^DEPO:	SKIPN E,STSAV		;WAS MULTI-WORD ASCII INDICATED?
	JRST DPO11		; NO
	MOVEM E,STRIN		;YES, LET RAID READ THIS WEIRD STRING
	JRST MAIN		;FROM THE TOP

DPO11:	PUSHJ P,DEPO1
	HLRS CURMOD		;RESET MODE
	POPJ P,

^OPENS:	TLNE F1,VALF		;VALUE TYPED?
	JRST SOPENS		;YES
	TRO F1,1		;NO, SET FLAG
	HRRZ E,(PNT)		;GET CURRENT ADDRS
	JSR ECHK
IFE UESW,<
IFE FILESW,<	MOVE E,(E)	>
IFN FILESW,<
	PUSHJ P,RDTRKE		;READ IN THE TRACK THAT CONTAINS E
	MOVE E,@TRKOFF
>
>
			IFN UESW,<	MO (E,E)>
OPENU:	MOVEM E,VALUE
SOPENS:	MOVEI T,0		;400000,, BIT ON FOR PERMANENT
OPENQ:	HRRZ E,VALUE		;GET VALUE
	JSR FNDSCR		;ON SCREEN? (ALSO SETS `M' TO POINT TO THE LINE)
	JRST PNT2		; YES
PNT4:	TLO F,LOCOPF 		;LOCATION OPEN
	AOBJN PNT,PNT1 		;GO TO NEXT, AT END?
	TLNE PNT,7		;NOT REALLY AT END?
PNT9:	MOVS PNT,SPNT		;AT END,GET START POINTER
PNT1:	SKIPL (PNT)		;PERMANENT?
	JRST GOTIT		;NO
	JUMPGE PNT,PNT99	;AT LAST ONE?
	MOVE E,PNT		;GET POINTER
	SKIPGE 1(E)		;NEXT ONE PERMANENT?
	AOBJN E,.-1		;YES, TRY AGAIN
	JUMPGE E,[ PNT99:  TRON F1,2
			   JRST PNT9
			   JRST CERR]
	HRRZS E
LOP1:	MOVE V,(E)		;FOUND ONE, SHUFFLE DOWN
	MOVEM V,1(E)
	TLNN V,20		;DOES SOMEONE POINT HERE?
	JRST NOPONT		;NO
	MOVS D2,SPNT		;GET POINTER FOR SEARCH
LOP2:	MOVE D3,(D2)
	TLNN D3,17		;IS THIS A POINT TYPE THING?
	JRST NOLOP1		;NO
	CAIN E,(D3)		;DOES THIS POINT TO IT?
	AOS (D2)		;YES, UPDATE
NOLOP1:	AOBJN D2,LOP2		;LOOP
	TLNN D2,7
	JRST LOP2
NOPONT:	CAIE E,(PNT)		;BACK TO START?
	SOJA E,LOP1		;NO
GOTIT:	MOVE E,VALUE		;GET LOCATION
	HRL E,CURMOD		;GET CURRENT MODE
	MOVEM E,(PNT)		;DEPOSIT
	TRZN F1,1
	HRRZM E,LOCOP
OPNTP:	IORM T,(PNT)		;MARK AS PERMANENT
	POPJ P,

PNT2:	MOVE PNT,M
	TLO F,LOCOPF
	IORM T,(PNT)
	HRRZ E,(PNT)
	TRZN F1,1
	MOVEM E,LOCOP
	POPJ P,

^FNDSCR: 0
	MOVS M,SPNT	;GET START POINTER
PNT3:	SKIPN D2,(M)	;DONE?
	JRST PNT44	;YES
	TLZ D2,777760
	CAMN E,D2	;SAME?
	JRST @FNDSCR	;YES
	AOBJN M,PNT3	;LOOP, AT END?
	TLNN M,7	;REALLY AT END?
	JRST PNT3	;NO
PNT44:	AOS FNDSCR	;SKIP ROUTINE, FIND
	JRST @FNDSCR

^OPENP:	MOVSI T,400000
	TLNE F1,-1	;A VALUE TYPED IN?
	JRST OPENQ	;YES
	MOVS E,SPNT
	CAML PNT,E	;BLANK SCREEN?
	JRST OPNTP	;NO
	POPJ P,		;YES, DO NOTHING

^BSSET:	SKIPA C,["<"]
^LFSET:	MOVEI C,">"
	SUB P,[1,,1]
	JRST CDCONT

; Macdef, Macexp, Macimm -- Define and Expand Macros

^MACDEF:TLNN F1,VALF			;THERE MUST BE AN ADDRESS
	JRST CERR			; THERE ISN'T
IFE TENEX,<
	MOVE T,[INCHRW C]		;ONE CHAR
>
IFN TENEX,<
	MOVE T,[^BIN1:	PUSHJ P,[PBIN
				 MOVE C,1
				 POPJ P,]	]
>
	EXCH T,TYII
	PUSHJ P,GCHRS
	MOVEM T,TYII			;HAVE A CHARACTER
	LSH C,4				;PREPARE DISPATCH TABLE ENTRY
	TRO C,10			;DOUBLE-BUCKY CHARACTER FOR MACRO
	HRLI C,MACEXP			;ROUTINE WHICH EXPANDS MACROS
	AOS T,TABLEN			;GET A NEW ENTRY
	CAIG T,CTABCN+20		;IS THERE ROOM?
	JRST OKMAC			; YES, ENTER IT
IFE TENEX,<
	OUTSTR [ASCIZ /TOO MANY MACROS /]
>
IFN TENEX,<
	HRROI A,[ASCIZ /TOO MANY MACROS /]
	PSOUT
>
	SOS TABLEN
	JRST CERR			;GO COMPLAIN
OKMAC:	MOVSM C,CTAB(T)			;A NEW DISPATCH ENTRY
	MOVE V,VALUE			;THE MACRO TEXT LOCATION
	TLNN V,-1			;UNLESS USER SUPPLIED BP BITS,
	HRLI V,440700			;CREATE A BYTE POINTER
	MOVEM V,MACLOC-CTABCN(T)	;PARALLELS DISPATCH ENTRY
	POPJ P,				;DONE

^MACIMM:TLNN F1,VALF			;THERE MUST BE AN ADDRESS
	JRST CERR			; THERE ISN'T
	MOVE V,VALUE			;GET IT
	TLNN V,-1			;MAKE BP IF NOT THERE
	HRLI V,440700
	SKIPA
^MACEXP:MOVE V,MACLOC-CTABCN(T)		;BYTE POINTER
	MOVEM V,STRIN			;TTY SIMULATOR
	JRST ERET			;ROUND WE GO

; Edit -- Edit Previous Value Using System Line Editor

IFN STANFO,<
^EDIT:	MOVE E,DDSW
	JRST @[	CERR
		CERR
		CERR
		EDDIT
		EDDIT
		EDDIT](E)
EDDIT:	HRRZ E,VALUE		;IF THERE IS ONE
	TLNN F1,VALF		;A VALUE?
	HRRZ E,LOCOP		;NO, USE .
	JSR FNDSCR		;ON SCREEN?
	JRST [	HLRZ M,(M)	;YES, USE SCREEN LINE'S MODE
		JRST ED1]
	HRRZ M,CURMOD		;NO, USE CURRENT MODE
ED1:	JSR ECHK		;ADJUST IF AC
	TRZ M,774037		;CLEAR NON-MODE BITS
	MOVE V,M
	LSH V,-5		;PUT IN SAVMOD FORMAT
	MOVEM V,SAVMOD		;SAVE IT
	
; NOW PREPARE FOR CONVERSION

IFE FILESW,<
	MOVE V,(E)		;SAVE VALUE
>
IFN FILESW,<
	PUSHJ P,RDTRKE
	MOVE V,@TRKOFF
>
	MOVE E,[POINT 7,EXBUF] 	;PUT STRING REP HERE
;	MOVEM E,STRIN		;FOR RAID STRING INPUT
	MOVEI T,0		;ASSUME NOT TEXT
	CAIN M,65		;SIXBIT
	MOVEI T,"'"		; YES
	CAIN M,75		;ASCII?
	MOVEI T,42		;YES, " CHAR
	JUMPE T,NOTX1		;NOT A TEXT RQST
	IDPB T,E		;TEXT RQST
; FOR ASCII TEXT, MUST EDIT THE VALUE, FIND VALID DELIM, ELIMINATE 
; ACTIVATION CHARS
	MOVEI D2,""
	PUSH P,D2		;SAVE DELIMITER
	CAIE M,75		;ASCII?
	JRST NOASCI		;NO
	MOVE D3,V		;GET TEXT VAL
	SETZB V,T		;CLEAR THESE
ASL:	JUMPE D3,ASD		;DONE
	MOVEI D2,0
	LSHC D2,7		;NEXT CHAR
	CAIE D2,15		;ELIMINATE ACTIVATION
	CAIN D2,12		;CHARS
	JRST ASL
	CAIN D2,ALTMOD
	JRST ASL
	CAIN D2,""
	TRO T,4
	CAIN D2,""
	TRO T,2
	CAIN D2,""
	TRO T,1
	LSH V,7
	IOR V,D2		;COLLECT NEW VALUE
	JRST ASL

	LSH V,7
ASD:	JUMPE V,.+3
	TLNN V,376000		;SHIFT TO LEFT
	JRST .-3		;UNTIL TO LEFT
	LSH V,1			;ONE MORE
	MOVEI D2,0		;NOW GET DELIM
	TRNN T,4
	MOVEI D2,""
	TRNN T,2
	MOVEI D2,""
	TRNN T,1
	MOVEI D2,""
	JUMPE D2,CERR		;NO AVAIL DELIM
	MOVEM D2,(P)		;SET UP DELIM
NOASCI:	IDPB D2,E		;PUT IN DELIMITER
NOTX1:	PUSHJ P,CONV		;CONVERT TO EXTERNAL REP
	HRRZ V,SAVMOD
	CAIL V,6		;IF TEXT,
	CAILE V,7
	JRST ABCDE
	POP P,T
	IDPB T,E		;FINISH OUT TEXT INPUT FORMAT
ABCDE:	PUSHJ P,[FINLIN:
			MOVEI C,15
			IDPB C,E
			MOVEI C,12
			IDPB C,E
			MOVEI C,0
	 		IDPB C,E
			POPJ P,]

; TIME TO PLAY EDITOR
	SETLIN EDTLIN		;FCS ON, SPECIAL ACTIVATION OFF
;	CLRBFI			;CLEAR INPUT ;LET HIM TYPE AHEAD
	PTLOAD [0
		EXBUF]  	;SEND TO LINE EDITOR
	SETLIN ASCLIN		;FCS SAME AS USER'S, SPECIAL ACTIVATION OFF
	PUSHJ P,SVACS
REPEAT 0,<
	INWAIT T		;#CHARS EDITED
	SETLIN RADLIN		;NORMAL RAID CHARACTERISTICS
	MOVE E,[POINT 7,EXBUF]
	JRST EDL1		;GO LOOP

EDL:	INCHRW C		;GET CHAR
	CAIN C,ALTMOD
	JRST EDL2		;ABORT
	CAIE C,15		;IGNORE CRLFS
	CAIN C,12
	JRST EDL1
	IDPB C,E		;COLLECT STRING
EDL1:	SOJGE T,EDL
	PUSHJ P,FINLIN		;INSERT CRLF-NULL
	SUB P,[1,,1]		;FLUSH CALL FROM MAIN
	JRST MAIN1		;WILL FEED DEPO

EDL2:	CLRBFI
	JRST ERET
>;END REPEAT 0
	INWAIT			;WAIT FOR AN ACTIVATION
	SETLIN RADLIN		;NORMAL RAID CHARACTERISTICS
	MOVEI M,1		;SHIFT STATUS BACK AND FORTH TO INDICATE DONE
	SKIPE DDSW		; EXCEPT ON TTY,
	XORM M,NBIGWD
	POPJ P,
>;STANFORD

;Upar,Lnfd,Lefsq2,Tab,<,>,Routs,<tab>,MVTST,MOVDN,MOVUP,REMPER,SCLR

^UPAR:	PUSHJ P,MVTST	;GET CURRENT LOCATION
	HLLZ M,(PNT)	;GET MODE OF CURRENT ONE
	MOVS T,PNT	;GET CURRENT POINTER
	CAMGE T,SPNT
	SOJA E,MOVL1	;IF BEFORE BEGINNING, GO TO BEGINNING
	CAME T,SPNT	;AT TOP?
	JRST UPA1	;NO
	AOBJN PNT,.	;YES, GO TO END (THERE'S ONE MORE AFTER AOBJN END)
	SKIPN -1(PNT)	;NULL?
	SOJA E,[MOVS PNT,SPNT	;YES, MOVE DOWN INSTEAD
		JRST MOVL1]
UPAR2:	SKIPL (PNT)	;PERMANENT?
	JRST UPA1A	;NO
	SUB PNT,[1,,1]	;YES
	JRST UPAR2

UPA1:	SUB PNT,[1,,1]
UPA1A:	SUB PNT,[1,,1]
	SOJA E,MOVL1	;GO TO PREVIOUS

^LNFD:	PUSHJ P,MVTST	;GET CURRENT LOCATION
	HLLZ M,(PNT)	;GET MODE OF CURRENT ONE
	ADDI E,1	;GO TO NEXT
MOVL1:	TRNN B,2	;LEFT BUCKY ON?
	JRST OPENU	;NO
	TLZ M,400037	;CLEAR RANDOM BITS
	PUSH P,M	;SAVE MODE OF THIS ONE
	MOVEI F1,4
	PUSHJ P,OPENU
	MOVSI M,377777
	ANDCAM M,(PNT)	;CLEAR MODE
	POP P,M		;GET MODE OF OLD ONE
	IORM M,(PNT)
	POPJ P,

^MOVUP:	PUSHJ P,MVTST
	MOVS M,(PNT)	;GET MODE OF CURRENT ONE
	TLO F,LOCOPF	;LOCATION OPEN
	MOVS E,SPNT	;GET STARTING POINTER
	CAMGE PNT,E
	POPJ P,		;BLANK SCREEN, DO NOTHING
	CAMN E,PNT	;AT THE TOP?
	JRST MOVL2	;YES
	SUB PNT,[1,,1]	;NO, MOVE UP 1
	JRST MOVL3	;GO DISPLAY

MOVL2:	AOBJN PNT,.	;GO TO END
MOVL2A:	SKIPE (PNT)	;IS THIS LOCATION USED?
	JRST MOVL3	;YES
	SUB PNT,[1,,1]	;NO, BACK UP
	JRST MOVL2A

^MOVDN:	PUSHJ P,MVTST
	MOVS M,(PNT)	;GET MODE OF CURRENT LOCATION
	TLO F,LOCOPF	;LOCATION OPEN
	MOVS E,SPNT	;STARTING POINTER
	CAMGE PNT,E
	POPJ P,		;BLANK SCREEN, DO NOTHING
	TLNE PNT,-1	;ARE WE AT THE END?
	SKIPN 1(PNT)	;NO, IS NEXT LOCATION USED?
	JRST MOVD1	;AT THE LAST LOCATION USED OR THE END, MOVE TO TOP
	ADD PNT,[1,,1]	;MOVE DOWN 1
	JRST MOVL3

MOVD1:	MOVS PNT,SPNT
MOVL3:	HRRZ T,(PNT)
	MOVEM T,LOCOP
	TRNN B,2	;LEFT BUCKY BIT ON?
	POPJ P,		;NO
	LSH M,-5
	DPB M,[POINT 12,(PNT),12];SET NEW MODE ON THIS ONE
	POPJ P,

^LEFSQ2:TRO F1,1
^TAB:	MOVEI D2,0
	JRST RLCON

^RITSQ2:TRO F1,1
^RITSQ4:MOVEI D2,1
	JRST RLCON

^ATSIN2:TRO F1,1
^ATSIN4:MOVEI D2,2
RLCON:	PUSHJ P,MVTST
	MOVE V,(PNT)
	PUSHJ P,GETPOI
	JRST CERR
IFE UESW,<
IFE FILESW,<
	XCT (D2)[MOVE E,(E)
		 MOVS E,(E)
		 MOVE M,(E)]
>
IFN FILESW,<
	PUSHJ P,RDTRKE
	XCT (D2)[MOVE E,@TRKOFF
		 MOVS E,@TRKOFF
		 MOVE M,@TRKOFF]
>
>;END NOT UESW
			IFN UESW,<	MO (E,E)
					CAIN D2,1
					MOVSS E
				>
	CAIN D2,2
	PUSHJ P,GPELOP
	JRST OPENU

MVTST:	HRRZ E,LOCOP
	TLNE F,LOCOPF
	TLNN F1,VALF		;ANY VALUE TYPED?
	POPJ P,
	PUSHJ P,DEPO1		;YES, DEPOSIT
	MOVE E,LOCOP
	POPJ P,			;NO

^LEFSQ1:MOVEI D2,1
	JRST LRATDO

^RITSQ1:SKIPA D2,[2]
^ATSIN1:MOVEI D2,3
LRATDO:	MOVSI M,400020
	IORM M,(PNT)		;MARK THIS ONE
	MOVEM PNT,VALUE		;OPEN A POINTER
	TRO D2,400000		;MAKE IT PERMANENT
	MOVS T,D2
	TRO F1,1
	JRST PNT4		;AVOID FINDING ANOTHER COPY ON SCREEN

^REMPER:MOVSI V,400000		;GET SIGN BIT
	MOVS E,SPNT
	CAMGE PNT,E		;BLANK SCREEN
	POPJ P,			;DO NOTHING
	ANDCAM V,(PNT)		;CLEAR
	JRST REDISP

^SCLR:
IFN STANFO,<
	PUSHJ P,SCLRCL
>
	MOVS PNT,SPNT
	SUB PNT,[1,,1]
	MOVEI M,0
	TLZ F,LOCOPF
	JRST INC

IFN STANFO,<
SCLRCL:	MOVE M,DDSW
	CAIE M,.DD
	JRST SCLRC1
	DDUPG [DDCLRP  2  0  0]
SCLRC2:	TRO F,DRWALL
	POPJ P,

DDCLRP:	BYTE (8)17,0,0 (3)1,2,2,4
	0

SCLRC1:	CAIE M,.DM
	POPJ P,
	UPGIOT [DMCLRP  2  0]
	JRST SCLRC2

DMCLRP:	BYTE (7) 177,37
	0
>;STANFO

; Sclrsv, Incr, Leffnd, Eqiv, Wdsrch, Etc., Inc

^SCLRSV:
IFN STANFO,<
	PUSHJ P,SCLRCL		;CLEAR THE SCREEN IF DATA DISK
>
	TRZ F,DRWALL
	TRO F,DPYALL
	MOVS M,SPNT		;GET POINTER TO DPNT
	MOVE V,M
SCLRS1:	SKIPGE T,(M)		;SKIP IF NOT PERMANENT
	JRST SCLRS4
SCLRS3:	AOBJN M,SCLRS1
	TLNN M,7
	JRST SCLRS1
	MOVE PNT,V
	SUB PNT,[1,,1]		;POINTER TO LAST LINE USED
	JUMPGE V,SCLRS6
SCLRS5:	SETZM (V)
	AOBJN V,SCLRS5
	TLNN V,7
	JRST SCLRS5
SCLRS6:	TLNN F,LOCOPF
	POPJ P,
	MOVE E,LOCOP
	JSR FNDSCR		;SKIP IF NOT ON SCREEN NOW
	POPJ P,			;ON SCREEN, OK
	MOVS V,PNT
	ADD V,[1,,1]
	CAMN V,SPNT
	TLZA F,LOCOPF
	CAIA
	POPJ P,
	MOVE V,(PNT)
	PUSHJ P,GETPOI
	JFCL
	HRRZM E,LOCOP
	POPJ P,

SCLRS4:	MOVEM T,(V)		;FOUND A PERMANENT ENTRY
	MOVE T,DSAV-DPNT(M)
	HLLM T,DSAV-DPNT(V)	;MOVE THE ARROW FLAGS
	AOBJN V,SCLRS3
	JRST SCLRS3

^INCR:	TLNE F1,VALF		;VALUE TYPED?
	JRST .+3		;YES
	MOVN E,SPNT		;NO, GET CURRENT #
	AOJA E,.+2		;INCREMENT
	SOS E,VALUE		;GET TYPED VALUE
	HRRZS E
	CAMG E,SCRMAX		;BIGGER THAN DISPLAY HEIGHT?
	CAILE E,MAXDLN-2-1	;TOO BIG?
	JRST CERR		;YES
	MOVS V,PNT
	SUB V,SPNT		;GET POINTER TO WHERE WE ARE IN DISPLAY
	CAIGE E,(V)
	JRST [	MOVEI V,0
		HLRZ M,SPNT
		HRRM M,PNT
		JRST .+1]
	MOVN M,E
	HLL M,SPNT
	EXCH M,SPNT		;DEPOSIT NEW DISPLAY SIZE
IFN STANFO,<
	SUB M,SPNT		;OLD -SIZE MINUS NEW -SIZE
	TRNE M,400000		;SKIP IF NOT DECREASING SIZE
	PUSHJ P,SCLRCL		;CLEAR THE SCREEN
>;STANFO
	SUB E,V
	MOVN M,E
	HRL PNT,M
INC:	SUBM PNT,M		;POINTER TO LAST ELEMENT IN THIS SIZE
	SETZM 1(M)
	HRLI M,1(M)
	ADDI M,2
	BLT M,DPNT+MAXDLN-1
	POPJ P,

^LEFFND:MOVE E,STPOP
	JRST OPENU

^EQIVL:	0
^EQIV:	MOVEI V,IFE UESW!FILESW,<EQIVL;> -1
	EXCH V,VALUE		;DEPOSIT AND GET TYPED VALUE
	TLNE F1,VALF		;VALUE TYPED?
	MOVEM V,EQIVL		;YES, DEPOSIT IT
	TRO F1,1		;DO NOT MOVE .
	PUSH P,CURMOD
	MOVEI V,100		;CHANGE MODE TO OCTAL
	HRRM V,CURMOD
	PUSHJ P,SOPENS		;OPEN IT
	POP P,CURMOD		;RESTORE MODE
	POPJ P,

^LB1:	MOVEI E,TLBOUN
	JRST LRB
^LB2:	MOVEI E,PLBOUN
LRB:	TLNN F1,VALF
	JRST CERR
	MOVE V,VALUE
	HRRZM V,(E)
	HRRZM V,1(E)
	POPJ P,

^RB1:	MOVEI E,TUBOUN
	JRST LRB
^RB2:	MOVEI E,PUBOUN
	JRST LRB
^PLBOUN:0
^TLBOUN:0
	0
^PUBOUN:0
^TUBOUN:0
	0

; WORD, EFFECTIVE ADDRESS, NOT-EQUAL SEARCHES

^ESRCH:	MOVEI M,2
	JRST SRST
^NWDSR:	MOVEI M,1
	JRST SRST
^SRCON:	TRZN F,SRCHSW	;SEARCH IN PROGRESS?
	POPJ	P,	;NO
	MOVE V,VSSVQ
	MOVE M,SRCHCN
	JRST WDSCON

^WDSRCH:MOVEI M,0
SRST:	MOVE V,TLBOUN
	MOVE E,VALUE	;GET VALUE
	XCT STB1(M)
	JRST ZPU
	MOVEM E,SRVAL#	;STORE
WDSCON:	MOVEI E,1	;GET INITL COUNT
	MOVS T,SPNT	;GET POINTER
	SKIPL (T)	;PERMANENT?
	ADDI E,1	;NO, COUNT
	AOBJN T,.-2	;LOOP
	TLNN T,7	;DONE?
	JRST .-4	;NO
	LSH E,-1	;DIVIDE BY 2
	JUMPE E,CERR	;NO LOCATIONS
	MOVEM E,SRCNT#
LOPP1:	CAML V,TUBOUN	;DONE?
	JRST WDON	;YES
IFN FILESW,<
	CAIGE V,20
	JRST [	MOVE E,JAC(V)
		JRST LOPP1A]
	HRRZ E,V
	PUSHJ P,RDTRKE
	MOVE E,@TRKOFF
LOPP1A:
>
IFE FILESW,<
	CAIG V,17	;AC?
	SKIPA E,JAC(V)	;YES
	MOVE E,(V)	;GET WORD
>
	XCT STB1(M)
	AOJA V,LOPP1
	XOR E,SRVAL	;COMPARE
	AND E,@STB3(M)	;AND WITH MASK
	XCT STB4(M)
	AOJA V,LOPP1	;NO
FND1:	PUSH P,V
	PUSH P,M
	MOVEM V,VALUE
	SETZB T,F1
	PUSHJ P,OPENQ	;OPEN FOUND LOCATION
	SOSG SRCNT	;n FOUND?
	SKIPA E,[.STAR]
	PUSHJ P,REDISP	;DRAW HERE IF NOT RETURNING TO TOP LEVEL
	POP P,M
	POP P,V
	SKIPLE SRCNT	;ENOUGH FOUND?
	AOJA V,LOPP1
	TRO F,SRCHSW	;YES, SET FLAG
	HRLM E,NBIGWD
	MOVEM M,SRCHCN#	;SAVE TYPE OF SEARCH
	MOVEM V,VSSVQ#
	AOS VSSVQ
	POPJ P,
WDON:	MOVE V,PLBOUN
	MOVEM V,TLBOUN
	MOVE V,PUBOUN
	MOVEM V,TUBOUN
	TRZ F,SRCHSW
	POPJ P,

;   Wdsrch Subroutines

^STRIN:	0		;IT'S $M-1 IF REALLY RAID
IFN REALSW,<INTERN $M,DDTEND>
^$M:
^SMASK:	-1
	-1
	0
^FLGPTR:0
STB1:	SKIPA
	SKIPA
	PUSHJ P,CALCE
STB3:	SMASK
	SMASK
	[777777]
STB4:	JUMPE E,FND1
	JUMPN E,FND1
	JUMPE E,FND1

CALCE:	MOVE T,E
	LDB D2,[POINT 4,E,17]	;GET IX
	JUMPE D2,CLOP1		;NO IX
	ADD T,JAC(D2)		;ADD IX
CLOP1:	HRRZS T			;CLEAR LEFT HALF
	MOVEM T,CTSV
	TLNN E,20		;@?
	JRST CDONE		;NO
IFE FILESW,<
	CAMLE T,JOBREL		;O.K.?
IFE SEGSW,<	POPJ P, 	;NO>
IFN SEGSW,<JRST	[CAIL T,400000
		CAILE T,@JOBHRL
		POPJ P,
		JRST .+1]>
>;NOT FILESW
IFN FILESW,<
	CAIGE T,20
	JRST [	MOVE E,JAC(T)
		JRST CALCE1]
	HRRZ E,T
	CAIL E,74
	CAMLE E,FJBHRL
	POPJ P,
	CAMLE E,FJBREL
	CAML E,UPPRST
	JRST .+2
	POPJ P,
	PUSHJ P,RDTRKE
	MOVE E,@TRKOFF
CALCE1:
>
IFE FILESW,<
	CAIG T,17	;AC?
	ADDI T,JAC	;YES
	MOVE E,(T)	;GET WORD
>
	HRRZ T,E
	CAME T,CTSV
	JRST CALCE
	POPJ P,
CTSV:	0
CDONE:	MOVE E,T
	AOS (P)
	POPJ P,

; Symdef, Symdf1, Symkil, Symfnd, Symfn1 -- Create and Delete Symbols
IFE SORTED,<

; SYMBOL_VALUE
^SYMDEF: PUSHJ P,CSFLUSH	;FLUSH ALL CACHES, SO AS NOT TO CONFUSE
	PUSH P,SYM	;SAVE SYMBOL
	PUSHJ P,EVAL	;GET VALUE
	TLNN F,VALF	;VALUE?
	JRST CERR	;NO
	POP P,SYM	;RESTORE SYMBOL
	JRST	DFQ1	;GO ENTER

; SYMBOL:
^SYMDF1: PUSHJ	P,CSFLUSH	;FLUSH ALL CACHES
	TLNN F,LOCOPF	;LOCATION OPEN?
	JRST ZPU	;	;NO
	MOVE V,LOCOP	;GET VALUE OF .

DFQ1:	MOVEM V,VALUE	;SAVE
	PUSHJ P,SYMFN1	;FIND THE CURRENT NAME ENTRY, IF ANY
	JRST THERE	; FOUND ONE
	MOVN V,[2,,2]
	ADDB V,JOBSYM	;FIX JOBSYM
	MOVSI E,2	;UPDATE POINTERS
	ADDM E,SYMPNT
	ADDM E,SYMPRG
	MOVE E,SYM	;GET SYMBOL
	TLO E,40000 	;MAKE GLOBAL
	MOVEM E,(V)	; SYMBOL
THERE:	MOVE E,VALUE	;SAVED VALUE
	MOVEM E,1(V)	;TO OLD LOCATION, OVERRIDING PREVIOUS DEF.
	JRST FREPOPJ

;SYMBOLK
^SYMKIL:PUSHJ P,CSFLUSH	;FLUSH ALL CACHES
	PUSHJ P,SYMFND	;FIND ENTRY
	CAIA		;FOUND ONE
	JRST PU		;NONE
	MOVE PV,SYMP	;GET POINTER
	MOVSI D3,400000	;GET KILL FLAG
	IORM D3,(PV)	;KILL SYMBOL
	TRO F,DPYALL	;HAVE TO START FROM SCRATCH
	JRST CSFLUSH

;SYMBOLK -- ANNIHILATE IT
^SYMNIL:PUSHJ P,SYMKIL	;MERELY KILL IT
	MOVE D3,[RADIX50 50,$UNDEF]
	MOVEM D3,(PV)	;NO SUCH NAME ANYMORE!
	POPJ P,

;SUBROUTINE USED BY ABOVE BIG GUYS
SYMFND:	TLNE F1,USINGF	;DEFINED?
	POPJ P,		; NO
SYMFN1:	TLNN F1,SINGF	;ySINGLE SYMBOL?
	JRST CERR	;NO
	TLZ F,UNDF	
	MOVS PV,F	;SAVE FLAGS
	PUSHJ P,SYMLOK	;FIND IN TABLE
	TLZ F,SCFL	;RESTORE SCFL FLAG...
	ANDI PV,SCFL	;....
	TSO F,PV	;...
	TLNE F,UNDF	;DEFINED?
	AOS (P)		;YES
	POPJ P,
>;NOT SORTED

IFN SORTED,<	; Symdef, Symdf1, Symkil -- Create and Delete Symbols

; SYMBOL_VALUE
^SYMDEF:PUSHJ P,CSFLUSH		;FLUSH ALL CACHES, SO AS NOT TO CONFUSE
	PUSH P,SYM		;SAVE SYMBOL
	PUSHJ P,EVAL		;GET VALUE (MIGHT MAKE CACHE ENTRY)
	TLNN F,VALF		;VALUE?
	JRST CERR		;NO
	POP P,SYM		;RESTORE SYMBOL
	PUSHJ P,DFQ1		;GO ENTER
	JRST CSFLUSH		;FLUSH AGAIN SINCE WE MOVED THE SYMBOLS

; SYMBOL:
^SYMDF1:PUSHJ P,CSFLUSH		;FLUSH ALL CACHES
	TLNN F,LOCOPF		;LOCATION OPEN?
	JRST ZPU		;NO
	MOVE V,LOCOP		;GET VALUE OF .
DFQ1:	PUSH P,B		;Save EVAL Ahead-values
	PUSH P,C
	PUSH P,PNT
	MOVEM V,VALUE		;Assume INTERNAL (not prev. def), and set
	MOVE E,PID		; up symbol for that -- in that case, any
	LSH E,5			; PID will do, really, so use current.
	PUSH P,E
	PUSHJ P,SYMFN1		;If the symbol already exists, save its
	JRST NTHERE		; type bits and its block ID, then remove
	MOVE PV,SYMP
	PUSH P,(PV)		; it from the face of the globe.
	HLRZ E,1(PV)
	MOVEM E,-1(P)
	PUSHJ P,SYMNIL
	POP P,SYM
NTHERE:	MOVE PNT,SYMBAS
	MOVE V,VALUE		;Determine the range of the new value,
	PUSHJ P,GETRNG		; and under the conditions:
	MOVEM A,RANGE		;  1) The symbol is in range 3 (full value)
	MOVEM V,VALUE		;  2) There are no free list entries for oflow
	MOVE M,5(PNT)		;REL PTR TO ONE AFTER LAST FREE
	MOVE T,4(PNT)		;REL PTR TO FIRST FREE
	HRRZ PV,(PNT)		;SEE IF THERE IS A FREE LIST FOR 36 BIT VALUES
	JUMPN PV,RM		;THERE IS ONE.  WORD FOR VAL WILL COME FROM IT
	CAIN A,3		;A HAS THE RANGE
	ADDI T,1		;RESERVE FIRST WORD OF FREE FOR THE 36 BIT VALUE
	SUBI M,2		;NEW FIRST SYMBOL
RM:	CAIL T,(M)
	JRST CERR		;WON'T DO IT IF CAN'T LEAVE AT LEAST ONE FREE
	MOVEM T,4(PNT)		;STORE BACK IN CASE IT WAS INCREMENTED ABOVE
	MOVE PV,@RNGBAS		;BEGINNING OF RANGE THAT SYM GOES IN
	ADDI PV,(PNT)
	MOVE B,@RNGBS1		;BEGINNING OF FOLLOWING RANGE
	ADDI B,(PNT)
	MOVNI M,2
	SETCM E,A		;-NUMBER OF CLASSES THAT ARE MOVING
	MOVEI T,5(PNT)		;ADDRESS OF RELATIVE POINTER OF CLASS 1
	HRLI T,(E)
	ADDM M,(T)
	AOBJN T,.-1		;UPDATE POINTERS OF ALL CLASSES THAT MOVED
	MOVN E,[2,,2]
	ADDM E,SYMRNG
	MOVE E,SUBRNG(A)	;E GETS 0 IF CLASSES 1-3 , 1 IF CLASS 4
HRDLUP:	CAIGE PV,(B)
	XCT CAMG1(E)
	JRST INSTAL
	ADDI PV,2		;IN EITHER CASE WILL INDICATE THE ENTRY JUST
	JRST HRDLUP		;AFTER THE NEW SYMBOL LOCATION

INSTAL:	MOVE T,5(PNT)		;POINTER TO NEW START OF CLASS 1
	ADDI T,(PNT)
	MOVEI M,2(T)		;POINTER TO OLD START OF CLASS 1
	HRLI T,(M)		;MAKE A BLT POINTER
	BLT T,-3(PV)
	MOVE T,SYM		;THE NAME IS EASY -- INCLUDING THE TYPE 
	TLNN T,740000
	TLO T,40000
	MOVEM T,-2(PV)		; DERIVED ABOVE.
	CAIE A,3
	JRST NBD
	HRRZ T,(PNT)		;POINTER TO FREE LIST OF 36 BIT VALUE WORDS
	JUMPE T,NEWW
	ADDI T,(PNT)		;MAKE ABSOLUTE
	HRRZ M,(T)		;RELATIVE POINTER TO NEW HEAD OF FREE LIST
	HRRM M,(PNT)		;UPDATE POINTER TO FREE
	JRST HHERE

NEWW:	HRRZ T,4(PNT)
	ADDI T,-1(PNT)
HHERE:	MOVEM V,(T)
	HRRZ V,T
	SUBI V,(PNT)		;REL POINTER TO VALUE GETS STORED IN RH OF SYM
	MOVEI T,PNT
	IORM T,(P)		;TURN ON INDEX FIELD IN BLOCK POINTER HALF
NBD:	POP P,E			;The new symbol value word has Block ID 
	HRL V,E			; info in the left half, value (or ptr)
	MOVEM V,-1(PV)
	POP P,PNT
	POP P,C
	POP P,B
	JRST FREPOPJ

;REVIVE, SYMKIL, SYMNIL, ZAPSYM, SYMFND, SYMFN1
;SYMBOL:
^REVIVE:SKIPA D1,[ANDCAM D3,(PV)]	;REVIVE KILLED SYMBOL
;SYMBOLK
^SYMKIL:MOVE D1,[IORM D3,(PV)]		;KILL A SYMBOL
	PUSHJ P,CSFLUSH			;FLUSH ALL CACHES
	PUSHJ P,SYMFND			;FIND ENTRY
	JRST PU				;NONE
	MOVE PV,SYMP			;GET POINTER
	MOVSI D3,400000			;GET KILL FLAG
	XCT D1				;KILL SYMBOL
	TRO F,DPYALL			;HAVE TO START FROM SCRATCH
	JRST CSFLUSH

;SYMBOLK -- ANNIHILATE IT
^SYMNIL:PUSHJ P,SYMKIL			;This one looks up the symbol,
^ZAPSYM:MOVE PNT,SYMBAS
	MOVE D1,1(PV)			; gets its pointer to PV.
	TLNN D1,37			;If the deleted symbol has an
	JRST NOFLOW			; overflow word, put into oflow
	HRRZ T,(PNT)
	HRRM D1,(PNT)
	ADD D1,PNT
	HRROM T,(D1)
NOFLOW:	MOVEI T,(PV)			;DESTINATION IS WHERE SYMBOL WAS
	MOVE E,5(PNT)
	ADDI E,(PNT)			;ABSOLUTE ADDRESS OF FIRST SYMBOL
NOFLW1:	CAIGE T,2(E)			;SKIP IF SOURCE IS STILL A SYMBOL
	JRST NOFLW2
	MOVE A,-2(T)
	MOVEM A,(T)
	MOVE A,-1(T)
	MOVEM A,1(T)
	SUBI T,2
	JRST NOFLW1

NOFLW2:	SETZM (T)
	SETZM 1(T)
	MOVEI T,2
	MOVEI A,0
	SUBI PV,(PNT)			;MAKE PV A RELATIVE POINTER
NOFLW3:	CAMGE PV,@RNGBAS
	JRST SETSYM
	ADDM T,@RNGBAS			;UPDATE RELATIVE POINTERS TO SYMS
	AOJA A,NOFLW3

;SUBROUTINE USED BY ABOVE BIG GUYS
SYMFND:	TLNE F1,USINGF			;DEFINED?
	JRST APOPJ2			; NO
SYMFN1:	TLNN F1,SINGF			;SINGLE SYMBOL?
	JRST CERR			;NO
	TLZ F,UNDF	
	MOVS PV,F			;SAVE FLAGS
	PUSHJ P,SYMLOK			;FIND IN TABLE
	TLZ F,SCFL			;RESTORE SCFL FLAG...
	ANDI PV,SCFL			;....
	TSO F,PV			;...
	TLNN F,UNDF			;DEFINED?
APOPJ2:	AOS (P)
	POPJ P,
>;SORTED

;$nB, 1nBrknum -- Brkins, Brkjsr, Dobrk, Brkpln

COMMENT  THE FORMAT OF THE BREAKPOINT TABLE
     IS AS FOLLOWS:
$1B:	RIGHT HALF IS THE ADDRESS OF THE BREAKPOINT
	LEFT HALF IS ZERO, THIS LOCATION IS -1 IF NOT USED

BRKCNT__1	;THIS IS THE MULTIPLE PROCEDE COUNT
BRKSKP__2	;THIS IS THE CONDITIONAL SKIP INSTRUCTION.
		;IF NON-ZERO, RAID WILL EXECUTE THIS INST.
		;WHEN YOU HIT THIS BREAKPOINT AND WILL
		;IGNORE THE BREAKPOINT IF THE INST. SKIPS
BRKSTR__3	;THIS IS THE STRING POINTER.  WHEN YOU HIT THIS
		;BREAKPOINT, THE STRING POINTED TO GETS EXECUTED
		;AS IF IT WAS BEING TYPED IN; AS LONG AS THE POINTER IS NON-ZERO
BRKCON__4	;THE REAL CONTENTS OF THE BREAKPOINT LOCATION ARE STORED HERE
BRKNUM__20	;MAX NUMBER OF BREAKPOINTS
BLOCNM__5	;NUMBER OF WORDS PER BREAKPOINT IN TABLE

IFN UESW,<
^JOBREL:,,-1
^JOBSYM:0	;DON'T CLOBBER REAL JOBSYM SO WE CAN DEBUG
>
IFN DEBSYM,<
^JOBSYM: 0
>

IFN FILESW,<EXTERNAL JOBREL,JOBSA,JOBSYM>
IFE UESW!FILESW,<
$1B:	-1
	BLOCK BLOCNM-1
FOR @@ ZILCH_2,BRKNUM
<IFN REALSW,<$@ZILCH@B:>	-1
	BLOCK BLOCNM-1
>
   	       	     	    
IFN REALSW,<INTERN $1B
FOR @! Z_2,BRKNUM
<INTERN $!Z!B
>>

^BRKINS:0
	SKIPE BRKSW#		;SKIP IF BREAKPOINTS ARE NOT IN CORE YET
	JRST @BRKINS
	SETOM BRKSW		;INDICATE BREAKPOINTS ARE IN CORE
	MOVEI M,$1B		;GET POINTER TO TABLE
	MOVEI D3,BRKNUM
LOP11:	SKIPGE V,(M)		;USED?
	JRST ARN1		;NO
	MOVE T,[JSR BRKJSR]	;GET THE JSR
	CAIG V,17		;AC?
	ADDI V,JAC		;YES
	EXCH T,(V)		;DEPOSIT
	MOVEM T,BRKCON(M)	;SAVE VALUE
ARN1:	ADDI M,BLOCNM		;GO TO NEXT
	SOJG D3,LOP11		;LOOP IF NOT DONE
	JRST @BRKINS

IFN REALSW,< $I:
INTERN $I
>
^BRKJSR:0
	MOVEM P,RAC+P
	MOVE P,[-PDLEN,,PDL-1]
	EXCH P,RAC+P
	JSR RACGT		;GET THE AC'S
	JSR ONCE		;TO BE SURE
	SOS BRKJSR		;POINT TO BREAKPOINT INSTR
^DOBRK:	SETZM PNTREM
	JSR BRKPUL		;PULL OUT THE BREAKPOINTS
	SKIPN M,PNTREM		;GET POINTER TO THIS ONE
	JRST HITT		;NO???????
	SKIPN V,BRKSKP(M)	;GET SKIP INST.
	JRST NORMAL	 	;NO SKIP
	MOVEI T,0		;SKIP-DETECTOR
	JSR JACGT		;GET USER BACK
	XCT RAC+V		;EXECUTE IT (RAID SAVED AC)
	AOS RAC+T		;SKIPPED NONE
	AOS RAC+T		;SKIPPED ONE
	JSR RACGT		;GET RAID'S ACS BACK (INCL M.)
	JRST .+1(T)
	JRST PROCEE		;SKIPPED TWO
	JRST HIT		;SKIPPED ONE
NORMAL:	SOSLE BRKCNT(M)		;CHECK PROCEDE COUNT
	JRST PROCEE		;NOT EXHAUSTED
	SETZM BRKCNT(M)		;EXHAUSTED
HIT:	SKIPN T,BRKSTR(M)	;IS THERE A STRING POINTER?
	JRST HIT1		; NO
	TLNN T,-1		;DID USER SPECIFY BP PART?
	HRLI T,440700		; NO, START AT WORD BEGINNING
HIT1:	MOVEM T,STRIN		;SET RAID INTERNAL INPUT BP
	MOVE V,(M)
	TLNE V,40		;DID WE HIT A TEMPORARY BREAKPOINT????
	SETOM (M)		;YES, REMOVE IT..
HITT:	SKIPN V,BRKJSR		;WAS THERE A LOCATION?
	JRST NOVALU
	MOVEI T,.STAR
	HRLM T,NBIGWD
	PUSHJ P,OPNQQQ		;OPEN BREAKPOINT LOCATION
	SKIPN PNTREM		;REAL BPT?
	TRNE F,ISOPC		;NO, JOBOPC KLUDGE?
	JRST NOVALU		;ONE OF THE ABOVE
	AOS V,BRKJSR		;IT'S A JSR $I, FIX THE PC
	PUSHJ P,OPNQQQ		;AND DISPLAY THE PROCEED LOC
	SOS VALUE
	PUSHJ P,OPENQ		;NOW SET . BACK TO JSR
NOVALU:	MOVE V,F		;SAVE ISOPC FLAG
IFN TENEX,<
	MOVEI A,100
	TRZN F,ISOPC
	CBIBF
>
IFE TENEX,<
	TRZN F,ISOPC
	CLRBFI
>
	TRNN V,ISOPC		;REDRAW ON TTY FOR RAID STARTUP
	SKIPE DDSW		;TEST DEVICE
	JRST E1RET		;GO DO RAID
	JRST ERET		;TTY, NO NEED TO REDRAW

OPNQQQ:	HRRZM V,VALUE
OPENQQ:	HRRZM V,STPOP
	MOVE T,V
	SUB T,(PNT)
	MOVEI T,-2(T)
	JUMPN T,NOSKPT
	SOS VALUE
	MOVEI T,0
	MOVEI F1,4
	PUSHJ P,OPENQ
	AOS VALUE
NOSKPT:	SETZB T,F1
	JRST OPENQ

^GOGOGO:MOVE V,VALUE		;GET VALUE
	TLNN F1,VALF		;WAS THERE A VALUE?
	MOVE V,JOBSA		;NO, GET JOBSA
	HRRM V,BRKJSR		;DEPOSIT
GOPRO:	JSR BRKINS		;INSERT BREAKPOINT
	JSR JACGT		;GET JOB AC'S
	JRST 2,@BRKJSR		;GO TO JOB

EXTERN JOBREL,JOBSA
IFE DEBSYM,<EXTERN JOBSYM>

^BRKPLN:TLNN F1,VALF		;VALUE TYPED?
	JRST CERR		; NO
	PUSHJ P,BRKREM
	MOVEI M,$1B
	MOVEI T,BRKNUM
BLOP:	SKIPGE (M)		;EMPTY?
	JRST BBFND		;YES
	ADDI M,BLOCNM		;GO TO NEXT
	SOJG T,BLOP
	JRST CERR		;NO ROOM
BBFND:	HRRZ V,VALUE
	CAIG V,@JOBREL
	JRST BBOK
IFN SEGSW,<
	CAIL V,400000
	CAILE V,@JOBHRL
	JRST CERR
	SKIPGE JOBHRL
	PUSHJ P,UNPUR
>
IFE SEGSW,<JRST	CERR>
BBOK:	MOVEM V,(M)		;STORE
	SETZM BRKCNT(M)
	SETZM BRKSTR(M)
	SETZM BRKSKP(M)
	POPJ P,

; Brkrem, Brkpul, Tbproc

^BRKREM:
^BKRM:	HRRZ V,VALUE		;GET VALUE IF ANY
	MOVEI T,$1B		;GET TABLE POINTER
	MOVEI M,BRKNUM		;AND COUNT
	TLNN F1,VALF		;VALUE?
	JRST REMALL		;NO, REMOVE ALL BREAKPOINTS
LOOP1:	CAMN V,(T)		;THIS IT?
	JRST BFND		;YES
	ADDI T,BLOCNM		;NO, GO TO NEXT
	SOJG M,LOOP1		;LOOP IF NOT DONE
	POPJ P,
BFND:	SETOM (T)		;REMOVE IT
	POPJ P,
REMALL:	SETOM (T)
	ADDI T,BLOCNM		;GO TO NEXT
	SOJG M,REMALL		;LOOP
	POPJ P,

;REMOVE THE BREAKPOINTS.  PNTREM GETS SET TO THE INDEX OF THE BREAKPOINT WHOSE
;LOCATION IS NOW IN BRKJSR
^BRKPUL:0
	SKIPN BRKSW		;SKIP IF BREAKPOINTS HAVE BEEN INSTALLED IN CORE
	JRST @BRKPUL
	SETZM BRKSW		;SAY THAT BREAKPOINTS ARE NO LONGER IN CORE
	MOVEI M,$1B		;GET POINTER TO TABLE
	MOVEI D3,BRKNUM
LOP12:	SKIPGE V,(M)		;GET LOCATION
	JRST ARN2		;NOT USED
	MOVE T,BRKCON(M)	;GET WORD WHICH GOES THERE
	ANDI V,-1
	CAIN V,@BRKJSR		;IS THIS THE ONE?
	MOVEM M,PNTREM		;YES REMEMBER POINTER
	CAIG V,17		;AC?
	ADDI V,JAC		;YES
	MOVEM T,(V)		;DEPOSIT
ARN2:	ADDI M,BLOCNM		;GO TO NEXT
	SOJG D3,LOP12		;LOOP
	JRST @BRKPUL

; TBPROC:	PLANT A TEMPORARY BREAKPOINT AT "."  AND PROCEED
^TBPROC:HRRZ E,(PNT)	;GET "."
	MOVEM E,VALUE	;PRETENT IT...
	TLO F1,VALF	;...WAS TYPED
	PUSHJ P,BRKPLN	;PLANT A BREAKPOINT AT "."
	MOVSI V,40
	ORM V,(M)	;MAKE IT A TEMPORARY BREAKPOINT
	JRST PROCEE	;PROCEED..

; Proced, Gpelop, Elop, Pstbrk, Prmbrk, $SBP

^PROCED:SKIPN M,PNTREM		;HAVE A POINTER?
	JRST GOPRO		;NO, USER JSR $I'ED, OR JRSTED DDT
	MOVE V,VALUE		;REPEAT COUNT
	TLNE F1,VALF		;VALUE TYPED?
	HRRZM V,BRKCNT(M)	;YES, DEPOSIT
PROCEE:	PUSHJ P,STEP		;STEP ONE LOCATION
	JRST GOPRO		;PROCEDE
PNTREM:	0

STEP:	HRRZ M,BRKJSR		;GET CURRENT PC
	CAIG M,17		;AC?
	ADDI M,JAC		;YES
	MOVEM M,BRKJSQ#		;SAVE
STP1:	MOVE M,@BRKJSQ		;GET THE INST. TO BE DONE
	PUSHJ P,ECALC		;CALCULATE EF. ADDRS.
	CAMGE M,[SOS]		;IF INST IS SOS OR GREATER, IT'S SAFE
	CAMGE M,[JFFO]		;IF IT IS LESS THAN JFFO, IT'S SAFE
	JRST SAFE
	LDB M,[POINT 9,M,8]	;GET OPCODE
	CAIL M,321		;IF IT'S JUMPL OR GREATER IT'S JUMP-SKIP
	JRST JSKP
	CAIN M,243		;JFFO?
	JRST OJUM		;YES
	CAIGE M,252		;AOBJNP OR GREATER?
	JRST SAFE		;NO
	CAIL M,270		;IF ADD OR GREATER, SAFE
	JRST SAFE
	JRST @JUMSTP-252(M)	;DISPATCH ON TYPE OF JUMP

JUMSTP:	OJUM			;AOBJP
	OJUM			;AOBJN
	OJRST			;JRST
	OJUM			;JFCL
	HXCT			;XCT
	SAFE			;?????
	HPSHJ			;PUSHJ
	SAFE			;PUSH
	SAFE			;POP
	HPPJ			;POPJ
	HJSR			;JSR
	HJSP			;JSP
	HJSA			;JSA
	OJUM			;JRA

OJUM:	PUSHJ P,ECALC		;GET THE EFFECTIVE ADDRS. IN E, INST IN M
	TLZ M,37		;CLEAR @ AND X
	HRRI M,ITJ		;PUT IN OUR OWN ADDRESS
	MOVEM M,OINST		;STORE INTR.
	JSR JACGT1		;GET JOB AC'S

OINST:	0			;DO THE INSTR.
	JSR RACGT1		;GET RAID AC'X
AOSR:	AOS BRKJSR		;UPDATE PC
	POPJ P,			;LEAVE

ITJ:	JSR RACGT1		;GET RAID AC'S
	HRRM E,BRKJSR		;UPDATE PC
	POPJ P,

OJRST:	PUSHJ P,ECALC
	TLNN M,100		;AC 2 ON?
	JRST OJUM+1		;NO
	TLNN M,20		;@ ON?
	JRST OJUM+1		;NO
	TLZ M,17
	HRRI M,MSAV
	MOVEM M,OINST
	MOVE M,MSAV
	TLZ M,37
	HRRI M,ITJ
	MOVEM M,MSAV
	JRST OINST-1

SAFE:	MOVE M,@BRKJSQ		;GET INST.
	SETZM BRCNT#
	LDB T,[POINT 9,M,8]	;GET OPCODE
	CAIN T,41		;INIT?
	JRST INITI		;YES
	CAIGE T,100
	JRST ITSUUO
SF1:	JSR JACGT1		;GET JOB AC
	XCT @BRKJSQ		;EXECUTE THE INST (BRKJSQ IN CASE UNDER XCT)
	AOS BRCNT
	AOS BRCNT
	AOS BRCNT
INRET:	JSR RACGT1		;GET RAID AC'S
	MOVEI T,4		;UPDATE PC
	ADD T,BRKJSR		
;...
	SUB T,BRCNT
	HRRM T,BRKJSR
	POPJ P,

INITI:	MOVS M,BRKJSQ
	HRRI M,INTQ
	BLT M,INTQ+2		;GET THE INIT
	JSR JACGT1		;GET JOB AC
INTQ:	BLOCK 3
	AOS BRCNT
	JRST INRET

ITSUUO:	CAIGE T,40
	JRST ITSU40
	PUSH P,M		;SAVE INSTRUCTION
	JSR BRKINS
	POP P,@BRKJSQ		;RESTORE INSTRUCTION IN CASE IT HAS A BREAKPOINT
	PUSHJ P,SF1
	JSR BRKPUL
	POPJ P,

ITSU40:	JUMPE T,SF1
	HRR M,E
	TLZ M,37
	MOVEM M,40
	MOVEI E,41
	MOVEM E,BRKJSQ
	JRST STP1

RACGT1:	0
	JSR RACGT		;GET RAID AC'S
	HLL T,RACGT1		;GET JOB FLAGS
	HLLM T,BRKJSR		;DEPOSIT
	JRST @RACGT1

JACGT1:	0
	MOVE T,BRKJSR		;GET JOB FLAGS
	HLLM T,JACGT1		;DEPOSIT
	JSR JACGT		;GET JOB AC'S
	JRST 2,@JACGT1		;RETURN & RESTORE JOB FLAGS

ECALC:	SKIPA M,@BRKJSQ		;GET INST
^GPELOP:SETZM BRKJSQ
>;END OF IFE UESW!FILESW
IFN UESW!FILESW,<
^GPELOP:>
^ELOP:	IFN UESW!FILESW,<PUSH P,M>
ELOOPP:	HRRZ E,M		;GET ADDRESS FIELD
	LDB T,[POINT 4,M,17]	;GET IX FIELD
	JUMPE T,.+3		;ANY IX?
 	ADD E,JAC(T)		;YES, ADD IN
	HRRZS E
	TLNN M,20		;@?
	JRST EDON		;NO
	JSR ECHK
	MOVE M,(E)		;GET WORD
	JRST ELOOPP
EDON:
IFE UESW!FILESW,<
	MOVEM M,MSAV
	MOVE M,@BRKJSQ ;ELSE > POP P,M
	POPJ P,

IFN REALSW,<
$SBP:
INTERN $SBP
>;REALSW
IFE UESW!FILESW,<
; USER CALLS JSR AC,$SBP TO SET BREAKPOINT AT LOCATION NAMED IN AC
^PSTBRK:0
	JSR RACGT		;GET RAID ACS
	JSR ONCE		;SET UP FOR RAID IF FIRST EXPOSURE
	JSR BRKPUL		;PULL, BECAUSE THEY'RE GOING TO CHANGE
	TLO F1,VALF		;SIMULATE SUCCESSFUL VALUE SCAN
	HRRZ V,PSTBRK		;RETURN ADDR
	LDB V,[POINT 4,-1(V),12];AC FIELD OF `JSR AC,$SBP'
	HRRZ V,JAC(V)		;USER'S VERSION OF THIS AC
	MOVEM V,VALUE		;FINISH SIMULATION
	PUSHJ P,BRKPLN		;PLANT THE BREAKPOINT
	JSR BRKINS		;INSERT BREAKPOINTS
	JSR JACGT		;GET JOB'S ACS BACK
	JRST 2,@PSTBRK		;RETURN TO SENDER
IFN REALSW,<
$RBP:
INTERN $RBP
>;REALSW
^PRMBRK:0
	JSR RACGT		;PRETTY MUCH A REPEAT
	JSR ONCE		;SET UP FOR RAID IF FIRST EXPOSURE
	JSR BRKPUL		;PULL, BECAUSE THEY'RE GOING TO CHANGE
	TLO F1,VALF		;SIMULATE SUCCESSFUL VALUE SCAN
	HRRZ V,PRMBRK		;RETURN ADDR
	LDB V,[POINT 4,-1(V),12];AC FIELD OF `JSR AC,$RBP'
	HRRZ V,JAC(V)		;USER'S VERSION OF THIS AC
	MOVEM V,VALUE		;FINISH SIMULATION
	PUSHJ P,BKRM		;REMOVE THE BREAKPOINT
	JSR BRKINS		;INSERT BREAKPOINTS
	JSR JACGT		;GET JOB'S ACS BACK
	JRST 2,@PRMBRK		;RETURN TO SENDER

; Steppe, Stepp, Xeq1, Xeq2

MSAV:	0
JSKP:	TRNE M,10	;JUMP OR SKIP?
	JRST SAFE	;SKIP, SAFE
	JRST OJUM	;JUMP, HANDLE
HJSR:	PUSHJ P,ECALC	;GET DFFECTIVE ADDRESS IN E, INST IN M
	AOS T,BRKJSR	;GET THE PC WORD
	CAILE E,17	;AC?
	SKIPA V,E	;NO
	MOVEI V,JAC(E)	;YES
	MOVEM T,(V)	;DEPOSIT PC WORD
	AOJA E,JSRET
HJSP:	PUSHJ P,ECALC	;GET EF AD IN E
	AOS T,BRKJSR	;GET THE PC
	LDB V,[POINT 4,M,12];GET AC FIELD
	MOVEM T,JAC(V)	;DEPOSIT PC IN THE AC
JSRET:	HLL E,BRKJSR 	;GET FLAGS
	TLZ E,20000	;CLEAR THE BIS FLAG
JSAET:	MOVEM E,BRKJSR	;DEPOSIT NEW PC
	POPJ P,
HJSA:	PUSHJ P,ECALC	;GET DF AD
	AOS T,BRKJSR	;GET THE PC
	LDB V,[POINT 4,M,12];GET AC FIELD
	MOVE PV,JAC(V)	;GET AC
	CAILE E,17	;IS E AN AC?
	SKIPA D3,E	;NO
	MOVEI D3,JAC(E)	;YES
	HRL T,E	;PUT E IN LEFT OF PC WORD
	MOVEM T,JAC(V)	;DEPOSIT PC IN AC
	MOVEM PV,(D3)	;DEPOSIT AC IN E
	HLL E,BRKJSR	;GET FLAGS
	AOJA E,JSAET
HPSHJ:	PUSHJ P,ECALC	;GET ADDRS
	AOS T,BRKJSR	;GET THE PC
	MOVEM T,OINST	;STORE
	LDB T,[POINT 4,M,12]	;GET AC
	DPB T,[POINT 4,HP1,12];DEPOSIT
	JSR JACGT1	;GET JOB AC
HP1:	PUSH P,OINST	;PUSH THE PC
	JSR RACGT1	;GET RAID AC
	JRST JSRET
HPPJ:	MOVE M,@BRKJSQ	;GET INST
	LDB T,[POINT 4,M,12];GET AC FIELD
	DPB T,[POINT 4,HP2,12];DEPOSIT
	JSR JACGT1	;GET JOB AC
HP2:	POP P,OINST	;GET THE RETURN ADDRS
	JSR RACGT1	;GET RAID AC
	MOVE E,OINST	;GET THE NEW PC
	HRRM E,BRKJSR	;STORE
	POPJ P,

HXCT:	PUSHJ P,ECALC	;GET EF AD
	CAIG E,17	;AC?
	ADDI E,JAC	;YES
	MOVEM E,BRKJSQ	;DEPOSIT
	JRST STP1	;DO THAT ONE

^STEPP:	MOVE M,LOCOP
	TLNN F,LOCOPF
	JRST CERR
	HRRM M,BRKJSR
^STEPPE:PUSHJ P,STEP	;DO IT
	MOVE V,BRKJSR	;GET PC
	HRRZM V,VALUE	;DISPLAY IT
	JRST OPENQQ

XQINST:	LDB T,[POINT 9,M,8]	;GET OPCODE
	CAIE T,264		;JSR?
	CAIN T,260		;PUSHJ?
	AOS (P)			;YES
	CAIE T,265		;JSP?
	CAIN T,266		;JSA?
	AOS (P)			;YES
	CAIG T,37		;UUO?
	AOS (P)			;YES
	POPJ P,			;NO

^XEQ2:	MOVE M,LOCOP
	TLNN F,LOCOPF
	JRST CERR
	HRRM M,BRKJSR
^XEQ1:	HRRZ M,BRKJSR		;GET PC
	CAIG M,17		;AC?
	ADDI M,JAC		;YES
	MOVEM M,BRKJSQ
	MOVE M,(M)		;GET INST
	PUSHJ P,XQINST		;SUBR. CALL INST?
	JRST STEPPE		;NO, STEP
NOSTPP:	MOVEM M,NONST		;STORE INST
	PUSHJ P,NOSTP		;DO IT
	MOVE V,BRKJSR
	HRRZM V,VALUE
	PUSHJ P,OPENQQ
	JRST ERET

; Xeq3, Yxeq, Mstep, LEAVE

^XEQ3:	TLNN F1,VALF	;VALUE TYPED?
	JRST CERR	;NO
	MOVE M,VALUE	;GET INST
	MOVEM M,NONST
	PUSHJ P,XQINST	;SUBR. CALL INST?
	SKIPA		;NO
	JRST YES1	;YES
	PUSH P,BRKJSR	;SAVE PC
	MOVEI T,NONST 	;SET UP TEMP PC
	HRRM T,BRKJSR
	PUSHJ P,STEP	;DO THE INST
	HRRZ M,BRKJSR
	SUBI M,NONST
	PUSHJ P,SKPSET
	POP P,M		;RESTORE PC
	HRRM M,BRKJSR
	POPJ P,

YES1:	MOVE T,XQPNT	;GET TABLE POINTER
	PUSH T,BRKJSR	;SAVE PC
	MOVEM T,XQPNT	;SAVE OVER BRKINS
	PUSHJ P,NOSTP	;GO GET BRKPNTS, DO
	HRRZ M,BRKJSR
	SUBI M,@(T)
	PUSHJ P,SKPSET
	POP T,M
	MOVEM T,XQPNT	;RESTORE TABLE POINTER
	HRRM M,BRKJSR	;RESTORE PC
	JRST ERET

SNUM__10
NOSTP:	JSR BRKINS		;INSERT BREAKPOINTS
	MOVE T,XQPNT		;GET TABLE POINTER
NOST:	PUSH T,BRKJSX#		;SAVE OLD PC
	PUSH T,BRKJSR		;SAVE OLD USER PC TOO
	POP P,M			;GET RETURN ADDRS
	HRLM M,-1(T)		;SAVE
	MOVEM T,XQPNT		;STORE POINTER
	MOVEI M,SNUM
	MOVEM M,BRKJSX
	JSR JACGT1		;GET JOB AC
NONST:	0			;DO INST
	REPEAT SNUM,<SOS BRKJSX>
	JSR RACGT1		;GET RAID AC
	JSR BRKPUL		;REMOV BRK PNTS
	MOVE M,NONST		;GET INST.
	LDB E,[POINT 4,M,12]	;GET AC FIELD
	PUSHJ P,ELOP		;CALC EF. ADDRS.
	MOVE T,XQPNT
	POP T,BRKJSR
	AOS M,BRKJSX
	ADDM M,BRKJSR
	POP T,M
	MOVEM T,XQPNT
	HRRM M,BRKJSX
	MOVSS M
	JRST (M)

XQTBLN__20
XQTB:	BLOCK XQTBLN
XQPNT:	-XQTBLN,,XQTB-1
^MSTSW1:0
^MSTSW2:0

^LEAVE:	MOVE M,[EXIT]
	MOVEM M,VALUE
	TLO F1,VALF
^YXEQ:	TLNN F1,VALF
	JRST CERR
	MOVE M,VALUE	;GET INST TO BE EXECUTED
	MOVEM M,YXINST	;DEPOSIT
	PUSHJ P,XQINST	;IS IT SUBR CALL?
	SKIPA	
	JRST XEQ3	;YES
	MOVEI T,2
	MOVEM T,YXCNT
	JSR BRKINS	;PLANT BREAKPOINTS
	JSR JACGT1	;GET JOB AC'S
YXINST:	0
	SOS YXCNT
	SOS YXCNT
	JSR RACGT1
	JSR BRKPUL
	SKIPE M,YXCNT
	PUSHJ P,SKPST1
	JRST ERET

YXCNT:	0

SKPSET:	SOJLE M,CPOPJ
SKPST1:	MOVEM	M,SKPVAL
	TLO	F,PMULFL!PUFL
	HRRI	M,.SKIP
	HRLM	M,NBIGWD
	POPJ P,

^MSTEP:	TLNN F1,VALF	;IF THERE WAS A REPEAT FACTOR,
	JRST MSTEP2
	MOVE M,VALUE	;USE IT AS NUMBER TO EXECUTE 
	MOVEM M,RPTCNT	;BEFORE DISPLAYING
	JRST MSTEP2

STPQ:	TRNE B,1
	AOS MSTSW1
STP:	PUSHJ P,STEPPE	;STEP INST
MSTEP1:	SOSGE RPTCNT
	PUSHJ P,REDISP	;DRAW INTERMEDIATE RESULTS
MSTEP2:	HRRZ M,BRKJSR	;GET PC
	MOVE V,M
	MOVEM M,VALUE
	CAIG M,17	;AC?
	ADDI M,JAC	;YES
	MOVEM M,BRKJSQ	;DEPOSIT
	MOVE M,(M)	;GET INST
	MOVEM M,NONST	;DEPOSIT
	PUSHJ P,XQINST	;SUBR. CALL INST?
	JRST STPNOS	;NO
	SKIPN MSTSW1	;ANY SWITCH SETTING FOR THIS?
	JRST STPYES	;NO
	PUSHJ P,OPENQQ	;YES, OPEN IT
	SKIPL MSTSW1	;WHICH WAY
	JRST STP	;STEP
	JRST STPX	;XEQ

STPNOS:	CAIE T,263	;POPJ?
	CAIN T,267	;JRA?
	JRST STPJ	;YES
	CAIN T,254	;JRST?
	TLNN M,20	;@?
	JRST STPNO	;NO
STPJ:	SKIPN MSTSW2	;CHECK SWITCH
STPYES:	TLO F,STARSW	;YES, TURN ON STAR
STPNO:	PUSHJ P,OPENQQ	;OPEN PC LOCATION
	TLZN F,STARSW	;WAS IT SUBR CALL?
	JRST STPQQ	;NO
	MOVEI M,.STAR
	HRLM M,NBIGWD
	PUSH P,TYII	;SAVE CURRENT INPUT INSTR
IFN TENEX,<
	PUSH P,BIN1 ;> PUSH P,[INCHRW C]
	POP P,TYII	;DDTIN MODE
	PUSHJ P,REDISP	;DRAW CHANGE, STAR
	PUSHJ P,GCHRS	;YES, GET A CHR.
	PUSH P,B
	PUSH P,C
	PUSHJ P,REDISP	;TURN OFF THE STAR
	POP P,C
	POP P,B
	POP P,TYII	;RESTORE PREV INSTR

	TRNE B,2	;CTL2?
	SETOM MSTSW2	;YES
	TRNE B,1	;CTL1?
	SETZM MSTSW1	;YES
	CAIN C,"S"	;IS IT S?
	JRST STPQ	;YES, STEP
	CAIE C,"X"	;IS IT X?
	JRST ERET	;NEITHER, LEAVE
	TRNE B,1
	SETOM MSTSW1
	MOVE M,@BRKJSQ
	PUSHJ P,XQINST	;IS IT SUBR TYPE?
	JRST STP	;NO
STPX:	PUSHJ P,NOSTP	;YES, EXECUTE THE INST
	JRST MSTEP1	;LOOP

STPQQ:	INCHRS		;IS THERE A CHR?
	JRST STP	;NO
	JRST ERET	; AND LEAVE
>;UESW!FILESW
BEND

;Some Random Variables

IFE DMOVSW,<
^PATCH: BLOCK 20
>
SAVB:	0
SAVC:	0
VALUE:	0
SYM:	0
FNM:	0
NM:	0
SYMP:	0
BLKLV:	0
SIXSYM:	0
IFN REALSW, <INTERN $RPTCNT
$RPTCNT:>
^RPTCNT: 0
; Here is defined the data buffer area for displays -- shared
;  by sort routine for sorted version

IQJ__MAXDLN+2
IQJ__IQJ*LINLEN
DISB:	BLOCK IQJ			;ROOM FOR ALL THE DATA
^DISB__DISB

;SORTED SYMBOL TABLE FORMAT

COMMENT 
		Symbol Table Format

Word 		Description
  0		-1		flags new format symbol table
  1		BN		relative pointer to Block Names
  2		BS		relative pointer to Block Structure
  3		FULLV		relative pointer to full word values
  4		FREES		relative pointer to free space
  5		CLASS1		relative pointer to first class 1 symbol
  6		CLASS2		relative pointer to first class 2 symbol
  7		CLASS3		relative pointer to first class 3 symbol
 10		CLASS4		relative pointer to first class 4 symbol
 11		LASTV		relative pointer to first word beyond
					the symbol table
 BN		table of RADIX50 block and program names
 BS		table of block and program structure (see below)
 FULLV		table of full word values pointed to by class 4 symbols
 FREES		free space for adding symbols.  initially zero
 CLASS1		Pairs of words for each class 1 symbol.
		First word is RADIX50 of symbol name with type flags
		Second word: Byte(13)bnum(5)0(18)value
		where bnum is an index to BN and BS table.
		Class 1 symbols have values in the range 0 to 377777.

 CLASS2		Same as CLASS1 space, except class2 symbols have
		values in the range of 400000 to 777777.

 CLASS3		Same as CLASS1 space, except class3 symbols have
		non-zero values with zero right halves.  The left
		half of the value is stored in the right half of
		the value word of the symbol entry.

 CLASS4		Pairs of words for each class 4 symbol.
		First word is RADIX50 of symbol name with type flags
		Second word: Byte(13)bnum(5)14(18)vp.
		Bnum is an index to BN and BS table.
		Vp is a pointer, relative to beginning of symbol table,
		to a word in the FULLV table that contains the value.
		Note that the index field is set to 14, so that if 14
		contains the address of the symbol table, you may
		indirect through this word.
		Class 4 values are all values not contained in the
		other classes.


Values are sorted by arithmetic order in each class.  Class 3 values
are considered as right-half quantities while being sorted.

Block Structure space:

All pointers in BS space are relative to BS space (and may be used
to index BN space).  BN (block name) space comes before BS space
in the symbol table.

Words corresponding to program names have left-half links to the next
program name.  Zero terminates this list.  Right-halves are zero. 
Word zero of BS space always corresponds to a program name. 

Words corresponding to block names have left-half links to the BS
space word corresponding to the program containing this block.  The
right-half links to the block immediately containing this block.  The
outermost block's right-half link points to the program name word. 
All blocks that are associated with a particular program are entered
immediately following that program name, and before the next program
name.



;SORT

IFN SORTED,<
^UNSHARE__.
RELOC DISB		;SHARE DISPLAY BUFFER AREA

BEGIN SORT

IFN TENEX,<
UPR__400000
SYMTP__765000
>

^SORT:
IFN DEBSYM,<
	SKIPN JOBSYM
	JRST MKSYTB
>
;PASS 1 - LOOK THRU THE OLD SYMBOL TABLE AND COUNT VARIOUS THINGS.

	SETZM CLASST		;ZERO CLASS COUNTERS
	MOVE A,[CLASST,,CLASST+1]
	BLT A,CLASST+5
	HLRE V,JOBSYM		;-N
	MOVN V,V		;N
	SUBI V,2
	HRL V,V			;N-2,,N-2
	HRRZ PV,JOBSYM		;ADDR
	ADD PV,V		;N-2,,ADDR+N-2
	MOVEM PV,OPTR		;SAVE POINTER
SYMLP1:	SKIPN V,(PV)		;GET RADIX50
	JRST SYLP1Z		;NOTHING THERE
	MOVE A,1(PV)		;A_VALUE, V_RADIX50
	MOVEI B,0		;ASSUME "CLASS 0" = BLOCK/PROGRAM NAME
	LDB T,[POINT 4,V,3]	;GET SYMBOL TYPE
	JUMPE T,SYLP1A		;0 IS PROGRAM NAME
	CAIN T,3
	JRST SYLP1A		;14 IS BLOCK NAME
	CAIE T,1		;4 IS NON-DELETED, NON-HALF-KILLED INTERNAL
	JRST NODOTS
	LDB D1,[POINT 32,V,35]	;GET SYMBOL WITHOUT TYPE BITS
	IDIVI D1,50*50		;FLUSH LAST TWO CHARACTERS
	CAME D1,[<RADIX50 0,....XX>/<50*50>]
	JRST NODOTS
	SETZM (PV)		;THIS IS A BOGUS SYMBOL DEFINED IN RAID FOR
	SETZM 1(PV)		;JUST THIS PURPOSE OF PROVIDING SPACE
	JRST SYLP1Z

NODOTS:	PUSHJ P,CLASS		;B_CLASS TYPE (1,2,3 OR 4)
SYLP1A:	AOSA CLASST(B)		;COUNT EACH SYMBOL CLASS
SYLP1Z:	AOS CLASST+5		;COUNT ANOTHER FREE
	SUB PV,[2,,2]
	JUMPG PV,SYMLP1
;;FALL OFF PAGE

;NOW, HOW BIG IS SYMBOL TABLE GOING TO BE?
IFE TENEX,<
IFE FILESW,<
	MOVE V,CLASST+5
	ADDM V,CLASST+5		;NUMBER OF FREE WORDS
	MOVE B,CLASST+4		;NUMBER OF EXTRA WORDS FOR CLASS 4 SYMBOLS
	ADDI B,12		;PLUS OVERHEAD WORDS
	CAMLE B,CLASST+5	;SKIP IF THERE IS ROOM FOR IT ALL
	JRST TOOMAN
	MOVN B,B
	ADDM B,CLASST+5		;LEAVE COUNT OF FREE CELLS
TOOMA3:
>;NOT FILESW
IFN FILESW,<
	MOVEI B,20
	MOVEM B,CLASST+5
	MOVE B,CLASST
	ADD B,CLASST+1
	ADD B,CLASST+2
	ADD B,CLASST+3
	ADD B,CLASST+4
	ASH B,1
	ADD B,CLASST+4
	ADD B,CLASST+5
	ADDI B,12		;NUMBER OF WORDS OF SYMBOL TABLE
	HRRZ C,JOBSYM
	ADDI C,-1(B)
	CORE C,
	JRST 4,.
	MOVN D1,B
	HRLM D1,JOBSYM
>;FILESW
	MOVE A,JOBREL
	MOVEM A,SAVJRL
IFE FILESW,<
	HLL A,JOBSYM		;-WC,,MA-1 OF NEW SYMBOL TABLE
>
IFN FILESW,<
	MOVN B,B
	HRL A,B			;-WC,,MA-1 OF NEW SYMBOL TABLE
>
	ADDI A,1
	MOVEM A,NPTR		;SAVE AOBJN POINTER TO NEW SYMBOL TABLE
	HRRZM A,NBASE		;SET BASE OF NEW SYMBOL TABLE
	HLRZ B,OPTR		;OLD WC-2
	ADDI A,1(B)		;LAST ADDRESS NEEDED
	MOVE C,A		;SAVE THIS (IS LAST ADDRESS FOR BLT)
	HRRZ A,A		;SOME SYSTEMS CARE
	CORE A,			;GET SOME CORE
	JRST 4,.
>;NOT TENEX
IFN TENEX,<.FATAL FIGURE OUT WHAT TO DO HERE>
	MOVE PNT,NBASE
	SETZM (PNT)
	HRL PNT,PNT		;NBASE,,NBASE
	ADDI PNT,1		;SOURCE,,DEST FOR BLT
	BLT PNT,(C)		;ZERO NEW CORE SPACE FOR SYMBOL TABLE
	MOVE PNT,NBASE		;GET BASE ADDRESS AGAIN
	HRROS (PNT)		;-1,, FLAGS THE NEW FORMAT SYMBOLS
	MOVEI C,12		;POINTER TO BN
	MOVEM C,1(PNT)		;BN POINTER
	ADD C,CLASST		;PLUS NUMBER OF BN'S
	MOVEM C,2(PNT)		;GIVES POINTER TO BS'S
	ADD C,CLASST		;PLUS NUMBER OF BS'S (= NUMBER OF BN'S)
	MOVEM C,3(PNT)		;GIVES POINTER TO FV'S
	ADD C,CLASST+4		;PLUS NUMBER OF FV'S
	MOVEM C,4(PNT)		;GIVES POINTER TO FF
	ADD C,CLASST+5		;PLUS AMOUNT OF FREE SPACE
	MOVEM C,5(PNT)		;GIVES POINTER TO CLASS1
	ADD C,CLASST+1
	ADD C,CLASST+1		;PLUS 2*CLASS1 SPACES
	MOVEM C,6(PNT)		;POINTER TO CLASS2 SPACE
	ADD C,CLASST+2
	ADD C,CLASST+2
	MOVEM C,7(PNT)		;POINTER TO CLASS3 SPACE
	ADD C,CLASST+3
	ADD C,CLASST+3
	MOVEM C,10(PNT)		;POINTER TO CLASS4 SPACE
	ADD C,CLASST+4
	ADD C,CLASST+4
	MOVEM C,11(PNT)		;POINTER TO THE END OF THE AREA

;PASS 2 - COPY SYMBOL NAMES TO NEW SYMBOL TABLE.  BUILD BN/BS AREAS

;PNT STILL CONTAINS NBASE

	SETZM CLASST		;ZERO CLASS COUNTERS
	MOVE B,[CLASST,,CLASST+1]
	BLT B,CLASST+5
	SETOM SVSTK
	SETOM ID
	SETZM PD
	MOVE PV,OPTR		;GET POINTER TO OLD TABLE
SYMLP2:	SKIPN V,(PV)		;GET RADIX50
	JRST SYLP2Z		;NOTHING THERE.
	MOVE A,1(PV)		;A_VALUE; V_RADIX50
	LDB T,[POINT 4,V,3]	;GET SYMBOL TYPE
	JUMPE T,SYLP2B		;0 IS PROGRAM NAME
	CAIN T,3
	JRST SYLP2C		;14 IS BLOCK NAME
	PUSHJ P,CLASS		;B_CLASS TYPE (1,2,3 OR 4)
	AOS C,CLASST(B)		;COUNT CLASS TYPE
	CAIN B,3		;CLASS 3 SYMBOL?
	MOVSS 1(PV)		;YES.  SWAP HALVES TO MAKE THE SORT WORK RIGHT
	LSH C,1			;DOUBLE COUNT TO MAKE INDEX
	ADDI B,4(PNT)		;GET ADDRESS OF BASE OF CLASS
	ADD C,(B)		;RELATIVE ADDRESS IN NEW SYMBOL TABLE+2
	ADDI C,(PNT)		;ABSOLUTE ADDRESS+2
	MOVEM V,-2(C)		;STORE RADIX50 OF SYMBOL
	HRLZ M,ID		;GET BLOCK ID
	LSH M,5			;MOVE IT OVER TO MAKE ROOM FOR INDEX/INDIRECT
	HRRI M,1(PV)		;POINTER TO THE VALUE CELL
	MOVEM M,-1(C)		;STUFF IN NEW SYMBOL TABLE
	JRST SYLP2Z		;LOOP

SYLP2B:	MOVE D3,PD		;HERE IF SYMBOL IS PROGRAM NAME
	MOVEI A,0		;ARGUMENT TO SYLPOP
	CAMGE D3,ID		;IF PD .LT. ID THERE WERE NESTED BLOCKS
	PUSHJ P,SYLPOP		;POP NESTED BLOCKS BELONGING TO PREVIOUS PD
	AOS D3,ID		;COUNT NEW PROGRAM ID
	MOVE D1,1(PNT)		;GET BASE OF BN AREA
	ADDI D1,(PNT)
	ADDI D1,(D3)		;PLUS CURRENT INDEX
	MOVEM V,(D1)		;STORE CURRENT PROGRAM NAME IN BN SPACE
	MOVE E,PD		;GET PD OF PREVIOUS PROGRAM
	MOVEM D3,PD		;STORE NEW PD
	MOVE D1,2(PNT)		;GET POINTER TO BS SPACE
	ADDI D1,(PNT)
	ADDI D1,(E)
	HRLZM D3,(D1)		;LH POINTER TO CURRENT ID IN PREVIOUS PROG'S WORD
	JRST SYLP2Z		;GET NEXT

SYLP2C:	AOS D3,ID		;COUNT NEW BLOCK
	MOVE D1,1(PNT)		;GET BASE OF BN AREA
	ADDI D1,(PNT)
	ADDI D1,(D3)		;PLUS CURRENT INDEX
	MOVEM V,(D1)		;STORE CURRENT BLOCK NAME IN BN SPACE
	PUSHJ P,SYLPOP		;A HAS BLOCK LEVEL.
SYLP2Z:	SUB PV,[2,,2]
	JUMPG PV,SYMLP2
	MOVE D3,PD
	MOVE D1,2(PNT)		;GET BASE OF BS AREA
	ADDI D1,(PNT)
	ADDI D1,(D3)		;PLUS CURRENT INDEX
	SETZB A,(D1)		;FINISH BS LINKAGE FOR LAST PROGRAM
	CAMGE D3,ID
	PUSHJ P,SYLPOP		;FINISH DANGLING BLOCK STRUCTURE
;;FALL OFF PAGE

;WE SORT THINGS HERE
	MOVE B,5(PNT)			;FIRST ADDRESS FOR CLASS1
	MOVE C,6(PNT)			;FIRST ADDRESS BEYOND CLASS1
	ADDI B,(PNT)			;MAKE ADDRESSES ABSOLUTE
	ADDI C,-2(PNT)			;MAKE ADDRESS WITHIN CLASS
	CAILE C,(B)			;DON'T SORT EMPTY RANGE OR ONLY ONE ELEMENT
	PUSHJ P,SSORT			;SORT RANGE
	MOVE B,6(PNT)			;FIRST ADDRESS FOR CLASS2
	MOVE C,7(PNT)			;FIRST ADDRESS BEYOND CLASS2
	ADDI B,(PNT)			;MAKE ADDRESSES ABSOLUTE
	ADDI C,-2(PNT)			;MAKE ADDRESS WITHIN CLASS
	CAILE C,(B)			;DON'T SORT EMPTY RANGE OR ONLY ONE ELEMENT
	PUSHJ P,SSORT			;SORT RANGE
	MOVE B,7(PNT)			;FIRST ADDRESS FOR CLASS3
	MOVE C,10(PNT)			;FIRST ADDRESS BEYOND CLASS3
	ADDI B,(PNT)			;MAKE ADDRESSES ABSOLUTE
	ADDI C,-2(PNT)			;MAKE ADDRESS WITHIN CLASS
	CAILE C,(B)			;DON'T SORT EMPTY RANGE OR ONLY ONE ELEMENT
	PUSHJ P,SSORT			;SORT RANGE
	MOVE B,10(PNT)			;FIRST ADDRESS FOR CLASS4
	MOVE C,11(PNT)			;FIRST ADDRESS BEYOND CLASS4
	ADDI B,(PNT)			;MAKE ADDRESSES ABSOLUTE
	ADDI C,-2(PNT)			;MAKE ADDRESS WITHIN CLASS
	CAILE C,(B)			;DON'T SORT EMPTY RANGE OR ONLY ONE ELEMENT
	PUSHJ P,SSORT			;SORT RANGE

;COPY SYMBOL VALUES TO NEW TABLE
	MOVE B,5(PNT)			;FIRST CLASS1 VALUE
	MOVE C,10(PNT)			;FIRST BEYOND CLASS3
	ADDI B,(PNT)			;MAKE ADDRESSES ABSOLUTE
	ADDI C,(PNT)
SYMLP3:	CAIL B,(C)			;AT THE END YET?
	JRST SYML3A			;YES.
	MOVE D1,@1(B)			;GET VALUE
	HRRM D1,1(B)			;REPLACE POINTER WITH VALUE
	ADDI B,2
	JRST SYMLP3

SYML3A:	MOVE B,10(PNT)			;FIRST CLASS4 VALUE
	MOVE C,11(PNT)			;FIRST BEYOND CLASS4
	MOVE D1,3(PNT)			;ADDRESS OF FULL WORD SPACE
	ADDI B,(PNT)			;MAKE ADDRESSES ABSOLUTE
	ADDI C,(PNT)
	ADDI D1,(PNT)
	MOVE D2,3(PNT)			;RELATIVE ADDRESS OF FULL WORD SPACE
	HRLI D2,14			;SET INDEX FIELD
SYML3B:	CAIL B,(C)			;AT THE END YET?
	JRST SYMXIT			;YES, ALL DONE
	MOVE D3,@1(B)			;GET VALUE
	MOVEM D3,(D1)			;STORE IN FULL WORD SPACE
	DPB D2,[POINT 23,1(B),35]	;STORE RELATIVE POINTER TO SYMBOL. AND INDEX
	ADDI B,2			;ADVANCE TO NEXT SYMBOL
	ADDI D1,1			;ADVANCE ABSOLUTE POINTER TO FULL WD SPACE
	AOJA D2,SYML3B			;ADVANCE RELATIVE POINTER TO FULL WD SPACE

SYMXIT:	HRRZ A,JOBSYM
	HRL A,NPTR
	HLRE B,NPTR			;AMOUNT TO BLT
	MOVN B,B
	ADDI B,-1(A)
	BLT A,(B)
IFE TENEX,<
	MOVE A,SAVJRL
	CORE A,
	JFCL
>
IFN TENEX,<.FATAL HERE TOO>
	POPJ P,

;CALL WITH B=FIRST ADDRESS IN RANGE, C=ADDRESS OF LAST ITEM IN RANGE
;THIS IS QUICKSORT WITHOUT STRAIGHT INSERTION SORT FOR SMALL SUBFILES.

SSORT:	MOVEI D1,(B)			;LEFT POINTER
	MOVEI D2,(C)			;RIGHT POINTER
	MOVE D3,@1(D1)			;"KEY LEFT" ELEMENT
MRST1:	CAML D3,@1(D2)			;IF "KEY LEFT" .GT. "KEY RIGHT"
	JRST MRST2			;NEED TO EXCHANGE (OR MAYBE STOP?)
	SUBI D2,2			;MOVE RIGHT SIDE TOWARD CENTER
	JRST MRST1			;LOOP

MRST2:	CAIN D1,(D2)			;REACHED THE MIDDLE YET?
	JRST MRST4			;YES. NOW TIME TO SORT THE SUBFILES.
	MOVE E,(D1)			;EXCHANGE
	EXCH E,(D2)
	MOVEM E,(D1)
	MOVE E,1(D1)
	EXCH E,1(D2)
	MOVEM E,1(D1)
MRST3:	ADDI D1,2			;MOVE LEFT END TOWARD CENTER
	CAMLE D3,@1(D1)
	JRST MRST3			;"KEY RIGHT" .GT. "KEY LEFT"
	CAIN D1,(D2)			;REACHED THE MIDDLE YET?
	JRST MRST4			;YES. NOW TIME TO SORT THE SUBFILES.
	MOVE E,(D1)			;EXCHANGE
	EXCH E,(D2)
	MOVEM E,(D1)
	MOVE E,1(D1)
	EXCH E,1(D2)
	MOVEM E,1(D1)
	SUBI D2,2			;MOVE RIGHT SIDE TOWARD CENTER
	JRST MRST1			;LOOP

MRST4:	MOVEI D3,(C)
	SUBI D3,(B)
	JUMPE D3,CPOPJ			;IF B=C, THE ONE ELEMENT FILE IS SORTED
	LSH D3,-1			;D3=1/2 SIZE OF ORIGINAL FILE.
	MOVEI E,(C)
	SUBI E,(D2)			;E=SIZE OF RIGHT SUBFILE
	CAILE D3,(E)			;IF E .GT. D3 THEN SORT LEFT SUBFILE FIRST
	JRST MRST5			;D3 .GT. E SORT RIGHT SUBFILE FIRST
	MOVSI D3,2(D1)
	HRRI D3,(C)			;LEFT EDGE,,RIGHT EDGE OF RIGHTSUBFILE
	MOVEI C,(D1)			;SET RIGHT EDGE OF SMALL SUBFILE
	JRST MRST6

MRST5:	MOVSI D3,(B)
	HRRI D3,-2(D1)
	MOVEI B,(D1)
MRST6:	PUSH P,D3			;STUFF ON STACK.
	PUSHJ P,SSORT			;!
	POP P,D3
	MOVEI C,(D3)
	HLRZ B,D3
	JRST SSORT

;SYLPOP, CLASS

SYLPOP:	HRL D3,PD		;PD COPIED TO LH OF ARGUMENT
	SKIPGE E,SVSTK		;GET "STACK TOP"
	JRST SYLPSH		;STACK IS EMPTY.  TIME TO PUSH
SYLPP1:	ADD E,2(PNT)		;GET STACK ADDRESS
	ADDI E,(PNT)
	HRRZ D2,(E)
	CAMG D2,A		;IS STACK LEVEL GREATER THAN BLOCK LEVEL?
	JRST SYLPSH		;NO. WE CAN PUSH NEW ENTRY
	HLRE D2,(E)		;GET NEW STACK TOP TO 10
	MOVEM D2,SVSTK		;SAVE NEW STACK TOP
	MOVEM D3,(E)		;STORE NEW STUFF IN STACK
	SKIPL E,D2
	JRST SYLPP1		;LOOP UNTIL NO STACK OR WE FIND THE PLACE
	JUMPLE A,CPOPJ		;STACK EMPTIED.  ONLY PUSH ITEM IF REAL
SYLPSH:	HRL A,SVSTK		;OLD STACK POINTER,,BLOCK LEVEL
	HRRZM D3,SVSTK		;STORE NEW TOP OF STACK
	ADD D3,2(PNT)
	ADDI D3,(PNT)
	MOVEM A,(D3)		;STUFF DATA ON TOP OF STACK.
	POPJ P,


;CALL WITH VALUE IN A, RETURNS CLASS NUMBER IN B
CLASS:	MOVEI B,2
	TDNN A,[-1,,400000]
	SOJA B,CPOPJ
	TLNN A,-1
	POPJ P,
	TRNE A,-1
	ADDI B,1
	AOJA B,CPOPJ

IFE FILESW,<
TOOMAN:
IFE TENEX,<
	OUTSTR LOSMES
>
IFN TENEX,<
	HRROI A,LOSMES
	PSOUT
>
	SUB B,CLASST+5		;NUMBER OF FREE WORDS NEEDED
	MOVNM B,CLASST+5
	MOVE PV,OPTR
TOOMA1:	SKIPN (PV)
	JRST TOOMA2		;NO VALUE THERE
	MOVE A,1(PV)		;GET VALUE
	PUSHJ P,CLASS		;GET ITS CLASS
	CAIE B,4
	JRST TOOMA2		;NOT CLASS 4
	SETZM (PV)
	SETZM 1(PV)
	SOS CLASST+3		;ONE LESS CLASS 4
	AOS CLASST+5		;ANOTHER FREE
	AOSL CLASST+5
	JRST TOOMA3		;GOT ENOUGH
TOOMA2:	SUB PV,[2,,2]
	JUMPG PV,TOOMA1
	JRST TOOMA3

LOSMES:	ASCIZ /
NOT ENOUGH ROOM FOR OVERHEAD WORDS AND FULLWORD VALUES,
DELETING ENOUGH CLASS 4 VALUES TO WIN.
/
>;NOT FILESW

NBASE:	0
OPTR:	0
NPTR:	0		;POINTER TO NEW SYMBOLS
CLASST:	BLOCK 6		;PROG/BLOCK, CLASS 1 THRU CLASS 4, FREE
PD:	0
ID:	0
SVSTK:	0
SAVJRL:	0		;SAVED JOBREL AT SORT

BEND SORT

IFN PADSYM,<
; Add 64 symbols with names ....xx and garbage values, to pad
; symbol table
FOR @' I_0,7,1,<
INTERNAL .....'I
.....'I_I
>
FOR @' I_10,77,1,<
INTERNAL ....'I
....'I_I
>
>;PADSYM
ENDSHARE__.
	RELOC
IFL UNSHARE-ENDSHARE,<.FATAL SORTING CODE TOO BIG TO FIT IN DISPLAY BUFFER>
>;SORTED
XLIST

VAR
LIT
ENDDT:
IFN REALSW,<
DDTEND:	END IFN FILESW,<RAID>
>
IFE REALSW,<END	RAID>