TITLE	TASTEFUL INIT

A=1
B=2
C=3
D=4
E=5
F=6					; A-F ARE SCRATCH AC'S

FNM=11					; FILE NAME 1 OR 0
RET=12					; JSP AC
RET1=13					; JSP AC
RET2=14					; JSP AC
JCLPTR=15				; BYTE POINTER TO JCL

AP=16					; AND'ING STACK
P=17					; PROCESS STACK

OUTCHN==1				; CURRENT OUTPUT CHANNEL
DSKCHN==2				; PRIMARY DISK CHANNEL
D2CHAN==4				; SECONDARY DISK CHANNEL
TTYI==3
TTYO==1

$STOP=400000				; DON'T CONTINUE THIS LEVEL
$AND=200000				; AND CONSTRUCTION
$OR=100000				; OR CONSTRUCTION
$COND=40000				; COND CONSTRUCTION
$CLAUSE=20000				; ONCE ONLY CLAUSE FLAG
$NOT=10000				; NOT CONSTRUCTION
$REPEAT=4000				; REPEAT CONSTRUCTION
$BIND=2000				; BIND HACK FOR CONDS
$MAPF=1000				; MAPF CONSTRUCTION
$ARG=400				; ARGUMENT ON STACK
$FCN=200				; FUNCTION ON STACK
$MAPARG=100				; LAST ARGUMENT TO MAPF (HACK)
$BLOCK=40				; TOP OF ARGUMENT BLOCK
$NOFRM=$COND+$ARG+$CLAUSE+$NOT+$OR+$AND+$BIND
					; THESE DON'T HACK AGAIN & REPEAT

LOC 40
	0
	JSR	UUOH
	JSR	TSINT
LOC 100


SUBTTL	VARIABLES

IMGFLG:	0				; -1 IF TTY IS IN IMAGE MODE
PRTFLG:	0				; -1 IF FILE IS BEING PRINTED
STRFLS:	0				; -1 IF AN ARGUMENT IS FLUSHED
DSKFLG:	0				; -1 IF CHANNEL OPEN
ENDSW:	0				; -1 IF FILE NAME TERMINATED
LSTOUT:	0				; -1 IF LAST OUT IS FALSE
PAGFLG:	0				; -1 IF IN PAGED MODE
MODFLG:	0				; -1 IS MODIFIER FLAG
RQUOTE:	0				; -1 IF QUOTE SEEN IN READER
PUSHSW:	0				; -1 IF JCL IO PUSH IN EFFECT
IMLAC:	0				; 0 IF IMLAC, -1 ELSE

PRMPT1:	0				; PROMPT FOR READER
FRMCNT:	0				; FRAME COUNTER
AFFIRM:	"Y				; AFFIRMATION CHARACTER
NEGATE:	"N				; NEGATION CHARACTER
FFMAP:	0				; POINTER TO DIR BUFFER
JCLSAV:	0				; SAVED JCL POINTER
JCLPSH:	0				; SAVED JCL POINTER FOR IO PUSH
EXCLHK:	0				; SAVED JCL POINTER FOR ARGUMENT HACKS
CTRLJ:	0				; SAYS OUTPUT CONTRL-J RIGHT
HPOS:	0				; HORIZONTAL POSITION (FOR OHPOS)
UUOD:	0				; UUO
UUOE:	0				; UUO
BASE:	0				; UUO
TTYOPT:	0				; TTYOPT VARIABLE FOR TTY
XCTRUB:	0				; RUBOUT HANDLER
NAMESV:	0				; TEMPORARY FOR CTRL-X AND CTRL-U
NAME:	0				; TEMPORARY FOR FILE NAME PARSER

DEVICE:	0				; BLOCK FOR FILE NAMES
	0
DIRECT:	0
	0
FNAME1:	0
	0
FNAME2:	0
	0

SYSDEV:	SIXBIT /DSK/			; BLOCK FOR SYSTEM DEFAULTS
SYSDIR:	0
SYSFN1:	0
SYSFN2: SIXBIT /MAIL/

APDLLN==400
INPBLN==50
QREGLN==6

INPBUF:	BLOCK	2000			; BUFFER FOR FILE PRINTING
DIRBUF:	BLOCK	200.			; BLOCK FOR FILE NAMES
JCLBUF:	BLOCK	400.			; BUFFER FOR JCL
	0
APDL:	BLOCK	APDLLN			; AND/OR/PROG STACK
GLOTOP:	BLOCK	<26.*QREGLN>		; Q-REGISTERS (FOR HYSTERICAL REASONS)
STRBUF:	BLOCK	INPBLN			; INPUT BUFFER
PDL:	BLOCK	30			; PROCESS STACK
VALBUF:	BLOCK	20			; BLOCK FOR VALRETS


SUBTTL	MACROS

DEFINE DBP X				;DECREMENT BYTE POINTER
	ADD	X,[070000,,0]
	JUMPGE	X,.+3
	SOS	X
	HRLI	X,010700
TERMIN

DEFINE PREDEF NM,VAL
ZZZ==.
LOC GLOTOP+<6*<"NM-101>>
	$FCN,,0
	440700,,[ASCIZ /!VAL!/]
LOC ZZZ
TERMIN

DEFINE COMMAND CHR,LOC
	CHR,,LOC
TERMIN

DEFINE CHOMP LOSSAGE\
	OASCR	[0]
	OASCR	[ASCIZ /!LOSSAGE!/]
	JRST	NERROR
TERMIN

DEFINE ERROR LOSSAGE\
	ERRUUO	[ASCIZ /!LOSSAGE!/]
TERMIN

DEFINE LOSE
	.LOSE	1000
TERMIN

DEFINE FATINS LOSS\
	.VALUE	[ASCIZ /: FATAL ERROR !LOSS! 
/]
TERMIN
	

SUBTTL	MAIN PROGRAM LOOP

START:	MOVE	P,[-30,,PDL-1]
	.BREAK	12,[5,,JCLBUF]
	.SUSET	[.RXUNAM,,A]
	MOVEM	A,SYSFN1
	MOVEM	A,SYSDIR
	MOVE	JCLPTR,[440700,,JCLBUF]	; SET UP JCL BUFFER POINTER
	MOVE	AP,[-APDLLN,,APDL+1]
	MOVEM	JCLPTR,-1(AP)
	PUSHJ	P,TTYOPN

INIT:	JSP	RET,GETCHR		; GET THE NEXT CMD
	 JRST	QUIT			; DONE
	CAIL	B,"a
	 CAILE	B,"z
	  CAIA				; UPPER CASE
	TRZ	B,40
	SUBI	B,FSTCOM		; CREATE TABLE POINTER
	JUMPL	B,NONE			; ILOPR
	CAILE	B,LSTCOM-FSTCOM
	 JRST	NONE			; ILOPR
	HRRZ	B,JCLCOM(B)		; TABLE ENTRY
DISPAT:	PUSHJ	P,(B)			; EXECUTE THE CMD
INLOSE:	 SKIPA	B,LOSINS		; COME HERE IF CMD LOSES
INWIN:	  MOVE	B,WININS		; COME HERE IF CMD WINS
	SETZM	MODFLG			; CLEAR MODIFIER FLAG
	SETOM	LSTOUT			; SET LAST OUT
	CAME	B,LOSINS
	 SETZM	LSTOUT
	MOVE	A,(AP)
	TLNE	A,$CLAUSE		; IS THE FIRST CLAUSE OF A COND?
	 JRST	CLSHAK
	TLNE	A,$NOT			; OR A NOT?
	 JSP	RET1,NOTHAK
	XCT	B			; CONTINUE?
	 JRST	INIT			; YES
INSTOP:	MOVSI	A,$STOP
	IORM	A,(AP)			; SET THE STOP FLAG
	PUSHJ	P,LEVFLS		; FLUSH JCL TO END OF THIS FRAME
	JRST	FINIS			; TERMINATE TASTEFULLY
	
NOTHAK:	MOVSI	C,$STOP+$AND		; SET UP 'AND'  WHICH HAS FAILED
	CAME	B,WININS
	 MOVSI	C,$STOP+$OR		; SET UP 'PROG' WHICH HAS WON (TAA/EBM 9/12)
	HLLM	C,(AP)
	JRST	(RET1)

CLSHAK:	TLZ	A,$CLAUSE		; TURN OFF THE CLAUSE BIT
	MOVEM	A,(AP)			; AND SAVE THIS (NOW A PROG)
	CAME	B,WININS		; DID WE SUCCEED?
	 JRST	INSTOP			; NO. STOP THIS CLAUSE
	MOVSI	A,$STOP			; STOP THE COND, I WANT TO GET OFF
	IORM	A,-6(AP)		; TO STOP THE COND CLAUSE
	JRST	INIT			; WIN. CONTINUE

LOSINS:	TLNN	A,$AND			; INSTRUCTION TO XCT FOR LOSER
WININS:	TLNN	A,$OR			; INSTRUCTION TO XCT FOR WINNER


SUBTTL	CONTROL STRUCTURE

; HERE TO HANDLE OPEN BRACKETS OF ANY KIND
; FRAMES ARE CREATED, AND SPECIAL HACKS ARE PERFORMED
; TO HANDLE SPECIAL CASES (I.E. MAPF, DEFINE, ETC.)

PUSHSP:	MOVSI	C,$BIND
	 CAIA
PUSHIT: SETZ	C,
	POP	P,
	SKIPGE	(AP)
         JRST   [PUSHJ P,LEVFLS
		 JRST FLGCLR]
        MOVE    A,JCLPTR
        ILDB    B,A                     ; DO A NXTCHR
        JSP	RET1,MKFRAM		; MAKE A FRAME FOR THIS
        CAIN	B,"*			; CHECK NEXT CHARACTER AND SET FLAGS
	 MOVSI	C,$REPEAT
	CAIN	B,"!
	 MOVSI	C,$MAPF+$BLOCK
	CAIN    B,"?
         MOVSI  C,$COND
        CAIN	B,"#
	 MOVSI	C,$NOT
	TLNE	C,$BIND
	 JRST	.+3
	CAIN	B,"@
	 JRST	APPLY
	CAIN    B,"&
         MOVSI  C,$AND
        CAIN    B,"\
         MOVSI  C,$OR
        CAIN	B,":
	 MOVSI	C,$FCN
	TLNE	C,$BIND
	 JRST	PUSHT1			; DON'T READ CHARACTER FOR BIND
	SKIPE   C
         ILDB   B,JCLPTR                ; DO A READCHR TO FLUSH IT
PUSHT1:	MOVEM	JCLPTR,-1(AP)		; SAVE JCL POINTER
	MOVE    D,-6(AP)                ; LAST FRAME
        TLNE    D,$COND
         JRST	CNDCHK			; SPECIAL HACK IF LAST WAS COND
	TLNE	C,$FCN
	 JRST	DEFIN			; SPECIAL HACK FOR DEFINE
	TLNE	D,$MAPARG
	 TLO	C,$FCN+$REPEAT		; SPECIAL HACK FOR MAPF'AGE
	TLNE	C,$MAPF
	 JRST	MAPFHK			; SPECIAL HACK FOR MAPF'AGE
PUSHT2:	HLLM	C,(AP)			; MOVE THE SPECIAL BITS
FLGCLR:	SETZM	DSKFLG			; AND CLEAR FLAGS
	.CLOSE	DSKCHN,
	JRST	INIT

; MAKE SURE COND IS GIVEN CORRECT ARGUMENTS

CNDCHK:	JUMPE	C,CNDCK1		; CONDS MUST TAKE PROGS OR BINDS
	TLNN	C,$BIND
	 JRST	CNDERR			; ELSE ERROR
