	TITLE	SPELL	SPELLING CHECK & CORRECTION

;;; Make ITS option reading better, not just first letter **********
;;;   or change documentation: at present, "J" denotes TJ6
;;; Does ITS allow altmode in command line when not reading JCL?
;;; Fix it or document it.

;;; Originated by R. E. Gorin, 1971
;;; Revised by W. E. Matson, 1974
;;; Revised by W. B. Ackerman, 1978

;;; %ITS = 1 for ITS, 0 for 10X or 20X
;;; %TNX = 1 for 10X or 20X, 0 for ITS
;;; %20X = 1 for 20X only
;;; %VTS = 1 for system (20X only) with virtual terminal stuff (RTCHR & VTSOP)

%ITS==0 ? %TNX==1 ? %20X==1 ? %VTS==1
IFE .OSMIDAS-SIXBIT /ITS/,[%ITS==1 ? %TNX==0 ? %20X==0 ? %VTS==0]
IFE .OSMIDAS-SIXBIT /TENEX/,[%20X==0 ? %VTS==0]

	SUBTTL	DEFINITIONS

;THESE REGISTERS (AND REGISTER ZERO) ARE GENERAL TEMPORARIES

A=1	;A MUST BE 1 BECAUSE OF IDIVI'S AND LSHC'S
B=2	;B MUST BE A+1 BECAUSE OF LSHC'S
C=3	;TWENEX REQUIRES A, B, C, D AS SHOWN ANYWAY
D=4

;THESE REGISTERS HAVE A QUASI-GLOBAL SIGNIFICANCE AS INDICATED,
;AND MAY NEED TO BE PRESERVED BETWEEN VARIOUS SUBROUTINE CALLS

W=5	;LENGTH OF WORD FROM GETWD
X=6	;BYTE POINTER FROM GETLBP
Y=7	;BYTE POINTER FROM HASHCP
;Y MUST FOLLOW X BECAUSE OF IDIVI'S
Z=10	;POINTER TO DICTIONARY ITEM, FROM SEARCH, INSRTD

;THESE REGISTERS ARE GENERALLY NOT USED BY ANY SUBROUTINES, AND
;MAY BE USED FOR ANY PURPOSE BY THE TOP LEVEL PROGRAM

K=11
L=12
M=13
N=14

;THESE REGISTERS ARE GLOBAL

FLAGS=16	;VARIOUS FLAG BITS, DESCRIBED BELOW
P=17		;PUSHDOWN LIST POINTER

NHASH==6760.	;NUMBER OF HASH CHAINS
MHASH==11327.	;MULTIPLIER FOR HASHCP (MUST BE .LT. 16384)
LPDL==100	;PDL SIZE (MUST BE AT LEAST 28 TO HANDLE "J" COMMAND)
LRBUF==200	;SIZE OF DISK TRANSFERS WHEN READING
MRBUF==20	;MARGIN AROUND READ POINTER, FOR CONTEXT DISPLAY

;I-O CHANNELS:

IFN %ITS,[DKIN==1	;FILE INPUT CHANNEL
DKO1==4		;FILE OUTPUT CHANNEL
ERCHN==5	;CHANNEL FOR OPENING "ERR" DEVICE
TTYI==6		;TERMINAL INPUT
TTYO==7		;TERMINAL OUTPUT
]

DEFINE TYPE ADR
	MOVEI	ADR
	PUSHJ	P,STTYO
TERMIN

;RIGHT HALF FLAGS -- THESE ARE KEPT IN FLAGS REGISTER
;MODE BITS ARE ALSO KEPT IN LOCATION "MODE", SO THAT FLAG
;BITS CAN BE TEMPORARILY TURNED OFF WHEN READING A DICTIONARY

	SPLERR==1	;WHEN QUERYING: ON IF ACTUAL SPELLING ERROR
	PRPTFG==2	;PROPT: USED TO MAKE COMMAS LOOK NICE
	CANDFG==4	;WHEN QUERYING: ON IF TRFX1 HAS BEEN CALLED
	CASERR==10	;ON IF WORD HAS ANOMALOUS CASE
	LOW1==20	;WHEN QUERYING: FIRST LETTER IS LOWER CASE
	LOW2==40	;WHEN QUERYING: SECOND LETTER IS LOWER CASE
	NOCORR==100	;SUPPRESS FILE OUTPUT
	TEMPF1==200	;USED BY DICTIONARY DUMP ROUTINE AND BY EVAL/BVAL
				;AND SET/NO
	FWRITE==400	;DIRECT OUTPUT OF OUTC TO FILE (INSTEAD OF TTY)
	SPLOFF==1000	;ON IF CHECKING HAS BEEN DISABLED BY "SPELLOFF"
	TFORCE==2000	;FORCE TYPEOUT EVEN IF READING FROM JCL STRING
	RDICT==100000	;ON IF READING DICTIONARY (USED BY GETWD)

;LEFT HALF FLAGS -- THESE ARE KEPT IN FLAGS REGISTER
;MODE BITS ARE ALSO KEPT IN LOCATION "MODE", SO THAT FLAG
;BITS CAN BE TEMPORARILY TURNED OFF WHEN READING A DICTIONARY

	TMODE==400	;IN "TEX" JUSTIFIER MODE
	JMODE==1000	;IN "TJ6" JUSTIFIER MODE
	RMODE==2000	;IN "R" JUSTIFIER MODE
	PMODE==4000	;IN "PUB" JUSTIFIER MODE
	SMODE==10000	;IN "SCRIBE" JUSTIFIER MODE
	DMODE==20000	;CONTEXT DISPLAY IS ON
	LMODE==40000	;LISTING OF CLOSE WORDS IS ON
	CMODE==100000	;CHECK CAPITALIZATION

;		WORD FORMAT
;WORDS ARE USUALLY STORED IN WORDIX IN ASCII (5 PER MACHINE WORD)
;AND/OR IN WORDIN IN "5BIT" FORMAT (7 PER MACHINE WORD).
;WORDIX AND WORDIN ARE PADDED WITH ZERO AT THE END.
;REGISTER W GENERALLY CONTAINS THE NUMBER OF LETTERS.
;THEY MUST NEVER EXCEED 42 LETTERS, SINCE INSRTD REQUIRES A FULL
;MACHINE WORD OF ZERO AT THE END, AND WORDIN IS ALLOCATED AS 7
;MACHINE WORDS.  SINCE TRFIX MAY LENGTHEN IT BY ONE, NO WORD
;LONGER THAN 41 LETTERS MAY EVER BE READ IN.

;THE 5BIT CODES ARE UPPERCASE ASCII MINUS 75, OR A=4 ... Z=35 OCTAL.
;APOSTROPHE IS 36 OCTAL. THE REASON FOR MAKING THEM START AT 4
;IS SO THAT EVERY NONEMPTY BYTE IS NONZERO IN THE LEFTMOST 3
;BITS (AS OPPOSED TO THE LEFTMOST 5).
	SUBTTL	VARIABLES AND TABLES

WORDIN:	BLOCK	7	;WORD IN 5BIT (WITH FULL WORD OF ZERO AT END)
WORDIX:	BLOCK	11.	;WORD IN ASCII, MUST FOLLOW WORDIN!!
WWLEN:	BLOCK	1
DCTVER:	BLOCK	2-%ITS	;VERSION OF LOADED DICTIONARY
STTYA:	BLOCK	1	;USED BY STTYO
RWSWT:	BLOCK	1	;USED BY OPENR/OPENW/CFFLSW
FLSWSW:	BLOCK	1	;USED BY OPENR/OPENW/CFFLSW
SAVCHR:	BLOCK	1	;SAVED CHAR IN GETWD (IF IT PEEKS AFTER APOSTROPHE)
BRKCHR:	BLOCK	1	;BREAK CHAR IN GETWD (ALSO USED TO TELL IF AT
			;  BEGINNING OF LINE)
TRMCHR:	BLOCK	1	;COMMENT TERMINATING CHAR IN GETWD
PURE:	0		;NONZERO IF PROGRAM IS PURE (I. E. MUST NOT ALTER
			;   EXISTING DICTIONARY ENTRIES)
NWORDS:	0		;COUNT OF WORDS DURING CORRECTION
FIRSTL:	0		;FIRST LINE TO CHECK
MODE:	RMODE+DMODE+LMODE,,0
			;CURRENT MODE, COPIED INTO FLAGS AT START OF COMMAND
JCLFLG:	BLOCK	1	;CONTROLS JCL READING -- ON ITS THIS IS THE ACTUAL
			;  SCAN POINTER, ON TNX JUST A FLAG.  ON EITHER
			;  SYSTEM NONZERO HERE MEANS THERE IS ANOTHER COMMAND
			;  FROM JCL AND CERTAIN PRINTOUTS SHOULD BE AVOIDED
LWCASE:	BLOCK	1	;NONZERO IF TERMINAL HAS LOWERCASE ABILITY
DICTNN:	0		;NUMBER OF ENTRIES IN DICTIONARIES
FLAGNN:	0		;NUMBER OF FLAGS IN DICTIONARIES
PDL:	BLOCK 	LPDL	;HERE FOR THE INIT PDL
HASHTB:	BLOCK	NHASH/2	;HASH CHAIN HEADER TABLE
LISTFF:	DICTIO		;END OF DICTIONARY
MEMTOP:	0		;END OF AVAILABLE MEMORY (ALWAYS MULTIPLE OF 2000)

IFN %ITS,[
DSPTTY:	BLOCK	1	;NONZERO IF THIS IS A DISPLAY
TOPEND:	BLOCK	1	;NONZERO IF TTY HAS BEEN OPENED
VPSTF:	ASCIZ /V?H/	;STUFF FOR VERTICAL CURSOR POSITIONING
FNML:	BLOCK	3	;LIST OF FILE NAMES
DEVICE:	BLOCK	1
SNAME:	BLOCK	1	;DEFAULT SNAME
TTIPTR:	BLOCK	1	;FOR READING COMMAND BUFFER
CMDBFL=40.		;SIZE OF COMMAND BUFFER
CMDBUF:	BLOCK	CMDBFL	;BUFFER FOR COMMAND LINE
JCLBUF:	BLOCK 100	;BUFFER FOR JCL LINE
JCLBFE=.-1
DUMPBF:	BLOCK	10	;WHERE TO PUT "PDUMP" STRING
JNUM:	BLOCK	1
JNAME:	BLOCK	1
JOBFF:	BLOCK 1
]

IFN %TNX,[

OLDMOD:	BLOCK	1	;SAVED TTY STATE
TCHAR:	BLOCK	1	;TERMINAL CHARACTERISTICS WORD FOR VTS USAGE
INJFN:	BLOCK	1
OUTJFN:	BLOCK	1
LTCTYP:	BLOCK	1
LINOPN:	BLOCK	1	;NEGATIVE WHEN THE COMMAND LINE IS OPEN.
			;  ZERO WHEN CLOSED AFTER READING A LINE -->
			;  CLEAR JCLFLG.  +1 INITIALLY --> LINE IS NOT
			;  OPEN, BUT DON'T CLEAR JCLFLG
COMMIT:	BLOCK	1	;NONZERO WHEN THE COMMAND HAS BEEN ACTED ON
BSAVE:	BLOCK	1	;SAVED FUNCTION BLOCK DURING COMND
NOPNFG:	BLOCK	1	;NONZERO FOR "SAVE" COMMAND, SO IT WON'T
			;  OPEN THE FILE (IT DOES AN SSAVE ON THE UNOPENED JFN)

;; FUNCTION BLOCK FOR "CONFIRMING" -- WHEN NOT READING FROM JCL IT IS AS
;;  SHOWN, OTHERWISE CMMBLK IS LINKED IN TO ALLOW COMMA

CFMBLK:	.CMCFM_27. ? 0 ? 0 ? 0	;CARRIAGE RETURN
CMMBLK:	.CMCMA_27. ? 0 ? 0 ? 0	;COMMA

;; FUNCTION BLOCK FOR "NOISE WORD" -- TEXT POINTER GETS STORED
;;   IN RIGHT HALF OF NZBLK+1

NZBLK:	.CMNOI_27. ? -1,,0 ? 0 ? 0

;; STATE BLOCK FOR READING COMMANDS

STBLK:	0,,0			;CMFLG
	.PRIIN,,.PRIOUT		;CMIOJ, GETS MODIFIED IF READING FROM JCL
	-1,,[ASCIZ /SPELL -> /]	;CMRTY
	-1,,BFR			;CMBFP
	-1,,BFR			;CMPTR
	149.			;CMCNT
	0			;CMINC
	-1,,ABP			;CMABP
	99.			;CMABC
	GJBLK			;CMGJB

GJBLK:	BLOCK 16		;AUXILIARY FUNCTION BLOCK FOR GTJFN
				;  WHEN PARSING FILE NAMES
BFR:	BLOCK 30.
ABP:	BLOCK 20.

TTLARG:	7			;BLOCK FOR "TEXTI" IN TYPLIN
	RD%BEL+RD%CRF+RD%JFN	;BREAK ON CR, LF, OR STUFF IN TABLE,
				;  PACK ONLY ^J IN BUFFER, NOT ^M
				;LOWER BITS OF THIS WORD GET MODIFIED!
	.PRIIN,,.PRIOU		;JFNS TO USE
	0			;PACKING POINTER IN WORDIX, GETS MODIFIED
	0			;CHARACTER COUNT, GETS MODIFIED
	440700,,WORDIX		;BEGINNING OF AREA TO PACK
	0			;(.CMRTY) ^R BUFFER, GETS FILLED WITH PROMPT
	.+1			;BREAK CHARACTER TABLE
	2220,,0			;^G, LF, CR
	20			;?
	0
	0

;TABLE OF DATA FOR ABSOLUTE CURSOR POSITIONING
;BEWARE -- THE "_" CHARACTERS ARE MODIFIED

HPVP:	ASCIZ	/&a__r0C/	;HP
VT52VP:	ASCIZ	/Y_ /		;VT52
VTCVP:	ASCIZ	/[__;H/	;VT100/ANN-ARBOR	BALANCE ]
IMLVP:	ASCIZ	/‘_/	;IMLAC
]

FLGTST:	BLOCK	1	; (PRIVATE TO WTEST/TESTFX) NEEDED FLAG
TWRDX:	BLOCK	7	; (PRIVATE TO WTEST/TESTFX) SAVED WORDIN
TWWSV:	BLOCK	1	; (PRIVATE TO WTEST/TESTFX) SAVED W
TFFLG:	BLOCK	1	; (PRIVATE TO WTEST/TESTFX) FLAG BIT FOR FAILING WTEST
TFPTR:	BLOCK	1	; (PRIVATE TO WTEST/TESTFX) WHERE THAT FLAG IS NEEDED

SVWDWX:	BLOCK	18.	; USED BY TRFX1, CORRE, AND EVAL/EVALB
SVWDLN:	BLOCK	1	; SAME
CANDS:	BLOCK	1	;NUMBER OF CANDIDATES IN CANDBF
CNDPTL:	BLOCK	11.	;LIST OF POINTERS INTO CANDBF (1 MORE THAN
			;MAX NUMBER OF CANDIDATES)
CANDID:	BLOCK	1
CANDBF:	BLOCK	25.	;HOLDS "CANDIDATES" (WORDS NEAR THE SUBJECT WORD)

TLET.1:	BLOCK	1
X1BYPT:	BLOCK	1
SAVEXS:	BLOCK	1
TLET.2:	BLOCK	1
LINENO:	BLOCK	1
IDNUM:	BLOCK	1	;2 * DICTIONARY NUMBER + 1 IF NONZERO, ELSE ZERO

;THESE ARE USED FOR READING AND WRITING FILES

RDABF:	BLOCK	LRBUF+2*MRBUF+1	;FILE INPUT BUFFER
RBUFF=RDABF+2*MRBUF		;WHERE THE DISK TRANSFER ACTUALLY TAKES PLACE
RSVLOC=RDABF+LRBUF+MRBUF	;WHEN READ POINTER GETS HERE, TIME TO GET
				;ANOTHER BLOCK FROM DISK

RDEPT:	BLOCK	1		;END OF CURRENT INPUT BUFFER
RDAPT:	BLOCK	1		;BYTE POINTER FOR READING FILES
RSVWD:	BLOCK	1		;SAVED WORD FROM RSVLOC
RDLOP1:	BLOCK	1		;FIRST LOWER BUFFER LIMIT FOR CONTEXT DISPLAY
RDLOP2:	BLOCK	1		;SECOND LOWER LIMIT (THE REAL ONE)

WBUF1:	BLOCK	200		;OUTPUT BUFFER

WPTR1:	BLOCK	1		;OUTPUT POINTER
WCOUNT:	BLOCK	1		;NEGATIVE OUTPUT CHARACTER COUNT
				; (ONLY TNX USES IT)
PURBEG:				;START OF PURE AREA
	SUBTTL	INITIALIZATION

;*** SHOULD CLEAR LOTS OF VARIABLES (BUT NOT "MODE")

BEGIN:	MOVE	P,[-LPDL,,PDL-1]
	TRZ	FLAGS,FWRITE+TFORCE	;SEND OUTPUT TO TERMINAL, UNLESS JCL
	PUSHJ	P,SETUP		;INITIALIZE THINGS, PRINT VERSION

;FIRST, SET UP SOME THINGS USED BY MANY OPERATIONS

TBLURB:	MOVE	[010700,,RBUFF+LRBUF-1]	;INITIALIZE STUFF FOR FILE READ
	MOVEM	RDAPT
	SETZM	RDEPT
	MOVE	[010700,,RBUFF-1]
	MOVEM	RDLOP1		;WILL GO INTO RDLOP2, WHICH IS
				;LOWER LIMIT FOR CONTEXT DISPLAY
	SETOM	SAVCHR		;IF .GE. 0, TELLS GETWD IT HAS A SAVED CHAR
	MOVEI	^J		;LAST CHAR RETURNED BY GETWD
	MOVEM	BRKCHR		;  (TO LOOK FOR POINT AT LEFT MARGIN)
	SETZM	RBUFF+LRBUF	;PUT PAD (^@) AT END OF READ BUFFER
	SETZM	LINENO
	MOVE	[010700,,WBUF1-1]	;INITIALIZE STUFF FOR FILE WRITE
	MOVEM	WPTR1		;INITIALIZE POINTER
	SETZM	WCOUNT		;NEGATIVE BYTE COUNT
	TRZ	FLAGS,RDICT+NOCORR+FWRITE+TFORCE	;CLEAR VARIOUS FLAGS
	HLL	FLAGS,MODE	;LOAD THE OPTIONS
	MOVEI	3
	MOVEM	IDNUM		;SET DEFAULT DICT NUM = 1 FOR T, L, I COMMANDS
	SETZM	FIRSTL		;WON'T START CHECKING UNTIL REACH THIS LINE
	JRST	GETCMD		;SEE "COMMAND PARSING ROUTINES"
	SUBTTL	SET, CLEAR OPTIONS

MODSET:	PUSHJ	P,OPTPRS	;SET AN OPTION
	PUSHJ	P,CONFRM
	HLLZ	(D)		;GET BITS TO CLEAR
	ANDCAM	MODE		;CLEAR ENTIRE FIELD (IF FORMATTER MODE,
	ANDCAM	FLAGS		;  CLEAR OTHER FORMATTER MODES)
	HRLZ	(D)		;NOW GET BIT TO SET
	IORM	MODE
	IORM	FLAGS
	JRST	ENDCMD

MODCLR:	PUSHJ	P,OPTPRS	;CLEAR AN OPTION
	PUSHJ	P,CONFRM
	HRLZ	(D)		;GET BIT TO CLEAR
	ANDCAM	MODE
	ANDCAM	FLAGS
	JRST	ENDCMD
	SUBTTL	THE CORRECTION ROUTINE

ITSCOR:
IFN %TNX,[
	PUSHJ	P,OPREXT	;OPEN INPUT FILE WITH APPROPRIATE DEFAULT
				;  EXTENSION
	MOVEI	Z,[ASCIZ /to corrected output file/]
	PUSHJ	P,NOISE
]
IFN %ITS,[
	PUSHJ	P,OPENR
]
	PUSHJ	P,CFFLSW	;LOOK FOR OUTPUT FILE, SWITCH, OR NOTHING
	 JRST	ITSCRF		;GOT A FILE
				;GOT SWITCH OR NOTHING, DISABLE WRITING
	TYPE	[[ASCIZ /Warning:  no correction file will be written.
/]]
	TROA	FLAGS,NOCORR
ITSCRF:	 PUSHJ	P,CFSWIT	;LOOK FOR SWITCH OR NOTHING
	JUMPE	C,ITSCR1	;JUMP IF NO SWITCH
	PUSHJ	P,NUMLIN	;SWITCH MUST BE "LINE", LOOK FOR NUMBER
	MOVEM	B,FIRSTL
	PUSHJ	P,CONFRM
ITSCR1:	TYPE	[[ASCIZ /You people never letta program sleep.
/]]
	TRZ	FLAGS,SPLOFF	;WILL GO ON IF SEE "SPELLOFF"
	SETZM	NWORDS

CORLOP:	PUSHJ	P,GETWD
	JUMPE	W,CORCLO	;END OF INPUT FILE
	MOVE	LINENO
	CAML	FIRSTL		;SKIP IF HAVEN'T REACHED STARTING LINE
	TRNE	FLAGS,SPLOFF	;ARE WE CHECKING?
	 JRST	CORLO2		;NO
	AOS	NWORDS		;COUNT WORDS
CORLO7:	PUSHJ	P,WTEST
	 JRST	CORLO5		;FOUND IT DIRECTLY
	 JRST	CORLO5		;FOUND IT INDIRECTLY
	TRO	FLAGS,SPLERR	;WORD IS UNKNOWN
	JRST	CORERR

CORLO5:	TRZ	FLAGS,SPLERR	;WORD IS SPELLED CORRECTLY
	TLNE	FLAGS,CMODE	;CHECKING CAPITALIZATION?
	TRNN	FLAGS,CASERR	;AND WORD IS IN ERROR?
	 JRST	CORLO2

;ERRONEOUS WORD ENCOUNTERED, QUERY THE USER ABOUT IT
;MAY HAVE SPELLING OR CAPITALIZATION ERROR OR BOTH

CORERR:	TRZ	FLAGS,CANDFG+FWRITE	;INITIALIZE SOME FLAGS
	TRO	FLAGS,TFORCE	;REALLY PRINT THE STUFF, EVEN IF IN JCL

;CANDFG WILL BE ON WHEN TRFX1 HAS BEEN CALLED.  ITS PURPOSE
;   IS TO ALLOW THE "L" OPTION TO BE TURNED ON, BUT AVOID
;   CALLING TRFX1 TWICE (TRFX1 IS VERY EXPENSIVE)

	MOVEM	W,SVWDLN	;SAVE WORD LENGTH
	MOVE	[WORDIN,,SVWDWX]
	BLT	SVWDWX+17.	;AND WORDIN AND WORDIX

;THE OFFENDING WORD IS NOW IN SVWDWX ( = OLD WORDIN, WORDIX)
;	AND SVWDLN ( = OLD W)

	SETZM	CANDS		;NUMBER OF CANDIDATES FOUND

;DISPLAY THE VARIOUS THINGS

REDISP:	PUSHJ	P,CLEARS	;CLEAR SCREEN
	TRNE	FLAGS,SPLERR	;WORD MISSPELLED
	TLNN	FLAGS,LMODE	;AND LOOKING FOR CANDIDATES?
	 JRST	.+3		;NO
	TRON	FLAGS,CANDFG	;SEE IF ALREADY LOOKED
	 PUSHJ	P,TRFX1		;IF NOT, FIND ALL CANDIDATES
	TYPE	[[ASCIZ /   /]]	;THREE SPACES TO LINE UP WITH CANDIDATES
	TYPE	WORDIX-WORDIN+SVWDWX	;DISPLAY THE OFFENDING WORD
	TRNE	FLAGS,SPLERR
	 JRST	REDIS2		;SPELLING ERROR, DISPLAY CANDIDATES
	TYPE	[[ASCIZ / :   Incorrect capitalization only/]]
	JRST	CORLOE

REDIS2:	TRNN	FLAGS,CASERR
	 JRST	REDIS3
	TYPE	[[ASCIZ /   (Incorrect capitalization)/]]
