TITLE	ZAP	PROGRAM TO ZAPEROO A FILE - CHANGE A WORD ON DISK

	SUBTTL	DANIEL KOHANSKI/CCIS SYSTEMS - RUTGERS UNIVERSITY/1974

	TWOSEG

;	  ACUMULATORS

F==0		;FLAGS
P==17		;STACK

A1==1		;MAIN TEMPORARIES
A2==2
A3==3
A4==4

T1==5		;SUBROUTINE TEMPS
T2==6
T3==7
T4==10

BK==11		;BREAK CHAR
OCT==T3		;OCTAL VALUE
INF==12		;SIXBIT VALUE
PTR==INF+1		;POINTER

M==14			;EXAMINE/DEPOSIT MODE
X==15		;EXTRA FLAGS (WITHIN ONE ROUTINE ONLY)

;    FLAGS

FL.OPN==1	;FILE IS OPEN
FL.ZAP==2	;BLOCK IS BEING MODIFIED
FL.BIC==4	;BLOCK IS IN CORE
FL.SIX==10	;ARGUMENT IS SIXBIT (HAS SOME NON-NUMERIC CHAR)
FL.LDZ==FL.SIX	;SKIPPING ;LEADING ZEROS (SUBROUTINE OUTPUT)
FL.ZON==20	;FIRST CHAR MUST BE 0 OR 1 (FOR ASCII MODE)
FL.XIS==FL.ZON	;X-VALUE FOR CURRENT PART (INSTRUCTION MODE)
FL.RRD==40	;REREAD OR CLOSE ZAPPED BLOCK WITHOUT WRITING
FL.HCP==100	;TERMINAL IS HARDCOPY
FL.XBD==200	;SEARCH STRING FOUND ACROSS WORD BOUNDARY
FL.XIT==400	;EXIT SWITCH OR ^C^C
FL.SIP==1000	;SEARCH IN PROGRESS CAN BE CONTINUED
FL.SMP==2000	;MULTIPLE BLOCK SEARCH IN PROGRESS CAN BE CONTINUED
FL.FFL==4000	;^L ALLOWED IN INPUT EDIT (ZAP)
FL.BBD==10000	;STRING SEARCH CROSSING BLOCK BOUNDARY
FL.AST==20000	;AUTO START IN PROGRESS
FL.DZC==FL.AST	;SYSTEM DISPLAY/ZAP IN CORE
FL.DDT==40000	;RUNNING WITH DDT
FL.PRO==100000	;FILE IS WRITE-PROTECTED
FL.PRX==200000	;FILE IS READ-ONLY (LOOKUP BUT NOT ENTER)
FL.SYS==400000	;SYSTEM TESTING


FR.FWS==1B18	;FULL-WORD SEARCH
FR.RPL==1B19	;SEARCH AND REPLACE WITH PRE-ENTERED VALUE
FR.ASR==1B20	;AUTOMATIC SEARCH (AND REPLACE)
FR.SGW==1B21	;STRING MUST BE IN ONE WORD


FR.MSX=1	;MODE IS SIXBIT
FR.MSC=2	;MODE IS ASCII
FR.MOC=0	;MODE IS OCTAL
FR.MIS=4	;MODE IS INSTRUCTION	(M = 3)
FR.MKC=10	;MODE IS ASCII CHARACTER (M = 4)

MASK==FL.HCP!FL.XIT!FL.DDT!FL.SYS!FL.AST	;LEFT HALF BITS TO RETAIN PAST A CLOSE
MMASK==FR.MSX!FR.MSC!FR.MOC!FR.MIS!FR.MKC	;MODE MASK
SRCFLG==FR.FWS!FR.RPL!FR.ASR!FR.SGW	;SPECIAL SEARCH BITS

;    ETRA FLAG REGISTER FLAGS

XR.CLI==400000	;CALLI INSTRUCTION
XR.EXT==200000	;EXTENDED INSTRUCTION
XR.OFC==1	;OP CODE PART COMPLETE
XR.AFC==2	;A/F FIELD COMPLETE
XR.YFC==4	;Y FIELD COMPLETE
XR.IFC==10	;INDIRECT BIT ON
XR.XFS==20	;X FIELD STARTED


;    OTHER FLAGS

IS.CLI==400000	;CALLI VALUE
IS.EXT==200000	;EXTENDED INSTRUCTION
IS.ILI==100000	;ILLEGAL INSTRUCTION

INDRCT==20	;INDIRECT BIT(LH)


;    CHANNELS

ZAP==1		;BOTH LOOKUP AND ENTER
TTY==2		;USED FOR SETTING SUPPRESS STATUS

;   TTY MODE EQUATES

TTMODE==1		;IMAGE DUMP

TTNOEC==1B28!TTMODE	;SUPPRESS ECHO
TTECHO==TTMODE	;RESTORE TO NORMAL

;   OTHER EQUATES

.JBDDT==74	;DDT VALUE



;   MACRO PERFORMS HARDCOPY TSEST. IF ON, ISSUES LINEFEED.

	DEFINE	HCOPY
	<TLNE	F,FL.HCP
	OUTCHR	[12]>

	SUBTTL	DATA AREAS

;   VERSION

VERSION==1
VUPDATE==0
VEDIT==0
VCUSTOM==0

	LOC	137

<VCUSTOM>B2+<VERSION>B11+<VUPDATE>B17+VEDIT


	LOC	134
	CTRLC		;JB INTERRUPT LOC

	RELOC	0

PSIZE==^D20	;STACK SIZE
STACK:	BLOCK	PSIZE		;PUSHDOWN STACK

OPSPEC:	EXP	17		;OPEN DISK FILE SPECIFICATION DUMP MODE
	SIXBIT	/DSK/
	XWD	0,0

TTSPEC:	EXP	TTMODE		;TTY SPEC
	SIXBIT	/TTY/
	XWD	0,0


;   EXTENDED LOOKUP ARGUMENT AREA

.RBCNT:	5		;SIZE OF AREA
.RBPPN:	Z
.RBNAM:	Z
.RBEXT:	Z
	Z
.RBSIZ:	Z		;SIZE OF FILE IN WORDS. DIVIDE BY BLKSIZ, +1

FILSIZ=.RBSIZ

;   ENTER ARGUMENT AREA - MUST BE CONTIGUOUS TO LOOKUP AREA

ENTNAM:	Z
ENTEXT:	Z
	Z
ENTPPN:	Z

PPN:	Z		;USER'S PPN

TTYLIN:	BLOCK	^D10	;TELETYPE INPUT BUFFER

INFTMP:	BLOCK	3	;ARGUMENT TEMP AREA

CURBLK:	Z		;NUMBER OF BLOCK IN CORE

BLKSIZ=200		;BLOCK SIZE (TOPS-10)

ZAPPED:	BLOCK	BLKSIZ	;WORK AREA
ZAPMOR:	BLOCK	BLKSIZ	;OVEFLOW IN SEARCH MULITPLE

XAMBEG:	Z		;BEGINNING OF EXAMINE AREA
XAMEND:	Z		;END OF EXAMINE AREA

FILPTR:	Z		;POINTER IF ESCAPE DEPOSIT

SKPCHR:	Z		;NO OF CHARS TO SKIP TO POSITION

;   I/O INSTRUCTIONS - MUST BE IN LOW CORE

INSTR:	IOWD	BLKSIZ,ZAPPED
	Z
INSCON:	IOWD	BLKSIZ,ZAPMOR	;FOR CROSSING BLOCK BOUNDARIES
	Z

;   VALUES MAINTAINED FOR CONTINUED SEARCH

SZPVAL:	Z	;SEARCH VALUE
SZPMSK:	Z	;SEARCH MASK
SZPPTR:	Z	;POINTER TO ZAPPED AREA
SZPCNT:	Z	;COUNT OF BITS IN SEARCH STRING
SZPPOS:	Z	;POINTER VALUE WHEN SPLIT ACROSS WORD BOUND
SZPRPL:	Z	;REPLACEMENT VALUE, RIGHT-JUSTIFIED

;  JB INTERRUPT BLOCK

CTRLC:	XWD	4,CLCHK		;EXIT ROUTINE
	XWD	0,2		;WORRY OVER ^C ONLY
	Z
	Z

	SUBTTL	MAIN ZAPPER!

;   ZAP IS A CUSP WHICH MODIFIES DISK FILES ON THE SPOT; IT IS
;   ESPECIALLY USEFUL FOR BINARY FILES WHICH CANNOT BE TECO'D.
;   MODIFICATIONS ARE DONE ONE BLOCK AT A TIME, AND FOR ONE
;   WORD WITHIN THE BLOCK. THE OUTPUT FILE IS THE SAME AS THE
;   INPUT FILE - THAT IS, MODIFICATION IS DONE BY UPDATES AND
;   USETI/O UUO'S. IT IS SUGGESTED THE USER CREATE A BACKUP FILE
;   BEFORE STICKING HIS FINGERS WHERE THEY MAY GET BURNED.
;   IT IS ALSO RECOMMENDED THAT THIS CUSP BE PROTECTED FROM
;   THE AVERAGE HACKER AND USED ON [1,2] ONLY.
;       ZAP WILL GUARD AGAINST SOME STUPID MISTAKES, SUCH AS
;   TRYING TO ZAP THE RIB, OR A BLOCK BEYOND THE END, BUT THE
;   USER IS EXPECTED TO KNOW WHAT HE IS DOING. OR IS THAT
;   ASKING TOO MUCH?


	RELOC	400000

ZZZZAP:	RESET
	MOVE	P,[IOWD PSIZE,STACK]
	GETPPN	A1,		;WHO MIGHT WE BE?
	JFCL
	MOVEM	A1,PPN
	SETZB	F,M		;GENERAL HOUSEKEEPING
	CAMN	A1,[1,,2]	;SYS PPN
	TLO	F,FL.SYS	;DIVINITY
	CAMN	A1,[1001,,1011]	;LESSER ANGELS
	TLO	F,FL.SYS
	OPEN	TTY,TTSPEC	;OPEN SO CAN DO THINGS
	JRST	[OUTSTR [ASCIZ /??CAN'T OPEN TTY
/]
		EXIT]		;CURSES! FOILED AGAIN

;    ZAP MUST RUN ON AN HONEST-TO-GOODNES TERMINAL,
;    SO THE USER CAN SEE WHAT HE'S GOOFING UP. SO BACTH JOBS
;    ARE VERBOTEN. SO IS OPSER, BECAUSE OF ALL THE
;    EDITING COMMANDS THAT HE NEEDS. THEREFORE.....THROW THE BUM
;    OUT IF HE TRIES TO PSEUDO HIS WAY.

	SETO	A1,		;ASK IF SELF BEING CONTROLLED
	CTLJOB	A1,
	JRST	WELCOM
	JUMPL	A1,WELCOM	;NO CONTROL
	OUTSTR	[ASCIZ /??ZAP RUNS ON REAL TERMINAL ONLY
/]
	EXIT

WELCOM:	OUTSTR	[ASCIZ /ZAP!		
TYPE H FOR HELP
/]

	SKIPE	.JBDDT		;SEE IF RUNNING DDT
	TLOA	F,FL.DDT	;IF SO, TURN ON DEBUG MODE
	SKIPA
	SETZM	134		;LET ^C BE 

	SETZ	T1,
	TLNE	F,FL.SYS	;IF PLAYING GOD,
	SETUWP	T1,		;ALLOW WRITE IN HIGH CORE
	JFCL


;   IF USER HAS REQUESTED A FILE ON COMMAD LEVEL, GET IT.
;   ALSO READ IN BLOCK 1 AND PRINT OUT INFO STATUS.

	RESCAN	1		;LOOK OVER COMMAND
	SKIPA
	JRST	ZAPCMD		;THAT'S ODD
RESCAN:	INCHRW	A2		;MOVE UP TO - OR EOL
	CAIN	A2,15		;CHECK VARIOUS EOL'S
	JRST	ZAPERR
	CAIN	A2,12
	JRST	ZAPERR
	CAIN	A2,33
	JRST	ZAPERR
	CAIE	A2,"-"		;GOLD AT THE END OF THE RAINBOW
	JRST	RESCAN		;BUT NO LEPRECHAUNS

;   LITTLE DEVILS CAME ACROSS. NOW MINE THE  GOLD

	PUSHJ	P,TTYINP	;REALLY TTYIN WITHOUT THE NOISE
	MOVE	PTR,[POINT 6,TTYLIN]
	TLO	F,FL.AST
	JRST	FILEIN		;AND BE ON OUR MERRY WAY


ZAPERR:	CLRBFI			;COMMAND ERROR RETURN

ZAPCMD:	TLZ	F,FL.AST	;GOT THAT OVER WITH
	SETSTS	TTY,TTECHO	;NO LONGER NEEDED
	SETZM	SKPCHR		;KEEP IT CLEAN
	PUSHJ	P,TTYIN		;THY WISH IS THY COMMAND
	MOVE	PTR,[POINT 6,TTYLIN,5]	;BUT LET ME THINK ABOUT IT FIRST
	LDB	A1,PTR		;PTR WILL BE USED LATER BY GETARG
	LSH	A1,^D12
	MOVEI	A3,CMDTBL
	TLZE	F,FL.RRD	;RESET IF ON AND USE DIFFERENT TABLE
	MOVEI	A3,RRDTBL	;SELECT FOR REREAD
ZAPCHK:	HLRZ	A2,(A3)		;CHECK OUT THE WISH
	JUMPE	A2,CMDERR	;WISHFUL THINKING
	CAMN	A1,A2
	JRST	@(A3)		;SHIDDOCH!
	AOJA	A3,ZAPCHK	;WELL, HOW ABOUT THIS ONE?

CMDTBL:	XWD	'R  ',BLCKIN	;READ BLOCK N
	XWD	'C  ',CLOSEF	;CLOSE OUT FILE
RRDTBL:	XWD	'F  ',FILEIN	;LIST OF VALID COMMANDS
	XWD	'A  ',ATOFIL	;PERFROM AUTO OPEN & READ
	XWD	'R  ',REREAD	;REREAD ZAPPED BLOCK
	XWD	'Z  ',DEPSIT	;DEPOSIT A WORD
	XWD	'T  ',SETTTY	;SET TTY TYPE
	XWD	'E  ',CLEXIT	;CLOSE AND EXIT
	XWD	'D  ',XAMCOM	;EXAMINE IN CURRENT MODE
	XWD	'S  ',SRCZAP	;SEARCH AND ZAP
	XWD	'W  ',WRTBLK	;WRITE BLOCK N
	XWD	'C  ',RECLOS	;CLOSE OUT FILE
	XWD	'I  ',GVINFO	;GIVE INFO ON FILE
	XWD	'M  ',SETMOD	;SET MODE
	XWD	'P  ',SETPRO	;SET PROTECTION
	XWD	'H  ',HLPMES	;HELP!!!!!!!!!!!!!
	XWD	'%  ',SYSTST	;SYSTEM TESTING COMMANDS
	XWD	770000,ZAPCMD	;BLANK LINE
	Z

NOTIMP:	OUTSTR	[ASCIZ /%NOT YET IMPLEMENTED. PATIENCE, PLEASE.
/]
	JRST	ZAPERR



;   PERFORM SYSTEM TEST COMMANDS IF PRIVELEGED

SYSTST:	TLNN	F,FL.SYS
	JRST	CMDERR
	MOVEI	A3,SYCTBL
	PUSHJ	P,GETARG	;GET SPECIFIC COMMAND
SYSCHK:	HLLZ	A1,(A3)
	JUMPE	A1,CMDERR
	CAME	A1,INF
	AOJA	A3,SYSCHK
	HRRZ	A3,(A3)
	JRST	(A3)

SYCTBL:	'DDT',,GETDDT	;START DDT IF LOADED
	'XAM',,XAMCOR	;EXAMINE WORDS IN CORE
	'ZAP',,ZAPCOR	;ZAP A WORD ANYWHERE IN CORE
	'MON',,MONRET	;RETURN TO MONITOR WITHOUT CLOSE
	Z


GETDDT:	SKIPN	.JBDDT
	JRST	[OUTSTR [ASCIZ /?DDT NOT LOADED
/]
	JRST	ZAPERR]
	HRRZ	A3,.JBDDT	;START ADDR OF DDT
	JRST	(A3)		;GO MAN GO

;   EXAMINE LOCATIONS IN CORE

XAMCOR:	CAIE	BK,':'		;SYNTAX CHECK
	JRST	ILLSYN
	TLO	F,FL.DZC	;MARK FOR THE ROAD AHEAD
	SETZM	XAMBEG		;DIFFERENT DEFAULTS
	MOVEI	T1,ENDALL
	MOVEM	T1,XAMEND	;END OF CORE
	JRST	XAMCRS

;   ZAP A SPOT OF CORE

ZAPCOR:	CAIE	BK,':'
	JRST	ILLSYN
	TLO	F,FL.DZC
	JRST	DEPCOR



MONRET:	EXIT	1,		;RETURN TO MONTIOR AT ONCE
	JRST	ZAPCMD		;IN CASE OF CONT

;  TELL STUPID BUTTERFINGERS OUT THERE WHAT GIVES, AND HOW
;  TO GIVE IT.

;   EDIT THIS PAGE IN UPPER/LOWER CASE.


HLPMES:	PUSHJ	P,GETARG	;CHECK WHAT KIND OF HELP
	JUMPE	INF,GENHLP	;JUST FOR STARTERS
	MOVEI	A3,HLPTBL
HLPSRX:	HLLZ	A2,(A3)
	JUMPE	A2,CMDERR	;WE DON'T SERVE THAT HERE
	CAME	INF,A2
	AOJA	A3,HLPSRX	;KEEP ON TRUCKING
	JRST	@(A3)

;   GENERAL HELP FOR THE INNOCENT

GENHLP:	OUTSTR	HLPMSG
	JRST	ZAPCMD

	DEFINE	MSG<
	XLIST
	ASCIZ	&

Z.A.P.	-  THE ZOFTIG ALTERATION PROGRAM

ALL COMMANDS ARE ONE LETTER, FOLLOWED IMMEDIATELY BY
THE ARGUMENT(S).
ARGUMENTS IN <> ARE OPTIONAL. ALL NUMBERS ARE OCTAL.

COMMANDS:

Ffile<.ext><[p,pn]>	- OPEN file.ext
Afile<.ext><[p,pn]>	- AUTO OPEN
C		- CLOSE FILE
E		- CLOSE FILE IF OPEN AND EXIT
		  (SAME AS ^C)
Rn OR R+/-<N>	- READ A BLOCK
W		- WRITE CURRENT BLOCK
D<loc<,n>>	- DISPLAY IN CURRENT MODE
Zloc		- ZAP IN CURRENT MODE
S		- SEARCH AND ZAP IN CURRENT OR CHARACTER MODE
Mk		- SET MODE
Pn		- SET WRITE PROTECT
I		- TYPE CURRENT STATUS
Tk		- SET TERMINAL TYPE
H		- THIS MESSAGE

FOR MORE INFORMATION, TYPE "Hc", WHERE c IS SOME COMMAND.

&
	LIST>

;          DANIEL KOHANSKI
;          CCIS SYSTEMS GROUP
;          RUTGERS UNIVERSITY
;	   JANUARY 1975

HLPMSG:	MSG

;   TABLE OF DETAILD HELP ROUTINES. EACH ACCOMPANIES
;   THE APPROPRIATE CODE.

HLPTBL:	XWD	'R  ',HLPRED
	XWD	'E  ',HLPCLS
	XWD	'C  ',HLPCLS
	XWD	'F  ',HLPFIL
	XWD	'A  ',HLPATO
	XWD	'Z  ',HLPZAP
	XWD	'D  ',HLPDIS
	XWD	'S  ',HLPSRC
	XWD	'W  ',HLPWRT
	XWD	'I  ',HLPINF
	XWD	'P  ',HLPPRO
	XWD	'M  ',HLPMOD
	XWD	'H  ',HLPHLP
	XWD	'T  ',HLPTTY
	Z

;   JUST FOR SUCKERS:

HLPHLP:	OUTSTR	[ASCIZ /WISE GUY!
/]
	JRST	ZAPCMD
;   SO YOU DON'T LIKE IT A LA MODE, HUH?

HLPMOD:	OUTSTR	MODMSG
	JRST	ZAPCMD

	DEFINE	MSG,<
	XLIST
	ASCIZ	&Mk		-SET CURRENT MODE

ALL DISPLAY AND ZAPPING IS DONE IN THE CURRENT MODE.
THE EXCEPTION IS K(CHARACTER ZAP - SEE THE K COMMAND).
THE THREE MODES ARE:
O	- OCTAL
S	- SIXBIT
A	- ASCII
K	- ASCII CHARACTER
I	- INSTRUCTION

ASCII IS DISPLAYED AS 7-BIT BINARY BYTES, WITH THE CHARACTER
EQUIVALENTS TO THE SIDE. CONTROL CHARACTERS ARE DISPLAYED
AS "\". SIXBIT MODE DISPLAYS AND ENTERS AS CHARACTERS; OCTAL
AS NUMERALS. OCTAL IS DEFAULT.
&
	LIST>

MODMSG:	MSG

SETMOD:	PUSHJ	P,GETARG	;SET MODE 
	JUMPGE	BK,ILLSYN
	SETZ	A2,
SETCHK:	SKIPN	SETTBL(A2)	;FIND OUT WHICH MODE
	JRST	[OUTSTR [ASCIZ /?INVALID MODE
/]
	JRST	ZAPERR]
	HLLZ	A3,SETTBL(A2)
	CAME	A3,INF
	AOJA	A2,SETCHK
	TRZ	F,MMASK		;MASK OUT OLD MODE
	TRO	F,@SETTBL(A2)	;AND RING IN THE NEW
	MOVEM	A2,M		;INDEX INTO TABLE = MODE INDEX
	TLZ	FL.SIP!FL.SMP	;MODE CHANGE INVALIDATES SEARCH
	TLNE	F,FL.OPN	;IF HAVE OPEN FILE WHEN REQ
	TRNN	F,FR.MIS	;INSTR MODE, WARN HIM IF NOT REL
	JRST	ZAPCMD
	SETZ	T1,
INSBIN:	MOVE	T2,BINLST(T1)
	JUMPE	T2,INNBIN	;NOT A BINARY FILE
	CAMN	T2,.RBEXT	;COMPARE W/ LIST OF VALID EXT
	JRST	ZAPCMD
	AOJA	T1,INSBIN
INNBIN:	OUTSTR	[ASCIZ /%NOT A BINARY FILE
/]
	JRST	ZAPCMD

SETTBL:	'O  ',,FR.MOC	;TABLE ORDER IS EQUAL TO MODE VALUE. THE ORDER OF 
	'S  ',,FR.MSX	;ALL MODE TABLES MUST MATCH THIS ONE.
	'A  ',,FR.MSC
	'I  ',,FR.MIS
	'K  ',,FR.MKC
	Z

BINLST:	SIXBIT	/REL/		;TABLE OF VALID BINARY EXTENSIONS
	SIXBIT	/BIN/
	SIXBIT	/SAV/
	SIXBIT	/HGH/
	SIXBIT	/LOW/
	SIXBIT	/SHR/
	Z
;    SET WRITE PROTECTION SO CAN EXAMINE IN PEACE

HLPPRO:	OUTSTR	[ASCIZ &
Pn		- SET WRITE PROTECTION

   IF SET TO ZERO (INITIAL CONDITION), FILE CAN BE ZAPPED.
IF SET TO 1, ZAP WILL NOT WORK, AND SEARCH WILL DISPLAY ONLY.
&]
	JRST	ZAPCMD

SETPRO:	TLNN	F,FL.OPN	;ANYTHING TO PROTECT?
	JRST	NFLERR
	TLNE	F,FL.PRX	;IF READ-ONLY, YOU'RE STUCK
	JRST	[OUTSTR [ASCIZ /?FILE IS READ-ONLY
/]
		JRST ZAPERR]
	PUSHJ	P,GETARG
	JUMPGE	BK,ILLSYN
	TLNN	F,FL.OPN
	JRST	NFLERR		;GOTTA HAVE A FILE TO PROTECT
	TLNE	F,FL.SIX	;ARG MUST BE BINARY
	JRST	ILLNUM
	CAILE	OCT,1		;ARG MUST BE 0 OR 1
	JRST	CMDERR
	XCT	ONFPRO(OCT)	;CLEAR: SET AS DESIRED
	TLZN	F,FL.ZAP	;IF ALREADY ZAPPED, UN-ZAP
	JRST	ZAPCMD
	JRST	REREAD		;GET ORIGINAL COPY BACK- FILE IS PROTECTED

ONFPRO:	TLZ	F,FL.PRO	;P0
	TLO	F,FL.PRO	;P1
;     SET TTY TYPE - HARDCOPY OR CRT

HLPTTY:	OUTSTR	TTYMSG
	JRST	ZAPCMD

	DEFINE	MSG<
	XLIST
	ASCIZ	&
Tk		- SET TERMINAL STATUS

FOR OPERATION ON A HARDCOPY TELETYPE, TYPE "TH". DEFAULT
IS CRT ("TC").
&
	LIST>
TTYMSG:	MSG

SETTTY:	PUSHJ	P,GETARG
	JUMPGE	BK,ILLSYN
	SETZ	A2,
STTCHK:	SKIPN	STTTBL(A2)	;CHECK OUT REQ
	JRST	[OUTSTR [ASCIZ /?INVALID TYPE
/]
	JRST	ZAPERR]
	HLLZ	A3,STTTBL(A2)
	CAME	INF,A3		;CHECK?
	AOJA	A2,STTCHK
	XCT	@STTTBL(A2)	;TURN SOMEHOW
	JRST	ZAPCMD

STTTBL:	XWD	'H  ',ONHCP	;HARDCOPY
	XWD	'C  ',ONCRT	;CRT IS DEFAULT
	Z

;   TO BE EXECUTED AT DAWN

ONHCP:	TLO	F,FL.HCP
ONCRT:	TLZ	F,FL.HCP
;     START AUTO FILE PROCESS

HLPATO:	OUTSTR	ATOMSG
	JRST	ZAPCMD

	DEFINE	MSG<
	XLIST
	ASCIZ	&
Afile<.ext><[p,pn]>	- AUTO OPEN file.ext

CLOSE CURRENT FILE, IF OPEN (UNLESS ZAPPED BLOCK STILL IN
CORE). OPEN FILE.EXT AND READ IN BLOCK 1. (THIS IS BASCALLY
THE SAME AS THE AUTO START PROCEDURE - SEE THE F COMMAND.)
&
	LIST>

ATOMSG:	MSG

ATOFIL:	TLO	F,FL.AST	;MARK
	TLNE	F,FL.OPN	;UNFINISHED BUSINESS?
	JRST	CLOSEF
	JRST	FILEIN
;   GET THE FILE NAMED IN THE COMMAND. HIER BEGINNT...

HLPFIL:	OUTSTR	FILMSG
	JRST	ZAPCMD

	DEFINE	MSG,<
	XLIST
	ASCIZ	&Ffile<.ext><[p,pn]>	- OPEN FILE FOR WORK
NO WORK CAN BE DONE UNTIL A FILE HAS BEEN SPECIFIED, EITHER WITH
THE F COMMAND, OR AT THE MONITOR LEVEL: R ZAP-file.ext.
IF A DIFFERENT P,PN FROM THE USER IS GIVEN, THE USER MUST
HAVE WRITE PRIVILEGES TO THAT UFD.
&
	LIST>

FILMSG:	MSG


FILEIN:	TLNE	F,FL.OPN	;CHECK IF OPEN FILE LYING AROUND
	JRST	[OUTSTR [ASCIZ /?FILE ALREADY OPEN
/]
	JRST	ZAPERR]		;WE BEGINNT ALREADY
	OPEN	ZAP,OPSPEC	;OPEN SESAME
	JRST	[OUTSTR	[ASCIZ /??CAN'T OPEN DISK
/]
	EXIT]			;ALLADIN WENT ON STRIKE

	SETZM	.RBPPN		;CLEAR OUT LOOKUP/ENTER AREAS
	MOVE	A1,[.RBPPN,,.RBNAM]
	BLT	A1,ENTPPN	;CUT THE MUSTARD

	PUSHJ	P,GETARG	;GET FIRST ARGUMENT - FILE NAME
	JUMPE	INF,[OUTSTR [ASCIZ /?NO FILE NAME
/]
	JRST	ZAPERR]		;MAYBE I SHOULD READ MINDS?
	MOVEM	INF,.RBNAM
	MOVEM	INF,ENTNAM
	JUMPL	BK,FILLKP	;DEFAULTS FOR REST - ZERO
	CAIN	BK,'['
	JRST	FILPPN	;EXTENSION DEFAULT
	CAIE	BK,'.'
	JRST	ILLSYN		;AW, YA BLEW IT!
	PUSHJ	P,GETARG	;GET THE MAN AN EXTENSION
	HLLZM	INF,.RBEXT
	HLLZM	INF,ENTEXT
	JUMPL	BK,FILLKP	;NOW CAN WE GO?
	CAIE	BK,'['		;EXACTLY PPN
	JRST	ILLSYN		;GOTCHA!
FILPPN:	PUSHJ	P,GETARG	;PROJ PART
	TLNE	F,FL.SIX
	JRST	ILLNUM		;MUST BE OCTAL
	SKIPN	OCT
	HLRZ	OCT,PPN		;USE OUR OWN PROJ
	HRLZM	OCT,.RBPPN
	HRLZM	OCT,ENTPPN
	CAIE	BK,','
	JRST	ILLSYN		;NO EXCUSES
	PUSHJ	P,GETARG	;PROG PART
	TLNE	F,FL.SIX
	JRST	ILLNUM		;SOME PEOPLE NEVER LEARN
	SKIPN	OCT
	HRRZ	OCT,PPN
	HRRM	OCT,.RBPPN
	HRRM	OCT,ENTPPN
FILLKP:	LOOKUP	ZAP,.RBCNT	;EXTENDED LOOKUP GETS FILE SIZE
	  JRST	LKPERR		;OH NO YOU DON'T
	ENTER	ZAP,ENTNAM	;SAME CHANNEL FOR UPDATE
	  JRST	ENTERR		;NOW WHAT?!
FLLEPX:	HLLZS	.RBEXT		;FOR LATER USE
	TLO	F,FL.OPN	;MARK IT OPEN
	TLZ	F,FL.BIC!FL.ZAP	;CLEAR OTHER THINGS
	MOVE	A1,FILSIZ	;COMPUTE FILSIZ IN BLOCKS
	IDIVI	A1,BLKSIZ
	SKIPE	A2
	AOJ	A1,		;FOR PARTIAL BLOCKS
	MOVEM	A1,FILSIZ
	TLNN	F,FL.AST	;CHECK FOR AUTO START
	JRST	ZAPCMD		;WHEW!
	MOVEI	OCT,1		;BLOCK ONE
	JRST	BLCPOS		;ROUND ONE
;  TYPE OUT GENERAL INFO IN CASE DOPE OUT THERE
;   DOESN'T KNOW WHAT'S GOING ON.

HLPINF:	OUTSTR	[ASCIZ &
I		- TYPE CURRENT STATUS

TYPE OUT THE NAME OF THE OPEN FILE, THE CURRENT BLOCK,ETC.
FOR EXAMPLE:
&]

GVINFO:	TLNN	F,FL.OPN	;MAKE SURE HAVE SOMETHING TO GIVE
	JRST	NFLWRN		;THOUGHT YOU COULD SLIP ONE PAST, EH?
	OUTSTR	[ASCIZ /FILE: /]
	MOVE	T2,ENTNAM	;FILE NAME
	PUSHJ	P,SIXOUT
	HLLZ	T2,ENTEXT	;AND EXTENSION
	JUMPE	T2,GVSCON	;BUT WE HAVEN'T ANY
	OUTCHR	["."]
	PUSHJ	P,SIXOUT
GVSCON:	OUTSTR	[ASCIZ / LENGTH: /]
	HRLZ	T2,FILSIZ
	PUSHJ	P,BINOUT
	OUTSTR	[ASCIZ / BLOCKS
/]
	TLNE	F,FL.PRO	;FILE PROTECTED?
	OUTSTR	[ASCIZ /WRITE-PROTECTED
/]
	TLNE	F,FL.BIC
	JRST	GVIBIC		;TESTING FOR BLOCKHEAD IN CORE
	OUTSTR	[ASCIZ /NO BLOCK IN CORE
/]
	JRST	ZAPCMD		;MY, WASN'T THAT EASY?