CNDCK1: TLO	C,$CLAUSE		; SET THE CLAUSE BIT
	JRST	PUSHT2			; AND CONTINUE

; HERE TO HACK THE INITIAL CALL TO MAPF
; CREATE ARGUMENT BLOCK ON THE STACK
; AND FIX UP POINTERS TO THE FIRST SET OF ARGUMENTS

MAPFHK:	HLLM	C,(AP)
	PUSH	P,JCLPTR
	JSP	RET,GETCHR		; GET A CHARACTER
	 JRST	UNEXP
	CAIE	B,"(
	 CAIN	B,"[
	  JRST	MPGARG
	JRST	NOARG
MPGARG:	PUSHJ	P,LEVFLS		; CLEAR A PATH TO THE ARGS
	JSP	RET,GETCHR		; GET A CHARACTER
	 JRST	UNEXP
	CAIE	B,"(			; DO WE HAVE AN ARGUMENT?
	 JRST	[MOVSI B,$MAPARG
		 IORM B,(AP)
		 POP P,JCLPTR
		 JRST FLGCLR]		; RETURN
	JSP	RET1,MKFRAM
	MOVEM	JCLPTR,-1(AP)		; SAVE JCL POINTER
	MOVSI	B,$ARG
	HLLM	B,(AP)			; AND BITS
	JRST	MPGARG

; COME HERE TO DEFINE A FUNCTION
; SAVE THE JCL POINTER IN THE CORRECT Q-REGISTER

DEFIN:	JSP	RET1,GETQRG		; GET THE REGISTER
	JUMPL	B,ILLATM
	MOVEM	C,GLOTOP(B)		; SAVE BITS
	MOVEM	JCLPTR,GLOTOP+1(B)	; AND POINTER
	PUSHJ	P,LEVFLS		; FLUSH JCL FOR THIS FRAME
	JRST	FINIS

; COME HERE TO APPLY A FUNCTION
; CREATE THE ARGUMENT FRAMES AND RUN

APPLY:	MOVEM	JCLPTR,-1(AP)
	ILDB	JCLPTR			; FLUSH THE @
	JSP	RET1,GETQRG		; GET A REGISTER
	JUMPL	B,ILLATM		; ILLEGAL REGISTER
	PUSH	P,B
	MOVE	A,GLOTOP(B)		; GET THE TYPE WORD
	TLNN	A,$FCN
	 JRST	NONAPP			; NON FUNCTION?
	MOVSI	C,$BLOCK
	HLLM	C,(AP)			; CALL THIS A BLOCK FRAME
	MOVEM	JCLPTR,-1(AP)		; AND SAVE JCL POINTER
APPLP:	PUSHJ	P,GETARG		; GET THE NEXT ARGUMENT
	 JRST	APPDON
	JSP	RET1,MKFRAM		; AND PUT IT ON THE STACK
	MOVSI	C,$ARG
	HLLM	C,(AP)
	MOVEM	A,-1(AP)
	JRST	APPLP			; KEEP GOING

APPDON:	JSP	RET1,MKFRAM		; NO MORE ARGUMENTS
	POP	P,B
	MOVE	C,GLOTOP+1(B)		; PUT THE FCN ON THE STACK
	MOVEM	C,-1(AP)
	MOVE	JCLPTR,C		; SET JCL POINTER TO HERE
	MOVSI	C,$FCN
	HLLM	C,(AP)			; MAKE THIS A FCN
	JRST	INIT			; AND RUN

; PUSHJ P,GETARG
; RETRIEVE AN ARGUMENT FROM A FUNCTION CALL
; ARGUMENT IS IN A

GETARG:	MOVEM	JCLPTR,JCLSAV		; SAVE JCL POINTER AWAY
	JSP	RET,GETCHR
	 JRST	UNEXP
	CAIE	B,"+
	 CAIN	B,"-
	  JRST	GETRG2
	CAIN	B,""
	 JRST	GETRG1			; ARGUMENTS MUST BE IN QUOTES
	DBP	JCLPTR			; RESTORE THE JCL POINTER
	POPJ	P,

GETRG1:	PUSHJ	P,SKPSTR
GETRG2:	MOVE	A,JCLSAV		; DONE. RESTORE THE JCL POINTER
POPJ1:	AOS	(P)
CPOPJ:	POPJ	P,

; HERE TO HANDLE CLOSED BRACKETS OF ANY KIND
; FLUSH THE FRAME AND RETURN THE CORRECT VALUE

POPIT:	POP	P,
FINIS:	SETZM	DSKFLG			; CLEAR FLAGS
	.CLOSE	DSKCHN,
	POP	AP,A			; RESTORE THE SPECIAL BITS
	TLNE	A,$REPEAT		; MAPFs AND REPEATS END UP WINNING
	 JRST	RAGAIN			; THIS IS REPEAT. HACK SPECIALLY
	TLNE	A,$FCN
	 JRST	POPFCN			; THIS IS FCN. FLUSH TASTEFULLY
	POP	AP,C			; SAVED JCL POINTER
	POP	AP,SYSFN2		; AND FILE DEFAULTS
	POP	AP,SYSFN1
	POP	AP,SYSDIR
	POP	AP,SYSDEV
	MOVE	B,[SKIPGE LSTOUT]	; FOR MOST, RETURN LAST OUT
	TLNE	A,$AND
	 MOVE	B,[JUMPGE A,INWIN]	; FOR AND, CONTINUE IF WINNING
	TLNE	A,$OR
	 MOVE	B,[JUMPL A,INWIN]	; FOR OR, CONTINUE IF LOSING
	XCT	B		
	 JRST	INLOSE			; REPORT LOSSAGE
	JRST	INWIN			; REPORT WINNAGE

; HERE TO FLUSH FUNCTION CALLS

POPFCN:	PUSH	AP,A			; REPUSH THE POPPED BITS
POPFC1:	SUB	AP,[6,,6]		; POP OFF DOWN TO THE $BLOCK
	MOVE	A,(AP)
	TLNN	A,$BLOCK
	 JRST	POPFC1
	MOVE	JCLPTR,-1(AP)		; RESTORE THE JCL POINTER FROM HERE
	PUSHJ	P,LEVFLS		; FLUSH JCL FOR THIS FRAME
	JRST	FINIS			; AND RETURN

; HERE TO AGAIN AFTER A REPEAT IS TERMINATED

RAGAIN:	PUSH	AP,A			; RESAVE
	TLNE	A,$FCN
	 JRST	MAGAIN			; MAPF HACK
	MOVE	JCLPTR,-1(AP)		; RESTORE THE JCL POINTER
	JRST	INIT

; HERE TO RESTART A MAPF AND RESET THE ARGUMENTS

MAGAIN:	PUSH	P,AP			; SAVE STACK POINTER
MAGLP:	SUB	AP,[6,,6]		; WALK UP THE STACK
	MOVE	A,(AP)
	TLNE	A,$BLOCK		; BLOCK MARKS TOP OF ARGUMENTS
	 JRST	MAGDON			; MUST BE DONE
	MOVE	JCLPTR,-1(AP)		; GET THE POINTER
	JSP	RET,GETCHR
	 JRST	UNEXP
	CAIE	B,""			; ARGUMENT HERE?
	 JRST	NOARG			; NO. TERMINATE THE MAPF
	PUSHJ	P,SKPSTR		; SKIP OVER THIS STRING
	MOVEM	JCLPTR,-1(AP)		; AND SAVE THE POINTER
	JSP	RET,GETCHR
	 JRST	UNEXP
	CAIE	B,""			; ARE WE DONE YET?
	 JRST	MFINIS			; YES. FINALLY.
	JRST	MAGLP			; I.E. REST THE 'LIST'

MAGDON:	POP	P,AP			; RESTORE THE STACK
	MOVE	JCLPTR,-1(AP)		; AND JCL POINTER
	JRST	INIT			; AND AGAIN ...

; HERE IF ARGUMENTS ARE EXHAUSTED. RETURN FROM THE MAPF

MFINIS:	SUB	AP,[6,,6]		; FLUSH ALL FRAMES BACK TO BLOCK
	MOVE	A,(AP)
	TLNN	A,$BLOCK		; BLOCK IS REALLY THE MAPF FRAME
	 JRST	MFINIS
	MOVE	JCLPTR,-1(AP)		; GET BACK JCL POINTER
	PUSHJ	P,LEVFLS		; FLUSH THE MAPF
	JRST	FINIS

; HERE TO AGAIN/RETURN
; C HAS THE CHARACTER > OR < WHICH DECIDES WHAT TO DO

AGAIN:	JSP	RET1,GETQRG
	JUMPGE	B,AGNACT
AGAIN1:	MOVE	A,(AP)			; GET LAST SPECIAL BIT WORD
	TLNE	A,$NOFRM
	 JRST	[SUB AP,[6,,6]
		 JUMPGE AP,NOTPRG
		 JRST AGAIN1]
	MOVE	JCLPTR,-1(AP)		; RESTORE JCL POINTER
	MOVSI	A,-5(AP)		; RESTORE FILE DEFAULTS
	HRRI	A,SYSDEV
	MOVE	D,A
	BLT	D,3(A)	
	POP	P,
	CAIE	C,">			; WHAT FORM OF OBSCENITY?
	 JRST	INIT
GOAWAY:	SUB	AP,[2,,2]
	POP	AP,SYSFN2		; AND FILE
	POP	AP,SYSFN1
	POP	AP,SYSDIR
	POP	AP,SYSDEV
	PUSHJ	P,LEVFLS
	JRST	FLGCLR

AGNACT:	CHOMP	UNIMPLEMENTED FEATURE


SUBTTL	CONTROL STRUCTURE UTILITY ROUTINES

; PUSHJ P,SKPSTR
; TO SKIP OVER A STRING

SKPSTR:	ILDB	A,JCLPTR		; SKIP PAST THE ARGUMENT
	CAIN	A,^Q
	JRST	[ILDB A,JCLPTR
		 JRST SKPSTR]
	CAIE	A,""
	 JRST	SKPSTR
	POPJ	P,

; JSP RET2,ARGH
; HERE TO REQUEST AN ARGUMENT. CHECKS WHETHER THE ARGUMENT
; IS SYMBOLIC AND IF SO, GETS HOLD OF IT

ARGH:	JSP	RET,GETCHR		; GET A CHARACTER
	 JRST	UNEXP
	SETZM	EXCLHK			; CLEAR THE EXCL FLAG
	CAIN	B,73			; HANDLE OPTIONALS
	 JRST	[SETOM MODFLG
		 ILDB B,JCLPTR
		 JRST .+1]
	CAIN	B,"!
	 JSP	RET1,EXCLER		; GET THE ARGUMENT
	CAIN	B,"=
	 PUSHJ	P,INPUSH
	POPJ	P,

; PUSHJ P,INPUSH
; HERE TO DO AN INPUSH

INPUSH:	JSP	RET1,GETQRG
	MOVEM	JCLPTR,EXCLHK
	MOVE	JCLPTR,GLOTOP(B)
	JSP	RET,GETCHR
	 JRST	UNEXP
	POPJ	P,

; HERE FOR OCCURANCES OF ! AT TOP LEVEL
; THESE MUST BE NON-STRING ARGUMENTS (T OR FALSE)

EXCLCM:	JSP	RET1,EXCLER
	CAME	JCLPTR,[-1]
	 AOS	(P)
	MOVE	JCLPTR,EXCLHK
	POPJ	P,

; JSP RET1,EXCLER
; GET A SYMBOLIC ARGUMENT