REDIS3:	PUSHJ	P,OUTCR		;NEED THIS IF ON A PRINTING TERMINAL
	TLNN	FLAGS,LMODE	;DISPLAYING CANDIDATES?
	 JRST	CORLOE
	PUSHJ	P,VPOS ? 3	;GO TO LINE 3
	SETZ	C,
DISLOP:	CAML	C,CANDS
	 JRST	CORLOE
	MOVE	C		;GET INDEX OF CANDIDATE
	ADDI	"0		;CONVERT TO DIGIT
	PUSHJ	P,OUTC		;PRINT IT
	TYPE	[[ASCIZ /  /]]	;TWO SPACES
	MOVE	A,CNDPTL(C)	;POINTER TO WORD IN CANDBF
	PUSHJ	P,OUT5		;DISPLAY THE WORD
	PUSHJ	P,OUTCR
	AOJA	C,DISLOP

CORLOE:	TLNN	FLAGS,DMODE	;SKIP IF CONTEXT DISPLAY OPTION ON
	 JRST	CORLO0
	PUSHJ	P,VPOS ? 16.	;GO TO LINE 16
	TYPE	[[ASCIZ /Line /]]
	MOVE	LINENO
	PUSHJ	P,DECPTR
	TYPE	[[ASCIZ /:

/]]
	PUSHJ	P,DISLIN	;DISPLAY CONTEXT

CORLO0:	MOVE	[SVWDWX,,WORDIN]	;RESTORE THINGS
	BLT	WORDIN+17.
	MOVE	W,SVWDLN
	PUSHJ	P,VPOS ? 22.	;GO TO LINE 22
	PUSHJ	P,CLEARL
	TYPE	[[ASCIZ /==> /]]

;NOW WORDIN, WORDIX, W = OFFENDING WORD FROM FILE
;SVWDWX, SVWDLN = SAME
;LOW1, LOW2 (FLAGS) = CASE INFO FROM FILE
;CANDFG ON IF TRFX1 HAS BEEN CALLED
;CANDS = NUMBER OF CANDIDATES (ZERO IF "L" OPTION OFF)
;CNDPTL = POINTERS TO CANDIDATES
;CANDBF = THE CANDIDATES, IN 5BIT
;FWRITE = 0, TFORCE = 1 (OUTPUT TO TERMINAL EVEN IF JCL)

;SCREEN HAS
;WORDIX AT TOP
;CANDIDATES (IF ANY)
;LINE NUMBER FROM TEXT FILE
;UP TO 3 LINES OF CONTEXT
;PROMPTING ARROW AT BOTTOM

CORRED:	PUSHJ	P,TTYIN
	CAIN	A,^G
	 JRST	CORCG		;^G : ABORT THE ENTIRE OPERATION
	CAIN	A,"?
	 JRST	CORQUE		;? : PRINT BRIEF DIRECTIONS
	CAIN	A,^L
	 JRST	REDISP		;^L : REDISPLAY EVERYTHING
	CAIGE	A,"0
	 JRST	.+3
	CAIG	A,"9
	 JRST	CORN		;DIGIT : SUBSTITUTE INDICATED CHOICE
	CAIE	A,"+
	CAIN	A,"-
	 JRST	COROPT		;+ OR + : SET OPTION
	CAIN	A,40
	 JRST	CORLO2		;SPACE : ACCEPT THE WORD
	TRZ	A,40		;LOOKING FOR LETTERS NOW:
	CAIN	A,"A		;  CONVERT TO UPPER CASE
	 JRST	CORLO2		;A : ACCEPT THE WORD
	CAIN	A,"I
	 JRST	CORI		;I : INSERT IN DICTIONARY #1
	CAIN	A,"D
	 JRST	CORD		;D : INSERT IN INDICATED DICTIONARY
	CAIN	A,"R
	 JRST	CORRE		;R : RETYPE THE WORD
	CAIN	A,"W
	 JRST	CORX		;W : COPY REST OF THE FILE
CORHUH:	TYPE	[[ASCIZ /  HUH??  /]]
	JRST	CORRED
CORNCO:	TYPE	[[ASCIZ /  Output not being written!!  /]]
	JRST	CORRED


CORQUE:	PUSHJ	P,CLEARS
	TYPE	LBLURB		;PRINT SHORT DIRECTIONS
	TYPE	PRPLST		;AND LAST PART OF SAME
	PUSHJ	P,PROPT		;PRINT CURRENT OPTIONS
	TYPE	[[ASCIZ /

Type any character to restore the display
/]]
	PUSHJ	P,TTYIN
	JRST	REDISP

CORLO2:	PUSHJ	P,PUTWD
	JRST	CORLOP

CORCG:	PUSHJ	P,CLEARS
	TYPE	[[ASCIZ /Do you wish to end this correction right now?  /]]
	PUSHJ	P,TTYIN
	TRZ	A,40
	CAIN	A,"Y
	 JRST	CORCLO		;YES, END IT
	JRST	REDISP

;READ OPTION LETTER AND PROCESS IT, PUTTING RESULT BOTH IN "MODE"
;   AND IN "FLAGS".