GVIBIC:	OUTSTR	[ASCIZ /BLOCK /]	;NOT SO FAST
	HRLZ	T2,CURBLK
	PUSHJ	P,BINOUT
	OUTSTR	[ASCIZ / IN CORE/]
	TLNE	F,FL.ZAP	;HAS HE ZAPPED IT YET?
	OUTSTR	[ASCIZ / ZAPPED/]
	OUTSTR	[ASCIZ &
DISPLAY/ZAP MODE: &]
	OUTSTR	@DISMOD(M)
	TLNN	F,FL.SMP!FL.SIP	;DESCRIBE SEARCH CONDITIONS
	JRST	ZAPCMD		;NO SEARCH
	TLNE	F,FL.SMP
	OUTSTR	[ASCIZ /MULTIPLE /]
	TRNE	F,FR.FWS
	OUTSTR	[ASCIZ /FULLWORD /]
	OUTSTR	[ASCIZ /SEARCH FOR "/]
	MOVE	T2,SZPVAL	;INCLUDE SEARCH VALUE IN MSG
	PUSHJ	P,DISCUR
	OUTSTR	[ASCIZ /" CAN BE CONTINUED.
/]
	TRNN	F,FR.RPL	;REPLACEMENT AVAILABLE?
	JRST	ZAPCMD
	OUTSTR	[ASCIZ /REPLACEMENT VALUE IS "/]
	MOVE	T2,SZPRPL
	PUSHJ	P,DISCUR	;DISPLAY SAME AS SEARCH VALUE
	OUTSTR	[BYTE(7) 42,15,12,0]	;  "CRLF
	JRST	ZAPCMD		;NOW, THAT DIDN'T HURT TOO MUCH, DID IT?

DISMOD:	[ASCIZ /OCTAL
/]
	[ASCIZ /SIXBIT
/]
	[ASCIZ /ASCII
/]
	[ASCIZ /INSTRUCTION
/]
	[ASCIZ /ASCII CHARACTER
/]
;   FURTHER ADVENTURES OF ZAP KOMIKS

HLPRED:	OUTSTR	[ASCIZ &
Rn		- READ BLOCK n
R+<n>		- READ AHEAD n BLOCKS (DEFAULT IS ONE)
R-<n>		- READ BACK n BLOCKS

YOU MUST SPECIFY THE BLOCK TO READ BEFORE DOING ANY WORK.
&]
	JRST	ZAPCMD

;     READ IN A BLOCK FOR BLOCKO BLOCKBUSTER, BUSTER

BLCKIN:	TLNN	F,FL.OPN	;ALREADY BUSTING?
	JRST	NFLERR		;NO FILE - BUST HIM
	TLNE	F,FL.ZAP	;IS THERE A BLOCK IN CORE BEEN ZAPPED?
	JRST	BLCRRD		;BLOCK ZAPPED, SUGGEST REREAD
	PUSHJ	P,GETARG
	JUMPGE	BK,BLCMOV	;CHECK FOR +/- COMMAND
	TLNE	F,FL.SIX
	JRST	ILLNUM		;MUST BE OCTAL
BLCPOS:	SKIPLE	OCT		;CANNOT BE ZERO
	CAMLE	OCT,FILSIZ	;MUST BE IN RANGE - BE FUSSY
	JRST	BLCORN
	MOVEM	OCT,CURBLK	;MARK FOR POSTERITY
REREAD:	USETI	ZAP,@CURBLK	;POSITION ARM
	TLO	F,FL.BIC	;WE ARE GETTING THERE
	TLZ	F,FL.ZAP!FL.XIT!FL.SIP	;RESET VARIOUS CONDITIONS
	MOVE	T1,SRXPTR(M)		;IN CASE IN MIDDLE OF SEARCH
	MOVEM	T1,SZPPTR	;MULTIPLE, RESET POINTER
	IN	ZAP,INSTR	;SEND OUT THE NETS
	JRST	BLKATO
	STATZ	ZAP,1B22	;IF ON, GONE PAST FILE
	JRST	BLCMAC		;WARNING AND ERROR
FIOERR:	GETSTS	ZAP,T2		;WE JUST CAN'T WIN
	HRLZS	T2
	OUTSTR	[ASCIZ *??I/O ERROR: STATUS = *]
	PUSHJ	P,BINOUT
	RESDV.	ZAP,		;GIVE UP THE GHOST
	EXIT			;THUD

BLKATO:	TLNN	F,FL.AST	;STILL IN AUTO START?
	JRST	ZAPCMD		;SPLIT
	JRST	GVINFO		;TELL HIM WHAT WE'VE DONE

BLCRRD:	CLRBFI			;GIVE HIM ANOTHER CHANCE
	OUTSTR	[ASCIZ /?ZAPPED BLOCK STILL IN CORE. TYPE R TO REREAD
/]
	TLO	F,FL.RRD	;MARK FOR COMMAND
	JRST	ZAPCMD

BLCMOV:	JUMPN	INF,ILLSYN	;CHECKING +/- N
	CAIN	BK,'+'
	JRST	BLCADM
	CAIE	BK,'-'
	JRST	ILLSYN		;FALSE HOPES
BLCADM:	MOVEM	BK,A1
	PUSHJ	P,GETARG	;GET COUNT IF ANY
	JUMPGE	BK,ILLSYN
	JUMPE	INF,BLCSET	;BLANK := +/- 1
	TLNE	F,FL.SIX
	JRST	ILLNUM
	JUMPE	OCT,ZAPCMD	;LEAVE US NOT BE SIMPLETONS
	SKIPA
BLCSET:	MOVEI	OCT,1		;DEFAULT ARG
	CAIE	A1,'+'		;NOW - WHICH IS WHICH?
	MOVNS	OCT
	ADD	OCT,CURBLK	;RECOMPUTE
	JRST	BLCPOS		;AND TRY IT OUT

;   TRUCKING ALONG...

HLPDIS:	OUTSTR	DISMSG
	JRST	ZAPCMD

	DEFINE	MSG,<
	XLIST
	ASCIZ	&D<loc<,n>>	DISPLAY IN CURRENT MODE

IF NO ARGUMENTS ARE GIVEN, DISPLAY THE ENTIRE BLOCK.
IF NO loc IS GIVEN, DISPLAY n WORDS STARTING AT LOC 0.
IF ONLY loc IS GIVEN, DISPLAY LOC.
OTHERWISE, DISPLAY n WORDS STARTING AT loc.
&

	LIST>

DISMSG:	MSG

;   DISPLAY SOME PRETTIES

XAMCOM:	PUSHJ	P,TSTBLC	;MAKE SURE ALL THERE

	SETZM	XAMBEG		;SET DEFAULTS
	MOVEI	A1,BLKSIZ
	MOVEM	A1,XAMEND
XAMCRS:	PUSHJ	P,GETARG
	SKIPN	INF		;IF ARGS, PUT IN
	JUMPL	BK,XAMDIS	;NO ARGS MEANS EXAMINE ALL
	TLNE	F,FL.SIX
	JRST	ILLNUM		;Y'GOTTA BE OCTAL
	TLNE	F,FL.DZC	;IF EXAMINING ALL CORE,
	JRST	XAMBST		;ACCEPT ARG
	CAIL	OCT,BLKSIZ
	JRST	LRGERR		;DON'T BE GREEDY
XAMBST:	MOVEM	OCT,XAMBEG	;ACCEPT AS BEGINNING
	SKIPGE	BK		;IF ONLY ARG, THEN END AS WELL
	MOVEM	OCT,XAMEND	;STORE AS ENDPOINT
	JUMPL	BK,XAMDIS	;SO IT'S ENDING
	CAIE	BK,','
	JRST	ILLSYN		;MUST BE COMMA
	PUSHJ	P,GETARG	;GET COUNT
	JUMPGE	BK,ILLSYN	;THAT'S ENOGUH ARGUMENT
	TLNE	F,FL.SIX
	JRST	ILLNUM
	TLNE	F,FL.DZC	;ON SYS EXAM OF CORE,
	JRST	XAMEST		;TRUST ME
	ADD	OCT,XAMBEG	;COMBINE START AND COUNT
	CAILE	OCT,BLKSIZ
	JRST	LRGERR		;OUT OF RANGE AGAIN
XAMEST:	MOVEM	OCT,XAMEND	;ACCEPTED
XAMDIS:	MOVE	A2,XAMBEG
XAMLIN:	OUTSTR	CRLF
	HRLZ	T2,A2		;GET REL ADDR
	PUSHJ	P,BINOUT
	OUTCHR	[":"]
	MOVE	A3,LNSIZE(M)	;WORDS/LINE DEPENDS ON MODE
XAMWRD:	SOJLE	A3,XAMLIN	;COUNT DOWN WORDS/LINE
	OUTSTR	DBLSP		;SPACING
	TLNE	F,FL.DZC	;EXAMINE CORE OR REGULAR?
	MOVE	T2,(A2)		;CORE
	TLNN	F,FL.DZC
	MOVE	T2,ZAPPED(A2)	;REG - THIS WAY PRESERVES THE REL ADDR
	PUSHJ	P,@DISOUT(M)	;DISPLAY IN MODE
	AOJ	A2,
	CAMGE	A2,XAMEND	;GOT THERE YET?
	JRST	XAMWRD		;KEEP GOING
	OUTSTR	CRLF
	JRST	ZAPCMD		;GOT THAT OVER WITH

;  TABLE OF SUBROUTINES

DISOUT:	DISOCT	;OCTAL
	SIXOUT	;SIXBIT
	DISASC	;ASCII
	DISMIS	;INSTRUCTION
	DASCII	;ASCII CHAR

;  TABLE OF WORDS/LINE
;     VALUE IS ONE GREATER THAN NUMBER THAT WILL BE PRINTED

LNSIZE:	5	;OCTAL
	^D9	;SIXBIT
	3	;ASCII
	3	;INSTR
	^D10	;CHAR

;    WE HAVE COME TO THE HEART OF THE MATTER - THE DARK OF THE FOREST.
;    FOLLOW THE YELLOW BRICK BAT AND MAKE YOUR NIGHT DEPOSITS HERE

HLPZAP:	OUTSTR	ZAPMSG
	JRST	ZAPCMD

	DEFINE	MSG,<
	XLIST
	ASCIZ	&Zloc		- ZAP ONE WORD IN CURRENT MODE

THE VALUE OF loc IS DISPLAYED, AND THE USER TYPES IN THE
NEW VALUE UNDERNEATH. ONLY THOSE CHARACTERS RECOGNIZED IN THE
CURRENT MODE ARE VALID. THE FOLLOWING KEYS HAVE SPECIAL MEANING:
ESCAPE	ZAP UP TO POINT OF ESCAPE
RUBOUT	DELETE NEW VALUE AND RETAIN OLD ONE.
CTRL-H	BACKSPACE ONE CHARACTER
CTRL-L	FORWARD SPACE ONE CHARACTER
IN ASCII MODE, THE FIRST CHARACTER OF EACH BYTE MUST BE ZERO OR
ONE, AS MUST THE LAST BIT (BIT 35).
&
	LIST>

ZAPMSG:	MSG


DEPSIT:	PUSHJ	P,TSTBLC	;USUAL CHECKS
	TLNE	F,FL.PRO	;MUST BE ABLE TO WRITE
	JRST	WPOERR

DEPCOR:	PUSHJ	P,GETARG	;LOCATION TO PATCH
	JUMPE	INF,LRGERR
	JUMPGE	BK,ILLSYN
	TLNE	F,FL.SIX
	JRST	ILLNUM
	TLNE	F,FL.DZC	;IF ZAPPING CORE,
	JRST	DEPALL		;DO IT DIFFERENTLY
	CAIL	OCT,BLKSIZ
	JRST	LRGERR
	MOVEM	OCT,A4		;NUMBER IS KOSHER
DEPSHW:	MOVE	T2,ZAPPED(A4)	;WORD TO ZAP
	PUSHJ	P,@DISOUT(M)	;SELECT A FORMAT BY MODE
	OUTSTR	CRLF
DEPOVR:	MOVE	INF,ZAPPED(A4)	;TO BE OVERLAID
	TLO	F,FL.FFL	;PERMIT ^L IN EDIT
	PUSHJ	P,INPVAL	;GET INPUT VALUE
DEPZRP:	ANDCAM	A3,ZAPPED(A4)	;CLEAR OUT ZAPPED PART
	IORM	A2,ZAPPED(A4)	;RING IN THE NEW
DEPDSP:	MOVE	T2,ZAPPED(A4)	;FOR EXTRA DISPLAY
	TRNE	F,FR.RPL	;IF REPLACED, SHOW WORK
	PUSHJ	P,@DISOUT(M)
	TLNN	F,FL.DDT	;BE FORGETFUL IF DEBUGGING
	TLO	F,FL.ZAP	;REMEMBER THE OCCASION
	PUSHJ	P,TRFBBD	;CLEAN UP IF NECESSARY
	TLZE	F,FL.XBD	;IS THERE A PARTY OF THE SECOND PART?
	JRST	DEPLTR
	OUTSTR	CRLF
	TRNN	F,FR.ASR	;AUTOMATIC CONTINUE?
	JRST	ZAPERR		;ALSO CLEAN OUT ANY GARBAGE
	JRST	SRCCON		;CONTINUE


DEPLTR:	OUTSTR	[ASCIZ /
(SECOND PART)
/]
	TRNN	F,FR.RPL	;SEE IF AUTO REPLACE
	AOJA	A4,DEPSHW	;GO DO NEXT WORD - HAS SEARCH STRING ALSO
	MOVE	T2,ZAPPED+1(A4)	;SHOW OLD VERSION - BE  POLITE (FOR ONCE)
	PUSHJ	P,@DISOUT(M)
	OUTSTR	CRLF
	AOJA	A4,DEPZRP	;GET REST OF REPL STRING


;    ZAPPING CORE - SYSTEM PRIV. WRITE-PROTECT HAS BEEN CLEARED
;    AT THE START OF THE PRGRAM.

DEPALL:	MOVEM	OCT,A4		;ADDRESS
	MOVE	T2,(A4)
	PUSHJ	P,@DISOUT(M)	;DISPLAY
	OUTSTR	CRLF		;USUAL PRETTIES
	MOVE	INF,(A4)	;SET UP FOR INPVAL
	TLO	F,FL.FFL
	PUSHJ	P,INPVAL	;GET ARG TO ZAP
	ANDCAM	A3,(A4)		;SURGERY!
	IORM	A2,(A4)		;TRANSPLANT
	OUTSTR	CRLF		;BURP
	JRST	ZAPERR		;CLEAN UP ANY LEFT OVER BLOOD

;
;   SEARCH/REPLACE SIMULATES THE INPUTTING OF THE REPLACEMENT VALUE.
;   IN FULLWORD SEARCH THERE IS NO PROBLEM. IF THE WORD IS ALL
;   IN ONE WORD, THE MASK IS SHIFTED AND USED AS USUAL.
;   WHEN A STRING IS SPREAD ACROSS THE WORD BOUND, THE MASK IS SHIFTED
;   IN DOUBLE WORD FASHION IN SUCH A WAY AS TO MINIMIZE THE RESETTING
;   OF VALUES FOR THE SECOND PART. INSTRUCTION MODE IS A LITTLE SIMPLER.

ZAPREP:	TRNN	F,FR.RPL	;ENTRY FROM SEARCH. CHECK IF REPLACE
	JRST	DEPOVR		;MANO A MANO
	TRNE	F,FR.FWS	;FULLWORD?
	JRST	ZRPFWL
	MOVE	A3,SZPMSK	;SET UP FOR VARIOUS POSSIBILITIES
	MOVE	A2,SZPRPL	;REPLACEMENT VALUE
	TRNE	F,FR.MIS
	JRST	DEPZRP		;IF INSTRUCTION, THAT'S ALL
	TLNE	F,FL.XBD	;IS WORD SPLIT?
	JRST	ZRPSPL
	MOVN	T1,SKPCHR	;CALCULATE SHIFT COUNT AS
	IMUL	T1,SRXSIZ(M)	;  (36-SZPCNT) - (SKPCHR*BYTESIZE)
	SUB	T1,SZPCNT
	ADDI	T1,^D36		;POSITIVE NUMBER FOR LEFT SHIFT
	LSH	A2,(T1)		;DO THIS ONE AT A TIME
	LSH	A3,(T1)
	SETZM	SKPCHR		;IN CASE OF FUTURE REFERENCE
	JRST	DEPZRP		;THAT'S ALL, FOLKS....
ZRPSPL:	MOVE	T1,SKPCHR	;SPLIT WORD - SHIFT RIGHT
	SETZM	SKPCHR
	IMUL	T1,SRXSIZ(M)
	SUBI	T1,^D36		;-(SZPCNT-(36- SKPCHR*BYTESIZE)))
	MOVMS	T1
	SUB	T1,SZPCNT
	MOVE	A2,SZPMSK
	MOVE	T3,SZPRPL	;GET REPLACEMENT VALUE
	SETZB	A3,T4		;THESE WILL HOLD THE SECOND PART VALUES
	TRNE	F,FR.MKC!FR.MSC	;IF ASCII, SHIFT
	SOJ	T1,		;RIGHT ANOTHER
	LSHC	A2,(T1)		;ADJUST MASK
	LSHC	T3,(T1)
	TRNN	F,FR.MKC!FR.MSC	;IF ASCII, ADJUST AGAIN
	JRST	ZRPSPX
	LSH	A2,1
	LSH	T3,1
ZRPSPX:	ANDCAM	A2,ZAPPED(A4)	;OK, PUT IT IN
	IORM	T3,ZAPPED(A4)
	MOVE	A2,T4		;FOR SAFEKEEPING AND TO MINIMIZE LATER
	JRST	DEPDSP		;WORK - A3 ALREADY CONTAINS CORRECT MASK
ZRPFWL:	MOVE	A2,SZPRPL	;FULLWORD ZAP - NOTHIN' TO IT
	MOVEM	A2,ZAPPED(A4)
	JRST	DEPDSP		;SHOW WHAT YOU'VE DONE TO HIM
;  HUNT DOWN OFFENDING BYTE AND ZAPPO!

HLPSRC:	OUTSTR	SRCMSG
	JRST	ZAPCMD

	DEFINE	MSG,<
	XLIST
	ASCIZ	&S[/s]		- SEARCH FOR VALUE AND ZAP
SM[/s]		- SEARCH MULTIPLE BLOCKS
SC		- CONTINUE SEARCH FROM LAST FOUND VALUE
SCM		- CONTINUE MULTIPLE SEARCH
SEARCH IS CONDUCTED IN CURRENT MODE; THUS, CHANGING THE MODE
WILL DISCONTINUE THE SEARCH. WHEN THE SEARCH VALUE IS FOUND,
IT IS DISPLAYED, AND THE USER HAS A CHANCE TO CHANGE IT. RUBOUT
WILL RETAIN THE ORIGINAL VALUE AND RETURN THE USER TO COMMAND
LEVEL. IF THE VALUE IS FOUND TO LIE ACROSS A WORD BOUNDARY, BOTH
WORDS MAY BE ZAPPED.
   SEARCH MULTIPLE WILL WRITE OUT ANY BLOCK THAT HAS BEEN ZAPPED
IN THE PROCESS OF CONTINUING THE SEARCH.  A NEW BLOCK MAY BE
READ IN WITHOUT INVALIDATING THE MULTIPLE SEARCH.
   S/F (OR SM/F) REQUESTS A FULLWORD SEARCH - THE ENTIRE WORD MUST
MATCH THE SEARCH STRING (RIGHT JUSTIFIED). EXCEPT IN ASCII MODE,
SEARCHING FOR ALL 36 BITS DOES NOT AUTOMATCIALLY INVOKE THE
FULLWORD SEARCH.
   S/R (SM/R) REQUESTS AUTO REPLACEMENT ON A SUCCESSFUL SEARCH. EXCEPT
ON A FULLWORD SEARCH, THE SEARCH AND REPLACEMENT STRINGS MUST BE THE
SAME SIZE.
   S/C (SM/C) WILL CONTINUE SEARCH AUTOMATICALLY AFTER ZAP IS COMPLETE
(FOR A PROTECTED FILE, AFTER DISPLAY). WHILE RUNNING, TYPING ^C (CTRL-C)
WILL STOP ACTION - EVENTUALLY. USE WITH CAUTION.
   S/W (SM/W) REQUIRES THAT THE MATCH TO THE SEARCH STRING BE FOUND
ENTIRELY WITHIN ONE WORD.
&
	LIST>

SRCMSG:	MSG

;  IF S, START NEW SEARCH. IF SC, TRY TO CONTINUE FROM WHERE
;  LEFT OFF. IF NEW SEARCH, GET VALUE FROM USER.

SRCZAP:	PUSHJ	P,TSTBLC	;USUAL PRELIMINARIES
	PUSHJ	P,GETARG
	JUMPE	INF,SRCNEW	;NEW SEARCH
	MOVEI	A2,SRCTBL	;CHECK REST OF COMMAND
SRCSRC:	HLLZ	A1,(A2)
	JUMPE	A1,CMDERR	;OUT OF POSSIBILITIES
	CAME	INF,A1
	AOJA	A2,SRCSRC
	JRST	@(A2)		;WE WENT THATAWAY

SMSINP:	TLNE	F,FL.SMP	;CONTINUE MULTIPLE SEARCH. SEE IF CAN
	JRST	SRCCON
	JRST	SRCERR

SCSINP:	TLNN	F,FL.SIP!FL.SMP	;CHECK IF SINGLE SEARCH ACTIVE
	JRST	SRCERR		;NEITHER ONE
	TLZ	F,FL.SMP		;STOP MULITIPLE IF ON
	JRST	SRCCON

SRCNMP:	TLOA	F,FL.SMP		;ENTRY FOR NEW MULITPLE SEARCH
SRCNEW:	TLZ	F,FL.SMP
	TRZ	F,SRCFLG	;TURN OFF SPECIAL SEARCH SWITCHES
SRCSWC:	CAIE	BK,'/'		;SEE IF COMMAND HAD A SWITCH
	JRST	SRCNMS
	PUSHJ	P,GETARG	;GET SWITCH
	MOVEI	T1,SWFTBL	;SWITCH TABLE
SRSWCK:	HLLZ	T2,(T1)
	JUMPE	T2,CMDERR	;ILLEGAL SWITCH
	CAME	INF,T2
	AOJA	T1,SRSWCK	;KEEP AT IT
	TLO	T1,INDRCT	;PUT SWITCH IN F
	TRO	F,@T1		;LEFT-HANDED PASS
	JRST	SRCSWC		;SEE IF ANY MORE SWITCHES
SRCNMS:	TRNN	F,FR.RPL
	JRST	SRCSMS
	TLNE	F,FL.PRO	;CANNOT DO S/R IF PROTECT ON
	JRST	WPOERR
SRCSMS:	OUTSTR	[ASCIZ /SEARCH MODE IS /]
	OUTSTR	@DISMOD(M)	;INTRODUCE YOURSELF
	OUTSTR	[ASCIZ /ENTER SEARCH VALUE: /]	;ASK, MY SON
	TLZ	F,FL.FFL	;NO FORWARD SPACING
	SETZM	SKPCHR		;JUST A CHECK
	PUSHJ	P,INPVAL	;GET SEARCH VALUE
	JUMPE	A3,ZAPCMD	;SAFETY
	TRNE	F,FR.MIS	;HANDLE INSTR DIFFERENTLY
	JRST	SRCMIS
	SETZ	T3,
SRCCTB:	TRNE	A3,1		;VALUES ARE LEFT-JUSTIFIED; RIGHT-JUST. THEM
	JRST	SRCLWF		;RIGHT END REACHD
	LSH	A3,-1		;ONE BIT AT A TIME
	SOJA	T3,SRCCTB	;SHI....FTING
SRCLWF:	LSH	A2,(T3)		;SO VALUE MATCHES MASK
	TRC	F,FR.MKC!FR.FWS	;IF FULLWORD IN ASCII CHAR MODE,
	TRCN	F,FR.MKC!FR.FWS	
	LSHC	A2,1		;ADJUST MASK AND VALUE (SEE NOTE IN ZRP SECTION)
	MOVEI	T2,^D36
	ADD	T2,T3
	MOVEM	T2,SZPCNT	;SIZE OF SEARCH STRING
	MOVMS	T3		;CALCULATE MIN VALUE FOR POINTER IF
	ADD	T3,SRXSIZ(M)	;WORD IS SPLIT ACROSS BOUND
	MOVEM	T3,SZPPOS
	TRNN	F,FR.MSC	;IF ASCII MODE, AND
	JRST	SRCSAV
	CAIN	T2,^D36		;IF ALL 36 BITS ARE BEING LOOKED FOR
	TRO	F,FR.FWS	;START AUTO FULL WORD SEARCH
	JRST	SRCSAV
SRCMIS:	MOVEI	T1,^D36		;VALUES ARE FIXED FOR INSTR MODE
	MOVEM	T1,SZPCNT	;FULL WORD
	MOVEM	T1,SZPPOS
SRCSAV:	MOVEM	A2,SZPVAL	;PRESERVE SEARCH VALUE
	MOVEM	A3,SZPMSK	;AND MASK
	OUTSTR	CRLF		;NEETNESZ
	TRNN	F,FR.RPL	;REPLACEMENT NEEDED?
	JRST	SMCCNT

;  GET REPLACEMENT VALUE. IF NOT FULLWORD, MUST BE SAME SIZE
	OUTSTR	[ASCIZ /ENTER REPLACEMENT: /]
	PUSHJ	P,INPVAL
	JUMPE	A3,ILNRPL	;NULL VALUE NOT ALLOWED
	TRNE	F,FR.MIS	;SKIP ALL THIS FOR INSTRUCTIONS
	JRST	SRCRMV
	SETZ	T3,
SRCRFF:	TRNE	A3,1		;RIGHT-JUSTIFY MASK AND VALUE
	JRST	SRCRFG
	LSH	A3,-1
	SOJA	T3,SRCRFF
SRCRFG:	LSH	A2,(T3)		;SHIFT RIGHT
	TRNE	F,FR.FWS	;NO CHECK FOR MATCH
	JRST	SRCRMV		;IF FULLWORD SEARCH
	CAME	A3,SZPMSK	;MASKS MUST MATCH
	JRST	ILLRPL
SRCRMV:	MOVEM	A2,SZPRPL	;GOT A REPLACEMENT VALUE!!

;   MULTIPLE SEARCH ENTRY FROM BLOCK READ
SMCCNT:	MOVE	T1,SRXPTR(M)	;SELECT A POINTER
	MOVEM	T1,SZPPTR
	TLO	F,FL.SIP	;SEARCH IN PROGRESS
	TRNN	F,FR.FWS	;IF FULLWORD SEARCH,
	JRST	SRCCON		;SET POINTER
	MOVEI	T1,^D36		;TO GRAB THE FULL WORD
	DPB	T1,[POINT 6,SZPPTR,11]

; LOOK FOR NEEDLE IN HAYSTACK

SRCCON:	TLNN	F,FL.DDT
	SETSTS	TTY,TTNOEC	;IN CASE OF CONTINUED SEARCH
	SETZB	A1,A3
	MOVE	T4,SRXSIZ(M)	;VALUE FOR ADDING
	MOVN	T1,SRXSIZ(M)	;FOR SHIFTING RIGHT
SRCCND:	ILDB	A2,SZPPTR	;GET NEXT BYTE FROM CORE
	HRRZ	A4,SZPPTR	;SEE IF PAST END OF ZAP AREA
	CAIL	A4,ZAPPED+BLKSIZ
	JRST	SRCEND		;FINAL CURTAIN, ACT II
SRCXTR:	TRNE	F,FR.MIS!FR.FWS	;SPECIAL FOR INSTRUCTION AND FULLWORD
	JRST	SRCIMK		;SWALLOW WORD WHOLE
	ROT	A2,(T1)		;POSITION PROPERLY...
	LSHC	A1,@SRXSIZ(M)	;...AND COMBINE WITH PREVIOUS BYTES
	ADD	A3,T4		;SEE IF HAVE ACQUIRED ENOUGH CHARS YET
	CAMGE	A3,SZPCNT
	JRST	SRCCND		;NOT YET
	SKIPA	T4,[Z]		;SKIP OVER INSTR PART AND RESET ADD VALUE SO NO OFLOW
SRCIMK:	MOVE	A1,A2		;INSTRUCTION GATHERS ORIGINAL
	TRNN	F,FR.FWS	;NO MASKING ON FULLWORD - ALL OR NOTHING
	AND	A1,SZPMSK	;REMOVE LAST HIGH ORDER
			;IF INSTR, REMOVE FIELDS NOT LOOKING FOR
	CAME	A1,SZPVAL	;S E A R C H ! ?
	JRST	SRCCND		;DASHED AGAIN
	SUBI	A4,ZAPPED	;GOT A LIVE ONE. PREPARE FOR DEPOSIT
	TRNE	F,FR.MIS!FR.FWS
	JRST	SRCANC		;ADVANCE  TO THE REAR
	LDB	A2,[POINT 6,SZPPTR,5]	;CHECK POSITION OF POINTER
	CAML	A2,SZPPOS	;TO SEE IF STRING SPREAD ACROSS WORD BOUND
	TLOA	F,FL.XBD	;MARK SPLIT WORD FOR DEPOSIT ROUTINES
	AOJ	A4,
	SOJ	A4,		;YES - MOVE BACK ONE
	TRNN	F,FR.SGW
	JRST	SRCANC
	TLZE	F,FL.XBD	;IF /W, CANNOT BE SPLIT
	JRST	SRCCON
SRCANC:	TLNN	F,FL.SMP
	JRST	SRCLOC
	HRLZ	T2,CURBLK	;ANNOUNCE BLOCK ON MULTIPLE SEARCH
	OUTSTR	[ASCIZ /
BLOCK /]
	PUSHJ	P,BINOUT
SRCLOC:	OUTSTR	[ASCIZ /
LOC /]

	HRLZ	T2,A4
	PUSHJ	P,BINOUT	;PRINT LOCATION
	TLNE	F,FL.XBD	;IF WENT BACK, SAY SO
	OUTSTR	[ASCIZ / (FIRST PART)/]
	OUTSTR	CRLF
	TLNE	F,FL.PRO	;IF FILE PROT, DISPLAY ONLY
	JRST	SRCPRO
	MOVE	T2,ZAPPED(A4)
	PUSHJ	P,@DISOUT(M)	;DISPLAY IN MODE
	OUTSTR	CRLF
	SETZM	SKPCHR
	TRNE	F,FR.MIS!FR.FWS	;IF INSTR MODE OR FULLWORD,
	JRST	ZAPREP		;ASSUME WHOLE WORD
	TLNN	F,FL.XBD	;CALC DEPENDS ON SPLIT
	JRST	SRCPWD		;NOT SPLIT
	MOVEI	A1,^D72
	SUB	A1,A2		;N = (71-P)-S
	SUB	A1,SZPCNT
	JRST	SRCPXD
SRCPWD:	MOVEI	A1,^D36		;ONLY ONE WORD
	ADD	A2,SZPCNT	;N = 35 - (S+P)
	SUB	A1,A2
SRCPXD:	IDIV	A1,SRXSIZ(M)	;DIVIDE TO GET NO. OF CHARS
	MOVEM	A1,SKPCHR	;WHEW!
	JRST	ZAPREP		;THIS IS JUST THE BEGINNING...

SRCPRO:	MOVE	T2,ZAPPED(A4)	;PROTECT ON MEANS SEARCH AND DISPLAY ONLY
	PUSHJ	P,@DISOUT(M)
	TLZN	F,FL.XBD	;DISPLAY ONLY. CHECK IF SPLIT
	JRST	SRCPRA
	PUSHJ	P,TRFBBD	;HOUSEKEEPING
	OUTSTR	[ASCIZ /
LOC /]
	AOJ	A4,		;ADJUST CORRECTLY
	HRLZ	T2,A4
	PUSHJ	P,BINOUT	;PRINT LOC
	OUTSTR	[ASCIZ / (SECOND PART)
/]
	MOVE	T2,ZAPPED(A4)	;ACTUAL WORD
	PUSHJ	P,@DISOUT(M)
SRCPRA:	OUTSTR	CRLF
	TRNN	F,FR.ASR	;IF AUTO,
	JRST	ZAPCMD
	JRST	SRCCON		;CONTINUE SEARCH

SRCEND:	TLNE	F,FL.SMP	;CHECK FOR MULTIPLE SEARCH
	JRST	SMCCON
	OUTSTR	[ASCIZ /%END OF BLOCK REACHED
/]
	TLZ	F,FL.SIP	;END O' THE LINE
	JRST	ZAPCMD

;   MULTIPLE SEARCH KEEPS ON GOING. WRITE OUT THIS BLOCK
;   IF IT WAS MODIFIED AND GET A NEW ONE. GIVE
;   UP ONLY WHEN OUT OF FILE.

SMCCON:	TLNE	F,FL.BBD	;SEE IF ACROSS A BLOCK BOUND
	JRST	SMCTST		;YES, AND HAVE ALREADY READ IN NEXT
	MOVE	A3,CURBLK	;READ IN NEXT BLOCK
	AOJ	A3,
	CAMLE	A3,FILSIZ	;STILL IN BOUNDS?
	JRST	SMCEND		;GONE PAST - GO FISHING
	USETI	ZAP,(A3)	;DON'T SET CURBLK YET
	IN	ZAP,INSCON	;PUT IN ZAPMOR
	SKIPA
	JRST	FIOERR		;CAUGHT IN THE ACT
SMCTST:	CAILE	A4,ZAPPED+BLKSIZ	;ONLY ALLOWED ONE WORD PAST
	JRST	SMCTRF		;END OF BLOCK
	LDB	A3,[POINT 6,SZPPTR,5]	;OR LESS IF STRING WILL FIT
	CAMGE	A3,SZPPOS	;IN NEW BLOCK
	JRST	SMCTRF
	TLOE	F,FL.BBD	;SET AND CHECK
	JRST	SRCXTR		;IF NOT FIRST TIME, THEN ALREADY ARRANGED
	HLL	A4,SRXPTR(M)	;THE NEW POINTER
	HRRI	A4,ZAPMOR
	MOVEM	A4,SZPPTR
	ILDB	A2,SZPPTR	;START IT OFF
	HRRZ	A4,SZPPTR
	JRST	SRCXTR
SMCTRF:	TLO	F,FL.BBD	;BE SURE OLD BLOCK GETS ITS CHANCE
	PUSHJ	P,TRFBBD	;WHEN TRANSFERRING THE MANTLE
	JRST	SMCCNT

;  THIS SUBROUTINE IS USED BY SEARCH AND THE ZAP ROUTINES TO CHECK
;  IF A NEW BLOCK WAS READ IN TO ZAPMOR - THE HOLDING AREA - TO
;  COVER THE CHANCE THAT A STRING SPREADS ACROSS A WORD BOUNDARY.
;  WE COME HERE WHEN WE HAVE GONE FAR ENOUGH INTO THE NEW BLOCK THAT
;  THE STRING HAS TO BE ALL HERE. THEREFORE, WRITE THE OLD BLOCK
;  OUT(IF ZAPPED), AND BLT THE NEW IN INTO ITS PROPER HOME.
;  UPDATE CURBLK TO BE THE NUMBER OF THE BLOCK
;  AT ZAPPED.

TRFBBD:	TLZN	F,FL.BBD
	POPJ	P,		;NOT CROSSING
	TLZN	F,FL.ZAP
	JRST	TRFBLT		;NOT WRITING
	USETO	ZAP,@CURBLK	;POINT TO RIGHT ADDR
	OUT	ZAP,INSTR	;HEAVE-HO!
	SKIPA
	JRST	FIOERR		;SLIPPED...
	WAIT	ZAP,		;GIVE IT A CHANCE
TRFBLT:	AOS	CURBLK		;NEXT
	MOVE	T1,[ZAPMOR,,ZAPPED]	;SHUFFLE
	BLT	T1,ZAPPED+BLKSIZ-1	;PUMPERNICKEL,THIS TIME
	SETO	A4,		;IN CASE CALLED BY ZAP
	POPJ	P,


SMCEND:	OUTSTR	[ASCIZ /%%END OF FILE REACHED.
/]
	TLZ	F,FL.SMP!FL.SIP	;TURN OFF THE LIGHTS AS YOU LEAVE
	JRST	ZAPCMD		;SPLIT

;   TABLE OF SEARCH ROUTINES. COMMAND IN LH, ADDR IN RH

SRCTBL:	XWD	'C  ',SCSINP	;CONTINUE SEARCH
	XWD	'CM ',SMSINP	;CONTINUE MULTIPLE SEARCH
	XWD	'M  ',SRCNMP	;BEGIN MULTIPLE SEARCH
	Z

;   TABLE OF SWITCHES AND MATCHING FLAGS

SWFTBL:	'F  ',,FR.FWS		;FULLWORD SEARCH
	'R  ',,FR.RPL		;SEARCH AND REPLACE
	'W  ',,FR.SGW		;STRING MUST BE IN ONE WORD - NO SPLITS
	'C  ',,FR.ASR		;AUTO CONTINUE SEARCH/DIS/ZAP/REPLACE
	Z

;   THESE TABLES ARE ALL INDEXED BY MODE (M)

;   POINTER TO CORE

SRXPTR:	POINT	3,ZAPPED
	POINT	6,ZAPPED
	POINT	7,ZAPPED
	POINT	36,ZAPPED
	POINT	7,ZAPPED

;   SIZE OF BYTE

SRXSIZ:	EXP	3,6,7,6,7

;    SCRIBBLE A NOTE SOMEWHERE ON DISK. USE A LEAD PENCIL

HLPWRT:	OUTSTR	[ASCIZ &
W		- WRITE CURRENT BLOCK
SELF-EXPLANATORY.
&]
	JRST	ZAPCMD

WRTBLK:	PUSHJ	P,TSTBLC
	TLNE	F,FL.PRO	;IS WRITE PROTECT?
	JRST	WPOERR
	TLZN	F,FL.ZAP	;CLEAR MODIFIED
	JRST	ZAPCMD		;NOTHING TO WRITE
	USETO	ZAP,@CURBLK	;RESET TO LAST BLOCK READ
	OUT	ZAP,INSTR	;OUT,OUT, DAMN SPOT!
	JRST	ZAPCMD
	JRST	FIOERR		;ZOT!
;  NOW THAT ALL IS SAID AND DONE, BE DONE...

HLPCLS:	OUTSTR	CLSMSG
	JRST	ZAPCMD

	DEFINE	MSG<
	XLIST
	ASCIZ	&
C		- CLOSE FILE.
E		- CLOSE AND EXIT.
ONE OR THE OTHER MUST BE DONE BEFORE EXITING. IF A ZAPPED BLOCK
IS STILL IN CORE, THE ROUTINE WILL OFFER THE CHOICE OF CLOSING
WITHOUT WRITING IT BACK OR REREADING IT. THE USER CAN OF
COURSE WRITE IT OUT THROUGH THE W COMMAND.
&
	LIST>

CLSMSG:	MSG

CLOSEF:	TLNN	F,FL.OPN	;SEE IF HAVE A FILE TO CLOSE
	JRST	NFLERR
	TLNE	F,FL.ZAP	;WARN USER IF FORGOT TO WRITE OUT
	JRST	RRDCLS		;A ZAPPED BLOCK
RECLOS:	CLOSE	ZAP,0		;TAPS, PLEASE
	RELEAS	ZAP,		;LOCK THE DOOR BEHIND YOU
	AND	F,[MASK,,0]	;CLEAR 'MOS EV'RYTHIN'
	TLNE	F,FL.AST	;AUTO START CONTINUES?
	JRST	FILEIN
	TLNN	F,FL.XIT	;SEE IF EXITING AFTER CLOSE
	JRST	ZAPCMD
RESXIT:	RESET			;CLEAR YE IN THE WILDERNESS...
	EXIT			;EXIT, STAGE LEFT, CUTRAIN

;   VARIATION ON A CLOSE - TWO ^C OR E COMMAND


CLEXIT:	TLO	F,FL.XIT	;INDICATE FOR POSTERITY
	TLNN	F,FL.OPN	;FILE AROUND
	JRST	RESXIT		;ALL'S WELL...
	TLNN	F,FL.ZAP	;MODIFIED FILE?
	JRST	RECLOS		;NO, DO AS HE SAYS
RRDCLS:	OUTSTR	[ASCIZ /?ZAPPED BLOCK STILL IN CORE.
TYPE C TO CLOSE WITHOUT WRITING OR R TO REREAD.
/]
	TLO	F,FL.RRD
	SETZM	CTRLC+2		;CLEAR ^C INTERRUPT
	JRST	ZAPERR



;   CTRL-C INTERRUPT - CHECK IF DOING S/C

CLCHK:	TRZN	F,FR.ASR
	JRST	CLEXIT		;NO - CLOSE OUT
	SETZM	CTRLC+2		;FOR THE NEXT ONE
	OUTSTR	[ASCIZ /
%SEARCH ABORTED
/]
	JRST	ZAPERR		;CLEAN OUT TIME
	SUBTTL	SUBROUTINES

;   TTY INPUT ROUTINE

TTYIN:	OUTCHR	["*"]
TTYINP:	MOVE	T1,[POINT 6,TTYLIN]

TTYGET:	INCHWL	T2		;HEAR YE THE WORD
TTYFND:	CAIN	T2,12		;OUT OF WORD YET?
	JRST	TTYFIN
	CAIN	T2,15		;CR - PULL FOLLOWING LF
	JRST	TTYPLF
	CAIN	T2,33		;ESCAPE!
	JRST	TTYESC
	SUBI	T2,40		;CONVERT TO SIXBIT
	JUMPL	T2,CHRERR	;HUH?
	IDPB	T2,T1		;DEPOSIT IN THE GOOD BOOK...
	JRST	TTYGET		;SERMON'S NOT OVER YET
TTYPLF:	INCHRW	T2		;SWALLOW LF ON CR
	SKIPA
TTYESC:	OUTSTR	CRLF		;SEND TO BEGINNING OF LINE
TTYFIN:	SETO	T2,		;MARK EOL AS 77
	IDPB	T2,T1
	POPJ	P,		;RETURN FORGIVEN - THIS TIME

;   GET AN ARGUMENT - AND GIVE ONE IF NOT PRETTY.
;   INPUT PARAMETER:
;	PTR - POINTER TO SIXBIT CHAR BEFORE CURRENT IN TTYLIN.
;   OUTPUT PARAMETERS:
;	INF - ARGUMENT IN SIXBIT
;	BK  - BREAK CHAR. IF 77, BK = -1.
;		IF ARGUMENT IS ALL OCTAL, ALSO HAVE:
;	OCT (=T3) - BINARY VALUE OF ARGUMENT
;	FL.SIX (FLAG) - OFF TO INDICATE OCTAL, ON FOR SIXBIT

GETARG:	TLZ	F,FL.SIX
	MOVE	T1,[POINT 6,INFTMP]	;POINT TO TEMP OUTPUT
	SETZB	OCT,INFTMP
GETONE:	ILDB	T4,PTR		;GET ONE CHAR
	MOVEI	T2,BRKTBL
GETBLK:	SKIPGE	(T2)		;CHECKING FOR BREAKS, LEAKS,...
	JRST	GETREG		;STILL SOLID
	CAME	T4,(T2)
	AOJA	T2,GETBLK	;WANNA TRY AGAIN?
	CAIN	T4,77		;IF EOL,
	SETO	T4,		;MAKE -1
	MOVEM	T4,BK
	MOVE	INF,INFTMP	;SO ONLY USE FIRST SIX CHAR
	POPJ	P,		;BYE-BYE...
GETREG:	IDPB	T4,T1		;DEPOSIT IN TEMP AREA
	SUBI	T4,20		;CONVERT TO BINARY
	JUMPL	T4,ILLSYN	;SNUCK ONE IN THERE
	CAILE	T4,7		;ALPHA - CAN'T CONVERT
	TLO	F,FL.SIX
	TLNE	F,FL.SIX	;IF ANY ALPHA,
	JRST	GETONE		;DON'T BOTHER
	LSH	OCT,3		;MAKE ROOM
	IOR	OCT,T4		;AND  THROW IT IN FOR FREE
	JRST	GETONE		;BACK FOR MORE

BRKTBL:	'['		;TABLE OF BREAK CHARS
	']'
	'.'
	','
	'+'
	'-'
	':'
	'/'
	' '			;SPACE
	77
	-1			;END OF TABLE
;   TTY OUTPUT SUBROUTINES

;  OUTPUT WORD IN T2 IN SIXBIT. PRODUCE SIX CHARS, EVEN IF BLANK

SIXOUT:	MOVEI	T3,6
SIXONE:	SETZ	T1,
	LSHC	T1,6		;ONE CHAR
	ADDI	T1,40		;CONVERT TO ASCII
	OUTCHR	T1
	SOJG	T3,SIXONE
	POPJ	P,

;   OUTPUT LH OF T2 AS AN OCTAL NUMBER. GIVE SIX DIGITS, EVEN IF ZERO

BINOUT:	MOVEI	T3,6
BINONE:	SETZ	T1,
	LSHC	T1,3
	ADDI	T1,60
	OUTCHR	T1
	SOJG	T3,BINONE
	POPJ	P,

;    OUTPUT WORD T2 IN OCTAL, BOTH HALVES

DISOCT:	MOVE	T4,T2		;SAFETY
	HLLZS	T2
	PUSHJ	P,BINOUT	;HALF
	OUTCHR	[","]	;MARK
	HRLZ	T2,T4
	JRST	BINOUT		;HALF AND EXIT

;   OUTPUT WORD IN T2 AS ASCII BYTES - BINARY
;   ENTRY POINTS:
;	DISASC - DISPLAY AS BINARY AND CHARACTERS
;	DASCII - DISPLAY AS CHARACTERS
;  CONTROL CHARACTERS ARE CONVERTED TO \(BACKSLASH)

DISASC:	MOVEI	T3,5		;FIVE BYTES
	MOVE	T4,T2
DISAON:	SETZ	T1,
	LSHC	T1,1		;HIGH ORDER BIT
	ADDI	T1,60
	OUTCHR	T1
	REPEAT	2,	;NEXT 2 DIGITS
<	SETZ	T1,
	LSHC	T1,3
	ADDI	T1,60
	OUTCHR	T1>
	OUTCHR	[" "]
	SOJG	T3,DISAON	;COUNT OF BYTES
	SETZ	T1,
	LSHC	T1,1		;LAST BIT - USUALLY ZERO
	ADDI	T1,60
	OUTCHR	T1
	OUTSTR	DBLSP
	SKIPA			;OVER SECOND ENTRY POINT
DASCII:	MOVE	T4,T2		;RECOVER VALUE
	MOVEI	T2,5		;PREPARE TO OUTPUT AS CHAR
	MOVE	T1,[POINT 7,INFTMP]
	SETZM	INFTMP+1
DISACH:	SETZ	T3,
	LSHC	T3,7		;GET A CHAR
	CAIGE	T3,40		;IS IT CONTROL?
	MOVEI	T3,"\"		;REPLACE
	CAILE	T3,176		;HOW ABOUT THESE?
	MOVEI	T3,"\"		;SAME THING
	IDPB	T3,T1		;BUILD LINE
	SOJG	T2,DISACH
	OUTSTR	INFTMP		;SHOW OFF
	POPJ	P,
DASCSP:	OUTSTR	DBLSP		;FOR PRETTY IF ZAPPED
	JRST	DASCII


; OUTPUT WORD IN T2 IN CURRENT MODE ACCORDING TO COUNT IN SZPCNT

DISCUR:	TRNE	F,FR.FWS	;IF FULLWORD SEARCH ON,
	JRST	@DISOUT(M)	;SHOW EVERYTHING
	TRNE	F,FR.MIS	;IF INSTRUCTION MODE, LET GEORGE DO IT
	JRST	DSMINS		;HI, GEORGE
	MOVEI	T3,^D36
	SUB	T3,SZPCNT	;CALCULATE SHIFT COUNT
	LSH	T2,(T3)		
	MOVE	T3,SZPCNT
DISCLP:	SETZ	T1,
	TRNE	F,FR.MSC	;IF ASCII,
	JRST	DISCAS		;JRST TO BE DIFFERENT
	LSHC	T1,@SRXSIZ(M)	;GET ONE BYTE
	ADD	T1,SRXCNV(M)	;CONVERT FOR OUTPUT
	OUTCHR	T1		;DO SO
DISCOM:	SUB	T3,SRXSIZ(M)	;COUNTDOWN
	JUMPG	T3,DISCLP
	POPJ	P,
DISCAS:	LSHC	T1,1		;FIRST BIT IN ASCII MODE
	ADDI	T1,60
	OUTCHR	T1
	REPEAT	2,<
	SETZ	T1,
	LSHC	T1,3
	ADDI	T1,60
	OUTCHR	T1
>
	OUTCHR	[" "]
	JRST	DISCOM



;   OUTPUT INSTRUCTION IN T2 IN INSTR MODE ACCORDING TO MAK IN SZPMSK

DSMINS:	SETZ	T4,
	PUSH	P,T2
	SKIPG	X,SZPMSK
	PUSHJ	P,DMIOPC	;OP PART INCLUDED
	POP	P,T2		;OP DISPLAY DESTROYS T2
	TRNN	T4,IS.EXT	;IF NOT EXTENDED INSTR,
	TLNN	X,740		;AND MASK INCLUDES,
	SKIPA
	PUSHJ	P,DMIAFC	;SHOW A/F PART
	TRNN	T4,IS.CLI	;SAME PROC FOR Y PART ON CALLI INSTR
	TRNN	X,777777
	SKIPA
	PUSHJ	P,DMIYFC
	TLNE	X,17		;ALL INSTR CAN HAVE X
	PUSHJ	P,DMIXFC
	POPJ	P,


;  CHECK IF FILE OPEN AND BLOCK IN CORE. IF SO, RETURN. IF NOT,
;   FIX STACK POINTER AND PRINT APPRPRIATE ERROR.

TSTBLC:	SUB	P,[1,,1]	;JUST IN CASE
	TLNN	F,FL.OPN	;MOUTH OPEN?
	JRST	NFLERR
	TLNN	F,FL.BIC	;CAUGHT ANYTHING?
	JRST	NBKERR
	AOBJP	P,.+1		;SO YA MADE IT
	POPJ	P,		;NOW WHAT ELSE CAN YOU DO?
	SUBTTL	SEARCH/ZAP VALUE INPUT SUBROUTINE
;    VALUE INPUT SUBROUTINE (SEARCH / ZAP)

; THE BASIC USER INTERACTION SUBROUTINE. USER INPUTS TO IT TO
; SPECIFY SEARCH VALUE AND ZAP REPLACEMENT. ALL EDITING FUNCTIONS
; ARE HANDLED BY THIS ROUTINE. IF FL.FFL IS ON, CTRL-L (FORWARD
; SPACING IS ALLOWED; ELSE NOT. THIS DISTINGUISHES BETWEEN
; SEARCH AND ZAP. IF USER DELETES (RUBOUT), RETURN TO COMMMAND
; LEVEL.

;   RETURN VALUES:
; A2	VALUE (LEFT-JUSTIFIED)
; A3	MASK (LEFT-JUSITIFED)

;   THE MASK INDICATES THOSE BITS TYPED, TO BE USED IN SEARCH OR TO
;   MASK OUT WHEN ZAPPING.

;   IF CALL IS THE RESULT OF SEARCH/ZAP, SKPCHR WILL
;   BE CHECKED TO DETERMINE BYTES TO SKIP.

;   ALL MODES ARE HANDLED. INSTRUCTION MODE SENDS BACK A FULL WORD
;   IN ALL CASES, AND REQUIRES NO ADJUSTMENTS. IN INSTRUCTION
;   MODE SEARCH, AN X VALUE TYPED IN WILL CAUSE A ZERO
;   MASK TO BE BUILT FOR THAT PART, SO THAT ANY VALUE IS VALID.
;   IN ZAP, 'X' IS NOT ALLOWED. ^L IN INSTR MODE GOES FORWARD ONE
;   PART(MORE ON EXTENDED INSTRUCTIONS); ^H WILL ONLY GO BACK AS
;   FAR AS THE BEGINNING OF THE CURRENT PART. PARTS IN INSTR MODE
;   ARE OP CODE, A/F, Y AND X. THE INDRECT BIT IS PART OF Y.

INPVAL:	TLZ	F,FL.ZON
	MOVE	PTR,IPMPTR(M)
	SETZB	A1,A2		;PRELIMINARY MISHEGOS
	SETZ	A3,
	MOVE	T3,IPMBYT(M)	;NO OF BYTES PER WORD
	TLNN	F,FL.DDT	;IF DEBUGGING, LEAVE TTY ALONE
	SETSTS	TTY,TTNOEC	;NO ECHOOOOOOOOO, WE  CAN DO IT 
	CLRBFI
	TRNN	F,FR.MSC	;ASCII MODE?
	JRST	INPPMS
	MOVE	T1,SKPCHR	;ADJUST SKIP COUNT TO REFLECT SPECIAL
	IMULI	T1,3		;ASCII PROBLEMS
	MOVEM	T1,SKPCHR
	JRST	INPRST
INPPMS:	TRNN	F,FR.MIS
	JRST	INPRST
	SETZ	X,		;ADDITIONAL PREP FOR I MODE
	TLNN	F,FL.FFL
	JRST	INPRST		;NO ^L - PREP NOT NEEDED
	HRRZ	X,MISTBL+1(BK)	;BK SET BY DISMIS POINTS TO OLD VAL OF INST
	ANDI	X,XR.CLI!XR.EXT	;REMOVE LINK - SET UP FOR FUTURE ^L

INPRST:	MOVE	T2,IPMSIZ(M)	;START OF BYTE - CHARS/BYTE SET
	TRNE	F,FR.MSC	;IF A-MODE, START OF BYTE
	TLO	F,FL.ZON	;MUST BE 0 OR 1

INPREQ:	SOSL	SKPCHR		;SEE IF SKIPPING ANY BYTES (POSITIONING)
	JRST	@IPTFFL(M)	;PERFORM A ^L

	INCHRW	T1		;LET THE USER TALK
	CAIN	T1,15		;IF CR, SWALLOW LF
	INCHRW	XAMBEG		;GULP!
	CAIN	T1,33		;ESCAPING?
	JRST	@IPTESC(M)	;EVERY MODE HAS ITS OWN OF DUCKING OUT
	CAIN	T1,10		;BACKSPACE?
	JRST	@IPTBKS(M)
	CAIN	T1,177		;GIVING UP? - RUBOUT
	JRST	INPDEL		;EVERYBODY SURRENDERS THE SAME WAY
	TLNN	F,FL.FFL	;IF ZAPPING CHECK FOR FORM FEED (^L)
	JRST	INPCNV
	CAIN	T1,14		;FORWARD SPACE?
	JRST	@IPTFFL(M)
INPCNV:	TRNN	F,FR.MKC	;CHAR MODE ACCEPTS ANYTHING
	CAIL	T1,40		;NO MORE CONTROL ALLOWED
	SKIPA
	JRST	INPINV
	SUB	T1,IPMVAL(M)	;CONVERT TO LOCAL RELIGION
	JUMPL	T1,INPINV	;HERETIC
	CAMLE	T1,IPMMAX(M)	;MAXIMUM ALLOWED VALUE IN MODE
	JRST	INPINV
	JRST	@IPTCNV(M)	;LOCAL CONVERT/STORE DEPEDNDS ON MODE
;   ESCAPE ROUTINES. ESC (ALTMODE) MEANS THE USER HAS FINISHED. EITHER
;   THAT'S ALL THE SEARCH VALUES HAS WANTS, OR THE REST OF THE
;   WORD CAN KEEP ITS OLD VALUE.

IPTESC:	ITAGNL	;O
	ITAGNL	;S
	ITAGNL	;A
	ITAINS	;I
	ITAGNL	;K

ITAGNL:	CAMLE	T3,IPMBYT(M)	;SEE IF DID ANYTHING
	JRST	INPDEL		;STILL AT START = DELETE
ITACOM:	TLNN	F,FL.FFL	;IF ZAP, DISPLAY WHOLE VALUE
	JRST	ITASRC
	ANDCM	INF,A3
	OR	INF,A2		;FILL IN FOR DISPLAY
	OUTCHR	[15]		;START OF LINE
	HCOPY
	MOVE	T2,INF
	PUSHJ	P,@DISOUT(M)	;DISPLAY
	SKIPA
ITASRC:	JUMPE	A3,INPDEL	;IF NO MASK ON SEARCH, CALL IT RUBOUT
POPOUT:	SETSTS	TTY,TTECHO	;UNGAG HIM
	POPJ	P,		;BACK TO MASTER

ITAINS:	SKIPN	A1		;ESCAPE IN I-MODE
	JUMPE	A3,INPDEL	;NOTHING DOEN, NOTHING DOING
	TRNE	X,XR.OFC	;OP CODE DONE?
	JRST	IAIAFD
	PUSHJ	P,CHKMIS	;CHECK OUT OP
	  JRST	ICICOM		;YOU LOSE
	TLZE	F,FL.XIS	;X GIVEN?
	JRST	POPOUT
	MOVE	A2,T2		;VALUE
	MOVE	A3,T1		;MASK
	JRST	ITACOM
IAIAFD:	TRNE	X,XR.YFC	;ON ESCAPE, ASSUME WANTS Y FIELD
	JRST	ITACOM		;SINCE A/F AND X MUST TERMINATE W/ CHAR
	JUMPE	A1,ITACOM	;NO Y FIELD INPUT
	PUSHJ	P,SXBCNV	;CONVERT INPUT TO BINARY
	  JRST	ICICOM		;NO GOOD
	TLZE	F,FL.XIS	;X VALUE?
	JRST	ITACOM
	HRRI	A3,777777	;MASK OUT Y FIELD
	HRR	A2,T1		;AND GET VALUE
	JRST	ITACOM
;     BUILD VALUE IN A2, MASK IN A3. COUNT DOWN CHAR/BYTE AND BYTES.
;     DEF OF CHAR AND BYTE VARIES FOR MODES.

IPTCNV:	ITCGNL	;O
	ITCGNL	;S
	ITCASC	;A
	ITCINS	;I
	ITCKAS	;K

ITCGNL:	IDPB	T1,PTR	;OCTAL/SIXIBT/(ASCII): DEPOSIT CHAR
	ADD	T1,IPMVAL(M)	;BACK TO ORIGINAL
	CAIGE	T1,40		;IN CASE OF ASCII FORWARD SPACE
	MOVEI	T1,"\"		;OVER A CTRL CHAR
	OUTCHR	T1		;AND ECCHHHHHOOOOOOOOO
	MOVN	T1,IPMSFT(M)	;SHIFT RIGHT
	LSH	A3,(T1)		;TO MAKE ROOM
	OR	A3,IPMASK(M)	;FOR ADDITIONAL PART OF MASK
	SOJG	T2,INPREQ	;COUNT DOWN CHAR/BYTE
	CAIE	T3,1		;IF NOT LAST BYTE...
	OUTCHR	IPMSPC(M)	;OUT SPACE VAL BTWN BYTES
	SOJG	T3,INPRST	;COUNT DOWN BYTES/WORD
	JRST	POPOUT		;END O' THE LINE

ITCASC:	TLNN	F,FL.ZON	;ASCII - IS IT FIRST BIT?
	JRST	ITCGNL		;NO - LIKE EVERYBODY ELSE
	CAILE	T1,1
	JRST	INPINV		;MUST BE 0 OR 1
	MOVEI	T4,1
	DPB	T4,[POINT 6,PTR,11]	;CHANGE BYTE SIZE
	IDPB	T1,PTR		;AND MAKE DEPOSIT
	MOVEI	T4,3
	DPB	T4,[POINT 6,PTR,11]	;BACK TO NORMAL
	ADD	T1,IPMVAL(M)	;CONVERT FOR OUTPUT
	OUTCHR	T1
	LSH	A3,-1		;ADJUST MASK
	TLO	A3,400000	;ONE BIT
	TLZ	F,FL.ZON
	SOJ	T2,		;ADJUST CHAR/BYTE COUNTER
	CAILE	T3,1		;LAST BIT? (BIT 35)
	JRST	INPREQ		;NO
	JRST	POPOUT		;YES

ITCINS:	TRNE	X,XR.OFC	;INSTR - DECIDE WHICH PART NEXT
	JRST	ICIAXY		;ALREADY DID OP
	CAIN	T1,' '		;SPACE CAN END OP PART
	JRST	ICIOCK
	IDPB	T1,PTR		;JUST A CHARACTER
	ADD	T1,IPMVAL(M)	;MAKE PRETTY FOR OUTPUT
	OUTCHR	T1
	SOJG	T2,INPREQ	;ALLOWED UP TO 6 CHAR
ICIOCK:	MOVEM	T2,XAMEND	;SAVE
	PUSHJ	P,CHKMIS	;CHECK INSTRUCTION
	  JRST	ICICOM		;NONE THAT WE EVER HEARD OF
	MOVE	A1,XAMEND	;RESTORE
ICIOPT:	OUTCHR	[" "]		;SPACE OVER SO EVEN
	SOJGE	A1,ICIOPT	;WITH REST
	TRO	X,XR.OFC	;OP CODE GOTTEN
	TLZE	F,FL.XIS	;X-VALUE?
	JRST	ICICOM		;FORGET IT
	TRNE	T4,IS.CLI	;IS IT CALLI TYPE?
	TRO	X,XR.CLI!XR.YFC	;MARK Y PART FILLED
	TRNE	T4,IS.EXT	;HOW ABOUT EXTENEDED?
	TRO	X,XR.EXT!XR.AFC	;A/F FIELD TAKEN CARE OF
ICFIOP:	MOVE	A2,T2		;GET OP VALUE
	MOVE	A3,T1		;AND MASK
ICICOM:	MOVE	PTR,IPMPTR(M)	;NEW POINTER
	SETZ	A1,
	MOVEI	T2,6		;MAX CHAR/BYTE
	JRST	INPREQ		;PLEASE SIR, I WANT SOME MORE...
ICIAXY:	CAIN	T1,'@'		;INDIRECTION
	JRST	ICIIND
	CAIN	T1,','		;END OF A/F FIELD?
	JRST	ICIEAF
	CAIN	T1,'('	;END OF Y/START OF X?
	JRST	ICIBYX
	CAIN	T1,')'		;END OF X/ALL?
	JRST	ICIEIX
	IDPB	T1,PTR		;STILL BANKING
	ADD	T1,IPMVAL(M)
	OUTCHR	T1		;DISPLAY
	SOJG	T2,INPREQ	;IF RUN OUT, BECOMES Y PART
	TROE	X,XR.YFC	;GOT ONE ALREADY?
	JRST	ICIERR
ICICVY:	PUSHJ	P,SXBCNV	;CONVERT Y PART
	  JRST	ICIBNX		;OOPS
	TLZE	F,FL.XIS
	JRST	ICICXX
	HRR	A2,T1		;BUILD VALUE
	HRRI	A3,777777	;AND MASK
ICICXX:	TRNE	X,XR.XFS	;IF X PART STARTED,
	OUTCHR	["("]		;SHOW SOMETHING
	JRST	ICICOM
ICIBYX:	TROE	X,XR.XFS	;ALREADY STARTED X PART?
	JRST	INPINV
	TRNE	X,XR.YFC
	JRST	ICICXX		;ALREADY DID Y PART
	JRST	ICICVY		;GO ADD Y PART
ICIBNX:	TRZ	X,XR.XFS	;ERROR IN Y PART
	JRST	ICICOM
ICIIND:	JUMPN	A1,INPINV	;ALREADY STARTED SOMETHING ELSE
	TROE	X,XR.IFC	;INDIRECT - ALREADY HAVE ONE?
	JRST	INPINV
	OUTCHR	["@"]		;SHOW WORK
	TLO	A2,INDRCT	;BUILD INTO VALUE
	TLO	A3,INDRCT
	JRST	INPREQ
ICIEAF:	TROE	X,XR.AFC	;A/F FIELD
	JRST	INPINV
	PUSHJ	P,SXBCNV	;GET VALUE
	  JRST	ICICOM
	CAIG	T1,17
	JRST	ICIPAF	;MUST FIT INTO A/F FIELD
ICIERR:	PUSHJ	P,CHKMER	;CLEAN OUT INPUT ON SCREEN
	JRST	ICICOM
ICIPAF:	OUTCHR	[","]		;ACCEPTED
	TLZE	F,FL.XIS
	JRST	ICICOM
ICFIAF:	LSH	T1,^D23		;POSITION FOR INCLUSION
	OR	A2,T1
	OR	A3,[740,,0]	;MASK
	JRST	ICICOM
ICIEIX:	TRNN	X,XR.XFS	;HAVE WE STARTED AN INDEX?
	JRST	INPINV
	PUSHJ	P,SXBCNV	;CONVERT
	  JRST	ICICOM
	CAILE	T1,17
	JRST	ICIERR
	OUTCHR	[")"]
	TLZE	F,FL.XIS
	JRST	POPOUT
ICFIDX:	TSO	A2,T1		;POSITION AND INCLUDE
	OR	A3,[17,,0]	;MASK
	JRST	POPOUT		;POPPIES!

ITCKAS:	CAIE	T1,"!"		;ASCII CHAR MODE - IF !, NEXT CHAR IS CTRL
	JRST	ICKDEP
	INCHRW	T1		;GET THE CHAR
	CAIN	T1,15		;IF CR
	INCHRW	XAMBEG		;SWALLOW LF
	CAIN	T1,177		;IF NOT DELETE,
	TRZ	T1,100		;FORCE INTO CTRL
ICKDEP:	IDPB	T1,PTR		;MAKE DEP
	CAIGE	T1,40		;IF CTRL,
	MOVEI	T1,"\"		;DISPLAY AS BACKSLASH
	CAIN	T1,177
	MOVEI	T1,"\"		;DELETE IS BACKSLASH ALSO
	OUTCHR	T1
	LSH	A3,-7		;SHIFT OVER MASK
	OR	A3,IPMASK(M)	;ADD TO HIGH-ORDER END
	SOJG	T3,INPREQ	;ONE CHAR = ONE BYTE
	JRST	POPOUT
;   BACKSPACE ROUTINES.  ACCOUNT FOR BYTE BOUNDARIES. IF BACKSPACE PAST
;   BEGINNING OF WORD, EQUIVALENT TO DELETE. INSTR MODE ALLOWS
;   BACKSPACE ONLY TO BEGINNING OF PART.

BKPCUR:	BYTE (7) 10,40,10,0	;ERASE ONE CHAR FROM SCREEN

IPTBKS:	ITBGNL	;O
	ITBGNL	;S
	ITBASC	;A
	ITBINS	;I
	IBGBYT	;K

ITBGNL:	AOJ	T2,		;CHAR/BYTE
	CAMG	T2,IPMSIZ(M)	;BEGINNING OF BYTE?
	JRST	IBGCOM		;GONE PAST
	TRNE	F,FR.MIS	;IF GONE PAST IN INSTR MODE,
	JRST	INPRST		;START FROM BEGINNING OF CURRENT PART
IBGBYT:	AOJ	T3,		;CROSSING BYTE BOUND
	CAMLE	T3,IPMBYT(M)	;BACK TO START OF WORD?
	JRST	INPDEL		;GIVE UP
	MOVEI	T2,1		;LAST CHAR OF BYTE
	TRNN	F,FR.MKC	;ASCII CHAR DOES NOT HAVE SPACE
	OUTSTR	BKPCUR		;EXTRA TRACKS TO COVER
IBGCOM:	SETZ	T4,
	DPB	T4,PTR		;ZERO OUT AREA
	LSH	A3,@IPMSFT(M)	;RESHIFT MASK
	LDB	T4,[POINT 6,PTR,5]
	ADD	T4,IPMSFT(M)	;ADJUST POS OF POINTER
	DPB	T4,[POINT 6,PTR,5]
IBGCOT:	OUTSTR	BKPCUR		;BLANK IT OUT
	HCOPY
	JRST	INPREQ

ITBASC:	TLZE	F,FL.ZON	;ASCII - TEST FOR FIRST BIT
	JRST	IBGBYT		;CROSS BYTE LINE
	AOJ	T2,
	CAME	T2,IPMSIZ(M)	;NOW AT FIRST CHAR?
	JRST	IBGCOM		;NO
	TLO	F,FL.ZON	;MARK
	MOVEI	T1,1
	DPB	T1,[POINT 6,PTR,11]
	SETZ	T1,		;CLEAR BIT
	DPB	T1,PTR
	MOVEI	T1,3		;ORIGINAL PTR VALUE - SIZE
	DPB	T1,[POINT 6,PTR,11]
	LSH	A3,1		;ADJUST MASK
	LDB	T1,[POINT 6,PTR,5]	;ADJUST PTR VALUE - POS
	AOJ	T1,1
	DPB	T1,[POINT 6,PTR,5]
	JRST	IBGCOT

ITBINS:	JUMPE	A1,INPREQ	;BACKSPACE ONLY TO START OF CURRENT WORKSPACE
	JRST	ITBGNL		;LIKE EVERYBODY ELSE
;    FORWARD SPACE - ZAP ONLY.
;  THE APPROPRIATE VALUE IS RETRIEVED FROM INF AND PASSED ON TO THE
; DEPOSIT ROUTINE, MAKING IT APPEAR THAT THE USER HAD TYPED IN THAT
; VALUE INSTEAD OF ^L. IN INSTR MODE, THE NEXT PART (OP, A/F, Y OR
; X) IS DISPLAYED AND PASSED ON. IF THE OP IS CALLI OR EXTENDED,
; THE APPROPRIATE VALUES ARE SET.

IPTFFL:	ITFGNL	;O
	ITFGNL	;S
	ITFASC	;A
	ITFINS	;I
	ITFGNL	;K

ITFGNL:	HLL	T4,PTR		;O/S/K - BUILD POINTER INTO INF
	HRRI	T4,INF
	ILDB	T1,T4		;GET VALUE
	JRST	ITCGNL		;AND PASS IT ON

ITFASC:	TLNN	F,FL.ZON
	JRST	ITFGNL		;IF NOT FIRST BIT, NORMAL
	HLL	T4,PTR
	HRRI	T4,INF
	MOVEI	T1,1
	DPB	T1,[POINT 6,T4,11]	;BUILD SPECIAL PTR
	ILDB	T1,T4
	JRST	ITCASC

ITFINS:	JUMPN	A1,INPINV	;INSTR - NO PARTIAL SKIPS ALLOWED
	MOVE	T2,INF		;FOR USE BY DISPLAY ROUTINES
	TRON	X,XR.OFC	;DECIDE WHAT'S BEEN DONE
	JRST	IFIOPC
	TRON	X,XR.AFC
	JRST	IFIAFC		;DO THE A/F FIELD
	TRON	X,XR.YFC
	JRST	IFIYFC
	TRNE	X,XR.XFS	;HAVE WE STARTED X PART?
	JRST	INPINV
	PUSHJ	P,DMIXFC	;DISPLAY X PART
	LDB	T1,[POINT 4,INF,17]	;GET VALUE FOR DEPOSIT
	JRST	ICFIDX		;BEHAVE AS THOUGH ENTERED VALUE
IFIOPC:	PUSHJ	P,DMIOPC	;DISPLAY OP CODE PART
	MOVE	T2,INF
	TLZ	T2,27		;REMOVE INDEX AND INDIRECT
	HRLZI	T1,777000	;MASK
	TRNN	T4,IS.CLI	;SEE IF CALLI INSTR
	JRST	IFIOAF
	HRRI	T1,-1		;MASK IN CALLI PART
	TRO	X,XR.CLI!XR.YFC	;SHOW FILLED
	TLZ	T2,740		;AND REMOVE A/F FIELD
	JRST	ICFIOP
IFIOAF:	TRNN	T4,IS.EXT	;MAYBE EXTENDED INSTR
	JRST	IFIORD		;JUST ORDINARY
	TRO	X,XR.EXT!XR.AFC	;MARK IT FILLD
	HLLZS	T2
	TLO	T1,740		;INCLUDE A/F IN MASK
	JRST	ICFIOP
IFIORD:	TLZ	T2,740		;ORDINARY - REMOVE X AND A/F
	HLLZS	T2
	JRST	ICFIOP
IFIAFC:	PUSHJ	P,DMIAFC	;DISPLAY A/F PART
	LDB	T1,[POINT 4,INF,12]	;GET VALUE
	JRST	ICFIAF
IFIYFC:	PUSHJ	P,DMIYFC	;DISPLAY Y FIELD
	HRR	A2,INF		;BUILD Y FIELD DIRECTLY
	HRRI	A3,-1		;INCLUDE IN MASK
	TLNN	INF,INDRCT	;INDIRECT?
	JRST	ICICOM
	TLO	A2,INDRCT	;SET BITS IN VALUE
	TLO	A3,INDRCT	;AND MASK
	JRST	ICICOM
;   MISCELLANEOUS

INPINV:	OUTSTR	[BYTE (7) 77,10,0]	;CLEAR INVALID CHAR
	HCOPY
	JRST	INPREQ		;CONTINUE

INPDEL:	TLNN	F,FL.FFL	;DELETE
	OUTSTR	[ASCIZ /DELETED
/]
	TLNE	F,FL.FFL
	OUTSTR	[ASCIZ /UNCHANGED
/]
	SETSTS	TTY,TTECHO	;LAST MINUTE DETAILS
	TLZE	F,FL.XBD
	PUSHJ	P,TRFBBD
	POP	P,T1		;ADJUST STACK
	TLNE	F,FL.FFL	;IF ZAPPING,
	TRNN	F,FR.ASR	;AND ON AUTOMATIC S/Z,
	JRST	ZAPERR		;FOR CLEAR INPUT
	JRST	SRCCON		;CONTINUE AUTO S-Z

;   CONVERSION SUBROUTINE - CONVERT TO BINARY. CHECK FOR X-VALUE
;   INPUT VALUE IN A1; RETURN IN T1. FL.XIS SET APPROPRIATELY. IF
;   ERROR, CLEAR LINE AND RETURN +1, ELSE RETURN +2

SXBCNV:	SETZB	T1,T2
	TLNE	F,FL.FFL
	JRST	SXBSRC		;X VALUE ALLOWED ONLY ON SEARCH
	TLO	F,FL.XIS
	CAMN	A1,[SIXBIT /X/]
	JRST	SXBVLD
SXBSRC:	TLZ	F,FL.XIS	;NOT X VALUE
	SKIPN	T3,A1
	JRST	SXBVLD		;BLANK = 0
SXBCON:	SETZ	T2,
	LSHC	T2,6		;CONVERT CHAR AT A TIME
	SUBI	T2,20
	JUMPL	T2,CHKMER	;NOT A NUMBER
	CAILE	T2,7
	JRST	CHKMER		;DITTO
	LSH	T1,3
	IOR	T1,T2		;ADD TO COLLECTION
	JUMPN	T3,SXBCON
SXBVLD:	AOS	(P)		;SKIP RETURN
	POPJ	P,

;   OUTPUT 4 BITS IN T1 

TWODIG:	LSHC	T1,-3
	ADDI	T1,60
	OUTCHR	T1		;HIGH ORDER BIT
	SETZ	T1,
	LSHC	T1,3
	ADDI	T1,60
	OUTCHR	T1		;LOW ORDER BYTE
	POPJ	P,


;   TABLES - INDEXED BY MODE

IPMBYT:	EXP	2,1,6,4,5	;NO OF BYTES

IPMSIZ:	EXP	6,6,3,6,1	;SIZE OF BYTE - CHAR/BYTE

SRXCNV:
IPMVAL:	EXP	60,40,60,40,0	;CONVERSION FACTOR

IPMMAX:	EXP	7,77,7,77,177	;MAX ALLOWED VALUE

IPMSFT:	EXP	3,6,3,6,7	;SHIFT VALUE - SIZE OF CHAR

IPMSPC:	","			;SPACING CHAR
	0
	" "
	0
	0

IPMPTR:	POINT	3,A2		;BYTE POINTERS
	POINT	6,A2
	POINT	3,A2
	POINT	6,A1
	POINT	7,A2

IPMASK:	700000,,0		;MASK FOR ONE BYTE - HIGH ORDER
	770000,,0
	700000,,0
	0
	774000,,0
	SUBTTL	OTHER SUBROUTINES
;   SUBROUTINES FOR INSTR MODE TO HANDLE INSTRUCTION NAMES AND DISPLAY

;   MAIN SUBROUTINE (DISMIS) DISPLAYS INSTRUCTION AND ALL PARTS, USING
;  THE OTHER SUBROUTINES. SPACING IS INCLUDED.

;   VALUES PASSED ARE: T2 - EENTIRE INSTRUCTION
;   VALUES RETURNED:
;    BK - REL POINTER INTO MACHT TABLE
;    T4 - INSTRUCTION FLAGS

;    SUB-SUBROUTINES:
;	DMIOPC - DISPLAY OP CODE PART, FIX VALUES FOR BK AND T4
;	DMIAFC - DISPLAY A/F FIELD, IF NOT ZERO
;	DMIYFC - DISPLAY Y PART. IF ZERO, PRINT "0".
;	DMIXFC - DISPLAY  FIELD, IF NOT ZERO

;    ALL SUBROUTINES CAN BE CALLED INDEPENDENTLY. ALL PASS VALUE IN
;    T3 BETWEEN THEM TO COUNT THE NUMBER OF SPACES REMAINING, BUT THIS
;    CAN BE IGNORED IF NOT THE MAIN DISPLAY ROUTINE.


DISMIS:	PUSH	P,T2		;MAIN DISPLAY ROUTINE - SHOW ALL, WITH TRAILING BLANKS
	PUSHJ	P,DMIOPC	;DISPLAY OP CODE
	MOVEI	T3,^D14		;NUMBER OF SPACES TO BE FILLED
	MOVE	T2,(P)		;RECOVER VALUE
	TRNN	T4,IS.EXT	;A/F PART NEEDED?
	PUSHJ	P,DMIAFC	;YES
	MOVE	T2,(P)
	TRNN	T4,IS.CLI	;Y PART NEEDED?
	PUSHJ	P,DMIYFC
	MOVE	T2,(P)
	PUSHJ	P,DMIXFC	;ALWAYS DO X PART
DISMPS:	SOJL	T3,DISMEX	;ADD TRAILING BLANKS - T3 SAYS HOW MANY
	OUTCHR	[" "]
	JRST	DISMPS
DISMEX:	POP	P,T2		;CLEAR STACK
	POPJ	P,

DMIOPC:	SETZ	T1,		;DISPLAY OPCODE AND SET BK, T4 VALUES
	LSHC	T1,^D9		;GET INSTRUCTION CODE
	HRLZ	T3,T1		;SAVE IF NECESSARY
	LSH	T1,1		;DOUBLE FOR TABLE
	MOVE	T4,MISTBL+1(T1)	;GET VALUE OF INSTR
	MOVE	BK,T1
	TRNN	T4,IS.CLI!IS.EXT	;SPECIAL CASE?
	JRST	DISMPR		;REGULAR
	LSH	T1,-1
	TRZE	T4,IS.EXT	;EXTENDED?
	LSHC	T1,4		;GET A/F VALUE
	LSH	T1,^D23		;LEFT-JUSTIFY
	LSH	T2,-^D9
	TRZE	T4,IS.CLI
	HRLZ	T1,T2		;IF CALLI, GET SUBVAL
	SKIPA	BK,T4		;GET FIRST LINK
DISMSR:	LDB	BK,[POINT 9,MISTXC+1(BK),35]	;GET LINK
	JUMPE	BK,DISMDT	;DATA
	LSH	BK,1		;DOUBLE LINK
	HLLZ	T4,MISTXC+1(BK)	;GET VALUE
	CAME	T4,T1		;MATCH?
	JRST	DISMSR
	HRRZ	T4,MISTXC+1(BK)	;SET FLAGS
	ADDI	BK,MISTXC-MISTBL	;ADJUST RELATIVE ADDRESS
DISMPR:	MOVE	T2,MISTBL(BK)	;GET SIXBIT NAME
	JUMPE	T2,DISMDT	;NULL NAME MEANS DATA
	PUSHJ	P,SIXOUT	;AND OUTPUT
	OUTCHR	[" "]
CPOPJ:	POPJ	P,		;END OF OP CODE
DISMDT:	LSHC	T2,^D45		;DATA - RECOVER AND OUTPUT AS BINARY
	MOVEI	T3,3		;FORCE 3 DIGITS
	PUSHJ	P,BINONE
	OUTSTR	[BYTE (7) 40,40,40,40,0]
	SETZ	T4,
	POPJ	P,
DMIAFC:	LDB	T1,[POINT 4,T2,12]	;A/F - GET VALUE
	JUMPE	T1,CPOPJ
	PUSHJ	P,TWODIG
	OUTCHR	[","]
	SUBI	T3,3		;COUNT DOWN SPACES REMAINING
	POPJ	P,		;END OF A/F FIELD

DMIYFC:	TLNE	T2,INDRCT	;DISPLAY Y FIELD - CHECK FOR INDIRECT
	OUTCHR	["@"]
	TLNE	T2,INDRCT
	SOJ	T3,
	HRLZS	T2
	JUMPE	T2,BINNOZ
	TLO	F,FL.LDZ	;START OUT W/ LEADING ZEROS
	MOVEI	T4,6
BINNLP:	SETZ	T1,
	LSHC	T1,3		;OUTPUT Y PART, ELIMINATING LEADING ZEROS
	TLNE	F,FL.LDZ	;STILL LEADING?
	JUMPE	T1,BINNCT
	TLZ	F,FL.LDZ
	ADDI	T1,60		;BAPTISM
	OUTCHR	T1
	SOJ	T3,		;ANOTHER SPACE GONE
BINNCT:	SOJG	T4,BINNLP	;6 DIGITS MAX
	POPJ	P,
BINNOZ:	OUTCHR	["0"]		;IF ZERO, PRINT ONE
	SOJ	T3,
	POPJ	P,		;END OF Y FIELD

DMIXFC:	LDB	T1,[POINT 4,T2,17]	;DISPLAY X FIELD
	JUMPE	T1,CPOPJ	;ZERO INDEX
	OUTCHR	["("]
	PUSHJ	P,TWODIG
	OUTCHR	[")"]
	SUBI	T3,4
	POPJ	P,		;END OF X FIELD

;     SUBROUTINE TO TAKE SIXBIT VALUE IN A1 AND PERFORM LOOKUP IN
;     INSTR TABLE. RETURN INSTR VAL IN T2, MASK IN T1. SET FL.XIS IF
;     INSTR IS X - ALL INSTR VALID. IF INVALID INSTR, CLEAR SCREEN 
;     LINE AND SET T2 TO 0. T4 CONTAINS CLI, EXT BITS
;    RETURN +1 IF ERROR
;   RETURN +2 IF OK

CHKMIS:	SETZB	T2,T1
	TLNE	F,FL.FFL	;IF CAN HAVE ^L,
	JRST	CHKSRC		;CAN'T HAVE X
	TLO	F,FL.XIS
	CAMN	A1,[SIXBIT /X/]
	JRST	CHKLVE		;RETURN OF THE STRANGER
CHKSRC:	TLZ	F,FL.XIS	;NO GOOD, THAT ONE
	JUMPE	A1,CHKMER	;BLANK IS NOT X
	
;   CHECK IF ALL NUMERIC; IF SO, RETURN BINARY EQUIVALENT

	HRRZ	T3,A1
	JUMPN	T3,CHKNAM	;MORE THAN 3 CHAR
	HLLZ	T3,A1
CHKNUM:	LSHC	T2,6
	SUBI	T2,20		;CONVERT FROM SIXBIT TO BINARY
	JUMPL	T2,CHKMER	;WON'T CONVERT
	CAILE	T2,7
	JRST	CHKNAM		;NOT A NUMBER
	LSH	T2,^D33
	LSHC	T1,3		;ADD TO THE COLLECTION
	JUMPN	T3,CHKNUM
	LSHC	T1,-^D9		;PLACE VALUE IN OUPUT REG
	SETZ	T4,
	JRST	CHKMSK		;SET UP MASK

;   NOT A NUMBER. LOOKUP ON TABLE. LINEAR SEARCH.
;   (INEFFICIENT, BUT RARELY DONE.)

CHKNAM:	MOVEI	T1,40		;SKIP THE L-UUO'S
CHKCHK:	MOVE	T3,MISTBL(T1)	;GET SIXBIT NAME
	AOJ	T1,		;FOR ODD VALUE
	CAMN	T3,[-1]		;END OF TABLE?
	JRST	CHKMER
	CAME	A1,T3
	AOJA	T1,CHKCHK	;KEEP PLUGGING
	HRRE	T4,MISTBL(T1)	;FIND OUT WHAT WE GOT
	JUMPL	T4,CHKCAL	;CALLI TYPE
	HLLZ	T2,MISTBL(T1)	;GET INSTRUCTION VALUE
CHKMSK:	MOVE	T1,[777000,,0]	;MASK VALUE
	TRNE	T4,IS.EXT	;EXTENDED INSTR?
	TLO	T1,740		;EXTEND MASK
CHKLVE:	AOS	(P)		;NORMAL RETURN
	POPJ	P,
CHKCAL:	HLRZ	T2,MISTBL(T1)	;GET CALLI PART
	HRLI	T2,047000	;ADD CALLI OP CODE
	MOVE	T1,[777000,,777777]	;CALLI MASK
	AOS	(P)		;NORMAL RETURN
	POPJ	P,

CHKMER:	HCOPY			;INVALID INSTRUCTION. ERASE FROM SCREEN
	MOVE	T3,A1
CHKERC:	SETZ	T2,
	LSHC	T2,6		;FOR EVERY CHAR TYPED, BACKSPACE ONE AND CLEAR
	SKIPN	T2
	JRST	CHKERF
	OUTSTR	BKPCUR
	JRST	CHKERC
CHKERF:	OUTSTR	[BYTE (7) 77,10,0]	;QUESTION THE WHOLE THING
	POPJ	P,		;T2 IS ALREADY ZERO. GOTTA WATCHTHOSE
				;LEFT-HANDED MANUEVERS...
;   TABLE OF MACHINE INSTRUCTIONS

;    THIS TABLE IS ARRANGED IN INSTRUCTION ORDER, AS TWO WORDS
;    PER INSTRUCTION:

;    WORD 0:	NAME OF INSTR IN SIXBIT
;	  1:	BITS 0-17:	OP CODE+A/F VALUE(IF EXTENDED)
;			   OR	CALLI VALUE (Y PART)
;		       18:	=1 FOR CALLI INSTRUCTION
;		       19:	=1 FOR EXTENDED INSTRUCTION
;		       20:	=1 FOR ILLEGAL INSTRUCTION
;		    26-35:	LINK OR NULL



;    MACRO FOR DEFINING INSTRUCTIONS IN TABLE ACCORDING TO ABOVE FORMAT

	DEFINE	MACHT($NAME,$VAL,$SUBV,$LINK<0>,$CALLI<0>)
<
	XLIST
	SIXBIT	/$NAME/
	IFE	$CALLI,<
	IFG $SUBV,<$EXP==1
		$A==$SUBV>
	IFE $SUBV,<$EXP==0
		$A==0>
	IFL $SUBV,<$EXP==1
		$A==0>
	EXP	<$VAL>B8+<$A>B12+<$EXP>B19+<$LINK>B35
>
	IFN	$CALLI,<
	EXP	<$VAL>B17+<1>B18+<$LINK>B35
>
	LIST
>

;   LINK IS RELATIVE TO MISTXC - THE START OF THE EXTENDED TABLE.
;   THE TABLE ENDS WITH -1.

;  MACRO FOR FILL AREAS - ILLEGAL INSTRUCTIONS

	DEFINE	MFILL($N)
<
	XLIST
	REPEAT	$N,<EXP 0,IS.ILI>
	LIST
>


	XALL

MISTBL:	MFILL(40)	;L-UUO'S
	MACHT(CALL,40)
	MACHT(INIT,41)
	MFILL(5)	;RESERVED FOR SPECIAL MONITORS
	MACHT(CALLI,0,,32,1)
	MACHT(OPEN,50)
	MACHT(TTCALL,51,17,14)	;INVALID SUBVALUE FORCES LINK SEARCH
	MFILL(3)	;RESERVED FOR DEC
	MACHT(RENAME,55)
	MACHT(IN,56)
	MACHT(OUT,57)
	MACHT(SETSTS,60)
	MACHT(STATO,61)
	MACHT(GETSTS,62)
	MACHT(STATZ,63)
	MACHT(INBUF,64)
	MACHT(OUTBUF,65)
	MACHT(INPUT,66)
	MACHT(OUTPUT,67)
	MACHT(CLOSE,70)
	MACHT(RELEAS,71)
	MACHT(MTAPE,72)
	MACHT(UGETF,73)
	MACHT(USETI,74)
	MACHT(USETO,75)
	MACHT(LOOKUP,76)
	MACHT(ENTER,77)
	MACHT(UJEN,100)
	MFILL(3)	;UNIMPLEMENTED
	MACHT(JSYS,104)	;FOR LATER TENEX EXPANSION
	MFILL(3)
	MACHT(DFAD,110)
	MACHT(DFSB,111)
	MACHT(DFMP,112)
	MACHT(DFDV,113)
	MFILL(4)
	MACHT(DMOVE,120)
	MACHT(DMOVN,121)
	MACHT(FIX,122)
	MFILL(1)
	MACHT(DMOVEM,124)
	MACHT(DMOVNM,125)
	MACHT(FIXR,126)
	MACHT(FLTR,127)
	MACHT(UFA,130)
	MACHT(DFN,131)
	MACHT(FSC,132)
	MACHT(IBP,133)
	MACHT(ILDB,134)
	MACHT(LDB,135)
	MACHT(IDPB,136)
	MACHT(DPB,137)
	MACHT(FAD,140)
	MACHT(FADL,141)
	MACHT(FADM,142)
	MACHT(FADB,143)
	MACHT(FADR,144)
	MACHT(FADRI,145)
	MACHT(FADRM,146)
	MACHT(FADRB,147)
	MACHT(FSB,150)
	MACHT(FSBL,151)
	MACHT(FSBM,152)
	MACHT(FSBB,153)
	MACHT(FSBR,154)
	MACHT(FSBRI,155)
	MACHT(FSBRM,156)
	MACHT(FSBRB,157)
	MACHT(FMP,160)
	MACHT(FMPL,161)
	MACHT(FMPM,162)
	MACHT(FMPB,163)
	MACHT(FMPR,164)
	MACHT(FMPRI,165)
	MACHT(FMPRM,166)
	MACHT(FMPRB,167)
	MACHT(FDV,170)
	MACHT(FDVL,171)
	MACHT(FDVM,172)
	MACHT(FDVB,173)
	MACHT(FDVR,174)
	MACHT(FDVRI,175)
	MACHT(FDVRM,176)
	MACHT(FDVRB,177)
	MACHT(MOVE,200)
	MACHT(MOVEI,201)
	MACHT(MOVEM,202)
	MACHT(MOVES,203)
	MACHT(MOVS,204)
	MACHT(MOVSI,205)
	MACHT(MOVSM,206)
	MACHT(MOVSS,207)
	MACHT(MOVN,210)
	MACHT(MOVNI,211)
	MACHT(MOVNM,212)
	MACHT(MOVNS,213)
	MACHT(MOVM,214)
	MACHT(MOVMI,215)
	MACHT(MOVMM,216)
	MACHT(MOVMS,217)
	MACHT(IMUL,220)
	MACHT(IMULI,221)
	MACHT(IMULM,222)
	MACHT(IMULB,223)
	MACHT(MUL,224)
	MACHT(MULI,225)
	MACHT(MULM,226)
	MACHT(MULB,227)
	MACHT(IDIV,230)
	MACHT(IDIVI,231)
	MACHT(IDIVM,232)
	MACHT(IDIVB,233)
	MACHT(DIV,234)
	MACHT(DIVI,235)
	MACHT(DIVM,236)
	MACHT(DIVB,237)
	MACHT(ASH,240)
	MACHT(ROT,241)
	MACHT(LSH,242)
	MACHT(JFFO,243)
	MACHT(ASHC,244)
	MACHT(ROTC,245)
	MACHT(LSHC,246)
	MFILL(1)
	MACHT(EXCH,250)
	MACHT(BLT,251)
	MACHT(AOBJP,252)
	MACHT(AOBJN,253)
	MACHT(JRST,254,-1,2)
	MACHT(JFCL,255,-1,7)
	MACHT(XCT,256)
	MACHT(MAP,257)
	MACHT(PUSHJ,260)
	MACHT(PUSH,261)
	MACHT(POP,262)
	MACHT(POPJ,263)
	MACHT(JSR,264)
	MACHT(JSP,265)
	MACHT(JSA,266)
	MACHT(JRA,267)
	MACHT(ADD,270)
	MACHT(ADDI,271)
	MACHT(ADDM,272)
	MACHT(ADDB,273)
	MACHT(SUB,274)
	MACHT(SUBI,275)
	MACHT(SUBM,276)
	MACHT(SUBB,277)
	MACHT(CAI,300)
	MACHT(CAIL,301)
	MACHT(CAIE,302)
	MACHT(CAILE,303)
	MACHT(CAIA,304)
	MACHT(CAIGE,305)
	MACHT(CAIN,306)
	MACHT(CAIG,307)
	MACHT(CAM,310)
	MACHT(CAML,311)
	MACHT(CAME,312)
	MACHT(CAMLE,313)
	MACHT(CAMA,314)
	MACHT(CAMGE,315)
	MACHT(CAMN,316)
	MACHT(CAMG,317)
	MACHT(JUMP,320)
	MACHT(JUMPL,321)
	MACHT(JUMPE,322)
	MACHT(JUMPLE,323)
	MACHT(JUMPA,324)
	MACHT(JUMPGE,325)
	MACHT(JUMPN,326)
	MACHT(JUMPG,327)
	MACHT(SKIP,330)
	MACHT(SKIPL,331)
	MACHT(SKIPE,332)
	MACHT(SKIPLE,333)
	MACHT(SKIPA,334)
	MACHT(SKIPGE,335)
	MACHT(SKIPN,336)
	MACHT(SKIPG,337)
	MACHT(AOJ,340)
	MACHT(AOJL,341)
	MACHT(AOJE,342)
	MACHT(AOJLE,343)
	MACHT(AOJA,344)
	MACHT(AOJGE,345)
	MACHT(AOJN,346)
	MACHT(AOJG,347)
	MACHT(AOS,350)
	MACHT(AOSL,351)
	MACHT(AOSE,352)
	MACHT(AOSLE,353)
	MACHT(AOSA,354)
	MACHT(AOSGE,355)
	MACHT(AOSN,356)
	MACHT(AOSG,357)
	MACHT(SOJ,360)
	MACHT(SOJL,361)
	MACHT(SOJE,362)
	MACHT(SOJLE,363)
	MACHT(SOJA,364)
	MACHT(SOJGE,365)
	MACHT(SOJN,366)
	MACHT(SOJG,367)
	MACHT(SOS,370)
	MACHT(SOSL,371)
	MACHT(SOSE,372)
	MACHT(SOSLE,373)
	MACHT(SOSA,374)
	MACHT(SOSGE,375)
	MACHT(SOSN,376)
	MACHT(SOSG,377)
	MACHT(SETZ,400)
	MACHT(SETZI,401)
	MACHT(SETZM,402)
	MACHT(SETZB,403)
	MACHT(AND,404)
	MACHT(ANDI,405)
	MACHT(ANDM,406)
	MACHT(ANDB,407)
	MACHT(ANDCA,410)
	MACHT(ANDCAI,411)
	MACHT(ANDCAM,412)
	MACHT(ANDCAB,413)
	MACHT(SETM,414)
	MACHT(SETMI,415)
	MACHT(SETMM,416)
	MACHT(SETMB,417)
	MACHT(ANDCM,420)
	MACHT(ANDCMI,421)
	MACHT(ANDCMM,422)
	MACHT(ANDCMB,423)
	MACHT(SETA,424)
	MACHT(SETAI,425)
	MACHT(SETAM,426)
	MACHT(SETAB,427)
	MACHT(XOR,430)
	MACHT(XORI,431)
	MACHT(XORM,432)
	MACHT(XORB,433)
	MACHT(IOR,434)
	MACHT(IORI,435)
	MACHT(IORM,436)
	MACHT(IORB,437)
	MACHT(ANDCB,440)
	MACHT(ANDCBI,441)
	MACHT(ANDCBM,442)
	MACHT(ANDCBB,443)
	MACHT(EQV,444)
	MACHT(EQVI,445)
	MACHT(EQVM,446)
	MACHT(EQVB,447)
	MACHT(SETCA,450)
	MACHT(SETCAI,451)
	MACHT(SETCAM,452)
	MACHT(SETCAB,453)
	MACHT(ORCA,454)
	MACHT(ORCAI,455)
	MACHT(ORCAM,456)
	MACHT(ORCAB,457)
	MACHT(SETCM,460)
	MACHT(SETCMI,461)
	MACHT(SETCMM,462)
	MACHT(SETCMB,463)
	MACHT(ORCM,464)
	MACHT(ORCMI,465)
	MACHT(ORCMM,466)
	MACHT(ORCMB,467)
	MACHT(ORCB,470)
	MACHT(ORCBI,471)
	MACHT(ORCBM,472)
	MACHT(ORCBB,473)
	MACHT(SETO,474)
	MACHT(SETOI,475)
	MACHT(SETOM,476)
	MACHT(SETOB,477)
	MACHT(HLL,500)
	MACHT(HLLI,501)
	MACHT(HLLM,502)
	MACHT(HLLS,503)
	MACHT(HRL,504)
	MACHT(HLRI,505)
	MACHT(HRLM,506)
	MACHT(HRLS,507)
	MACHT(HLLZ,510)
	MACHT(HLLZI,511)
	MACHT(HLLZM,512)
	MACHT(HLLZS,513)
	MACHT(HRLZ,514)
	MACHT(HRLZI,515)
	MACHT(HRLZM,516)
	MACHT(HRLZS,517)
	MACHT(HLLO,520)
	MACHT(HLLOI,521)
	MACHT(HLLOM,522)
	MACHT(HLLOS,523)
	MACHT(HRLO,524)
	MACHT(HRLOI,525)
	MACHT(HRLOM,526)
	MACHT(HRLOS,527)
	MACHT(HLLE,530)
	MACHT(HLLEI,531)
	MACHT(HLLEM,532)
	MACHT(HLLES,533)
	MACHT(HRLE,534)
	MACHT(HRLEI,535)
	MACHT(HRLEM,536)
	MACHT(HRLES,537)
	MACHT(HRR,540)
	MACHT(HRRI,541)
	MACHT(HRRM,542)
	MACHT(HRRS,543)
	MACHT(HLR,544)
	MACHT(HLRI,545)
	MACHT(HLRM,546)
	MACHT(HLRS,547)
	MACHT(HRRZ,550)
	MACHT(HRRZI,551)
	MACHT(HRRZM,552)
	MACHT(HRRZS,553)
	MACHT(HLRZ,554)
	MACHT(HLRZI,555)
	MACHT(HLRZM,556)
	MACHT(HLRZS,557)
	MACHT(HRRO,560)
	MACHT(HRROI,561)
	MACHT(HRROM,562)
	MACHT(HRROS,563)
	MACHT(HLRO,564)
	MACHT(HLROI,565)
	MACHT(HLROM,566)
	MACHT(HLROS,567)
	MACHT(HRRE,570)
	MACHT(HRREI,571)
	MACHT(HRREM,572)
	MACHT(HRRES,573)
	MACHT(HLRE,574)
	MACHT(HLREI,575)
	MACHT(HLREM,576)
	MACHT(HLRES,577)
	MACHT(TRN,600)
	MACHT(TLN,601)
	MACHT(TRNE,602)
	MACHT(TLNE,603)
	MACHT(TRNA,604)
	MACHT(TLNA,605)
	MACHT(TRNN,606)
	MACHT(TLNN,607)
	MACHT(TDN,610)
	MACHT(TSN,611)
	MACHT(TDNE,612)
	MACHT(TSNE,613)
	MACHT(TDNA,614)
	MACHT(TSNA,615)
	MACHT(TDNN,616)
	MACHT(TSNN,617)
	MACHT(TRZ,620)
	MACHT(TLZ,621)
	MACHT(TRZE,622)
	MACHT(TLZE,623)
	MACHT(TRZA,624)
	MACHT(TLZA,625)
	MACHT(TRZN,626)
	MACHT(TLZN,627)
	MACHT(TDZ,630)
	MACHT(TSZ,631)
	MACHT(TDZE,632)
	MACHT(TSZE,633)
	MACHT(TDZA,634)
	MACHT(TSZA,635)
	MACHT(TDZN,636)
	MACHT(TSZN,637)
	MACHT(TRC,640)
	MACHT(TLC,641)
	MACHT(TRCE,642)
	MACHT(TLCE,643)
	MACHT(TRCA,644)
	MACHT(TLCA,645)
	MACHT(TRCN,646)
	MACHT(TLCN,647)
	MACHT(TDC,650)
	MACHT(TSC,651)
	MACHT(TDCE,652)
	MACHT(TSCE,653)
	MACHT(TDCA,654)
	MACHT(TSCA,655)
	MACHT(TDCN,656)
	MACHT(TSCN,657)
	MACHT(TRO,660)
	MACHT(TLO,661)
	MACHT(TROE,662)
	MACHT(TLOE,663)
	MACHT(TROA,664)
	MACHT(TLOA,665)
	MACHT(TRON,666)
	MACHT(TLON,667)
	MACHT(TDO,670)
	MACHT(TSO,671)
	MACHT(TDOE,672)
	MACHT(TSOE,673)
	MACHT(TDOA,674)
	MACHT(TSOA,675)
	MACHT(TDON,676)
	MACHT(TSON,677)
MISTXC:	MFILL(2)	;DUMMY - ELSE LINK TO HERE WOULD BE ZERO=NULL
	MACHT(JRST,254,-1,3)
	MACHT(PORTAL,254,4,4)
	MACHT(JRSTF,254,10,5)
	MACHT(HALT,254,20,6)
	MACHT(JEN,254,50)	;END OF JRST GROUP
	MACHT(JFOV,255,4,10)
	MACHT(JCRY1,255,10,11)
	MACHT(JCRY0,255,20,12)
	MACHT(JCRY,255,30,13)
	MACHT(JOV,255,40)
	MACHT(INCHRW,51,-1,15)
	MACHT(OUTCHR,51,1,16)
	MACHT(INCHRS,51,2,17)
	MACHT(OUTSTR,51,3,20)
	MACHT(INCHWL,51,4,21)
	MACHT(INCHSL,51,5,22)
	MACHT(GETLCH,51,6,23)
	MACHT(SETLCH,51,7,24)
	MACHT(RESCAN,51,10,25)
	MACHT(CLRBFI,51,11,26)
	MACHT(CLRBFO,51,12,27)
	MACHT(SKPINC,51,13,30)
	MACHT(SKPINL,51,14,31)
	MACHT(IONEOU,51,15)
	MACHT(LIGHTS,777777,,33,1)
	MACHT(RESET,0,,34,1)
	MACHT(DDTIN,1,,35,1)
	MACHT(SETDDT,2,,36,1)
	MACHT(DDTOUT,3,,37,1)
	MACHT(DEVCHR,4,,40,1)
	MACHT(DDTGT,5,,41,1)
	MACHT(GETCHR,6,,42,1)
	MACHT(DDTRL,7,,43,1)
	MACHT(WAIT,10,,44,1)
	MACHT(CORE,11,,45,1)
	MACHT(EXIT,12,,46,1)
	MACHT(UPTCLR,13,,47,1)
	MACHT(DATE,14,,50,1)
	MACHT(LOGIN,15,,51,1)
	MACHT(APRENB,16,,52,1)
	MACHT(LOGOUT,17,,53,1)
	MACHT(SWITCH,20,,54,1)
	MACHT(REASSI,21,,55,1)
	MACHT(TIMER,22,,56,1)
	MACHT(MSTIME,23,,57,1)
	MACHT(GETPPN,24,,60,1)
	MACHT(TRPSET,25,,61,1)
	MACHT(TRPJEN,26,,62,1)
	MACHT(RUNTIM,27,,63,1)
	MACHT(PJOB,30,,64,1)
	MACHT(SLEEP,31,,65,1)
	MACHT(SETPOV,32,,66,1)
	MACHT(PEEK,33,,67,1)
	MACHT(GETLIN,34,,70,1)
	MACHT(RUN,35,,71,1)
	MACHT(SETUWP,36,,72,1)
	MACHT(REMAP,37,,73,1)
	MACHT(GETSEG,40,,74,1)
	MACHT(GETTAB,41,,75,1)
	MACHT(SPY,42,,76,1)
	MACHT(SETNAM,43,,77,1)
	MACHT(TMPCOR,44,,100,1)
	MACHT(DSKCHR,45,,101,1)
	MACHT(SYSSTR,46,,102,1)
	MACHT(JOBSTR,47,,103,1)
	MACHT(STRUUO,50,,104,1)
	MACHT(SYSPHY,51,,105,1)
	MACHT(DEVTYP,53,,106,1)
	MACHT(DEVSTS,54,,107,1)
	MACHT(DEVPPN,55,,110,1)
	MACHT(SEEK,56,,111,1)
	MACHT(RTTRP,57,,112,1)
	MACHT(LOCK,60,,113,1)
	MACHT(JOBSTS,61,,114,1)
	MACHT(LOCATE,62,,115,1)
	MACHT(WHERE,63,,116,1)
	MACHT(DEVNAM,64,,117,1)
	MACHT(CTLJOB,65,,120,1)
	MACHT(GOBSTR,66,,121,1)
	MACHT(HPQ,71,,122,1)
	MACHT(HIBER,72,,123,1)
	MACHT(WAKE,73,,124,1)
	MACHT(CHGPPN,74,,125,1)
	MACHT(SETUUO,75,,126,1)
	MACHT(OTHUSR,77,,127,1)
	MACHT(CHKACC,100,,130,1)
	MACHT(DEVSIZ,101,,131,1)
	MACHT(DAEMON,102,,132,1)
	MACHT(JOBPEK,103,,133,1)
	MACHT(ATTACH,104,,134,1)
	MACHT(DAEFIN,105,,135,1)
	MACHT(FRCUUO,106,,136,1)
	MACHT(DEVLNM,107,,137,1)
	MACHT(PATH.,110,,140,1)
	MACHT(METER.,111,,141,1)
	MACHT(MTCHR.,112,,142,1)
	MACHT(JBSET.,113,,143,1)
	MACHT(POKE.,114,,144,1)
	MACHT(TRMNO.,115,,145,1)
	MACHT(TRMOP.,116,,146,1)
	MACHT(RESDV.,117,,147,1)
	MACHT(UNLOK.,120,,150,1)
	MACHT(DISK.,121,,151,1)
	MACHT(DVRST.,122,,152,1)
	MACHT(DVURS.,123,,153,1)
	MACHT(CAL11.,125,,154,1)
	MACHT(MTAID.,126,,155,1)
	MACHT(IONDX.,127,,156,1)
	MACHT(CNECT.,130,,157,1)
	MACHT(MVHDR.,131,,160,1)
	MACHT(ERLST.,132,,161,1)
	MACHT(SENSE.,133,,162,1)
	MACHT(CLRST.,134,,163,1)
	MACHT(PIINI.,135,,164,1)
	MACHT(PISYS.,136,,165,1)
	MACHT(DEBRK.,137,,166,1)
	MACHT(PISAV.,140,,167,1)
	MACHT(PIRST.,141,,170,1)
	MACHT(IPCFR.,142,,171,1)
	MACHT(IPCFS.,143,,172,1)
	MACHT(IPCFQ.,144,,173,1)
	MACHT(PAGE.,145,,174,1)
	MACHT(SUSET.,146,,,1)
	-1			;INDICATE END OF TABLE
	SUBTTL	ERROR ROUTINES

NFLERR:	OUTSTR	[ASCIZ /?FILE NOT OPENED
/]
	JRST	ZAPERR

ILLSYN:	OUTSTR	[ASCIZ /?ILLEGAL SYNTAX
/]
	JRST	ZAPERR

BLCMAC:	OUTSTR	[ASCIZ /%MORE BLOCKS ALLOCATED THAN USED IN FILE
/]
BLCORN:	OUTSTR	[ASCIZ /?BLOCK # OUT OF RANGE
/]
	TLZ	F,FL.BIC	;TOO OPTIMISTIC
	SETZM	CURBLK
	JRST	ZAPERR

CHRERR:	OUTSTR	[ASCIZ /?ILLEGAL CHARACTER
/]
	JRST	ZAPERR

ILLNUM:	OUTSTR	[ASCIZ .?NOT AN OCTAL NUMBER
.]
	JRST	ZAPERR

CMDERR:	OUTSTR	[ASCIZ /?ILLEGAL COMMAND
/]
	JRST	ZAPERR


NFLWRN:	OUTSTR	[ASCIZ /%NO FILE OPEN
/]
	JRST	ZAPCMD

NBKERR:	OUTSTR	[ASCIZ /?NO BLOCK IN CORE
/]
	JRST	ZAPERR

SRCERR:	OUTSTR	[ASCIZ /?NO SEARCH IN PROGRESS
/]
	JRST	ZAPERR


ILNRPL:	OUTSTR	[ASCIZ /?NULL REPLACEMENT ILLEGAL
/]
	SKIPA
ILLRPL:	OUTSTR	[ASCIZ /?SEARCH AND REPLACEMENT VALUES NOT THE SAME SIZE
/]
	TRZ	F,SRCFLG	;TURN OFF SPECIAL SWITCHES
	TLZ	F,FL.SIP!FL.SMP	;NO MORE SEARCH
	JRST	ZAPERR

WPOERR:	OUTSTR	[ASCIZ /?FILE IS WRITE-PROTECTED
/]
	JRST	ZAPERR

LRGERR:	OUTSTR	[ASCIZ /?LOCATION OUT OF RANGE
/]
	JRST	ZAPERR


CRLF:	BYTE	(7) 15,12,0
DBLSP:	BYTE	(7) 40,40,0
;   LOOKUP/ENTER ERROR INFORMATION ROUTINE (WHAT A TITLE!)

ENTERR:	HRRZS	A1,ENTEXT	;IF LOOKUP SUCCEEDED, BUT ENTER
	CAIE	A1,2		;FAILED ON PROTECTION, ALLOW READ-ONLY
	JRST	LKPERR+1
	TLO	F,FL.PRX!FL.PRO	;WRITE-PROTECT LOCKED
	JRST	FLLEPX
LKPERR:	HRRZS	A1,.RBEXT	;LOOKUP DOES NOT FORGIVE
	OUTSTR	[ASCIZ .? (FILE I/O): .]
	OUTSTR	@LENMSG(A1)	;SELECT A MESSAGE
	OUTSTR	[BYTE (7) 15,12,0]
	JRST	ZAPERR

LENMSG:	[ASCIZ /FILE NOT FOUND/]
	[ASCIZ /NO UFD FOR P,PN/]
	[ASCIZ /PROTECTION FAILURE/]
	[ASCIZ /FILE BEING MODIFIED; TRY LATER/]
	[ASCIZ /SYSTEM ERROR P-ERAEF%/]
	[ASCIZ /SYSTEM ERROR P-ERISU%/]
	[ASCIZ /DEVICE OR RIB ERROR/]
	0
	0
	0
	0
	0
	0
	[ASCIZ /QUOTA EXCEEDED/]
	[ASCIZ /STRUCTURE WRITE-LOCKED/]
	[ASCIZ/SYSTEM ERROR S-ERNET%/]
	[ASCIZ /PARTIAL ALLOCATION/]
	[ASCIZ /BLOCK NOT FREE/]
	[ASCIZ /SYSTEM ERROR P-ERCSD%/]
	0
	0
	[ASCIZ /SEARCH LIST EMPTY/]
	0
	0
	0

	XLIST		;HIDE LITERALS
	LIT
	LIST
ENDALL==.		;MARK END OF CORE
	END	ZZZZAP