EXCLER:	ILDB	C,JCLPTR		; READ THE SYMBOLIC ARGUMENT
	CAIGE	C,"9
	 CAIGE	C,"0
	  JRST	UNBOUND			; BETTER BE 0-9
	MOVEM	JCLPTR,EXCLHK		; SAVE REAL POINTER
	PUSH	P,AP			; SAVE STACK POINTER
EXCLLP:	SUB	AP,[6,,6]		; MARCH DOWN STACK
	MOVE	A,(AP)			; LOOKING FOR A $BLOCK
	TLNN	A,$BLOCK
	 JRST	EXCLLP
	SUBI	C,"0	
	JUMPE	C,UNBOUND		; MUST BE 1-9, REALLY
	SETZ	D,
EXLLP2:	ADDI	D,1			; D IS COUNTER OF ARGUMENTS
	ADD	AP,[6,,6]		; LOOK FOR CORRECT ARGUMENT NUMBER
	MOVE	A,(AP)
	TLNN	A,$ARG
	 JRST	EXCLR2			; END OF ARGUMENTS. LOST?
	CAME	C,D
	 JRST	EXLLP2
	JSP	RET,GETCHR		; GET THE NEXT CHARACTER
	 JRST	UNEXP
	CAIN	B,""			; IS IT A STRING?
	 JRST	[PUSHJ P,SKPSTR		; YES. THIS IS OPTIONAL ARGUMENT
		 MOVEM JCLPTR,EXCLHK	; FLUSH THE STRING AND SAVE NEW POINTER
		 JRST .+1]	
	CAIE	B,"+			; FLUSH THE DEFAULT IF GIVEN
	 CAIN	B,"-
	  IBP	EXCLHK
	MOVE	JCLPTR,-1(AP)		; FOUND THE ARGUMENT. POINT TO IT
	JSP	RET,GETCHR
	 JRST	UNEXP
	CAIN	B,"+
	 JRST	EXCLR3
	CAIN	B,"-
	 JRST	EXCLF1
	POP	P,AP			; RESTORE THE STACK
	JRST	(RET1)			; AND RETURN POINTING CORRECTLY

EXCLR2:	SKIPN	MODFLG			; DEFAULT ARGUMENT SUPPLIED?
	 JRST	UNBOUND			; NO. CHOMPER.
	JSP	RET,GETCHR		; NEXT CHARACTER BETTER BE QUOTE!
	 JRST	UNEXP
	MOVEM	JCLPTR,EXCLHK
	CAIN	B,"+
	 JRST	EXCLR3
	CAIN	B,"-
	 JRST	EXCLF1
	SETZM	EXCLHK			; NOT HACKED
EXCLR3:	POP	P,AP			; RESTORE STACK
	JRST	(RET1)			; FINGERS CROSSED

EXCLF1:	SETOM	JCLPTR
	JRST	EXCLR3

; CREATE AN EMPTY FRAME AND PUT IT ON THE STACK

MKFRAM:	PUSH	AP,SYSDEV		; DEVICE
	PUSH	AP,SYSDIR		; SNAME
	PUSH	AP,SYSFN1		; FILE NAME 1
	PUSH	AP,SYSFN2		; FILE NAME 2
	PUSH	AP,[0]			; SLOT FOR JCL POINTER
	AOS	RET2,FRMCNT		; UNIQUE FRAME COUNTER
	PUSH	AP,RET2			; MAKE A FRAME
	JRST	(RET1)

; COME HERE TO FLUSH ALL BETWEEN MATCHED SQUARE BRACKETS
; THIS IS USED TO SKIP AN ENTIRE CONSTRUCTION

LEVFLS:	SETZ	A,
LEVFL1:	ILDB	B,JCLPTR
	JUMPE	B,CPOPJ
	CAIN	B,^Q			; ALLOW FOR QUOTING
	 ILDB	B,JCLPTR
	CAIE	B,"(
	 CAIN	B,"[
	  AOJ	A,
	CAIE	B,"]
	 CAIN	B,")
	  JRST	[SOJGE A,LEVFL1
		 JRST CPOPJ]
	JRST	LEVFL1
	
; GET THE NEXT CHARACTER AND TURN IT INTO A Q-REGISTER POINTER
; FATAL IF ILLEGAL NAME (ILLEGAL ATOM)

GETQRG:	ILDB	B,JCLPTR		; GET THE CHAR
	CAIE	B,">			; SPECIAL HACK FOR > AND <
	 CAIN	B,"<			; IS RETURN AND AGAIN
	  JRST	[MOVE C,B
		 SETO B,		; RETURN -1 FOR THESE
		 JRST (RET1)]
	TRZ	B,40
	SUBI	B,"A
	JUMPL	B,ILLATM
	CAILE	B,26.
	 JRST	ILLATM
	IMULI	B,QREGLN		; RETURN POINTER TO Q-REGISTER
	JRST	(RET1)


SUBTTL	COMMANDS

FSTCOM="!
JCLCOM:	COMMAND "!,EXCLCM
	COMMAND "",NONE
	COMMAND "#,NONE
	COMMAND "$,NONE
	COMMAND "%,YNSET		; SET THE YES/NO DEFAULT
	COMMAND "&,NONE			; RESERVED FOR [&
	COMMAND "',NONE
	COMMAND "(,PUSHSP		; BIND PARENS
	COMMAND "),POPIT		; BIND PARENS
	COMMAND "*,NONE			; REPEAT CONSTRUCTION
	COMMAND "+,POPJ1		; RETURN T IMMEDIATE
	COMMAND "!,NONE			; DONT USE THIS ONE
	COMMAND "-,CPOPJ		; RETURN FALSE IMMEDIATE
	COMMAND ".,NONE			; SET A TAG
	COMMAND "/,NONE
	COMMAND "0,NONE			; SYMBOLIC ARG
	COMMAND "1,NONE			; SYMBOLIC ARG
	COMMAND "2,NONE			; SYMBOLIC ARG
	COMMAND "3,NONE			; SYMBOLIC ARG
	COMMAND "4,NONE			; SYMBOLIC ARG
	COMMAND "5,NONE			; SYMBOLIC ARG
	COMMAND "6,NONE			; SYMBOLIC ARG
	COMMAND "7,NONE			; SYMBOLIC ARG
	COMMAND "8,NONE			; SYMBOLIC ARG
	COMMAND "9,NONE			; SYMBOLIC ARG
	COMMAND ":,SETG			; SET A Q-REGISTER
	COMMAND 73,MODIFY		; MODIFICATION
	COMMAND "<,NONE			; WITH @<
	COMMAND "=,GVAL			; READ A Q-REGISTER
	COMMAND ">,NONE			; WITH @>
	COMMAND "?,NONE			; COND CONSTRUCTION
	COMMAND "@,AGAIN		; GO SOMEWHERE
	COMMAND	"A,APPEND		; APPEND "FILE1,FILE2"
	COMMAND "B,READER		; CHECK READER FILES
	COMMAND "C,COPY			; COPY "FILE1,FILE2"
	COMMAND	"D,DELETE		; DELETE "FILE"
	COMMAND	"E,EXIST		; EXIST "FILE"
	COMMAND	"F,DEFAUL		; SET DDT DEFAULTS
	COMMAND "G,CNSCHK		; CONSOLE PRGM "XXX"?
	COMMAND "H,HSTYQ		; T IF ON STY
	COMMAND "I,IMAGE		; PRINT "FILE" IN IMAGE MODE
	COMMAND "J,NLOUT		; LIKE O, BUT NEW LINE FIRST
	COMMAND "K,CLRSCR		; CLEAR SCREEN
	COMMAND	"L,CRLF			; CR
	COMMAND "M,MAKFIL		; MAKE "FILE"
	COMMAND "N,FNAME		; FILE NAME OF "FILE"
	COMMAND	"O,OUTPUT		; OUTPUT "STRING"
	COMMAND	"P,PRINT		; PRINT "FILE"
	COMMAND	"Q,ASKME		; ASK "STRING"
	COMMAND	"R,RENAME		; RENAME "FILE1,FILE2"
	COMMAND "S,SSVMOD		; SSVMOD "STRING"
	COMMAND "T,TPL			; TPL "FILE"
	COMMAND "U,USER			; PRINT MY USER NAME
	COMMAND "V,VALRET		; VALRET "STRING"
	COMMAND	"W,CDATE		; WHEN? "FILE"
	COMMAND "X,READCH		; READ CHARACTER FROM TTY
	COMMAND "Y,READST		; READSTRING FROM TTY
	COMMAND "Z,EQSTR		; EQUALSTRING
	COMMAND	"[,PUSHIT		; OPEN BRACKET
	COMMAND	"\,NONE			; DO NOT USE
	COMMAND	"],POPIT		; CLOSE BRACKET

LSTCOM="]


SUBTTL	USER COMMANDS

; H COMMAND:  WIN IF ON STY
HSTYQ:	.CALL	[SETZ
		 SIXBIT	/CNSGET/
		 MOVEI	TTYI
		 MOVEM	A
		 MOVEM	A
		 MOVEM	B		; TCTYP
		 MOVEM	A
		 MOVEM	A
		 SETZM	A]		; TTYTYP VARIABLE
	 .LOSE	%LSSYS
	CAIN	B,%TNSFW		; SKIP IF NOT SOFTWARE (-->SUPDUP OR LOCAL)
	 POPJ	P,
	TRNN	A,%TYSTY		; SKIP IF ON STY
	 POPJ	P,
	JRST	POPJ1

; U COMMAND
; PRINT XUNAME

USER:	.SUSET	[.RXUNAM,,A]
	OSIX	A
	JRST	POPJ1

; K COMMAND
; CLEAR THE SCREEN

CLRSCR:	OCTLP	"C
	JRST	POPJ1

; L COMMAND
; CRLF TO THE TTY

CRLF:	OASCR	[0]
	JRST	POPJ1

; F COMMAND
; SET THE DDT FILE NAME DEFAULTS

DEFAUL:	JSP	RET2,FSTARN
	MOVE	A,DEVICE
	MOVE	B,DIRECT
	MOVE	C,FNAME1
	MOVE	D,FNAME2
	.BREAK	12,[..SPFILE,,A]
	JRST	POPJ1

; V COMMAND
; VALRET TO DDT

VALRET:	MOVE	F,[440700,,VALBUF]
;; MODFIED V COMMAND STUFF BY EBM, 7/23/77
	SKIPE	MODFLG
	 JRST	VALRT1
	MOVEI	A,^W
	IDPB	A,F
VALRT1:	JSP	RET,GETCHR
	 JRST	UNEXP
	CAIE	B,""
	 JRST	NOARG
VALLP:	ILDB	A,JCLPTR
	CAIN	A,^Q
	 JRST	[ILDB A,JCLPTR
		 JRST VALOUT]
	CAIN	A,"^
	 JRST	[ILDB A,JCLPTR
		 TRZ A,140
		 JRST VALOUT]
	CAIN	A,""
	 JRST	VALGO
VALOUT:	IDPB	A,F
	JRST	VALLP

VALGO:	SKIPE	MODFLG
	 JRST	[MOVE	A,[440700,,[ASCIZ /
P/]]
		 JRST	VALADD]
	MOVE	A,[440700,,[ASCIZ /
:VP
/]]
VALADD:	ILDB	B,A
	IDPB	B,F
	JUMPN	B,VALADD
	.VALUE	VALBUF
	JRST	POPJ1

; : COMMAND
; HANDLE SETG'ING Q-REGISTERS

SETG:	JSP	RET1,GETQRG		; GET A Q-REGISTER
	MOVE	A,LSTOUT
	MOVEM	A,GLOTOP(B)		; STORE LAST-OUT
	SETZM	GLOTOP+1(B)		; CLEAR JCL POINTER WORD
	JRST	HKEXIT