COROPT:	MOVEM	A,C		;REMEMBER WHETHER IT WAS + OR -
	PUSHJ	P,TTYIN		;GET OPTION NAME
	TRZ	A,40		;CONVERT TO UPPER CASE
	MOVNI	B,MTABE-MTAB
	CAME	A,MTABE-MTAB(B)+MTABE
	 AOJL	B,.-1		;SEARCH
	JUMPGE	B,CORHUH	;NOT THERE
	CAIE	C,"+
	 JRST	ROPT1
	HLLZ	MTABE(B)	;COMMAND WAS "+", GET BITS TO CLEAR
	ANDCAM	MODE		;CLEAR ENTIRE FIELD (E.G. IF "+T", CLEAR
	ANDCAM	FLAGS			;T, R, P, AND X
	HRLZ	MTABE(B)	;NOW GET BIT TO SET
	IORM	MODE
	IORM	FLAGS
	JRST	REDISP		;REDISPLAY, MAYBE DIFFERENTLY THIS TIME

ROPT1:	HRLZ	MTABE(B)	;COMMAND WAS "-", GET BIT TO CLEAR
	ANDCAM	MODE
	ANDCAM FLAGS
	JRST	REDISP		;REDISPLAY, MAYBE DIFFERENTLY THIS TIME

CORX:	TRNE	FLAGS,NOCORR
	 JRST	CORCLO		;DONE WITH CORRECTING
	TYPE	[[ASCIZ /  Copying .../]]
	PUSHJ	P,PUTWD		;WRITE OUTPUT WORD
	PUSHJ	P,GETWD		;READ INPUT WORD
	JUMPE	W,CORCLO	;EOF HERE
	JRST	.-3

;ACCEPT WORD AND INSERT IN INDICATED DICTIONARY

CORD:	PUSHJ	P,TTYIN		;READ DICTIONARY NUMBER
	CAIL	A,"0
	CAILE	A,"9
	 JRST	CORHUH		;NOT A DIGIT
	SUBI	A,"0		;GET ACTUAL NUMBER
	SKIPA
CORI:	MOVEI	A,1		;INSERT IN DICTIONARY 1
	LSH	A,1		;CONVERT DICT NUM TO 2N+1 FORMAT
	SKIPE	A
	 AOS	A		;UNLESS ZERO
	MOVEM	A,IDNUM		;THIS IS THE FORMAT INSRTD WANTS
	PUSHJ	P,HASHCP
	PUSHJ	P,INSRTD
	JRST	CORLO2		;ACCEPT THE WORD

CORRE:	TRNE	FLAGS,NOCORR
	 JRST	CORNCO		;NOT WRITING OUTPUT, THIS MAKES NO SENSE
	PUSHJ	P,VPOS
	 3			;GO TO LINE 3
	PUSHJ	P,CLEARF	;CLEAR REST OF SCREEN
	MOVEI	Z,[ASCIZ /Type word -> /]
	PUSHJ	P,TYPLIN
	 JRST	REDISP		;HE DIDN'T WANT TO RETYPE AFTER ALL
	SKIPN	WORDIX
	 JRST	REDISP		;NULL LINE

;NOW WORDIX HAS NEW WORD, IN ASCII.  IT MUST BE COPIED INTO WORDIN
;  (TO BE RECHECKED) AND ITS CAPITALIZATION IN WORDIX MUST BE  FORCED
;  TO AGREE WITH THAT OF THE ORIGINAL WORD IF LWCASE IS OFF.
;TEMPF1 WILL BE SET IF THE COPYING INTO WORDIN FAILED AND HENCE THE
;  WORD SHOULD NOT BE RECHECKED.

	MOVE	B,[440700,,WORDIX]
	MOVE	C,[440500,,WORDIN]
	TRZ	FLAGS,TEMPF1	;WILL BE SET IF THERE IS A NON-LETTER
LOP2:	ILDB	B		;GET A LETTER
	JUMPE	CORRE2		;DONE
	CAIN	"'
	 MOVEI	"Z+1
	TRZ	740		;IGNORE CASE
	ADDI	3
	IDPB	C		;PACK FIVEBIT INTO WORDIN (JUNK IF NOT LETTER)
	AOJA	W,.+1		;COUNT IT
	LDB	B		;GET IT AGAIN
	SKIPN	LWCASE
	CAIN	"'
	 JRST	LOP2		;DON'T FIX CAPITALIZATION
	TRZ	40		;MAKE UPPER
	CAIG	"Z		;IS IT REALLY A LETTER?
	CAIGE	"A
	 JRST	LOP4		;DON'T CHANGE CASE OF NON-LETTERS
	CAME	B,[350700,,WORDIX]
	 JRST	.+4
	TRNE	FLAGS,LOW1	;FIRST TIME
	 TRO	40		;CHANGE TO LOWER
	JRST	LOP3
	TRNE	FLAGS,LOW2
	 TRO	40
LOP3:	DPB	B		;PUT IT BACK
	JRST	LOP2
LOP4:	TRO	FLAGS,TEMPF1	;THIS FLAG MEANS THAT THERE IS A NON-LETTER
				;  AND HENCE THAT WORDIN HAS GARBAGE
	JRST	LOP2

CORRE2:	TRNE	FLAGS,TEMPF1	;WAS THE RETYPED STUFF AN ACCEPTABLE WORD?
	 JRST	CORLO2		;NO, JUST PUT IT INTO THE TEXT AND PROCEED
	TRZ	FLAGS,CASERR	;YES, TEST IT AGAIN
	JRST	CORLO7

CORCLO:	PUSHJ	P,CLEARS
	MOVE	NWORDS
	PUSHJ	P,DECPTR
	TYPE	[[ASCIZ / words processed./]]
	TRNN	FLAGS,NOCORR	;ARE WE WRITING OUTPUT?
	 PUSHJ	P,CLOSW		;YES, CLOSE IT
	JRST	CLOR		;CLOSE INPUT

;DIGIT - SUBSTITUTE INDICATED WORD

CORN:	TRNE	FLAGS,NOCORR
	 JRST	CORNCO		;NOT WRITING OUTPUT, THIS MAKES NO SENSE
	SUBI	A,"0		;GET ACTUAL NUMBER
	TLNE	FLAGS,LMODE	;DISPLAYING CANDIDATES?
	 CAML	A,CANDS
	 JRST	CORHUH		;NO, OR NUMBER TOO BIG
	MOVE	B,CNDPTL(A)	;GET ADDRESS OF CHOSEN CANDIDATE
	HRLI	B,440500	;BYTE POINTER TO CHOICE
	MOVE	X,[440700,,WORDIX]

;NOW B POINTS TO NEW WORD IN 5BIT, ITS CASE MUST BE FIXED UP
;   AND COPIED INTO WORDIX IN ASCII

	ILDB	B
	ADDI	75		;CONVERT TO ASCII (CAN'T BE APOSTROPHE)
	TRNE	FLAGS,LOW1
	 TRO	40		;MAKE LOWER CASE
ALWNLP:	IDPB	X
	ILDB	B
	JUMPE	[IDPB X ? JRST CORLO2]
	ADDI	75		;CONVERT TO ASCII
	CAIN	"Z+1
	 MOVEI	"'		;SUBSEQUENT "TRO 40" WON'T AFFECT THIS
	TRNE	FLAGS,LOW2
	 TRO	40
	JRST	ALWNLP
	SUBTTL	THE TRAINING ROUTINE

ITSTRN:
IFN %TNX,[
	PUSHJ	P,OPREXT	;OPEN INPUT FILE WITH APPROPRIATE DEFAULT
				;  EXTENSION
	HRROI	[ASCIZ /EXC/]	;BUT USE "EXC" AS DEFAULT EXTENSION
	MOVEM	GJBLK+.GJEXT	;  INSTEAD OF WHAT IS RETURNED BY OPREXT
	MOVEI	Z,[ASCIZ /to exceptions file/]
]
IFN %ITS,[
	PUSHJ	P,OPENR
]
	PUSHJ	P,OPENW
	PUSHJ	P,CONFRM
	TYPE	MSGWRK
	TRZ	FLAGS,SPLOFF	;WILL GO ON IF SEE "SPELLOFF"
	SETZM	NWORDS

TRNLOP:	TRO	FLAGS,NOCORR+FWRITE
			;OUTPUT TO FILE, BUT SUPPRESS IT WHILE CALLING GETWD
			;SO GETWD WON'T COPY IT
	PUSHJ	P,GETWD
	JUMPE	W,TRNCLO	;END OF INPUT
	TRNE	FLAGS,SPLOFF	;ARE WE CHECKING?
	 JRST	TRNLOP		;NO
	AOS	NWORDS		;COUNT WORDS
	PUSHJ	P,WTEST
	 JRST	TRNLOP		;FOUND IT
	 JRST	TRNLOP
	TRZ	FLAGS,NOCORR	;TURN FILE OUTPUT BACK ON
	PUSHJ	P,HASHCP
	PUSHJ	P,INSRTD	;REMEMBER THE WORD
	MOVEI	A,WORDIN	;POINTER TO THE 5BIT TEXT
	PUSHJ	P,OUT5		;WRITE IT
	PUSHJ	P,OUTCR
	JRST	TRNLOP

TRNCLO:	TRZ	FLAGS,NOCORR+FWRITE	;SO THAT NUMBER GETS PRINTED
	MOVE	NWORDS
	PUSHJ	P,DECPTR
	TYPE	[[ASCIZ / words processed./]]
	PUSHJ	P,CLOSW		;CLOSE FILES
CLOR:	PUSHJ	P,CLOSR
	JRST	ENDCMD
	SUBTTL	THE DICTIONARY LOADER.

NLOAD:	TRO	FLAGS,RDICT+NOCORR	;TO NOTIFY GETWD
IFN %TNX,[
	MOVEI	Z,[ASCIZ /dictionary file/]
	HRROI	[ASCIZ /DCT/]
	MOVEM	GJBLK+.GJEXT
]
	PUSHJ	P,CFMFIL	;LOOK FOR INPUT FILE OR NOTHING
	JUMPE	C,LODEND+1	;NO FILE, JUST PRINT TOTALS
	MOVEI	Z,[ASCIZ /to dictionary number/]
	PUSHJ	P,NOISE
	PUSHJ	P,CFMNUM	;LOOK FOR NUMBER OR END OF LINE
	JUMPE	C,NLOAD0	;NO NUMBER
	LSH	B,1		;CONVERT DICT NUM TO 2N+1 FORMAT
	SKIPE	B
	 AOS	B		;UNLESS ZERO
;;; ***** SHOULD CHECK FOR NUMBER < 10
	MOVEM	B,IDNUM
	PUSHJ	P,CONFRM
NLOAD0:	TYPE	MSGWRK

LOAD2:	PUSHJ	P,GETWD		;READ ONE WORD
	JUMPE	W,LODEND	;END OF FILE
	MOVE	[WORDIN,,SVWDWX]
	BLT	SVWDWX+6	;SAVE WORDIN IN CASE OF ERROR
	CAIGE	W,2
	 JRST	LOAD2		;SINGLE LETTER (MAYBE FLAG LEFT AFTER ERROR)
	MOVE	BRKCHR		;ARE THERE DICTIONARY FLAGS?
	CAIN	"/
	 JRST	LOAD3		;YES, LOAD THE WORD DIRECTLY
	PUSHJ	P,WTEST		;NO, TRY TO OPTIMIZE IT
	 JRST	LOAD2		;ALREADY KNOWN
	 JRST	LOAD2		;ALREADY KNOWN
	SKIPE	IDNUM		;IF NOT GOING TO DICT ZERO, DON'T CALL TESTFX
	 JRST	LOAD3		;  SINCE TESTFX PUTS IT IN DICT ZERO
	PUSHJ	P,TESTFX	;TRY TO SET FLAGS
	 JRST	LOAD3		;NO LUCK, MUST CREATE AN ENTRY
	JRST	LOAD2		;DONE, WORD IS FLAGGED

LOAD3:	PUSHJ	P,SEARCH
	 JRST	.+2
	PUSHJ	P,INSRTD
LOAD4:	MOVE	BRKCHR
	CAIE	"/		;LOOK FOR FLAG LETTERS
	 JRST	LOAD2		;NO
	PUSHJ	P,GETWD		;YES, READ IT
	JUMPE	W,LODEND	;END OF FILE
	MOVE	WORDIX		;THIS "WORD" IS THE FLAG LETTER
	ROT	-29.
	TRZ	40		;CONVERT TO UPPER CASE
	HRLZI	A,FVTAB-FNTAB
	CAMN	FNTAB(A)	;LOOK IT UP
	 JRST	LODFFL		;FOUND THE FLAG
	AOBJN	A,.-2
	TYPE	[[ASCIZ /BAD FLAG: "/]]
	JRST	LODERR

LODFFL:	HRLZ	B,FVTAB(A)	;GET PATTERN FOR DESIRED FLAG
	HLLZ	(Z)		;GET EXISTING FLAGS FOR THIS WORD
	SKIPN	PURE		;IS PROGRAM PURE?
	 TLNE	1		;  OR DICTNUM BIT ON?
	 JRST	LODNF		;YES, CAN'T SET FLAGS
	AND	FVTAB(A)	;CHECK AGAINST MASK FOR DESIRED FIELD
	JUMPN	LODAMB		;ALREADY A PATTERN IN THIS FIELD
	IORM	B,(Z)		;PUT IN THE NEW FLAG
	AOS	FLAGNN		;COUNT IT
	JRST	LOAD4
		 
LODAMB:	CAMN	B		;SEE IF THE RIGHT FLAG IS ALREADY IN
	 JRST	LOAD4		;OK, DO NOTHING
	TYPE	[[ASCIZ /INCONSISTENT FLAG: "/]]
LODERR:	MOVEI	A,WORDIN
	PUSHJ	P,OUT5
	TYPE	[[ASCIZ /" FOR WORD "/]]
	MOVEI	A,SVWDWX
	PUSHJ	P,OUT5
	TYPE	[[ASCIZ /"
/]]
	JRST	LOAD2		;THERE MAY BE MORE FLAGS FOR THIS WORD,
				;  THEY WILL BE IGNORED

LODNF:	TYPE	[[ASCIZ /FLAG NOT ALLOWED: "/]]
	JRST	LODERR

LODEND:	PUSHJ	P,CLOSR		;CLOSE INPUT FILE
	JRST	HLPEND		;PRINT DICTIONARY SIZE
	SUBTTL	DUMP ROUTINE

NDUMP:
IFN %TNX,[
	MOVEI	Z,[ASCIZ /to dictionary file/]
	HRROI	[ASCIZ /DCT/]
	MOVEM	GJBLK+.GJEXT
]
	PUSHJ	P,OPENW		;OUTPUT CHANNEL
	MOVEI	Z,[ASCIZ /from dictionary number/]
	PUSHJ	P,NOISE
	PUSHJ	P,CFMNUM	;LOOK FOR NUMBER OR END OF LINE
	JUMPE	C,NDUMP0	;NO NUMBER GIVEN
	LSH	B,1		;CONVERT DICT NUM TO 2N+1 FORMAT
	SKIPE	B
	 AOS	B		;UNLESS ZERO
	MOVEM	B,IDNUM
NDUMP1:	PUSHJ	P,CONFRM
NDUMP0:	TYPE	MSGWRK
	TRO	FLAGS,FWRITE	;DIRECT OUTPUT TO FILE
	TRZ	FLAGS,NOCORR	;BE SURE OUTPUT GETS WRITTEN
	MOVEI	Z,NHASH		;NUMBER OF CHAINS
	MOVE	Y,[442200,,HASHTB]	;BYTE POINTER TO HEADER TABLE
DODMP1:	ILDB	X,Y		;GET HEADER TO CHAIN
CHASED:	JUMPE	X,DODMP2	;END OF CHAIN
	MOVE	K,X		;REMEMBER THE LINK AHEAD
	HLRZ	A,(X)		;GET DICTNUM STUFF FOR ENTRY
	TRNN	A,1		;CHECK DICTNUM BIT
	 SETZ	A,		;IF OFF, SET TO ZERO
	CAME	A,IDNUM
	JRST	CHAS.2		;SKIP THIS WORD
CHAS.1:	MOVE	A,X	;*** FIX THIS (IS IT OPTIMAL?)
	AOS	A		;POINT TO TEXT PART
	PUSHJ	P,OUT5		;WRITE IT
	HLRZ	A,(X)
	TRNN	A,1		;DICTNUM BIT ON?
	 PUSHJ	P,WFLAGS	;WRITE THE FLAGS ONLY IF BIT OFF
	MOVEI	15
	PUSHJ	P,OUTC
	MOVEI	12
	PUSHJ	P,OUTC
CHAS.2:	HRRZ	X,(K)			;LINK ONWARDS
	JRST	CHASED

DODMP2:	SOJG	Z,DODMP1		;LOOP
	PUSHJ	P,CLOSW
	JRST	ENDCMD
	SUBTTL	"A" AND "B" - ASK FOR SINGLE WORD

EVALB:	TROA	FLAGS,TEMPF1	;"B" - PUT RESULT IN FILE
EVAL:	 TRZ	FLAGS,TEMPF1	;"A" - RESULT TO TERMINAL
	TRZ	FLAGS,FWRITE+NOCORR	;OUTPUT TO TERMINAL
	MOVEI	Z,[ASCIZ /for word/]
	PUSHJ	P,NOISE
	PUSHJ	P,WRDPRS
	TRNN	FLAGS,TEMPF1	;DOING A "B"?
	 JRST	EVLB7		;NO
IFN %TNX,[
	MOVEI	Z,[ASCIZ /to text file/]
	HRROI	[ASCIZ /RPT/]
	MOVEM	GJBLK+.GJEXT
]
	PUSHJ	P,OPENW
EVLB7:	PUSHJ	P,CONFRM
	JUMPE	W,JME		;WORD IS EMPTY

;;;NOW WORD IS IN WORDIN, W

	MOVEM	W,SVWDLN	;ISN'T THIS SORT OF A CROCK?
	MOVE	[WORDIN,,SVWDWX]
	BLT	SVWDWX+17.

	TRNE	FLAGS,TEMPF1	;DOING A "B"?
	 JRST	EVLB		;YES
	TRO	FLAGS,TFORCE	;FORCE OUTPUT EVEN IF IN JCL STRING
	PUSHJ	P,WTEST
	 JRST	QFOUND		;WORD EXISTS DIRECTLY
	 JRST	QINDIR		;WORD EXISTS INDIRECTLY
	PUSHJ	P,TRFX1		;LOOK FOR CLOSE WORDS
	SKIPN	CANDS		;ANY SUGGESTIONS?
	 JRST	EVL3		;NO
	TYPE	[[ASCIZ /No, may i suggest:
/]]
	SETZ	C,
EVLOP:	CAML	C,CANDS
	 JRST	ENDCMD		;DONE
	MOVE	A,CNDPTL(C)	;POINTER TO WORD IN CANDBF
	PUSHJ	P,OUT5		;DISPLAY THE WORD
	TYPE	[[ASCIZ /
/]]
	AOJA	C,EVLOP

EVL3:	TYPE	[[ASCIZ /Couldn't find it/]]
	JRST	ENDCMD

QFOUND:	TYPE	[[ASCIZ /Found it/]]
QEND:	TYPE	[[ASCIZ /    /]]
	SKIPE	K,Z
	 PUSHJ	P,WFLAGS	;PRINT ITS FLAGS IF ENTRY EXISTS
	JRST	ENDCMD

QINDIR:	TYPE	[[ASCIZ /Found it because of  /]]
	HRRZ	A,Z		;DICTIONARY ENTRY THAT WAS USED
	AOS	A		;POINT TO TEXT PART
	PUSHJ	P,OUT5		;PRINT IT
	JRST	QEND

EVLB:	TRO	FLAGS,FWRITE	;OUTPUT TO FILE
	PUSHJ	P,WTEST
	 JRST	EVLB1		;WORD EXISTS DIRECTLY
	 JRST	EVLB2		;WORD EXISTS INDIRECTLY
	PUSHJ	P,TRFX1		;LOOK FOR CLOSE WORDS
	SKIPN	CANDS		;ANY SUGGESTIONS?
	 JRST	EVLB3		;NO
	MOVEI	"&
	PUSHJ	P,OUTC
	SETZ	C,
EVLBOP:	CAML	C,CANDS
	 JRST	QENDZ		;DONE
	MOVE	A,CNDPTL(C)	;POINTER TO WORD IN CANDBF
	PUSHJ	P,OUT5		;DISPLAY THE WORD
	PUSHJ	P,OUTCR
	AOJA	C,EVLBOP

QENDB:	SKIPE	K,Z
	 PUSHJ	P,WFLAGS	;PRINT ITS FLAGS IF ENTRY EXISTS
QENDZ:	PUSHJ	P,OUTCR		;IF "B", CLOSE THE OUTPUT FILE
	PUSHJ	P,CLOSW
	JRST	ENDCMD

EVLB3:	MOVEI	"#
	PUSHJ	P,OUTC
	JRST	QENDZ

EVLB1:	MOVEI	"*
	PUSHJ	P,OUTC
	JRST	QENDB		;WRITE FLAGS

EVLB2:	MOVEI	"+
	PUSHJ	P,OUTC
	HRRZ	A,Z		;DICTIONARY ENTRY THAT WAS USED
	AOS	A		;POINT TO TEXT PART
	PUSHJ	P,OUT5		;PRINT IT
	JRST	QENDB
	SUBTTL	FIND ANAGRAMS

JUMBLE:	TRZ	FLAGS,FWRITE+NOCORR	;OUTPUT TO TERMINAL
	MOVEI	Z,[ASCIZ /word/]
	PUSHJ	P,NOISE
	PUSHJ	P,WRDPRS
	PUSHJ	P,CONFRM
	TRO	FLAGS,TFORCE	;FORCE OUTPUT EVEN IF IN JCL STRING

;;;NOW WORD IS IN WORDIN, W
;;;THIS USES 3W-2 STACK WORDS

	JUMPE	W,JME		;WORD IS EMPTY
	CAILE	W,8.
	 JRST	JME		;TOO LONG
	MOVE	X,[440500,,WORDIN]
	MOVEM	W,K
JM1:	PUSH	P,X
	MOVE	Y,X
	ILDB	X
	SOSN	L,K
	 JRST	JM2
JM4:	ILDB	Y
	LDB	A,X
	DPB	A,Y
	DPB	X
	PUSH	P,L
	PUSH	P,Y
	JRST	JM1

JM2:	PUSHJ	P,WTEST
	 JFCL			;WORD EXISTS DIRECTLY
	 SKIPA			;WORD EXISTS INDIRECTLY
	JRST	JM3
	MOVE	A,[440500,,WORDIN]
	PUSHJ	P,OUT5
	TYPE	[[ASCIZ /
/]]
JM3:	POP	P,X
	AOS	K
	CAMN	W,K
	JRST	ENDCMD
	POP	P,Y
	POP	P,L
	LDB	Y
	LDB	A,X
	DPB	A,Y
	DPB	X
	SOJGE	L,JM4
	JRST	JM3

JME:	TYPE	[[ASCIZ /????
/]]
	JRST	ENDCMD

KILL:	PUSHJ	P,CONFRM	;EXIT AND KILL SELF
IFN %ITS,.BREAK	16,160000
IFN %TNX,[
IFN %20X,[
	MOVE	A,[440700,,[ASCIZ /RESET
/]]
	RSCAN			;STUFF THE COMMAND INTO THE RESCAN BUFFER
				;  (20X ONLY)
	 JRST .+4		;HUH?
	MOVEI	A,.RSINI
	RSCAN			;ACTIVATE IT
	 JFCL
]
	HALTF			;10X OR 20X
	JRST	.-1
]

QUIT:	PUSHJ	P,CONFRM	;EXIT, ALLOW RESTART
IFN %ITS,	.BREAK	16,100000
IFN %TNX,	HALTF
	JRST	BEGIN
	SUBTTL	WTEST	TEST A WORD, USING THE ENDINGS STUFF

; THE WORD IS IN WORDIN AND W
; NO SKIP IF WORD KNOWN DIRECTLY (INCLUDING SINGLE LETTER)
; SKIP ONCE IF KNOWN INDIRECTLY
;   IN ABOVE CASES, ENTRY THAT IT USED IS IN RIGHT HALF OF Z
;   OR Z=0 IF SINGLE LETTER
; SKIP TWICE IF UNKNOWN (CALLING TESTFX MIGHT SET BITS TO MAKE IT KNOWN)
; CLOBBERS 0, A, B, X, Y, Z

WTEST:	CAIGE	W,2		; 2 OR MORE LETTERS LONG?
	 JRST	[SETZ Z, ? POPJ P,]		; NO, ACCEPT IT IMMEDIATELY
	PUSHJ	P,SEARCH
	 POPJ	P,		; OK
	SETZM	TFFLG		; WILL BE NONZERO IF CAN FIX THE WORD
	CAIGE	W,4
	 JRST	CPOPJ2		; DON'T CHECK ENDINGS UNLESS AT LEAST 4 LETTERS
	MOVEM	W,TWWSV		; SAVE W, SINCE WILL CLOBBER IT A LOT
	MOVE	[WORDIN,,TWRDX]
	BLT	TWRDX+6		; SAVE WORDIN ALSO
	PUSHJ	P,GETLBP	; GET LAST LETTER
	CAIN	"D-75		; CHECK FOR "D" (ASCII-75 = 5BIT)
	 JRST	EDT.D		; FOR "CREATED", "IMPLIED", "CROSSED"
	CAIN	"T-75
	 JRST	EDT.T		; FOR "LATEST", "DIRTIEST", "BOLDEST"
	CAIN	"R-75
	 JRST	EDT.R		; FOR "LATER", "DIRTIER", "BOLDER"
	CAIN	"G-75
	 JRST	EDT.G		; FOR "CREATING", "FIXING"
	CAIN	"H-75
	 JRST	EDT.H		; FOR "HUNDREDTH", "TWENTIETH"
	CAIN	"S-75
	 JRST	EDT.S		; FOR ALL SORTS OF THINGS ENDING IN "S"
	CAIN	"N-75
	 JRST	EDT.N		; FOR "TIGHTEN", "CREATION", "MULIPLICATION"
	CAIN	"E-75
	 JRST	EDT.V		; FOR "CREATIVE", "PREVENTIVE"
	CAIN	"Y-75
	 JRST	EDT.Y		; FOR "QUICKLY"
TFAIL:	MOVE	[TWRDX,,WORDIN]	; FAILED
				; (BUT IF TFFLG IS SET MAY BE ABLE TO FIX IT)
	BLT	WORDIN+6	; RESTORE WORDIN
	MOVE	W,TWWSV		; AND W
	JRST	CPOPJ2

EDT.G:	MOVE	GFLAG
	MOVEM	FLGTST
QQG:	PUSHJ	P,KLAST
	PUSHJ	P,GETLBP
	CAIE	"N-75
	 JRST	TFAIL
	PUSHJ	P,KLAST
	PUSHJ	P,GETLBP
	CAIE	"I-75
	JRST	TFAIL
	MOVEI	"E-75		; CHANGE I TO E
	DPB	X		; FOR "CREATING"
	PUSHJ	P,SEARCH
	 PUSHJ	P,ENDSD
	PUSHJ	P,KLAST		; DELETE THE E
	CAIGE	W,2
	 JRST	TFAIL		; GETTING TOO SHORT
	PUSHJ	P,GETLBP
	CAIN	"E-75
	 JRST	TFAIL		; THIS STOPS "CREATEING"
	PUSHJ	P,SEARCH
	 PUSHJ	P,ENDSD		; FOR "FIXING"
	JRST	TFAIL

EDT.D:	MOVE	DFLAG
	MOVEM	FLGTST

; THIS CODE IS USED FOR D, Z, T, AND R FLAGS

QQP:	PUSHJ	P,KLAST		; REMOVE THE D
	PUSHJ	P,GETLBP
	CAIE	"E-75
	 JRST	TFAIL
	PUSHJ	P,SEARCH
	 PUSHJ	P,ENDSD		; THIS GETS "CREATED"
	PUSHJ	P,KLAST
QQQ:	PUSHJ	P,GETLBP	; LOOK AT NEW LAST LETTER
	CAIN	"E-75
	 JRST	TFAIL		; THIS STOPS "CREATEED"

; ENTER HERE FROM "P" FLAG

QQT:	PUSHJ	P,CKVOWL
	JUMPL	A,QQS
	PUSHJ	P,GETLBP	; RESTORE 0 AND X
	CAIN	"Y-75
	 JRST	TFAIL		; THIS STOPS "IMPLYED"
	PUSHJ	P,SEARCH
	 PUSHJ	P,ENDSD		; THIS GETS "FIXED" OR "ALERTNESS"
	LDB	X		; LOOK AT LAST LETTER AGAIN
	CAIE	"I-75
	 JRST	TFAIL
	MOVEI	"Y-75
	DPB	X		; CHANGE I TO Y AND TRY IT AGAIN
	 JRST	QQS		; THIS GETS "IMPLIED" OR "CLOUDINESS"

; HAVE STRIPPED ENDING AND FOUND WORD IN DICTIONARY
; IF THE WORD HAS THE FLAG INDICATED IN FLGTST, WIN
; IF IT IS NOT IN DICTIONARY ZERO, RETURN, SINCE IT COULDN'T HAVE HAD THE FLAG
; IF IT IS IN DICTIONARY ZERO AND DOES NOT HAVE THE FLAG, FAIL

ENDSD:	HLLZ	A,(Z)		; FLAGS HALFWORD OF THE ENTRY
	TLNE	A,1		; IS DICTNUM BIT ON?
	 JRST	CPOPJ		; YES, RETURN FOR MORE TESTING
	POP	P,		; FLUSH STACK ITEM
	HRLZ	FLGTST		; GET DESIRED FLAG INTO LEFT HALF
	AND	A,FLGTST	; GET ACTUAL FLAG FIELD OF ENTRY
	JUMPN	A,ENDSQ		; ENTRY HAS A FLAG IN THIS FIELD
	HRRZM	Z,TFPTR		; NO, RECORD STUFF FOR TESTFX TO USE
	SKIPN	PURE		; DON'T ALLOW FLAG SETTING IF PURE
	 MOVEM	TFFLG		; FLAG BITS TO SET
	JRST	TFAIL

ENDSQ:	CAME	A		; SEE IF FLAG IS THE RIGHT ONE
	 JRST	TFAIL		; NO
	MOVE	[TWRDX,,WORDIN]	; YES, DESIRED FLAG IS ON
	BLT	WORDIN+6	; RESTORE WORDIN
	MOVE	W,TWWSV		; AND W
	JRST	CPOPJ1		; WORD KNOWN INDIRECTLY

EDT.R:	MOVE	RFLAG
	MOVEM	FLGTST
	JRST	QQP

EDT.S:	MOVE	SFLAG
	MOVEM	FLGTST
	PUSHJ	P,KLAST
	PUSHJ	P,GETLBP
	CAIN	"S-75
	 JRST	EDT.P		; CHECK FOR ...NESS
	CAIE	"X-75
	CAIN	"H-75
	 JRST	TFAIL		; OR ...XS OR ...HS
	CAIN	"Z-75
	 JRST	TFAIL		; OR ...ZS
	CAIN	"Y-75
	 JRST	EDT.YS		; CHECK FOR THINGS LIKE "CONVEYS"
	PUSHJ	P,SEARCH
	 PUSHJ	P,ENDSD		; THIS GETS "BATS" UNDER RULE S
	LDB	X		; LOOK AT LAST LETTER AGAIN
	CAIN	"R-75		; LOOK FOR ...RS
	 JRST	EDT.Z		; USE RULE Z
	CAIN	"N-75		; OR ...NS
	 JRST	EDT.X		; USE RULE X
	CAIN	"G-75		; OR ...GS
	 JRST	EDT.J		; USE RULE J
	CAIN	36		; OR ...'S
	 JRST	EDT.M		; USE RULE M
	CAIE	"E-75
	 JRST	TFAIL
	PUSHJ	P,KLAST		; BACK TO RULE S
	PUSHJ	P,GETLBP
	MOVE	A,[000100020500]	; BITS FOR H, S, X, Z
	ROT	A,@0
	JUMPL	A,QQS		; JUMP IF "H", "S", "X", OR "Z"
	CAIE	"I-75
	 JRST	TFAIL
	MOVEI	"Y-75
	DPB	X		; CHANGE I TO Y
	PUSHJ	P,CKVOWL
	JUMPL	A,TFAIL

QQS:	PUSHJ	P,SEARCH
	 PUSHJ	P,ENDSD
	JRST	TFAIL

EDT.YS:	PUSHJ	P,CKVOWL
	JUMPL	A,QQS
	JRST	TFAIL

EDT.P:	MOVE	PFLAG
	MOVEM	FLGTST
	CAIGE	W,5
	 JRST	TFAIL
	PUSHJ	P,KLAST
	PUSHJ	P,GETLBP
	CAIE	"E-75
	 JRST	TFAIL
	PUSHJ	P,KLAST
	PUSHJ	P,GETLBP
	CAIE	"N-75
	 JRST	TFAIL
	PUSHJ	P,KLAST		; WORD WAS ...NESS
	JRST	QQT		; CHECK THE WORD, CHANGE I TO Y
				;   IF NECESSARY

EDT.J:	MOVE	JFLAG
	MOVEM	FLGTST
	CAIGE	W,4
	 JRST	TFAIL
	JRST	QQG

EDT.M:	MOVE	MFLAG
	MOVEM	FLGTST
	PUSHJ	P,KLAST
	JRST	QQS

EDT.Z:	MOVE	ZFLAG
	MOVEM	FLGTST
	CAIGE	W,4
	 JRST	TFAIL		; NOT LONG ENOUGH
	JRST	QQP

EDT.X:	MOVE	XFLAG
	MOVEM	FLGTST
	CAIGE	W,4
	 JRST	TFAIL
	JRST	QQN

EDT.T:	MOVE	TFLAG
	MOVEM	FLGTST
	PUSHJ	P,KLAST
	PUSHJ	P,GETLBP
	CAIE	"S-75
	 JRST	TFAIL
	PUSHJ	P,KLAST
	PUSHJ	P,GETLBP
	CAIE	"E-75
	 JRST	TFAIL
	PUSHJ	P,SEARCH
	 PUSHJ	P,ENDSD
	CAIGE	W,3
	 JRST	TFAIL		; WORD IS GETTING TOO SMALL
	PUSHJ	P,KLAST
	JRST	QQQ


EDT.H:	MOVE	HFLAG
	MOVEM	FLGTST
	PUSHJ	P,KLAST
	PUSHJ	P,GETLBP
	CAIE	"T-75
	 JRST	TFAIL
	PUSHJ	P,KLAST
	PUSHJ	P,GETLBP
	CAIN	"Y-75
	 JRST	TFAIL		; THIS STOPS "TWENTYTH"
	PUSHJ	P,SEARCH
	 PUSHJ	P,ENDSD
	PUSHJ	P,GETLBP
	CAIE	"E-75
	 JRST	TFAIL
	PUSHJ	P,KLAST
	CAIGE	W,2
	 JRST	TFAIL
	PUSHJ	P,GETLBP
	CAIE	"I-75
	 JRST	TFAIL
	MOVEI	"Y-75
	DPB	X
	PUSHJ	P,SEARCH
	 PUSHJ	P,ENDSD
	JRST	TFAIL


EDT.N:	MOVE	NFLAG
	MOVEM	FLGTST
QQN:	PUSHJ	P,KLAST
	PUSHJ	P,GETLBP
	CAIN	"E-75
	 JRST	EDT.EN
	CAIE	"O-75
	 JRST	TFAIL
	PUSHJ	P,KLAST
	PUSHJ	P,GETLBP
	CAIE	"I-75
	 JRST	TFAIL
	MOVEI	"E-75
	DPB	X		; CHANGE "I" TO "E"
	PUSHJ	P,SEARCH
	 PUSHJ	P,ENDSD
	CAIGE	W,6
	 JRST	TFAIL		; WON'T MAKE IT THROUGH 4 DELETIONS
	PUSHJ	P,KLAST
	PUSHJ	P,GETLBP
	CAIE	"T-75
	 JRST	TFAIL
	PUSHJ	P,KLAST
	PUSHJ	P,GETLBP
	CAIE	"A-75
	 JRST	TFAIL
	PUSHJ	P,KLAST
	PUSHJ	P,GETLBP
	CAIE	"C-75
	 JRST	TFAIL
	PUSHJ	P,KLAST
	PUSHJ	P,GETLBP
	CAIE	"I-75
	 JRST	TFAIL
	MOVEI	"Y-75
	DPB	X
	JRST	QQS

EDT.EN:	PUSHJ	P,KLAST
	PUSHJ	P,GETLBP
	CAIE	"E-75
	CAIN	"Y-75
	 JRST	TFAIL		; THIS STOPS "CREATEEN" OR "MULTIPLYEN"
	JRST	QQS

EDT.Y:	MOVE	YFLAG
	MOVEM	FLGTST
	PUSHJ	P,KLAST
	PUSHJ	P,GETLBP
	CAIE	"L-75
	 JRST	TFAIL
	PUSHJ	P,KLAST
	JRST	QQS

EDT.V:	MOVE	VFLAG
	MOVEM	FLGTST
	PUSHJ	P,KLAST
	PUSHJ	P,GETLBP
	CAIE	"V-75
	 JRST	TFAIL
	PUSHJ	P,KLAST
	PUSHJ	P,GETLBP
	CAIE	"I-75
	 JRST	TFAIL
	MOVEI	"E-75
	DPB	X		; CHANGE I TO E
	PUSHJ	P,SEARCH
	 PUSHJ	P,ENDSD
	PUSHJ	P,KLAST		; REMOVE THE E
	CAIGE	W,2
	 JRST	TFAIL		; TOO SHORT NOW
	PUSHJ	P,GETLBP
	CAIN	"E-75
	 JRST	TFAIL		; THIS STOPS "CREATEIVE"
	JRST	QQS

; ATTEMPT TO SET THE FLAG IN THE WORD THAT CAUSED A DOUBLE SKIP IN
; THE LAST CALL TO WTEST

TESTFX:	SKIPN	A,TFFLG
	 POPJ	P,
	IORM	A,@TFPTR	; SET THE BITS
	AOS	FLAGNN
	JRST	CPOPJ1
	SUBTTL	ROUTINES USED BY ENDTST

;SEE IF NEXT-TO-LAST LETTER IS A, E, I, O, OR U
;LEAVES A < 0 IF SO
;CLOBBERS 0, A, X, Y

CKVOWL:	SOS	W		;FOOL GETLBP INTO GETTING EARLIER LETTER
	PUSHJ	P,GETLBP
	AOS	W		;REPAIR THINGS
	MOVE	A,[021040404000]	;THIS HAS BITS ON IN RIGHT PLACES
	ROT	A,@0		;ROTATE A ONE INTO SIGN IF VOWEL
	POPJ	P,

;GET BYTE PTR TO LAST LETTER IN X, THAT LETTER (IN 5BIT) IN 0
;CLOBBERS 0, X, Y

GETLBP:	MOVE	X,W	;LENGTH OF WORD
	SOS	X
	IDIVI	X,7	;X = WORD NUMBER, Y = BYTE NUMBER
	ADD	X,GETLBT(Y)
	LDB	X	;GET THE LETTER ITSELF
	POPJ	P,

;KILL LAST LETTER, REQUIRE X SET UP BY GETLBP
;CLOBBERS 0

KLAST:	SETZ
	DPB	X	;SET IT TO ZERO
	SOS	W
	POPJ	P,

GETLBT:	370500,,WORDIN
	320500,,WORDIN
	250500,,WORDIN
	200500,,WORDIN
	130500,,WORDIN
	060500,,WORDIN
	010500,,WORDIN

CPOPJ2:	AOS	(P)
CPOPJ1:	AOS	(P)
CPOPJ:	POPJ	P,			;NORMALLY A SKIP RETURN
	SUBTTL	TRFX1 - FIND ALL "CLOSE" WORDS

;FIND ALL WORDS CLOSE TO (SVWDWX,SVWDLN), MAKE LIST IN CNDPTL, CANDBF
;SET CANDS = NUMBER FOUND
;CALLER SHOULD HAVE MOVED (WORDIN,W) TO (SVWDWX,SVWDLN)
;CLOBBERS WORDIN, W

TRFX1:	SETZM	CANDS
	MOVEI	CANDBF
	MOVEM	CNDPTL		;INITIALIZE POINTER LIST
	PUSHJ	P,X1SRCH	;TRY MAYBE ONE LETTER WRONG
	PUSHJ	P,XTRNP		;TRY SIMPLE TRANSPOSITION
	PUSHJ	P,X1EXL		;TRY MAYBE DELETE 1 EXTRA LETTER
	PUSHJ	P,X1LMS		;ADD ONE LETTER
	POPJ	P,

;LOAD (WORDIN, W) FROM (SVWDWX, SVWDLN)

UNSVWD:	MOVE	[SVWDWX,,WORDIN]
	BLT	WORDIN+6
	MOVE	W,SVWDLN
	POPJ	P,

;X1SRCH - TRY TO CORRECT ONE MISSPELLED LETTER

X1SRCH:	MOVE	SVWDLN
	MOVEM	TLET.2		;NUMBER OF POSITIONS TO ALTER
	MOVE	[370500,,WORDIN]
	MOVEM	X1BYPT
X1SRC1:	PUSHJ	P,UNSVWD	;GET WORD BACK
	MOVEI	A,33		;TRY ALL LETTERS
	MOVEM	A,TLET.1
X1SRC2:	ADDI	A,3
	DPB	A,X1BYPT
	PUSHJ	P,WTEST
	 JFCL
	 PUSHJ	P,CNSRT
	SOSLE	A,TLET.1
	JRST	X1SRC2
	IBP	X1BYPT		;GO TO NEXT POSITION
	SOSLE	TLET.2
	 JRST	X1SRC1
	POPJ	P,
;XTRNP - ONE PAIR TRANSPOSITION

XTRNP:	MOVE	W,SVWDLN
	MOVEM	W,TLET.1
	SOS	TLET.1
XTRNP1:	SETZM	WORDIN
	MOVE	[WORDIN,,WORDIN+1]
	BLT	WORDIN+6
	MOVE	B,[440500,,WORDIN]
	MOVE	C,[440500,,SVWDWX]
	MOVEI	D,1
XTRNP2:	ILDB	C
	CAMN	D,TLET.1
	JRST	[ILDB	A,C
		IDPB	A,B
		AOJA	D,.+1]
	IDPB	B
	CAMGE	D,W
	 AOJA	D,XTRNP2
	PUSHJ	P,WTEST
	 JFCL
	 PUSHJ	P,CNSRT		;IT IS A WORD, INSERT IT
	SOSLE	TLET.1
	JRST	XTRNP1
	POPJ	P,

;X1EXL - MAYBE HE TYPED ONE EXTRA LETTER

X1EXL:	MOVE	W,SVWDLN	;GET BACK W
	CAIGE	W,3
	POPJ	P,		;CAN'T CORRECT A SHORT WORD
	SOS	W
	MOVEM	W,TLET.1	;TLET.1 WILL SELECT THE LETTER TO
				;SKIP
X1EXL1:	SETZM	WORDIN		;READY FOR BLT
	MOVE	[WORDIN,,WORDIN+1]
	BLT	WORDIN+6
	MOVE	B,[440500,,WORDIN]
	MOVE	C,[440500,,SVWDWX]
	SETZ	D,		;COUNT THE CHARACTERS MOVED
X1EXL2:	ILDB	C
	CAME	D,TLET.1
	 IDPB	B
	CAMGE	D,W
	 AOJA	D,X1EXL2
	PUSHJ	P,WTEST
	 JFCL
	 PUSHJ	P,CNSRT
	SOSL	TLET.1
	 JRST	X1EXL1
	POPJ	P,
;X1LMS - ONE LETTER MISSING

X1LMS:	SETZM	WORDIN
	MOVE	[WORDIN,,WORDIN+1]
	BLT	WORDIN+6
	MOVE	B,[370500,,WORDIN]	;SKIP FIRST CHARACTER
	MOVEM	B,X1BYPT
	MOVE	C,[440500,,SVWDWX]
	MOVE	W,SVWDLN
	MOVEI	D,1
X1LMS3:	ILDB	C
	IDPB	B
	CAMGE	D,W
	AOJA	D,X1LMS3
	ADDI	W,1
	MOVEM	W,TLET.2
X1LM3A:	MOVEI	A,33
	MOVEM	A,TLET.1
X1LMS4:	ADDI	A,3
	DPB	A,X1BYPT
	PUSHJ	P,WTEST
	 JFCL
	 PUSHJ	P,CNSRT
	SOSLE	A,TLET.1
	JRST	X1LMS4
	MOVE	A,X1BYPT
	ILDB	X1BYPT		;ADVANCE TO NEXT POSITION
	DPB	A		;COPY LETTER BACK TO OLD POSITION
	SOSLE	TLET.2
	 JRST	X1LM3A
	POPJ	P,

;INSERT (WORDIN,W) INTO CANDBF

CNSRT:	MOVE	CANDS
	CAIL	10.
	 POPJ	P,		;ALREADY ENOUGH
;THE LIMIT IS 10 BECAUSE MORE WOULD JUST MESS UP THE SCREEN
;   AND THEY COULDN'T BE SELECTED WITH A SINGLE DIGIT
	MOVE	W
	IDIVI	7
	AOS			;NUMBER OF WORDS FOR ITEM
	MOVEM	Z
	SETZ	K,		;COUNTS CANDBF ENTRIES SEARCHED
CNSRT1:	CAMN	K,CANDS
	 JRST	CNSRT4		;REACHED END, WORD NEEDS TO BE ADDED
	MOVN	Y,Z
	HRLZS	Y		;Y = -COUNT,,0
	MOVE	X,CNDPTL(K)	;BASE OF WORD TO COMPARE
CNSRT2:	MOVE	(X)
	AOS	X
	CAME	WORDIN(Y)
	 AOJA	K,CNSRT1	;DOESN'T MATCH, GO TO NEXT
	AOBJN	Y,CNSRT2
	POPJ	P,		;WORD IS ALREADY IN CANDBF

CNSRT4:	MOVE	CNDPTL(K)	;BASE OF ITEM TO CREATE
	MOVEM	CNDPTL+1(K)	;WILL BECOME END
	HRLI	WORDIN
	ADDB	Z,CNDPTL+1(K)	;END OF ITEM TO CREATE
	CAILE	Z,CANDBF+25.
	 POPJ	P,		;WOULD OVERFLOW CANDBF
	SOS	Z
	BLT	(Z)
	AOS	CANDS
	POPJ	P,
	SUBTTL	THE HASH COMPUTATION.

;COMPUTE HASH CHAIN FOR WORD IN WORDIN, WHICH HAS W LETTERS

;LEAVES Y = BYTE POINTER TO HASH CHAIN HEADER
;LEAVES WWLEN = NUMBER OF MACHINE WORDS TO STORE WORD NAME

;CLOBBERS 0, A, Y

HASHCP:	HLRZ	WORDIN	;LEFT HALF OF WORDIN IS FAIRLY RANDOM
	LSH	3	;MAKE ROOM FOR
	ADD	W	;MORE RANDOMNESS
	IMULI	MHASH	;RANDOMIZE
	IDIVI	NHASH	;MODULO NUMBER OF CHAINS (IN A)
	ROT	A,-1	;NOW SIZE OF TABLE IN WORDS, PLUS SIGN BIT
	TLZN	A,400000
	TLOA	A,222200	;MAKE BYTE POINTER FOR APPROPRIATE HALFWORD
	TLO	A,002200
	ADDI	A,HASHTB	;ADD BASE OF HEADER TABLE
	MOVE	Y,A
	MOVE	W
	ADDI	6		;TO ROUND UP TO FULL WORD
	IDIVI	7		;7 CHARS/WORD IN FIVEBIT
	MOVEM	WWLEN		;WORD LENGTH IN MACHINE WORDS
	POPJ	P,
	SUBTTL	SEARCH	LOOK IN DICTIONARY FOR A WORD.

;	THE SUBJECT OF THE SEARCH LIVES IN WORDIN.
;	IT HAS W CHARACTERS, W SHOULD BE .GE. 2
;	SKIP RETURN IF NOT FOUND, NO SKIP IF FOUND
;LEAVES Y AND WWLEN AS SET UP BY HASHCP
;IF FOUND, LEAVES ENTRY IN RIGHT HALF OF Z (LEFT HALF IS JUNK)

;CLOBBERS 0, A, B, Y, Z

SEARCH:	PUSHJ	P,HASHCP
	MOVE	B,WWLEN
	LDB	Z,Y		;GET HEADER TO CHAIN
	IMUL	B,[-1,,0]
	AOSA	B		;NOW B = -WWLEN,,1
SRCH1:	HRRZ	Z,(Z)		;GET NEXT ITEM IN CHAIN
	JUMPE	Z,CPOPJ1	;END OF CHAIN, WORD IS NOT THERE
	HRLI	Z,A		;PUT IN INDEX FIELD, SO INDIRECTION WILL WORK
	MOVE	A,B
;NOW A = -NUMBER OF COMPARES TO GO,,INDEX OF NEXT COMPARE
	MOVE	WORDIN-1(A)	;A STARTS COUNTING AT 1
	CAMN	@Z		;TABLE ENTRY, INDEXED BY A
				;SKIPS WITH A .LT. 0 IF COMPARISON FAILS
	AOBJN	A,.-2		;FALL THROUGH WITH A .GE. 0 IF MATCH FOUND
	JUMPL	A,SRCH1		;FAILED, GET NEXT ENTRY IN CHAIN
	MOVE	@Z		;GET NEXT WORD FROM DICTIONARY ITEM
	TLNE	700000		;SEE IF LEFTMOST 3 BITS ARE OFF
	 JRST	SRCH1		;NO, MATCH IS NOT GOOD
	POPJ	P,		;WORD FOUND, EXIT WITH NO SKIP
	SUBTTL	INSRTD

;INSERT THE WORD AT WORDIN. MUST HAVE Y AND WWLEN SET UP BY HASHCP
;IDNUM = DICTIONARY NUMBER TO PUT IT IN, IN FOLLOWING FORMAT:
;   IF WANT 0, IDNUM = 0
;   IF WANT N, N .NE. 0, IDNUM = 2*N+1
;LISTFF CONTAINS THE ADDRESS OF THE ZERO AT THE END OF THE DICTIONARY
;LEAVES Z POINTING TO THE CREATED ENTRY
;CLOBBERS 0, Z

INSRTD:	MOVE	Z,LISTFF	;BASE OF BLOCK TO CREATE
	MOVE	WWLEN		;AMOUNT WE NEED
	ADDI	1		;NEED WORD FOR CHAIN POINTER
	ADDB	LISTFF
	CAMGE	MEMTOP
	 JRST	INSE35		;HAVE ENOUGH MEMORY
	MOVEI	2000		;ANOTHER 1K
	ADDB	MEMTOP
IFN %ITS,.SUSET	[.SMEMT,,]	;RAISE THE MEMORY BOUND

INSE35:	LDB	Y		;GET CHAIN HEADER
	HRL	IDNUM		;DICTIONARY NUMBER (2N+1 FORMAT)
	MOVEM	(Z)
	DPB	Z,Y		;STORE NEW HEADER
	MOVE	Z
	ADD	[WORDIN,,1]	;FROM ADDR,,TO ADDR
	BLT	@LISTFF		;COPY DATA, INCLUDING WORD OF ZERO AT END
	AOS	DICTNN
	POPJ	P,
	SUBTTL	SUBROUTINE GETWD - READ A REAL WORD

;;; If W ~= 0, word loaded
;;;	5bit in WORDIN, ascii in WORDIX, length in W.
;;;	The delimiter that caused it to stop is in BRKCHR.
;;;	The word may contain "hyphen" characters, they will be in WORDIX
;;;	  but not in WORDIN.  They will not be counted in W:  W always
;;;	  gives the size of WORDIN.  Neither WORDIX no WORDIN will
;;;	  have more than 41 characters.
;;;		(That is, once it gets fixed.)
;;;	Also: CASERR on if illegal capitalization.
;;;	If CASERR off:
;;;		ALL LOWER CASE            - LOW1 = 1  LOW2 = 1
;;;		INITIAL UPPER, REST LOWER - LOW1 = 0  LOW2 = 1
;;;		ALL UPPER CASE            - LOW1 = 0  LOW2 = 0
;;;	   (If CASERR on, LOW1 and LOW2 are random.)
;;;	Manipulates SPLOFF flag when sees appropriate indicators.
;;;	All text before the word (punctuation, formatter commands)
;;;	has been copied into output.  User must copy word (with
;;;	corrected spelling) into output, followed by BRKCHR if
;;;	BRKCHR >= 0.  BRKCHR will be -1 if word was instantly
;;;	followed by end of input file.
;;;
;;; If W = 0, no word: this can happen only if end of input file.
;;; 	Preceding text has been copied.  Caller does not need to
;;;	write anything.
;;;
;;; If called when BRKCHR < 0, returns instantly with BRKCHR < 0
;;;	and W = 0.  This occurs at end of file.

;;; USER MUST PRESERVE BRKCHR BETWEEN CALLS
;;; OBSERVES FORMAT OF JUSTIFIERS ACCORDING TO OPTIONS SELECTED IN
;;;    FLAGS - RETURNS ONLY "TRUE" WORDS, SKIPS AND COPIES ALL ELSE
;;;    (IF SPLOFF ON, IT STILL RETURNS THE STUFF)
;;; COPIES EVERYTHING SKIPPED INTO OUTPUT FILE UNLESS NOCORR IS ON

;;; MUST HAVE SAVCHR=-1, BRKCHR=^J, AND LINENO=0 AT START OF FILE

;;; CLOBBERS 0, A, B, X, Y; SETS UP WORDIN, WORDIX, W, LOW1, LOW2, CASERR
;;; UPDATES SPLOFF
;;; LINENO CONTAINS LINE ON WHICH WORD APPEARED

GETWD:	TRZ	FLAGS,LOW1+LOW2+CASERR	;INITIALIZE CASE FLAGS
	SETZB	W,WORDIN	;SET UP POINTERS AND SUCH
	MOVE	[WORDIN,,WORDIN+1]
	BLT	WORDIX+10.
	MOVE	X,[440700,,WORDIX]
	MOVE	Y,[440500,,WORDIN]
	MOVEI	^J
	MOVEM	TRMCHR		;COMMENT TERMINATOR IN ALL MODES BUT SCRIBE
	MOVE	SAVCHR		;WAITING CHARACTER FROM LAST CALL?
	JUMPGE	RDLOOQ		;YES, PROCESS IT ***** CHECK THIS FOR TEX "\"

RDLOO1:	MOVE	BRKCHR		;CHECK LAST CHARACTER
	CAIGE	40		;SEE IF CONTROL CHAR
	 JRST	RDLCTL		;YES, CHECK FOR VARIOUS SPECIAL THINGS
	TLNE	FLAGS,SMODE+TMODE	;NOT CONTROL CHAR
	 JRST	CHKTEX		;IF NOT "TEX" OR "SCRIBE" MODE, NOTHING TO DO

;NOW BRKCHR = PRECEDING CHARACTER

RDLOOP:	PUSHJ	P,READF		;READ INPUT CHAR
	 JRST	RDEOF		;EOF RETURN
RDLOOQ:	CAILE	"z
	 JRST	WDELIM		;NOT A LETTER
	CAIGE	"a
	 JRST	RDLO1
	TRNN	FLAGS,LOW2	;LOWER CASE LETTER
	 JRST	RDLOW		;NEED TO FIX FLAGS
SCHAR:	IDPB	X		;LETTER FOUND
	TRZ	740		;CONVERT TO 5BIT
	ADDI	3
	IDPB	Y
	AOS	W
	CAME	X,[260700,,WORDIX+10]	;HAVE STORED 42ND CHARACTER?
	 JRST	RDLOOP		;OK, GET ANOTHER
WOVF:	MOVE	X,[440700,,WORDIX]	;WORD TOO LONG *** COMPLAIN IF RDICT ON
	ILDB	X		;UNPACK WHAT WE HAVE
	JUMPE	GETWD		;DONE
	PUSHJ	P,WRITF		;AND COPY IT TO OUTPUT
	JRST	.-3

RDLO1:	CAILE	"Z		;CONTINUE CHECKING
	 JRST	BSL		;DELIMITER, BUT MIGHT BE BACKSLASH
	CAIL	"A
	 JRST	RDUPP		;UPPERCASE LETTER
	CAIN	^Y
	 JRST	CTLY
	CAIN	"'
	 JRST	APO
	CAIN	".		;LOOK FOR POINT AT LEFT MARGIN
	 JRST	POI

;DELIMITER FOUND

WDELIM:	SETOM	SAVCHR		;TURN OFF SAVED CHARACTER FLAG
WDEL1:	MOVEM	BRKCHR		;REMEMBER THIS CHARACTER
	JUMPN	W,CPOPJ		;A WORD EXISTS, EXIT

;WE HAVE DELIMITER BUT NO WORD, SO COPY IT AND READ SOME MORE

	PUSHJ	P,WRITF		;COPY CHARACTER
	JRST	RDLOO1		;CHECK FOR SPECIAL CHARS AND CONTINUE

;PREVIOUS CHARACTER WAS CONTROL CHARACTER

RDLCTL:	JUMPL	RDEOF		;ALREADY SAW END OF FILE
	CAIN	^J
	 AOS	LINENO		;COUNT LINES
	TLNN	FLAGS,JMODE+RMODE+PMODE
	 JRST	RDLOOP		;NO SPECIAL PROCESSING NEEDED
	CAIN	^F
	 JRST	RFONT		;PROCESS ^F IF IN J, P, OR R MODE
	TLNN	FLAGS,RMODE	;OTHERS APPLY ONLY IF IN R MODE
	 JRST	RDLOOP
	MOVE	B,[010700,,[ASCIZ / &&&SPELLO/]-1]
	CAIN	^K
	 JRST	CMN2		;^K --> COMMENT
	CAIN	^X
	 JRST	SREG		;^X --> MACRO NAME
	CAIE	^S
	CAIN	^N
	 JRST	SREG		;^S OR ^N --> REGISTER NAME
	JRST	RDLOOP

;CHECK FOR SPECIAL ACTION FOR "TEX" OR "SCRIBE", BASED ON PREVIOUS CHARACTER

CHKTEX:	TLNN	FLAGS,TMODE
	 JRST	CHKSCR		;SCRIBE MODE, "$" AND "\" ARE INTERESTING
	CAIN	"\
	 JRST	TEXBSL		;READ NAME AND DON'T CHECK SPELLING
	CAIN	"$
	 JRST	CMNX		;COMMENT ENCLOSED IN DOLLARSIGNS
	MOVE	B,[010700,,[ASCIZ / &&&SPELLO/]-1]
	CAIN	"%
	 JRST	CMN2		;DON'T CHECK SPELLING OF REST OF LINE
	JRST	RDLOOP

CHKSCR:	CAIE	"@		;SCRIBE MODE, "@" IS INTERESTING
	 JRST	RDLOOP
	SETZ	B,		;B WILL COLLECT THE KEYWORD
	JRST	SREG		;IGNORE NEXT WORD

;FOUND LOWER CASE LETTER, BUT LOW2 WAS OFF

RDLOW:	JUMPE	W,RDLOW1	;IS FIRST LETTER OF WORD
	TRO	FLAGS,LOW2	;NOT FIRST, SET LOW2
	CAIE	W,1		;SEE IF SECOND
	 TRO	FLAGS,CASERR	;THIRD OR MORE - BUT IF LOW2 WAS OFF,
	JRST	SCHAR		;  FIRST 2 LETTERS MUST BOTH HAVE BEEN CAPS

RDLOW1:	TRO	FLAGS,LOW2+LOW1	;WORD MUST BE ALL LOWER CASE
	JRST	SCHAR

;FOUND UPPERCASE LETTER

RDUPP:	TRNE	FLAGS,LOW2
	 TRO	FLAGS,CASERR	;HAVE SEEN LOWERCASE, THIS IS AN ERROR
	JRST SCHAR

;FOUND APOSTROPHE (SINGLE QUOTE)

APO:	JUMPE	W,APO2		;APOSTROPHE, BUT NO LETTER BEFORE IT
	PUSHJ	P,READF		;PEEK AT NEXT CHAR
	 JRST	RDEOF		;END OF FILE (RATHER ODD)
	CAILE	"z		;SEE IF LETTER
	 JRST	APOOPS		;NO, HAVE READ TOO FAR
	CAIGE	"a
	JRST	APO3
	TROE	FLAGS,LOW2	;LOWER CASE LETTER
	 JRST	APO1		;ALREADY KNOW ABOUT IT
	CAIE	W,1
	 TRO	FLAGS,CASERR	;MUST HAVE HAD TWO UPPER CASE LETTERS BEFORE
	JRST	APO1

APO3:	CAIG	"Z
	CAIGE	"A
	 JRST	APOOPS		;DELIMITER
	TRNE	FLAGS,LOW2	;UPPER CASE LETTER
	 TRO	FLAGS,CASERR	;PREVIOUSLY HAD LOWER CASE
APO1:	MOVEI	A,"'		;APOSTROPHE IS SURROUNDED BY LETTERS,
	IDPB	A,X		;SO PACK IT, ALONG WITH FOLLOWING LETTER
				; ***** CHECK FOR OVERFLOW
	MOVEI	A,36		;5BIT CODE FOR APOSTROPHE
	IDPB	A,Y		;PACK IT IN 5BIT
	AOS	W
	JRST	SCHAR		;NOW PROCESS THE FOLLOWING LETTER

APOOPS:	MOVEM	SAVCHR		;OOPS, SAVE IT FOR NEXT TIME
	MOVEI	"'		;PUT BACK THE APOSTROPHE
	JRST	WDEL1		;PROCESS IT AS DELIMITER

;DELIMITER SEEN, CHECK FOR BACKSLASH BEFORE AN "R" COMMAND, OR TEX HYPHEN

BSL:	CAIE	"\
	 JRST	WDELIM		;NOT BACKSLASH
	JUMPN	W,BSLT		;PRECEDED BY WORD, NOT INTERESTING
	MOVE	A,BRKCHR
	TLNE	FLAGS,RMODE
	CAIE	A,^J
	 JRST	WDELIM		;NOT FIRST CHARACTER IN LINE, OR NOT "R" MODE
BSL1:	PUSHJ	P,WRITF		;COPY HOWEVER MANY BACKSLASHES THERE ARE
	PUSHJ	P,READF
	 JRST	RDEOF		;END IF INPUT???
	CAIN	"\
	 JRST	BSL1
	CAIE	".
	CAIN	"'
	 JRST	STPCHK		;YES, IGNORE THE COMMAND LINE
	JRST	RDLOOQ		;NO, TREAT AS ORDINARY CHARACTER

BSLT:	TLNN	FLAGS,TMODE	;SEE IF BACKSLASH IN WORD IN TEX MODE
	 JRST	WDELIM
	PUSHJ	P,READF		;PEEK AT NEXT CHAR
	 JRST	RDEOF		;END OF FILE (RATHER ODD)
	CAIE	"-		;SEE IF "\-"
	 JRST	BSOOPS
	MOVEI	A,"\
	IDPB	A,X
				; ***** CHECK FOR OVERFLOW
	IDPB	X
				; ***** CHECK FOR OVERFLOW
	JRST	RDLOOP

BSOOPS:	MOVEM	SAVCHR		;OOPS, SAVE IT FOR NEXT TIME
	MOVEI	"\		;PUT BACK THE BACKSLASH
	JRST	WDEL1		;PROCESS IT AS DELIMITER

CTLY:	JUMPE	W,WDELIM	;NO WORD YET? DON'T BOTHER
	TLNN	FLAGS,RMODE	;CONTROL-Y, IS HYPHEN IN R MODE
	 JRST	WDELIM
	IDPB	X		;STORE ASCII IN WORDIX
	CAME	X,[260700,,WORDIX+10]
	 JRST	RDLOOP
	JRST	WOVF

;POINT OR APOSTROPHE SEEN, IT MIGHT BEGIN A "COMMENT"

APO2:	TLNN	FLAGS,RMODE	;APOSTROPHE PRECEDED BY DELIMITER
	 JRST	WDELIM		;NOT IN R MODE, TREAT NORMALLY
POI:	JUMPN	W,WDELIM	;POINT SEEN, CHECK FOR PRECEDING DELIMITER
	TLNN	FLAGS,JMODE+RMODE+PMODE
	 JRST	WDELIM		;NOT IN J, R, OR P MODE, TREAT NORMALLY
	MOVE	A,BRKCHR	;GET LAST DELIMITER
	CAIE	A,^J
	 JRST	WDELIM		;NO, NOT INTERESTING
	MOVE	B,[010700,,[ASCIZ /<< &&&SPELLO/]-1]
	TLNN	FLAGS,PMODE
	 MOVE	B,[010700,,[ASCIZ /C &&&SPELLO/]-1]
	TLNN	FLAGS,JMODE+PMODE
STPCHK:	SETO	B,		;DISABLE &&&SPELLON/OFF CHECKING

;;;READ THE CONTENTS OF A COMMENT -- CHECK FOR &&&SPELLON/OFF
;;;  TRMCHR HAS ")" OR WHATEVER FOR SCRIBE, ^J FOR ALL OTHERS

CHKC:	PUSHJ	P,WRITF		;COPY LAST CHARACTER
CMN2:	PUSHJ	P,READF		;PROCESS COMMENT, B MAY BE LOADED IF LOOKING
				;  FOR INDICATOR TO ENABLE/DISABLE CHECKING
	 JRST	RDEOF
CMN3:	CAMN	TRMCHR		;END OF COMMENT?
	 JRST	WDELIM		;YES
	CAIN	^J
	 AOS	LINENO		;COUNT LINES, IN CASE MULTI-LINE SCRIBE COMMENT
	SKIPL	A,B		;SEE IF CHECKING FOR &&&SPELLON/OFF
	 ILDB	A,B		;YES
	JUMPE	A,FOO		;JUMP IF REACHED END OF WORD BEING LOOKED FOR
	CAME	A
	 JRST	STPCHK
	JRST	CHKC

FOO:	SETO	B,
	CAIN	"N		;CHECK FOR "SPELLON"
	 TRZ	FLAGS,SPLOFF
	CAIE	"F
	 JRST	STPCHK
	PUSHJ	P,WRITF		;COPY THE "F"
	PUSHJ	P,READF		;CHECK FOR ANOTHER
	 JRST	RDEOF
	CAIN	"F
	 TRO	FLAGS,SPLOFF
	JRST	CMN3

CMNX:	PUSHJ	P,READF		;LOOK FOR SECOND DOLLARSIGN
	 JRST	RDEOF
	CAIN	^J
	 AOS	LINENO		;COUNT LINES
	CAIN	"$
	 JRST	CMNX1
CMNX2:	CAIN	"\		;LOOK FOR "\$" IN MATH MODE
	 JRST	TEXQDL
	PUSHJ	P,WRITF
	PUSHJ	P,READF
	 JRST	RDEOF
	CAIN	^J
	 AOS	LINENO		;COUNT LINES
	CAIE	"$
	 JRST	CMNX2
	JRST	CMNX9

TEXQDL:	PUSHJ	P,WRITF
	PUSHJ	P,READF
	 JRST	RDEOF
	CAIN	^J
	 AOS	LINENO		;COUNT LINES
	JRST	CMNX2		;PROCESS NEXT CHAR EVEN IF IT IS "$"

CMNX1:	PUSHJ	P,WRITF		;TWO CONSECUTIVE DOLLARSIGNS
	PUSHJ	P,READF
	 JRST	RDEOF
	CAIN	^J
	 AOS	LINENO		;COUNT LINES
	CAIE	"$
	 JRST	CMNX1
	PUSHJ	P,WRITF
	PUSHJ	P,READF
	 JRST	RDEOF
	CAIN	^J
	 AOS	LINENO		;COUNT LINES
	CAIE	"$
	 JRST	CMNX1
CMNX9:	MOVEM	BRKCHR
	PUSHJ	P,WRITF
	JRST	RDLOOP

TEXBSL:	PUSHJ	P,READF		;BACKSLASH IN "TEX" MODE
	 JRST	RDEOF		;END OF FILE?
	CAIN	"$
	 JRST	CMNX9		;QUOTED DOLLARSIGN
	CAIE	":		;LOOK FOR BACKSLASH-COLON
	 JRST	SREGX		;JUST FLUSH NAME
	PUSHJ	P,WRITF		;FONT SELECT, COPY THE COLON
RFONT:	PUSHJ	P,READF		;READ FONT NUMBER (OR LETTER)
	 JRST	RDEOF		;END OF FILE?
	CAIN	^J
	 AOS	LINENO		;STRANGE FONT, BUT OURS IS NOT TO REASON WHY
	JRST	CMNX9

SREGU:	TLNN	FLAGS,RMODE	;UNDERSCORE, IT IS PART OF NAME IN "R" ONLY
	 JRST	SREND
SREG0:	MOVEM	A		;SCRIBE MODE NEEDS TO KNOW THE WORD
	LSHC	A,-5		;SHIFT CHAR (LOW 5 BITS ARE ENOUGH) INTO B
	PUSHJ	P,WRITF
SREG:	PUSHJ	P,READF		;READ CHARACTER OF NAME
	 JRST	RDEOF		;END OF FILE?
SREGX:	CAIN	"_
	 JRST	SREGU
	CAIG	"z
	CAIGE	"A
	 JRST	SREND
	CAIGE	"a
	CAIG	"Z
	JRST	SREG0
SREND:	TLNN	FLAGS,SMODE
	 JRST	WDELIM		;NOT SCRIBE, THAT'S ALL
	MOVEI	A,")		;CHECK FOR SUITABLE TYPES OF PARENS
	CAIN	"(
	 JRST	SCRWCH
	MOVEI	A,"]
	CAIN	"[
	 JRST	SCRWCH
	MOVEI	A,"}
	CAIN	"{
	 JRST	SCRWCH
	MOVEI	A,">
	CAIN	"<
	 JRST	SCRWCH
	MOVEI	A,""
	CAIN	""
	 JRST	SCRWCH
	JRST	WDELIM		;NO

SCRWCH:	MOVEM	A,TRMCHR	;CHARACTER THAT WILL TERMINATE THE STUFF
	HRLZI	A,SCRTAB-SCRTBE
	CAMN	B,SCRTAB(A)	;SEARCH KEYWORD TABLE
	 JRST	.+3
	AOBJN	A,.-2
	JRST	WDELIM		;NOT A KEYWORD THAT REQUIRES SKIPPING STUFF
	SETO	B,		;REMEMBER NOT TO LOOK FOR "&&&SPELLO"
	TRNN	A,-1		;CHECK FOR FIRST TABLE ITEM, WHICH IS "COMMENT"
	 MOVE	B,[010700,,[ASCIZ /&&&SPELLO/]-1]
	JRST	CHKC

SCRTAB:
<.BYTE 5 ? "T ? "N ? "E ? "M ? "M ? "O ? "C>	;"COMMENT"
<.BYTE 5 ? "N ? "I ? "G ? "E ? "B>		;"BEGIN"
<.BYTE 5 ? "E ? "C ? "A ? "P ? "S ? "K ? "N>	;"BLANKSPACE"
<.BYTE 5 ? "E ? "S ? "A ? "C>			;"CASE"
<.BYTE 5 ? "E ? "T ? "I ? "C>			;"CITE"
<.BYTE 5 ? "K ? "R ? "A ? "M ? "E ? "T ? "I>	;"CITEMARK"
<.BYTE 5 ? "R ? "E ? "T ? "N ? "U ? "O ? "C>	;"COUNTER"
<.BYTE 5 ? "E ? "N ? "I ? "F ? "E ? "D>		;"DEFINE"
<.BYTE 5 ? "E ? "C ? "I ? "V ? "E ? "D>		;"DEVICE"
<.BYTE 5 ? "D ? "N ? "E>			;"END"
<.BYTE 5 ? "E ? "T ? "A ? "U ? "Q ? "E>		;"EQUATE"
<.BYTE 5 ? "E ? "L ? "I ? "F>			;"FILE"
<.BYTE 5 ? "T ? "N ? "O ? "F>			;"FONT"
<.BYTE 5 ? "M ? "R ? "O ? "F>			;"FORM"
<.BYTE 5 ? "P ? "S ? "H>			;"HSP"
<.BYTE 5 ? "E ? "D ? "U ? "L ? "C ? "N ? "I>	;"INCLUDE"
<.BYTE 5 ? "X ? "E ? "D ? "N ? "I>		;"INDEX"
<.BYTE 5 ? "Y ? "R ? "T ? "N ? "E ? "X ? "E>	;"INDEXENTRY"
<.BYTE 5 ? "G ? "A ? "T ? "I>			;"ITAG"
<.BYTE 5 ? "L ? "E ? "B ? "A ? "L>		;"LABEL"
<.BYTE 5 ? "E ? "K ? "A ? "M>			;"MAKE"
<.BYTE 5 ? "Y ? "F ? "I ? "D ? "O ? "M>		;"MODIFY"
<.BYTE 5 ? "F ? "E ? "R ? "E ? "G ? "A ? "P>	;"PAGEREF"
<.BYTE 5 ? "T ? "R ? "A ? "P>			;"PART"
<.BYTE 5 ? "E ? "R ? "U ? "T ? "C ? "I ? "P>	;"PICTURE"
<.BYTE 5 ? "F ? "E ? "R>			;"REF"
<.BYTE 5 ? "D ? "N ? "E ? "S>			;"SEND"
<.BYTE 5 ? "T ? "E ? "S>			;"SET"
<.BYTE 5 ? "T ? "N ? "O ? "F ? "L ? "A ? "I>	;"SPECIALFONT"
<.BYTE 5 ? "G ? "N ? "I ? "R ? "T ? "S>		;"STRING"
<.BYTE 5 ? "E ? "L ? "Y ? "T ? "S>		;"STYLE"
<.BYTE 5 ? "T ? "E ? "S ? "B ? "A ? "T>		;"TABSET"
<.BYTE 5 ? "G ? "A ? "T>			;"TAG"
<.BYTE 5 ? "M ? "R ? "O ? "F ? "T ? "X ? "E>+1	;"TEXTFORM"
<.BYTE 5 ? "E ? "L ? "T ? "I ? "T>		;"TITLE"
<.BYTE 5 ? "E ? "S ? "U>			;"USE"
<.BYTE 5 ? "E ? "U ? "L ? "A ? "V>		;"VALUE"
SCRTBE:

RDEOF:	SETOM	BRKCHR
	POPJ	P,
	SUBTTL	MISCELLANEOUS ROUTINES AND TABLES

;PRINT CURRENT OPTIONS
;CLOBBERS 0, A, B

PROPT:	TLNN	FLAGS,-1
	 POPJ	P,		;NO OPTIONS
	TYPE	[[ASCIZ /
Options are:  /]]
	TRZ	FLAGS,PRPTFG	;WILL BE TURNED ON AFTER PRINT ANYTHING
	MOVNI	B,MTABE-MTAB
PROP1:	HRLZ	A,MTABE(B)	;GET OPTION BIT
	TDNN	FLAGS,A		;IS IT CURRENTLY SET?
	 JRST	PROP2		;NO
	TRON	FLAGS,PRPTFG	;IS THIS FIRST TIME?
	 JRST	PROP3		;YES
	TYPE	[[ASCIZ /, /]]
PROP3:	MOVE	MTABE-MTAB(B)+MTABQ	;GET NAME OF OPTION
	PUSHJ	P,STTYO		;PRINT IT
PROP2:	AOJL	B,PROP1
	POPJ	P,
;PRINT OR WRITE DICTIONARY FLAGS OF ENTRY POINTED TO BY K,
;DEPENDING ON FWRITE
;CLOBBERS 0, A, B

WFLAGS:	HRLZI	A,FVTAB-FNTAB
DDCVR3:	HLLZ	FVTAB(A)	;MASK INTO LEFT HALF
	TLO	1		;MAKE IT CHECK LOW BIT (DICTNUM BIT)
				;  SO IT WILL FAIL IF BIT IS ON
	AND	(K)		;PICK OUT FIELD FROM DICT ENTRY
	HRLZ	B,FVTAB(A)	;BITS THAT IT SHOULD HAVE
	CAME	B		;DO THEY MATCH?
	 JRST	DDCVR4		;NO (OR DICTNUM BIT IS ON)
	MOVEI	"/		;YES, FLAG IS ON
	PUSHJ	P,OUTC
	MOVE	FNTAB(A)	;PICK UP FLAG NAME
	PUSHJ	P,OUTC
DDCVR4:	AOBJN	A,DDCVR3	;SCAN THROUGH THE TABLE
	POPJ	P,

;TABLE OF OPTION BITS
;LEFT HALF = BITS TO CLEAR BEFORE SETTING A BIT
;	(SO THAT ONLY ONE OF "T", "R", "P", OR "X" WILL BE ON)
;RIGHT HALF = BIT FOR THIS SPECIFIC OPTION

MTAB:
JMBITS:	RMODE+PMODE+TMODE+SMODE,,JMODE
RMBITS:	JMODE+PMODE+TMODE+SMODE,,RMODE
PMBITS:	JMODE+RMODE+TMODE+SMODE,,PMODE
TMBITS:	JMODE+RMODE+PMODE+SMODE,,TMODE
SMBITS:	JMODE+RMODE+PMODE+TMODE,,SMODE
DMBITS:	DMODE,,DMODE
LMBITS:	LMODE,,LMODE
CMBITS:	CMODE,,CMODE

MTABE:	"J ? "R ? "P ? "T ? "S ? "D ? "L ? "C
MTABQ:	JMNAME ? RMNAME ? PMNAME ? TMNAME
	SMNAME ? DMNAME ? LMNAME ? CMNAME

JMNAME:	ASCIZ /TJ6/
RMNAME:	ASCIZ /R/
PMNAME:	ASCIZ /PUB/
TMNAME:	ASCIZ /TEX/
SMNAME:	ASCIZ /SCRIBE/
DMNAME:	ASCIZ /DISPLAY/
LMNAME:	ASCIZ /LIST/
CMNAME:	ASCIZ /CAPITALIZATION/

;TABLE OF DICTIONARY FLAGS
;ENTRIES ARE MASK,,VALUE

FVTAB:
PFLAG:	60000,,40000
DFLAG:	10000,,10000
TFLAG:	05000,,04000
RFLAG:	02000,,02000
ZFLAG:	05000,,01000
MFLAG:	05000,,05000
GFLAG:	00400,,00400
HFLAG:	00200,,00200
NFLAG:	00100,,00100
XFLAG:	00040,,00040
VFLAG:	60000,,20000
YFLAG:	00010,,00010
JFLAG:	60000,,60000
SFLAG:	00002,,00002

;NAME TABLE, MUST FOLLOW VALUE TABLE

FNTAB:	"P
	"D
	"T
	"R
	"Z
	"M
	"G
	"H
	"N
	"X
	"V
	"Y
	"J
	"S
;PROMPTING MESSAGES

MSGWRK:	ASCIZ /Workin
/
PRPLST:	ASCIZ %+/-J - Turn TJ6 mode on/off
+/-R - Turn R mode on/off
+/-P - Turn PUB mode on/off
+/-T - Turn TEX mode on/off
+/-S - Turn SCRIBE mode on/off
+/-D - Turn context display on/off
+/-L - Turn list of close words on/off
+/-C - Turn capitalization checking on/off (don't use this yet)
%

LBLURB:	ASCIZ /
^G  - Abort entire correction
^L  - Restore the display
<space> or A - Accept the word, but do not remember it
I   - Accept word and put it in dictionary #1
0 to 9   - Substitute the numbered choice
D1 to D9 - Accept the word and put it in indicated dictionary
R   - Replace the word manually
W   - Accept the word and copy the rest of the file without checking
/
	SUBTTL	MISCELLANEOUS IO ROUTINES

;PRINT OR WRITE CR AND LF
;WRITE ON OUTPUT FILE IF FWRITE ON, PRINT ON TERMINAL IF OFF
;FILE OUTPUT SUPPRESSED IF NOCORR ON
;CLOBBERS 0

OUTCR:	HRRZI	^M
	PUSHJ	P,OUTC
	HRRZI	^J		; FALL INTO OUTC

;PRINT OR WRITE CHARACTER IN AC0
;WRITE ON OUTPUT FILE IF FWRITE ON, PRINT ON TERMINAL IF OFF
;FILE OUTPUT SUPPRESSED IF NOCORR ON
;CLOBBERS 0

OUTC:	TRNN	FLAGS,FWRITE
	 JRST	PRINC
	JRST	WRITF

;PRINT OR WRITE WORD (IN 5BIT) POINTED TO BY A, NO FINAL CRLF
;WRITE ON OUTPUT FILE IF FWRITE ON, PRINT ON TERMINAL IF OFF
;FILE OUTPUT SUPPRESSED IF NOCORR ON
;CLOBBERS 0

OUT5:	PUSH	P,A
	HRLI	A,440500	;BYTE POINTER
WRTW1:	ILDB	A		;GET ONE LETTER
	TRNN	34		;CHECK FOR END
	 JRST	POPJA		;(COULD BE JUNK IN LOW 2 BITS)
	ADDI	75		;CONVERT TO UPPER CASE ASCII
	CAIN	"Z+1
	 MOVEI	"'		;SPECIAL CODE FOR APOSTROPHE
	PUSHJ	P,OUTC		;WRITE IT
	JRST	WRTW1

;DECIMAL PRINT OR WRITE AC0
;WRITE ON OUTPUT FILE IF FWRITE ON, PRINT ON TERMINAL IF OFF
;FILE OUTPUT SUPPRESSED IF NOCORR ON
;CLOBBERS 0

DECPTR:	PUSH	P,A
	IDIVI	10.		;QUOTIENT TO 0, REMAINDER TO A
	SKIPE	
	 PUSHJ	P,DECPTR	;PRINT MORE DIGITS
	MOVE	A
	ADDI	"0
	PUSHJ	P,OUTC
POPJA:	POP	P,A
	POPJ	P,

;WRITE OUT THE CONTENTS OF WORDIX
;PLUS THE CHARACTER IN BRKCHR, UNLESS IT IS < 0

PUTWD:	MOVE	X,[440700,,WORDIX]
	ILDB	X
	JUMPE	.+3
	PUSHJ	P,WRITF
	JRST	.-3
	SKIPGE	BRKCHR
	 POPJ	P,
	HRRZ	BRKCHR
	JRST	WRITF
	SUBTTL	READ FROM FILE

;READ CHARACTER FROM INPUT FILE, RETURNS IT IN AC0, SKIP IF NOT END OF FILE
;  IF END OF FILE, MUST NOT CALL AGAIN
;THIS ALLOWS LAST WORD OF FILE TO BE PADDED WITH ^@, ^A, ^B, ^C

READF:	ILDB	RDAPT
	CAILE	^C
	 JRST	CPOPJ1		;OK
	HRRZ	RDAPT		;GET WORD IT CAME FROM
	SKIPE	RDEPT		;IS THIS A SHORT BUFFER?
	 JRST	READNF		;YES
	CAIGE	RSVLOC		;NO, ARE WE AT THE MARK?
	 JRST	RETC		;NO, THE PAD MUST BE REAL
	MOVE	RSVWD		;RESTORE THE SAVED WORD
	MOVEM	RSVLOC
	MOVN	[340000,,LRBUF+1]
	ADDM	RDAPT		;MOVE RDAPT BACK
	MOVE	[RDABF+LRBUF,,RDABF]
	BLT	RBUFF-1		;COPY STUFF DOWN TO START OF BUFFER
	MOVE	[010700,,RDABF-1]
	EXCH	RDLOP1
	MOVEM	RDLOP2		;NOW RDLOP2 -> RBUFF-1 AFTER
				;FIRST TRANSFER, RDABF-1 AFTER OTHERS
	PUSHJ	P,RDISK		;READ BLOCK AT RBUFF
	 JRST	RDA7		;BLOCK IS SHORT
	MOVE	RSVLOC
	MOVEM	RSVWD		;SAVE WORD FROM BUFFER
	SETZM	RSVLOC		;CLOBBER IT TO ^@ (SO WILL NOTICE WHEN HIT IT)
	JRST	READF

RDA7:	HRRZM	RDEPT		;POINTS TO WORD AFTER END OF TRANSFER
	SETZM	@RDEPT		;PUT ^@ AT END OF DATA
	SOS	RDEPT		;NOW POINTS TO LAST WORD OF DATA
	JRST	READF

READNF:	CAMGE	RDEPT
	 JRST	RETC		;PAD NOT IN LAST WORD OF FILE - IT IS REAL
	CAMLE	RDEPT
	 POPJ	P,		;PAST END, FILE HAS ENDED
	HLRZ	RDAPT		;IN LAST WORD, GET POSITION
	CAIN	350700		;LEFTMOST BYTE?
	 JRST	RETC		;YES, THIS CAN'T BE FILLING END OF FILE
	PUSH	P,RDAPT		;MAKE A COPY OF THE POINTER
RDA2:	ILDB	(P)		;PEEK AT REST OF WORD
	CAIG	^C		;SEE IF REST OF WORD IS ALL PADS
	 JRST	RDA4		;YES
	POP	P,		;NO, SO THIS IS NOT FILLING END OF FILE
RETC:	LDB	RDAPT		;RELOAD THE PAD
	JRST	CPOPJ1

RDA4:	HRRZ	(P)		;SEE WHERE WE ARE
	CAMN	RDEPT		;STILL IN SAME WORD?
	 JRST	RDA2		;YES, KEEP PEEKING
;WORD WAS PADDED TO THE END, SO THIS IS END OF FILE
	POP	P,		;THROW AWAY TEMPORARY POINTER
	 POPJ	P,		;END OF FILE
	SUBTTL	WRITE, CLOSE FILE

;WRITE AC0 TO OUTPUT FILE, UNLESS NOCORR IS ON
;CLOBBERS 0

WRITF:	TRNE	FLAGS,NOCORR
	 POPJ	P,		;OUTPUT IS SUPPRESSED
	IDPB	WPTR1
	MOVE	WPTR1
	CAME	[010700,,WBUF1+177]
	 POPJ	P,
	SUBI	200
	MOVEM	WPTR1
	MOVNI	200
	PUSHJ	P,WDISK		;WRITE 200 WORDS
	POPJ	P,

;CLOSE OUTPUT FILE
;CLOBBERS 0, A

CLOSW:	SETZ	A,		;COUNTS NUMBER OF PADS WRITTEN
CLOSW1:	MOVE	WPTR1
	TLNE	760000		;ON A WORD BOUNDARY?
	 JRST CLOC3		;NO
	SUBI	WBUF1-1		;NOW 010700,,WORDS TO WRITE
	HRRZS	0		;WORDS TO WRITE
	MOVNS	0
	JUMPE	.+2
	 PUSHJ	P,WDISK		;WRITE LAST BUFFER
	MOVN	WCOUNT		;NUMBER OF WORDS WRITTEN
	IMULI	5		;NUMBER OF BYTES, INCLUDING PADS
	SUB	A		;NUMBER OF BYTES OF ACTUAL FILE
				;(BYTE COUNT IS USED ONLY ON TNX)
	PUSHJ	P,CLZW		;CLOSE THE FILE
	POPJ	P,

CLOC3:	MOVEI	^C*%ITS		;PAD REST OF WORD (^C on ITS, ^@ on TNX)
	TRZ	FLAGS,NOCORR	;TO BE SURE IT GETS WRITTEN
	PUSHJ	P,WRITF
	AOJA	A,CLOSW1	;COUNT NUMBER OF PADS
	SUBTTL	DISPLAY CONTEXT

;DISPLAY CONTEXT AROUND WORD JUST READ.  DISPLAYS 1, 2, OR 3
;LINES, WITH CRLF AFTER EACH.
;MAY DISPLAY MORE, IF LINES ARE LONG AND OPERATING SYSTEM PUTS
;IN CONTINUATION LINES, OR IF FILE HAS CR'S WITHOUT LF'S.
;IF SO, PROMPTING ARROW MAY OVERWRITE STUFF, OR IT MAY HIT
;END OF SCREEN AND GO INTO A **MORE** WAIT.  SORRY ABOUT THAT.

;CLOBBERS 0, X, Y, K

DISLIN:	MOVE	RSVWD
	SKIPN	RDEPT
	 MOVEM	RSVLOC	;TEMPORARILY RESTORE SAVED WORD

;SEARCH BACKWARD TO LINE FEED

	MOVE	X,RDAPT
	MOVEI	K,20		;THIS COUNTS CHARACTERS
DISL1:	ADD	X,[070000,,0]	;BACK UP X
	SKIPGE	X
	 SUB	X,[430000,,1]
	CAMN	X,RDLOP2	;AT BEGINNING OF BUFFER?
;RDLOP2 NORMALLY = 010700,,RDABF-1 BUT IS MOVED UP ON FIRST
;BUFFER TO COMPENSATE FOR LACK OF OVERLAP
	 JRST	DISL2		;YES, STOP NOW
	LDB	X
	CAIE	^J		;SEARCH FOR LINE FEED
	 SOJA	K,DISL1		;KEEP SEARCHING AND COUNTING

;FOUND BEGINNING OF LINE.  IF PASSED 20 CHARS, THAT'S ENOUGH.
;IF NOT, DO ONE MORE LINE (BUT NO MORE THAN ONE).

	TLON	K,600000	;IF K NEGATIVE, ENOUGH
	 JRST	DISL1		;NO, MAKE IT NEGATIVE SO WILL ONLY DO THIS ONCE

;NOW X POINTS JUST BEFORE FIRST CHARACTER TO DISPLAY
;SEARCH FORWARD TO SECOND LINE FEED

DISL2:	MOVE	Y,RDAPT
	MOVEI	K,15		;COUNTS CHARACTERS

;REASON IT WAS 20 BEFORE AND 15 THIS TIME IS THAT POINTER IS AT END
;OF SUSPECT WORD, THIS SORT OF COMPENSATES FOR IT

	LDB	Y
	JRST	DISL6

DISL4:	TLNE	Y,760000	;AT RIGHTMOST BYTE?
	 JRST	DISL5		;NO, DON'T STOP
	HRRZ	Y		;GET WORD BEING POINTED TO
	CAIGE	RBUFF+LRBUF-1	;END OF BUFFER?
	CAMN	RDEPT		;OR END OF SHORT BUFFER?
	 JRST	DISLZ		;YES, STOP
DISL5:	ILDB	Y
DISL6:	CAIE	^J		;SEARCH FOR LINE FEED
	 SOJA	K,DISL4		;KEEP SEARCHING AND COUNTING

;FOUND END OF LINE.  IF PASSED 15 CHARS, THAT'S ENOUGH.
;IF NOT, DO ONE MORE LINE (BUT NO MORE THAN ONE).

	TLON	K,600000	;IF K NEGATIVE, ENOUGH
	 JRST	DISL4		;NO, MAKE IT NEGATIVE SO WILL ONLY DO THIS ONCE

;NOW Y POINTS TO LAST CHARACTER TO DISPLAY

DISL7:	CAMN	X,Y
	 JRST	DISL8		;DONE
	ILDB	X
	PUSHJ	P,PRINC
	JRST	DISL7

DISL8:	SKIPN	RDEPT
	 SETZM	RSVLOC		;REPLACE ^@ MARKER IF NECESSARY
	POPJ	P,

;HAD TO STOP FORWARD SCAN BECAUSE HIT END--MAY NEED TO FLUSH PADS
;  AT END OF FILE TO AVOID UGLINESS

DISLZ:	LDB	Y
	CAILE	^C
	 JRST	DISL7		;IT'S OK
	ADD	Y,[070000,,0]	;BACK UP Y TO STRIP OFF THE PAD
	SKIPGE	Y
	 SUB	Y,[430000,,1]
	JRST	DISLZ		;TRY AGAIN
	SUBTTL	COMMAND PARSING ROUTINES FOR TWENEX

IFN %TNX,[

GETCMD:	SETZM	GJBLK+.GJDEV	;RESET FILE DEFAULTS
	SETZM	GJBLK+.GJNAM
	SETZM	GJBLK+.GJEXT
	SETZM	GJBLK+.GJDIR
	SETZM	GJBLK+.GJPRO
	SETZM	GJBLK+.GJACT
	SETZM	GJBLK+.GJJFN
	SETOM	INJFN		;MARK THE JFN'S UNUSED
	SETOM	OUTJFN
	SKIPGE	LINOPN
	 JRST	PARSE		;LINE IS ALREADY OPEN
	SKIPN	LINOPN
	 SETZM	JCLFLG		;LAST LINE HAS BEEN CLOSED, NO MORE JCL
	SETZM	COMMIT		;WILL ALLOW REPARSING UNTIL THIS IS SET
	SETOM	LINOPN
	HRRZS	STBLK		;CLEAR OLD ERROR FLAGS
	MOVE	[.PRIIN,,.PRIOUT]
	SKIPE	JCLFLG
	 MOVE	[.CTTRM,,.NULIO]
	MOVEM	STBLK+.CMIOJ
	MOVEI	0
	SKIPE	JCLFLG
	 MOVEI	CMMBLK		;IF READING FROM JCL, ALLOW COMMA
	HRRM	CFMBLK		;   AS COMMAND TERMINATOR
	MOVEI	A,STBLK
	MOVEI	B,[.CMINI_27. ? 0 ? 0 ? 0]
	COMND			;INITIALIZE

PARSE:	MOVE	P,[-LPDL,,PDL-1]	;RESTORE STACK
	SKIPL	A,INJFN		;FLUSH ANY LEFTOVER JFNS
	RLJFN			;  (THEY ARE NOT OPEN)
	 JFCL
	SETOM	INJFN
	SKIPL	A,OUTJFN
	RLJFN
	 JFCL
	SETOM	OUTJFN
	SETZM	NOPNFG		;WILL BE SET BY "SAVE" COMMAND
	PUSHJ	P,CKPRSI		;READ FIRST COMMAND
	 .CMKEY_27.+CM%HPP ? KTABLE ? -1,,[ASCIZ /command,/] ? 0
	HRRZ	D,(B)
	JRST	(D)

;;GET HERE AT END OF ANY COMMAND

ENDCMD:	SETOM	COMMIT		;UNTIL END OF LINE SEEN, CAN'T ALLOW
	JRST	TBLURB		;  ANY REPARSE, ELSE WOULD DO THE COMMAND OVER

;;; CHECK THAT THERE IS NOTHING FURTHER IN COMMAND
;;; THIS ALWAYS RETURNS WITH C=0

CONFRM:	MOVEI	B,CFMBLK	;CFMBLK IS IN VARIABLES AREA BECAUSE IT
	JRST	CKPRSE		;  GETS MODIFIED:  WHEN READING FROM JCL
				;  IT ALLOWS A COMMA AS WELL AS A CR

;;; LOOK FOR LINE NUMBER, RETURN IT IN B WITH C~=0
;;; PROMPT AS SHOWN

NUMLIN:	JSP	B,CKPRSE
	 .CMNUM_27.+CM%HPP+CM%SDH ? 10. ? -1,,[ASCIZ /starting line number/] ? 0

;;; LOOK FOR NUMBER OR NOTHING
;;; C=0 IF NOTHING, C~=0 IF NUMBER, VALUE IN B
;;; PROMPT AS "DECIMAL NUMBER"

CFMNUM:	JSP	B,CKPRSE	;LOOK FOR NUMBER OR RETURN
	 .CMNUM_27.+CFMBLK ? 10. ? 0 ? 0

;;; LOOK FOR SWITCH OR NOTHING
;;; C=0 IF NOTHING, C~=0 IF SWITCH

CFSWIT:	JSP	B,CKPRSE	;LOOK FOR SWITCH OR RETURN
CFSWTB:	.CMSWI_27.+CM%HPP+CFMBLK ? STABLE ? -1,,[ASCIZ /switch,/] ? 0

;;; LOOK FOR WORD, PACK IT WORDIX FOLLOWED BY NULL
;;; ALSO IN WORDIN (IN FIVEBIT) AND LENGTH IN W
;;; THIS ALWAYS RETURNS WITH C~=0
;;; PROMPT AS SHOWN

WRDPRS:	MOVEI	B,WDP1
	PUSHJ	P,CKPRSE	;LOOK FOR TEXT STRING
	MOVE	[ABP,,WORDIX]
	BLT	WORDIX+10.	;SAVE WORD IN WORDIX
	SETZB	W,WORDIN
	MOVE	[WORDIN,,WORDIN+1]
	BLT	WORDIN+6	;CLEAR WORDIN
	MOVE	X,[440700,,WORDIX]
	MOVE	Y,[440500,,WORDIN]
JVL1:	ILDB	X		;PACK WORD INTO FIVEBIT
	JUMPE	CPOPJ
	CAIN	"'
	 MOVEI	"Z+1
	TRZ	740		;IGNORE CASE
	ADDI	3
	IDPB	Y
	AOJA	W,JVL1

;;; BREAK CHARACTER MASKS FOR WRDPRS ARE SET UP SO THAT
;;; ALL ARE BREAK EXCEPT LETTERS AND APOSTROPHE

WDP1:	.CMFLD_27.+CM%HPP+CM%BRK ? 0 ? -1,,[ASCIZ /word to check/] ? 0 ? .+1
	777777,,777760 ? 775777,,777760 ? 400000,,000760 ? 400000,,000760

;;; LOOK FOR OPTION NAME, RETURN WITH D=ADDRESS OF BITS WORD IN MTAB
;;; THIS ALWAYS RETURNS WITH C~=0
;;; PROMPT AS SHOWN

OPTPRS:	PUSHJ	P,CKPRSI
	 .CMKEY_27.+CM%HPP ? OTABLE ? -1,,[ASCIZ /option,/] ? 0
	HRRZ	D,(B)
	POPJ	P,

;;; LOOK FOR INPUT FILE OR NOTHING
;;; C=0 IF NOTHING, C~=0 IF FILE
;;; SEE COMMENTS AT OPENR

CFMFIL:	PUSHJ	P,NOISE
	MOVSI	A,(GJ%OLD+GJ%CFM+GJ%FNS)
	MOVEM	A,GJBLK+.GJGEN
	JSP	B,CKPRSE
	 .CMFIL_27.+CFMBLK ? 0 ? 0 ? 0

;;; LOOK FOR OUTPUT FILE, SWITCH, OR NOTHING
;;; IF GET FILE, NO SKIP, LEAVE C~=0
;;; OTHERWISE, SKIP -- C=0 IF NOTHING, C~=0 IF SWITCH
;;; SEE COMMENTS AT OPENW

CFFLSW:	MOVSI	A,(GJ%FOU+GJ%MSG+GJ%CFM+GJ%FNS)
	MOVEM	A,GJBLK+.GJGEN
	PUSHJ	P,CKPRSI
	 .CMFIL_27.+CFSWTB ? 0 ? 0 ? 0
	CAIE	C,.CMFIL_9.	;GOT A FILE?
	 AOS	(P)
	POPJ	P,

;; PRINT GUIDE WORD, POINTER TO TEXT IN Z

NOISE:	HRRM	Z,NZBLK+1
	MOVEI	B,NZBLK
	JRST	CKPRSE

;; CHECK RESULT OF PARSE, WILL ABORT AND START OVER IF NOT RIGHT
;; LEAVES C WITH ADDRESS OF COMMAND BLOCK THAT WAS USED,
;;   OR ZERO IF COMMAND HAS BEEN FULLY PARSED (C.R. OR COMMA)
;; IF C=0, CALLER MUST GO AHEAD WITH THE COMMAND AND GO TO ENDCMD,
;;   THE FILES WILL BE OPEN
;; C=0 WILL HAPPEN ONLY IF CALLER REQUESTED IT BY CALLING CONFRM OR
;;   SOME FUNCTION INCLUDING CFMBLK

CKPRSE:	HRRZS	B		;CLEAR JUNK IN LEFT HALF
	MOVEM	B,BSAVE
	MOVEI	A,STBLK
	COMND
	HRRZS	C		;NOW C HAS FUNCTION BLOCK THAT IT USED
	TLNN	A,(CM%RPT+CM%NOP)	;SEE IF IT FAILED OR GOT RUBBED OUT
	 JRST	PRSOK		;IT WORKED
	TLNE	A,(CM%NOP)
	 JRST	PRSNOK		;IT FAILED
	SKIPN	COMMIT		;IT GOT RUBBED OUT, JUST REPARSE IT
	 JRST	PARSE
PLOSE:	HRROI	A,[ASCIZ /You can't reparse through this stuff!!!!!!
/]
	PSOUT
;;IF  READING FROM JCL AND END OF LINE HASN'T BEEN SEEN, FLUSH REST OF LINE
FIXJCL:	TLNN	A,(CM%EOC)	;SKIP IF END OF LINE SEEN
	SKIPN	JCLFLG
	 JRST	JCFE
	HRRZS	STBLK		;CLEAR OLD ERROR FLAGS
	MOVEI	B,[.CMTXT_27. ? 0 ? 0 ? 0]
	MOVEI	A,STBLK
	COMND			;FLUSH THE LINE BY FORCING READ TO LINEFEED
JCFE:	SETZM	JCLFLG
	SETZM	LINOPN
	JRST	TBLURB

PRSOK:	HLRZ	C,(C)		;GET THE FUNCTION THAT WAS PERFORMED
	CAIE	C,.CMFIL_9.	;SEE IF IT WAS A FILE NAME
	 JRST	PRSOQ		;NO
	MOVE	GJBLK+.GJGEN	;SEE WHETHER READ OR WRITE
	TLNE	(GJ%OLD)
	 HRRZM	B,INJFN		;READ
	TLNN	(GJ%OLD)
	 HRRZM	B,OUTJFN	;WRITE
PRSOQ:	CAIN	C,.CMCFM_9.
	 SETZM	LINOPN
	CAIE	C,.CMCFM_9.
	CAIN	C,.CMCMA_9.
	SKIPA
	 POPJ	P,		;NOT FINISHED READING COMMAND
	SKIPGE	A,INJFN		;SEE WHETHER TO OPEN INPUT FILE
	 JRST	CKOPW		;NO
	MOVEI	B,OF%RD+OF%PLN	;READ, FORGET ABOUT "LINE NUMBERS"
	OPENF
	 JRST	OPNFA3
	SKIPE	DCTVER		;AM I LOOKING FOR A DICTIONARY VERSION?
	 JRST	CKOPW		;NO, FINISHED
	HRROI	A,DCTVER	;YES, GET VERSION OF THIS FILE
	MOVE	B,INJFN
	MOVSI	C,(JS%GEN/7*.JSAOF)	;GET GENERATION NUMBER
	JFNS
CKOPW:	SKIPL	A,OUTJFN	;SEE WHETHER TO OPEN OUTPUT FILE
	SKIPE	NOPNFG
	 JRST	CLRC		;NO
	MOVEI	B,OF%WR+OF%PLN	;WRITE, FORGET ABOUT "LINE NUMBERS"
	OPENF
	 JRST	OPNFA4
CLRC:	SETZ	C,		;TELL CALLER COMMAND READING IS FINISHED
	POPJ	P,

OPNFA3:	MOVE	A,INJFN
	SKIPA
OPNFA4:	MOVE	A,OUTJFN
	CLOSF			;FLUSH THE CREATED JFN
	 JFCL
	JRST	CMDERN

;;; PARSE FAILED, MAYBE JUST NEED BETTER FILENAME DEFAULTS
;;; WE FIRST TRY TO OPEN THE FILE WITH DEFAULT EXTENSION = WHAT
;;;   THE FORMATTER MODE INDICATES (R, MSS, ...).  IF A FILE EXISTS
;;;   WITH CORRECT FIRST NAME BUT WRONG EXTENSION, THAT WILL FAIL.
;;;   TRYING AGAIN WITH NO DEFAULT EXTENSION WILL WIN.

PRSNOK:	SKIPN	GJBLK+.GJEXT	;SEE IF ALREADY USING NO DEFAULT
	 JRST	CMDERR		;YES (OR NOT DOING FILES AT ALL), TOO BAD
	MOVE	GJBLK+.GJGEN	;SEE WHETHER READ OR WRITE
	TLNN	(GJ%OLD)
	 JRST	CMDERR		;WRITE, TOO BAD
	SETZM	GJBLK+.GJEXT	;USED A DEFAULT EXTENSION, TRY AGAIN WITH NONE
	MOVE	B,BSAVE
	JRST	CKPRSE

CMDERR:	TLNE	A,(CM%EOC)
	 SETZM	LINOPN		;HE TYPED A CR, LINE IS CLOSED
	TLNE	A,(CM%EOC)
	 JRST	CMDERN
	PUSH	P,A		;*** CROCK
	HRROI	A,[ASCIZ /
/]
	PSOUT
	POP	P,A		;*** CROCK
CMDERN:	PUSH	P,A		;*** CROCK
	HRROI	A,[ASCIZ /?/]
	PSOUT
	MOVEI	A,.PRIOU
	MOVE	B,[.FHSLF,,-1]
	SETZ	C,
	ERSTR			;PRINT THE ERROR MESSAGE
	 JFCL
	 JFCL
	POP	P,A		;*** CROCK
	SKIPE	COMMIT
	 JRST	PLOSE
	JRST	FIXJCL

;; CALL CKPRSE WITH NEXT 4 WORDS AS FUNCTION BLOCK

CKPRSI:	HRRZ	B,(P)
	PUSHJ	P,CKPRSE
	MOVEI	4
	ADDM	(P)
	POPJ	P,

KTABLE:	KTABE-.-1,,KTABE-.-1
	[ASCIZ /ASK/],,EVAL
	[CM%FW+CM%INV ? ASCIZ /BASK/],,EVALB
	[ASCIZ /CORRECT/],,ITSCOR
	[ASCIZ /DUMP/],,NDUMP
	[ASCIZ /EXIT/],,QUIT
	[ASCIZ /HELP/],,HELP
	[ASCIZ /JUMBLE/],,JUMBLE
	[ASCIZ /KILL/],,KILL
	[ASCIZ /LOAD/],,NLOAD
	[ASCIZ /NO/],,MODCLR
	[ASCIZ /QUIT/],,QUIT
	[ASCIZ /SET/],,MODSET
	[ASCIZ /TRAIN/],,ITSTRN
	[CM%FW+CM%INV ? ASCIZ /WRITE/],,SAVEME
KTABE:

STABLE:	STABE-.-1,,STABE-.-1
	[ASCIZ /LINE:/],,0
STABE:

OTABLE:	OTABE-.-1,,OTABE-.-1
	CMNAME,,CMBITS
	DMNAME,,DMBITS
	LMNAME,,LMBITS
	PMNAME,,PMBITS
	RMNAME,,RMBITS
	SMNAME,,SMBITS
	TMNAME,,TMBITS
	JMNAME,,JMBITS
OTABE:
]
	SUBTTL	COMMAND PARSING ROUTINES FOR ITS

IFN %ITS,[

GETCMD:	MOVE	P,[-LPDL,,PDL-1]	;RESTORE STACK
	MOVEI	Z,[ASCIZ /SPELL --> /]
	PUSHJ	P,TYPLIN	;GET LINE INTO CMDBUF
				;  (WRDPRS CLOBBERS WORDIX, AND WORDIX
				;  ISN'T LONG ENOUGH ANYWAY)
	 JRST	ICTLG		;TYPED CONTROL-G OR QUESTION MARK
	MOVE	[440700,,CMDBUF]
	MOVEM	TTIPTR
	ILDB	A,TTIPTR	;IGNORE INITIAL SPACES OR CONTROL CHARS
	JUMPE	A,TBLURB	;LINE WAS ESSENTIALLY EMPTY
	CAIG	A,40
	 JRST	.-3
	SETZ	B,		;B GETS SIXBIT CMD NAME, PADDED WITH BLANKS.
	SETO	K,		;K GETS SIXBIT CMD NAME, PADDED WITH _'S.
	MOVE	C,[440600,,B]
	MOVE	M,[440600,,K]
	SKIPA			;ALREADY HAVE FIRST CHARACTER
LP1:	ILDB	A,TTIPTR
	CAIL	A,140		;CONVERT LOWER CASE TO UPPER.
	 SUBI	A,40
	CAIL	A,"0
	CAILE	A,"9
	CAIL	A,"A
	CAILE	A,"Z
	 JRST	LP2		;THIS CHAR IS A DELIMITER.
	SUBI	A,40		;NO, CONVERT TO SIXBIT.
	TLNE	C,770000
	 IDPB	A,C
	TLNE	M,770000
	 IDPB	A,M
	JRST	LP1

;B HAS NAME OF CMD, IN SIXBIT, PADDED WITH SPACES,
;K HAS SIXBIT NAME PADDED WITH _'S. ANY KEYWORD THAT THE TYPED
;COMMAND IS AN ABBREVIATION FOR MUST LIE BETWEEN THOSE 2 VALUES.
LP2:	JUMPE	B,CERR		;NULL COMMAND??
	MOVSI	L,-KEYTBL/2	;AOBJN -> KEYWORD TABLE.
	CAMLE	B,KEYTAB(L)	;MOVE UP TO 1ST KEYWD ABOVE BOTTOM OF RANGE
	 AOBJN	L,[AOJA	L,.-1]
	CAMGE	K,KEYTAB(L)
	 JRST	CERR		;IF THAT IS BEYOND THE RANGE, ILLEGAL CMD.
	CAMN	B,KEYTAB(L)	;IF USER HAS GIVEN WHOLE NAME OF A COMMAND,
	 JRST	LP5		;THAT'S GOOD, EVEN IF IT ABBREVIATES OTHERS
	CAML	K,KEYTAB+2(L)
	 JRST	CERR		;IF THERE ARE 2 KEYWDS IN RANGE, AMBIGUOUS CMD.
LP5:	JRST	@KEYTAB+1(L)

;;GET HERE AT END OF ANY COMMAND

ENDCMD:	JRST	CBLURB

KEYTAB:	SIXBIT /ASK/ ? EVAL
	SIXBIT /BASK/ ? EVALB
	SIXBIT /CORREC/ ? ITSCOR
	SIXBIT /DUMP/ ? NDUMP
	SIXBIT /EXIT/ ? QUIT
	SIXBIT /HELP/ ? HELP
	SIXBIT /JUMBLE/ ? JUMBLE
	SIXBIT /KILL/ ? KILL
	SIXBIT /LOAD/ ? NLOAD
	SIXBIT /NO/ ? MODCLR
	SIXBIT /QUIT/ ? QUIT
	SIXBIT /SET/ ? MODSET
	SIXBIT /TRAIN/ ? ITSTRN
	SIXBIT /WRITE/ ? SAVEME
	377777 ? 0
KEYTBL=.-KEYTAB

CERR:	TYPE	[[ASCIZ /HUH?/]]
ZERR:	SETZM	JCLFLG		;TURN OFF JCL READING
	JRST	CBLURB		;READ INSTRUCTION AGAIN

ICTLG:	CAIN	A,^G
	 JRST	CBLURB		;^G
	PUSHJ	P,CLEARS	;QUESTION MARK
	TYPE	XBLURB		;PRINT SHORT DIRECTIONS
	PUSHJ	P,PROPT		;PRINT CURRENT OPTIONS
CBLURB:	TYPE	[[ASCIZ /
/]]
	JRST	TBLURB

;;; START PARSING A FIELD SKIP WITH CHAR IN A IF THERE IS REAL TEXT

STFLD:	LDB	A,TTIPTR
	SKIPA
	ILDB	A,TTIPTR	;FLUSH BLANKS ETC.
	JUMPE	A,CPOPJ		;END OF LINE
	CAIG	A,40
	 JRST	.-3
	JRST	CPOPJ1		;THERE IS SOMETHING THERE

;;; CHECK THAT THERE IS NOTHING FURTHER IN COMMAND
;;; THIS ALWAYS RETURNS WITH C=0

CONFRM:	PUSHJ	P,STFLD
	 JRST	CZ		;OK, END OF LINE
	TYPE	[[ASCIZ /?extra stuff in command?/]]
	JRST	ZERR

CZ:	SETZ	C,
	POPJ	P,

;;; LOOK FOR LINE NUMBER, RETURN IT IN B WITH C~=0

NUMLIN:	SETZ	B,
	PUSHJ	P,STFLD
	 JRST	CERR		;NOTHING?
NUMLI2:	SUBI	A,60
	JUMPL	A,CERR
	CAIL	A,12
	 JRST	CERR		;NOT A DIGIT
	IMULI	B,12
	ADD	B,A
	ILDB	A,TTIPTR
	CAILE	A,40
	JRST	NUMLI2
	JRST	CNZ

;;; LOOK FOR NUMBER OR NOTHING
;;; C=0 IF NOTHING, C~=0 IF NUMBER, VALUE IN B

CFMNUM:	LDB	TTIPTR
CFMNU1:	JUMPE	CZ		;NOTHING
	CAIN	",
	 JRST	.+3
	CAILE	40
	 JRST	NUMLIN
	ILDB	TTIPTR		;FLUSH BLANKS ETC.
	JRST	CFMNU1

;;; LOOK FOR SWITCH OR NOTHING
;;; C=0 IF NOTHING, C~=0 IF SWITCH

CFSWIT:	PUSHJ	P,STFLD
	 JRST	CZ		;NOTHING
CFSWI2:	CAIE	A,"/
	 JRST	CERR		;NOT A SWITCH
	ILDB	A,TTIPTR	;START INTO NEXT FIELD
CNZ:	SETO	C,		;RETURN WITH C NONZERO
	POPJ	P,

;;; LOOK FOR WORD, PACK IT WORDIX FOLLOWED BY NULL
;;; ALSO IN WORDIN (IN FIVEBIT) AND LENGTH IN W
;;; THIS ALWAYS RETURNS WITH C~=0

WRDPRS:	SETZB	W,WORDIN
	MOVE	[WORDIN,,WORDIN+1]
	BLT	WORDIX+10.	;CLEAR WORDIN, WORDIX
	MOVE	B,[440700,,WORDIX]
	MOVE	Y,[440500,,WORDIN]
	PUSHJ	P,STFLD
	 JRST	CERR		;NOTHING?
FLDBL2:	IDPB	A,B		;PACK ASCII
	CAIN	A,"'
	 MOVEI	A,"Z+1
	TRZ	A,740		;IGNORE CASE
	ADDI	A,3
	IDPB	A,Y		;PACK FIVEBIT
	ILDB	A,TTIPTR	;GET NEXT
	CAIE	A,",		;EXIT IF COMMA, SPACE, OR CONTROL CHAR
	CAIG	A,40
	 AOJA	W,CNZ
	AOJA	W,FLDBL2

;;; LOOK FOR OPTION NAME, RETURN WITH D=ADDRESS OF BITS WORD IN MTAB
;;; THIS ALWAYS RETURNS WITH C~=0
;;; ON ITS, AN OPTION NAME IS ONE LETTER ONLY, WITH "J" MEANING TJ6

OPTPRS:	PUSHJ	P,WRDPRS
	LDB	A,[350700,,WORDIX]	;EXAMINE FIRST LETTER **** WHAT A CROCK
	TRZ	A,40		;CONVERT TO UPPER CASE
	MOVNI	C,MTABE-MTAB
	CAME	A,MTABE-MTAB(C)+MTABE
	 AOJL	C,.-1		;SEARCH
	JUMPGE	C,CERR		;NOT THERE
	MOVEI	D,MTABE(C)
	JRST	CNZ

;;; LOOK FOR INPUT FILE OR NOTHING
;;; C=0 IF NOTHING, C~=0 IF FILE
;;; SEE COMMENTS AT OPENR

CFMFIL:	SETZM	RWSWT
	SETOM	FLSWSW		;FLSWSW = -1
	JRST	OPP2

;;; LOOK FOR OUTPUT FILE, SWITCH, OR NOTHING
;;; IF GET FILE, NO SKIP, LEAVE C~=0
;;; OTHERWISE, SKIP -- C=0 IF NOTHING, C~=0 IF SWITCH
;;; SEE COMMENTS AT OPENW

CFFLSW:	SETOB	RWSWT
	HRRZM	FLSWSW		;SET FLSWSW NONZERO BUT POSITIVE
	JRST	OPP2

NOISE:	POPJ	P,

]
	SUBTTL	BASIC TERMINAL IO ROUTINES FOR ITS

IFN %ITS,[
;PRINT CHARACTER IN 0, FORMATS CONTROL CHARACTERS FOR NICE DISPLAY
;DON'T PRINT IF JCL IS WAITING
;CLOBBERS 0

PRINC:	TRNE	FLAGS,TFORCE
	 JRST	.+3
	SKIPE	JCLFLG
	 POPJ	P,		;JCL IS WAITING, SUPPRESS OUTPUT
	SKIPN	TOPEND
	 PUSHJ	P,TTYOPN	;OPEN TTY IF NECESSARY
	CAIN	177
	 POPJ	P,		;DON'T PRINT RUBOUT
	CAIE	^M
	CAIN	^J
	 JRST	PRINC1		;PRINT CR OR LF CORRECTLY
	CAIE	^I		;OR TAB
	CAIL	40		;BUT NO OTHER CONTROL CHARS
	 JRST	PRINC1
	.IOT	TTYO,["^]	;DO CONTROL CHARACTER CAREFULLY
	ADDI	100
PRINC1:	.IOT	TTYO,0
	POPJ	P,

;PRINT ASCIZ STRING POINTED TO BY 0, RECOGNIZE CONTROL-P CODES
;DON'T PRINT IF JCL IS WAITING
;CLOBBERS 0

STTYO:	PUSH	P,A
	TRNE	FLAGS,TFORCE
	 JRST	.+3
	SKIPE	JCLFLG
	 JRST	POPJA		;JCL IS WAITING, SUPPRESS OUTPUT
	SKIPN	TOPEND
	 PUSHJ	P,TTYOPN	;OPEN TTY IF NECESSARY
	PUSH	P,B
	HRLI	440700		;MAKE A BYTE POINTER
	MOVEM	STTYA
	SETZ	B,		;TO COUNT CHARACTERS
	ILDB	A,
	JUMPE	A,.+2		;REACHED END
	AOJA	B,.-2
	.CALL	[SETZ
		SIXBIT /SIOT/
		SUBI %TJDIS	;RECOGNIZE ^P CODES
		ADDI TTYO	;CHANNEL
		STTYA		;STRING TO PRINT
		SETZ B]		;COUNT
	 .LOSE 1000
	POP	P,B
	JRST	POPJA

;CLEAR SCREEN

CLEARS:	TRNE	FLAGS,TFORCE
	 JRST	.+3
	SKIPE	JCLFLG
	 POPJ	P,		;JCL IS WAITING, SUPPRESS OUTPUT
	SKIPN	TOPEND
	 PUSHJ	P,TTYOPN	;OPEN TTY IF NECESSARY
	SKIPN	DSPTTY
	 JRST	OUTCR		;IF NOT A DISPLAY, PRINT CR
	TYPE	[[ASCIZ /C/]]
	POPJ	P,

;CLEAR REST OF SCREEN, CURSOR SHOULD BE AT LEFT EDGE
;CLOBBERS 0

CLEARF:	TRNE	FLAGS,TFORCE
	 JRST	.+3
	SKIPE	JCLFLG
	 POPJ	P,		;JCL IS WAITING, SUPPRESS OUTPUT
	SKIPN	TOPEND
	 PUSHJ	P,TTYOPN	;OPEN TTY IF NECESSARY
	SKIPN	DSPTTY
	 POPJ	P,		;DO NOTHING IF NOT A DISPLAY
	TYPE	[[ASCIZ /HE/]]
	POPJ	P,
	
;CLEAR LINE, CURSOR SHOULD BE AT LEFT EDGE
;CLOBBERS 0

CLEARL:	TRNE	FLAGS,TFORCE
	 JRST	.+3
	SKIPE	JCLFLG
	 POPJ	P,		;JCL IS WAITING, SUPPRESS OUTPUT
	SKIPN	TOPEND
	 PUSHJ	P,TTYOPN	;OPEN TTY IF NECESSARY
	SKIPN	DSPTTY
	 POPJ	P,		;DO NOTHING IF NOT A DISPLAY
	TYPE	[[ASCIZ /L/]]
	POPJ	P,

;SET VERTICAL CURSOR POSITION TO POSITION GIVEN IN FOLLOWING WORD
;AND MOVE TO LEFT EDGE OF SCREEN
;CLOBBERS 0

VPOS:	TRNE	FLAGS,TFORCE
	 JRST	.+3
	SKIPE	JCLFLG
	 JRST	CPOPJ1		;JCL IS WAITING, SUPPRESS OUTPUT
	SKIPN	TOPEND
	 PUSHJ	P,TTYOPN	;OPEN TTY IF NECESSARY
	SKIPN	DSPTTY
	 JRST	CPOPJ1		;DO NOTHING IF NOT A DISPLAY
	MOVE	@(P)		;GET POSITION TO USE
	ADDI	10		;ITS SUPERVISOR REQUIRES THIS
	DPB	[170700,,VPSTF]	;INSERT IT INTO "^PV" SEQUENCE
	TYPE	VPSTF
	JRST	CPOPJ1

;READ CHARACTER FROM TERMINAL (OR FROM JCL STRING), RESULT TO A
;CLOBBERS 0, A

TTYIN:	TRNN	FLAGS,TFORCE
	 SKIPN	JCLFLG		;SEE IF JCL CHAR IS WAITING
	 JRST	TTYI2		;NO, GET CHARACTER FROM TERMINAL
	ILDB	A,JCLFLG	;YES, GET FOLLOWING CHAR
	CAIN	A,^M
	 SETZM	JCLFLG		;JCL RAN OUT
	POPJ	P,
TTYI2:	SKIPN	TOPEND
	 PUSHJ	P,TTYOPN	;OPEN TTY IF NECESSARY
	.IOT	TTYI,A
	POPJ	P,

;OPEN TTY FOR INPUT AND OUTPUT
;CLOBBERS NOTHING

TTYOPN:	PUSH	P,A
	PUSH	P,0
	.OPEN	TTYI,[.UAI,,'TTY]
	 .VALUE	[ASCIZ /:OPEN FAILED/]
	.OPEN	TTYO,[.UAO,,'TTY]
	 .VALUE	[ASCIZ /:OPEN FAILED/]
	.CALL	[SETZ
		SIXBIT /CNSGET/
		ADDI TTYO
		ADDM
		ADDM
		ADDM
		ADDM
		SETZM A]
	 .VALUE	[ASCIZ /:CNSGET FAILED/]
	TLNE	A,%TOMVU	;IS THIS A DISPLAY?
	 SETOM	DSPTTY
	SETOM	TOPEND		;SO I DON'T DO IT AGAIN
	POP	P,0
	JRST	POPJA
	SUBTTL	OPEN DISK FILE

;OPEN INPUT OR OUTPUT FILE, Z HAS PROMPTING MESSAGE
;IF DCTVER IS ZERO (I.E. THIS IS THE FIRST FILE WE HAVE
;   EVER READ ANYTHING), PUT VERSION NUMBER INTO DCTVER FOR
;   PRINTING NEXT TIME PROGRAM IS STARTED
;DIRECTS OUTPUT TO TERMINAL BY CLEARING FWRITE
;CLOBBERS 0, A, B, C, D, W, X, WORDIN, WORDIX, FWRITE

OPENR:	SETZM	RWSWT		;REMEMBER WHAT WE ARE DOING
	SKIPA
OPENW:	SETOM	RWSWT		;REMEMBER WHAT WE ARE DOING
	SETZM	FLSWSW
OPP2:	TRZ	FLAGS,FWRITE	;DIRECT OUTPUT TO TERMINAL
	MOVSI	'DSK
	MOVEM	DEVICE		;DEFAULT DEVICE
	MOVEI	B,FNML-1	;POINTER TO LIST OF NAMES
	LDB	A,TTIPTR
	TLOA	C,-1		;SKIP WHILE SETTING C .LT. 0 FOR FNEND
GETF0:	ILDB	A,TTIPTR	;FLUSH BLANKS ETC.
	JUMPE	A,FNEND		;NOTHING
	CAIN	A,"/
	 JRST	FNEND
	CAIE	A,",
	CAIG	A,40
	 JRST	GETF0
GETF1:	SETZM	D		;NAME WILL BE PACKED HERE
	MOVE	C,[440600,,D]	;PACKING POINTER
GETF2:	CAIN	A,":
	 JRST	COLON
	CAIN	A,";
	 JRST	SEMI
	CAIN	A,40
	 JRST	SPACE
	CAIN	A,"/		;CHECK FOR FILENAME TERMINATORS
	 JRST	FNEND		;SLASH
	CAIE	A,33
	CAIN	A,",
	 JRST	FNEND		;ALTMODE OR COMMA
	CAIN	A,^Q
	 ILDB	A,TTIPTR	;GET NEXT CHARACTER AND QUOTE IT
	JUMPE	A,FNEND		;END OF LINE (YES, EVEN IF QUOTED)
	SUBI	A,40		;CONVERT TO SIXBIT
	CAIL	A,100
	 SUBI	A,40
	JUMPL	A,ILF		;ILLEGAL CHARACTER
	TLNE	C,770000
	 IDPB	A,C		;STORE UNLESS ALREADY FULL
	ILDB	A,TTIPTR	;GET NEXT CHARACTER
	JRST	GETF2

COLON:	PUSHJ	P,FNPK
	CAIN	B,FNML-1
	 JRST	ILF		;NO DEVICE GIVEN
	POP	B,DEVICE
	JRST	GETF9

SEMI:	PUSHJ	P,FNPK
	CAIN	B,FNML-1
	 JRST	ILF		;NO SNAME GIVEN
	POP	B,SNAME
	JRST	GETF9

SPACE:	PUSHJ	P,FNPK
GETF9:	ILDB	A,TTIPTR	;GET NEXT CHARACTER
	JRST	GETF1

FNEND:	PUSHJ	P,FNPK		;PACK FINAL NAME IF ANY
	CAIE	B,FNML-1	;SEE IF ANY FILENAMES AT ALL
	 JRST	FNEN3		;YES
	MOVSI	'DSK
	CAMN	DEVICE
	 JRST	NOFLNM		;NO DEVICE OR FILENAME
	PUSH	B,[SIXBIT /(NIL)/]
FNEN3:	CAMN	B,[1,,FNML]	;SEE IF ONLY ONE NAME
	 PUSH	B,[SIXBIT />/]	;YES, SET DEFAULT SECOND NAME
	CAME	B,[2,,FNML+1]
	 JRST	ILF		;TOO MANY NAMES

	SKIPE	RWSWT
	 JRST	OPNWW		;WRITING
	.CALL	[SETZ		;READING
		SIXBIT /OPEN/
		[.BII,,DKIN]
		DEVICE
		FNML		;FIRST FILENAME
		FNML+1		;SECOND FILENAME
		SETZ SNAME]
	 JRST	TRYAGN		;FAILED
	SKIPE	DCTVER		;AM I LOOKING FOR A DICTIONARY VERSION?
	 JRST	CNZ		;NO, FINISHED
	.CALL	[SETZ		;YES, GET VERSION OF THIS FILE
		SIXBIT /RFNAME/
		ADDI DKIN	;CHANNEL
		ADDM
		ADDM
		SETZM DCTVER]
	 .LOSE 1000
	JRST	CNZ

OPNWW:	.CALL	[SETZ
		SIXBIT /OPEN/
		[.BIO,,DKO1]
		DEVICE
		[SIXBIT /_SPELL/]
		[SIXBIT /OUTPUT/]
		SETZ SNAME]
	 JRST	TRYAGN		;FAILED
	JRST	CNZ

NOFLNM:	SKIPN	A,FLSWSW	;NO FILENAME GIVEN
	 JRST	CERR		;ERROR UNLESS CALL WAS TO CFFLSW OR CFMFIL
	JUMPL	A,CZ		;CFMFIL: RETURN WITH C=0
	AOS	(P)		;CFFLSW: SWITCH OR NOTHING, MUST SKIP
	LDB	TTIPTR
	CAIE	"/
	 JRST	CONFRM		;NOT SWITCH, MUST BE NOTHING
	JRST	CNZ		;****** CROCK!!!! SHOULD ACTUALLY LOOK AT IT

ILF:	TYPE	[[ASCIZ /?Bad file name?/]]
	JRST	ZERR

;FILE OPEN FAILED, PRINT ERROR MESSAGE

TRYAGN:	SETZM	JCLFLG		;FLUSH JCL READING
	.CALL	[SETZ		;GET ERROR MESSAGE FROM SYSTEM
		SIXBIT /OPEN/
		[.UAI,,ERCHN]
		[SIXBIT /ERR/]
		SETZI 1]	;CODE FOR LAST ERROR
	 JRST	ZERR		;FAILED ??
	.IOT	ERCHN,0		;READ CHARACTER OF ERROR MESSAGE
	CAIGE	40
	 JRST	ZERR		;END OF STRING
	PUSHJ	P,OUTC		;PRINT IT
	JRST .-4

;PUT AWAY FILE NAME, IF ANY

FNPK:	JUMPL	C,CPOPJ
	CAME	B,[3,,FNML+2]
	PUSH	B,D		;STORE NAME UNLESS TOO MANY ALREADY
	POPJ	P,

;READ BLOCK OF INPUT FILE INTO RBUFF.  LENGTH IS LRBUF.
;SKIP IF FULL LENGTH BLOCK, OTHERWISE RH OF 0 HAS ADDRESS PAST LAST WORD
;CLOBBERS 0

RDISK:	MOVE	[-LRBUF,,RBUFF]
	.IOT	DKIN,0
	CAIN	RBUFF+LRBUF
	 AOS	(P)
	POPJ	P,

;WRITE BLOCK OF OUTPUT FILE FROM WBUF1.  LENGTH (NONZERO) IS NEGATED IN 0.
;MAINTAINS NEGATIVE OF NUMBER OF WORDS WRITTEN IN WCOUNT
;CLOBBERS 0, WCOUNT

WDISK:	ADDM	WCOUNT
	HRLZS	0		;-COUNT,,0
	ADDI	WBUF1		;-COUNT,,ADDR
	.IOT	DKO1,0
	POPJ	P,

;CLOSE INPUT FILE

CLOSR:	.CLOSE	DKIN,
	POPJ	P,

;CLOSE OUTPUT FILE, 0 HAS COUNT OF REAL CHARACTERS
;  (NOT INCLUDING PADS)

CLZW:	.CALL	[SETZ
		SIXBIT /RENMWO/
		ADDI DKO1
		FNML
		SETZ FNML+1]
	 JFCL
	.CLOSE	DKO1,
	POPJ	P,
]
	SUBTTL	BASIC TERMINAL IO ROUTINES FOR TWENEX

;THESE ROUTINES ALL BEHAVE EXACTLY AS THEIR ITS COUNTERPARTS DO

IFN %TNX,[

PRINC:	TRNE	FLAGS,TFORCE
	 JRST	.+3
	SKIPE	JCLFLG
	 POPJ	P,		;JCL IS WAITING, SUPPRESS OUTPUT
	PUSH	P,A
	CAIN	177
	 JRST	POPJA		;DON'T PRINT RUBOUT
	CAIE	^M
	CAIN	^J
	 JRST	PRINC1		;PRINT CR OR LF CORRECTLY
	CAIE	^I		;OR TAB
	CAIL	40		;BUT NO OTHER CONTROL CHARS
	 JRST	PRINC1
	MOVEI	A,"^		;DO CONTROL CHARACTER CAREFULLY
	PBOUT
	ADDI	100
PRINC1:	MOVE	A,0
	PBOUT
	JRST	POPJA

STTYO:	TRNE	FLAGS,TFORCE
	 JRST	.+3
	SKIPE	JCLFLG
	 POPJ	P,		;JCL IS WAITING, SUPPRESS OUTPUT
	PUSH	P,A
	HRRO	A,0
	PSOUT
	JRST	POPJA

;SET VERTICAL CURSOR POSITION TO POSITION GIVEN IN FOLLOWING WORD
;AND MOVE TO LEFT EDGE OF SCREEN
;CLOBBERS 0, B, C

VPOS:	PUSH	P,A
	HRLZ	C,@-1(P)	;GET POSITION TO USE, IN LEFT HALF
	AOS	-1(P)
	JSP	A,PRTPRT
IFN %VTS,[
	TC%MOV			;WHAT BIT WE NEED IN TCHAR
	DP%AG1+DP%AG2+.VTMOV	;WHAT KIND OF VTSOP TO DO IF BIT IS ON
]
.ELSE [0 ? 0]
	0			;WHAT CODE TO USE IN CPTAB IF BIT IS OFF

;CLEAR SCREEN
;;; CLOBBERS B, C

CLEARS:	PUSH	P,A
	JSP	A,PRTPRT
IFN %VTS,[
	TC%CLR			;WHAT BIT WE NEED IN TCHAR
	.VTCLR 			;WHAT KIND OF VTSOP TO DO IF BIT IS ON
]
.ELSE [0 ? 0]
	1			;WHAT CODE TO USE IN CPTAB IF BIT IS OFF

;CLEAR REST OF SCREEN, CURSOR SHOULD BE AT LEFT EDGE
;;; CLOBBERS B, C

CLEARF:	PUSH	P,A
	JSP	A,PRTPRT
IFN %VTS,[
	TC%SCL
	.VTCEW
]
.ELSE [0 ? 0]
	2

;CLEAR LINE, CURSOR SHOULD BE AT LEFT EDGE
;;; CLOBBERS B, C

CLEARL:	PUSH	P,A
	JSP	A,PRTPRT
IFN %VTS,[
	TC%SCL
	.VTCEL
]
.ELSE [0 ? 0]
	3

PRTPRT:	TRNE	FLAGS,TFORCE
	 JRST	.+3
	SKIPE	JCLFLG
	 JRST	POPJA		;JCL IS WAITING, SUPPRESS OUTPUT
;;;EXAMINE TERMINAL CHARACTERISTICS WORD AND SEE IF THE TERMINAL
;;;KNOWS HOW TO DO THIS DIRECTLY.
	MOVE	B,TCHAR
	TDNN	B,(A)
	 JRST	CRUD		;TOO BAD
IFN %VTS,[
	MOVE	B,1(A)		;OPERATION TO DO (IF CURSOR POSITIONING,
	MOVEI	A,.PRIIN	;  DESIRED POSITION IS IN C LEFT)
	VTSOP
	JRST	POPJA
]

;;;MUST DO IT THE HARD WAY, FIND OUT WHICH BLOCK OF CPTAB TO USE
;;;  2(A) HAS WORD TO USE IN THAT BLOCK: 0=VPOS, 1=CLEARS, 2=CLEARF, 3=CLEARL
CRUD:	HLRZ	C		;LINE NUMBER, IF DOING VPOS
	MOVE	C,LTCTYP	;BLOCK DEPENDS ON TERMINAL, 0 IF PRINTING
	ASH	C,2		;BLOCK SIZE IS 4
	ADD	C,2(A)		;INDEX OF DESIRED WORD IN DESIRED BLOCK
	SKIPN	2(A)
	 JRST	CPTAB(C)	;DOING A VPOS, WORD HAS A JRST TO THE ROUTINE
	MOVE	C,CPTAB(C)	;OTHERS, WORD HAS ASCIZ STRING
;;;PRINT ASCIZ STRING IN C IN DIRECT ACCESS MODE
PRTDAM:	MOVEI	A,.PRIIN
	MOVE	B,OLDMOD
	TRZ	B,TT%DAM
	SFMOD			;ENABLE "DIRECT ACCESS": ESCAPE CODES ETC.
	HRRO	A,C
	PSOUT			;DO IT
	MOVEI	A,.PRIIN
	MOVE	B,OLDMOD
	SFMOD			;RESTORE TERMINAL MODE
	JRST	POPJA

;;; TABLE OF TERMINAL-SPECIFIC ACTIONS: ONE BLOCK PER TERMINAL TYPE.
;;; EACH BLOCK HAS 4 WORDS FOR FOR CURSOR POSITIONING,
;;;   CLEAR SCREEN, CLEAR REST OF SCREEN, AND CLEAR LINE, RESPECTIVELY
;;; THE CURSOR POSITIONING IS AN ADDRESS TO GO TO WITH POSITION IN AC0,
;;;   OTHERS ARE STRING TO PRINT IN DIRECT ACCESS MODE

CPTAB:	JRST	POPJA		;NON-DISPLAY (VERTICAL POSITION)
	[ASCIZ	/		;(CLEAR SCREEN)
/]
	[0]			;(CLEAR REST OF SCREEN)
	[0]			;(CLEAR LINE)

	JRST	VPHP		;HP
	[ASCIZ	/HJ/]		;(CLEAR SCREEN)
	[ASCIZ	/J/]		;(CLEAR REST OF SCREEN)
	[ASCIZ	/K/]		;(CLEAR LINE)

	JRST	VPVT52		;VT52
	[ASCIZ	/HJ/]
	[ASCIZ	/J/]
	[ASCIZ	/K/]

	JRST	VPVTC		;VT100
	[ASCIZ	/[;H[J/]
	[ASCIZ	/[J/]
	[ASCIZ	/[K/]		;BALANCE ]]]]

	JRST	VPIML		;IMLAC
	[ASCIZ	/’/]
	[ASCIZ	/„/]
	[ASCIZ	/…/]

	JRST	VPVTC		;ANN-ARBOR
	[ASCIZ	/[;H[J/]
	[ASCIZ	/[J/]
	[ASCIZ	/[K/]		;BALANCE ]]]]

;*** NOTE -- THIS MAY NOT MOVE TO LEFT EDGE YET FOR HP OR VT100 OR IMLAC
;***  FIX IT  (MAYBE SHOULD REQUIRE ALREADY AT LEFT EDGE)

VPHP:	IDIVI	10.			;HP SEQUENCE
	ADDI	"0			;ESC & a {y} r {x} C
	DPB	[100700,,HPVP]		;REPLACE 4RD BYTE
	ADDI	A,"0
	DPB	A,[010700,,HPVP]	;REPLACE 5TH BYTE
	MOVEI	C,HPVP
	JRST	PRTDAM

VPVT52:	ADDI	40			;VT52 SEQUENCE
	DPB	[170700,,VT52VP]	;ESC Y <y+40> <x+40>
	MOVEI	C,VT52VP
	JRST	PRTDAM

VPVTC:	ADDI	1			;VT100/ANN-ARBOR SEQUENCE
	IDIVI	10.			;ESC LBKT {y+1} ; {x+1} H
	ADDI	"0
	DPB	[170700,,VTCVP]		;REPLACE 3RD BYTE
	ADDI	A,"0
	DPB	A,[100700,,VTCVP]	;REPLACE 4TH BYTE
	MOVEI	C,VTCVP
	JRST	PRTDAM

VPIML:	ADDI	1			;IMLAC SEQUENCE
	DPB	[170700,,IMLVP]		;DEL ^Q <y+1> <x+1>
	MOVEI	C,IMLVP
	JRST	PRTDAM

;TABLE OF TERMINAL TYPES (NUMBERS RETURNED BY "GTTYP")

TTYS:	999.			;LTCTYP=0 FOR NON-DISPLAY
	.TTHP			;HP	
	.TTV52			;VT52 OR TERMINAL EMULATING SAME
				; (SUCH AS VT100, HEATH, OR TELERAY)
	.TTV10			;VT100 IN REAL ANSI MODE
	.TTIMX			;IMLAC
	34			;ANN-ARBOR
TTYSE:

;;;READ CHARACTER FROM TERMINAL, RESULT TO A
;;;CLOBBERS A
;;;WE KNOW JCL HAS ENDED

TTYIN:	PBIN
	ANDI	A,177		;REMOVE THE %$&@!#$* PARITY BIT
	POPJ	P,
	SUBTTL	OPEN DISK FILE

;;; OPEN INPUT OR OUTPUT FILE, Z HAS PROMPTING MESSAGE
;;; GJBLK+.GJEXT MUST HAVE DEFAULT EXTENSION TO USE
;;; GJBLK+.GJNAM MUST HAVE DEFAULT FILENAME, THIS IS NORMALLY CLEARED AT
;;;   START OF COMMAND BY GETCMD, BUT OPREXT SETS IT UP PROPERLY FOR WRITING
;;;   SAME FILE NAME AS INPUT
;;; IF DCTVER IS ZERO (I.E. THIS IS THE FIRST FILE WE HAVE
;;;    EVER READ), PUT VERSION NUMBER INTO DCTVER FOR
;;;    PRINTING NEXT TIME PROGRAM IS STARTED
;;; CLOBBERS 0, A, B, C, D, W, X, WORDIN, WORDIX

OPENR:	PUSHJ	P,NOISE
	MOVSI	A,(GJ%OLD+GJ%CFM+GJ%FNS)
	JRST	FILPRS

OPENW:	PUSHJ	P,NOISE
	MOVSI	A,(GJ%FOU+GJ%MSG+GJ%CFM+GJ%FNS)
FILPRS:	MOVEM	A,GJBLK+.GJGEN
	JSP	B,CKPRSE
	 .CMFIL_27. ? 0 ? 0 ? 0

;;; OPEN INPUT TEXT FILE, USE APPROPRIATE DEFAULT EXTENSION FROM MODE
;;;   THEN GET ACTUAL NAME AND EXTENSION (LEAVING THEM IN WORDIN AND WORDIX)
;;;   AND SET THEM UP AS THE DEFAULTS FOR OPENING OUTPUT
;;; WORDIN AND WORDIX MUST NOT BE CLOBBERED UNTIL OUTPUT FILE IS OPENED

OPREXT:	SETZ			;TRY TO GET DEFAULT EXTENSION FROM MODE
	TLNE	FLAGS,RMODE
	 HRROI	[ASCIZ /R/]
	TLNE	FLAGS,SMODE
	 HRROI	[ASCIZ /MSS/]
	TLNE	FLAGS,TMODE
	 HRROI	[ASCIZ /TEX/]
	TLNE	FLAGS,PMODE
	 HRROI	[ASCIZ /TXT/]
	MOVEM	GJBLK+.GJEXT
	MOVEI	Z,[ASCIZ /input text file/]
	PUSHJ	P,OPENR
	HRROI	A,WORDIN	;GET DEFAULT EXTENSION FROM INPUT FILENAME
	MOVEM	A,GJBLK+.GJEXT
	MOVE	B,INJFN
	MOVSI	C,(JS%TYP/7*.JSAOF)
	JFNS
;FOLLOWING LINES USED TO SET DEFAULT FILENAME FOR OUTPUT SAME AS FILE
;USED FOR INPUT.  UNFORTUNATELY, THIS MADE IT IMPOSSIBLE TO SUPPRESS
;OUTPUT (IF YOU JUST TYPED THE INPUT FILENAME FOLLOWED BY C.R., IT WOULD
;FILL IN OUTPUT FILENAME ANYWAY)
;	HRROI	A,WORDIX	;AND DEFAULT NAME
;	MOVEM	A,GJBLK+.GJNAM
;	MOVE	B,INJFN
;	MOVSI	C,(JS%NAM/7*.JSAOF)
;	JFNS
	POPJ	P,

;READ BLOCK OF INPUT FILE INTO RBUFF.  LENGTH IS LRBUF.
;SKIP IF FULL LENGTH BLOCK, OTHERWISE RH OF 0 HAS ADDRESS PAST LAST WORD
;CLOBBERS 0

RDISK:	PUSH	P,A
	PUSH	P,B
	PUSH	P,C
	MOVE	A,INJFN
	MOVE	B,[444400,,RBUFF]
	MOVNI	C,LRBUF
	SIN
	HRRZ	B		;GET ADDRESS OF LAST WORD TRANSFERRED
	CAIN	RBUFF+LRBUF-1
	 AOSA	-3(P)		;WAS A FULL BLOCK
	 AOS	0		;NO, POINT 0 PAST LAST WORD
POPCBA:	POP	P,C
	POP	P,B
	POP	P,A
	POPJ	P,

;WRITE BLOCK OF OUTPUT FILE FROM WBUF1.  LENGTH (NONZERO) IS NEGATED IN 0.
;MAINTAINS NEGATIVE OF NUMBER OF WORDS WRITTEN IN WCOUNT
;CLOBBERS 0, WCOUNT

WDISK:	ADDM	WCOUNT
	PUSH	P,A
	PUSH	P,B
	PUSH	P,C
	MOVE	A,OUTJFN
	MOVE	B,[444400,,WBUF1]
	MOVE	C,0		;-COUNT
	SOUT
	JRST	POPCBA

;CLOSE INPUT FILE

CLOSR:	MOVE	A,INJFN
	CLOSF
	 JFCL
	POPJ	P,

;CLOSE OUTPUT FILE, 0 HAS COUNT OF REAL CHARACTERS
;  (NOT INCLUDING PADS)

CLZW:	MOVE	A,OUTJFN
	HRLI	A,(CO%NRJ)	;DO NOT RELEASE THE JFN
	CLOSF			;CLOSE THE FILE
	 JFCL
	MOVE	A,OUTJFN
	HRLI	A,.FBBYV+(CF%NUD)
	HRLZI	B,(FB%BSZ)	;CHANGE BYTE SIZE
	HRLZI	C,000700	;TO 7 BITS
	CHFDB			;DO IT, DON'T UPDATE ON DISK
	 ERJMP	CLZW9		;MIGHT BE DEVICE NUL:
	MOVE	A,OUTJFN
	HRLI	A,.FBSIZ	;CHANGE BYTE COUNT
	SETO	B,
	MOVE	C,0
	CHFDB			;DO IT, UPDATE ON DISK
	 ERJMP	CLZW9		;MIGHT BE DEVICE NUL:
CLZW9:	MOVE	A,OUTJFN
	RLJFN			;RELEASE JFN
	 JFCL
	POPJ	P,
]
	SUBTTL	INITIALIZE FOR ITS

IFN %ITS,[

SETUP:	SETZM	TOPEND		;INDICATE TTY NOT OPENED YET
	SETZM	LWCASE		;**** UNTIL DO THE RIGHT THING TO GET INFO
	SETZM	DSPTTY		;WILL BECOME NONZERO IF TTY IS A DISPLAY
;(MUST DO THIS BECAUSE PROGRAM MIGHT HAVE BEEN DUMPED WITH TOPEND NONZERO)
	.SUSET	[.RSNAM,,SNAME]	;READ INITIAL SNAME
	SETZM	JCLBUF		;CLEAR JCL BUFFER
	MOVE	[JCLBUF,,JCLBUF+1]
	BLT	JCLBFE
	HLLOS	JCLBFE		;MAKE SURE WE DON'T GET OVERRUN
	.SUSET	[.ROPTI,,]
	TLNN	%OPCMD
	 JRST	NOJCL
	.BREAK	12,[..RJCL,,JCLBUF]
	SKIPN	JCLBUF
	 JRST	NOJCL
	SKIPE	JCLBFE-1
	 .VALUE	[ASCIZ /:JCL LINE TOO LONGKILL /]
	MOVE	A,[440700,,JCLBUF]
	MOVEM	A,JCLFLG
	ILDB	A		;READ FIRST JCL CHARACTER
	CAIN	^M		;SEE IF JCL LINE IS EMPTY
NOJCL:	 SETZM	JCLFLG
YESJCL:	.SUSET	[.RMEMT,,B]	;READ MEMORY TOP INTO B
	TRZ	B,1777		;BE SURE IT'S A MULTIPLE OF 2000
	MOVEM	B,MEMTOP
	CAMG	B,LISTFF
	 .VALUE	[ASCIZ /:PROGRAM IMPROPERLY LOADED/]

;LOOK FOR "NEWS" FILE, PRINT SAME (UNLESS HAVE JCL)

	.CALL	[SETZ
		SIXBIT /OPEN/
		[.UAI,,DKIN]
		[SIXBIT /DSK/]
		[SIXBIT /SPELL/]
		[SIXBIT /NEWS/]
		SETZ [SIXBIT /INFO/]]
	 JRST	BEG7		;FAILED
	.IOT	DKIN,0		;READ CHARACTER
	CAIE	^_		;STOP READING AT ^_
	CAIG	^C
	 JRST .+3		;END OF STRING
	PUSHJ	P,OUTC		;PRINT IT
	JRST .-5
	.CLOSE	DKIN,
BEG7:	TYPE	[[ASCIZ /Spell./]]
	MOVE	A,[.FNAM2]
	PUSHJ	P,SIXPRN
	SKIPN	A,DCTVER	;SEE IF I HAVE A DICTIONARY VERSION
	 JRST	BEG2		;NO
	TYPE	[[ASCIZ /   Dict./]]
	PUSHJ	P,SIXPRN	;PRINT IT

BEG2:	TYPE	[[ASCIZ /
/]]
	POPJ	P,

;PRINT WORD IN A IN SIXBIT (FOR PRINTING VERSION NUMBERS)
;ITS ONLY
;CLOBBERS 0, A

SIXPRN:	SETZ
	LSHC	6		;GET SIX BITS OF A INTO 0
	ADDI	40
	PUSHJ	P,PRINC
	JUMPN	A,SIXPRN	;GO BACK FOR MORE
	POPJ	P,
]
	SUBTTL	INITIALIZE FOR TWENEX

IFN %TNX,[

SETUP:	RESET
	MOVEI	1
	MOVEM	LINOPN
	MOVEI	A,.PRIIN
	RFMOD			;GET TERMINAL MODE WORD
	MOVEM	B,OLDMOD	;SAVE IT SO CAN TEMPORARILY CHANGE IT FOR
				;  DIRECT ACCESS STUFF (CURSOR POSITIONING ETC)
	AND	B,[TT%LCA]	;THIS BIT TELLS WHETHER THE TERMINAL
	MOVEM	B,LWCASE	;  HAS LOWERCASE
IFN %VTS,[
	MOVEI	A,.PRIIN	;GET TERMINAL CHARACTERISTICS WORD,
	RTCHR			;  WHICH TELLS WHAT THE SYSTEM KNOWS
	MOVEM	B,TCHAR		;  HOW TO DO FOR THIS TERMINAL
]
.ELSE [SETZM	TCHAR]

;FIND TERMINAL TYPE, SET LTCTYP ACCORDINGLY, OR LTCTYP = 0 IF UNKNOWN

	MOVEI	A,.PRIIN	;GET TERMINAL TYPE
	GTTYP			;INTO B
	MOVE	K,B		;TEMPORARY TYPEOUT
	CAIE	B,18.		;**** WHAT A CROCK!!! FOR VT100 TERMINALS
	CAIN	B,20.		;**** WHAT A CROCK!!! FOR HEATH TERMINALS
	 MOVEI	B,15.
	CAIN	B,19.		;**** WHAT A CROCK!!! FOR TELERAY TERMINALS
	 MOVEI	B,15.
	MOVSI	A,TTYS-TTYSE	;INITIALIZE TABLE SEARCH
	CAMN	B,TTYS(A)	;LOOK FOR IT
	 JRST	FNDTTY		;FOUND IT
	AOBJN	A,.-2
	SETZM	LTCTYP		;UNKNOWN TTY TYPE
	JRST	STPCNT
FNDTTY:	HRRZM	A,LTCTYP	;KNOWN TTY TYPE
STPCNT:	SETOM	JCLFLG		;NONZERO IF CURRENTLY READING OUT OF RESCAN

;;; READ JCL FOR 20X ONLY

IFN %20X,[
	MOVEI	A,.RSINI
	RSCAN			;ACTIVATE RESCAN BUFFER FOR READING JCL
	 JRST	NOJCL		;HUH??
	JUMPE	A,NOJCL		;ZERO CHARACTERS?
	MOVEI	A,.CTTRM
	BIN			;READ JCL CHARACTER TO SCAN OVER PROGRAM NAME
	CAIN	B,^J
	 JRST	NOJCL		;RAN OUT, MUST NOT BE ANY REAL JCL
	CAIE	B,40		;LOOK FOR BLANK
	 JRST	.-4
	JRST	YESJCL
]

;;; READ JCL FOR 10X ONLY

IFE %20X,[
	MOVEI	A,.PRIIN
	BKJFN
	 JRST	NOJCL		;HUH??
	PBIN
	CAIN	A,^_		;10X NEWLINE CHARACTER?
	 JRST	NOJCL		;YES, MUST NOT BE ANY REAL JCL
	JRST	YESJCL
]

NOJCL:	SETZM	JCLFLG
YESJCL:	MOVE	LISTFF
	TRO	1777
	AOS			;SET TO NEXT HIGHER MULTIPLE OF 2000
	MOVEM	MEMTOP		;MEMTOP .GT. LISTFF AND MULTIPLE OF 2000

;LOOK FOR "NEWS" FILE, PRINT SAME (UNLESS HAVE JCL)

	MOVSI	A,(GJ%OLD+GJ%SHT)
	HRROI	B,[ASCIZ /<INFO>ISPELL.NEWS/]
	GTJFN
	 ERJMP	BEG7		;FAILED
	HRRZS	A
	MOVE	B,[070000,,OF%RD+OF%PLN]
	OPENF
	 JRST	BEG7		;FAILED
	BIN			;READ A CHARACTER
	 ERJMP	.+6		;END OF FILE
	CAIN	B,^_		;STOP READING AT ^_
	 JRST	.+4
	MOVE	B
	PUSHJ	P,PRINC
	JRST	.-6
	CLOSF
	 JFCL

BEG7:	TYPE	[[ASCIZ /Spell./]]
	MOVEI	.FVERS
	PUSHJ	P,DECPTR
	SKIPN	DCTVER	;SEE IF I HAVE A DICTIONARY VERSION
	 JRST	BEG2		;NO
	TYPE	[[ASCIZ /   Dict./]]
	TYPE	DCTVER
BEG2:	TYPE	[[ASCIZ /   Term./]]
	MOVE	K
	PUSHJ	P,DECPTR
	TYPE	[[ASCIZ /
/]]
	POPJ	P,
]

HELP:	PUSHJ	P,CONFRM
	TYPE	XBLURB		;PRINT SHORT DIRECTIONS
	PUSHJ	P,PROPT		;PRINT CURRENT OPTIONS
HLPEND:	TYPE	[[ASCIZ /
There are /]]
	MOVE	DICTNN
	PUSHJ	P,DECPTR
	TYPE	[[ASCIZ / entries for /]]
	MOVE	DICTNN
	ADD	FLAGNN
	PUSHJ	P,DECPTR
	TYPE	[[ASCIZ / words in /]]
	MOVE	MEMTOP
	LSH	-10.
	PUSHJ	P,DECPTR
	TYPE	[[ASCIZ / K of core./]]
	JRST	ENDCMD

IFN %ITS,[
XBLURB:	ASCIZ %
CORRECT <input file>,<output file>/<starting line> -
	Correct a file (normal mode for program)
LOAD <file>,<num> - Load incremental dictionary #N (1 to 9, default=1)
DUMP <file>,<num> - Dump incremental dictionary #N (1 to 9, default=1)
TRAIN <file>,<exceptions file> - Train
ASK <word> - Ask about a single word
SET <option> / NO <option> - turn option on or off; options are:
  J(TJ6), R, P(PUB), T(TEX), S(SCRIBE) - text formatter mode
  D - Display context around misspelled word
  L - Show list of close words
  C - Check capitalization (don't use this yet)
EXIT or QUIT - Exit and allow program to be restarted
KILL - Exit and kill the program
%
]
IFN %TNX,[
XBLURB:	ASCIZ %
CORRECT <input file> <output file> /LINE:<starting line> -
	Correct a file (normal mode for program)
LOAD <file> <num> - Load incremental dictionary #N (1 to 9, default=1)
DUMP <file> <num> - Dump incremental dictionary #N (1 to 9, default=1)
TRAIN <file> <exceptions file> - Train
ASK <word> - Ask about a single word
SET <option> / NO <option> - turn option on or off; options are:
  TJ6, R, PUB, TEX, SCRIBE - text formatter mode
  DISPLAY - Display context around misspelled word
  LIST - Show list of close words
  CAPITALIZATION - Check capitalization (don't use this yet)
EXIT or QUIT - Exit and allow program to be restarted
KILL - Exit and kill the program
%
]
	SUBTTL	TYPLIN (READ LINE FROM TTY) FOR ITS

IFN %ITS,[

;READ LINE FROM TTY, CURSOR SHOULD BE AT LEFT EDGE TO START
;PROMPT IS IN Z, Z MUST POINT TO WORD OF ZERO FOR NO PROMPT
;NO SKIP IF USER TYPES CONTROL G OR QUESTION MARK, THAT CHARACTER IS IN A
;SKIP OTHERWISE, WITH DATA IN WORDIX, W AND WORDIN CLEAR
;CLOBBERS 0, A, B, C, X, WORDIN, WORDIX, W
;WORDIX DOES NOT HAVE MORE THAN 40 CHARACTERS

;;; ON ITS ONLY --> TEXT IS ALSO IN CMDBUF, AND IS NOT TRUNCATED
;;;   TO 40 CHARACTERS.  THIS IS BECAUSE ITS USES THIS TO READ THE
;;;   ENTIRE COMMAND LINE, WHILE TNX DOES NOT.

TYPLIN:	SETZB	W,WORDIN
	MOVE	[WORDIN,,WORDIN+1]
	BLT	WORDIX+10.	;CLEAR WORDIN, WORDIX
	SETZM	CMDBUF
	MOVE	[CMDBUF,,CMDBUF+1]
	BLT	CMDBUF+CMDBFL-1	;CLEAR CMDBUF
	MOVE	X,[010700,,CMDBUF-1]
	TYPE	@Z		;PRINT PROMPTING MESSAGE
TYPW1:	PUSHJ	P,TTYIN
	CAIN	A,^[		;]
	 JRST	TYPWA		;COMMA OR ALTMODE, DONE
	CAIN	A,^M
	 JRST	TYPWB		;CR, DONE
	CAIN	A,177
	 JRST	RUBOUT
	CAIN	A,^U
	 JRST	CTLU		;CONTROL U, START OVER
	CAIE	A,^L
	CAIN	A,^R
	 JRST	CTLR		;CONTROL L OR R, RETYPE THE LINE
	CAIE	A,"?
	CAIN	A,^G
	 POPJ	P,		;CONTROL G OR QUESTION MARK, EXIT
	CAIN	A,^Q
	 PUSHJ	P,TTYIN		;CONTROL Q, QUOTE NEXT CHAR
	CAME	X,[010700,,CMDBUF+CMDBFL-1]	;DON'T PACK IF ALREADY FULL
	 IDPB	A,X
	JRST	TYPW1

RUBOUT:	CAMN	X,[010700,,CMDBUF-1]
	 JRST	TYPW1		;ALREADY AT LEFT EDGE
	SETZ
	DPB	X		;ERASE FROM BUFFER
	ADD	X,[070000,,0]	;BACK UP X
	SKIPGE	X
	 SUB	X,[430000,,1]
	TYPE	[[ASCIZ /X/]]	;ERASE FROM SCREEN AND BACK UP CURSOR
	JRST	TYPW1

CTLU:	TYPE	[[ASCIZ /HL/]]	;MOVE TO LEFT EDGE AND ERASE LINE
	JRST	TYPLIN

CTLR:	TYPE	[[ASCIZ /HL/]]
	TYPE	@Z		;TYPE PROMPT AGAIN
	MOVE	A,[010700,,CMDBUF-1]
CTLR1:	CAMN	A,X
	 JRST	TYPW1		;DONE
	ILDB	A
	PUSHJ	P,PRINC		;DISPLAY IT
	JRST	CTLR1

TYPWA:	TYPE	[[ASCIZ /
/]]
TYPWB:
	MOVE	[CMDBUF,,WORDIX]
	BLT	WORDIX+7	;COPY ONLY 40 CHARACTERS
	JRST	CPOPJ1
]
	SUBTTL	TYPLIN (READ LINE FROM TTY) FOR TWENEX

.ELSE [

TYPLIN:	SETZB	W,WORDIN
	MOVE	[WORDIN,,WORDIN+1]
	BLT	WORDIX+10.	;CLEAR WORDIN, WORDIX
	TYPE	@Z		;PRINT THE PROMPT THE FIRST TIME (SIGH)
	MOVEI	A,TTLARG	;IF READING FROM TTY
	HRLI	Z,440700	;MAKE A BYTE POINTER OUT OF Z
	MOVEM	Z,.RDRTY(A)	;TO PRINT THE PROMPT AFTER ^R
	HRROI	WORDIX		;INITIAL PACKING ADDRESS
	MOVEM	.RDDBP(A)
	MOVEI	41.		;MAX CHARACTER COUNT
	MOVEM	.RDDBC(A)
	TEXTI
	 POPJ	P,		;HOW THE HECK CAN THIS HAPPEN?
	SETZ	B,
	LDB	A,TTLARG+.RDDBP	;GET THE BREAK CHARACTER
	DPB	B,TTLARG+.RDDBP	;ERASE IT FROM THE BUFFER
	CAIE	A,"?
	CAIN	A,^G
	 POPJ	P,		;ENDED WITH ? OR ^G, GIVE ABORT EXIT
	JRST	CPOPJ1
]
	SUBTTL	SAVEME FOR ITS

IFN %ITS,[

SAVEME:	SETOM	PURE		;IT'S PURE FROM NOW ON
	SETZM	DUMPBF		;INITIALIZE DUMPBF WITH ":PDUMP"
	MOVE	A,[DUMPBF,,DUMPBF +1]
	BLT	A,DUMPBF+7
	MOVE	M,[440700,,DUMPBF]
	MOVE	C,[440700,,[ASCIZ /:PDUMP/]]
	ILDB	A,C
	JUMPE	A,.+3
	IDPB	A,M
	JRST	.-3
	MOVEI	Z,2		;COUNT TWO FILE NAMES
SAV2:	PUSHJ	P,WRDPRS	;PARSE A FILE NAME
	MOVE	C,[440700,,WORDIX]
	MOVEI	A,40		;PACK A SPACE
	IDPB	A,M
	ILDB	A,C
	JUMPN	A,.-2
	SOJG	Z,SAV2		;DO ANOTHER NAME
	MOVE	C,[440700,,[ASCIZ /  
:CONTINUE
/]]
	ILDB	A,C
	JUMPE	A,.+3
	IDPB	A,M
	JRST	.-3
	PUSHJ	P,CONFRM
	TYPE	[[ASCIZ /
Ya want it like drivn snow?  /]]
	PUSHJ	P,TTYIN
	TRZ	A,40
	CAIN	A,"Y
	PUSHJ	P,PURIFY
	TYPE	[[ASCIZ /
Getcher paws off the keys!!!
/]]
	.VALUE	DUMPBF
	JRST	ENDCMD
	SUBTTL	THE PURIFY CODE
PURIFY:	.SUSET	[.RUIND,,JNUM]
	.SUSET	[.RJNAM,,JNAME]
	HRRZI	A,400000
	IORM	A,JNUM		;THATS WHAT COREBLK WANTS

;PURIFY STUFF FROM PURBEG (INCL) TO LISTFF (EXCL)

	HRRZI	A,PURBEG
	ADDI	A,1777
	LSH	A,-10.
	HRRZ	B,LISTFF
	LSH	B,-10.
PTEST:	CAML	A,B
	JRST	.+4
	.CALL	CORCAL
	.VALUE	[ASCIZ /: CORBLK FAILED 
/]
	AOJA	A,PTEST		;LOOP
	POPJ	P,

CORCAL:	SETZ
	 SIXBIT/CORBLK/
	 1000,,040000
	 JNUM
	 SETZ	A		;PUT PAGE NUM IN A
]
	SUBTTL	SAVEME FOR TWENEX

IFN %TNX,[
SAVEME:	SETOM	PURE		;IT'S PURE FROM NOW ON
	SETOM	NOPNFG		;SO IT WON'T OPEN THE FILE
	MOVEI	Z,[ASCIZ /to EXE file/]
	HRROI	[ASCIZ /EXE/]
	MOVEM	GJBLK+.GJEXT
	PUSHJ	P,OPENW
	PUSHJ	P,CONFRM
	MOVE	A,OUTJFN	;THIS JFN IS NOT OPENED!
	HRLI	A,.FHSLF
	MOVE	B,MEMTOP
	LSH	B,-9.		;NUMBER OF PAGES
	MOVNS	B
	HRLZS	B		;TO LEFT HALF
	HRRI	B,SS%CPY+SS%RD+SS%EXE
	SETZ	C,
	SSAVE
	SETOM	OUTJFN		;SSAVE CLOSED AND RELEASED THE JFN!
	JRST	ENDCMD
]
	CONSTANTS

DICTIO:	0
END	BEGIN