; = COMMAND
; HANDLE GVAL'ING Q-REGISTERS

GVAL:	JSP	RET1,GETQRG		; GET THE Q-REGISTER
	SKIPL	GLOTOP(B)		; IS IT FALSE
	 AOS	(P)			; YES. RETURN T
	POPJ	P,			; RETURN <>

; J COMMAND
; GO TO THE NEXT LINE ON THE TTY

NLOUT:	JSP	RET1,NEWLIN
	JRST	POPJ1

NEWLIN:	;;;SKIPE	IMLAC
	 ;;;JRST	[OASCR [0]		; PRINT CRLF IF NOT IMLAC
		 ;;;JRST (RET1)]			(CHOMP, CHOMP)
	.IOT	TTYO,[^P]		; DO NEW LINE
	.IOT	TTYO,["A]
	JRST	(RET1)

; O COMMAND
; PRINT THE FOLLOWING CRUFT TO THE TTY

OUTPUT:	PUSHJ	P,ARGH
	SKIPE	MODFLG			; NEW LINE IF MODIFIED
	 JSP	RET1,NEWLIN
OUTLP:	ILDB	A,JCLPTR
	CAIN	A,^Q
	 JRST	[ILDB A,JCLPTR
		 JRST OUTOUT]
	JUMPE	A,UNEXP
	CAIN	A,"^
	 JRST	[ILDB A,JCLPTR
		 TRZ A,140
		 JRST OUTOUT]
	CAIN	A,""
	 JRST	[SKIPE EXCLHK
		  MOVE JCLPTR,EXCLHK
		 JRST POPJ1]
OUTOUT:	 .IOT	TTYO,A
	AOS	HPOS
	JRST	OUTLP

; EQUALSTRING COMMAND
; SKIP RETURN IF STRING IN Q-REG EQUALS STRING ARGUMENT

EQSTR:	JSP	RET1,GETQRG
	JUMPL	B,ILLATM
	MOVE	A,GLOTOP(B)			; BYTE POINTER TO STRING
	JSP	RET,GETCHR
	 JRST	UNEXP
	CAIE	B,""
	 JRST	NOARG
EQLOOP:	ILDB	C,JCLPTR			; NEXT CHARACTER
	ILDB	D,A
	CAIN	C,""
	 JRST	EQUAL1
	CAME	C,D
	 JRST	EQFLS
	JRST	EQLOOP

EQUAL1:	JUMPN	D,.+2
	AOS	(P)
	POPJ	P,

EQFLS:	ILDB	C,JCLPTR
	CAIE	C,""
	 JRST	EQFLS
	POPJ	P,

; READCH COMMAND
; READ CHARACTER FROM TTY AND PUT IT IN Q-REG

READCH:	JSP	RET1,GETQRG
	JUMPL	B,ILLATM
	PUSH	P,B
	MOVEM	JCLPTR,JCLSAV
	MOVEI	F,.
	MOVE	JCLPTR,JCLSAV
	PUSHJ	P,OUTPUT
	 JFCL
	.RESET	TTYI,
	.IOT	TTYI,D
	POP	P,B
	MOVE	A,[440700,,STRBUF]
	MOVEM	A,GLOTOP(B)
	SETZM	STRBUF
	IDPB	D,A
	JRST	POPJ1

; READSTRING COMMAND
; READ INPUT FROM TTY AND PUT THE POINTER IN Q-REG

READST:	JSP	RET1,GETQRG		; GET Q-REGISTER
	PUSH	P,B			; SAVE POINTERS
	MOVEM	JCLPTR,JCLSAV		; SAVE JCL POINTER
	MOVEI	F,.			; MAKE ACTIVATION
	MOVE	JCLPTR,JCLSAV
	PUSHJ	P,OUTPUT		; OUTPUT PROMPT
	 JFCL				; HUH
	PUSHJ	P,GETLIN		; READ A LINE
	POP	P,B
	JUMPE	C,CPOPJ
	MOVE	A,[440700,,STRBUF]
	MOVEM	A,GLOTOP(B)		; SAVE BUFFER POINTER
	JRST	POPJ1

; Q COMMAND
; ASK THE FOLLOWING QUESTION AND WIN

ASKME:	MOVEM	JCLPTR,JCLSAV
	MOVEI	F,.
	MOVE	JCLPTR,JCLSAV
	PUSHJ	P,OUTPUT
	 POPJ	P,
	PUSHJ	P,YESNO
	 POPJ	P,
	JRST	POPJ1

; MODIFY COMMAND
; TURN ON MODIFY BIT

MODIFY:	SETOM	MODFLG
	JRST	HKEXIT

; % SWITCH
; COMPLEMENT (Y/N)/(SPACE/RUBOUT) "SWITCH" FOR QUESTION ANSWERS

YNSET:	MOVEI	A,40	; SEE IF WAS SPACE/RUBOUT
	CAME	A,AFFIRM
	 JRST	[MOVEM	A,AFFIRM	; IF NOT, SET TO SPACE/RUBOUT
		 MOVEI	A,177
		 MOVEM	A,NEGATE
		 JRST	HKEXIT]
	MOVEI	A,"Y		; IF WAS, SET TO Y/N
	MOVEM	A,AFFIRM
	MOVEI	A,"N
	MOVEM	A,NEGATE
HKEXIT:	POP	P,
	JRST	INIT

; E COMMAND
; TELL IF A FILE EXISTS OR NOT

EXIST:	SKIPN	MODFLG
	 JRST	EXIST1
	JSP	RET2,FSTARH	; TEST WITH BIT 1.5 (DON'T CHASE LINKS) SET
	JRST	POPJ1

EXIST1:	JSP	RET2,FSTARI
	JRST	POPJ1

; M COMMAND
; MAKE A FILE

MAKFIL:	SETZM	DSKFLG
	JSP	RET2,FSTARO
	.CALL	SDMPBT
	 LOSE
	JRST	POPJ1

SDMPBT:	SETZ
	SIXBIT /SDMPBT/
	MOVEI DSKCHN
	SETZI 1

; N COMMAND
; PRINT THE REAL FILE NAME OF A FILE

FNAME:	JSP	RET2,FSTARI
	.CALL	RCHST
	 LOSE				; NO EXCUSE FOR THIS
	SETZ	FNM,
	PUSHJ	P,PFNAME
	JRST	POPJ1

RCHST:	SETZ
	SIXBIT /RCHST/
	MOVEI DSKCHN
	MOVEM DEVICE(FNM)
	MOVEM FNAME1(FNM)
	MOVEM FNAME2(FNM)
	SETZM DIRECT(FNM)

; D COMMAND
; DELETES A FILE

DELETE:	JSP RET2,FSTARI			; GET THE FILE
	 JFCL
	.CLOSE	DSKCHN,
	.CALL	DELBLK
	 POPJ	P,			; FILE DIDN'T EXIST OR SOMETHING
	JRST	POPJ1

DELBLK:	SETZ
	SIXBIT /DELETE/
	DEVICE
	FNAME1
	FNAME2
	SETZ DIRECT

; R COMMAND
; RENAMES A FILE

RENAME:	JSP	RET2,FSTARI
	.CLOSE	DSKCHN,
	.CALL	RNMBLK
	 POPJ	P,
	JRST	POPJ1
	
RNMBLK:	SETZ
	SIXBIT /RENAME/
	DEVICE
	FNAME1
	FNAME2
	DIRECT
	FNAME1+1
	SETZ FNAME2+1

; A COMMAND
; APPEND A FILE TO ANOTHER FILE

APPEND:	JSP	RET2,FSTARI
	MOVEI	.BII
	.CALL	D2OPEN			; OPEN THE FILE FOR READING
	 JRST	[MOVEI .BIO		; DOESN'T EXIST. OPEN FOR WRITING
		 .CALL D2OPEN
		  ERROR CAN'T OPEN APPEND FILE
		 JRST APPND2]
	.CALL	FILLEN			; GET THE FILE LENGTH
	 ERROR	CAN'T GET FILE LENGTH
	PUSH	P,C
	JUMPE	C,APPND1
	SUBI	C,2			; SUB OFF TWO WORDS??
	MOVEM	C,(P)
	.ACCESS	D2CHAN,C		; AND GO THERE
	MOVE	D,[-2,,A]
	.IOT	D2CHAN,D		; READ IN THE WORDS INTO A AND B
	MOVE	D,[440700,,A]		; GET A BP TO THESE
	MOVEI	C,10.
	ILDB	E,D			; NOW CHECK FOR ^C OR ^@
	CAILE	E,^C
	 SOJG	C,.-2
	JUMPE	C,APPND1		; IF HERE, NO PADDING AT ALL
	MOVEI	E,40			; PAD NULLS WITH SPACES
	DPB	E,D
	IBP	D
	SOJG	C,.-2
APPND1:	.CLOSE	D2CHAN,			; CLOSE THE OUTPUT FILE
	MOVEI	100000+.BIO
	.CALL	D2OPEN			; OPEN IT IN WRITE-OVER MODE
	 ERROR	CAN'T OPEN APPEND FILE
APPN1A:	POP	P,C			; RESTORE THE CORRECT ACCESS
	JUMPE	C,APPND2
	.ACCESS	D2CHAN,C		; GO THERE
	MOVE	C,[-2,,A]	
	.IOT	D2CHAN,C		; OUTPUT FIXED UP LAST WORDS
APPND2:	MOVE	A,[-2000,,INPBUF]
	.IOT	DSKCHN,A		; READ IN A BLOCK
	JUMPGE	A,APPND3
	HLRE	A,A
	ADDI	A,2000			; GET WORDS TRANSFERRED
	MOVNS	A
	HRLS	A			; INTO LEFT HALF
	HRRI	A,INPBUF
	.IOT	D2CHAN,A
	.CLOSE	D2CHAN,
	JRST	POPJ1

APPND3: MOVE	A,[-2000,,INPBUF]	; BLAT IT OUT
	.IOT	D2CHAN,A
	JRST	APPND2			; AND AGAIN
	
D2OPEN:	SETZ
	SIXBIT /OPEN/
	MOVS
	MOVEI D2CHAN
	DEVICE+1
	FNAME1+1
	FNAME2+1
	SETZ DIRECT+1

FILLEN:	SETZ
	SIXBIT /FILLEN/
	MOVEI D2CHAN
	SETZM C

; C COMMAND
; COPY A FILE

COPY:	JSP	RET2,FSTARI
	MOVEI	.BIO
	.CALL	D2OPEN
	 ERROR	CAN'T OPEN COPY FILE
	JRST	APPND2

; T COMMAND
; TPL A FILE

TPL:	JSP	RET2,FSTARI
	.CALL	TPLOPN
	 ERROR	CAN'T OPEN TPL FILE
	JRST	APPND2

TPLOPN:	SETZ
	SIXBIT /OPEN/
	MOVSI .BIO
	MOVEI D2CHAN
	SETZ [SIXBIT /TPL/]

; I COMMAND
; PRINT A FILE (IN IMAGE MODE)

IMAGE:	JSP	RET2,FSTARI
	SKIPE	IMLAC
	 POPJ	P,
	.OPEN	TTYO,[SIXBIT /  ETTY/]	; OPEN THE TTY IN IMAGE MODE
	 ERROR	CAN'T OPEN TTY IN IMAGE MODE
	SETOM	IMGFLG
	PUSHJ	P,FILPRT		; PRINT THE FILE
	SETZM	IMGFLG
	.CALL	TTYRST			; REOPEN THE TTY NORMALLY
	 ERROR	CAN'T OPEN OUTPUT TTY
	OCTLP	"C
	JRST	POPJ1

SCPOS:	SETZ
	SIXBIT /SCPOS/
	MOVEI TTYO
	[0]
	SETZ [0]

; HERE TO PRINT A FILE
; PGFLAG SAYS WHETHER WE ARE IN PAGED MODE

FILPRT:	OASCR	[0]
	SKIPE	PAGFLG
	 OCTLP	"C
FILPR1:	MOVE	A,[-2000,,INPBUF]
	SETOM	PRTFLG
	.IOT	DSKCHN,A
	MOVEI	C,<5*2000>
	JUMPGE	A,PROUT
	.CLOSE	DSKCHN,
	SETZM	(A)
	HRRZ	D,A
	SUBI	D,INPBUF
	IMULI	D,5		; max in this buffer
	MOVEI	B,-2(A)
	CAIGE	B,INPBUF-1
	 MOVEI	B,INPBUF	; beginning of buffer
	MOVE	C,B
	SUBI	C,INPBUF
	IMULI	C,5
	HRLI	B,440700
PRCTRL:	SKIPE	IMGFLG
	 JRST	PRIMG
	ILDB	0,B
	CAIE	0,^C
	 CAIN	0,^L
	  SKIPA
	JUMPN	0,PRAOS
	JRST	PROUT
PRAOS:	CAME	C,D
	 AOJA	C,PRCTRL

PROUT:	MOVE	E,C
	MOVE	B,[440700,,INPBUF]
	SKIPE	PAGFLG
	 JRST	PAGPRT
	.CALL	[SETZ
		 SIXBIT /SIOT/
		 MOVSI %TJDIS
		 MOVEI TTYO
		 B
		 SETZ E]
	 JRST	PREXIT
PROUT1:	JUMPGE	A,FILPR1
	JRST	PREXIT

PRIMG:	SETZ	E,
PRIMG1:	CAMN	C,D
	JRST [	JUMPE	E,PROUT
		SUB	C,E
		JRST	PROUT]
	ILDB	0,B
	CAIN	0,^C
	 AOJA	E,PRIMG2
	SETZ	E,
PRIMG2:	AOJA	C,PRIMG1

PRFLXT:	OASCR	[0]
PREXIT:	.CLOSE	DSKCHN,
	SETZM	PRTFLG
	OASCR	[0]
	POPJ	P,

; HERE TO PRINT A FILE IN PAGED MODE

PAGPRT:	ILDB	C,B
	CAMN	B,[10700,,INPBUF+1777]
	 PUSHJ	P,PROUT2
	CAIE	C,0
	 CAIN	C,^C
	  JRST	PREXIT
	CAIE	C,^L
	 CAIN	C,^_
	  JRST	PAGPR1
	.CALL	[SETZ ? SIXBIT /IOT/ ? MOVSI %TJDIS ? MOVEI TTYO ? SETZ C]
	 JRST	PREXIT
	JRST	PAGPRT
PAGPR1:	ILDB	C,B
	CAMN	B,[10700,,INPBUF+1777]
	 PUSHJ	P,PROUT2
	CAIE	C,0
	 CAIN	C,^C
	  JRST	PREXIT
	CAIE	C,^M
	 CAIN	C,^J
	  JRST	PAGPR1
	CAIN	C," 
	  JRST	PAGPR1
	PUSHJ P,MORAGE
	 JRST PREXIT
	OCTLP "T
	OCTLP "L
	JRST PAGPRT+1
PROUT2:	JUMPGE	A,FILPR2
	POP	P,A
	JRST	PREXIT
FILPR2:	MOVE	A,[-2000,,INPBUF]
	SETOM	PRTFLG
	.IOT	DSKCHN,A
	MOVE	B,[440700,,INPBUF]
	CAIL	A,
	 POPJ	P,
	.CLOSE	DSKCHN,
	SETZM	(A)
	POPJ	P,

; P COMMAND
; PRINT A FILE (IN NORMAL MODE)

PRINT:	SETZM	PAGFLG
	SKIPE	MODFLG
	 SETOM	PAGFLG			; MODIFIER ==> PAGE MODE
	JSP	RET2,FSTARI
	PUSHJ	P,FILPRT
	JRST	POPJ1

; B COMMAND
; INTERPRET READER OUTPUT FILE
;      AC -> VALUE
;	A -> POINTER TO BUFFER
;	B -> CHARACTER
;	C -> NUMBER OF INBOX MESSAGES
;	D -> NUMBER OF OUTBOX MESSAGES
;	E -> CURRENT MESSAGE NUMBER
;	F -> LAST MESSAGE NUMBER

READER:	JSP	RET2,FSTARI
	MOVE	A,[-2000,,INPBUF]
	.IOT	DSKCHN,A
	.CLOSE	DSKCHN,
	SETZM	(A)
	SETZB	C,D
	SETZ	F,
	MOVE	A,[440700,,INPBUF]
	OCTLP	"A
RDLP:	ILDB	B,A
	CAIE	B,3
	 CAIN	B,0
	  JRST	RDEOF
	CAIE	B,^I
	 CAIN	B,^J
	  JRST	RDLP
	CAIE	B,^M
	 CAIN	B,40
	  JRST	RDLP
	CAIN	B,"-
	 JRST	[SETZ E,
	         AOJA D,RDNXT]
	CAIG	B,"9
	 CAIGE	B,"0
	  JRST	RDCHMP
	SETZ	E,
	AOJA	C,RDNXT0

RDNXT:	ILDB	B,A
	CAIG	B,"9
	 CAIGE	B,"0
	  JRST	RDNXT1
RDNXT0:	IMULI	E,10.
	ADDI	E,-"0(B)
	JRST	RDNXT

RDNXT1:	CAIE	B,3
	 CAIN	B,0
	  JRST	RDEOF
	CAIE	B,^J
	 JRST	RDNXT
	CAMN	E,F
	 SUBI	D,1
	MOVE	F,E
	JRST	RDLP

RDEOF:	OASC	[ASCIZ /You have /]
	JUMPE	C,RDOUT
	ODEC	C
	OASC	[ASCIZ / new message/]
	CAIE	C,1
	 OASCI	"s
	JUMPE	D,RDEOF1
	OASC	[ASCIZ / and /]
RDOUT:	ODEC	D
	OASC	[ASCIZ / outbox message/]
	CAIE	D,1
	 OASCI	"s
RDEOF1:	OASC	[ASCIZ /./]
	JRST	POPJ1

RDCHMP:	OASC	[ASCIZ /READER file in bad format?/]
	POPJ	P,

; W COMMAND
; PRINT THE CREATION DATE OF A FILE

CDATE:	JSP	RET2,FSTARI
	.CALL	RFDATE
	 ERROR	CAN'T READ CREATION DATE
	PUSHJ	P,PRDATE
	OASCR	[0]
	JRST	POPJ1

RFDATE:	SETZ
	SIXBIT	/RFDATE/
	MOVEI	DSKCHN
	SETZM	A

; G COMMAND
; GET CONSOLE PROGRAM TYPE AND CHECK AGAINST ARG

CNSCHK:	JSP	RET,GETCHR
	 JRST	UNEXP
	CAIE	B,""
	 JRST	NOARG
	SKIPE	IMLAC
	 JRST	SKPSTR	; snarf rest of useless command
	.OPEN	TTYO,[SIXBIT /  ETTY/]
	 ERROR	CAN'T OPEN TTY IN IMAGE MODE
; here snarf arg, usually "SSV" or "SST"
	MOVE	B,[440700,,C]
	SETZB	C,D
CNSLUP:	ILDB	A,JCLPTR
	CAIN	A,""
	 JRST	CNSLPX
	CAIL	A,"0
	 CAILE	A,"9
	  SKIPA
	   JRST	CNSNUM
	IDPB	A,B
;; CHANGED CAIE TO TLNE
	TLNE	B,760000
	 JRST	CNSLUP
	ILDB	A,JCLPTR
	CAIE	A,""
	 JRST	.-2
	JRST	CNSLPX
; here for version number if given
CNSNLP:	ILDB	A,JCLPTR
	CAIL	A,"0
	CAILE	A,"9
	 JRST	CNSLPX
	CAIN	A,""
	 JRST	CNSLPX
CNSNUM:	IMULI	D,10.
	ADDI	D,-60(A)
	JRST	CNSNLP
; ask console program who he his
CNSLPX:	.RESET	TTYI,		; flush any random chars hanging around
	.IOT	TTYO,[^A]
	.IOT	TTYO,[^M]
	.IOT	TTYI,A		; reply char 1
	.IOT	TTYI,B		; reply char 2
	SETZ	E,
	CAME	C,[ASCIZ "SSV"]
	 JRST	.+3
	TRNN	B,1_4		; pxmit bit distinguishes
	 SETO	E,
	CAME	C,[ASCIZ "STV"]
	 JRST	.+3
	TRNE	B,1_2
	 MOVNI	E,1
	CAME	C,[ASCIZ "SST"]
	 JRST	.+3
	TRNE	B,1_4
	 SETO	E,
	CAME	C,[ASCIZ "MSE"]
	 JRST	.+3
	TRNE	B,1_5
	 SETO	E,
	CAME	C,[ASCIZ "MDL"]
	 JRST	.+3
	TRNE	B,1_6
	 SETO	E,
; now check version number
	JUMPE	D,CNSRST
	CAIE	D,-40(A)	; sent +40
	 SETZ	E,
CNSRST:	.CALL	TTYRST
	 ERROR	CAN'T RESET REAL TTY
	SKIPE	MODFLG		; if modified, its NOT G etc.
	 JRST	CNSNOT
	SKIPE	E
	 AOS	(P)
	POPJ	P,

CNSNOT:	SKIPN	E
	 AOS	(P)
	POPJ	P,

; S COMMAND
; DO WHAT :SSVMOD DOES

SSVMOD:	JSP	RET,GETCHR
	 JRST	UNEXP
	CAIE	B,""
	 JRST	NOARG
	SKIPE	IMLAC
	 JRST	SKPSTR
	.OPEN	TTYO,[SIXBIT /  ETTY/]
	 ERROR	CAN'T OPEN TTY IN IMAGE MODE
	SETZ	B,
	MOVE	C,[TRO B,(D)]

SSLOOP:	ILDB	A,JCLPTR
	CAIN	A,""
	 JRST	SSLOPX
	CAIGE	A,40
	 JRST	SSLOPX
	CAIN	A,40
	 JRST	SSLOOP
	CAIN	A,"+
	 JRST	[MOVE C,[TRO B,(D)]
		 JRST SSLOOP]
	CAIN	A,"-
	 JRST	[MOVE C,[TRZ B,(D)]
		 JRST SSLOOP]

	TRZ	A,40	; flush case distinctions
	MOVE	D,MODPTR
BLOOP:	CAMN	A,(D)
	 JRST	BITTER
	ADD	D,[1,,1]
	AOBJN	D,BLOOP
	OASC	[ASCIZ /BAD SSVMOD COMMAND/]
	JRST	QUIT
	
SSLOPX:	.IOT	TTYO,[^A]
	.IOT	TTYO,[^O]
	IORI	B,100		; make sure 100 bit is on
	.IOT	TTYO,B
	.CALL	TTYRST		; REOPEN THE REAL TTYO
	 ERROR	CAN'T OPEN OUTPUT TTY
	JRST	POPJ1

TTYGET:	SETZ
	SIXBIT /TTYGET/
	MOVEI TTYI
	MOVEM A
	MOVEM A
	MOVEM A
	MOVEM A
	SETZM A	; last one is TCTYP, which we want!

BITTER:	MOVE	D,1(D)
	XCT	C
	JRST	SSLOOP

MODTAB:	"C	; case
	1
	"A	; auto-mode
	2
	"T	; teco cursor
	4
	"B	; blinking cursor
	10
	"M	; clear macro buffer
	20
MODPTR:	-<.-MODTAB>,,MODTAB


SUBTTL	UTILITY ROUTINES

QMARK:	ASCIZ / ? /

; COMMAND READER.
; PUSHJ P,GETLIN READS TO AN ALTMODE AND FILLS IN THE INPUT BUFFER
; ACCORDINGLY

GETLIN:	SETZM	STRBUF		; CLEAR THE INPUT BUFFER
	.RESET	TTYI,
RCMD:	MOVE	B,[440700,,STRBUF]
	MOVEI	C,0		; COUNT OF CHARACTERS
RCMD1:	.IOT	TTYI,A
	SKIPE	RQUOTE		; IN QUOTE MODE?
	 JRST	[SETZM RQUOTE
		 JRST RCMDL]
	CAIN	A,"\
	 JRST	[SETOM RQUOTE
		 JRST RCMD1]
	CAIN	A,177
	 JRST	RUB
	JUMPE	A,RSTBUF
	CAIN	A,^D		; DISPLAY BUFFER
	 JRST	RREPEA
	CAIN	A,^L		; CLEAR SCREEN AND DISPLAY BUFFER
	 JRST	RCLEAR
	CAIE	A,^M
	 CAIN	A,33		; TERMINATE ON ALTMODE
	  JRST	RCMDX1
RCMDL:	.IOT	TTYO,A
	IDPB	A,B		; DEPOSIT THE CHARACTER
	CAMGE	B,[350700,,STRBUF+INPBLN]
	 AOJA	C,RCMD1		; AND MAKE SURE NOT BUFFER FULL
	FATINS	PDL OVERFLOW ON NON-EXPANDABLE PDL

RCMDX:	IDPB	A,B		; TERMINATE GETLIN
RCMDX1:	MOVEI	A,0		; DEPOSIT ZERO
	IDPB	A,B
	POPJ	P,		; EXIT

RSTBUF:	.IOT	TTYO,A		; ECHO THE CHAR AND CLEAR THE BUFFER
	OASCR	[0]
	SETZ	C,
	SETZM	STRBUF
	MOVE	B,[440700,,STRBUF]
	JRST	REPPER

PPRMPT:	MOVE	JCLPTR,JCLSAV
	PUSH	P,B
	PUSHJ	P,OUTPUT
	 JFCL
	POP	P,B
	POPJ	P,

RREPEA:	.IOT	TTYO,A
	OASCR	[0]		; RETYPE LINE
	JRST	REPPER
RCLEAR:	OCTLP	"C
REPPER:	PUSHJ	P,PPRMPT
	OASC	STRBUF
	JRST	RCMD1

RUB:	PUSHJ	P,RUBBER
	 JRST	RCMD
	JRST	RCMD1

RUBBER:	SOJL	C,CPOPJ
	LDB	D,B		; CHAR TO BE DELETED
	MOVEI	A,0
	DPB	A,B		; PUT A 0 IN THE BUFFER
	XCT	XCTRUB		; XCT THE RUBOUT COMMAND
	ADD	B,[070000,,]
	TLNE	B,400000
	ADD	B,[347777,,-1]
	AOS	(P)		; DECREMENT THE BP
	POPJ	P,		; SKIP RETURN

RUBECH:	CAIN	D,177		; ECHO A RUBOUT
	 JRST	[OASC	[ASCIZ /^?/]
		 POPJ	P,]
	OASCI	(D)
	POPJ	P,

RUBFLS:	MOVE	TTYOPT
	TLNE	%TOSAI
	 JRST	RUBONE
	CAIN	D,177
	 JRST	RUBTWO
	CAIL	D,40
	 JRST	RUBONE
	CAIE	D,33
	CAIN	D,10
	 JRST	RUBONE
	CAIE	D,^I
	CAIN	D,^L
	 JRST	RUBONE
RUBTWO:	OCTLP	"X		; DO THE RUBOUT(S)
RUBONE:	OCTLP	"X
	POPJ	P,

; PUSHJ P,YESNO
; IN F, A RETURN ADDRESS FOR REPRINTING PROMPT
; SKIP RETURNS IF ANSWER IS AFFIRMATIVE?

YESNO:	.RESET	TTYI,
	.IOT	TTYI,A
	CAIE	A,177
	 .IOT	TTYO,A
	CAIN	A,^L
	 JRST	[OCTLP "C
		 JRST YESNO1]
	CAMN	A,AFFIRM
	 JRST	POPJ1
	CAMN	A,NEGATE
	 POPJ	P,
	TRZ	A,40
	CAMN	A,AFFIRM
	 JRST	POPJ1
	CAMN	A,NEGATE
	 POPJ	P,
	OASCI	"?
YESNO1:	OASCR	[0]
	HRRM	F,(P)
	POPJ	P,

; JSP RET,GETCHR
; GET THE NEXT NON-SPACE(OR TAB) CHARACTER FROM JCLBUF IN B

GETCHR: ILDB	B,JCLPTR		;FIND NEXT NON-EMPTY CHARACTER
	JUMPE	B,(RET)
	CAIN	B,3
	 JRST	(RET)
	CAIE	B,40
	 CAIN	B,^I
	  JRST	GETCHR
	CAIN	B,^M
	 JRST	GETCHR
	JRST	1(RET)
	
; JRST DECOUT
; DECREMENT THE JCL BUFFER POINTER AND RETURN

DECOUT:	DBP	JCLPTR
	POPJ	P,

; PUSHJ P,PRDATE
; PRINTS DATE IN DISK FORMAT

PRDATE:	LDB	B,[270400,,A]
	OASC	@MONTHS-1(B)		; MONTH
	OASCI	40
	LDB	B,[220500,,A]
	ODEC	B			; DATE
	OASCI	",
	ODEC	[19.]
	LDB	B,[330700,,A]
	ODEC	B			; YEAR
	OASC	[ASCIZ / at /]
	HRRZ	A,A
	LSH	A,-1			; SECONDS FROM MIDNIGHT
	IDIVI	A,3600.	
	MOVE	E,[ASCIZ / AM/]
	CAIL	A,12.
	 MOVE	E,[ASCIZ / PM/]
	CAIL	A,12.
	 SUBI	A,12.
	JUMPN	A,PRDAT1
	 MOVEI	A,12.
PRDAT1:	ODEC	A			; HOUR
	OASCI	":
	IDIVI	B,60.
	CAIGE	B,10.
	 OASCI	"0
	ODEC	B			; MINUTES
	OASCI	":
	CAIGE	C,10.
	 OASCI	"0
	ODEC	C			; SECONDS
	OASC	E
	POPJ	P,

MONTHS:	[ASCIZ /January/]
	[ASCIZ /February/]
	[ASCIZ /March/]
	[ASCIZ /April/]
	[ASCIZ /May/]
	[ASCIZ /June/]
	[ASCIZ /July/]
	[ASCIZ /August/]
	[ASCIZ /September/]
	[ASCIZ /October/]
	[ASCIZ /November/]
	[ASCIZ /December/]

; PUSHJ P,PFNAME
; PRINTS FILE NAME TO TTY

PFNAME:	MOVE	DEVICE(FNM)
	CAMN	[SIXBIT /DSK/]
	 JRST	PFNAM1
	OSIX	DEVICE(FNM)
	OASCI	":
PFNAM1:	OSIX	DIRECT(FNM)
	OASCI	";
	OSIX	FNAME1(FNM)
	OASCI	40
	OSIX	FNAME2(FNM)
	POPJ	P,

; JSP RET2,FSTARI/FSTARO/FSTARN
; FIRST, PARSES THE FILE NAME AND CHECKS FOR CONTIN
; THEN DOES FILE OPENING (I=INPUT, O=OUTPUT, N=NONE)
; WILL POPJ IF ANY LOSSAGE OCCURS

FSTARN:	PUSH	P,[-1]
	JRST	FSTAR1

FSTARO:	PUSH	P,[.BIO]
	JRST	FSTAR1

FSTARH:	 PUSH	P,[.BII+20]		; DON'T CHASE LINKS
	JRST	FSTAR1

FSTARI:	 PUSH	P,[.BII]
FSTAR1:	PUSHJ	P,FPARSE
	 JRST	POPAJ
	POP	P,
	JUMPL	(RET2)
	SKIPE	DSKFLG			; IS THE FILE OPEN FLAG SET
	 JRST	(RET2)			; YES. LEAVE
	PUSH	P,A
	MOVE	A,FNAME2
	CAMN	A,[SIXBIT /*/]
	 PUSHJ	P,FMAP			; SPECIAL HACK FOR * SECOND NAME
	POP	P,A
	.CALL	DSKOPN			; NO. OPEN IT
	 POPJ	P,
	SETOM	DSKFLG			; SET FILE OPEN
	JRST	(RET2)

; COME HERE TO GET THE NEXT FNAME2 FOR * MODE

FMAP:	SKIPE	A,FFMAP			; POINTER TO BLOCK WITH SAME FNAME1
	 JRST	FMAP1			; NO? CREATE ONE
	PUSH	P,B			; SOME SCRATCH AC'S
	PUSH	P,C
	PUSH	P,D
	MOVE	B,AP
FMAPL:	HLRZ	C,(B)
	TRNN	C,$REPEAT+$FCN
	 JRST	[SUB	B,[6,,6]
	         SKIPE	(B)
		  JRST	FMAPL
		 JRST FERR]
	HRRZ	C,(B)
	HRLZM	C,FFMAP
	SETZM	DIRBUF			; CLEAR THE DIRECTORY BUFFER
	MOVE	B,[DIRBUF,,DIRBUF+1]
	BLT	B,DIRBUF+177
	.CALL	DIROPN			; OPEN THE DIRECTORY
	 LOSE
	MOVE	B,[-2000,,INPBUF]
	.IOT	DSKCHN,B		; AND GET IT
	MOVE	B,INPBUF+1		; START OF NAME AREA
	SUBI	B,1777			
	HRLZS	B			; BUILD AOBJN POINTER TO DIRECTORY
	HRRI	B,INPBUF
	ADD	B,INPBUF+1		; IN B NOW, THE AOBJN POINTER
	MOVEI	D,DIRBUF		; IN D, POINTER TO DIR BUFFER

FSTMAP:	MOVE	C,(B)			; FILE NAME ONE
	CAME	C,FNAME1		; IF THIS IS A MATCH
	 JRST	FSTMP1
	MOVE	C,1(B)			; GET FNAME2
	MOVEM	C,(D)			; AND SAVE IT IN DIR BUFFER
	AOJ	D,
FSTMP1:	ADD	B,[4,,4]		; MAP THROUGH THE DIRECTORY
	AOBJN	B,FSTMAP
	MOVEI	B,DIRBUF
	HRRM	B,FFMAP			; SAVE POINTER TO DIR BUFFER
	MOVE	B,(B)
	MOVEM	B,FNAME2		; FIXUP THIS FNAME2
	MOVEM	B,SYSFN2
	POP	P,D
	POP	P,C
	POP	P,B
	POPJ	P,			; AND RETURN

FMAP1:	AOS	A,FFMAP			; IF BUFFER EXISTS
	PUSH	P,B
	PUSH	P,C
	PUSH	P,D
	HLRZ	D,FFMAP
	MOVE	B,AP
FMAP1L:	HRRZ	C,(B)
	CAME	C,D
	 JRST	[SUB	B,[6,,6]
		 SKIPE	(B)
	  	  JRST FMAP1L
	 	 JRST .+2]
	SKIPN	A,(A)			; UPDATE THE POINTER AND GET FNAME2
	 JRST	[SUB	P,[4,,4]	; IF 0, END OF DIR BUFFER
		 SETZM	FFMAP
		 JRST	POPAJ]		; SO RETURN
	MOVEM	A,FNAME2		; SET THE NEW FNAME1
	MOVEM	A,SYSFN2
	SUB	P,[3,,3]
	POPJ	P,			; AND RETURN

DIROPN:	SETZ
	SIXBIT /OPEN/
	MOVSI .BII
	MOVEI DSKCHN
	DEVICE
	[SIXBIT /.FILE./]
	[SIXBIT /(DIR)/]
	SETZ DIRECT

DSKOPN:	SETZ
	SIXBIT /OPEN/
	MOVS
	MOVEI DSKCHN
	DEVICE
	FNAME1
	FNAME2
	SETZ DIRECT

; PUSHJ P,FPARSE
; JCLBUF HAS POINTER TO JCL BUFFER
; SKIP RETURN UNLESS NO FILE NAME FOUND
; ^Q IS THE QUOTE CHARACTER
; ^X SAYS USE MY XUNAME
; ^U SAYS USE MY UNAME

FPARSE:	PUSHJ	P,ARGH
	CAIE	B,""
	 JRST	DECOUT
	MOVE	C,JCLPTR
	ILDB	B,C
	CAIE	B,""
	 SETZM	DSKFLG
	SETZ	FNM,
FPARS1:	SETZM	DEVICE(FNM)
	SETZM	DIRECT(FNM)
	SETZM	FNAME1(FNM)
	SETZM	FNAME2(FNM)
	SETZM	ENDSW

FPARSS:	SKIPE	ENDSW
	 JRST	FPEND
	ILDB	B,JCLPTR
	SKIPE	PUSHSW
	 JUMPE	B,[MOVE JCLPTR,JCLPSH
		   SETZM PUSHSW
		   ILDB B,JCLPTR
		   JRST .+1]
	SETZM	NAME			; CLEAR NAME SLOT
	MOVE	F,[440600,,NAME]
	
FIELD: 	CAIE	B,40			; HERE TO GET A NAME
	 CAIN	B,^I
	  JRST	FNAM			; SPACE AND TAB MAKE FNAME1 AND 2
	CAIN	B,",
	 JRST	FNAM	 		; , --> NEXT FILE NAME
	JUMPE	B,CPOPJ
	CAIN	B,"#
	 JRST	[JSP RET1,GETQRG
		 MOVEM JCLPTR,JCLPSH
		 MOVE JCLPTR,GLOTOP(B)
		 SKIPE PUSHSW
		  ERROR ATTEMPT TO PUSH JCL IO RECURSIVELY
		 SETOM PUSHSW
		 ILDB B,JCLPTR
		 JRST FIELD]
	CAIN	B,^X			; USE MY XUNAME
	 JRST	[.SUSET	[.RXUNAM,,NAMESV]
		 JRST FPARSX]
	CAIN	B,^U			; USE MY UNAME
	 JRST	[.SUSET	[.RUNAME,,NAMESV]
		 JRST FPARSX]
	CAIN	B,""
	 JRST	FTERM			; TERMINATE
	CAIN	B,":
	 JRST	DEV			; DEVICE NAME
	CAIN	B,";
	 JRST	DIR			; SNAME
	CAIN	B,^Q			
	 ILDB	B,JCLPTR		; QUOTE THE NEXT CHARACTER
	SUBI	B,40
	CAIL	B,100
	 SUBI	B,40			; CASE CONVERSION
	TLNE	F,770000		; IGNORE MORE THAN 6 CHARACTERS
	 IDPB	B,F
FPARS2:	ILDB	B,JCLPTR
	SKIPE	PUSHSW
	 JUMPE	B,FPARS3
	JRST	FIELD

FPARS3:	MOVE	JCLPTR,JCLPSH
	ILDB	B,JCLPTR
	SETZM	PUSHSW
	JRST	FIELD

FPARSX:	MOVE	B,[440600,,NAMESV]
	MOVEI	D,6
FPARSY:	ILDB	C,B
	TLNE	F,770000
	 IDPB	C,F
	SOJN	D,FPARSY
	JRST	FPARS2

DEV:	MOVE	A,NAME	
	MOVEM	A,DEVICE(FNM)
	JRST	FPARSS

DIR:	MOVE	A,NAME
	MOVEM	A,DIRECT(FNM)
	JRST	FPARSS

FTERM:	SETOM	ENDSW
FNAM:	MOVE	A,NAME
	JUMPE	A,FNAM1
	SKIPE	FNAME1(FNM)		; DOES HE HAVE AN FNAME1 ALREAD?
	 JRST	[MOVEM A,FNAME2(FNM)
		 JRST FNAM1]
	MOVEM	A,FNAME1(FNM)		; NO - TRY IT AS FNAME1
FNAM1:	CAIE	B,",
	 JRST	FPARSS
	MOVEI	FNM,1
	JRST	FPARS1

; COME HERE TO DO DEFAULT HACKING (WHICH IS GROSS AND DISGUSTING)
; BASICALLY, IF THE ITEM IS NOT SPECIFIED, GET IT FROM THE SYSTEM DEFAULT
; OTHERWISE, 1) IF THIS IS THE FIRST FILE, SET THE SYSTEM DEFAULT
;	     2) OTHERWISE, WIN IMMEDIATE

FPEND:	SKIPE	EXCLHK
	 MOVE	JCLPTR,EXCLHK
	SKIPN	A,DEVICE	
	 SKIPA	A,SYSDEV
	  MOVEM	A,SYSDEV
	MOVEM	A,DEVICE
	SKIPN	A,DIRECT
	 SKIPA	A,SYSDIR
	  MOVEM	A,SYSDIR
	MOVEM	A,DIRECT
	SKIPN	A,FNAME1
	 SKIPA	A,SYSFN1
	  MOVEM	A,SYSFN1
	MOVEM	A,FNAME1
	SKIPN	A,FNAME2
	 SKIPA	A,SYSFN2
	  MOVEM	A,SYSFN2
	MOVEM	A,FNAME2
	JUMPE	FNM,POPJ1
	SKIPN	A,DEVICE+1
	 MOVE	A,SYSDEV
	MOVEM	A,DEVICE+1
	SKIPN	A,DIRECT+1
	 MOVE	A,SYSDIR
	MOVEM	A,DIRECT+1
	SKIPN	A,FNAME1+1
	 MOVE	A,SYSFN1
	MOVEM	A,FNAME1+1
	SKIPN	A,FNAME2+1
	 MOVE	A,SYSFN2
	MOVEM	A,FNAME2+1
	SETZ	FNM,
	JRST	POPJ1

; COME HERE TO OPEN UP THE INPUT AND OUTPUT TTY'S
; THE CONSOLE TYPE IS READ AND IS USED TO DETERMINE 
; THE RUBOUT PROCEDURE

TTYOPN:	.CALL	[SETZ
		 SIXBIT /OPEN/
		 MOVEI TTYI
		 SETZ [SIXBIT /TTY/]]
	 ERROR	CAN'T OPEN INPUT TTY
	.CALL	TTYRST
	 ERROR	CAN'T OPEN OUTPUT TTY
	.SUSET	[.SMSK2,,[<1_TTYI>#<1_TTYO>]]
	.SUSET	[.SMASK,,[%PIPDL]]
	.CALL	CNSGET
	 LOSE
	.CALL	TTYSET	    		; SET UP TTY TO TAKE CONTROL CHARACTERS
	 LOSE
	.CALL	TTYGET
	 LOSE
	SETZM	IMLAC
       	.CALL	[SETZ
		 'TTYVAR
		 MOVEI TTYI
		 ['SMARTS]
		 SETZM B]
	 JRST	TTYRUB		; ASSUME IMLAC
	SETOM	IMLAC
	TLNE	B,%TQIM1
	 SETZM	IMLAC
TTYRUB:	MOVE	[PUSHJ P,RUBECH]
	TLNE	A,%TOERS
	 MOVE	[PUSHJ P,RUBFLS]
	MOVEM	XCTRUB
	POPJ 	P,

CNSGET:	SETZ
	SIXBIT /CNSGET/
	MOVEI TTYO
	MOVEM
	MOVEM 
	MOVEM 
	MOVEM 
	SETZM TTYOPT

TTYRST:	SETZ
	SIXBIT /OPEN/
	[4001,,TTYO]
	SETZ [SIXBIT /TTY/]

TTYSET:	SETZ
	SIXBIT /TTYSET/
	MOVEI TTYI
	[030303,,030303]
	SETZ [030303,,030303]


SUBTTL	VARIOUS LOSSAGES

FERR:	CHOMP	FILE NAME * MODE NOT IN REPEAT?

UNEXP:	CHOMP	UNEXPECTED TERMINATION OF JCL

NOARG:	CHOMP	TOO FEW ARGUMENTS SUPPLIED
	
CNDERR:	CHOMP	COND CLAUSE NOT A BIND OR PROG

ILLATM: CHOMP	ILLEGAL ATOM
	
ILLFRM:	CHOMP	ILLEGAL FRAME

NOTPRG:	CHOMP	AGAIN NOT IN PROG OR REPEAT

UNBOUN:	CHOMP	UNBOUND VARIABLE

NONAPP:	CHOMP	NON APPLICABLE TYPE

NONE:	CAIN	B,"|-FSTCOM
	 JRST	INIT
	OASC	[ASCIZ /ILLEGAL COMMAND READ - /]
	TRO	B,40
	ADDI	B,"A
	OASCI	(B)

NERROR:	LDB	A,JCLPTR
	JUMPE	A,NERR1
	DBP	JCLPTR
	LDB	A,JCLPTR
	JUMPE	A,NERR1
	DBP	JCLPTR
NERR1:	OASC	[ASCIZ / --> /]
	OBPTR	JCLPTR			; TRY TO PRINT THE REMAINING JCL

QUIT:	MOVE	A,(AP)
	TLNE	A,$FCN
	 JRST	FINIS			; THIS IS THE END OF A FUNCTION CALL
	.RESET	TTYI,
	.CLOSE	DSKCHN,
	.BREAK	16,140000


SUBTTL	UUO HANDLERS

; TYPEOUT UUOS (STRAIGHT FROM DIRED, WITH SOME HELP FROM PDL)

UUOCT==0
UUOTAB:	FATINS	ILLEGAL UUO
	IRPS X,,[ODEC OBPTR OHPOS OCTLP OALIGN OSIX OASC OASCI OASCR OSIXS ERRUUO]
	UUOCT==UUOCT+1
	X=UUOCT_33
	JRST U!X
	TERMIN

UUOMAX==.-UUOTAB

TSINT:	0
	0
	PUSH	P,A
	PUSH	P,B
	SKIPG	A,TSINT
	 JRST	TSINTM
	TRZE	A,%PIPDL
	 FATINS	PDL OVERFLOW ON NON-EXPANDABLE PDL
TSDIS:	POP	P,B
	POP	P,A
	.DISMIS TSINT+1

TSIN:	MOVEI	A,TTYI
	.ITYIC	A,
	 JFCL
	CAIN	A,^S
	 JRST	TSFLS
	JRST	TSDIS

TSFLS:	SKIPN	PRTFLG
	 JRST	TSDIS
	MOVE	A,[440700,,[ASCIZ / Flushed/]]
	MOVEI	B,8.		; FLUSH FILE PRINTING
	PUSHJ	P,MESIOT
	SUB	P,[2,,2]
	.DISMIS	[PRFLXT]

TSINTM:	TRNN	A,1_TTYO	; more only on output channel
	 JRST	TSIN		; spurious interrupt?
	PUSHJ	P,MORAGE
	 JRST	TSMSTP
	JRST	TSDIS

MORAGE:	PUSH	P,A
	PUSH	P,B
	MOVE	A,[440700,,[ASCIZ /--More--/]]
	MOVEI	B,8.
	PUSHJ	P,MESIOT
	.CALL	[SETZ
		 SIXBIT /IOT/
		 MOVEI TTYI
		 SETZ A]
	 LOSE
	POP	P,B
	CAIE	A,^S	; ^S is also stop
	 CAIN	A,177	; not rubout is continue
	  JRST	POPAJ
	.IOT	TTYO,[^M]
	.IOT	TTYO,[^J]
	POP	P,A
	JRST	POPJ1

TSMSTP:	MOVE	A,[440700,,[ASCIZ /Flushed/]]
	MOVEI	B,7
	PUSHJ	P,MESIOT
	.CLOSE	DSKCHN,
	SUB	P,[2,,2]
	.DISMIS	[CPOPJ]

MESIOT:	.CALL	MESCAL
	 LOSE
	.CALL	[SETZ ? SIXBIT /FLUSH/ ? SETZI TTYO]
	 LOSE
	POPJ	P,

MESCAL:	SETZ
	SIXBIT	/SIOT/
	MOVEI	TTYO
	A
	SETZ	B

UUOH:	0
	PUSH	P,A
	PUSH	P,B
	PUSH	P,C
	PUSH	P,D
	PUSH	P,RET1
	MOVEI	@40			; GET EFF ADDR. OF UUO
	MOVEM	UUOE
	MOVE	@0
	MOVEM	UUOD			; CONTENTS OF EFF ADR
	MOVE	B,UUOE			; EFF ADR
	LDB	A,[270400,,40]		; GET UUO AC,
	LDB	C,[330600,,40]		; OP CODE
	CAIL	C,UUOMAX
	MOVEI	C,0	; GRT=>ILLEGAL
	JSP	RET1,@UUOTAB(C)		; GO TO PROPER ROUT

UUORET: POP	P,RET1
	POP	P,D
	POP	P,C
	POP	P,B
	POP	P,A			; RESTORE AC'S
	JRST	2,@UUOH

UOBPTR:	MOVEI	C,0
	MOVE	B,UUOD
	JRST	UOASC1

UOASCR:	SKIPA	C,[^M]			; CR FOR END OF TYPE
UOASC:	 MOVEI	C,0			; NO CR
	HRLI	B,440700		; MAKE ASCII0 POINTER
UOASC1:	ILDB	A,B			; GET CHAR
	JUMPE	A,UOASC2		; FINISH?
	PUSHJ	P,IOTA
	JRST	UOASC1			; AND GET ANOTHER
UOASC2:	SKIPE	A,C			; GET SAVED CR?
	 PUSHJ	P,IOTA
	JRST	(RET1)			; HO HO

UOASCC:	HRLI	B,440700		; MAKE ASCII POINTER
UOAS1C:	ILDB	A,B			; GET CHAR
	CAIN	A,^C
	 JRST	UUORET
	PUSHJ	P,IOTA
	JRST	UOAS1C			; AND GET ANOTHER

UOCTLP:	;;;SKIPE	IMLAC		; ONLY PRINT CTRL-P CODES FOR IMLAC
	 ;;;JRST	UOASCI			(HOW NARROW-MINDED CAN YOU GET!)
	MOVEI	A,^P
	PUSHJ	P,IOTA1

UOASCI:	MOVE	A,B			; PRT ASCII IMMEDIATE
	PUSHJ	P,IOTA
	JRST	UUORET

UOSIX:	MOVE	B,UUOD
USXOOP:	JUMPE	B,UUORET
	LDB	A,[360600,,B]
	ADDI	A,40
	PUSHJ	P,IOTA
	LSH	B,6
	JRST	USXOOP

UOSIXS:	MOVE	A,[440600,,UUOD]
USLOOP:	ILDB	C,A
	ADDI	C,40
	PUSHJ	P,IOTC
	TLNE	A,770000
	JRST	USLOOP
	JRST	UUORET

UOHPOS:	SUB	B,HPOS
	JUMPLE	B,UOASCI
UOHPO1:	MOVEI	A,40
	PUSHJ	P,IOTA
	SOJG	B,UOHPO1
	JRST	UUORET

POWER:	0 ? 1 ? 10. ? 100. ? 1000. ? 10000. ? 100000. ? 1000000.

UOALIG:	MOVE	D,UUOD
	ANDI	A,7
	MOVE	A,POWER(A)
	MOVEI	C,40
UOALI1:	CAMLE	A,D
	 PUSHJ	P,IOTC
	IDIVI	A,10.
	CAIE	A,1
	 JRST	UOALI1
	SETZ	A,

UODEC:	SKIPA	C,[10.]			; GET BASE FOR DECIMAL
UOOCT:	 MOVEI	C,8.			; OCTAL BASE
	MOVE	B,UUOD			; GET ACTUAL WORD TO PRT
	JRST	.+3			; JOIN CODE
UODECI:	SKIPA	C,[10.]			; DECIMAL
UOOCTI:	 MOVEI	C,8.
	MOVEM	C,BASE
	SKIPN	A
	 HRREI	A,-1			; A=DIGIT COUNT
	PUSHJ	P,UONUM			; PRINT NUMBR
	JRST	UUORET

UONUM:	IDIV	B,BASE
	HRLM	C,(P)			; SAVE DIGIT
	SOJE	A,UONUM1		; DONE IF 0
	SKIPG	A			; + => MORE
	 SKIPE	B			; - => B=0 => DONE
	  PUSHJ	P,UONUM			; ELSE MORE
UONUM1:	HLRZ	C,(P)			; RETREIVE DIGITS
	ADDI	C,"0			; MAKE TO ASCII
	CAILE	C,"9			; IS IT GOOD DIG
	ADDI	C,"A-"9-1		; MAKE HEX DIGIT
	PUSHJ	P,IOTC
	POPJ	P,			; RET

UERRUU:	JSP	RET1,UOASCR
	MOVEI	A,CPOPJ
	MOVEM	A,UUOH
	JRST	UUORET

IOTC:	PUSH	P,A
	MOVE	A,C
	PUSHJ	P,IOTA
	JRST	POPAJ

IOTA:	CAIN	A,^P
	 JRST	IOTAP
IOTA1:	SKIPN	CTRLJ
	 JRST	[CAIN A,^J
	 	  POPJ P,
		 JRST .+1]
	.IOT	OUTCHN,A
	CAIN	A,^I
	 JRST [MOVE A,HPOS
	       ADDI A,10
	       ANDI A,7770
	       MOVEM A,HPOS
	       POPJ P,]
	AOS	HPOS
	CAIE	A,^M
	 POPJ	P,
	SETZM	HPOS
	POPJ	P,
IOTAP:	.IOT	OUTCHN,["^]
	ADDI	A,100
	JRST	IOTA1

POPAJ:	POP	P,A
	POPJ	P,

; HERE TO PRINT THE STACK.  THIS MUST BE DONE MANUALLY
; TRY PUSHJ P,PRSTAK

PRSTAK:	PUSH	P,AP
	PUSH	P,JCLPTR
	SETZM	HPOS
PRSTKL:	MOVE	A,(AP)
	TLZE	A,400000
	OASCI	!"*
	JFFO	A,.+1
	CAIL	B,STTBLN
	 MOVEI	B,STTBLN
	JUMPE	A,PRSTGO
	HRRZ	C,(AP)
	ODEC	C
	OHPOS	6.
	OASC	STKTBL(B)
	TLNE	A,$ARG
	 JRST	[OHPOS 15.
		 OASCI ""
		 MOVE JCLPTR,-1(AP)
		 JSP RET,GETCHR
		  JFCL
		 PUSHJ P,OUTLP
		  JFCL
		 OASCI ""
		 JRST .+1]
	SUB	AP,[6,,6]
	SETZ	C,
PRFMK:	ADD	AP,[1,,1]
	MOVE	A,(AP)
	MOVEM	A,DEVICE(C)
	CAIN	C,6
	 JRST	PRFMK1
	AOJ	C,
	AOJA	C,PRFMK
PRFMK1:	OHPOS	40.
	OASCI	""
	PUSHJ	P,PFNAME
	OASCI	""
	OASCR	[0]
	SUB	AP,[4,,4]
	JRST	PRSTKL

PRSTGO:	OASC	[ASCIZ /      TOPLEVEL/]
	POP	P,JCLPTR
	POP	P,AP
	POPJ	P,

STKTBL:	ASCIZ /STOP/
	ASCIZ /AND/
	ASCIZ /OR/
	ASCIZ /COND/
	ASCIZ /BIND/
	ASCIZ /NOT/
	ASCIZ /RPT/
	ASCIZ /BIND/
	ASCIZ /MAPF/
	ASCIZ /ARG/
	ASCIZ /FCN/
	ASCIZ /ARG/
	ASCIZ /BLK/
	ASCIZ /PROG/
STTBLN==.-STKTBL-1

SUBTTL	PREDEFINED FUNCTIONS

; PREDEFINED FUNCTIONS ARE CREATED THROUGH CALLS TO PREDEF
; THE SEQUENCE IS <CHAR>,[THE STUFF YOU WANT]
; THE FOLLOWING ARE FAIRLY STRAIGHTFORWARD

; B FUNCTION -- DO READER OUTPUT INTERPRETATION WITH OPTIONAL ARGS

BFCN:	PREDEF B,[[B"; READER"]]

; M FUNCTION -- PRINT MAIL AND RENAME TO OMAIL
; no arguments

MFCN:	PREDEF	M,[[? [E"; MAIL" [& ;Q"Print mail? " P"" R", OMAIL"]]]]

; T FUNCTION -- PRINT IF HAVE A SAFETY FILE
; no arguments

TFCN:	PREDEF	T,[[& E"_ >" ;O"You have a TECO safety file."]]

; S FUNCTION -- HAIRY 'SAVE' ADDITION TO M FUNCTION
; arg 1 = mail file (defaults to <xuname> MAIL)
; arg 2 = rename file specification (defaults to <xuname> MAIL,VANISH;<xuname> OMAIL)

SFCN:	PREDEF	S,[[? [E;!1" MAIL" [& ;Q"Print mail? " P"" [? (;Q"Save mail? " R;!2",OMAIL >") (A",VANISH; OMAIL")]]]]]
	
; C FUNCTION -- COMB FILES
; arg 1 = file, must be FOO;BAR * (no default)
; arg 2 = what to print between files (default "Next file? ")

CFCN:	PREDEF	C,[[* [? (E!1 K N"" P"" [\ ;Q;!2"Next file? " @>]) (@>)]]]

; P FUNCTION -- PRUNE FILES (comb + offer to delete)
; arg 1 = file, must be FOO;BAR * (no default)
; arg 2 = what to print between files (default "Next file? ")
; arg 3 = what to print for deletion (default "Delete? ")

PFCN:	PREDEF	P,[[* [? (E!1 K N"" P"" [& ;Q;!3"Delete? " D""] [\ ;Q;!2"Next file? " @>]) (@>)]]]

; D FUNCTION -- DELETE ALL FILES WITH FIRST FILE NAME
; arg 1 = file name (default PCOMP)

DFCN:	PREDEF	D,[[*[\D;!1"PCOMP >"@>]]]

	END	START


